#!/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
##############################################