]> diplodocus.org Git - minc/blob - minc
Fix bug with compacting the messages that stay in inbox.
[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 $src_msgpath = shift;
426 my $mhfolder = shift;
427 my ($dst_msgnum, $dst_msgpath);
428
429 # We must do this even in -n mode because later steps fail without
430 # it. This should be harmless.
431 mkfolder($mhfolder);
432
433 if ("+$mhfolder" eq $inbox) {
434 # If @filtered is empty, this message already has the right number.
435 if (!($dst_msgpath = shift(@filtered))) {
436 $src_msgpath =~ m|.*/(\d+)$|;
437 return $1;
438 }
439 $dst_msgpath =~ m|.*/(\d+)$|;
440 $dst_msgnum = $1;
441 } else {
442 # This loop is a modified version of the maildir delivery algorithm.
443 $dst_msgnum = get_highest_msgnum($mhfolder);
444 my $try;
445 for ($try = 0; ; $try++) {
446 $dst_msgnum++;
447 $dst_msgpath = "$mh/$mhfolder/$dst_msgnum";
448
449 if (not stat($dst_msgpath)) {
450 if ($!{ENOENT}) {
451 # Now we have a non-existent file, let's try to create
452 # it. We must create a zero-byte file first because a
453 # file my appear between our happy stat results and
454 # our later rename(2), which would clobber said file.
455 # So attempt to create a file with this name. If it
456 # succeeds, in just a bit here we'll knowingly clobber
457 # this file with the rename(2) call.
458
459 # Another way to do this is not to use rename(2), but
460 # use link(2) + unlink(2) instead. That's how the
461 # standard maildir algorithm does it. Each method has
462 # a disadvantage: the program may crash between the
463 # link(2) and unlink(2) calls. With the standard
464 # maildir algorithm, that means the message will end
465 # up duplicated. The advantage of creating an empty
466 # file followed by rename(2) is that an extra empty
467 # file is left behind as opposed to a duplicate
468 # message. This is more easily detected by the user.
469 if ($run) {
470 if (sysopen(MSG, $dst_msgpath,
471 O_WRONLY | O_EXCL | O_CREAT, 0600)) {
472 close(MSG);
473 last;
474 }
475 } else {
476 last;
477 }
478 }
479 }
480
481 # This algorithm is different from the maildir one; let's make
482 # 10 tries instead of 3.
483 if ($try == 9) {
484 die("Attempted filename $dst_msgpath exists.");
485 }
486
487 # This algorithm is different; i don't think we need to sleep.
488 #sleep(2);
489 }
490
491 if ($run) {
492 # Mark each message as soon as we store it and bomb if that
493 # fails. While it is slow, it is not safe to store multiple
494 # messages and then have a failure before marking some (or
495 # all).
496 if ($mhfolder ne 'SPAM') {
497 mark($mhfolder, $dst_msgnum, 'unseen');
498 }
499 }
500 }
501 push(@filtered, $src_msgpath);
502
503 if ($run) {
504 if (not rename($src_msgpath, $dst_msgpath)) {
505 die("rename($src_msgpath, $dst_msgpath): $!");
506 }
507 }
508
509 return $dst_msgnum;
510 }
511
512 # Parse a message file into a structure describing the headers. The
513 # structure is a hash of arrays. The hash keys are the names of the
514 # headers found in the message, made all lower-case. Each item in
515 # the hash is an array of header text. The array has one element
516 # per occurrence of the header. Most headers will only have a single
517 # element because they occur only once. The Received header is the
518 # most common header with multiple texts.
519 sub get_headers {
520 my $msg = shift;
521 my %headers;
522 my $current; # current header, used for unfolding lines
523 my $fieldname; # unmolested header name
524 my $contents; # contents of header
525
526 open(MSG, $msg) or die("open(MSG, $msg): $!");
527 while (<MSG>) {
528 chomp;
529 if (length == 0) {
530 last;
531 }
532
533 if (/^\s/) {
534 # folded header continuation
535
536 if (not defined($current)) {
537 warn('Malformed message, cannot parse headers.');
538 next;
539 }
540
541 @{$headers{$current}}[-1] .= $_;
542 } else {
543 ($fieldname) = split(/:/);
544 $current = lc($fieldname);
545 (undef, $contents) = split(/^\Q$fieldname\E:\s*/);
546
547 if (defined($headers{$current})) {
548 # multiple occurence of same header
549 push(@{$headers{$current}}, $contents);
550 } else {
551 # first occurence of a header
552 $headers{$current} = [$contents];
553 }
554 }
555 }
556 close(MSG);
557
558 return \%headers;
559 }
560
561 \f
562 ###############################################################################
563 # Filtering
564
565 sub find_mh_folder {
566 my $msg = shift;
567 my $header = shift;
568
569 if (not %$header) {
570 return 'malformed';
571 }
572
573 # Walk the list of filters. This structure is documented in
574 # pod at the end of the program.
575 for my $filterref (@FILTERS) {
576 if (ref($filterref) eq 'CODE') {
577 my $m = $filterref->($header, $msg);
578 $m && return $m;
579 next;
580 }
581
582 my $m = match($header, @$filterref);
583 $m && return $m;
584 }
585
586 return 'inbox';
587 }
588
589 # Test all the header fields against each [regexp, folder-expression] pair.
590 sub match {
591 my $header = shift;
592 my $filter_field = shift;
593 my @filters = @_;
594
595 # Handle filters using the magic TO header specially.
596 if ($filter_field eq $MAGIC_TO_TOKEN) {
597 for my $field_name (keys(%$header)) {
598 if ($field_name =~ /$MAGIC_TO_REGEX/i) {
599 my $m = match_one_field($header->{$field_name}, \@filters);
600 $m && return $m;
601 }
602 }
603 # Now that it's been processed specially, skip normal handling.
604 return;
605 }
606
607 # Walk the list of header fields matching the filter's specified header.
608 my $m = match_one_field($header->{lc($filter_field)}, \@filters);
609 $m && return $m;
610 }
611
612 # Test all the values of one header field against each [regexp,
613 # folder-expression] pair.
614 sub match_one_field {
615 my $values = shift;
616 my $filters = shift;
617 for my $value (@$values) {
618 for my $pair (@$filters) {
619 my ($regexp, $expression) = @$pair;
620 if ($value =~ $regexp) {
621 my $result;
622 if (eval "\$result = \"$expression\"") {
623 return $result;
624 }
625 }
626 }
627 }
628 }
629
630 sub scan_line {
631 my ($headers, $mhfolder, $msgnum, $nf, $nm, $nF, $ns) = @_;
632 my $from = '';
633 my $subject = '';
634 # Sometimes these headers are missing...
635 eval { $from = [@{$headers->{'from'}}]->[-1] };
636 eval { $subject = [@{$headers->{'subject'}}]->[-1] };
637 # Replace garbage characters.
638 for ($from, $subject) {
639 tr/\x00-\x1f\x80-\xff/?/;
640 }
641 return sprintf("\%-${nf}s \%${nm}d \%-${nF}s \%s",
642 substr($mhfolder, 0, $nf), substr($msgnum, 0, $nm),
643 substr($from, 0, $nF),
644 substr($subject, 0, $ns));
645 }
646
647 sub filter_mail {
648 my $inbox = shift;
649 @_ or return ();
650 my $msgcount = @_ - 2; # don't count . and ..
651 my $len = length($msgcount);
652 my @baton;
653 my $msg;
654 my $mhfolder;
655 my $spam = 0;
656 my $saved = 0;
657 my $msgnum;
658 my %folders;
659
660 # XXX lame names
661 my $nf = int($COLUMNS * $SCAN_P_FOLDER);
662 my $nm = int($COLUMNS * $SCAN_P_MESSAGE);
663 my $nF = int($COLUMNS * $SCAN_P_FROM);
664 my $ns = $COLUMNS - $nf - $nm - $nF - 3;
665
666 my %batons;
667 for my $hook (@start_hooks) {
668 my ($handle, @baton) = $hook->();
669 if (defined($handle)) {
670 $batons{$handle} = [@baton];
671 }
672 }
673
674 my $tty = -t STDOUT;
675 if (not $tty) {
676 # Print a newline after the incomplete "N messages..." line.
677 print("\n");
678 }
679
680 for $msg (@_) {
681 ($msg eq '.' or $msg eq '..') and next;
682
683 my $headers = get_headers($msg);
684
685 undef($mhfolder);
686 for my $hook (@filter_hooks) {
687 my $result = $hook->(\%batons, $headers, $msg);
688 defined($result) and ($mhfolder = $result);
689 }
690
691 defined($mhfolder) or ($mhfolder = find_mh_folder($msg, $headers));
692
693 $msgnum = store_message($inbox, $msg, $mhfolder);
694 $folders{$mhfolder}++;
695
696 if ($tty) {
697 print("\r");
698 }
699
700 if ($mhfolder eq 'SPAM') {
701 $spam++;
702 $SPAM{$msgnum} = [$headers, undef];
703 } else {
704 $saved++;
705 print(scan_line($headers, $mhfolder, $msgnum, $nf, $nm, $nF, $ns),
706 "\n");
707 }
708
709 for my $hook (@post_store_hooks) {
710 $hook->(\%batons, $headers, $mhfolder, $msgnum);
711 }
712
713 if ($tty) {
714 printf(" \%${len}d SPAM \%${len}d saved \%${len}d/%1d",
715 $spam, $saved, $spam + $saved, $msgcount);
716 }
717
718 defined($maxmsgs) and ($spam + $saved < $maxmsgs or last);
719 }
720 print("\n");
721
722 for my $hook (@stop_hooks) {
723 $hook->(\%batons);
724 }
725
726 return %folders;
727 }
728
729 sub build_dot_folders {
730 my $folders = shift;
731 my $fh = shift;
732 my $fn;
733
734 if (defined($fh)) {
735 while (<$fh>) {
736 chomp;
737 $folders->{$_}++;
738 }
739 }
740
741 eval { ($fh, $fn) = tempfile("$mh/.folders.XXXXX") };
742 if ($@) {
743 warn("$@");
744 return;
745 }
746
747 for my $folder (sort { $folder_sorter->($a,$b) } keys(%$folders)) {
748 print($fh "$folder\n");
749 }
750
751 if (not close($fh)) {
752 warn("close($fn): $!");
753 unlink($fn) or warn("unlink($fn): $!");
754 return;
755 }
756
757 rename($fn, "$mh/.folders") or warn("rename($fn, $mh/.folders): $!");
758 }
759
760 sub create_dot_folders {
761 if (-f "$HOME/.minc") {
762 require "$HOME/.minc";
763 }
764
765 my %folders;
766 open(my $fh, '-|', 'folders', '-fast', '-recur')
767 or die("open(folders|): $!");
768 build_dot_folders(\%folders, $fh);
769 return 0;
770 }
771
772 sub update_dot_folders {
773 my $folders = shift;
774 my $fh;
775
776 if (not open($fh, "$mh/.folders") and not $!{ENOENT}) {
777 # For ENOENT, we go ahead and create it, else we error and
778 # don't clobber it.
779 warn("open($mh/.folders): $!");
780 return;
781 }
782
783 build_dot_folders($folders, $fh);
784 }
785
786 # XXX Could use some unification with getfiles...
787 sub maildir_spam {
788 my $dir = "$MAILDIR/spam/new";
789
790 if (not chdir($dir)) {
791 $!{ENOENT} or print(STDERR "skipping maildir spam: chdir($dir): $!\n");
792 return;
793 }
794
795 if (not opendir(DIR, '.')) {
796 print(STDERR "skipping maildir spam: opendir($dir): $!\n");
797 return;
798 }
799
800 $! = 0;
801 my @spams = readdir(DIR);
802 if ($! != 0) {
803 print(STDERR "skipping maildir spam: readdir($dir): $!\n");
804 return;
805 }
806
807 closedir(DIR);
808
809 for my $msg (@spams) {
810 ($msg eq '.' or $msg eq '..') and next;
811 my $msgnum = store_message($msg, 'SPAM');
812 # Store the original file name for scan_spam in -n mode.
813 $SPAM{$msgnum} = [undef, $msg];
814 }
815 }
816
817 sub scan_spam {
818 my ($msgnum, $header, $tuple, $msg);
819
820 # Unlike filter_mail, we don't need to print the folder name.
821 # Calculate how many columns would be allocated to it...
822 my $nf = int($COLUMNS * $SCAN_P_FOLDER);
823 # ...and add that amount to COLUMNS to calculate the number of columns to
824 # allocate to msgnum and from snippet, thus filling the line without
825 # printing the folder name.
826 my $nm = int(($COLUMNS + $nf) * $SCAN_P_MESSAGE);
827 my $nF = int(($COLUMNS + $nf) * $SCAN_P_FROM);
828 my $ns = $COLUMNS - $nm - $nF - 3;
829
830 for $msgnum (sort(keys(%SPAM))) {
831 $tuple = $SPAM{$msgnum};
832 if (defined($tuple->[0])) {
833 # Filed by filter_mail, so we have the header.
834 $header = $tuple->[0];
835 } elsif (defined($tuple->[1])) {
836 # Filed by maildir_spam, so we don't have the header.
837 if ($run) {
838 # The message has been filed, load it from $mh.
839 $msg = "$mh/SPAM/$msgnum";
840 } else {
841 # The message has not been filed, load it from the maildir.
842 # $tuple->[1] is just a basename, not a path; this works
843 # because maildir_spam did chdir(Maildir/spam/new).
844 $msg = $tuple->[1];
845 }
846 $header = get_headers($msg);
847 } else {
848 print(STDERR
849 "BUG: corrupt SPAM tuple, neither element defined",
850 " for message $msgnum\n");
851 next;
852 }
853 print(scan_line($header, '', $msgnum, 0, $nm, $nF, $ns),
854 "\n");
855 }
856 }
857
858 \f
859 if (!caller()) {
860 my $st;
861
862 if ($dumpfilters) {
863 require "$HOME/.minc";
864 $Data::Dumper::Indent = 1;
865 print(Dumper(\@FILTERS));
866 exit;
867 }
868
869 $rebuild_dot_folders and exit(create_dot_folders);
870
871 if (-f "$HOME/.minc") {
872 require "$HOME/.minc";
873 }
874
875 my $inbox;
876 if ($MAILDIR) {
877 $inbox = $MAILDIR;
878 } elsif (-d "$HOME/Maildir") {
879 $inbox = "$HOME/Maildir";
880 }
881
882 if (@ARGV > 0) {
883 $inbox = shift(@ARGV);
884 }
885
886 my @files;
887 if (substr($inbox, 0, 1) eq '+') {
888 my @msgs = @ARGV;
889 if (!@msgs) {
890 @msgs = ('cur-last');
891 }
892 open(my $fh, '-|', 'mhpath', @msgs) or die("open(mhpath|): $!");
893 chomp(@files = <$fh>);
894 if (!close($fh)) {
895 $! == 0 or die("open(mhpath|): $!");
896 die('mhpath '. exit_msg($?));
897 }
898 @files > 0 or exit 0;
899 } else {
900 @ARGV == 0 or pod2usage();
901 chdir("$inbox/new") or die("chdir($inbox/new): $!");
902 @files = map { $_->[1] }
903 sort { $a->[0] <=> $b->[0] }
904 map {
905 $st = stat($_) or die("stat($_): $!");
906 [ $st->mtime, $_ ]
907 } getfiles('.');
908
909 @files = map { $_->[1] }
910 sort { $a->[0] <=> $b->[0] }
911 map {
912 if (not ($st = stat($_))) {
913 die("stat($_): $!");
914 }
915 [$st->mtime, $_]
916 }
917 getfiles('.');
918 }
919
920 my %folders = filter_mail($inbox, @files);
921
922 $run and %folders and update_dot_folders(\%folders);
923
924 maildir_spam();
925 scan_spam();
926 }
927
928 1;
929
930 \f
931 __END__
932
933 =head1 THE FILTERS STRUCTURE
934
935 Each element of @FILTERS is a filter. A filter is itself an array.
936 The first element of a filter is a string, the name of the header this
937 filter acts upon. The header name is not case-sensitive. Each
938 subsequent element of a filter is a pair (i.e. a two-element array):
939 first, a regular expression B<minc> uses to determine whether this
940 filter matches or not, and second, an expression which B<minc>
941 evaluates to get the folder name.
942
943 B<minc> decides where to store a message by iterating over the
944 @FILTERS array. It tests each regexp of each filter against all
945 headers matching that filter's specified header. As soon as a match
946 is found, B<minc> evaluates the second part of the pair. This part
947 may contain positional parameters from the matched regexp ($1, $2,
948 etc.). The result of this expression is used as the folder name.
949
950 Multiple occurrences of the same header are preserved and tested
951 individually against the filters. That means, for example, that
952 filters can search all the Received headers for a certain string.
953
954 It is important to note that all the arrays of the @FILTERS structure
955 are traversed I<in order>. This means the filters can be arranged so
956 that some have priority over others. XXX: get Doug to write an
957 example of having the same header matched more than once.
958
959 Lastly, B<minc> supports a magic ' TO' header. Filters using this
960 header are matched against a collection of headers related to (and
961 including) the To. Which headers to use is determined by a regular
962 expression borrowed from procmail.
963
964 =head1 HOOKS
965
966 Filter hooks take a reference to a hash of batons, a reference to a
967 hash of headers, and the message filename as arguments. It returns
968 undef to decline filtering of this message (thus falling back to
969 subsequent filter hooks, and finally @FILTERS), or the name of the
970 folder to store this message into.
971
972 One of B<minc>'s global variables is available to the user-defined
973 hooks: $run. This boolean should be honored; hooks should only take
974 real action (i.e. removing or creating files, running external
975 programs, etc.) if $run is non-zero.
976
977 The baton hash is created simply from the start hooks; if the hook
978 returns at least one defined value, this value is used as the key and
979 all other return values are put into a list reference as the value.
980 This hash is then passed by reference to all filter, post-store, and
981 stop hooks.
982
983 Post store hooks take a reference to a hash of batons, a reference to
984 a hash of headers, the folder this message was stored in, and its new
985 message number.
986
987 XXX: need more details about the hook process; for now read the code.
988
989 =head1 EXAMPLES
990
991 @FILTERS = (
992
993 ['List-Id',
994 ['<([[:graph:]]+)-([[:graph:]]+)\.lists\.sourceforge\.net>', 'l/$1/$2'],
995 ['<([[:graph:]]+?)(-list)?\.freedesktop\.org>', 'l/freedesktop/$1'],
996 ['<swig\.cs\.uchicago\.edu>', 'l/swig'],
997 ],
998
999 ['List-Post',
1000 ['<mailto:([[:graph:]]+)+@([[:graph:]]+)\.apache\.org>', 'l/apache/$2/$1'],
1001 ],
1002
1003 ['To',
1004 ['root', 'root'],
1005 ],
1006 );
1007
1008 The first List-Id filter is a surprisingly effective one which creates
1009 appropriate folder names (such as l/htdig/updates and l/rox/devel) for
1010 all Sourceforge lists to which i subscribe. Certainly there are lists
1011 hosted at Sourceforge which do not work well with this, and this is
1012 where it is important to remember that the first match is the one
1013 uses. Simply put the more specific rules before this one.
1014
1015 The next List-Id example is simple. The swig example demonstrates
1016 that the folder name does not have to use a portion of the matched
1017 header; you can just hardcode the folder name.
1018
1019 The List-Post example is a nice one. Most ASF projects have their own
1020 apache.org subdomain, with mailing lists hosted there. So, given a
1021 list such as dev@httpd.apache.org, this filter will create the folder
1022 name l/apache/httpd/dev.
1023
1024 XXX Need hook examples.
1025
1026 =head1 AUTHORS
1027
1028 Written by Eric Gillespie <epg@pretzelnet.org>. Design by Eric
1029 Gillespie and Doug Porter <dsp@waterspout.com>.
1030
1031 This program is free software; you can redistribute it and/or modify
1032 it under the same terms as Perl itself.
1033
1034 =cut
1035
1036 # Local variables:
1037 # cperl-indent-level: 4
1038 # perl-indent-level: 4
1039 # indent-tabs-mode: nil
1040 # End:
1041
1042 # vi: set tabstop=4 expandtab: