kaul@icarus.eng.ohio-state.edu (Rich Kaul) (11/15/90)
Some time ago people got to posting scripts that did mail actions, so
I thought I`d throw in my entry. I get a fair quantity of mail, much
of it from mailing lists, the various computers I deal with and other
users. I prefer that such mail be placed in a format that I can read
with my favorite news reader, GNUS. Here's what I came up to do my
mail delivery. It's a bit more than twice as fast as the old shell
script I used to do this. The scheme I use is to try and decode the
"From " line (for well behaved lists and personal mail) and check the
"To:" and "CC:" lines (for less well behaved mailing lists). If it's
from a mailing list, drop it in a private news-like directory
structure in a file that's appropriately numbered. If it's from
someone on a short list, drop it in the mailbox, otherwise drop it in
a generic directory and number it correctly.
Comments are certainly welcome, especially as to style and efficiency.
I haven't been writing perl very long, as may be obvious from some of
the hacks. I'd love to see someone turn it into a one-liner ;-)
#!/usr/bin/perl
# A crude attempt at a perl mail delivery agent. The basic premise is
# that mail from certain people demands attention immediately, so it
# gets put in the normal system mailbox. Mail from mailing lists is
# to be placed in various subdirectories in a format that GNUS can
# handle for reading. Mail from the system, random users, etc, gets
# placed in a third directory ($Root). This is, of course, easily
# customizable. Delivering into a directory requires a .last file to
# keep track of article numbers.
#
# Pardon the perl style; I'm just learning but this works! Comments
# welcome.
#
# Author: Rich Kaul (kaul@icarus.eng.ohio-state.edu)
# Date: 11/13//90
# The credit where credit is due department: the core of the message
# parsing is based on Larry Wall's mailagent script, with much of the
# functionality removed.
#
# Usage: Make a .forward file like:
# "| /usr/1/kaul/bin/pmd /usr/1/kaul kaul >> /usr/1/kaul/.maillog 2>&1"
($HOME, $USER) = @ARGV;
$Root = "$HOME/Memos/personal"; # root of personal news tree.
$dest = $Root;
$box = "/usr/spool/mail/$USER"; # default mail box.
$GIVE_UP_BOX = "$HOME/mail_dump"; # emergency dumping box.
$LOCK_SH = 1; # Values for flock() calls.
$LOCK_EX = 2;
$LOCK_NB = 4;
$LOCK_UN = 8;
umask(077); # Get a little privacy.
# Now run and get the headers. We have to parse the headers before we
# can figure out delivery.
while (<stdin>) {
# Do this on the From_ line only.
if (1 .. 1) {
if (/^From\s+(\S+)\s+[^\n]*(\w{3}\s+\d+\s+\d+:\d+)/) { $from = $1; }
$from =~ s/@.*//; # remove trailing @machine
$from =~ s/%.*//; # remove trailing %machine
$from = $1 if $from =~ /.*!([^\n]+)/; # remove leading ! paths
}
# This section operates on the header of the message. We create
# an array of header keys to work on later.
if (1 .. /^\s*$/) {
s/^From: ([^<]*)\s+<(.*)>$/From: $2 ($1)/; # rewrite ugly header
$header .= $_;
chop;
if (/^\s*$/) {
foreach $key (keys(header)) {
eval "\$H$key = \$header{'$key'}";
}
}
else {
if (s/^([-\w]+):\s*//) {
($headline = $1) =~ y/A-Z-/a-z_/;
$header{$headline} .= "\n" if $header{$headline} ne '';
}
else {
s/^\s+/ /;
}
$header{$headline} .= $_;
}
}
# And here we make the body of the message.
else {
$body .= $_;
}
}
# Ok, now figure out where to deliver the message. The first case is
# mail from well behaved mailing lists (i.e. ones that advertise that
# they are mailing lists).
if($from =~ /firearms/) {$dest = "$Root/firearms";}
elsif($from =~ /Info-VM/ || $from =~ /Bug-VM/) {$dest="$Root/bug-vm";}
elsif($from =~ /freemacs/) {$dest = "$Root/freemacs";}
# Sometimes we have dumb mailing lists that can't get their act
# together. The interviews, oct and some freemacs stuff are prime examples.
if ($Hto =~ /gif/ || $Hcc =~ /gif/) {$dest = "$Root/gif";}
elsif($Hto =~ /gnuplot/ || $Hcc =~ /gnuplot/) {$dest = "$Root/gnuplot";}
elsif ($Hto =~ /freemacs/ || $Hcc =~ /freemacs/) {$dest = "$Root/freemacs";}
elsif ($Hto =~ /interviews/i || $Hcc =~ /interviews/i ) {
$dest = "$Root/interviews";}
elsif ($Hto =~ /vem/i || $Hto =~ /oct/i || $Hcc =~ /vem/i || $Hcc =~ /oct/i) {
$dest = "$Root/vem";}
elsif($Hto =~ /xviewbug-trackers/ || $Hcc =~ /xviewbug-trackers/) {
$dest = "$Root/xview";}
# Now we list the people who can crash into the mailbox.
if($from =~ /karl_kl/ || $from =~ /alden/ || $from =~ /monty/) {$dest = $box;}
elsif($from=~/pnelson/ || $from=~/wilson/i || $from =~ /gratz/i) {$dest=$box;}
elsif($from =~ /bibyk/ || $from =~ /adkins/ || $from =~ /zaka/) {$dest = $box;}
elsif($from =~ /kaul/) {$dest = $box;}
# Do the delivery. There are two cases. If we are delivering
# to a directory find and update the .last file there.
if ( -d $dest ) {
# It's going to be a news article, so change the From_ line
$header =~ s/^From /Unix-From: /;
$all = $header . $body;
$count_file = "$dest/\.last";
open(COUNTER,"+<$count_file")|| do gag("Can't open $dest/.last ($< $>): $!");
while (<COUNTER>) {
chop;
$count = $_;
$count++;
}
do flocker(COUNTER,$LOCK_EX); # Lock the file, just in case.
seek(COUNTER,0,0);
print COUNTER $count,"\n";
do flocker(COUNTER,$LOCK_UN);
# We now have the article number we need.
open(ART,">>$dest/$count") || do gag("Can't open $dest/$count ($< $>): $!");
print ART $all,"\n";
} else {
# Here we're delivering to a file, which is easier. Build and deliver.
$all = $header . $body;
open(BOX, ">>$dest") || do gag ("Can't open $dest ($< $>): $!");
do flocker(BOX,$LOCK_EX);
print BOX $all,"\n\n";
do flocker(BOX,$LOCK_UN);
}
# File locking subroutine.
sub flocker {
local ($file, $mode) = @_;
eval 'flock($file,$mode);';
seek($file, 0, 2); # in case it was appended while we were waiting
}
# For some reason mail couldn't get delivered. Dump the message in the
# emergency mailbox and exit.
sub gag {
open(ERR_BOX, ">>$GIVE_UP_BOX") || die "I'm really hosed. I can't even open the emergency box $GIVE_UP_BOX\n";
print @_;
do flocker(ERR_BOX,$LOCK_EX);
print ERR_BOX $all,"\n\n";
do flocker(ERR_BOX,$LOCK_UN);
exit 1;
}