Marco Fioretti wrote:
I found several pop clients written in perl that can be easily
> modified to fetch the headers only from the pop server, and send
> "delete" commands when some header matches a certain pattern.
> I don't have any URL here, but a search on CPAN would find them.
> Another source for this is the example code of the O'Reilly Book
> "Advanced Perl Programming", available on their ftp site: that
> book is what gave me the idea.
>
> Marco
There it goes (there are many others like this on the net..)
@rem = '-*- Perl -*-';
@rem = '
@echo off
c:\perl\bin\perl f:/local/bin/checkmail.cmd %1 %2 %3 %4 %5 %6 %7 %8 %9
goto endofperl
';
# This perl script can be used to pre-scan your POP mailbox on your ISP
to
# delete any mail with objectionable headers before you go to the
trouble of
# downloading the whole message. It only reads the headers, and can be
# customized to look for any patterns of interest.
# To use it you need the latest and greatest perl version 5.004 (soon to
be
# released) and the Net::POP3 and Mail::Header optional modules
installed.
# (Instructions for how to get perl won't fit here - see www.perl.com
for
# lots of good info). You will need to edit the line after @echo off
(above)
# to contain the full path name of perl and where you put this script.
# You also need to customize a lot of stuff in this script, including
(but
# probably not limted to):
#
# * The lines up at the top with the absolute path names of perl and
this
# script in them.
#
# * The mail server and password information below.
#
# * The regular expressions and algorithms used to actually check the
# mail headers for what you want to classify as spam and delete.
use Net::POP3;
use Mail::Header;
# Configure the interesting parameters here
#
$postoffice=''; # fill in this with something like postoffice.isp.com
$user=''; # fill this in with your mail user name
$password=''; # fill this in with your mail server password
$verbose=1;
# Call scan_header with the Mail::Header object as the first argument
and
# the message size as the 2nd arg. If it returns a value, then that
value is
# the reason the mail should be deleted. If it returns undef, the mail
is
# left intact;
#
# NOTE: Edit this routine to put in your very own reasons for deleteing
# mail.
#
sub scan_header {
my $head, @rec, $r, @tags, $t, $msgsize;
($head, $msgsize) = @_;
if ($msgsize > 100000) {
return "Message bigger than 100K, probable mailbomb";
}
@tags = $head->tags();
$goodguy = 0;
foreach $t (@tags) {
if ($t=~/^X-Advertisement/i) {
return "Found X-Advertisement header";
}
if ($goodguy == 0) {
# If this mail isn't explicity being sent to me or being sent
on
# one of the mailing lists I know about or forwarded from work,
etc
# then it is highly suspicious...
if (($t=~/From/i) || ($t=~/To/i) || ($t=~/Cc/i)) {
@rec = $head->get($t);
foreach $r (@rec) {
# Fill in tests to check for your mail address, the
# mail addresses associated with any mailing lists you
# are on, etc. These are only examples...
if (($r=~/Tom\.Horsley\@worldnet\.att\.net/i) ||
($r=~/kermit\@columbia\.edu/i) ||
($r=~/fdc\@watsun\.cc\.columbia\.edu/i) ||
($r=~/ntemacs\-users\@cs\.washington\.edu/i)) {
$goodguy = 1;
}
}
}
}
# If any of these standard goons show up in any headers, trash the
# sucker...
if (($t=~/From/i) || ($t=~/Received/i) || ($t=~/Reply/i) ||
($t=~/Sender/i) || ($t=~/^X-/) || ($t=~/^To/i) ||
($t=~/Comments/i)) {
@rec = $head->get($t);
foreach $r (@rec) {
# As above, replace any of these (or just add more) with
# your own list of bad guys.
if ($r=~/cyberpromo\.com/i) {
return "Found cyberpromo.com in $t header";
}
if ($r=~/savetrees\.com/i) {
return "Found savetrees\.com in $t header";
}
if ($r=~/earthlink\.net/i) {
return "Found earthlink\.net in $t header";
}
if ($r=~/\@shoppingplanet\.com/i) {
return "Found \@shoppingplanet.com in $t header";
}
}
}
}
# These subjects were repeated over and over at one time, so I stuck
# in an explicit check for them...
@rec = $head->get('Subject');
foreach $r (@rec) {
if ($r=~/Free Fax/i) {
return "Found \"Free Fax\" in Subject header";
}
if ($r=~/credit limit/i) {
return "Found \"credit limit\" in Subject header";
}
}
if ($goodguy == 0) {
return "No good guys in any From: To: or Cc: header";
}
return undef;
}
# Call delete_spam with postoffice, user, password to be scanned.
#
sub delete_spam {
my $postoffice, $user, $password, $pop, $msgcount, $i, $head,
$reason,
$subj, $from, $delcount;
($postoffice, $user, $password) = @_;
$pop = Net::POP3->new($postoffice) ;
if (! defined($pop)) {
die "Net::POP3::new failed for postoffice $postoffice\n";
}
$msgcount = $pop->login($user, $password);
if (! defined($msgcount)) {
die "Cannot login to mailbox at $postoffice\n";
}
($msgcount, $msgsize) = $pop->popstat();
$delcount = 0;
for ($i = 1; $i <= $msgcount; ++$i) {
$msgsize = $pop->list($i);
$head = new Mail::Header $pop->top($i, 0);
if ($reason = &scan_header($head, $msgsize)) {
if ($verbose) {
$subj = $head->get('Subject');
$from = $head->get('From');
if (! defined($subj)) {
$subj = "<no subject>\n";
}
if (! defined($from)) {
$from = "<no from address>\n";
}
print "Deleteing mail:\n";
print " From: $from";
print " Subject: $subj";
print " Reason: $reason\n";
}
$pop->delete($i);
++$delcount;
}
}
$pop->quit();
if ($verbose && ($msgcount > 0)) {
print "Looked at $msgcount message(s), Deleted $delcount\n";
}
}
# Actually do everything.
#
&delete_spam($postoffice, $user, $password);
__END__
:endofperl
