]>
diplodocus.org Git - minc/blob - minc
c0688d691865534c54097eab7e00d3417eb14c33
5 B<minc> - incorporate mail from a maildir into mh folders
9 B<minc> [B<-m> I<MAX>] [B<-n>]
17 B<minc> incorporates mail from a maildir to a mh folder hierarchy. It
18 takes mail from a maildir folder (not a maildir folder hierarchy),
19 running each message through regular expression based filter and hook
20 functions to determine in which folder to store it or whether it's
21 spam. Post-processing hooks may be applied to each message.
23 As it processes each message, B<minc> prints a line for each message
24 similar to B<inc(1)> and B<scan(1)>. This line includes the folder
25 and message number in which the message was stored, the last 'From'
26 header, and the last 'Subject' header. These fields are truncated to
27 fit in the user's terminal (see COLUMNS in B<ENVIRONMENT> below) in
28 the following proportions: folder (0.1), message number (0.0625), from
29 header (0.175). Any of these may be overridden with $SCAN_P_FOLDER,
30 $SCAN_P_MESSAGE, or $SCAN_P_FROM. The subject always fills out the
38 $SIG{'PIPE'} = 'IGNORE';
45 use File
::Temp
qw(tempfile);
47 use Getopt
::Long
qw(:config gnu_getopt no_ignore_case);
48 use POSIX
qw(WIFEXITED WEXITSTATUS WIFSIGNALED WTERMSIG);
51 use constant LOCK_TRIES
=> 60;
55 # If a filter set's header is $MAGIC_TO_TOKEN, that set is compared
56 # against headers matching this regex (taken from procmail).
57 my $MAGIC_TO_REGEX = '^((Original-)?(Resent-)?(To|Cc|Bcc)|(X-Envelope |Apparently(-Resent)?)-To)';
58 my $MAGIC_TO_TOKEN = ' TO';
60 # Mapping of message numbers to array references. The first element is set by
61 # filter_mail to a reference to a header hash for the message; the second is
62 # set by maildier_spam to the name of the message file in the spam maildir.
63 # scan_spam scans this at the end so the user can check for false positives.
72 Dump (using Data::Dumper) the FILTERS list and exit. This is useful
73 for testing the syntax of .minc.
81 Stop processing after I<MAX> messages.
85 Dry run; do not actually incorporate the mail, but log and report to
86 stdout/stderr as normal.
90 Rebuild `mhpath +`/.folders from scratch, processing no mail.
100 my $rebuild_dot_folders;
104 'd' => \
$dumpfilters,
108 'r' => \
$rebuild_dot_folders,
110 $help and pod2usage
(-exitstatus
=>0, -verbose
=>1);
121 How many columns the user's terminal can hold, used to print scan
122 lines for each processed message. Defaults to 80.
126 Where the configuration file (.minc) is found. Also,
127 $HOME/Maildir is used for the maildir if MAILDIR is not set.
131 Where mail is delivered.
137 use Env
qw(COLUMNS HOME MAILDIR);
142 die("HOME environment variable must be set.\n");
151 This file is Perl code (included via the 'require' directive) which
152 may define the FILTERS list, @start_hooks, @filter_hooks,
153 @post_store_hooks, and @stop_hooks.
155 =item `mhpath +`/.folders
157 B<minc> adds all folders it filters into to this file, which is used
158 by lukem's B<new(1)> (XXX need a link).
160 =item `mhpath +`/.minc.context
162 B<minc> uses this file for context (i.e. current folder) instead of
163 `mhpath +`/context. This allows you some amount of freedom to use mh
164 while B<minc> is running. For example, you can changed folders without
165 causing a message to be stored in the wrong folder. Care must still
166 be taken, however, about the unseen sequence; if you change it
167 (whether via show, or mark, or anything else) while in the same folder
168 as B<minc>, it is likely the new message B<minc> stores will not end up
176 our (@start_hooks, @stop_hooks, @filter_hooks, @post_store_hooks);
177 our $SCAN_P_FOLDER = 0.1;
178 our $SCAN_P_MESSAGE = 0.0625;
179 our $SCAN_P_FROM = 0.175;
180 our @folder_sort_list = (qr/^inbox$/);
181 our $folder_sorter = sub { sort_by_list
(@_, @folder_sort_list) };
185 $mh = `mhpath +`; $? >= 0 or die;
188 die('mhpath did not give MH mail path: ' . exit_msg
($?));
191 $ENV{"MHCONTEXT"} = $mh . '/.minc.context';
193 # TODO: Support dot-locking too. This works on FreeBSD and Linux.
194 my $locking = `mhparam datalocking`;
196 $? == 0 || die('mhparam datalocking: ' . exit_msg
($?));
198 if ($locking ne 'fcntl') {
199 die("mh locking $locking not supported; only fcntl");
203 ###############################################################################
208 WIFEXITED
($status) && return 'exited with status ' . WEXITSTATUS
($status);
209 WIFSIGNALED
($status) && return 'killed with signal ' . WTERMSIG
($status);
240 foreach $component (split('/', $folder)) {
241 $target = join('/', $target, $component);
242 -d
$target or mkdir($target) or die("mkdir($target): $!");
250 if (not opendir(DIR
, $dir)) {
251 die("opendir($dir): $!");
254 # Initialize $! to 0 (success) because stupid stupid Perl provides
255 # no way to distinguish an error from an empty directory; that
256 # means setting $! to 0 and testing it afterwards is the only way
257 # to detect an error. Real Programmers don't handle errors,
260 @result = readdir(DIR
);
262 die("readdir($dir): $!");
269 STDOUT-
>autoflush(1);
271 print('1 message...');
273 print(@result - 2, ' messages...');
282 sub get_highest_msgnum
{
283 my $mhfolder = shift;
289 if (defined($msgnum_cache{$mhfolder})) {
290 return $msgnum_cache{$mhfolder}++;
293 $dir = "$mh/$mhfolder";
294 if (not opendir(DIR
, $dir)) {
295 die("opendir($dir): $!");
298 # Insert rant from getfiles here.
300 @list = readdir(DIR
);
303 die("readdir($dir): $!");
309 foreach $msgnum (@list) {
311 if ($msgnum =~ /^[0-9]+$/) {
312 if ($msgnum > $highest) {
318 $msgnum_cache{$mhfolder} = $highest;
319 return $msgnum_cache{$mhfolder}++;
327 my $fn = "$mh/$folder/.mh_sequences";
328 my ($fh, $e) = lkopen_fcntl
($fn, O_RDWR
| O_CREAT
, 0600);
330 my @sequences = <$fh>;
333 seek($fh, 0, SEEK_SET
) or die("seek($fn): $!");
334 truncate($fh, 0) or die("truncate($fn): $!");
337 for $_ (@sequences) {
342 for my $part (split(' ', $1)) {
344 my ($st, $en) = split('-', $part);
345 if ((defined($en) and ($msgnum >= $st and $msgnum <= $en))
347 # It's already there.
351 if ($st - 1 == $msgnum) {
352 $part = "$msgnum-$en";
354 } elsif ($en + 1 == $msgnum) {
355 $part = "$st-$msgnum";
359 if ($part - 1 == $msgnum) {
360 $part = "$msgnum-$part";
362 } elsif ($part + 1 == $msgnum) {
363 $part = "$part-$msgnum";
368 push(@result, $part);
371 push(@result, $msgnum);
373 print($fh "$seq: ", join(' ', @result), "\n");
379 $marked or print($fh "$seq: $msgnum\n");
380 close($fh) or die("close(>$fn): $!");
383 # Based on nmh's lkopen_fcntl
384 # Return 0 for success, errno on failure.
391 # The assumption here is that if you open the file for writing, you
392 # need an exclusive lock.
394 my $tries = LOCK_TRIES
;
396 sysopen(my $fh, $fn, $access, $mode) or die("sysopen($fn): $!");
398 my $flk = File
::FcntlLock-
>new;
401 $flk->l_type(($access & O_ACCMODE
) == O_RDONLY
? F_RDLCK
: F_WRLCK
);
402 $flk->l_whence(SEEK_SET
);
404 # Really should only retry on EAGAIN and EINTR...
405 if ($flk->lock($fh, F_SETLK
)) {
409 $errno = $flk->lock_errno;
410 close($fh) or die("close($fn): $!");
419 die("failed to lock $fn: $!");
425 my $src_msgpath = shift;
426 my $mhfolder = shift;
427 my ($dst_msgnum, $dst_msgpath);
429 # We must do this even in -n mode because later steps fail without
430 # it. This should be harmless.
433 if ("+$mhfolder" eq $inbox) {
434 # If @filtered is empty, this message already has the right number.
435 if (!($dst_msgpath = shift(@filtered))) {
436 $src_msgpath =~ m
|.*/(\d
+)$|;
439 $dst_msgpath =~ m
|.*/(\d
+)$|;
442 # This loop is a modified version of the maildir delivery algorithm.
443 $dst_msgnum = get_highest_msgnum
($mhfolder);
445 for ($try = 0; ; $try++) {
447 $dst_msgpath = "$mh/$mhfolder/$dst_msgnum";
449 if (not stat($dst_msgpath)) {
451 # Now we have a non-existent file, let's try to create
452 # it. We must create a zero-byte file first because a
453 # file my appear between our happy stat results and
454 # our later rename(2), which would clobber said file.
455 # So attempt to create a file with this name. If it
456 # succeeds, in just a bit here we'll knowingly clobber
457 # this file with the rename(2) call.
459 # Another way to do this is not to use rename(2), but
460 # use link(2) + unlink(2) instead. That's how the
461 # standard maildir algorithm does it. Each method has
462 # a disadvantage: the program may crash between the
463 # link(2) and unlink(2) calls. With the standard
464 # maildir algorithm, that means the message will end
465 # up duplicated. The advantage of creating an empty
466 # file followed by rename(2) is that an extra empty
467 # file is left behind as opposed to a duplicate
468 # message. This is more easily detected by the user.
470 if (sysopen(MSG
, $dst_msgpath,
471 O_WRONLY
| O_EXCL
| O_CREAT
, 0600)) {
481 # This algorithm is different from the maildir one; let's make
482 # 10 tries instead of 3.
484 die("Attempted filename $dst_msgpath exists.");
487 # This algorithm is different; i don't think we need to sleep.
492 # Mark each message as soon as we store it and bomb if that
493 # fails. While it is slow, it is not safe to store multiple
494 # messages and then have a failure before marking some (or
496 if ($mhfolder ne 'SPAM') {
497 mark
($mhfolder, $dst_msgnum, 'unseen');
501 push(@filtered, $src_msgpath);
504 if (not rename($src_msgpath, $dst_msgpath)) {
505 die("rename($src_msgpath, $dst_msgpath): $!");
512 # Parse a message file into a structure describing the headers. The
513 # structure is a hash of arrays. The hash keys are the names of the
514 # headers found in the message, made all lower-case. Each item in
515 # the hash is an array of header text. The array has one element
516 # per occurrence of the header. Most headers will only have a single
517 # element because they occur only once. The Received header is the
518 # most common header with multiple texts.
522 my $current; # current header, used for unfolding lines
523 my $fieldname; # unmolested header name
524 my $contents; # contents of header
526 open(MSG
, $msg) or die("open(MSG, $msg): $!");
534 # folded header continuation
536 if (not defined($current)) {
537 warn('Malformed message, cannot parse headers.');
541 @{$headers{$current}}[-1] .= $_;
543 ($fieldname) = split(/:/);
544 $current = lc($fieldname);
545 (undef, $contents) = split(/^\Q$fieldname\E:\s*/);
547 if (defined($headers{$current})) {
548 # multiple occurence of same header
549 push(@{$headers{$current}}, $contents);
551 # first occurence of a header
552 $headers{$current} = [$contents];
562 ###############################################################################
573 # Walk the list of filters. This structure is documented in
574 # pod at the end of the program.
575 for my $filterref (@FILTERS) {
576 if (ref($filterref) eq 'CODE') {
577 my $m = $filterref->($header, $msg);
582 my $m = match
($header, @$filterref);
589 # Test all the header fields against each [regexp, folder-expression] pair.
592 my $filter_field = shift;
595 # Handle filters using the magic TO header specially.
596 if ($filter_field eq $MAGIC_TO_TOKEN) {
597 for my $field_name (keys(%$header)) {
598 if ($field_name =~ /$MAGIC_TO_REGEX/i) {
599 my $m = match_one_field
($header->{$field_name}, \
@filters);
603 # Now that it's been processed specially, skip normal handling.
607 # Walk the list of header fields matching the filter's specified header.
608 my $m = match_one_field
($header->{lc($filter_field)}, \
@filters);
612 # Test all the values of one header field against each [regexp,
613 # folder-expression] pair.
614 sub match_one_field
{
617 for my $value (@$values) {
618 for my $pair (@$filters) {
619 my ($regexp, $expression) = @$pair;
620 if ($value =~ $regexp) {
622 if (eval "\$result = \"$expression\"") {
631 my ($headers, $mhfolder, $msgnum, $nf, $nm, $nF, $ns) = @_;
634 # Sometimes these headers are missing...
635 eval { $from = [@{$headers->{'from'}}]->[-1] };
636 eval { $subject = [@{$headers->{'subject'}}]->[-1] };
637 # Replace garbage characters.
638 for ($from, $subject) {
639 tr/\x00-\x1f\x80-\xff/?/;
641 return sprintf("\%-${nf}s \%${nm}d \%-${nF}s \%s",
642 substr($mhfolder, 0, $nf), substr($msgnum, 0, $nm),
643 substr($from, 0, $nF),
644 substr($subject, 0, $ns));
650 my $msgcount = @_ - 2; # don't count . and ..
651 my $len = length($msgcount);
661 my $nf = int($COLUMNS * $SCAN_P_FOLDER);
662 my $nm = int($COLUMNS * $SCAN_P_MESSAGE);
663 my $nF = int($COLUMNS * $SCAN_P_FROM);
664 my $ns = $COLUMNS - $nf - $nm - $nF - 3;
667 for my $hook (@start_hooks) {
668 my ($handle, @baton) = $hook->();
669 if (defined($handle)) {
670 $batons{$handle} = [@baton];
676 # Print a newline after the incomplete "N messages..." line.
681 ($msg eq '.' or $msg eq '..') and next;
683 my $headers = get_headers
($msg);
686 for my $hook (@filter_hooks) {
687 my $result = $hook->(\
%batons, $headers, $msg);
688 defined($result) and ($mhfolder = $result);
691 defined($mhfolder) or ($mhfolder = find_mh_folder
($msg, $headers));
693 $msgnum = store_message
($inbox, $msg, $mhfolder);
694 $folders{$mhfolder}++;
700 if ($mhfolder eq 'SPAM') {
702 $SPAM{$msgnum} = [$headers, undef];
705 print(scan_line
($headers, $mhfolder, $msgnum, $nf, $nm, $nF, $ns),
709 for my $hook (@post_store_hooks) {
710 $hook->(\
%batons, $headers, $mhfolder, $msgnum);
714 printf(" \%${len}d SPAM \%${len}d saved \%${len}d/%1d",
715 $spam, $saved, $spam + $saved, $msgcount);
718 defined($maxmsgs) and ($spam + $saved < $maxmsgs or last);
722 for my $hook (@stop_hooks) {
729 sub build_dot_folders
{
741 eval { ($fh, $fn) = tempfile
("$mh/.folders.XXXXX") };
747 for my $folder (sort { $folder_sorter->($a,$b) } keys(%$folders)) {
748 print($fh "$folder\n");
751 if (not close($fh)) {
752 warn("close($fn): $!");
753 unlink($fn) or warn("unlink($fn): $!");
757 rename($fn, "$mh/.folders") or warn("rename($fn, $mh/.folders): $!");
760 sub create_dot_folders
{
761 if (-f
"$HOME/.minc") {
762 require "$HOME/.minc";
766 open(my $fh, '-|', 'folders', '-fast', '-recur')
767 or die("open(folders|): $!");
768 build_dot_folders
(\
%folders, $fh);
772 sub update_dot_folders
{
776 if (not open($fh, "$mh/.folders") and not $!{ENOENT
}) {
777 # For ENOENT, we go ahead and create it, else we error and
779 warn("open($mh/.folders): $!");
783 build_dot_folders
($folders, $fh);
786 # XXX Could use some unification with getfiles...
788 my $dir = "$MAILDIR/spam/new";
790 if (not chdir($dir)) {
791 $!{ENOENT
} or print(STDERR
"skipping maildir spam: chdir($dir): $!\n");
795 if (not opendir(DIR
, '.')) {
796 print(STDERR
"skipping maildir spam: opendir($dir): $!\n");
801 my @spams = readdir(DIR
);
803 print(STDERR
"skipping maildir spam: readdir($dir): $!\n");
809 for my $msg (@spams) {
810 ($msg eq '.' or $msg eq '..') and next;
811 my $msgnum = store_message
($msg, 'SPAM');
812 # Store the original file name for scan_spam in -n mode.
813 $SPAM{$msgnum} = [undef, $msg];
818 my ($msgnum, $header, $tuple, $msg);
820 # Unlike filter_mail, we don't need to print the folder name.
821 # Calculate how many columns would be allocated to it...
822 my $nf = int($COLUMNS * $SCAN_P_FOLDER);
823 # ...and add that amount to COLUMNS to calculate the number of columns to
824 # allocate to msgnum and from snippet, thus filling the line without
825 # printing the folder name.
826 my $nm = int(($COLUMNS + $nf) * $SCAN_P_MESSAGE);
827 my $nF = int(($COLUMNS + $nf) * $SCAN_P_FROM);
828 my $ns = $COLUMNS - $nm - $nF - 3;
830 for $msgnum (sort(keys(%SPAM))) {
831 $tuple = $SPAM{$msgnum};
832 if (defined($tuple->[0])) {
833 # Filed by filter_mail, so we have the header.
834 $header = $tuple->[0];
835 } elsif (defined($tuple->[1])) {
836 # Filed by maildir_spam, so we don't have the header.
838 # The message has been filed, load it from $mh.
839 $msg = "$mh/SPAM/$msgnum";
841 # The message has not been filed, load it from the maildir.
842 # $tuple->[1] is just a basename, not a path; this works
843 # because maildir_spam did chdir(Maildir/spam/new).
846 $header = get_headers
($msg);
849 "BUG: corrupt SPAM tuple, neither element defined",
850 " for message $msgnum\n");
853 print(scan_line
($header, '', $msgnum, 0, $nm, $nF, $ns),
863 require "$HOME/.minc";
864 $Data::Dumper
::Indent
= 1;
865 print(Dumper
(\
@FILTERS));
869 $rebuild_dot_folders and exit(create_dot_folders
);
871 if (-f
"$HOME/.minc") {
872 require "$HOME/.minc";
878 } elsif (-d
"$HOME/Maildir") {
879 $inbox = "$HOME/Maildir";
883 $inbox = shift(@ARGV);
887 if (substr($inbox, 0, 1) eq '+') {
890 @msgs = ('cur-last');
892 open(my $fh, '-|', 'mhpath', @msgs) or die("open(mhpath|): $!");
893 chomp(@files = <$fh>);
895 $! == 0 or die("open(mhpath|): $!");
896 die('mhpath '. exit_msg
($?));
898 @files > 0 or exit 0;
900 @ARGV == 0 or pod2usage
();
901 chdir("$inbox/new") or die("chdir($inbox/new): $!");
902 @files = map { $_->[1] }
903 sort { $a->[0] <=> $b->[0] }
905 $st = stat($_) or die("stat($_): $!");
909 @files = map { $_->[1] }
910 sort { $a->[0] <=> $b->[0] }
912 if (not ($st = stat($_))) {
920 my %folders = filter_mail
($inbox, @files);
922 $run and %folders and update_dot_folders
(\
%folders);
933 =head1 THE FILTERS STRUCTURE
935 Each element of @FILTERS is a filter. A filter is itself an array.
936 The first element of a filter is a string, the name of the header this
937 filter acts upon. The header name is not case-sensitive. Each
938 subsequent element of a filter is a pair (i.e. a two-element array):
939 first, a regular expression B<minc> uses to determine whether this
940 filter matches or not, and second, an expression which B<minc>
941 evaluates to get the folder name.
943 B<minc> decides where to store a message by iterating over the
944 @FILTERS array. It tests each regexp of each filter against all
945 headers matching that filter's specified header. As soon as a match
946 is found, B<minc> evaluates the second part of the pair. This part
947 may contain positional parameters from the matched regexp ($1, $2,
948 etc.). The result of this expression is used as the folder name.
950 Multiple occurrences of the same header are preserved and tested
951 individually against the filters. That means, for example, that
952 filters can search all the Received headers for a certain string.
954 It is important to note that all the arrays of the @FILTERS structure
955 are traversed I<in order>. This means the filters can be arranged so
956 that some have priority over others. XXX: get Doug to write an
957 example of having the same header matched more than once.
959 Lastly, B<minc> supports a magic ' TO' header. Filters using this
960 header are matched against a collection of headers related to (and
961 including) the To. Which headers to use is determined by a regular
962 expression borrowed from procmail.
966 Filter hooks take a reference to a hash of batons, a reference to a
967 hash of headers, and the message filename as arguments. It returns
968 undef to decline filtering of this message (thus falling back to
969 subsequent filter hooks, and finally @FILTERS), or the name of the
970 folder to store this message into.
972 One of B<minc>'s global variables is available to the user-defined
973 hooks: $run. This boolean should be honored; hooks should only take
974 real action (i.e. removing or creating files, running external
975 programs, etc.) if $run is non-zero.
977 The baton hash is created simply from the start hooks; if the hook
978 returns at least one defined value, this value is used as the key and
979 all other return values are put into a list reference as the value.
980 This hash is then passed by reference to all filter, post-store, and
983 Post store hooks take a reference to a hash of batons, a reference to
984 a hash of headers, the folder this message was stored in, and its new
987 XXX: need more details about the hook process; for now read the code.
994 ['<([[:graph:]]+)-([[:graph:]]+)\.lists\.sourceforge\.net>', 'l/$1/$2'],
995 ['<([[:graph:]]+?)(-list)?\.freedesktop\.org>', 'l/freedesktop/$1'],
996 ['<swig\.cs\.uchicago\.edu>', 'l/swig'],
1000 ['<mailto:([[:graph:]]+)+@([[:graph:]]+)\.apache\.org>', 'l/apache/$2/$1'],
1008 The first List-Id filter is a surprisingly effective one which creates
1009 appropriate folder names (such as l/htdig/updates and l/rox/devel) for
1010 all Sourceforge lists to which i subscribe. Certainly there are lists
1011 hosted at Sourceforge which do not work well with this, and this is
1012 where it is important to remember that the first match is the one
1013 uses. Simply put the more specific rules before this one.
1015 The next List-Id example is simple. The swig example demonstrates
1016 that the folder name does not have to use a portion of the matched
1017 header; you can just hardcode the folder name.
1019 The List-Post example is a nice one. Most ASF projects have their own
1020 apache.org subdomain, with mailing lists hosted there. So, given a
1021 list such as dev@httpd.apache.org, this filter will create the folder
1022 name l/apache/httpd/dev.
1024 XXX Need hook examples.
1028 Written by Eric Gillespie <epg@pretzelnet.org>. Design by Eric
1029 Gillespie and Doug Porter <dsp@waterspout.com>.
1031 This program is free software; you can redistribute it and/or modify
1032 it under the same terms as Perl itself.
1037 # cperl-indent-level: 4
1038 # perl-indent-level: 4
1039 # indent-tabs-mode: nil
1042 # vi: set tabstop=4 expandtab: