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