X-Git-Url: https://diplodocus.org/git/minc/blobdiff_plain/f520c82f15ffe0017aacbfba63af1e038162fefa..c89632e9aa7ee73fe13020fe666f8f3563edf95c:/minc diff --git a/minc b/minc index a143457..a8eb94f 100755 --- a/minc +++ b/minc @@ -8,15 +8,14 @@ B - Incorporate mail from a maildir into mh folders. =head1 SYNOPSIS -B [-B] +B [-B] =head1 DESCRIPTION -B is a program for incorporating mail from a maildir to a mh -folder hierarchy. It takes mail from a maildir folder (not a maildir -folder hierarchy), optionally checks for spam with a user-defined -spam-checking function, and optionally filters mail into separate mh -folders. +B incorporates mail from a maildir to a mh folder hierarchy. It +takes mail from a maildir folder (not a maildir folder hierarchy), +optionally checks for spam with a user-defined spam-checking function, +and optionally filters mail into separate mh folders. The filtering is quite sophisticated, as it is done using real Perl matching (m//) commands. @@ -26,17 +25,27 @@ matching (m//) commands. use strict; use warnings; -require 'sysexits.ph'; - use Data::Dumper; use Errno; use Fcntl qw(O_WRONLY O_EXCL O_CREAT); -use File::Basename; -use Getopt::Std; +use FileHandle; +use File::stat; +use Getopt::Std; $Getopt::Std::STANDARD_HELP_VERSION = 1; use Log::Dispatch; use Log::Dispatch::File; use POSIX qw(strftime WEXITSTATUS WIFEXITED); +our $VERSION = 1; + +# If a filter set's header is $MAGIC_TO_TOKEN, that set is compared +# against headers matching this regex (taken from procmail). +my $MAGIC_TO_REGEX = '^((Original-)?(Resent-)?(To|Cc|Bcc)|(X-Envelope |Apparently(-Resent)?)-To)'; +my $MAGIC_TO_TOKEN = ' TO'; + +# List of SPAM message numbers, scanned at the end so the user can +# check for false positives. +my @SPAM; + =head1 OPTIONS =over 4 @@ -46,56 +55,52 @@ use POSIX qw(strftime WEXITSTATUS WIFEXITED); Dump (using Data::Dumper) the FILTERS list and exit. This is useful for testing the syntax of .mincfilter. -=item B<-f> +=item B<--help> -Filter only, then exit. This is useful after running B. +Show help. -=item B<-h> +=item B<-m> I -Show help. +Stop processing after I messages. =item B<-n> Dry run; do not actually incorporate the mail, but log and report to stdout/stderr as normal. -=item B<-s> +=item B<-p> -Process SPAM only, then exit, leaving all non-spam messages in the -maildir. +Print the filename of each message before checking it for spam. This +can be handy if a particular message is giving the spam checker a +problem. =back =cut my $dumpfilters = 0; -my $filteronly = 0; +my $maxmsgs; our $run = 1; -my $spamonly = 0; +my $printfilenames = 0; -our $opt_d; -our $opt_f; -our $opt_h; -our $opt_n; -our $opt_s; # ;; # stupid cperl-mode +my %opts; -if (not getopts('dfhns')) { - exit(&EX_USAGE); +if (not getopts('dm:np', \%opts)) { + exit(2); } -if ($opt_d) { +if ($opts{'d'}) { $dumpfilters = 1; -} elsif ($opt_h) { - print("Sorry bub, no help.\n"); - exit(&EX_OK); -} elsif ($opt_n) { +} elsif ($opts{'n'}) { $run = 0; } -if ($opt_f) { - $filteronly = 1; -} elsif ($opt_s) { # ))){ # stupid cperl-mode - $spamonly = 1; +if (defined($opts{'m'})) { + $maxmsgs = $opts{'m'}; +} + +if ($opts{'p'}) { + $printfilenames = 1; } =head1 ENVIRONMENT @@ -135,16 +140,23 @@ expected to define the FILTERS list. =item $HOME/.mincspam -If this file exists, B will include it with the expectation that it -will define a B function. This function takes a message -filename as an argument and returns 1 if the message is spam, else 0. -If this file does not exist, B will define a simple function that -always returns 0. +If this file exists, B will include it with the expectation that +it will define a B function. This function takes a +message filename as an argument and returns 1 if the message is spam, +else 0. If this file does not exist, B will define a simple +function that always returns 0. One of B's global variables is available to the user-defined -is_spam function: $run. This boolean should be honored; is_spam -should only take real action (i.e. removing or creating files, running -external programs, etc.) if $run is non-zero. +B function: $run. This boolean should be honored; +B should only take real action (i.e. removing or creating +files, running external programs, etc.) if $run is non-zero. + +This file may also declare two other functions: B and +B. The former is passed no arguments and is expected +to return a list. This list is a "baton" that will also be passed to +B and B. It can hold anything +B will need to do its job, whether network sockets, pipes, +or whatever. XXX: need more details about the spam-handling process; for now read the code. @@ -173,14 +185,14 @@ marked unseen. =cut our @FILTERS; -require "$HOME/.mincfilter2"; +require "$HOME/.mincfilter"; if (-f "$HOME/.mincspam") { require "$HOME/.mincspam"; } else { - sub is_spam { - return 0; - } + eval "sub spam_start_hook { return (); }"; + eval "sub spam_stop_hook { }"; + eval "sub spam_check { return 0; }"; } my $mh; @@ -241,57 +253,40 @@ sub mylog { } } -sub logincoming { mylog('info', INCOMINGCHAR, @_); } 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 { + my ($text, @contents) = @_; + my $last; + + if (@contents) { + $last = $contents[-1]; + } else { + $last = ''; + } + + mylog('info', INCOMINGCHAR, $text, $last); +} + sub log_headers { my %headers = @_; # For an explanation of the %headers structure, see the # get_headers function below. - logincoming('From: ', @{$headers{'return-path'}}[-1]); - logincoming('To: ', @{$headers{'to'}}[-1]); - logincoming('Subject: ', @{$headers{'subject'}}[-1]); - logincoming('Message-Id: ', @{$headers{'message-id'}}[-1]); + logincoming('From: ', @{$headers{'return-path'}}); + logincoming('To: ', @{$headers{'to'}}); + logincoming('Subject: ', @{$headers{'subject'}}); + logincoming('Message-Id: ', @{$headers{'message-id'}}); } ############################################################################### # Utility procedures -sub _errprint { - printf(STDERR '%s:%s', __FILE__, __LINE__); - - if (@_) { - print(STDERR ': '); - foreach (@_) { - print(STDERR); - } - } -} - -sub err { - my $ex = shift; - - _errprint(@_); - print(STDERR ": $!\n"); - - exit($ex); -} - -sub errx { - my $ex = shift; - - _errprint(@_); - print(STDERR "\n"); - - exit($ex); -} - sub mkfolder { my $mhfolder = shift; my $folder; @@ -308,8 +303,7 @@ sub mkfolder { if (-d $target or mkdir($target)) { next; } else { - err(&EX_OSERR, - "Failed to create +$mhfolder ($component)"); + die("Failed to create +$mhfolder ($component)"); } } } @@ -321,7 +315,7 @@ sub getfiles { my @result; if (not opendir(DIR, $dir)) { - err(&EX_OSERR, "Failed opendir($dir)"); + die("Failed opendir($dir)"); } # Initialize $! to 0 (success) because stupid stupid Perl provides @@ -336,7 +330,11 @@ sub getfiles { } readdir(DIR); if ($! != 0) { - err(&EX_OSERR, "Failed readdir($dir)"); + die("Failed readdir($dir)"); + } + + if (scalar(@result) == 0) { + exit(0); } closedir(DIR); @@ -353,14 +351,14 @@ sub get_highest_msgnum { $dir = "$mh/$mhfolder"; if (not opendir(DIR, $dir)) { - err(&EX_OSERR, "Failed opendir($dir)"); + die("Failed opendir($dir)"); } $! = 0; @list = readdir(DIR); if ($! != 0) { - err(&EX_OSERR, "Failed readdir($dir)"); + die("Failed readdir($dir)"); } closedir(DIR); @@ -378,12 +376,6 @@ sub get_highest_msgnum { return $highest; } -# We want to print the name of each list that has new mail only once, -# so use this hash to store the lists that have already been printed. -# Start the list out with SPAM already in it, since we don't care when -# new messages are added to it. -my %FOLDERS = ('SPAM'=>1); - sub store_message { my $msg = shift; my $mhfolder = shift; @@ -411,6 +403,17 @@ sub store_message { # So attempt to create a file with this name. If it # succeeds, in just a bit here we'll knowingly clobber # this file with the rename(2) call. + + # Another way to do this is not to use rename(2), but + # use link(2) + unlink(2) instead. That's how the + # standard maildir algorithm does it. Each method has + # a disadvantage: the program may crash between the + # link(2) and unlink(2) calls. With the standard + # maildir algorithm, that means the message will end + # up duplicated. The advantage of creating an empty + # file followed by rename(2) is that an extra empty + # file is left behind as opposed to a duplicate + # message. This is more easily detected by the user. if ($run) { if (sysopen(MSG, "$mhmsg", O_WRONLY | O_EXCL | O_CREAT, 0600)) { @@ -426,39 +429,40 @@ sub store_message { # This algorithm is different from the maildir one; let's make # 10 tries instead of 3. if ($try == 9) { - errx(&EX_TEMPFAIL, "Attempted filename $mhmsg exists."); + die("Attempted filename $mhmsg exists."); } # This algorithm is different; i don't think we need to sleep. #sleep(2); } - logsave("+$mhfolder"); + if ($mhfolder ne 'SPAM') { + logsave("+$mhfolder"); + } if ($run) { if (not rename($msg, $mhmsg)) { - err(&EX_OSERR, "Failed rename($msg, $mhmsg)"); + die("Failed rename($msg, $mhmsg)"); } # Mark each message as soon as we store it and bomb if that # fails. While it is slow, it is not safe to store multiple # messages and then have a failure before marking some (or # all). - if ($mhfolder ne 'SPAM') { + if ($mhfolder eq 'SPAM') { + push(@SPAM, $msgnum); + } else { $status = system('mark', "+$mhfolder", "$msgnum", '-sequence', 'unseen', '-add'); if (not WIFEXITED($status)) { - err(&EX_OSERR, "Failed to run mark"); + die("Failed to run mark"); } elsif (WEXITSTATUS($status) != 0) { - errx(&EX_SOFTWARE, "Failed to mark message unseen."); + die("Failed to mark message unseen."); } } } - if (not $FOLDERS{$mhfolder}) { - print("+$mhfolder\n"); - $FOLDERS{$mhfolder} = 1; - } + return $msgnum; } # Parse a message file into a structure describing the headers. The @@ -510,33 +514,6 @@ sub get_headers { return %headers; } -############################################################################### -# Spam handling - -sub kill_spam { - my @msglist = @_; - my @result; - my $msg; - my $i; - - @result = (); - - $i = 0; - foreach $msg (@msglist) { - printf('%sChecking for spam... %6d/%d', - "\r", ++$i, scalar(@msglist)); - if (is_spam($msg)) { - print(" SPAM\n"); - store_message($msg, 'SPAM'); - } else { - push(@result, $msg); - } - } - print("\nDone: ", scalar(@result), " survivors\n"); - - return @result; -} - ############################################################################### # Filtering @@ -566,13 +543,32 @@ sub find_mh_folder { @filter = @$filterref; $header = shift(@filter); + # Handle filters using the magic TO header specially. + if ($header eq $MAGIC_TO_TOKEN) { + foreach $header (keys(%headers)) { + if ($header =~ /$MAGIC_TO_REGEX/i) { + foreach $contents (@{$headers{lc($header)}}) { + foreach $pair (@filter) { + ($match, $expression) = @$pair; + if ($contents =~ /$match/) { + return $expression; + } + } + } + } + } + + # Now that it's been processed specially, skip normal handling. + next; + } + # Walk the list of message headers matching the filter's # specified header. foreach $contents (@{$headers{lc($header)}}) { # Walk the filter's list of match/expression pairs. foreach $pair (@filter) { ($match, $expression) = @$pair; - if ($contents =~ /$match/) { + if ($contents =~ /$match/i) { if (eval "\$result = \"$expression\"") { return $result; } @@ -586,34 +582,72 @@ sub find_mh_folder { sub filter_mail { my @msglist = @_; + my $msgcount = scalar(@msglist); + my $msgcountlen = length($msgcount); + my @baton; my $msg; my $mhfolder; + my $spam = 0; + my $saved = 0; + my %FOLDERS = ('SPAM'=>1); + + @baton = spam_start_hook(); + STDOUT->autoflush(1); + print("$msgcount messages..."); foreach $msg (@msglist) { - $mhfolder = find_mh_folder($msg); + if (spam_check($msg, @baton)) { + $mhfolder = 'SPAM'; + $spam = scalar(@SPAM)+ 1; + } else { + $mhfolder = find_mh_folder($msg); + $saved++; + } + store_message($msg, $mhfolder); + + print("\r"); + if (not $FOLDERS{$mhfolder}) { + print(' ' x $msgcountlen); + print(" \r+$mhfolder\n"); + $FOLDERS{$mhfolder} = 1; + } + + printf('%6d SPAM %6d saved %6d/%1d', + $spam, $saved, $spam + $saved, $msgcount); + + defined($maxmsgs) and ($spam + $saved < $maxmsgs or last); } + print("\n"); + + spam_stop_hook(@baton); } MAIN: { my @msglist; + my $st; if ($dumpfilters) { $Data::Dumper::Indent = 1; print(Dumper(\@FILTERS)); - exit(&EX_OK); + exit; } - @msglist = getfiles("$MAILDIR/new"); + @msglist = ( + map { $_->[1] } + sort { $a->[0] <=> $b->[0] } + map { + if (not ($st = stat($_))) { + die("stat($_): $!"); + } + [$st->mtime, $_] + } + getfiles("$MAILDIR/new")); - if (not $filteronly) { - @msglist = kill_spam(@msglist); - } + filter_mail(@msglist); - if (not $spamonly) { - filter_mail(@msglist); - } + @SPAM and (exec('scan', '+SPAM', @SPAM) or die); } @@ -646,6 +680,11 @@ are traversed I. This means the filters can be arranged so that some have priority over others. XXX: get Doug to write an example of having the same header matched more than once. +Lastly, B supports a magic ' TO' header. Filters using this +header are matched against a collection of headers related to (and +including) the To. Which headers to use is determined by a regular +expression borrowed from procmail. + =head1 EXAMPLES @FILTERS = ( @@ -681,7 +720,7 @@ apache.org subdomain, with mailing lists hosted there. So, given a list such as dev@httpd.apache.org, this filter will create the folder name l/apache/httpd/dev. -For an example is_spam function, see +For an example B function, see LE<047>pretzelnet.orgE<047>cvsE<047>dotfilesE<047>.mincspam> =head1 AUTHORS @@ -691,6 +730,9 @@ stolen from Adam Lazur . 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 # Local variables: