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