note
Aristotle
This is futher restructured compared to my points made above:
<code>
#!/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 password\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();
</code>
<p align="right"><em>Makeshifts last the longest.</em></p>
261632
261632