X-Git-Url: https://diplodocus.org/git/minc/blobdiff_plain/95a97f883e0e32b7e78b58ff11424fe8a4d4630e..9f49e6ebf2ac84d22bc78b0eea64d3adf1196b98:/minc diff --git a/minc b/minc index 8d8b6a3..f8d54dd 100755 --- a/minc +++ b/minc @@ -1,49 +1,65 @@ -#! /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 B<-d> + +B B<-r> =head1 DESCRIPTION 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. +running each message through regular expression based filter and hook +functions to determine in which folder to store it or whether it's +spam. Post-processing hooks may be applied to each message. + +As it processes each message, B prints a line for each message +similar to B and B. This line includes the folder +and message number in which the message was stored, the last 'From' +header, and the last 'Subject' header. These fields are truncated to +fit in the user's terminal (see COLUMNS in B below) in +the following proportions: folder (0.1), message number (0.0625), from +header (0.175). Any of these may be overridden with $SCAN_P_FOLDER, +$SCAN_P_MESSAGE, or $SCAN_P_FROM. The subject always fills out the +rest of the line. =cut use strict; use warnings; +$SIG{'PIPE'} = 'IGNORE'; + use Data::Dumper; use Errno; use Fcntl qw(O_WRONLY O_EXCL O_CREAT); use FileHandle; -use File::Basename; +use File::Temp qw(tempfile); use File::stat; -use Getopt::Std; -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; -# Autoflush STDOUT for the benefit of the status reporting in kill_spam(). -STDOUT->autoflush(1); +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 @@ -51,79 +67,59 @@ my $MAGIC_TO_TOKEN = ' TO'; =item B<-d> Dump (using Data::Dumper) the FILTERS list and exit. This is useful -for testing the syntax of .mincfilter. - -=item B<-f> - -Filter only, then exit. This is useful after running B. +for testing the syntax of .minc. =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 stdout/stderr as normal. -=item B<-p> +=item B<-r> -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. - -=item B<-s> - -Process SPAM only, then exit, leaving all non-spam messages in the -maildir. +Rebuild `mhpath +`/.folders from scratch, processing no mail. =back =cut -my $dumpfilters = 0; -my $filteronly = 0; -our $run = 1; -my $printfilenames = 0; -my $spamonly = 0; - -our $opt_d; -our $opt_f; -our $opt_h; -our $opt_n; -our $opt_p; -our $opt_s; # ;; # stupid cperl-mode - -if (not getopts('dfhnps')) { - exit(2); -} - -if ($opt_d) { - $dumpfilters = 1; -} elsif ($opt_h) { - print("Sorry bub, no help.\n"); - exit; -} elsif ($opt_n) { - $run = 0; -} +my $dumpfilters; +my $help; +my $maxmsgs; +my $norun; +my $rebuild_dot_folders; -if ($opt_p) { - $printfilenames = 1; -} +GetOptions( + 'd' => \$dumpfilters, + 'h|help' => \$help, + 'm=i' => \$maxmsgs, + 'n' => \$norun, + 'r' => \$rebuild_dot_folders, + ) or pod2usage(); +$help and pod2usage(-exitstatus=>0, -verbose=>1); +@ARGV == 0 or pod2usage(); -if ($opt_f) { - $filteronly = 1; -} elsif ($opt_s) { # ))){ # stupid cperl-mode - $spamonly = 1; -} +our $run = !$norun; =head1 ENVIRONMENT =over 4 +=item COLUMNS + +How many columns the user's terminal can hold, used to print scan +lines for each processed message. Defaults to 80. + =item HOME -Where configuration files (.mincfilter) are found. Also, +Where the configuration file (.minc) is found. Also, $HOME/Maildir is used for the maildir if MAILDIR is not set. =item MAILDIR @@ -134,7 +130,9 @@ Where mail is delivered. =cut -use Env qw(HOME MAILDIR); +use Env qw(COLUMNS HOME MAILDIR); + +$COLUMNS ||= 80; if (not $HOME) { die("HOME environment variable must be set.\n"); @@ -147,42 +145,21 @@ if (not $MAILDIR) { =over 4 -=item $HOME/.mincfilter - -This file is Perl code (included via the 'require' directive) which is -expected to define the FILTERS list. - -=item $HOME/.mincspam +=item $HOME/.minc -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. +This file is Perl code (included via the 'require' directive) which +may define the FILTERS list, @start_hooks, @filter_hooks, +@post_store_hooks, and @stop_hooks. -One of B's global variables is available to the user-defined -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. +=item `mhpath +`/.folders -XXX: need more details about the spam-handling process; for now read -the code. +B adds all folders it filters into to this file, which is used +by lukem's B (XXX need a link). =item `mhpath +`/logs/minc.log Where B logs what it does, unless in -n mode. -=item `mhpath +`/logs/dryrun.log - -Where B logs what it would do; used in -n mode. - =item `mhpath +`/.minc.context B uses this file for context (i.e. current folder) instead of @@ -199,27 +176,19 @@ 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; }"; -} +our (@start_hooks, @stop_hooks, @filter_hooks, @post_store_hooks); +our $SCAN_P_FOLDER = 0.1; +our $SCAN_P_MESSAGE = 0.0625; +our $SCAN_P_FROM = 0.175; +our @folder_sort_list = (qr/^inbox$/); +our $folder_sorter = sub { sort_by_list(@_, @folder_sort_list) }; my $mh; -my $logfile; $mh = `mhpath +`; chomp($mh); -if ($run) { - $logfile = $mh . '/logs/minc.log'; -} else { - $logfile = $mh . '/logs/dryrun.log'; -} +my $logfile = $mh . '/logs/minc.log'; $ENV{"MHCONTEXT"} = $mh . '/.minc.context'; @@ -227,29 +196,9 @@ $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; + $run or return; + my $timestamp = strftime('%b %e %H:%M:%S', localtime); my $msg; foreach my $part (@_) { @@ -259,21 +208,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; @@ -283,7 +224,7 @@ sub logincoming { $last = ''; } - mylog('info', INCOMINGCHAR, $text, $last); + mylog('<< ', $text, $last); } sub log_headers { @@ -291,36 +232,45 @@ 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'}}); } ############################################################################### # Utility procedures +sub sort_by_list { + my $a = shift; + my $b = shift; + + for my $i (@_) { + my $am = $a =~ $i; + my $bm = $b =~ $i; + if ($am) { + if ($bm) { + last; + } + return -1; + } elsif ($bm) { + return 1; + } + } + + return $a cmp $b; +} + 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): $!"); } } @@ -329,7 +279,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 @@ -338,24 +288,24 @@ 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) { - exit(0); + if (@result <= 2) { + return (); } + STDOUT->autoflush(1); + print(@result - 2, " messages..."); + closedir(DIR); return @result; } +my %msgnum_cache; sub get_highest_msgnum { my $mhfolder = shift; my $dir; @@ -363,16 +313,21 @@ sub get_highest_msgnum { my $highest; my $msgnum; + if (defined($msgnum_cache{$mhfolder})) { + return $msgnum_cache{$mhfolder}++; + } + $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); @@ -387,7 +342,71 @@ sub get_highest_msgnum { } } - return $highest; + $msgnum_cache{$mhfolder} = $highest; + return $msgnum_cache{$mhfolder}++; +} + +sub mark { + my $folder = shift; + my $msgnum = shift; + my $seq = shift; + my $fn = "$mh/$folder/.mh_sequences"; + my $fh; + my @sequences; + + if (not open($fh, $fn)) { + $!{ENOENT} or die("open($fn): $!"); + } else { + @sequences = <$fh>; + chomp(@sequences); + } + + my $marked = 0; + open($fh, '>', $fn) or die("open(>$fn): $!"); + for $_ (@sequences) { + if (/^$seq: (.*)/) { + my @parts; + my @result; + my $done = 0; + for my $part (split(' ', $1)) { + if (not $done) { + my ($st, $en) = split('-', $part); + if ((defined($en) and ($msgnum >= $st and $msgnum <= $en)) + or $msgnum == $st) { + # It's already there. + $done = 1; + } + if (defined($en)) { + if ($st - 1 == $msgnum) { + $part = "$msgnum-$en"; + $done = 1; + } elsif ($en + 1 == $msgnum) { + $part = "$st-$msgnum"; + $done = 1; + } + } else { + if ($part - 1 == $msgnum) { + $part = "$msgnum-$part"; + $done = 1; + } elsif ($part + 1 == $msgnum) { + $part = "$part-$msgnum"; + $done = 1; + } + } + } + push(@result, $part); + } + if (not $done) { + push(@result, $msgnum); + } + print($fh "$seq: ", join(' ', @result), "\n"); + $marked = 1; + } else { + print($fh "$_\n"); + } + } + $marked or print($fh "$seq: $msgnum\n"); + close($fh) or die("close(>$fn): $!"); } sub store_message { @@ -429,7 +448,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; @@ -450,29 +469,25 @@ sub store_message { #sleep(2); } - 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 # 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') { - $status = system('mark', "+$mhfolder", "$msgnum", '-sequence', - 'unseen', '-add'); - if (not WIFEXITED($status)) { - die("Failed to run mark"); - } elsif (WEXITSTATUS($status) != 0) { - die("Failed to mark message unseen."); - } + if ($mhfolder eq 'SPAM') { + push(@SPAM, $msgnum); + } else { + mark($mhfolder, $msgnum, 'unseen'); } } + + return $msgnum; } # Parse a message file into a structure describing the headers. The @@ -489,7 +504,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) { @@ -500,8 +515,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] .= $_; @@ -530,23 +545,20 @@ sub get_headers { sub find_mh_folder { my $msg = shift; - my %headers; + my %headers = @_; my $filterref; my @filter; my $header; my $contents; my $pair; - my $match; + my $regexp; my $expression; my $result; - %headers = get_headers($msg); if (not %headers) { return 'malformed'; } - log_headers(%headers); - # Walk the list of filters. This structure is documented in # pod at the end of the program. foreach $filterref (@FILTERS) { @@ -559,9 +571,11 @@ sub find_mh_folder { if ($header =~ /$MAGIC_TO_REGEX/i) { foreach $contents (@{$headers{lc($header)}}) { foreach $pair (@filter) { - ($match, $expression) = @$pair; - if ($contents =~ /$match/) { - return $expression; + ($regexp, $expression) = @$pair; + if ($contents =~ $regexp) { + if (eval "\$result = \"$expression\"") { + return $result; + } } } } @@ -575,10 +589,10 @@ sub find_mh_folder { # 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. + # Walk the filter's list of regexp/expression pairs. foreach $pair (@filter) { - ($match, $expression) = @$pair; - if ($contents =~ /$match/i) { + ($regexp, $expression) = @$pair; + if ($contents =~ $regexp) { if (eval "\$result = \"$expression\"") { return $result; } @@ -591,57 +605,189 @@ sub find_mh_folder { } sub filter_mail { - my @msglist = @_; - my $msgcount = scalar(@msglist); + @_ or return (); + my $msgcount = @_ - 2; # don't count . and .. + my $len = length($msgcount); my @baton; my $msg; my $mhfolder; my $spam = 0; my $saved = 0; - my %FOLDERS = ('SPAM'=>1); + my $msgnum; + my %folders; - @baton = spam_start_hook(); + if (-f "$HOME/.minc") { + require "$HOME/.minc"; + } - print("$msgcount messages..."); - foreach $msg (@msglist) { - if (spam_check($msg, @baton)) { - $mhfolder = 'SPAM'; - $spam = scalar(@SPAM)+ 1; + # XXX lame names + my $nf = int($COLUMNS * $SCAN_P_FOLDER); + my $nm = int($COLUMNS * $SCAN_P_MESSAGE); + my $nF = int($COLUMNS * $SCAN_P_FROM); + my $ns = $COLUMNS - $nf - $nm - $nF - 3; + + my %batons; + for my $hook (@start_hooks) { + my ($handle, @baton) = $hook->(); + if (defined($handle)) { + $batons{$handle} = [@baton]; + } + } + + for $msg (@_) { + ($msg eq '.' or $msg eq '..') and next; + + my %headers = get_headers($msg); + log_headers(%headers); + + undef($mhfolder); + for my $hook (@filter_hooks) { + my $result = $hook->(\%batons, \%headers, $msg); + defined($result) and ($mhfolder = $result); + } + + defined($mhfolder) or ($mhfolder = find_mh_folder($msg, %headers)); + + $msgnum = store_message($msg, $mhfolder); + $folders{$mhfolder}++; + + if ($mhfolder eq 'SPAM') { + $spam++; } else { - $mhfolder = find_mh_folder($msg); $saved++; + my $from = ''; + my $subject = ''; + # Sometimes these headers are missing... + eval { $from = [@{$headers{'from'}}]->[-1] }; + eval { $subject = [@{$headers{'subject'}}]->[-1] }; + for ($from, $subject) { + tr/\x00-\x1f\x80-\xff/ /; + } + printf("\r\%-${nf}s \%${nm}d \%-${nF}s \%s\n", + substr($mhfolder, 0, $nf), substr($msgnum, 0, $nm), + substr($from, 0, $nF), + substr($subject, 0, $ns)); } - store_message($msg, $mhfolder); - - print("\r"); - if (not $FOLDERS{$mhfolder}) { - print(' ' x length($msgcount)); - print(" \r+$mhfolder\n"); - $FOLDERS{$mhfolder} = 1; + for my $hook (@post_store_hooks) { + $hook->(\%batons, \%headers, $mhfolder, $msgnum); } - 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"); - spam_stop_hook(@baton); + for my $hook (@stop_hooks) { + $hook->(\%batons); + } + + return %folders; +} + +sub build_dot_folders { + my $folders = shift; + my $fh = shift; + my $fn; + + if (defined($fh)) { + while (<$fh>) { + chomp; + $folders->{$_}++; + } + } + + eval { ($fh, $fn) = tempfile("$mh/.folders.XXXXX") }; + if ($@) { + warn("$@"); + return; + } + + for my $folder (sort { $folder_sorter->($a,$b) } keys(%$folders)) { + print($fh "$folder\n"); + } + + if (not close($fh)) { + warn("close($fn): $!"); + unlink($fn) or warn("unlink($fn): $!"); + return; + } + + rename($fn, "$mh/.folders") or warn("rename($fn, $mh/.folders): $!"); +} + +sub create_dot_folders { + if (-f "$HOME/.minc") { + require "$HOME/.minc"; + } + + my %folders; + open(my $fh, '-|', 'folders', '-fast', '-recur') + or die("open(folders|): $!"); + build_dot_folders(\%folders, $fh); + return 0; +} + +sub update_dot_folders { + my $folders = shift; + my $fh; + + if (not open($fh, "$mh/.folders") and not $!{ENOENT}) { + # For ENOENT, we go ahead and create it, else we error and + # don't clobber it. + warn("open($mh/.folders): $!"); + return; + } + + build_dot_folders($folders, $fh); +} + +# XXX Could use some unification with getfiles... +sub maildir_spam { + my $dir = "$MAILDIR/spam"; + + if (not chdir($dir)) { + print(STDERR "skipping maildir spam: chdir($dir): $!\n"); + return; + } + + if (not opendir(DIR, '.')) { + print(STDERR "skipping maildir spam: opendir($dir): $!\n"); + return; + } + + $! = 0; + my @spams = readdir(DIR); + if ($! != 0) { + print(STDERR "skipping maildir spam: readdir($dir): $!\n"); + return; + } + + closedir(DIR); + + for my $msg (@spams) { + ($msg eq '.' or $msg eq '..') and next; + store_message($msg, 'SPAM'); + } } MAIN: { - my @msglist; my $st; if ($dumpfilters) { + require "$HOME/.minc"; $Data::Dumper::Indent = 1; print(Dumper(\@FILTERS)); exit; } - @msglist = ( - map { $_->[1] } + $rebuild_dot_folders and exit(create_dot_folders); + + chdir("$MAILDIR/new") or die("chdir($MAILDIR/new): $!"); + my %folders = filter_mail(map { $_->[1] } sort { $a->[0] <=> $b->[0] } map { if (not ($st = stat($_))) { @@ -649,9 +795,11 @@ MAIN: { } [$st->mtime, $_] } - getfiles("$MAILDIR/new")); + getfiles('.')); - filter_mail(@msglist); + $run and %folders and update_dot_folders(\%folders); + + maildir_spam(); @SPAM and (exec('scan', '+SPAM', @SPAM) or die); } @@ -661,14 +809,13 @@ __END__ =head1 THE FILTERS STRUCTURE -The user's .mincfilter file must define the @FILTERS structure. This -structure is an array. Each element of @FILTERS is a filter. A -filter is itself an array. The first element of a filter is a string, -the name of the header this filter acts upon. The header name is not -case-sensitive. Each subsequent element of a filter is a pair (i.e. a -two-element array): first, a regular expression B uses to -determine whether this filter matches or not, and second, an -expression which B evaluates to get the folder name. +Each element of @FILTERS is a filter. A filter is itself an array. +The first element of a filter is a string, the name of the header this +filter acts upon. The header name is not case-sensitive. Each +subsequent element of a filter is a pair (i.e. a two-element array): +first, a regular expression B uses to determine whether this +filter matches or not, and second, an expression which B +evaluates to get the folder name. B decides where to store a message by iterating over the @FILTERS array. It tests each regexp of each filter against all @@ -691,6 +838,31 @@ 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 HOOKS + +Filter hooks take a reference to a hash of batons, a reference to a +hash of headers, and the message filename as arguments. It returns +undef to decline filtering of this message (thus falling back to +subsequent filter hooks, and finally @FILTERS), or the name of the +folder to store this message into. + +One of B's global variables is available to the user-defined +hooks: $run. This boolean should be honored; hooks should only take +real action (i.e. removing or creating files, running external +programs, etc.) if $run is non-zero. + +The baton hash is created simply from the start hooks; if the hook +returns at least one defined value, this value is used as the key and +all other return values are put into a list reference as the value. +This hash is then passed by reference to all filter, post-store, and +stop hooks. + +Post store hooks take a reference to a hash of batons, a reference to +a hash of headers, the folder this message was stored in, and its new +message number. + +XXX: need more details about the hook process; for now read the code. + =head1 EXAMPLES @FILTERS = ( @@ -726,15 +898,15 @@ 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 B function, see -LE<047>pretzelnet.orgE<047>cvsE<047>dotfilesE<047>.mincspam> +XXX Need hook examples. =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