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