]> diplodocus.org Git - minc/blob - minc
75fa67e833075bf7c1403c791a6dd29767522332
[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 @ARGV <= 1 or pod2usage();
112 }
113
114 our $run = !$norun;
115
116 =head1 ENVIRONMENT
117
118 =over 4
119
120 =item COLUMNS
121
122 How many columns the user's terminal can hold, used to print scan
123 lines for each processed message. Defaults to 80.
124
125 =item HOME
126
127 Where the configuration file (.minc) is found. Also,
128 $HOME/Maildir is used for the maildir if MAILDIR is not set.
129
130 =item MAILDIR
131
132 Where mail is delivered.
133
134 =back
135
136 =cut
137
138 use Env qw(COLUMNS HOME MAILDIR);
139
140 $COLUMNS ||= 80;
141
142 if (not $HOME) {
143 die("HOME environment variable must be set.\n");
144 }
145 if (not $MAILDIR) {
146 $MAILDIR = "$HOME/Maildir";
147 }
148
149 =head1 FILES
150
151 =over 4
152
153 =item $HOME/.minc
154
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.
158
159 =item `mhpath +`/.folders
160
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).
163
164 =item `mhpath +`/.minc.context
165
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
173 marked unseen.
174
175 =back
176
177 =cut
178
179 our @FILTERS;
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) };
186
187 my $mh;
188
189 $mh = `mhpath +`; $? >= 0 or die;
190 chomp($mh);
191 if (!$mh) {
192 die('mhpath did not give MH mail path: ' . exit_msg($?));
193 }
194
195 $ENV{"MHCONTEXT"} = $mh . '/.minc.context';
196
197 # TODO: Support dot-locking too. This works on FreeBSD and Linux.
198 my $locking = `mhparam datalocking`;
199 $? < 0 && die;
200 $? == 0 || die('mhparam datalocking: ' . exit_msg($?));
201 chomp($locking);
202 if ($locking ne 'fcntl') {
203 die("mh locking $locking not supported; only fcntl");
204 }
205
206 \f
207 ###############################################################################
208 # Utility procedures
209
210 sub exit_msg {
211 my $status = shift;
212 WIFEXITED($status) && return 'exited with status ' . WEXITSTATUS($status);
213 WIFSIGNALED($status) && return 'killed with signal ' . WTERMSIG($status);
214 # WTF
215 "died ($status)";
216 }
217
218 sub sort_by_list {
219 my $a = shift;
220 my $b = shift;
221
222 for my $i (@_) {
223 my $am = $a =~ $i;
224 my $bm = $b =~ $i;
225 if ($am) {
226 if ($bm) {
227 last;
228 }
229 return -1;
230 } elsif ($bm) {
231 return 1;
232 }
233 }
234
235 return $a cmp $b;
236 }
237
238 sub mkfolder {
239 my $folder = shift;
240 my $target;
241 my $component;
242
243 $target = $mh;
244 foreach $component (split('/', $folder)) {
245 $target = join('/', $target, $component);
246 -d $target or mkdir($target) or die("mkdir($target): $!");
247 }
248 }
249
250 sub getfiles {
251 my $dir = shift;
252 my @result;
253
254 if (not opendir(DIR, $dir)) {
255 die("opendir($dir): $!");
256 }
257
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,
262 # right? >sigh<
263 $! = 0;
264 @result = readdir(DIR);
265 if ($! != 0) {
266 die("readdir($dir): $!");
267 }
268
269 if (@result <= 2) {
270 return ();
271 }
272
273 STDOUT->autoflush(1);
274 if (@result == 3) {
275 print('1 message...');
276 } else {
277 print(@result - 2, ' messages...');
278 }
279
280 closedir(DIR);
281
282 return @result;
283 }
284
285 my %msgnum_cache;
286 sub get_highest_msgnum {
287 my $mhfolder = shift;
288 my $dir;
289 my @list;
290 my $highest;
291 my $msgnum;
292
293 if (defined($msgnum_cache{$mhfolder})) {
294 return $msgnum_cache{$mhfolder}++;
295 }
296
297 $dir = "$mh/$mhfolder";
298 if (not opendir(DIR, $dir)) {
299 die("opendir($dir): $!");
300 }
301
302 # Insert rant from getfiles here.
303 $! = 0;
304 @list = readdir(DIR);
305
306 if ($! != 0) {
307 die("readdir($dir): $!");
308 }
309
310 closedir(DIR);
311
312 $highest = 0;
313 foreach $msgnum (@list) {
314 # Look for integers.
315 if ($msgnum =~ /^[0-9]+$/) {
316 if ($msgnum > $highest) {
317 $highest = $msgnum;
318 }
319 }
320 }
321
322 $msgnum_cache{$mhfolder} = $highest;
323 return $msgnum_cache{$mhfolder}++;
324 }
325
326 sub mark {
327 my $folder = shift;
328 my $msgnum = shift;
329 my $seq = shift;
330
331 my $fn = "$mh/$folder/.mh_sequences";
332 my ($fh, $e) = lkopen_fcntl($fn, O_RDWR | O_CREAT, 0600);
333
334 my @sequences = <$fh>;
335 chomp(@sequences);
336
337 truncate($fh, 0) or die("truncate($fn): $!");
338 seek($fh, 0, SEEK_SET) or die("seek($fn): $!");
339
340 my $marked = 0;
341 for $_ (@sequences) {
342 if (/^$seq: (.*)/) {
343 my @parts;
344 my @result;
345 my $done = 0;
346 for my $part (split(' ', $1)) {
347 if (not $done) {
348 my ($st, $en) = split('-', $part);
349 if ((defined($en) and ($msgnum >= $st and $msgnum <= $en))
350 or $msgnum == $st) {
351 # It's already there.
352 $done = 1;
353 }
354 if (defined($en)) {
355 if ($st - 1 == $msgnum) {
356 $part = "$msgnum-$en";
357 $done = 1;
358 } elsif ($en + 1 == $msgnum) {
359 $part = "$st-$msgnum";
360 $done = 1;
361 }
362 } else {
363 if ($part - 1 == $msgnum) {
364 $part = "$msgnum-$part";
365 $done = 1;
366 } elsif ($part + 1 == $msgnum) {
367 $part = "$part-$msgnum";
368 $done = 1;
369 }
370 }
371 }
372 push(@result, $part);
373 }
374 if (not $done) {
375 push(@result, $msgnum);
376 }
377 print($fh "$seq: ", join(' ', @result), "\n");
378 $marked = 1;
379 } else {
380 print($fh "$_\n");
381 }
382 }
383 $marked or print($fh "$seq: $msgnum\n");
384 close($fh) or die("close(>$fn): $!");
385 }
386
387 # Based on nmh's lkopen_fcntl
388 # Return 0 for success, errno on failure.
389 sub lkopen_fcntl {
390 my $fn = shift;
391 my $access = shift;
392 my $mode = shift;
393 my $errno;
394
395 # The assumption here is that if you open the file for writing, you
396 # need an exclusive lock.
397
398 my $tries = LOCK_TRIES;
399 for (;;) {
400 sysopen(my $fh, $fn, $access, $mode) or die("sysopen($fn): $!");
401
402 my $flk = File::FcntlLock->new;
403 $flk->l_start(0);
404 $flk->l_len(0);
405 $flk->l_type(($access & O_ACCMODE) == O_RDONLY ? F_RDLCK : F_WRLCK);
406 $flk->l_whence(SEEK_SET);
407
408 # Really should only retry on EAGAIN and EINTR...
409 if ($flk->lock($fh, F_SETLK)) {
410 return $fh;
411 }
412
413 $errno = $flk->lock_errno;
414 close($fh) or die("close($fn): $!");
415
416 if (--$tries == 0) {
417 last;
418 }
419 sleep(1);
420 }
421
422 local $! = $errno;
423 die("failed to lock $fn: $!");
424 }
425
426 sub store_message {
427 my $msg = shift;
428 my $mhfolder = shift;
429 my $msgnum;
430 my $try;
431 my $mhmsg;
432
433 # We must do this even in -n mode because later steps fail without
434 # it. This should be harmless.
435 mkfolder($mhfolder);
436
437 # This loop is a modified version of the maildir delivery algorithm.
438 $msgnum = get_highest_msgnum($mhfolder);
439 for ($try = 0; ; $try++) {
440 $msgnum++;
441 $mhmsg = "$mh/$mhfolder/$msgnum";
442
443 if (not stat($mhmsg)) {
444 if ($!{ENOENT}) {
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.
452
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.
463 if ($run) {
464 if (sysopen(MSG, $mhmsg,
465 O_WRONLY | O_EXCL | O_CREAT, 0600)) {
466 close(MSG);
467 last;
468 }
469 } else {
470 last;
471 }
472 }
473 }
474
475 # This algorithm is different from the maildir one; let's make
476 # 10 tries instead of 3.
477 if ($try == 9) {
478 die("Attempted filename $mhmsg exists.");
479 }
480
481 # This algorithm is different; i don't think we need to sleep.
482 #sleep(2);
483 }
484
485 if ($run) {
486 if (not rename($msg, $mhmsg)) {
487 die("rename($msg, $mhmsg): $!");
488 }
489
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 return $msgnum;
500 }
501
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.
509 sub get_headers {
510 my $msg = shift;
511 my %headers;
512 my $current; # current header, used for unfolding lines
513 my $fieldname; # unmolested header name
514 my $contents; # contents of header
515
516 open(MSG, $msg) or die("open(MSG, $msg): $!");
517 while (<MSG>) {
518 chomp;
519 if (length == 0) {
520 last;
521 }
522
523 if (/^\s/) {
524 # folded header continuation
525
526 if (not defined($current)) {
527 warn('Malformed message, cannot parse headers.');
528 next;
529 }
530
531 @{$headers{$current}}[-1] .= $_;
532 } else {
533 ($fieldname) = split(/:/);
534 $current = lc($fieldname);
535 (undef, $contents) = split(/^\Q$fieldname\E:\s*/);
536
537 if (defined($headers{$current})) {
538 # multiple occurence of same header
539 push(@{$headers{$current}}, $contents);
540 } else {
541 # first occurence of a header
542 $headers{$current} = [$contents];
543 }
544 }
545 }
546 close(MSG);
547
548 return \%headers;
549 }
550
551 \f
552 ###############################################################################
553 # Filtering
554
555 sub find_mh_folder {
556 my $msg = shift;
557 my $header = shift;
558
559 if (not %$header) {
560 return 'malformed';
561 }
562
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);
568 $m && return $m;
569 next;
570 }
571
572 my $m = match($header, @$filterref);
573 $m && return $m;
574 }
575
576 return 'inbox';
577 }
578
579 # Test all the header fields against each [regexp, folder-expression] pair.
580 sub match {
581 my $header = shift;
582 my $filter_field = shift;
583 my @filters = @_;
584
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);
590 $m && return $m;
591 }
592 }
593 # Now that it's been processed specially, skip normal handling.
594 return;
595 }
596
597 # Walk the list of header fields matching the filter's specified header.
598 my $m = match_one_field($header->{lc($filter_field)}, \@filters);
599 $m && return $m;
600 }
601
602 # Test all the values of one header field against each [regexp,
603 # folder-expression] pair.
604 sub match_one_field {
605 my $values = shift;
606 my $filters = shift;
607 for my $value (@$values) {
608 for my $pair (@$filters) {
609 my ($regexp, $expression) = @$pair;
610 if ($value =~ $regexp) {
611 my $result;
612 if (eval "\$result = \"$expression\"") {
613 return $result;
614 }
615 }
616 }
617 }
618 }
619
620 sub scan_line {
621 my ($headers, $mhfolder, $msgnum, $nf, $nm, $nF, $ns) = @_;
622 my $from = '';
623 my $subject = '';
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/?/;
630 }
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));
635 }
636
637 sub filter_mail {
638 @_ or return ();
639 my $msgcount = @_ - 2; # don't count . and ..
640 my $len = length($msgcount);
641 my @baton;
642 my $msg;
643 my $mhfolder;
644 my $spam = 0;
645 my $saved = 0;
646 my $msgnum;
647 my %folders;
648
649 if (-f "$HOME/.minc") {
650 require "$HOME/.minc";
651 }
652
653 # XXX lame names
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;
658
659 my %batons;
660 for my $hook (@start_hooks) {
661 my ($handle, @baton) = $hook->();
662 if (defined($handle)) {
663 $batons{$handle} = [@baton];
664 }
665 }
666
667 my $tty = -t STDOUT;
668 if (not $tty) {
669 # Print a newline after the incomplete "N messages..." line.
670 print("\n");
671 }
672
673 for $msg (@_) {
674 ($msg eq '.' or $msg eq '..') and next;
675
676 my $headers = get_headers($msg);
677
678 undef($mhfolder);
679 for my $hook (@filter_hooks) {
680 my $result = $hook->(\%batons, $headers, $msg);
681 defined($result) and ($mhfolder = $result);
682 }
683
684 defined($mhfolder) or ($mhfolder = find_mh_folder($msg, $headers));
685
686 $msgnum = store_message($msg, $mhfolder);
687 $folders{$mhfolder}++;
688
689 if ($tty) {
690 print("\r");
691 }
692
693 if ($mhfolder eq 'SPAM') {
694 $spam++;
695 $SPAM{$msgnum} = [$headers, undef];
696 } else {
697 $saved++;
698 print(scan_line($headers, $mhfolder, $msgnum, $nf, $nm, $nF, $ns),
699 "\n");
700 }
701
702 for my $hook (@post_store_hooks) {
703 $hook->(\%batons, $headers, $mhfolder, $msgnum);
704 }
705
706 if ($tty) {
707 printf(" \%${len}d SPAM \%${len}d saved \%${len}d/%1d",
708 $spam, $saved, $spam + $saved, $msgcount);
709 }
710
711 defined($maxmsgs) and ($spam + $saved < $maxmsgs or last);
712 }
713 print("\n");
714
715 for my $hook (@stop_hooks) {
716 $hook->(\%batons);
717 }
718
719 return %folders;
720 }
721
722 sub build_dot_folders {
723 my $folders = shift;
724 my $fh = shift;
725 my $fn;
726
727 if (defined($fh)) {
728 while (<$fh>) {
729 chomp;
730 $folders->{$_}++;
731 }
732 }
733
734 eval { ($fh, $fn) = tempfile("$mh/.folders.XXXXX") };
735 if ($@) {
736 warn("$@");
737 return;
738 }
739
740 for my $folder (sort { $folder_sorter->($a,$b) } keys(%$folders)) {
741 print($fh "$folder\n");
742 }
743
744 if (not close($fh)) {
745 warn("close($fn): $!");
746 unlink($fn) or warn("unlink($fn): $!");
747 return;
748 }
749
750 rename($fn, "$mh/.folders") or warn("rename($fn, $mh/.folders): $!");
751 }
752
753 sub create_dot_folders {
754 if (-f "$HOME/.minc") {
755 require "$HOME/.minc";
756 }
757
758 my %folders;
759 open(my $fh, '-|', 'folders', '-fast', '-recur')
760 or die("open(folders|): $!");
761 build_dot_folders(\%folders, $fh);
762 return 0;
763 }
764
765 sub update_dot_folders {
766 my $folders = shift;
767 my $fh;
768
769 if (not open($fh, "$mh/.folders") and not $!{ENOENT}) {
770 # For ENOENT, we go ahead and create it, else we error and
771 # don't clobber it.
772 warn("open($mh/.folders): $!");
773 return;
774 }
775
776 build_dot_folders($folders, $fh);
777 }
778
779 # XXX Could use some unification with getfiles...
780 sub maildir_spam {
781 my $dir = "$MAILDIR/spam/new";
782
783 if (not chdir($dir)) {
784 $!{ENOENT} or print(STDERR "skipping maildir spam: chdir($dir): $!\n");
785 return;
786 }
787
788 if (not opendir(DIR, '.')) {
789 print(STDERR "skipping maildir spam: opendir($dir): $!\n");
790 return;
791 }
792
793 $! = 0;
794 my @spams = readdir(DIR);
795 if ($! != 0) {
796 print(STDERR "skipping maildir spam: readdir($dir): $!\n");
797 return;
798 }
799
800 closedir(DIR);
801
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];
807 }
808 }
809
810 sub scan_spam {
811 my ($msgnum, $header, $tuple, $msg);
812
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;
822
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.
830 if ($run) {
831 # The message has been filed, load it from $mh.
832 $msg = "$mh/SPAM/$msgnum";
833 } else {
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).
837 $msg = $tuple->[1];
838 }
839 $header = get_headers($msg);
840 } else {
841 print(STDERR
842 "BUG: corrupt SPAM tuple, neither element defined",
843 " for message $msgnum\n");
844 next;
845 }
846 print(scan_line($header, '', $msgnum, 0, $nm, $nF, $ns),
847 "\n");
848 }
849 }
850
851 \f
852 if (!caller()) {
853 my $st;
854
855 if ($dumpfilters) {
856 require "$HOME/.minc";
857 $Data::Dumper::Indent = 1;
858 print(Dumper(\@FILTERS));
859 exit;
860 }
861
862 $rebuild_dot_folders and exit(create_dot_folders);
863
864 my @files;
865 # XXX some options:
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
870 # just do cur-last
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
875 # my @filtered;
876 # for (@msgs) {
877 # if (!my $new = filter($_)) {
878 # # If @filtered is empty, this message already has the right number.
879 # $new = shift(@filtered) || next;
880 # }
881 # push(@filtered, $_);
882 # rename($_, $new);
883 # }
884
885 if (@ARGV > 0) {
886 # XXX if sticking with this approach, reject arg other than '-'
887 chomp(@files = <>);
888 @files > 0 || exit 0;
889 } else {
890 chdir("$MAILDIR/new") or die("chdir($MAILDIR/new): $!");
891 @files = getfiles('.');
892 }
893
894 my %folders = filter_mail(map { $_->[1] }
895 sort { $a->[0] <=> $b->[0] }
896 map {
897 if (not ($st = stat($_))) {
898 die("stat($_): $!");
899 }
900 [$st->mtime, $_]
901 }
902 @files);
903
904 $run and %folders and update_dot_folders(\%folders);
905
906 maildir_spam();
907 scan_spam();
908 }
909
910 1;
911
912 \f
913 __END__
914
915 =head1 THE FILTERS STRUCTURE
916
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.
924
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.
931
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.
935
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.
940
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.
945
946 =head1 HOOKS
947
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.
953
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.
958
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
963 stop hooks.
964
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
967 message number.
968
969 XXX: need more details about the hook process; for now read the code.
970
971 =head1 EXAMPLES
972
973 @FILTERS = (
974
975 ['List-Id',
976 ['<([[:graph:]]+)-([[:graph:]]+)\.lists\.sourceforge\.net>', 'l/$1/$2'],
977 ['<([[:graph:]]+?)(-list)?\.freedesktop\.org>', 'l/freedesktop/$1'],
978 ['<swig\.cs\.uchicago\.edu>', 'l/swig'],
979 ],
980
981 ['List-Post',
982 ['<mailto:([[:graph:]]+)+@([[:graph:]]+)\.apache\.org>', 'l/apache/$2/$1'],
983 ],
984
985 ['To',
986 ['root', 'root'],
987 ],
988 );
989
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.
996
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.
1000
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.
1005
1006 XXX Need hook examples.
1007
1008 =head1 AUTHORS
1009
1010 Written by Eric Gillespie <epg@pretzelnet.org>. Design by Eric
1011 Gillespie and Doug Porter <dsp@waterspout.com>.
1012
1013 This program is free software; you can redistribute it and/or modify
1014 it under the same terms as Perl itself.
1015
1016 =cut
1017
1018 # Local variables:
1019 # cperl-indent-level: 4
1020 # perl-indent-level: 4
1021 # indent-tabs-mode: nil
1022 # End:
1023
1024 # vi: set tabstop=4 expandtab: