X-Git-Url: https://diplodocus.org/git/minc/blobdiff_plain/29c99d6c9ab65449be4e5b4aaf7cafa2c8796043..68a4ee3a17937925b02ea2197e6d30e745d4dc3b:/minc diff --git a/minc b/minc index 83acac4..e216504 100755 --- a/minc +++ b/minc @@ -1,14 +1,18 @@ -#! /usr/local/bin/perl +#! /usr/bin/env perl # $Id$ =head1 NAME -B - Incorporate mail from a maildir into mh folders. +B - incorporate mail from a maildir into mh folders =head1 SYNOPSIS -B [-B] +B [B<-m> I] [B<-n>] [B<-p>] + +B B<-d> + +B B<-h> =head1 DESCRIPTION @@ -29,12 +33,10 @@ use Data::Dumper; use Errno; use Fcntl qw(O_WRONLY O_EXCL O_CREAT); use FileHandle; -use File::Basename; use File::stat; -use Getopt::Std; $Getopt::Std::STANDARD_HELP_VERSION = 1; -use Log::Dispatch; -use Log::Dispatch::File; +use Getopt::Long qw(:config gnu_getopt no_ignore_case); use POSIX qw(strftime WEXITSTATUS WIFEXITED); +use Pod::Usage; our $VERSION = 1; @@ -56,10 +58,14 @@ my @SPAM; Dump (using Data::Dumper) the FILTERS list and exit. This is useful for testing the syntax of .mincfilter. -=item B<--help> +=item B<-h> Show help. +=item B<-m> I + +Stop processing after I messages. + =item B<-n> Dry run; do not actually incorporate the mail, but log and report to @@ -75,27 +81,23 @@ problem. =cut -my $dumpfilters = 0; -our $run = 1; -my $printfilenames = 0; - -our $opt_d; -our $opt_n; -our $opt_p; +my $dumpfilters; +my $help; +my $maxmsgs; +my $norun; +my $printfilenames; -if (not getopts('dnp')) { - exit(2); -} +GetOptions( + 'd' => \$dumpfilters, + 'h|help' => \$help, + 'm=i' => \$maxmsgs, + 'n' => \$norun, + 'p' => \$printfilenames, + ) or pod2usage(); +$help and pod2usage(-exitstatus=>0, -verbose=>1); +@ARGV == 0 or pod2usage(); -if ($opt_d) { - $dumpfilters = 1; -} elsif ($opt_n) { - $run = 0; -} - -if ($opt_p) { - $printfilenames = 1; -} +our $run = !$norun; =head1 ENVIRONMENT @@ -179,15 +181,6 @@ marked unseen. =cut our @FILTERS; -require "$HOME/.mincfilter"; - -if (-f "$HOME/.mincspam") { - require "$HOME/.mincspam"; -} else { - eval "sub spam_start_hook { return (); }"; - eval "sub spam_stop_hook { }"; - eval "sub spam_check { return 0; }"; -} my $mh; my $logfile; @@ -207,29 +200,7 @@ $ENV{"MHCONTEXT"} = $mh . '/.minc.context'; ############################################################################### # Logging -# debuglevels for the logger -use constant LOG_DEBUGLEVEL => 'info'; -use constant SCREEN_DEBUGLEVEL => 'debug'; - -# characters used to wrap around the id field in the log so I can more -# easily parse the msg flow -use constant DEBUGCHAR => '%'; -use constant INFOCHAR => '='; -use constant INCOMINGCHAR => '<'; -use constant SAVECHAR => '>'; -use constant WARNCHAR => 'W'; -use constant ERRORCHAR => 'E'; - -my $logger = new Log::Dispatch; -$logger->add(new Log::Dispatch::File (name=>'logfile', - filename=>$logfile, - min_level=>'info', - mode=>'append')); - -# log alias, handles getting passed vars that are undef sub mylog { - my $level = shift; - my $act = shift; my $timestamp = strftime('%b %e %H:%M:%S', localtime); my $msg; foreach my $part (@_) { @@ -239,21 +210,13 @@ sub mylog { } # no newlines in the log message, thanks $msg =~ s/\n/ /gm; - $msg = sprintf("%s %s%s %s\n", $timestamp, $act, $act, $msg); - $logger->log(level=>$level, message=>$msg); - if ($act eq SAVECHAR) { - $logger->log(level=>$level, message=>"\n"); - } + open(LOG, ">>$logfile") or die("open(>>$logfile): $!"); + print(LOG "$timestamp $msg\n") or die("print(>>$logfile): $!"); + close(LOG) or die("close($logfile): $!"); } -sub logsave { mylog('notice', SAVECHAR, @_); } -sub loginfo { mylog('info', INFOCHAR, @_); } -sub logdebug { mylog('debug', DEBUGCHAR, @_); } -sub logwarn { mylog('warning', WARNCHAR, @_); } -sub logerr { mylog('error', ERRORCHAR, @_); } - -sub logincoming { +sub logheader { my ($text, @contents) = @_; my $last; @@ -263,7 +226,7 @@ sub logincoming { $last = ''; } - mylog('info', INCOMINGCHAR, $text, $last); + mylog('<< ', $text, $last); } sub log_headers { @@ -271,10 +234,10 @@ sub log_headers { # For an explanation of the %headers structure, see the # get_headers function below. - logincoming('From: ', @{$headers{'return-path'}}); - logincoming('To: ', @{$headers{'to'}}); - logincoming('Subject: ', @{$headers{'subject'}}); - logincoming('Message-Id: ', @{$headers{'message-id'}}); + logheader('From: ', @{$headers{'return-path'}}); + logheader('To: ', @{$headers{'to'}}); + logheader('Subject: ', @{$headers{'subject'}}); + logheader('Message-Id: ', @{$headers{'message-id'}}); } @@ -282,25 +245,14 @@ sub log_headers { # Utility procedures sub mkfolder { - my $mhfolder = shift; - my $folder; + my $folder = shift; my $target; my $component; - $folder = $mh . '/' . $mhfolder; - $target = ''; - - if (not -d $folder) { - foreach $component (split('/', $folder)) { - if (defined($component) and length($component) >= 1) { - $target = $target . '/' . $component; - if (-d $target or mkdir($target)) { - next; - } else { - die("Failed to create +$mhfolder ($component)"); - } - } - } + $target = $mh; + foreach $component (split('/', $folder)) { + $target = join('/', $target, $component); + -d $target or mkdir($target) or die("mkdir($target): $!"); } } @@ -309,7 +261,7 @@ sub getfiles { my @result; if (not opendir(DIR, $dir)) { - die("Failed opendir($dir)"); + die("opendir($dir): $!"); } # Initialize $! to 0 (success) because stupid stupid Perl provides @@ -318,19 +270,18 @@ sub getfiles { # to detect an error. Real Programmers don't handle errors, # right? >sigh< $! = 0; - @result = grep { - ($_ ne '.' and $_ ne '..') - and $_ = "$MAILDIR/new/$_" - } readdir(DIR); - + @result = readdir(DIR); if ($! != 0) { - die("Failed readdir($dir)"); + die("readdir($dir): $!"); } - if (scalar(@result) == 0) { + if (@result <= 2) { exit(0); } + STDOUT->autoflush(1); + print(@result - 2, " messages..."); + closedir(DIR); return @result; @@ -345,14 +296,15 @@ sub get_highest_msgnum { $dir = "$mh/$mhfolder"; if (not opendir(DIR, $dir)) { - die("Failed opendir($dir)"); + die("opendir($dir): $!"); } + # Insert rant from getfiles here. $! = 0; @list = readdir(DIR); if ($! != 0) { - die("Failed readdir($dir)"); + die("readdir($dir): $!"); } closedir(DIR); @@ -409,7 +361,7 @@ sub store_message { # file is left behind as opposed to a duplicate # message. This is more easily detected by the user. if ($run) { - if (sysopen(MSG, "$mhmsg", + if (sysopen(MSG, $mhmsg, O_WRONLY | O_EXCL | O_CREAT, 0600)) { close(MSG); last; @@ -431,12 +383,12 @@ sub store_message { } if ($mhfolder ne 'SPAM') { - logsave("+$mhfolder"); + mylog('+', $mhfolder); } if ($run) { if (not rename($msg, $mhmsg)) { - die("Failed rename($msg, $mhmsg)"); + die("rename($msg, $mhmsg): $!"); } # Mark each message as soon as we store it and bomb if that @@ -448,6 +400,8 @@ sub store_message { } else { $status = system('mark', "+$mhfolder", "$msgnum", '-sequence', 'unseen', '-add'); + # XXX need to handle signalled and stopped, and print + # the exit code or signal number. if (not WIFEXITED($status)) { die("Failed to run mark"); } elsif (WEXITSTATUS($status) != 0) { @@ -473,7 +427,7 @@ sub get_headers { my $fieldname; # unmolested header name my $contents; # contents of header - open(MSG, $msg); + open(MSG, $msg) or die("open(MSG, $msg): $!"); while () { chomp; if (length == 0) { @@ -484,8 +438,8 @@ sub get_headers { # folded header continuation if (not defined($current)) { - print(STDERR "Malformed message, cannot parse headers.\n"); - return (); + warn('Malformed message, cannot parse headers.'); + next; } @{$headers{$current}}[-1] .= $_; @@ -576,39 +530,66 @@ sub find_mh_folder { sub filter_mail { my @msglist = @_; - my $msgcount = scalar(@msglist); + my $msgcount = @msglist - 2; # don't count . and .. + my $len = length($msgcount); my @baton; my $msg; my $mhfolder; my $spam = 0; my $saved = 0; + my $msgnum; my %FOLDERS = ('SPAM'=>1); - @baton = spam_start_hook(); + if (-f "$HOME/.mincspam") { + require "$HOME/.mincspam"; + } else { + eval "sub spam_start_hook { return (); }"; + eval "sub spam_stop_hook { }"; + eval "sub spam_check { return 0; }"; + } + if (-f "$HOME/.mincfilter") { + require "$HOME/.mincfilter"; + } + + if (-f "$HOME/.minchooks") { + require "$HOME/.minchooks"; + } else { + eval "sub post_store_hook { }"; + } + + @baton = spam_start_hook(); - STDOUT->autoflush(1); - print("$msgcount messages..."); foreach $msg (@msglist) { + ($msg eq '.' or $msg eq '..') and next; + + if ($printfilenames) { + print("$msg\n"); + } + if (spam_check($msg, @baton)) { $mhfolder = 'SPAM'; - $spam = scalar(@SPAM)+ 1; + $spam = @SPAM + 1; } else { $mhfolder = find_mh_folder($msg); $saved++; } - store_message($msg, $mhfolder); + $msgnum = store_message($msg, $mhfolder); + + post_store_hook($mhfolder, $msgnum); print("\r"); if (not $FOLDERS{$mhfolder}) { - print(' ' x length($msgcount)); - print(" \r+$mhfolder\n"); + print(' ' x $len); + print(" \r$mhfolder\n"); $FOLDERS{$mhfolder} = 1; } - printf('%6d SPAM %6d saved %6d/%1d', + printf(" \%${len}d SPAM \%${len}d saved \%${len}d/%1d", $spam, $saved, $spam + $saved, $msgcount); + + defined($maxmsgs) and ($spam + $saved < $maxmsgs or last); } print("\n"); @@ -617,17 +598,17 @@ sub filter_mail { MAIN: { - my @msglist; my $st; if ($dumpfilters) { + require "$HOME/.mincfilter"; $Data::Dumper::Indent = 1; print(Dumper(\@FILTERS)); exit; } - @msglist = ( - map { $_->[1] } + chdir("$MAILDIR/new") or die("chdir($MAILDIR/new): $!"); + filter_mail(map { $_->[1] } sort { $a->[0] <=> $b->[0] } map { if (not ($st = stat($_))) { @@ -635,9 +616,7 @@ MAIN: { } [$st->mtime, $_] } - getfiles("$MAILDIR/new")); - - filter_mail(@msglist); + getfiles('.')); @SPAM and (exec('scan', '+SPAM', @SPAM) or die); } @@ -713,14 +692,15 @@ list such as dev@httpd.apache.org, this filter will create the folder name l/apache/httpd/dev. For an example B function, see -LE<047>pretzelnet.orgE<047>cvsE<047>dotfilesE<047>.mincspam> +L =head1 AUTHORS -Written by Eric Gillespie with logging code -stolen from Adam Lazur . +Written by Eric Gillespie . Design by Eric +Gillespie and Doug Porter . -Design by Eric Gillespie and Doug Porter . +This program is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. =cut