Mail Filtering with Mail::Audit
by Simon Cozens
|
Pages: 1, 2, 3, 4
A Complete Filter
Here, to show off exactly what I do with Mail::Audit, is a suitably anonymized and annotated version of the filter I currently use to process my incoming mail.
#!/usr/bin/perl
use Mail::Audit;
$folder = "/home/simon/mail/";
Anything that actually reaches me is going to be logged so that I can tail -f a summary of incoming mail to one of my terminals.
open (LOG, ">/home/simon/.audit_log");
Read in the new mail message, and extract the important headers from it:
my $item = Mail::Audit->new;
my $from = $item->from();
study $from;
my $to = $item->to();
my $cc = $item->cc();
my $subject = $item->subject();
chomp($from, $to, $subject);
If I'm likely to be at the office, I appreciate a copy of all mail I receive, in case there's something I need to deal with immediately. So I need time-controlled filtering. Try doing this with procmail:
my ($hour, $wday) = (localtime)[2,6];
if ($wday !=0 and $wday !=6 # Not Saturday/Sunday
and $hour > 9 and $hour < 18) { # Between 9am and 6pm
print LOG "$subject: $from: Bouncing to work\n";
$item->resend('simon@theoffice.com');
# resend is the only action
# which doesn't end the program.
}
One of my users didn't have their own email address for a while, so they had their friends send mail to me instead. Now they have their own address, so the mail is bounced across to them:
$item->bounce('ei@somewhere.com') if $subject =~ /^For Ei:/;
I maintain two FAQs: the perl5-porters FAQ and the Tokyo high speed connectivity FAQ. The mail comes to different email addresses, but it all ends up at my box. They need to go in separate folders.
$item->accept("$folder/p5p-faq") if $to=~ /p5p-faq/;
$item->accept("$folder/tokyo-faq") if $to=~ /faq/;
I get some mail in Greek which needs to be processed with metamail to sort out the character sets. The pipe method squirts the mail to a separate program:
$item->pipe("metamail -B -x > $folder/greek")
if $from =~/hri\.org$/;
Some people I definitely want to hear from, so they get accepted at this stage to save time:
for (qw(goodguy dormouse locust)) {
if ($from =~ /$_/) {
print LOG "$from:$subject:Exception,
accepting into inbox\n";
$item->accept;
}
}
Some people I very definitely do not want to hear from:
for (qw(badguy nasty enemy)) {
if ($from =~ /$_/) {
print LOG "$from:$subject:Dumped\n";
$item->reject("Go away! Stop emailing me!");
}
}
Some people or mailing lists I currently just don't have time for, so they get silently ignored:
for (qw(freshmeat.net microsoft news\@myhost cron)) {
if ($from =~ /$_/) {
print LOG "$from:$subject:Ignored\n";
$item->ignore;
}
}
Some mailing lists I want to stay as lists:
my %lists = (
"pound.perl.org" => "purl",
"helixcode" => "gnome",
"uclinux" => "uclinux",
"infobot" => "infobot",
"european-" => "yapc",
"tpm\@otherside" => "tpm",
"hellenic" => "greeknews",
);
for my $what (keys %lists) {
next unless $from =~ /$what/i or
$to =~ /$what/i or $cc =~/$what/i;
my $where = $lists{$what};
print LOG "$from:$subject:List,
accepting to folder $where\n";
$item->accept($folder.$where);
}
And some I want to pipe to listgate as newsgroups:
my %gated = (
"tlug" => "tlug",
"advocacy" => "advocacy",
"security-sig" => "security",
"iss.net" => "security",
"securityfocus" => "security",
"perl5-porters" => "p5p",
"linux-kernel" => "linux-kernel",
"perlsupport" => "perl-friends",
);
for my $what (keys %gated) {
next unless $from =~ /$what/i or
$to =~ /$what/i or $cc =~/$what/i;
my $where=$gated{$what};
print LOG "$from:$subject:Gated to lists.$where\n";
$item->pipe("/usr/local/bin/listgate $where");
}
Some spammers just don't give up, so we actually reject their messages. We do this based on subject, which is a bit risky but seems to work:
for ("Invest", "nude asian")) {
$item->reject("No! Go away!")
if $subject=~/\b$_\b/;
}
