#!/usr/bin/perl -w
use strict;
use Net::POP3;

use constant HOST => "pop.foo.net";
use constant USER => "bar";
use constant PASS => "baz";
use constant MAXSIZE => 50000;

sub make_rx_from_file {
    my $fn = shift;
    open my $fh, "<", $fn or warn("Can't open $fn: $!\n"), return [];
    chomp(my @line = <$fh>);
    return [ map qr/$_/, @line ];
}

my @bad_word = @{make_rx_from_file "badwords"};

my %test_for = (
    'To' => {
        ok => make_rx_from_file "togood",
    },
    'Received' => {
        ok => make_rx_from_file "receivedgood",
    },
    'Content-Type' => {
        bad => make_rx_from_file "contentbad",
    },
    'Subject' => {
        bad => \@bad_word,
    },
    'X-Mailinglist' => {
        ok => make_rx_from_file "maillist",
    },
    'From' => {
        ok => make_rx_from_file "fromgood",
        bad => make_rx_from_file "frombad",
    },
    'Content-Transfer-Encoding:' => {
        bad => [
            qr/base64/,
        ],
    },
    'Message-ID' => {
        bad => [
            qr/^(?>[^<>]+)<(?>[^<>]+)\@(?>[^<>]+)>(?>[^<>]*)$/,
            qr/\@127\.0\.0\.1/,
        ]
    },
);

my $pop3 = Net::POP3->new(HOST) || die ("Couldn't connect to server\n"
+);
my $num_messages = $pop3->apop(USER, PASS) || die ("Bad username or pa
+ssword\n");

my $messages = $pop3->list();
print "Number of messages: $num_messages\n";

sub MSG_BAD; sub MSG_OK;

CHECK: foreach my $msg_id (keys %$messages) {
    my @messref;

    *MSG_OK = sub {
        print shift, "\n", map "> $_", @messref;
        print "Message $msg_id is ok\n\n";
        local $^W;
        next CHECK;
    };

    *MSG_BAD = sub {
        print shift, "\n", map "> $_", @messref;
        print "Message $msg_id is bad\n";
        # uncomment the following lines for real deletes 
        #$pop3->delete($msg_id);
        #print "Message $msg_id deleted\n";
        print "\n";
        local $^W;
        next CHECK;
    };

    my $size = $pop3->list($msg_id);

    print "Message $msg_id ($size bytes):\n";

    MSG_BAD "Size limit exceeded\n" if $size > MAXSIZE;

    my $in_header = 1;
    @messref = @{$pop3->top($msg_id, 10)};

    while(defined(my $line = shift @messref)) {
        print "> $line";

        if($in_header and $line =~ /^\s*$/) {
            $in_header = 0;
            print "Checking body\n";
            next;
        }

        my @match;

        if($in_header) {
            my ($header) = grep $line =~ /^$_:/i, keys %test_for;
            next unless $header;
            my $tests = $test_for{$header};

            if(exists $tests->{ok} and @{ $tests->{ok} }) {
                @match = grep $line =~ $_, @{ $tests->{ok} };
                MSG_OK "Header $header matched: @match\n" if @match;
            }

            if(exists $tests->{bad} and @{ $tests->{bad} }) {
                @match = grep $line =~ $_, @{ $tests->{bad} };
                MSG_BAD "Header $header matched: @match\n" if @match;
            }
        }
        else {
            @match = grep $line =~ $_, @bad_word;
            MSG_BAD "Bad word(s) matched in body: @match\n" if @match;
        }
    }

    MSG_OK "No tests triggered.";
}

$pop3->quit();
[download]

Makeshifts last the longest.