]>
diplodocus.org Git - minc/blob - minc
1d7a4c2e228314213b511c91c82535076a0c96cf
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';
42 use Fcntl
qw(O_WRONLY O_EXCL O_CREAT);
44 use File
::Temp
qw(tempfile);
46 use Getopt
::Long
qw(:config gnu_getopt no_ignore_case);
51 # If a filter set's header is $MAGIC_TO_TOKEN, that set is compared
52 # against headers matching this regex (taken from procmail).
53 my $MAGIC_TO_REGEX = '^((Original-)?(Resent-)?(To|Cc|Bcc)|(X-Envelope |Apparently(-Resent)?)-To)';
54 my $MAGIC_TO_TOKEN = ' TO';
56 # Mapping of message numbers to array references. The first element is set by
57 # filter_mail to a reference to a header hash for the message; the second is
58 # set by maildier_spam to the name of the message file in the spam maildir.
59 # scan_spam scans this at the end so the user can check for false positives.
68 Dump (using Data::Dumper) the FILTERS list and exit. This is useful
69 for testing the syntax of .minc.
77 Stop processing after I<MAX> messages.
81 Dry run; do not actually incorporate the mail, but log and report to
82 stdout/stderr as normal.
86 Rebuild `mhpath +`/.folders from scratch, processing no mail.
96 my $rebuild_dot_folders;
100 'd' => \
$dumpfilters,
104 'r' => \
$rebuild_dot_folders,
106 $help and pod2usage
(-exitstatus
=>0, -verbose
=>1);
107 @ARGV == 0 or pod2usage
();
118 How many columns the user's terminal can hold, used to print scan
119 lines for each processed message. Defaults to 80.
123 Where the configuration file (.minc) is found. Also,
124 $HOME/Maildir is used for the maildir if MAILDIR is not set.
128 Where mail is delivered.
134 use Env
qw(COLUMNS HOME MAILDIR);
139 die("HOME environment variable must be set.\n");
142 $MAILDIR = "$HOME/Maildir";
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) };
188 $ENV{"MHCONTEXT"} = $mh . '/.minc.context';
191 ###############################################################################
220 foreach $component (split('/', $folder)) {
221 $target = join('/', $target, $component);
222 -d
$target or mkdir($target) or die("mkdir($target): $!");
230 if (not opendir(DIR
, $dir)) {
231 die("opendir($dir): $!");
234 # Initialize $! to 0 (success) because stupid stupid Perl provides
235 # no way to distinguish an error from an empty directory; that
236 # means setting $! to 0 and testing it afterwards is the only way
237 # to detect an error. Real Programmers don't handle errors,
240 @result = readdir(DIR
);
242 die("readdir($dir): $!");
249 STDOUT-
>autoflush(1);
251 print('1 message...');
253 print(@result - 2, ' messages...');
262 sub get_highest_msgnum
{
263 my $mhfolder = shift;
269 if (defined($msgnum_cache{$mhfolder})) {
270 return $msgnum_cache{$mhfolder}++;
273 $dir = "$mh/$mhfolder";
274 if (not opendir(DIR
, $dir)) {
275 die("opendir($dir): $!");
278 # Insert rant from getfiles here.
280 @list = readdir(DIR
);
283 die("readdir($dir): $!");
289 foreach $msgnum (@list) {
291 if ($msgnum =~ /^[0-9]+$/) {
292 if ($msgnum > $highest) {
298 $msgnum_cache{$mhfolder} = $highest;
299 return $msgnum_cache{$mhfolder}++;
306 my $fn = "$mh/$folder/.mh_sequences";
310 if (not open($fh, $fn)) {
311 $!{ENOENT
} or die("open($fn): $!");
318 open($fh, '>', $fn) or die("open(>$fn): $!");
319 for $_ (@sequences) {
324 for my $part (split(' ', $1)) {
326 my ($st, $en) = split('-', $part);
327 if ((defined($en) and ($msgnum >= $st and $msgnum <= $en))
329 # It's already there.
333 if ($st - 1 == $msgnum) {
334 $part = "$msgnum-$en";
336 } elsif ($en + 1 == $msgnum) {
337 $part = "$st-$msgnum";
341 if ($part - 1 == $msgnum) {
342 $part = "$msgnum-$part";
344 } elsif ($part + 1 == $msgnum) {
345 $part = "$part-$msgnum";
350 push(@result, $part);
353 push(@result, $msgnum);
355 print($fh "$seq: ", join(' ', @result), "\n");
361 $marked or print($fh "$seq: $msgnum\n");
362 close($fh) or die("close(>$fn): $!");
367 my $mhfolder = shift;
372 # We must do this even in -n mode because later steps fail without
373 # it. This should be harmless.
376 # This loop is a modified version of the maildir delivery algorithm.
377 $msgnum = get_highest_msgnum
($mhfolder);
378 for ($try = 0; ; $try++) {
380 $mhmsg = "$mh/$mhfolder/$msgnum";
382 if (not stat($mhmsg)) {
384 # Now we have a non-existent file, let's try to create
385 # it. We must create a zero-byte file first because a
386 # file my appear between our happy stat results and
387 # our later rename(2), which would clobber said file.
388 # So attempt to create a file with this name. If it
389 # succeeds, in just a bit here we'll knowingly clobber
390 # this file with the rename(2) call.
392 # Another way to do this is not to use rename(2), but
393 # use link(2) + unlink(2) instead. That's how the
394 # standard maildir algorithm does it. Each method has
395 # a disadvantage: the program may crash between the
396 # link(2) and unlink(2) calls. With the standard
397 # maildir algorithm, that means the message will end
398 # up duplicated. The advantage of creating an empty
399 # file followed by rename(2) is that an extra empty
400 # file is left behind as opposed to a duplicate
401 # message. This is more easily detected by the user.
403 if (sysopen(MSG
, $mhmsg,
404 O_WRONLY
| O_EXCL
| O_CREAT
, 0600)) {
414 # This algorithm is different from the maildir one; let's make
415 # 10 tries instead of 3.
417 die("Attempted filename $mhmsg exists.");
420 # This algorithm is different; i don't think we need to sleep.
425 if (not rename($msg, $mhmsg)) {
426 die("rename($msg, $mhmsg): $!");
429 # Mark each message as soon as we store it and bomb if that
430 # fails. While it is slow, it is not safe to store multiple
431 # messages and then have a failure before marking some (or
433 if ($mhfolder ne 'SPAM') {
434 mark
($mhfolder, $msgnum, 'unseen');
441 # Parse a message file into a structure describing the headers. The
442 # structure is a hash of arrays. The hash keys are the names of the
443 # headers found in the message, made all lower-case. Each item in
444 # the hash is an array of header text. The array has one element
445 # per occurrence of the header. Most headers will only have a single
446 # element because they occur only once. The Received header is the
447 # most common header with multiple texts.
451 my $current; # current header, used for unfolding lines
452 my $fieldname; # unmolested header name
453 my $contents; # contents of header
455 open(MSG
, $msg) or die("open(MSG, $msg): $!");
463 # folded header continuation
465 if (not defined($current)) {
466 warn('Malformed message, cannot parse headers.');
470 @{$headers{$current}}[-1] .= $_;
472 ($fieldname) = split(/:/);
473 $current = lc($fieldname);
474 (undef, $contents) = split(/^\Q$fieldname\E:\s*/);
476 if (defined($headers{$current})) {
477 # multiple occurence of same header
478 push(@{$headers{$current}}, $contents);
480 # first occurence of a header
481 $headers{$current} = [$contents];
491 ###############################################################################
496 my %headers = %{(shift)};
510 # Walk the list of filters. This structure is documented in
511 # pod at the end of the program.
512 foreach $filterref (@FILTERS) {
513 @filter = @$filterref;
514 $header = shift(@filter);
516 # Handle filters using the magic TO header specially.
517 if ($header eq $MAGIC_TO_TOKEN) {
518 foreach $header (keys(%headers)) {
519 if ($header =~ /$MAGIC_TO_REGEX/i) {
520 foreach $contents (@{$headers{lc($header)}}) {
521 foreach $pair (@filter) {
522 ($regexp, $expression) = @$pair;
523 if ($contents =~ $regexp) {
524 if (eval "\$result = \"$expression\"") {
533 # Now that it's been processed specially, skip normal handling.
537 # Walk the list of message headers matching the filter's
539 foreach $contents (@{$headers{lc($header)}}) {
540 # Walk the filter's list of regexp/expression pairs.
541 foreach $pair (@filter) {
542 ($regexp, $expression) = @$pair;
543 if ($contents =~ $regexp) {
544 if (eval "\$result = \"$expression\"") {
556 my ($headers, $mhfolder, $msgnum, $nf, $nm, $nF, $ns) = @_;
559 # Sometimes these headers are missing...
560 eval { $from = [@{$headers->{'from'}}]->[-1] };
561 eval { $subject = [@{$headers->{'subject'}}]->[-1] };
562 # Replace garbage characters.
563 for ($from, $subject) {
564 tr/\x00-\x1f\x80-\xff/?/;
566 return sprintf("\%-${nf}s \%${nm}d \%-${nF}s \%s",
567 substr($mhfolder, 0, $nf), substr($msgnum, 0, $nm),
568 substr($from, 0, $nF),
569 substr($subject, 0, $ns));
574 my $msgcount = @_ - 2; # don't count . and ..
575 my $len = length($msgcount);
584 if (-f
"$HOME/.minc") {
585 require "$HOME/.minc";
589 my $nf = int($COLUMNS * $SCAN_P_FOLDER);
590 my $nm = int($COLUMNS * $SCAN_P_MESSAGE);
591 my $nF = int($COLUMNS * $SCAN_P_FROM);
592 my $ns = $COLUMNS - $nf - $nm - $nF - 3;
595 for my $hook (@start_hooks) {
596 my ($handle, @baton) = $hook->();
597 if (defined($handle)) {
598 $batons{$handle} = [@baton];
604 # Print a newline after the incomplete "N messages..." line.
609 ($msg eq '.' or $msg eq '..') and next;
611 my $headers = get_headers
($msg);
614 for my $hook (@filter_hooks) {
615 my $result = $hook->(\
%batons, $headers, $msg);
616 defined($result) and ($mhfolder = $result);
619 defined($mhfolder) or ($mhfolder = find_mh_folder
($msg, $headers));
621 $msgnum = store_message
($msg, $mhfolder);
622 $folders{$mhfolder}++;
628 if ($mhfolder eq 'SPAM') {
630 $SPAM{$msgnum} = [$headers, undef];
633 print(scan_line
($headers, $mhfolder, $msgnum, $nf, $nm, $nF, $ns),
637 for my $hook (@post_store_hooks) {
638 $hook->(\
%batons, $headers, $mhfolder, $msgnum);
642 printf(" \%${len}d SPAM \%${len}d saved \%${len}d/%1d",
643 $spam, $saved, $spam + $saved, $msgcount);
646 defined($maxmsgs) and ($spam + $saved < $maxmsgs or last);
650 for my $hook (@stop_hooks) {
657 sub build_dot_folders
{
669 eval { ($fh, $fn) = tempfile
("$mh/.folders.XXXXX") };
675 for my $folder (sort { $folder_sorter->($a,$b) } keys(%$folders)) {
676 print($fh "$folder\n");
679 if (not close($fh)) {
680 warn("close($fn): $!");
681 unlink($fn) or warn("unlink($fn): $!");
685 rename($fn, "$mh/.folders") or warn("rename($fn, $mh/.folders): $!");
688 sub create_dot_folders
{
689 if (-f
"$HOME/.minc") {
690 require "$HOME/.minc";
694 open(my $fh, '-|', 'folders', '-fast', '-recur')
695 or die("open(folders|): $!");
696 build_dot_folders
(\
%folders, $fh);
700 sub update_dot_folders
{
704 if (not open($fh, "$mh/.folders") and not $!{ENOENT
}) {
705 # For ENOENT, we go ahead and create it, else we error and
707 warn("open($mh/.folders): $!");
711 build_dot_folders
($folders, $fh);
714 # XXX Could use some unification with getfiles...
716 my $dir = "$MAILDIR/spam/new";
718 if (not chdir($dir)) {
719 $!{ENOENT
} or print(STDERR
"skipping maildir spam: chdir($dir): $!\n");
723 if (not opendir(DIR
, '.')) {
724 print(STDERR
"skipping maildir spam: opendir($dir): $!\n");
729 my @spams = readdir(DIR
);
731 print(STDERR
"skipping maildir spam: readdir($dir): $!\n");
737 for my $msg (@spams) {
738 ($msg eq '.' or $msg eq '..') and next;
739 my $msgnum = store_message
($msg, 'SPAM');
740 # Store the original file name for scan_spam in -n mode.
741 $SPAM{$msgnum} = [undef, $msg];
746 my ($msgnum, $header, $tuple, $msg);
748 # Unlike filter_mail, we don't need to print the folder name.
749 # Calculate how many columns would be allocated to it...
750 my $nf = int($COLUMNS * $SCAN_P_FOLDER);
751 # ...and add that amount to COLUMNS to calculate the number of columns to
752 # allocate to msgnum and from snippet, thus filling the line without
753 # printing the folder name.
754 my $nm = int(($COLUMNS + $nf) * $SCAN_P_MESSAGE);
755 my $nF = int(($COLUMNS + $nf) * $SCAN_P_FROM);
756 my $ns = $COLUMNS - $nm - $nF - 3;
758 for $msgnum (sort(keys(%SPAM))) {
759 $tuple = $SPAM{$msgnum};
760 if (defined($tuple->[0])) {
761 # Filed by filter_mail, so we have the header.
762 $header = $tuple->[0];
763 } elsif (defined($tuple->[1])) {
764 # Filed by maildir_spam, so we don't have the header.
766 # The message has been filed, load it from $mh.
767 $msg = "$mh/SPAM/$msgnum";
769 # The message has not been filed, load it from the maildir.
770 # $tuple->[1] is just a basename, not a path; this works
771 # because maildir_spam did chdir(Maildir/spam/new).
774 $header = get_headers
($msg);
777 "BUG: corrupt SPAM tuple, neither element defined",
778 " for message $msgnum\n");
781 print(scan_line
($header, '', $msgnum, 0, $nm, $nF, $ns),
791 require "$HOME/.minc";
792 $Data::Dumper
::Indent
= 1;
793 print(Dumper
(\
@FILTERS));
797 $rebuild_dot_folders and exit(create_dot_folders
);
799 chdir("$MAILDIR/new") or die("chdir($MAILDIR/new): $!");
800 my %folders = filter_mail
(map { $_->[1] }
801 sort { $a->[0] <=> $b->[0] }
803 if (not ($st = stat($_))) {
810 $run and %folders and update_dot_folders
(\
%folders);
821 =head1 THE FILTERS STRUCTURE
823 Each element of @FILTERS is a filter. A filter is itself an array.
824 The first element of a filter is a string, the name of the header this
825 filter acts upon. The header name is not case-sensitive. Each
826 subsequent element of a filter is a pair (i.e. a two-element array):
827 first, a regular expression B<minc> uses to determine whether this
828 filter matches or not, and second, an expression which B<minc>
829 evaluates to get the folder name.
831 B<minc> decides where to store a message by iterating over the
832 @FILTERS array. It tests each regexp of each filter against all
833 headers matching that filter's specified header. As soon as a match
834 is found, B<minc> evaluates the second part of the pair. This part
835 may contain positional parameters from the matched regexp ($1, $2,
836 etc.). The result of this expression is used as the folder name.
838 Multiple occurrences of the same header are preserved and tested
839 individually against the filters. That means, for example, that
840 filters can search all the Received headers for a certain string.
842 It is important to note that all the arrays of the @FILTERS structure
843 are traversed I<in order>. This means the filters can be arranged so
844 that some have priority over others. XXX: get Doug to write an
845 example of having the same header matched more than once.
847 Lastly, B<minc> supports a magic ' TO' header. Filters using this
848 header are matched against a collection of headers related to (and
849 including) the To. Which headers to use is determined by a regular
850 expression borrowed from procmail.
854 Filter hooks take a reference to a hash of batons, a reference to a
855 hash of headers, and the message filename as arguments. It returns
856 undef to decline filtering of this message (thus falling back to
857 subsequent filter hooks, and finally @FILTERS), or the name of the
858 folder to store this message into.
860 One of B<minc>'s global variables is available to the user-defined
861 hooks: $run. This boolean should be honored; hooks should only take
862 real action (i.e. removing or creating files, running external
863 programs, etc.) if $run is non-zero.
865 The baton hash is created simply from the start hooks; if the hook
866 returns at least one defined value, this value is used as the key and
867 all other return values are put into a list reference as the value.
868 This hash is then passed by reference to all filter, post-store, and
871 Post store hooks take a reference to a hash of batons, a reference to
872 a hash of headers, the folder this message was stored in, and its new
875 XXX: need more details about the hook process; for now read the code.
882 ['<([[:graph:]]+)-([[:graph:]]+)\.lists\.sourceforge\.net>', 'l/$1/$2'],
883 ['<([[:graph:]]+?)(-list)?\.freedesktop\.org>', 'l/freedesktop/$1'],
884 ['<swig\.cs\.uchicago\.edu>', 'l/swig'],
888 ['<mailto:([[:graph:]]+)+@([[:graph:]]+)\.apache\.org>', 'l/apache/$2/$1'],
896 The first List-Id filter is a surprisingly effective one which creates
897 appropriate folder names (such as l/htdig/updates and l/rox/devel) for
898 all Sourceforge lists to which i subscribe. Certainly there are lists
899 hosted at Sourceforge which do not work well with this, and this is
900 where it is important to remember that the first match is the one
901 uses. Simply put the more specific rules before this one.
903 The next List-Id example is simple. The swig example demonstrates
904 that the folder name does not have to use a portion of the matched
905 header; you can just hardcode the folder name.
907 The List-Post example is a nice one. Most ASF projects have their own
908 apache.org subdomain, with mailing lists hosted there. So, given a
909 list such as dev@httpd.apache.org, this filter will create the folder
910 name l/apache/httpd/dev.
912 XXX Need hook examples.
916 Written by Eric Gillespie <epg@pretzelnet.org>. Design by Eric
917 Gillespie and Doug Porter <dsp@waterspout.com>.
919 This program is free software; you can redistribute it and/or modify
920 it under the same terms as Perl itself.
925 # cperl-indent-level: 4
926 # perl-indent-level: 4
927 # indent-tabs-mode: nil
930 # vi: set tabstop=4 expandtab: