]> diplodocus.org Git - minc/blob - minc
31fefa53e2426120442b40a8e89a7edcbd8115fb
[minc] / minc
1 #!/usr/bin/perl
2
3 =head1 NAME
4
5 B<minc> - incorporate mail from a maildir into mh folders
6
7 =head1 SYNOPSIS
8
9 B<minc> [B<-m> I<MAX>] [B<-n>]
10
11 B<minc> B<-d>
12
13 B<minc> B<-r>
14
15 =head1 DESCRIPTION
16
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.
22
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
31 rest of the line.
32
33 =cut
34
35 use strict;
36 use warnings;
37
38 $SIG{'PIPE'} = 'IGNORE';
39
40 use Data::Dumper;
41 use Errno;
42 use Fcntl;
43 use FileHandle;
44 use File::FcntlLock;
45 use File::Temp qw(tempfile);
46 use File::stat;
47 use Getopt::Long qw(:config gnu_getopt no_ignore_case);
48 use POSIX qw(WIFEXITED WEXITSTATUS WIFSIGNALED WTERMSIG);
49 use Pod::Usage;
50
51 use constant LOCK_TRIES => 60;
52
53 our $VERSION = 1;
54
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';
59
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.
64 my %SPAM;
65
66 =head1 OPTIONS
67
68 =over 4
69
70 =item B<-d>
71
72 Dump (using Data::Dumper) the FILTERS list and exit. This is useful
73 for testing the syntax of .minc.
74
75 =item B<-h>
76
77 Show help.
78
79 =item B<-m> I<MAX>
80
81 Stop processing after I<MAX> messages.
82
83 =item B<-n>
84
85 Dry run; do not actually incorporate the mail, but log and report to
86 stdout/stderr as normal.
87
88 =item B<-r>
89
90 Rebuild `mhpath +`/.folders from scratch, processing no mail.
91
92 =back
93
94 =cut
95
96 my $dumpfilters;
97 my $help;
98 my $maxmsgs;
99 my $norun;
100 my $rebuild_dot_folders;
101
102 if (!caller()) {
103 GetOptions(
104 'd' => \$dumpfilters,
105 'h|help' => \$help,
106 'm=i' => \$maxmsgs,
107 'n' => \$norun,
108 'r' => \$rebuild_dot_folders,
109 ) or pod2usage();
110 $help and pod2usage(-exitstatus=>0, -verbose=>1);
111 }
112
113 our $run = !$norun;
114
115 =head1 ENVIRONMENT
116
117 =over 4
118
119 =item COLUMNS
120
121 How many columns the user's terminal can hold, used to print scan
122 lines for each processed message. Defaults to 80.
123
124 =item HOME
125
126 Where the configuration file (.minc) is found. Also,
127 $HOME/Maildir is used for the maildir if MAILDIR is not set.
128
129 =item MAILDIR
130
131 Where mail is delivered.
132
133 =back
134
135 =cut
136
137 use Env qw(COLUMNS HOME MAILDIR);
138
139 $COLUMNS ||= 80;
140
141 if (not $HOME) {
142 die("HOME environment variable must be set.\n");
143 }
144
145 =head1 FILES
146
147 =over 4
148
149 =item $HOME/.minc
150
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.
154
155 =item `mhpath +`/.folders
156
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).
159
160 =item `mhpath +`/.minc.context
161
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
169 marked unseen.
170
171 =back
172
173 =cut
174
175 our @FILTERS;
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) };
182
183 my $mh;
184
185 $mh = `mhpath +`; $? >= 0 or die;
186 chomp($mh);
187 if (!$mh) {
188 die('mhpath did not give MH mail path: ' . exit_msg($?));
189 }
190
191 $ENV{"MHCONTEXT"} = $mh . '/.minc.context';
192
193 # TODO: Support dot-locking too. This works on FreeBSD and Linux.
194 my $locking = `mhparam datalocking`;
195 $? < 0 && die;
196 $? == 0 || die('mhparam datalocking: ' . exit_msg($?));
197 chomp($locking);
198 if ($locking ne 'fcntl') {
199 die("mh locking $locking not supported; only fcntl");
200 }
201
202 \f
203 ###############################################################################
204 # Utility procedures
205
206 sub exit_msg {
207 my $status = shift;
208 WIFEXITED($status) && return 'exited with status ' . WEXITSTATUS($status);
209 WIFSIGNALED($status) && return 'killed with signal ' . WTERMSIG($status);
210 # WTF
211 "died ($status)";
212 }
213
214 sub sort_by_list {
215 my $a = shift;
216 my $b = shift;
217
218 for my $i (@_) {
219 my $am = $a =~ $i;
220 my $bm = $b =~ $i;
221 if ($am) {
222 if ($bm) {
223 last;
224 }
225 return -1;
226 } elsif ($bm) {
227 return 1;
228 }
229 }
230
231 return $a cmp $b;
232 }
233
234 sub mkfolder {
235 my $folder = shift;
236 my $target;
237 my $component;
238
239 $target = $mh;
240 foreach $component (split('/', $folder)) {
241 $target = join('/', $target, $component);
242 -d $target or mkdir($target) or die("mkdir($target): $!");
243 }
244 }
245
246 sub getfiles {
247 my $dir = shift;
248 my @result;
249
250 if (not opendir(DIR, $dir)) {
251 die("opendir($dir): $!");
252 }
253
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,
258 # right? >sigh<
259 $! = 0;
260 @result = readdir(DIR);
261 if ($! != 0) {
262 die("readdir($dir): $!");
263 }
264
265 if (@result <= 2) {
266 return ();
267 }
268
269 STDOUT->autoflush(1);
270 if (@result == 3) {
271 print('1 message...');
272 } else {
273 print(@result - 2, ' messages...');
274 }
275
276 closedir(DIR);
277
278 return @result;
279 }
280
281 my %msgnum_cache;
282 sub get_highest_msgnum {
283 my $mhfolder = shift;
284 my $dir;
285 my @list;
286 my $highest;
287 my $msgnum;
288
289 if (defined($msgnum_cache{$mhfolder})) {
290 return $msgnum_cache{$mhfolder}++;
291 }
292
293 $dir = "$mh/$mhfolder";
294 if (not opendir(DIR, $dir)) {
295 die("opendir($dir): $!");
296 }
297
298 # Insert rant from getfiles here.
299 $! = 0;
300 @list = readdir(DIR);
301
302 if ($! != 0) {
303 die("readdir($dir): $!");
304 }
305
306 closedir(DIR);
307
308 $highest = 0;
309 foreach $msgnum (@list) {
310 # Look for integers.
311 if ($msgnum =~ /^[0-9]+$/) {
312 if ($msgnum > $highest) {
313 $highest = $msgnum;
314 }
315 }
316 }
317
318 $msgnum_cache{$mhfolder} = $highest;
319 return $msgnum_cache{$mhfolder}++;
320 }
321
322 sub mark {
323 my $folder = shift;
324 my $msgnum = shift;
325 my $seq = shift;
326
327 my $fn = "$mh/$folder/.mh_sequences";
328 my ($fh, $e) = lkopen_fcntl($fn, O_RDWR | O_CREAT, 0600);
329
330 my @sequences = <$fh>;
331 chomp(@sequences);
332
333 seek($fh, 0, SEEK_SET) or die("seek($fn): $!");
334 truncate($fh, 0) or die("truncate($fn): $!");
335
336 my $marked = 0;
337 for $_ (@sequences) {
338 if (/^$seq: (.*)/) {
339 my @parts;
340 my @result;
341 my $done = 0;
342 for my $part (split(' ', $1)) {
343 if (not $done) {
344 my ($st, $en) = split('-', $part);
345 if ((defined($en) and ($msgnum >= $st and $msgnum <= $en))
346 or $msgnum == $st) {
347 # It's already there.
348 $done = 1;
349 }
350 if (defined($en)) {
351 if ($st - 1 == $msgnum) {
352 $part = "$msgnum-$en";
353 $done = 1;
354 } elsif ($en + 1 == $msgnum) {
355 $part = "$st-$msgnum";
356 $done = 1;
357 }
358 } else {
359 if ($part - 1 == $msgnum) {
360 $part = "$msgnum-$part";
361 $done = 1;
362 } elsif ($part + 1 == $msgnum) {
363 $part = "$part-$msgnum";
364 $done = 1;
365 }
366 }
367 }
368 push(@result, $part);
369 }
370 if (not $done) {
371 push(@result, $msgnum);
372 }
373 print($fh "$seq: ", join(' ', @result), "\n");
374 $marked = 1;
375 } else {
376 print($fh "$_\n");
377 }
378 }
379 $marked or print($fh "$seq: $msgnum\n");
380 close($fh) or die("close(>$fn): $!");
381 }
382
383 # Based on nmh's lkopen_fcntl
384 # Return 0 for success, errno on failure.
385 sub lkopen_fcntl {
386 my $fn = shift;
387 my $access = shift;
388 my $mode = shift;
389 my $errno;
390
391 # The assumption here is that if you open the file for writing, you
392 # need an exclusive lock.
393
394 my $tries = LOCK_TRIES;
395 for (;;) {
396 sysopen(my $fh, $fn, $access, $mode) or die("sysopen($fn): $!");
397
398 my $flk = File::FcntlLock->new;
399 $flk->l_start(0);
400 $flk->l_len(0);
401 $flk->l_type(($access & O_ACCMODE) == O_RDONLY ? F_RDLCK : F_WRLCK);
402 $flk->l_whence(SEEK_SET);
403
404 # Really should only retry on EAGAIN and EINTR...
405 if ($flk->lock($fh, F_SETLK)) {
406 return $fh;
407 }
408
409 $errno = $flk->lock_errno;
410 close($fh) or die("close($fn): $!");
411
412 if (--$tries == 0) {
413 last;
414 }
415 sleep(1);
416 }
417
418 local $! = $errno;
419 die("failed to lock $fn: $!");
420 }
421
422 my @filtered;
423 sub store_message {
424 my $inbox = shift;
425 my $msg = shift; # rename $src_msg
426 my $mhfolder = shift;
427 my ($msgnum, $mhmsg); # rename $dst_msg and $dst_msgpath
428 my $try;
429
430 # We must do this even in -n mode because later steps fail without
431 # it. This should be harmless.
432 mkfolder($mhfolder);
433
434 if ("+$mhfolder" eq $inbox) {
435 # If @filtered is empty, this message already has the right number.
436 if (!($msgnum = shift(@filtered))) {
437 $msg =~ m|.*/(\d+)$|;
438 return $1;
439 }
440 $mhmsg = "$mh/$mhfolder/$msgnum";
441 } else {
442 # This loop is a modified version of the maildir delivery algorithm.
443 $msgnum = get_highest_msgnum($mhfolder);
444 for ($try = 0; ; $try++) {
445 $msgnum++;
446 $mhmsg = "$mh/$mhfolder/$msgnum";
447
448 if (not stat($mhmsg)) {
449 if ($!{ENOENT}) {
450 # Now we have a non-existent file, let's try to create
451 # it. We must create a zero-byte file first because a
452 # file my appear between our happy stat results and
453 # our later rename(2), which would clobber said file.
454 # So attempt to create a file with this name. If it
455 # succeeds, in just a bit here we'll knowingly clobber
456 # this file with the rename(2) call.
457
458 # Another way to do this is not to use rename(2), but
459 # use link(2) + unlink(2) instead. That's how the
460 # standard maildir algorithm does it. Each method has
461 # a disadvantage: the program may crash between the
462 # link(2) and unlink(2) calls. With the standard
463 # maildir algorithm, that means the message will end
464 # up duplicated. The advantage of creating an empty
465 # file followed by rename(2) is that an extra empty
466 # file is left behind as opposed to a duplicate
467 # message. This is more easily detected by the user.
468 if ($run) {
469 if (sysopen(MSG, $mhmsg,
470 O_WRONLY | O_EXCL | O_CREAT, 0600)) {
471 close(MSG);
472 last;
473 }
474 } else {
475 last;
476 }
477 }
478 }
479
480 # This algorithm is different from the maildir one; let's make
481 # 10 tries instead of 3.
482 if ($try == 9) {
483 die("Attempted filename $mhmsg exists.");
484 }
485
486 # This algorithm is different; i don't think we need to sleep.
487 #sleep(2);
488
489 if ($run) {
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
493 # all).
494 if ($mhfolder ne 'SPAM') {
495 mark($mhfolder, $msgnum, 'unseen');
496 }
497 }
498 }
499 }
500 push(@filtered, $msg);
501
502 if ($run) {
503 if (not rename($msg, $mhmsg)) {
504 die("rename($msg, $mhmsg): $!");
505 }
506 }
507
508 return $msgnum;
509 }
510
511 # Parse a message file into a structure describing the headers. The
512 # structure is a hash of arrays. The hash keys are the names of the
513 # headers found in the message, made all lower-case. Each item in
514 # the hash is an array of header text. The array has one element
515 # per occurrence of the header. Most headers will only have a single
516 # element because they occur only once. The Received header is the
517 # most common header with multiple texts.
518 sub get_headers {
519 my $msg = shift;
520 my %headers;
521 my $current; # current header, used for unfolding lines
522 my $fieldname; # unmolested header name
523 my $contents; # contents of header
524
525 open(MSG, $msg) or die("open(MSG, $msg): $!");
526 while (<MSG>) {
527 chomp;
528 if (length == 0) {
529 last;
530 }
531
532 if (/^\s/) {
533 # folded header continuation
534
535 if (not defined($current)) {
536 warn('Malformed message, cannot parse headers.');
537 next;
538 }
539
540 @{$headers{$current}}[-1] .= $_;
541 } else {
542 ($fieldname) = split(/:/);
543 $current = lc($fieldname);
544 (undef, $contents) = split(/^\Q$fieldname\E:\s*/);
545
546 if (defined($headers{$current})) {
547 # multiple occurence of same header
548 push(@{$headers{$current}}, $contents);
549 } else {
550 # first occurence of a header
551 $headers{$current} = [$contents];
552 }
553 }
554 }
555 close(MSG);
556
557 return \%headers;
558 }
559
560 \f
561 ###############################################################################
562 # Filtering
563
564 sub find_mh_folder {
565 my $msg = shift;
566 my $header = shift;
567
568 if (not %$header) {
569 return 'malformed';
570 }
571
572 # Walk the list of filters. This structure is documented in
573 # pod at the end of the program.
574 for my $filterref (@FILTERS) {
575 if (ref($filterref) eq 'CODE') {
576 my $m = $filterref->($header, $msg);
577 $m && return $m;
578 next;
579 }
580
581 my $m = match($header, @$filterref);
582 $m && return $m;
583 }
584
585 return 'inbox';
586 }
587
588 # Test all the header fields against each [regexp, folder-expression] pair.
589 sub match {
590 my $header = shift;
591 my $filter_field = shift;
592 my @filters = @_;
593
594 # Handle filters using the magic TO header specially.
595 if ($filter_field eq $MAGIC_TO_TOKEN) {
596 for my $field_name (keys(%$header)) {
597 if ($field_name =~ /$MAGIC_TO_REGEX/i) {
598 my $m = match_one_field($header->{$field_name}, \@filters);
599 $m && return $m;
600 }
601 }
602 # Now that it's been processed specially, skip normal handling.
603 return;
604 }
605
606 # Walk the list of header fields matching the filter's specified header.
607 my $m = match_one_field($header->{lc($filter_field)}, \@filters);
608 $m && return $m;
609 }
610
611 # Test all the values of one header field against each [regexp,
612 # folder-expression] pair.
613 sub match_one_field {
614 my $values = shift;
615 my $filters = shift;
616 for my $value (@$values) {
617 for my $pair (@$filters) {
618 my ($regexp, $expression) = @$pair;
619 if ($value =~ $regexp) {
620 my $result;
621 if (eval "\$result = \"$expression\"") {
622 return $result;
623 }
624 }
625 }
626 }
627 }
628
629 sub scan_line {
630 my ($headers, $mhfolder, $msgnum, $nf, $nm, $nF, $ns) = @_;
631 my $from = '';
632 my $subject = '';
633 # Sometimes these headers are missing...
634 eval { $from = [@{$headers->{'from'}}]->[-1] };
635 eval { $subject = [@{$headers->{'subject'}}]->[-1] };
636 # Replace garbage characters.
637 for ($from, $subject) {
638 tr/\x00-\x1f\x80-\xff/?/;
639 }
640 return sprintf("\%-${nf}s \%${nm}d \%-${nF}s \%s",
641 substr($mhfolder, 0, $nf), substr($msgnum, 0, $nm),
642 substr($from, 0, $nF),
643 substr($subject, 0, $ns));
644 }
645
646 sub filter_mail {
647 my $inbox = shift;
648 @_ or return ();
649 my $msgcount = @_ - 2; # don't count . and ..
650 my $len = length($msgcount);
651 my @baton;
652 my $msg;
653 my $mhfolder;
654 my $spam = 0;
655 my $saved = 0;
656 my $msgnum;
657 my %folders;
658
659 # XXX lame names
660 my $nf = int($COLUMNS * $SCAN_P_FOLDER);
661 my $nm = int($COLUMNS * $SCAN_P_MESSAGE);
662 my $nF = int($COLUMNS * $SCAN_P_FROM);
663 my $ns = $COLUMNS - $nf - $nm - $nF - 3;
664
665 my %batons;
666 for my $hook (@start_hooks) {
667 my ($handle, @baton) = $hook->();
668 if (defined($handle)) {
669 $batons{$handle} = [@baton];
670 }
671 }
672
673 my $tty = -t STDOUT;
674 if (not $tty) {
675 # Print a newline after the incomplete "N messages..." line.
676 print("\n");
677 }
678
679 for $msg (@_) {
680 ($msg eq '.' or $msg eq '..') and next;
681
682 my $headers = get_headers($msg);
683
684 undef($mhfolder);
685 for my $hook (@filter_hooks) {
686 my $result = $hook->(\%batons, $headers, $msg);
687 defined($result) and ($mhfolder = $result);
688 }
689
690 defined($mhfolder) or ($mhfolder = find_mh_folder($msg, $headers));
691
692 $msgnum = store_message($inbox, $msg, $mhfolder);
693 $folders{$mhfolder}++;
694
695 if ($tty) {
696 print("\r");
697 }
698
699 if ($mhfolder eq 'SPAM') {
700 $spam++;
701 $SPAM{$msgnum} = [$headers, undef];
702 } else {
703 $saved++;
704 print(scan_line($headers, $mhfolder, $msgnum, $nf, $nm, $nF, $ns),
705 "\n");
706 }
707
708 for my $hook (@post_store_hooks) {
709 $hook->(\%batons, $headers, $mhfolder, $msgnum);
710 }
711
712 if ($tty) {
713 printf(" \%${len}d SPAM \%${len}d saved \%${len}d/%1d",
714 $spam, $saved, $spam + $saved, $msgcount);
715 }
716
717 defined($maxmsgs) and ($spam + $saved < $maxmsgs or last);
718 }
719 print("\n");
720
721 for my $hook (@stop_hooks) {
722 $hook->(\%batons);
723 }
724
725 return %folders;
726 }
727
728 sub build_dot_folders {
729 my $folders = shift;
730 my $fh = shift;
731 my $fn;
732
733 if (defined($fh)) {
734 while (<$fh>) {
735 chomp;
736 $folders->{$_}++;
737 }
738 }
739
740 eval { ($fh, $fn) = tempfile("$mh/.folders.XXXXX") };
741 if ($@) {
742 warn("$@");
743 return;
744 }
745
746 for my $folder (sort { $folder_sorter->($a,$b) } keys(%$folders)) {
747 print($fh "$folder\n");
748 }
749
750 if (not close($fh)) {
751 warn("close($fn): $!");
752 unlink($fn) or warn("unlink($fn): $!");
753 return;
754 }
755
756 rename($fn, "$mh/.folders") or warn("rename($fn, $mh/.folders): $!");
757 }
758
759 sub create_dot_folders {
760 if (-f "$HOME/.minc") {
761 require "$HOME/.minc";
762 }
763
764 my %folders;
765 open(my $fh, '-|', 'folders', '-fast', '-recur')
766 or die("open(folders|): $!");
767 build_dot_folders(\%folders, $fh);
768 return 0;
769 }
770
771 sub update_dot_folders {
772 my $folders = shift;
773 my $fh;
774
775 if (not open($fh, "$mh/.folders") and not $!{ENOENT}) {
776 # For ENOENT, we go ahead and create it, else we error and
777 # don't clobber it.
778 warn("open($mh/.folders): $!");
779 return;
780 }
781
782 build_dot_folders($folders, $fh);
783 }
784
785 # XXX Could use some unification with getfiles...
786 sub maildir_spam {
787 my $dir = "$MAILDIR/spam/new";
788
789 if (not chdir($dir)) {
790 $!{ENOENT} or print(STDERR "skipping maildir spam: chdir($dir): $!\n");
791 return;
792 }
793
794 if (not opendir(DIR, '.')) {
795 print(STDERR "skipping maildir spam: opendir($dir): $!\n");
796 return;
797 }
798
799 $! = 0;
800 my @spams = readdir(DIR);
801 if ($! != 0) {
802 print(STDERR "skipping maildir spam: readdir($dir): $!\n");
803 return;
804 }
805
806 closedir(DIR);
807
808 for my $msg (@spams) {
809 ($msg eq '.' or $msg eq '..') and next;
810 my $msgnum = store_message($msg, 'SPAM');
811 # Store the original file name for scan_spam in -n mode.
812 $SPAM{$msgnum} = [undef, $msg];
813 }
814 }
815
816 sub scan_spam {
817 my ($msgnum, $header, $tuple, $msg);
818
819 # Unlike filter_mail, we don't need to print the folder name.
820 # Calculate how many columns would be allocated to it...
821 my $nf = int($COLUMNS * $SCAN_P_FOLDER);
822 # ...and add that amount to COLUMNS to calculate the number of columns to
823 # allocate to msgnum and from snippet, thus filling the line without
824 # printing the folder name.
825 my $nm = int(($COLUMNS + $nf) * $SCAN_P_MESSAGE);
826 my $nF = int(($COLUMNS + $nf) * $SCAN_P_FROM);
827 my $ns = $COLUMNS - $nm - $nF - 3;
828
829 for $msgnum (sort(keys(%SPAM))) {
830 $tuple = $SPAM{$msgnum};
831 if (defined($tuple->[0])) {
832 # Filed by filter_mail, so we have the header.
833 $header = $tuple->[0];
834 } elsif (defined($tuple->[1])) {
835 # Filed by maildir_spam, so we don't have the header.
836 if ($run) {
837 # The message has been filed, load it from $mh.
838 $msg = "$mh/SPAM/$msgnum";
839 } else {
840 # The message has not been filed, load it from the maildir.
841 # $tuple->[1] is just a basename, not a path; this works
842 # because maildir_spam did chdir(Maildir/spam/new).
843 $msg = $tuple->[1];
844 }
845 $header = get_headers($msg);
846 } else {
847 print(STDERR
848 "BUG: corrupt SPAM tuple, neither element defined",
849 " for message $msgnum\n");
850 next;
851 }
852 print(scan_line($header, '', $msgnum, 0, $nm, $nF, $ns),
853 "\n");
854 }
855 }
856
857 \f
858 if (!caller()) {
859 my $st;
860
861 if ($dumpfilters) {
862 require "$HOME/.minc";
863 $Data::Dumper::Indent = 1;
864 print(Dumper(\@FILTERS));
865 exit;
866 }
867
868 $rebuild_dot_folders and exit(create_dot_folders);
869
870 if (-f "$HOME/.minc") {
871 require "$HOME/.minc";
872 }
873
874 my $inbox;
875 if ($MAILDIR) {
876 $inbox = $MAILDIR;
877 } elsif (-d "$HOME/Maildir") {
878 $inbox = "$HOME/Maildir";
879 }
880
881 if (@ARGV > 0) {
882 $inbox = shift(@ARGV);
883 }
884
885 my @files;
886 if (substr($inbox, 0, 1) eq '+') {
887 my @msgs = @ARGV;
888 if (!@msgs) {
889 @msgs = ('cur-last');
890 }
891 open(my $fh, '-|', 'mhpath', @msgs) or die("open(mhpath|): $!");
892 chomp(@files = <$fh>);
893 if (!close($fh)) {
894 $! == 0 or die("open(mhpath|): $!");
895 die('mhpath '. exit_msg($?));
896 }
897 @files > 0 or exit 0;
898 } else {
899 @ARGV == 0 or pod2usage();
900 chdir("$inbox/new") or die("chdir($inbox/new): $!");
901 @files = map { $_->[1] }
902 sort { $a->[0] <=> $b->[0] }
903 map {
904 $st = stat($_) or die("stat($_): $!");
905 [ $st->mtime, $_ ]
906 } getfiles('.');
907
908 @files = map { $_->[1] }
909 sort { $a->[0] <=> $b->[0] }
910 map {
911 if (not ($st = stat($_))) {
912 die("stat($_): $!");
913 }
914 [$st->mtime, $_]
915 }
916 getfiles('.');
917 }
918
919 my %folders = filter_mail($inbox, @files);
920
921 $run and %folders and update_dot_folders(\%folders);
922
923 maildir_spam();
924 scan_spam();
925 }
926
927 1;
928
929 \f
930 __END__
931
932 =head1 THE FILTERS STRUCTURE
933
934 Each element of @FILTERS is a filter. A filter is itself an array.
935 The first element of a filter is a string, the name of the header this
936 filter acts upon. The header name is not case-sensitive. Each
937 subsequent element of a filter is a pair (i.e. a two-element array):
938 first, a regular expression B<minc> uses to determine whether this
939 filter matches or not, and second, an expression which B<minc>
940 evaluates to get the folder name.
941
942 B<minc> decides where to store a message by iterating over the
943 @FILTERS array. It tests each regexp of each filter against all
944 headers matching that filter's specified header. As soon as a match
945 is found, B<minc> evaluates the second part of the pair. This part
946 may contain positional parameters from the matched regexp ($1, $2,
947 etc.). The result of this expression is used as the folder name.
948
949 Multiple occurrences of the same header are preserved and tested
950 individually against the filters. That means, for example, that
951 filters can search all the Received headers for a certain string.
952
953 It is important to note that all the arrays of the @FILTERS structure
954 are traversed I<in order>. This means the filters can be arranged so
955 that some have priority over others. XXX: get Doug to write an
956 example of having the same header matched more than once.
957
958 Lastly, B<minc> supports a magic ' TO' header. Filters using this
959 header are matched against a collection of headers related to (and
960 including) the To. Which headers to use is determined by a regular
961 expression borrowed from procmail.
962
963 =head1 HOOKS
964
965 Filter hooks take a reference to a hash of batons, a reference to a
966 hash of headers, and the message filename as arguments. It returns
967 undef to decline filtering of this message (thus falling back to
968 subsequent filter hooks, and finally @FILTERS), or the name of the
969 folder to store this message into.
970
971 One of B<minc>'s global variables is available to the user-defined
972 hooks: $run. This boolean should be honored; hooks should only take
973 real action (i.e. removing or creating files, running external
974 programs, etc.) if $run is non-zero.
975
976 The baton hash is created simply from the start hooks; if the hook
977 returns at least one defined value, this value is used as the key and
978 all other return values are put into a list reference as the value.
979 This hash is then passed by reference to all filter, post-store, and
980 stop hooks.
981
982 Post store hooks take a reference to a hash of batons, a reference to
983 a hash of headers, the folder this message was stored in, and its new
984 message number.
985
986 XXX: need more details about the hook process; for now read the code.
987
988 =head1 EXAMPLES
989
990 @FILTERS = (
991
992 ['List-Id',
993 ['<([[:graph:]]+)-([[:graph:]]+)\.lists\.sourceforge\.net>', 'l/$1/$2'],
994 ['<([[:graph:]]+?)(-list)?\.freedesktop\.org>', 'l/freedesktop/$1'],
995 ['<swig\.cs\.uchicago\.edu>', 'l/swig'],
996 ],
997
998 ['List-Post',
999 ['<mailto:([[:graph:]]+)+@([[:graph:]]+)\.apache\.org>', 'l/apache/$2/$1'],
1000 ],
1001
1002 ['To',
1003 ['root', 'root'],
1004 ],
1005 );
1006
1007 The first List-Id filter is a surprisingly effective one which creates
1008 appropriate folder names (such as l/htdig/updates and l/rox/devel) for
1009 all Sourceforge lists to which i subscribe. Certainly there are lists
1010 hosted at Sourceforge which do not work well with this, and this is
1011 where it is important to remember that the first match is the one
1012 uses. Simply put the more specific rules before this one.
1013
1014 The next List-Id example is simple. The swig example demonstrates
1015 that the folder name does not have to use a portion of the matched
1016 header; you can just hardcode the folder name.
1017
1018 The List-Post example is a nice one. Most ASF projects have their own
1019 apache.org subdomain, with mailing lists hosted there. So, given a
1020 list such as dev@httpd.apache.org, this filter will create the folder
1021 name l/apache/httpd/dev.
1022
1023 XXX Need hook examples.
1024
1025 =head1 AUTHORS
1026
1027 Written by Eric Gillespie <epg@pretzelnet.org>. Design by Eric
1028 Gillespie and Doug Porter <dsp@waterspout.com>.
1029
1030 This program is free software; you can redistribute it and/or modify
1031 it under the same terms as Perl itself.
1032
1033 =cut
1034
1035 # Local variables:
1036 # cperl-indent-level: 4
1037 # perl-indent-level: 4
1038 # indent-tabs-mode: nil
1039 # End:
1040
1041 # vi: set tabstop=4 expandtab: