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 <[EMAIL PROTECTED]>
"...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 '[EMAIL PROTECTED]')
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
#
############################################################
