The files at the end are where you put the regex patterns, about the only thing to watch for is backslashing '.'
It runs fast on my dialup line. I just run it before I download my mail with my normal mail client.
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.
Update2 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.
#!/usr/bin/perl -w use strict; use Net::POP3; my $maxsize = 50000; my (@fromgoodre,@frombadre,@badwordre,@maillistre,@badcontentre,@recei +vedgoodre,@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 userna +me 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 g +ood\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->$ba +dfromre\n"; push(@del_mess,$msg_id); $messcheck .= "$msg_id -> $badfr +omre ->$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-Pa +th 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 "Receive +d 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 Conte +nt->$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 s +ubject->$badwordre\n"; push(@del_mess,$msg_id); $messcheck .= "$msg_i +d -> $badwordre ->$from\n"; $flag = 'bad'; goto DOBODY} } #check for base64 if(($line) = grep(/^Content-Transfer-Encoding: base64/o,@heade +r)){ 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); $mes +scheck .= "$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,$m +sg_id); $messcheck .= "$msg_id -> size limit exceeded ->$from\n"; $fl +ag = '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->$badword +re\n"; push(@del_mess,$msg_id); $messcheck .= "$msg_id -> bad word in + body ->$badwordre ->$from\n"; delmessage($msg_id); line(); goto FINI +SH} } } FINISH: line(); print "\n"; } #confirm the deletions line();line();line();line(); unless(defined $del_mess[0]){print "No messages to be deleted\nHit Ent +er to quit\n"; my $input = <>; $pop3->quit(); exit} print "$messcheck\n\n"; print "Delete above messages?\n [yY] then Enter to delete, or Enter t +o 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 ##############################################