1: #!/usr/bin/perl -w
2: ##############################################################################
3: ## -*-perl-*-
4: ##
5: ## rifle - POP3 mailbox filter
6: ##
7: ## REVISION HISTORY
8: ##
9: ## 1.0 2002/01/10 Initial release.
10: ## 1.1 2002/01/14 Added logfile and trashcan.
11: ## 1.2 2002/01/28 Added summary statistics.
12: ## 1.3 2002/02/04 Added Vipul's Razor.
13: ## 1.4 2002/02/18 Need to kill trailing \s when printing headers.
14: ##############################################################################
15:
16: package MessageTemplateMethod;
17:
18: # Iterates over each message in a POP3 mailbox. See the Template
19: # Method pattern in the Design Patterns book.
20:
21: use strict;
22:
23: use Net::POP3;
24: use Mail::Header;
25:
26: sub new
27: {
28: my $class = shift;
29: my %args = @_;
30:
31: my $obj = bless {
32: _hostname => $args{hostname},
33: _account => $args{account},
34: _password => $args{password},
35: }, $class;
36:
37: return $obj;
38: }
39:
40: sub iterate
41: {
42: my $self = shift;
43:
44: my $pop3 = Net::POP3->new($self->{_hostname}) or
45: die "ERROR: Net::POP3->new(", $self->{_hostname}, ") failed\n";
46:
47: my $msgs = $pop3->login($self->{_account}, $self->{_password});
48: die "ERROR: Net::POP3->login() failed\n" if (!defined $msgs);
49:
50: $msgs += 0; # Get rid of funky 0E0.
51: foreach my $i (1..$msgs) {
52: my $hdrs = $pop3->top($i);
53: my $mh = Mail::Header->new($hdrs);
54: $self->_message($pop3, $i, $mh);
55: }
56: $pop3->quit;
57: }
58:
59: # PRIVATE
60:
61: sub _message
62: {
63: my $self = shift;
64: my $pop3 = shift;
65: my $num = shift;
66: my $mh = shift;
67:
68: # Override this so you can do something with this message.
69: }
70:
71:
72: package MailFilter;
73:
74: use strict;
75: use IO::File;
76: use Digest::MD5;
77: use Razor::Client;
78:
79: use vars qw(@ISA);
80:
81: @ISA = qw( MessageTemplateMethod );
82:
83: sub new
84: {
85: my $self = shift;
86: my %arg = @_;
87:
88: my $objref = $self->SUPER::new(@_);
89:
90: $objref->{_filter} = $arg{filter};
91: $objref->{_logfile} = $arg{logfile};
92: $objref->{_trashcan} = $arg{trashcan};
93: $objref->{_prompt} = $arg{prompt};
94: $objref->{_bins} = { kept => {}, tossed => {} };
95: $objref->{_razor} = new Razor::Client("");
96:
97: bless $objref, $self;
98:
99: return $objref;
100: }
101:
102: sub summarize
103: {
104: my $self = shift;
105:
106: $self->_print("\n");
107: $self->_timestamp;
108:
109: my $kept = 0;
110: if (keys %{$self->{_bins}->{kept}}) {
111: $self->_print("\n");
112: $self->_print(" Summary of Kept Messages:\n");
113: foreach my $i (keys %{$self->{_bins}->{kept}}) {
114: $self->_print(' ' x 8, "$self->{_bins}->{kept}->{$i} : $i\n");
115: $kept += $self->{_bins}->{kept}->{$i};
116: }
117: }
118:
119: my $tossed = 0;
120: if (keys %{$self->{_bins}->{tossed}}) {
121: $self->_print("\n");
122: $self->_print(" Summary of Tossed Messages:\n");
123: foreach my $i (keys %{$self->{_bins}->{tossed}}) {
124: $self->_print(' ' x 8, "$self->{_bins}->{tossed}->{$i}: $i\n");
125: $tossed += $self->{_bins}->{tossed}->{$i};
126: }
127: }
128:
129: my $total = $kept + $tossed;
130: $self->_print("\n");
131: if ($total) {
132: $self->_print(
133: " $total message",
134: ($total > 1) ? 's ' : ' ',
135: "processed. ");
136: }
137:
138: if ($tossed && $kept) {
139: $self->_print(" Kept $kept and tossed $tossed.\n");
140: }
141: elsif ($kept) {
142: $self->_print(" Kept $kept.\n");
143: }
144: elsif ($tossed) {
145: $self->_print(" Tossed $tossed.\n");
146: }
147: else {
148: $self->_print(" No messages.\n");
149: }
150: }
151:
152:
153: # PRIVATE
154:
155: sub _timestamp
156: {
157: my $self = shift;
158: my $now = localtime;
159: $self->_print("-" x 20, " $now ", "-" x 20, "\n");
160: }
161:
162: sub _message
163: {
164: my $self = shift;
165: my $pop3 = shift;
166: my $num = shift;
167: my $mh = shift;
168:
169: $self->_print("\n");
170: $self->_timestamp;
171: my @tags = $mh->tags();
172: foreach my $t (qw(Subject From To Cc Date Message-ID)) {
173: if (grep(/(?i)^$t$/, @tags)) {
174: my $text = $mh->get($t);
175: $text =~ s/\s+$//; # Better than chomp.
176: $self->_print(sprintf "%10s: %s\n", $t, $text);
177: }
178: }
179:
180: my $filtered = 0;
181: FILTERS: foreach my $f (@{$self->{_filter}}) {
182:
183: if (!($f->{op} cmp "razor")) {
184: # Let Vipul's Razor look at it.
185: my $msg = $pop3->get($num);
186: my $response = $self->{_razor}->check(spam => $msg);
187: if ($response->[0]) {
188: $self->_print(" FILTER: Vipul's Razor said it was SPAM/UCE\n");
189: $self->_toss($pop3, $num, $mh, $f);
190: $filtered = 1;
191: last FILTERS;
192: }
193: }
194: else {
195: # A 'keep' or 'toss' filter. Apply regexps to headers.
196: foreach my $h (@{$f->{hdr}}) {
197: if (grep(/^$h$/, @tags)) {
198: my $text = $mh->get($h);
199: $text =~ s/\s+$//; # Better than chomp.
200: if ($text =~ /$f->{regex}/) {
201: $self->_print(" FILTER: ");
202: if (!defined $f->{desc}) {
203: $self->_print($f->{regex}, " matched $text in $h.\n");
204: }
205: else {
206: $self->_print($f->{desc}, "\n");
207: }
208: if (!($f->{op} cmp "keep")) {
209: $self->_keep($pop3, $num, $mh, $f);
210: }
211: else {
212: $self->_toss($pop3, $num, $mh, $f);
213: }
214: $filtered = 1;
215: last FILTERS;
216: }
217: }
218: }
219: }
220: }
221:
222: if (!$filtered) {
223: $self->_print(" FILTER: It was not explicitly kept or tossed.\n");
224: $self->_default($pop3, $num, $mh);
225: }
226: }
227:
228: sub _count
229: {
230: my $self = shift;
231: my $desc = shift;
232: my $key = shift;
233:
234: if ($desc) {
235: if (!defined $self->{_bins}->{$key}->{$desc}) {
236: $self->{_bins}->{$key}->{$desc} = 0;
237: }
238: $self->{_bins}->{$key}->{$desc}++;
239: }
240: else {
241: if (!defined $self->{_bins}->{$key}->{'No description.'}) {
242: $self->{_bins}->{$key}->{'No description.'} = 0;
243: }
244: $self->{_bins}->{$key}->{'No description.'}++;
245: }
246: }
247:
248: sub _keep
249: {
250: my $self = shift;
251: my $pop3 = shift;
252: my $num = shift;
253: my $mh = shift;
254: my $f = shift;
255:
256: $self->_print(" RESULT: Left message on server.\n");
257: $self->_count($f->{desc}, 'kept');
258: }
259:
260: sub _toss
261: {
262: my $self = shift;
263: my $pop3 = shift;
264: my $num = shift;
265: my $mh = shift;
266: my $f = shift;
267:
268: $self->_delete($pop3, $num, $mh);
269: $self->_count($f->{desc}, 'tossed');
270: }
271:
272: sub _default
273: {
274: my $self = shift;
275: my $pop3 = shift;
276: my $num = shift;
277: my $mh = shift;
278:
279: $self->_delete($pop3, $num, $mh);
280: $self->_count('It was not explicitly kept or tossed.', 'tossed');
281: }
282:
283: sub _print
284: {
285: my $self = shift;
286: print @_;
287:
288: if (defined $self->{_logfile}) {
289: my $fh = IO::File->new;
290: if ($fh->open(">> ".$self->{_logfile})) {
291: print $fh @_;
292: $fh->close;
293: }
294: }
295: }
296:
297: sub _yesno {
298: my $question = shift;
299:
300: print $question, " (y/n) [n]: ";
301: my $answer = <>;
302: chomp $answer;
303:
304: if ($answer =~ /(?i)^y/i) {
305: return 1;
306: }
307: else {
308: return 0;
309: }
310: }
311:
312: sub _delete
313: {
314: my $self = shift;
315: my $pop3 = shift;
316: my $num = shift;
317: my $mh = shift;
318: if (!$self->{_prompt} || ($self->{_prompt} && _yesno("Delete it?"))) {
319:
320: if (defined $self->{_trashcan}) {
321:
322: # Download message and save it to the trashcan.
323:
324: my $msgid = $mh->get('Message-ID');
325: if (!$msgid) {
326: # Missing the Message-ID, so make one up.
327: my $headers = $pop3->top($num);
328: $msgid = join("", Digest::MD5::md5_hex(join '', @{$headers}),
329: '@NO-ID-FOUND');
330: }
331:
332: # Convert all non-alphanumeric to a nice char.
333: $msgid =~ s/([^\w\/\_\-])/\_/g;
334:
335: my $fh = IO::File->new;
336: my $filename = $self->{_trashcan};
337: $filename .= ($^O eq "MacOS" ? ':' : '/');
338: $filename .= $msgid.'.txt';
339: if (!$fh->open("> $filename")) {
340: die "Could not open $filename for writing.\n";
341: }
342: else {
343: my $message = $pop3->get($num, $fh);
344: $self->_print(" TRASH: Saved message as $filename.\n");
345: $fh->close;
346: }
347: }
348:
349: # Now really delete it off the server.
350: $pop3->delete($num);
351: $self->_print(" RESULT: Deleted message on server.\n");
352: }
353: else {
354: $self->_print(" RESULT: Left message on server.\n");
355: }
356: }
357:
358:
359: package main;
360:
361: use strict;
362:
363: use Getopt::Std;
364: use Term::ReadKey;
365: use Net::Netrc;
366: use IO::File;
367:
368: my %opt;
369:
370: my $error = !getopts('h:u:f:l:t:xw', \%opt);
371: if ($error) {
372: print << "EOU";
373:
374: Usage: rifle [switches]
375:
376: where
377: -h host Hostname to connect to
378: -u user User account name
379: -f file Use alternative .riflerc
380: -l file Output log file
381: -t dir Write tossed messages to trashcan directory
382: -x Do not prompt before tossing
383: -w Print out warranty information
384:
385: EOU
386: }
387: elsif ($opt{'w'}) {
388: print << "EOW";
389: ------------------------------------------------------------------------------
390: BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
391: FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
392: OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
393: PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
394: OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
395: MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
396: TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
397: PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
398: REPAIR OR CORRECTION.
399:
400: IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
401: WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
402: REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
403: INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
404: OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
405: TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
406: YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
407: PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
408: POSSIBILITY OF SUCH DAMAGES.
409: EOW
410: }
411: else {
412:
413: my $hostname;
414: if ($opt{'h'}) {
415: $hostname = $opt{'h'};
416: }
417: else {
418: print " Host: ";
419: $hostname = ReadLine(0);
420: chomp $hostname;
421: }
422:
423: my $account;
424: if ($opt{'u'}) {
425: $account = $opt{'u'};
426: }
427: else {
428: print "Account: ";
429: $account = ReadLine(0);
430: chomp $account;
431: }
432:
433: my $password;
434: my $netrc = Net::Netrc->lookup($hostname, $account);
435: if (defined $netrc) {
436: $password = $netrc->password;
437: }
438: else {
439: print "Password: ";
440: ReadMode('noecho');
441: $password = ReadLine(0);
442: ReadMode('restore');
443: chomp $password;
444: print "\n\n";
445: }
446:
447: # Locate the filter specification.
448: my $file;
449: if ($opt{'f'}) {
450: $file = $opt{'f'};
451: }
452: else {
453: if ($^O eq "MacOS") {
454: my $home = $ENV{HOME} || `pwd`;
455: chomp($home);
456: $file = ($home =~ /:$/ ? $home . "riflerc" : $home . ":riflerc");
457: }
458: else {
459: # Some OS's don't have `getpwuid', so we default to $ENV{HOME}
460: my $home = eval { (getpwuid($>))[7] } || $ENV{HOME};
461: $file = $home . "/.riflerc";
462: }
463: }
464:
465: my $fh = new IO::File;
466: if (!$fh->open("< $file")) {
467: die "Could not open $file\n";
468: }
469: elsif (defined $opt{'t'} && !-d $opt{'t'}) {
470: die "Directory ", $opt{'t'}, " doesn't exist.\n";
471: }
472: else {
473:
474: # Load the filter specification.
475: my $prev = $/;
476: $/ = undef; # slurp
477: my $filter_spec = <$fh>;
478: $/ = $prev; # unslurp
479: $fh->close;
480:
481: my $filter = eval $filter_spec;
482: die $@ if $@;
483: if (defined $filter) {
484: my $mf = MailFilter->new(
485: hostname => $hostname,
486: account => $account,
487: password => $password,
488: filter => $filter,
489: logfile => $opt{'l'},
490: trashcan => $opt{'t'},
491: prompt => !$opt{'x'});
492: $mf->iterate;
493: $mf->summarize;
494: }
495: }
496: }
497:
498: __END__
499: =pod
500:
501: =head1 NAME
502:
503: rifle - Filters email messages in your POP3 mailbox.
504:
505: =head1 SYNOPSIS
506:
507: rifle [-h host] [-u user] [-f file] [-l file] [-t dir] [-x] [-w]
508:
509: -h host Hostname to connect to
510: -u user User account name
511: -f file Use alternative filter specification file
512: -l file Output log file
513: -t dir Write tossed messages to trashcan directory
514: -x Do not prompt before deleting
515: -w Print out warranty information
516:
517: =head1 DESCRIPTION
518:
519: C<rifle> is a POP3 mailbox filtering program, which is particularly
520: adept at filtering SPAM/UCE messages.
521:
522: =head1 Filter Specification
523:
524: The C<.riflerc> file in your home directory contains
525: the filter specification. You can specify an alternate
526: filter specification file with the C<-f> option.
527:
528: The filter specification is a prioritized list of filtering
529: criteria (highest appearing first). Each entry consists of
530: an operation ('op'), and an optional description ('desc').
531:
532: For B<keep> and B<toss> operations, you specify a set of
533: header tags, and a Perl regular expression ('regex') to match.
534: If the regular expression matches one or more of the message
535: headers, the message will be kept or tossed, depending on
536: what you specified of the operation.
537:
538: For the B<razor> operation, a C<rifle> performs a lookup
539: of the message signature using Vipul's Razor SPAM/UCE
540: detection system.
541:
542: The optional description will be reported during logging
543: and will be used for tabulating and reporting statistics.
544:
545: Messages which are not explicitly kept or tossed by the filter
546: specification are deleted.
547:
548: At a minimum, you will want to keep all messages which are
549: explicitly addressed or Cc-ed to you:
550:
551: [
552: { hdr => [ 'To', 'Cc' ],
553: regex => '(?i)gerard\@lanois\.com',
554: op => 'keep',
555: desc => 'Mail addressed directly to me' },
556: ]
557:
558: C<rifle> will look for a password in your C<.netrc> for
559: the hostname and account you specify. Otherwise, it
560: will prompt you for the host, account name, and password.
561:
562: You can apply Vipul's Razor at any point in the filter
563: specification; however, you will find it most useful to
564: put as either first filter, or immediately prior to
565: your personal address filter.
566:
567: =head1 EXAMPLES
568:
569: Example C<.riflerc>:
570:
571: [
572: { hdr => [ 'From' ],
573: regex => '(?i)\@cgw\.com',
574: op => 'toss' },
575: { hdr => [ 'To' ],
576: regex => '(?i)Undisclosed\.Recipients',
577: op => 'toss' },
578: { hdr => [ 'Subject', 'To', 'Cc' ],
579: regex => '(?i)SDBC|sdcbc',
580: op => 'keep' },
581: { hdr => [ 'Subject' ],
582: regex => 'M2A|M2PA|M2SD',
583: op => 'keep' },
584: { hdr => [ 'To', 'Cc' ],
585: regex => '(?i)ubh\@yahoogroups\.com',
586: op => 'keep' },
587: { op => 'razor',
588: desc => 'Vipul\'s Razor' },
589: { hdr => [ 'To', 'Cc' ],
590: regex => '(?i)gerard\@lanois\.com',
591: op => 'keep' },
592: ]
593:
594: =head1 INSTALLATION
595:
596: You will need the following modules, if you don't already have them:
597:
598: IO::File
599:
600: Net::POP3
601:
602: Mail::Header
603:
604: Net::Netrc
605:
606: Getopt::Std
607:
608: Term::ReadKey
609:
610: Digest::MD5
611:
612: Razor::Client - http://razor.sourceforge.net/
613:
614: =head1 AUTHOR
615:
616: Gerard Lanois <gerard@lanois.com>
617:
618: Courtesy of Gerard's Perl Page, http://www.geocities.com/gerardlanois/perl/
619:
620: =head1 CREDITS
621:
622: Platform-independent C<.rc> file location code borrowed from Net::Netrc.
623:
624: =head1 SEE ALSO
625:
626: http://razor.sourceforge.net/
627:
628: Mail::Audit
629:
630: http://www.threeminutehero.com/projects/pop3/
631:
632: http://mailfilter.sourceforge.net/
633:
634: http://www.thrysoee.dk/checkmail/
635:
636: http://www.algonet.se/~staham/linux/programs.html
637:
638: =head1 LICENSE
639:
640: rifle - Copyright (C) 2002 Gerard Lanois <gerard@lanois.com>
641:
642: This program is free software; you can redistribute it and/or modify
643: it under the terms of the GNU General Public License as published by
644: the Free Software Foundation; either version 2 of the License, or
645: (at your option) any later version.
646:
647: This program is distributed in the hope that it will be useful,
648: but WITHOUT ANY WARRANTY; without even the implied warranty of
649: MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
650: GNU General Public License for more details.
651:
652: You should have received a copy of the GNU General Public License
653: along with this program; if not, write to the Free Software
654: Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
655:
656: =cut
657:
