]>
diplodocus.org Git - minc/blob - minc
75fa67e833075bf7c1403c791a6dd29767522332
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);
111 @ARGV <= 1 or pod2usage
();
122 How many columns the user's terminal can hold, used to print scan
123 lines for each processed message. Defaults to 80.
127 Where the configuration file (.minc) is found. Also,
128 $HOME/Maildir is used for the maildir if MAILDIR is not set.
132 Where mail is delivered.
138 use Env
qw(COLUMNS HOME MAILDIR);
143 die("HOME environment variable must be set.\n");
146 $MAILDIR = "$HOME/Maildir";
155 This file is Perl code (included via the 'require' directive) which
156 may define the FILTERS list, @start_hooks, @filter_hooks,
157 @post_store_hooks, and @stop_hooks.
159 =item `mhpath +`/.folders
161 B<minc> adds all folders it filters into to this file, which is used
162 by lukem's B<new(1)> (XXX need a link).
164 =item `mhpath +`/.minc.context
166 B<minc> uses this file for context (i.e. current folder) instead of
167 `mhpath +`/context. This allows you some amount of freedom to use mh
168 while B<minc> is running. For example, you can changed folders without
169 causing a message to be stored in the wrong folder. Care must still
170 be taken, however, about the unseen sequence; if you change it
171 (whether via show, or mark, or anything else) while in the same folder
172 as B<minc>, it is likely the new message B<minc> stores will not end up
180 our (@start_hooks, @stop_hooks, @filter_hooks, @post_store_hooks);
181 our $SCAN_P_FOLDER = 0.1;
182 our $SCAN_P_MESSAGE = 0.0625;
183 our $SCAN_P_FROM = 0.175;
184 our @folder_sort_list = (qr/^inbox$/);
185 our $folder_sorter = sub { sort_by_list
(@_, @folder_sort_list) };
189 $mh = `mhpath +`; $? >= 0 or die;
192 die('mhpath did not give MH mail path: ' . exit_msg
($?));
195 $ENV{"MHCONTEXT"} = $mh . '/.minc.context';
197 # TODO: Support dot-locking too. This works on FreeBSD and Linux.
198 my $locking = `mhparam datalocking`;
200 $? == 0 || die('mhparam datalocking: ' . exit_msg
($?));
202 if ($locking ne 'fcntl') {
203 die("mh locking $locking not supported; only fcntl");
207 ###############################################################################
212 WIFEXITED
($status) && return 'exited with status ' . WEXITSTATUS
($status);
213 WIFSIGNALED
($status) && return 'killed with signal ' . WTERMSIG
($status);
244 foreach $component (split('/', $folder)) {
245 $target = join('/', $target, $component);
246 -d
$target or mkdir($target) or die("mkdir($target): $!");
254 if (not opendir(DIR
, $dir)) {
255 die("opendir($dir): $!");
258 # Initialize $! to 0 (success) because stupid stupid Perl provides
259 # no way to distinguish an error from an empty directory; that
260 # means setting $! to 0 and testing it afterwards is the only way
261 # to detect an error. Real Programmers don't handle errors,
264 @result = readdir(DIR
);
266 die("readdir($dir): $!");
273 STDOUT-
>autoflush(1);
275 print('1 message...');
277 print(@result - 2, ' messages...');
286 sub get_highest_msgnum
{
287 my $mhfolder = shift;
293 if (defined($msgnum_cache{$mhfolder})) {
294 return $msgnum_cache{$mhfolder}++;
297 $dir = "$mh/$mhfolder";
298 if (not opendir(DIR
, $dir)) {
299 die("opendir($dir): $!");
302 # Insert rant from getfiles here.
304 @list = readdir(DIR
);
307 die("readdir($dir): $!");
313 foreach $msgnum (@list) {
315 if ($msgnum =~ /^[0-9]+$/) {
316 if ($msgnum > $highest) {
322 $msgnum_cache{$mhfolder} = $highest;
323 return $msgnum_cache{$mhfolder}++;
331 my $fn = "$mh/$folder/.mh_sequences";
332 my ($fh, $e) = lkopen_fcntl
($fn, O_RDWR
| O_CREAT
, 0600);
334 my @sequences = <$fh>;
337 truncate($fh, 0) or die("truncate($fn): $!");
338 seek($fh, 0, SEEK_SET
) or die("seek($fn): $!");
341 for $_ (@sequences) {
346 for my $part (split(' ', $1)) {
348 my ($st, $en) = split('-', $part);
349 if ((defined($en) and ($msgnum >= $st and $msgnum <= $en))
351 # It's already there.
355 if ($st - 1 == $msgnum) {
356 $part = "$msgnum-$en";
358 } elsif ($en + 1 == $msgnum) {
359 $part = "$st-$msgnum";
363 if ($part - 1 == $msgnum) {
364 $part = "$msgnum-$part";
366 } elsif ($part + 1 == $msgnum) {
367 $part = "$part-$msgnum";
372 push(@result, $part);
375 push(@result, $msgnum);
377 print($fh "$seq: ", join(' ', @result), "\n");
383 $marked or print($fh "$seq: $msgnum\n");
384 close($fh) or die("close(>$fn): $!");
387 # Based on nmh's lkopen_fcntl
388 # Return 0 for success, errno on failure.
395 # The assumption here is that if you open the file for writing, you
396 # need an exclusive lock.
398 my $tries = LOCK_TRIES
;
400 sysopen(my $fh, $fn, $access, $mode) or die("sysopen($fn): $!");
402 my $flk = File
::FcntlLock-
>new;
405 $flk->l_type(($access & O_ACCMODE
) == O_RDONLY
? F_RDLCK
: F_WRLCK
);
406 $flk->l_whence(SEEK_SET
);
408 # Really should only retry on EAGAIN and EINTR...
409 if ($flk->lock($fh, F_SETLK
)) {
413 $errno = $flk->lock_errno;
414 close($fh) or die("close($fn): $!");
423 die("failed to lock $fn: $!");
428 my $mhfolder = shift;
433 # We must do this even in -n mode because later steps fail without
434 # it. This should be harmless.
437 # This loop is a modified version of the maildir delivery algorithm.
438 $msgnum = get_highest_msgnum
($mhfolder);
439 for ($try = 0; ; $try++) {
441 $mhmsg = "$mh/$mhfolder/$msgnum";
443 if (not stat($mhmsg)) {
445 # Now we have a non-existent file, let's try to create
446 # it. We must create a zero-byte file first because a
447 # file my appear between our happy stat results and
448 # our later rename(2), which would clobber said file.
449 # So attempt to create a file with this name. If it
450 # succeeds, in just a bit here we'll knowingly clobber
451 # this file with the rename(2) call.
453 # Another way to do this is not to use rename(2), but
454 # use link(2) + unlink(2) instead. That's how the
455 # standard maildir algorithm does it. Each method has
456 # a disadvantage: the program may crash between the
457 # link(2) and unlink(2) calls. With the standard
458 # maildir algorithm, that means the message will end
459 # up duplicated. The advantage of creating an empty
460 # file followed by rename(2) is that an extra empty
461 # file is left behind as opposed to a duplicate
462 # message. This is more easily detected by the user.
464 if (sysopen(MSG
, $mhmsg,
465 O_WRONLY
| O_EXCL
| O_CREAT
, 0600)) {
475 # This algorithm is different from the maildir one; let's make
476 # 10 tries instead of 3.
478 die("Attempted filename $mhmsg exists.");
481 # This algorithm is different; i don't think we need to sleep.
486 if (not rename($msg, $mhmsg)) {
487 die("rename($msg, $mhmsg): $!");
490 # Mark each message as soon as we store it and bomb if that
491 # fails. While it is slow, it is not safe to store multiple
492 # messages and then have a failure before marking some (or
494 if ($mhfolder ne 'SPAM') {
495 mark
($mhfolder, $msgnum, 'unseen');
502 # Parse a message file into a structure describing the headers. The
503 # structure is a hash of arrays. The hash keys are the names of the
504 # headers found in the message, made all lower-case. Each item in
505 # the hash is an array of header text. The array has one element
506 # per occurrence of the header. Most headers will only have a single
507 # element because they occur only once. The Received header is the
508 # most common header with multiple texts.
512 my $current; # current header, used for unfolding lines
513 my $fieldname; # unmolested header name
514 my $contents; # contents of header
516 open(MSG
, $msg) or die("open(MSG, $msg): $!");
524 # folded header continuation
526 if (not defined($current)) {
527 warn('Malformed message, cannot parse headers.');
531 @{$headers{$current}}[-1] .= $_;
533 ($fieldname) = split(/:/);
534 $current = lc($fieldname);
535 (undef, $contents) = split(/^\Q$fieldname\E:\s*/);
537 if (defined($headers{$current})) {
538 # multiple occurence of same header
539 push(@{$headers{$current}}, $contents);
541 # first occurence of a header
542 $headers{$current} = [$contents];
552 ###############################################################################
563 # Walk the list of filters. This structure is documented in
564 # pod at the end of the program.
565 for my $filterref (@FILTERS) {
566 if (ref($filterref) eq 'CODE') {
567 my $m = $filterref->($header, $msg);
572 my $m = match
($header, @$filterref);
579 # Test all the header fields against each [regexp, folder-expression] pair.
582 my $filter_field = shift;
585 # Handle filters using the magic TO header specially.
586 if ($filter_field eq $MAGIC_TO_TOKEN) {
587 for my $field_name (keys(%$header)) {
588 if ($field_name =~ /$MAGIC_TO_REGEX/i) {
589 my $m = match_one_field
($header->{$field_name}, \
@filters);
593 # Now that it's been processed specially, skip normal handling.
597 # Walk the list of header fields matching the filter's specified header.
598 my $m = match_one_field
($header->{lc($filter_field)}, \
@filters);
602 # Test all the values of one header field against each [regexp,
603 # folder-expression] pair.
604 sub match_one_field
{
607 for my $value (@$values) {
608 for my $pair (@$filters) {
609 my ($regexp, $expression) = @$pair;
610 if ($value =~ $regexp) {
612 if (eval "\$result = \"$expression\"") {
621 my ($headers, $mhfolder, $msgnum, $nf, $nm, $nF, $ns) = @_;
624 # Sometimes these headers are missing...
625 eval { $from = [@{$headers->{'from'}}]->[-1] };
626 eval { $subject = [@{$headers->{'subject'}}]->[-1] };
627 # Replace garbage characters.
628 for ($from, $subject) {
629 tr/\x00-\x1f\x80-\xff/?/;
631 return sprintf("\%-${nf}s \%${nm}d \%-${nF}s \%s",
632 substr($mhfolder, 0, $nf), substr($msgnum, 0, $nm),
633 substr($from, 0, $nF),
634 substr($subject, 0, $ns));
639 my $msgcount = @_ - 2; # don't count . and ..
640 my $len = length($msgcount);
649 if (-f
"$HOME/.minc") {
650 require "$HOME/.minc";
654 my $nf = int($COLUMNS * $SCAN_P_FOLDER);
655 my $nm = int($COLUMNS * $SCAN_P_MESSAGE);
656 my $nF = int($COLUMNS * $SCAN_P_FROM);
657 my $ns = $COLUMNS - $nf - $nm - $nF - 3;
660 for my $hook (@start_hooks) {
661 my ($handle, @baton) = $hook->();
662 if (defined($handle)) {
663 $batons{$handle} = [@baton];
669 # Print a newline after the incomplete "N messages..." line.
674 ($msg eq '.' or $msg eq '..') and next;
676 my $headers = get_headers
($msg);
679 for my $hook (@filter_hooks) {
680 my $result = $hook->(\
%batons, $headers, $msg);
681 defined($result) and ($mhfolder = $result);
684 defined($mhfolder) or ($mhfolder = find_mh_folder
($msg, $headers));
686 $msgnum = store_message
($msg, $mhfolder);
687 $folders{$mhfolder}++;
693 if ($mhfolder eq 'SPAM') {
695 $SPAM{$msgnum} = [$headers, undef];
698 print(scan_line
($headers, $mhfolder, $msgnum, $nf, $nm, $nF, $ns),
702 for my $hook (@post_store_hooks) {
703 $hook->(\
%batons, $headers, $mhfolder, $msgnum);
707 printf(" \%${len}d SPAM \%${len}d saved \%${len}d/%1d",
708 $spam, $saved, $spam + $saved, $msgcount);
711 defined($maxmsgs) and ($spam + $saved < $maxmsgs or last);
715 for my $hook (@stop_hooks) {
722 sub build_dot_folders
{
734 eval { ($fh, $fn) = tempfile
("$mh/.folders.XXXXX") };
740 for my $folder (sort { $folder_sorter->($a,$b) } keys(%$folders)) {
741 print($fh "$folder\n");
744 if (not close($fh)) {
745 warn("close($fn): $!");
746 unlink($fn) or warn("unlink($fn): $!");
750 rename($fn, "$mh/.folders") or warn("rename($fn, $mh/.folders): $!");
753 sub create_dot_folders
{
754 if (-f
"$HOME/.minc") {
755 require "$HOME/.minc";
759 open(my $fh, '-|', 'folders', '-fast', '-recur')
760 or die("open(folders|): $!");
761 build_dot_folders
(\
%folders, $fh);
765 sub update_dot_folders
{
769 if (not open($fh, "$mh/.folders") and not $!{ENOENT
}) {
770 # For ENOENT, we go ahead and create it, else we error and
772 warn("open($mh/.folders): $!");
776 build_dot_folders
($folders, $fh);
779 # XXX Could use some unification with getfiles...
781 my $dir = "$MAILDIR/spam/new";
783 if (not chdir($dir)) {
784 $!{ENOENT
} or print(STDERR
"skipping maildir spam: chdir($dir): $!\n");
788 if (not opendir(DIR
, '.')) {
789 print(STDERR
"skipping maildir spam: opendir($dir): $!\n");
794 my @spams = readdir(DIR
);
796 print(STDERR
"skipping maildir spam: readdir($dir): $!\n");
802 for my $msg (@spams) {
803 ($msg eq '.' or $msg eq '..') and next;
804 my $msgnum = store_message
($msg, 'SPAM');
805 # Store the original file name for scan_spam in -n mode.
806 $SPAM{$msgnum} = [undef, $msg];
811 my ($msgnum, $header, $tuple, $msg);
813 # Unlike filter_mail, we don't need to print the folder name.
814 # Calculate how many columns would be allocated to it...
815 my $nf = int($COLUMNS * $SCAN_P_FOLDER);
816 # ...and add that amount to COLUMNS to calculate the number of columns to
817 # allocate to msgnum and from snippet, thus filling the line without
818 # printing the folder name.
819 my $nm = int(($COLUMNS + $nf) * $SCAN_P_MESSAGE);
820 my $nF = int(($COLUMNS + $nf) * $SCAN_P_FROM);
821 my $ns = $COLUMNS - $nm - $nF - 3;
823 for $msgnum (sort(keys(%SPAM))) {
824 $tuple = $SPAM{$msgnum};
825 if (defined($tuple->[0])) {
826 # Filed by filter_mail, so we have the header.
827 $header = $tuple->[0];
828 } elsif (defined($tuple->[1])) {
829 # Filed by maildir_spam, so we don't have the header.
831 # The message has been filed, load it from $mh.
832 $msg = "$mh/SPAM/$msgnum";
834 # The message has not been filed, load it from the maildir.
835 # $tuple->[1] is just a basename, not a path; this works
836 # because maildir_spam did chdir(Maildir/spam/new).
839 $header = get_headers
($msg);
842 "BUG: corrupt SPAM tuple, neither element defined",
843 " for message $msgnum\n");
846 print(scan_line
($header, '', $msgnum, 0, $nm, $nF, $ns),
856 require "$HOME/.minc";
857 $Data::Dumper
::Indent
= 1;
858 print(Dumper
(\
@FILTERS));
862 $rebuild_dot_folders and exit(create_dot_folders
);
866 # a. take message numbers on stdin
867 # b. take full paths to messages on stdin
868 # c. take standard [msgs] list on command-line
869 # d. assume inc has just finished so cur points to start of new mail and
871 # Hacked up b. here, but I'm not happy with it. I'm renaming files that
872 # stay in inbox for no reason, and leaving gaping holes. Any of the above
873 # approaches has those problems, and the solution is always the same:
874 # # Keep track of the message numbers we've renamed out of inbox
877 # if (!my $new = filter($_)) {
878 # # If @filtered is empty, this message already has the right number.
879 # $new = shift(@filtered) || next;
881 # push(@filtered, $_);
886 # XXX if sticking with this approach, reject arg other than '-'
888 @files > 0 || exit 0;
890 chdir("$MAILDIR/new") or die("chdir($MAILDIR/new): $!");
891 @files = getfiles
('.');
894 my %folders = filter_mail
(map { $_->[1] }
895 sort { $a->[0] <=> $b->[0] }
897 if (not ($st = stat($_))) {
904 $run and %folders and update_dot_folders
(\
%folders);
915 =head1 THE FILTERS STRUCTURE
917 Each element of @FILTERS is a filter. A filter is itself an array.
918 The first element of a filter is a string, the name of the header this
919 filter acts upon. The header name is not case-sensitive. Each
920 subsequent element of a filter is a pair (i.e. a two-element array):
921 first, a regular expression B<minc> uses to determine whether this
922 filter matches or not, and second, an expression which B<minc>
923 evaluates to get the folder name.
925 B<minc> decides where to store a message by iterating over the
926 @FILTERS array. It tests each regexp of each filter against all
927 headers matching that filter's specified header. As soon as a match
928 is found, B<minc> evaluates the second part of the pair. This part
929 may contain positional parameters from the matched regexp ($1, $2,
930 etc.). The result of this expression is used as the folder name.
932 Multiple occurrences of the same header are preserved and tested
933 individually against the filters. That means, for example, that
934 filters can search all the Received headers for a certain string.
936 It is important to note that all the arrays of the @FILTERS structure
937 are traversed I<in order>. This means the filters can be arranged so
938 that some have priority over others. XXX: get Doug to write an
939 example of having the same header matched more than once.
941 Lastly, B<minc> supports a magic ' TO' header. Filters using this
942 header are matched against a collection of headers related to (and
943 including) the To. Which headers to use is determined by a regular
944 expression borrowed from procmail.
948 Filter hooks take a reference to a hash of batons, a reference to a
949 hash of headers, and the message filename as arguments. It returns
950 undef to decline filtering of this message (thus falling back to
951 subsequent filter hooks, and finally @FILTERS), or the name of the
952 folder to store this message into.
954 One of B<minc>'s global variables is available to the user-defined
955 hooks: $run. This boolean should be honored; hooks should only take
956 real action (i.e. removing or creating files, running external
957 programs, etc.) if $run is non-zero.
959 The baton hash is created simply from the start hooks; if the hook
960 returns at least one defined value, this value is used as the key and
961 all other return values are put into a list reference as the value.
962 This hash is then passed by reference to all filter, post-store, and
965 Post store hooks take a reference to a hash of batons, a reference to
966 a hash of headers, the folder this message was stored in, and its new
969 XXX: need more details about the hook process; for now read the code.
976 ['<([[:graph:]]+)-([[:graph:]]+)\.lists\.sourceforge\.net>', 'l/$1/$2'],
977 ['<([[:graph:]]+?)(-list)?\.freedesktop\.org>', 'l/freedesktop/$1'],
978 ['<swig\.cs\.uchicago\.edu>', 'l/swig'],
982 ['<mailto:([[:graph:]]+)+@([[:graph:]]+)\.apache\.org>', 'l/apache/$2/$1'],
990 The first List-Id filter is a surprisingly effective one which creates
991 appropriate folder names (such as l/htdig/updates and l/rox/devel) for
992 all Sourceforge lists to which i subscribe. Certainly there are lists
993 hosted at Sourceforge which do not work well with this, and this is
994 where it is important to remember that the first match is the one
995 uses. Simply put the more specific rules before this one.
997 The next List-Id example is simple. The swig example demonstrates
998 that the folder name does not have to use a portion of the matched
999 header; you can just hardcode the folder name.
1001 The List-Post example is a nice one. Most ASF projects have their own
1002 apache.org subdomain, with mailing lists hosted there. So, given a
1003 list such as dev@httpd.apache.org, this filter will create the folder
1004 name l/apache/httpd/dev.
1006 XXX Need hook examples.
1010 Written by Eric Gillespie <epg@pretzelnet.org>. Design by Eric
1011 Gillespie and Doug Porter <dsp@waterspout.com>.
1013 This program is free software; you can redistribute it and/or modify
1014 it under the same terms as Perl itself.
1019 # cperl-indent-level: 4
1020 # perl-indent-level: 4
1021 # indent-tabs-mode: nil
1024 # vi: set tabstop=4 expandtab: