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