filtering with Mail::Audit

["Michael P. Soulier" <msoulier@storm.ca>]

On Mon, Sep 25, 2000 at 02:59:46PM -0500, will trillich wrote:

> cool -- that'd be great! (i finally learned the CPAN module... hopefully
> it won't conflict with an apt-get install ...) this sounds wonderful!

    Here you go. 

    Mike

-- 
Michael P. Soulier <msoulier@storm.ca>
"...the word HACK is used as a verb to indicate a massive amount
of nerd-like effort."  -Harley Hahn, A Student's Guide to UNIX

#!/usr/bin/perl

############################################################
# CVS Data:
#
# $Header: /usr/cvsroot/personal/mike/bin/mailfilter,v 1.6 2000/09/25 23:00:03 msoulier Exp $
# $Date: 2000/09/25 23:00:03 $
# $Author: msoulier $
# $Revision: 1.6 $
############################################################

use strict;

use Mail::Audit;

my $mailroot    = "/home/msoulier/Mail";
my $logfile = $mailroot . "/filter.log";
my $rootbox = $mailroot . "/rootbox";
my $spampattern = '\bxxx.*\.com|sex|\$\$|Now!';
my $version = '$Revision: 1.6 $';
$version =~ s/\$|Revision://g;
$version =~ s/^\s+|\s+$//g;

chomp ( my $date = `date` );

my $message = Mail::Audit->new(
    reject => sub { exit 67; }
    );

open (LOGFILE, ">>$logfile")
    or die "Can't open $logfile: $!";

# Select the logfile for all print statements are put
# into the logfile. Less typing.
select LOGFILE;

my $from    = $message->from;
my $to      = $message->to;
my $subject = $message->subject;
my $cc      = $message->cc;
chomp ( $from, $to, $subject, $cc );

my %route = (
    "mutt"          =>      "mutt",
    "nlug"          =>      "nlug",
    "pm-ottawa"     =>      "pm-ottawa",
    "debian"        =>      "debian",
    "gnome"         =>      "gnome",
    "tetex"         =>      "latex",
    "oclug"         =>      "oclug",
    "$spampattern"  =>      "spambox",
);

my @losers = qw();
my $losermessage = "Your message was automatically rejected. Have a nice day.";

print "Mailfilter version $version\n";
print "Date: $date\n";
print "Received message from $from\n";
print "Subject: $subject\n";

for my $what (keys %route) {
    next unless $from =~ /$what/i
        or $to =~ /$what/i
        or $cc =~ /$what/i;
    my $where = $mailroot . '/' . $route{$what};
    print "Accepting to folder $where\n\n";
    $message->accept($where);
}

for my $loser (@losers) {
    next unless $from =~ /$loser/i;
    print "From loser $loser...rejecting...\n\n";
    $message->reject($losermessage);
}

# Hard-coded entry for root messages on this machine.
if ($to eq 'root') {
    print "Sysadmin message. Accepting to $rootbox.\n\n";
    $message->accept($rootbox);
}

# Temporary hard-coded fix to block those stupid
# errors every time I post to the debian list.
if (($from eq 'webmaster@my.netvigator.com')
    and ($subject =~ /undelivered email/))
{
    print "Rejecting stupid Debian error message.\n\n";
    my $reason = "I'm sick of looking at these in my inbox.";
    $message->reject($reason);
}

print "Accepting to inbox.\n\n";
$message->accept;

############################################################
# CVS Log:
############################################################
# $Log: mailfilter,v $
# Revision 1.6  2000/09/25 23:00:03  msoulier
# Added oclug.
#
# Revision 1.5  2000/09/24 20:00:56  msoulier
# Fixed remaining whitespace around version number.
#
# Revision 1.4  2000/09/24 19:56:06  msoulier
# Using keyword expansion to pick up version.
#
# Revision 1.3  2000/09/24 19:50:32  msoulier
# Added hardcoded fix to block those stupid debian-list error messages.
# Added handling for local root messages.
#
# Revision 1.2  2000/09/24 16:28:44  msoulier
# Fixed reject code. Added select for less typing, and added
# a spam pattern.
#
# Revision 1.1.1.1  2000/09/24 16:13:30  msoulier
# Email Filter
#
############################################################