CUFP
zentara
snippet
<div class="Description">Well, we are all trying to filter spam. SpamAssasin gets high marks, but it requires you to download the mail first. I tried
popsneaker(c-program), and it works great on headers, but misses the body, which isn't good enough anymore. So... I decided to try Net::POP3, which can get the headers and head a number of body lines. This is just my first working model, and I know it uses "goto's", but it was just the easiest way to break out of nested loops. The patterns are stored in files, to make it easy to just add them as necessary. It works quite fast on my dialup. To test, just run, and observe the output. For real deletion, uncomment the pop3->delete line near the bottom of the code. <p>
The files at the end are where you put the regex patterns, about the only thing to watch for is backslashing '.'<p>
It runs fast on my dialup line. I just run it before I download my mail with my normal mail client.<p>
<b>Update: I have changed the original post, to a slightly improved version. Aristotle's methods below, are superior to mine, but I think my "clunky method" is a little easier for a beginner to see what is happening and modify. I did eliminate the redundant "regex creation from file" code.</b>
<p>
<b>Update2</b> I've taken Aristotle's recommendations and implemented a greping method to avoid redundant line checks. I also have split the message into 2 arrays, @header and @top. Additionally, I fixed the exit routine so that there
always is a logout from the pop server. The only thing that this code may miss, is if the various header lines have a newline in them, but I'm finding the first line of each header is good enough.</div>
<CODE>
#!/usr/bin/perl -w
use strict;
use Net::POP3;
my $maxsize = 50000;
my (@fromgoodre,@frombadre,@badwordre,@maillistre,@badcontentre,@receivedgoodre,@togoodre);
my %rehash = (
'fromgood' => \@fromgoodre,
'frombad' => \@frombadre,
'badwords' => \@badwordre,
'maillist' => \@maillistre,
'contentbad' => \@badcontentre,
'receivedgood' => \@receivedgoodre,
'togood' => \@togoodre
);
foreach my $file (keys %rehash){
open(FH,"< $file") or warn "Can't open $file $!\n";
chomp (my @lines = <FH>);
foreach my $line(@lines){push(@{$rehash{$file}},qr/$line/i)}
close FH;
}
my $ServerName = "mail.foobar.com";
my $pop3 = Net::POP3->new($ServerName)||die("Couldn't log on to server\n");
my $UserName = "zentara";
my $Password = "spam4lunch";
my $num_messages = $pop3->login($UserName, $Password)||die("Bad username or password\n");
my $messages = $pop3->list();
print "******$messages Number of messages->$num_messages*******\n";
my %messages;
my ($flag,$msg_id,$messcheck,@del_mess,@header,@top,$line);
@del_mess = ();
$messcheck = '';
print "####################################################\n";
foreach $msg_id(keys %{$messages}) {
$flag = '';
my @header =(); #array for headerlines
my @top = (); #array for top of messagebody
my $messref = $pop3->top($msg_id,10);
my $size = $pop3->list($msg_id);
print "message$msg_id->size=$size\n";
print "----------------------------------\n";
#split into @header and @top
while(1){
my $line = shift @$messref;
last if $line =~ /^\s*$/;
push(@header,$line);
}
@top = @$messref;
print '~~~~~~~~~~~~~~~~~~@header ->',"\n@header\n";
print '~~~~~~~~~~~~~~~~~~@top ->',"\n@top\n";
#check X-Mailinglist:
if(($line) = grep(/^X-Mailinglist:/o,@header)){
print "#################X-Mailinglistline-> $line\n";
for my $maillistre (@maillistre) {
if ($line =~ /$maillistre/) { print "Mail list good\n"; $flag = 'ok'; goto DOBODY}
}
}
#check From
($line) = grep(/^From:/io,@header);
print "#################Fromgrepline-> $line\n";
my $from = $line;
for my $goodfromre (@fromgoodre) {
if ($line =~ /$goodfromre/) { print "GoodFrom->$goodfromre\n"; $flag = 'ok'; goto DOBODY}
}
for my $badfromre (@frombadre) {
if ($line =~ /$badfromre/) { print "BadFrom->$badfromre\n"; push(@del_mess,$msg_id); $messcheck .= "$msg_id -> $badfromre ->$from\n"; $flag = 'bad'; goto DOBODY}
}
#check To and CC
($line) = grep(/^(To|Cc|cc|Return-Path):/o,@header);
print "#################To-CC-ReturnPathgrepline-> $line\n";
for my $togoodre (@togoodre) {
if ($line =~ /$togoodre/) { print "ToCCReturn-Path address good\n"; $flag = 'ok'; goto DOBODY}
}
#check Received
($line) = grep(/^Received:/o,@header);
print "#################Receivedgrepline-> $line\n";
for my $receivedgoodre (@receivedgoodre) {
if ($line =~ /$receivedgoodre/) { print "Received address good\n"; $flag = 'ok'; goto DOBODY}
}
#check Content-type
($line) = grep(/^Content-Type:/o,@header);
print "#################Content-typegrepline-> $line\n";
for my $badcontentre (@badcontentre) {
if ($line =~ /$badcontentre/) { print "Bad Content->$badcontentre\n"; push(@del_mess,$msg_id); $messcheck .= "$msg_id -> $badcontentre ->$from\n"; $flag = 'bad'; goto DOBODY}
}
#check Subject
($line) = grep(/^Subject:/o,@header);
print "#################Subjectgrepline-> $line\n";
for my $badwordre (@badwordre) {
if ($line =~ /$badwordre/) { print "badword in subject->$badwordre\n"; push(@del_mess,$msg_id); $messcheck .= "$msg_id -> $badwordre ->$from\n"; $flag = 'bad'; goto DOBODY}
}
#check for base64
if(($line) = grep(/^Content-Transfer-Encoding: base64/o,@header)){
print "#################base64grepline-> $line\n";
if ($line =~ /^Content-Transfer-Encoding: base64/o){print "base64 content\n"; push(@del_mess,$msg_id); $messcheck .= "$msg_id -> base64 ->$from\n"; $flag = 'bad';goto DOBODY}
}
#check Message-Id
($line) = grep(/^Message-[Ii][Dd]:/o,@header);
print "#################Message-Idgrepline-> $line\n";
if (($line !~ /.*<?.+@.+(\..+)?>?$/o) || ($line =~ /\@127\.0\.0\.1/o))
{ print "Bad Message-Id\n"; push(@del_mess,$msg_id); $messcheck .= "$msg_id -> bad Message-Id ->$from\n"; $flag = 'bad'; goto DOBODY}
DOBODY:
if ($flag eq 'ok'){print "Message $msg_id is OK\n"; line(); next}
if ($flag eq 'bad'){print "Message $msg_id is bad\n"; delmessage($msg_id); line(); next}
if ($size > $maxsize){print "Size limit exceeded\n"; push(@del_mess,$msg_id); $messcheck .= "$msg_id -> size limit exceeded ->$from\n"; $flag = 'bad'; goto DOBODY}
#do body check
print "Doing body check\n";
for my $line (@top){
for my $badwordre (@badwordre) {
if ($line =~ /$badwordre/) { print "badword in body->$badwordre\n"; push(@del_mess,$msg_id); $messcheck .= "$msg_id -> bad word in body ->$badwordre ->$from\n"; delmessage($msg_id); line(); goto FINISH}
}
}
FINISH:
line();
print "\n";
}
#confirm the deletions
line();line();line();line();
unless(defined $del_mess[0]){print "No messages to be deleted\nHit Enter to quit\n"; my $input = <>; $pop3->quit(); exit}
print "$messcheck\n\n";
print "Delete above messages?\n [yY] then Enter to delete, or Enter to abort\n";
chomp(my $input = <>);
if($input =~ /^[yY]$/i){foreach(@del_mess){print "Deleting message $_\n"; $pop3->delete($_)}}
$pop3->quit();
sub delmessage{print "Message @_ to be deleted\n"}
sub line {print "####################################################\n"}
exit 0;
__END__
SAMPLE FILES:
###badwords######
jackpot
fee
visit
information
confident
confidential
urgent
action
please
notice
cheaper
virus
travel
nigeria
gabon
africa
afrique
\$\$\$
\*\*
\*
PROFITS
debt
INVEST
MONEY
CREDIT
FREE
CASH
BUY
\. \. \.
\.\.\.
party
penis
sex
viagra
prescription
###########################################
####contentbad#############################
text\/html
multipart\/alternative
multipart\/mixed
###########################################
######frombad##############################
.*\.ac>?$
.*\.ae>?$
.*\.af>?$
.*\.ag>?$
.*\.ai>?$
.*\.al>?$
.*\.am>?$
.*\.an>?$
.*\.ao>?$
.*\.aq>?$
.*\.ar>?$
.*\.as>?$
.*\.at>?$
.*\.by>?$
.*\.bz>?$
.*\.ca>?$
.*\.cc>?$
.*\.cd>?$
.*\.cf>?$
.*\.cg>?$
.*\.ch>?$
.*\.ci>?$
.*\.ck>?$
.*\.cl>?$
.*\.cm>?$
.*\.cn>?$
.*\.co>?$
.*\.cr>?$
.*\.cu>?$
.*\.cv>?$
.*\.cx>?$
#############################################
####fromgood#################################
mailgeek\.compgeeks\.com
zmuato
sbiblert
mcubase
mymother
myrelatives
##############################################
#########maillist###########################
suse-linux-e
#############################################
#################receivedgood#################
list2\.suse\.com
#############################################
#########togood##############################
sdlperl@sdlperl\.org
mc@gnome\.org
##############################################
</CODE>