X-Git-Url: https://diplodocus.org/git/minc/blobdiff_plain/8f8233983028c468814a8d64d2811c192d3582b0..refs/heads/master:/minc diff --git a/minc b/minc index ae72ed5..224e56a 100755 --- a/minc +++ b/minc @@ -1,6 +1,4 @@ -#! /usr/bin/env perl - -# $Id$ +#!/usr/bin/perl =head1 NAME @@ -8,34 +6,44 @@ B - incorporate mail from a maildir into mh folders =head1 SYNOPSIS -B [B<-m> I] [B<-n>] [B<-p>] +B [B<-m> I] [B<-n>] B B<-d> -B B<-h> +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::Temp qw(tempfile); use File::stat; use Getopt::Long qw(:config gnu_getopt no_ignore_case); -use POSIX qw(strftime WEXITSTATUS WIFEXITED); use Pod::Usage; our $VERSION = 1; @@ -45,9 +53,11 @@ our $VERSION = 1; 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; +# Mapping of message numbers to array references. The first element is set by +# filter_mail to a reference to a header hash for the message; the second is +# set by maildier_spam to the name of the message file in the spam maildir. +# scan_spam scans this at the end so the user can check for false positives. +my %SPAM; =head1 OPTIONS @@ -56,7 +66,7 @@ my @SPAM; =item B<-d> Dump (using Data::Dumper) the FILTERS list and exit. This is useful -for testing the syntax of .mincfilter. +for testing the syntax of .minc. =item B<-h> @@ -71,11 +81,9 @@ Stop processing after I messages. 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. +Rebuild `mhpath +`/.folders from scratch, processing no mail. =back @@ -85,17 +93,19 @@ my $dumpfilters; my $help; my $maxmsgs; my $norun; -my $printfilenames; +my $rebuild_dot_folders; +if (!caller()) { GetOptions( 'd' => \$dumpfilters, 'h|help' => \$help, 'm=i' => \$maxmsgs, 'n' => \$norun, - 'p' => \$printfilenames, + 'r' => \$rebuild_dot_folders, ) or pod2usage(); $help and pod2usage(-exitstatus=>0, -verbose=>1); @ARGV == 0 or pod2usage(); +} our $run = !$norun; @@ -103,9 +113,14 @@ our $run = !$norun; =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 @@ -131,41 +146,16 @@ 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 - -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 -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. +=item $HOME/.minc -=item `mhpath +`/logs/minc.log +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. -Where B logs what it does, unless in -n mode. +=item `mhpath +`/.folders -=item `mhpath +`/logs/dryrun.log - -Where B logs what it would do; used in -n mode. +B adds all folders it filters into to this file, which is used +by lukem's B (XXX need a link). =item `mhpath +`/.minc.context @@ -184,69 +174,43 @@ marked unseen. our @FILTERS; 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'; -} - $ENV{"MHCONTEXT"} = $mh . '/.minc.context'; ############################################################################### -# Logging - -sub mylog { - my $timestamp = strftime('%b %e %H:%M:%S', localtime); - my $msg; - foreach my $part (@_) { - if (defined($part)) { - $msg .= $part; - } - } - # no newlines in the log message, thanks - $msg =~ s/\n/ /gm; - - open(LOG, ">>$logfile") or die("open(>>$logfile): $!"); - print(LOG "$timestamp $msg\n") or die("print(>>$logfile): $!"); - close(LOG) or die("close($logfile): $!"); -} +# Utility procedures -sub logheader { - my ($text, @contents) = @_; - my $last; +sub sort_by_list { + my $a = shift; + my $b = shift; - if (@contents) { - $last = $contents[-1]; - } else { - $last = ''; + for my $i (@_) { + my $am = $a =~ $i; + my $bm = $b =~ $i; + if ($am) { + if ($bm) { + last; + } + return -1; + } elsif ($bm) { + return 1; + } } - mylog('<< ', $text, $last); + return $a cmp $b; } -sub log_headers { - my %headers = @_; - - # For an explanation of the %headers structure, see the - # get_headers function below. - logheader('From: ', @{$headers{'return-path'}}); - logheader('To: ', @{$headers{'to'}}); - logheader('Subject: ', @{$headers{'subject'}}); - logheader('Message-Id: ', @{$headers{'message-id'}}); -} - - -############################################################################### -# Utility procedures - sub mkfolder { my $folder = shift; my $target; @@ -279,17 +243,22 @@ sub getfiles { } if (@result <= 2) { - exit(0); + return (); } STDOUT->autoflush(1); - print(@result - 2, " messages..."); + if (@result == 3) { + print('1 message...'); + } else { + print(@result - 2, ' messages...'); + } closedir(DIR); return @result; } +my %msgnum_cache; sub get_highest_msgnum { my $mhfolder = shift; my $dir; @@ -297,6 +266,10 @@ 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("opendir($dir): $!"); @@ -322,7 +295,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 { @@ -331,7 +368,6 @@ sub store_message { my $msgnum; my $try; my $mhmsg; - my $status; # We must do this even in -n mode because later steps fail without # it. This should be harmless. @@ -385,10 +421,6 @@ sub store_message { #sleep(2); } - if ($mhfolder ne 'SPAM') { - mylog('+', $mhfolder); - } - if ($run) { if (not rename($msg, $mhmsg)) { die("rename($msg, $mhmsg): $!"); @@ -398,18 +430,8 @@ sub store_message { # 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 eq 'SPAM') { - push(@SPAM, $msgnum); - } 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) { - die("Failed to mark message unseen."); - } + if ($mhfolder ne 'SPAM') { + mark($mhfolder, $msgnum, 'unseen'); } } @@ -462,7 +484,7 @@ sub get_headers { } close(MSG); - return %headers; + return \%headers; } @@ -471,66 +493,89 @@ sub get_headers { sub find_mh_folder { my $msg = shift; - my %headers = @_; - my $filterref; - my @filter; - my $header; - my $contents; - my $pair; - my $match; - my $expression; - my $result; - - if (not %headers) { + my $header = shift; + + if (not %$header) { return 'malformed'; } # Walk the list of filters. This structure is documented in # pod at the end of the program. - foreach $filterref (@FILTERS) { - @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. + for my $filterref (@FILTERS) { + if (ref($filterref) eq 'CODE') { + my $m = $filterref->($header, $msg); + $m && return $m; 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/i) { - if (eval "\$result = \"$expression\"") { - return $result; - } + my $m = match($header, @$filterref); + $m && return $m; + } + + return 'inbox'; +} + +# Test all the header fields against each [regexp, folder-expression] pair. +sub match { + my $header = shift; + my $filter_field = shift; + my @filters = @_; + + # Handle filters using the magic TO header specially. + if ($filter_field eq $MAGIC_TO_TOKEN) { + for my $field_name (keys(%$header)) { + if ($field_name =~ /$MAGIC_TO_REGEX/i) { + my $m = match_one_field($header->{$field_name}, \@filters); + $m && return $m; + } + } + # Now that it's been processed specially, skip normal handling. + return; + } + + # Walk the list of header fields matching the filter's specified header. + my $m = match_one_field($header->{lc($filter_field)}, \@filters); + $m && return $m; +} + +# Test all the values of one header field against each [regexp, +# folder-expression] pair. +sub match_one_field { + my $values = shift; + my $filters = shift; + for my $value (@$values) { + for my $pair (@$filters) { + my ($regexp, $expression) = @$pair; + if ($value =~ $regexp) { + my $result; + if (eval "\$result = \"$expression\"") { + return $result; } } } } +} - return 'inbox'; +sub scan_line { + my ($headers, $mhfolder, $msgnum, $nf, $nm, $nF, $ns) = @_; + my $from = ''; + my $subject = ''; + # Sometimes these headers are missing... + eval { $from = [@{$headers->{'from'}}]->[-1] }; + eval { $subject = [@{$headers->{'subject'}}]->[-1] }; + # Replace garbage characters. + for ($from, $subject) { + tr/\x00-\x1f\x80-\xff/?/; + } + return sprintf("\%-${nf}s \%${nm}d \%-${nF}s \%s", + substr($mhfolder, 0, $nf), substr($msgnum, 0, $nm), + substr($from, 0, $nF), + substr($subject, 0, $ns)); } sub filter_mail { - my @msglist = @_; - my $msgcount = @msglist - 2; # don't count . and .. + @_ or return (); + my $msgcount = @_ - 2; # don't count . and .. my $len = length($msgcount); my @baton; my $msg; @@ -538,18 +583,18 @@ sub filter_mail { my $spam = 0; my $saved = 0; my $msgnum; - my %FOLDERS = ('SPAM'=>1); - - # XXX lame names and hard-coded proportions. - my $nf = $COLUMNS * 0.1; - my $nm = $COLUMNS * 0.0625; - my $nF = $COLUMNS * 0.175; - my $ns = $COLUMNS - $nf - $nm - $nF - 3; + my %folders; if (-f "$HOME/.minc") { require "$HOME/.minc"; } + # 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->(); @@ -558,49 +603,49 @@ sub filter_mail { } } - foreach $msg (@msglist) { - ($msg eq '.' or $msg eq '..') and next; + my $tty = -t STDOUT; + if (not $tty) { + # Print a newline after the incomplete "N messages..." line. + print("\n"); + } - if ($printfilenames) { - print("$msg\n"); - } + for $msg (@_) { + ($msg eq '.' or $msg eq '..') and next; - my %headers = get_headers($msg); - log_headers(%headers); + my $headers = get_headers($msg); undef($mhfolder); for my $hook (@filter_hooks) { - my $result = $hook->(\%batons, \%headers, $msg); + my $result = $hook->(\%batons, $headers, $msg); defined($result) and ($mhfolder = $result); } - defined($mhfolder) or ($mhfolder = find_mh_folder($msg, %headers)); + defined($mhfolder) or ($mhfolder = find_mh_folder($msg, $headers)); $msgnum = store_message($msg, $mhfolder); + $folders{$mhfolder}++; + + if ($tty) { + print("\r"); + } if ($mhfolder eq 'SPAM') { $spam++; + $SPAM{$msgnum} = [$headers, undef]; } else { $saved++; - my $from = [@{$headers{'from'}}]->[-1]; - my $subject = [@{$headers{'subject'}}]->[-1]; - $from =~ s/[[:cntrl:]]/?/g; - print("\r"); - print(' ' x $COLUMNS); - printf("\r\%-${nf}s \%${nm}d \%-${nF}s \%s\n", - substr($mhfolder, 0, $nf), substr($msgnum, 0, $nm), - # XXX shouldn't pop, as these are about to be - # passed to post_store_hooks - substr($from, 0, $nF), - substr($subject, 0, $ns)); + print(scan_line($headers, $mhfolder, $msgnum, $nf, $nm, $nF, $ns), + "\n"); } for my $hook (@post_store_hooks) { - $hook->(\%batons, \%headers, $mhfolder, $msgnum); + $hook->(\%batons, $headers, $mhfolder, $msgnum); } - printf(" \%${len}d SPAM \%${len}d saved \%${len}d/%1d", - $spam, $saved, $spam + $saved, $msgcount); + if ($tty) { + printf(" \%${len}d SPAM \%${len}d saved \%${len}d/%1d", + $spam, $saved, $spam + $saved, $msgcount); + } defined($maxmsgs) and ($spam + $saved < $maxmsgs or last); } @@ -609,10 +654,141 @@ sub filter_mail { 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/new"; + + if (not chdir($dir)) { + $!{ENOENT} or 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; + my $msgnum = store_message($msg, 'SPAM'); + # Store the original file name for scan_spam in -n mode. + $SPAM{$msgnum} = [undef, $msg]; + } +} + +sub scan_spam { + my ($msgnum, $header, $tuple, $msg); + + # Unlike filter_mail, we don't need to print the folder name. + # Calculate how many columns would be allocated to it... + my $nf = int($COLUMNS * $SCAN_P_FOLDER); + # ...and add that amount to COLUMNS to calculate the number of columns to + # allocate to msgnum and from snippet, thus filling the line without + # printing the folder name. + my $nm = int(($COLUMNS + $nf) * $SCAN_P_MESSAGE); + my $nF = int(($COLUMNS + $nf) * $SCAN_P_FROM); + my $ns = $COLUMNS - $nm - $nF - 3; + + for $msgnum (sort(keys(%SPAM))) { + $tuple = $SPAM{$msgnum}; + if (defined($tuple->[0])) { + # Filed by filter_mail, so we have the header. + $header = $tuple->[0]; + } elsif (defined($tuple->[1])) { + # Filed by maildir_spam, so we don't have the header. + if ($run) { + # The message has been filed, load it from $mh. + $msg = "$mh/SPAM/$msgnum"; + } else { + # The message has not been filed, load it from the maildir. + # $tuple->[1] is just a basename, not a path; this works + # because maildir_spam did chdir(Maildir/spam/new). + $msg = $tuple->[1]; + } + $header = get_headers($msg); + } else { + print(STDERR + "BUG: corrupt SPAM tuple, neither element defined", + " for message $msgnum\n"); + next; + } + print(scan_line($header, '', $msgnum, 0, $nm, $nF, $ns), + "\n"); + } } -MAIN: { +if (!caller()) { my $st; if ($dumpfilters) { @@ -622,8 +798,10 @@ MAIN: { exit; } + $rebuild_dot_folders and exit(create_dot_folders); + chdir("$MAILDIR/new") or die("chdir($MAILDIR/new): $!"); - filter_mail(map { $_->[1] } + my %folders = filter_mail(map { $_->[1] } sort { $a->[0] <=> $b->[0] } map { if (not ($st = stat($_))) { @@ -633,22 +811,26 @@ MAIN: { } getfiles('.')); - @SPAM and (exec('scan', '+SPAM', @SPAM) or die); + $run and %folders and update_dot_folders(\%folders); + + maildir_spam(); + scan_spam(); } +1; + __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 @@ -671,6 +853,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 = ( @@ -706,8 +913,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 B function, see -L +XXX Need hook examples. =head1 AUTHORS