[comp.lang.perl] Perly mail filters

eastick@me.utoronto.ca (Doug Eastick) (09/05/90)

Ok JAPHs, what do some of you use to filter your incoming mail?  I've
been using filter(1) which comes with ELM but it is quite simple and
doesn't handle regexp's.

I'd like to be able to save/delete incoming mail based on things in
	From:
	Subject:

Or, as a last resort, just something (efficient) which will tear apart the 
header for me and I'll go from there.

merlyn@iwarp.intel.com (Randal Schwartz) (09/05/90)

In article <90Sep5.070222edt.18759@me.utoronto.ca>, eastick@me (Doug Eastick) writes:
| Ok JAPHs, what do some of you use to filter your incoming mail?  I've
| been using filter(1) which comes with ELM but it is quite simple and
| doesn't handle regexp's.
| 
| I'd like to be able to save/delete incoming mail based on things in
| 	From:
| 	Subject:
| 
| Or, as a last resort, just something (efficient) which will tear apart the 
| header for me and I'll go from there.

Here's what I'm doing for the moment.  My particular application
involves taking the mail, recording the headers into a log-file (so
that I can see how things are being addressed to me at a glance... I'm
eventually interested in a lwall-like mail response daemon), and then
stuff the body of the article into MH's rcvstore so that it gets
"inc"-ed into my incoming mailbox automatically.  I have
"|/j/merlyn/.mailman" in my ".forward" file.

It might be rough, but it should be a start...

================================================== snip here

#!/local/usr/bin/perl

%newENV = (
	'HOME', '/j/merlyn',
	'PATH', '/local/merlyn/bin:/local/usr/bin:/usr/ucb:/bin:/usr/bin',
	'SHELL', '/bin/sh',
	'USER', 'merlyn',
);

for (keys ENV) {
	delete $ENV{$_};
	$ENV{$_} = $newENV{$_} if defined $newENV{$_};
}

chdir;

open(STDOUT,">>.mailmanlog") || die "Cannot open .mailmanlog ($!)";
open(STDERR,">&STDOUT");
flock(STDOUT,2); # lock_ex
seek(STDOUT,0,2); # in case someone else had it while we were waiting
$message = join("",<STDIN>);
($_ = $message) =~ s/\n\n[^\0]*/\n/;
s/\n(\s+)/\377\1/g; # hide continuations
@headerlines = split(/\n/);
for $h (split(/\s+/,<<EOL)) {
Reply-To From Sender Apparently-To To Cc Subject Date Message-ID
EOL
	@h = grep(s/^$h:\s*//i, @headerlines);
	next unless @h;
	print "$h: ", join("\n and $h: ", @h), "\n";
}
print "\n";

open(RCVSTORE,"|/local/usr/lib/mh/rcvstore -create +inbox") ||
	die "Cannot open RCVSTORE: $!";
print RCVSTORE $message;
close(RCVSTORE);
exit(0);

================================================== snip here

print "Just another Perl hacker,"
-- 
/=Randal L. Schwartz, Stonehenge Consulting Services (503)777-0095 ==========\
| on contract to Intel's iWarp project, Beaverton, Oregon, USA, Sol III      |
| merlyn@iwarp.intel.com ...!any-MX-mailer-like-uunet!iwarp.intel.com!merlyn |
\=Cute Quote: "Welcome to Portland, Oregon, home of the California Raisins!"=/

chip@tct.uucp (Chip Salzenberg) (09/07/90)

[ Followups to comp.mail.misc ]

According to eastick@me.utoronto.ca (Doug Eastick):
>Ok JAPHs, what do some of you use to filter your incoming mail?

A program I wrote, called Deliver.  It allows users to write scripts,
called "deliver files," to control mail delivery.  When the scripts
run, the message header and body have been separated into two files,
the names of which are in the environment.  The output of the script
is a list of addresses and/or mailbox files that should receive the
message after all.

I wrote my system-wide delivery file in Perl, because it does
complicated things with a Micnet (ugh) network.

The current version, Deliver 2.0 PL13, is available at finer archive
sites everywhere (as soon as Rich posts patch #13).
-- 
Chip Salzenberg at Teltronics/TCT     <chip@tct.uucp>, <uunet!pdn!tct!chip>

lwall@jpl-devvax.JPL.NASA.GOV (Larry Wall) (09/07/90)

Here's my mailagent.  The mailpatch stuff should be in Perl, but I'm lazy.
Note that this mailagent is BSD specific in several ways, such as how
to lock mail files and where to find them.

Hmm.  Maybe this should go in the book...

Larry

#!/bin/sh
: make a subdirectory, cd to it, and run this through sh.
echo 'If this kit is complete, "End of kit" will echo at the end'
echo Extracting mailagent
sed >mailagent <<'!STUFFY!FUNK!' -e 's/X//'
X#!/usr/bin/perl
X
X# You'll need to set up a .forward file that feeds your mail to this script.
X# Mine looks like this:
X#   "| /u/sfoc/lwall/bin/mailagent /u/sfoc/lwall lwall Larry >>/u/sfoc/lwall/.maillog 2>&1"
X
X($HOME, $USER, $NAME) = @ARGV;
X
X$ENV{'PATH'}="$HOME/bin:/bin:/usr/bin:/usr/ucb";
X$ENV{'IFS'} = '' if $ENV{'IFS'};
X
X$LOCK_SH = 1;
X$LOCK_EX = 2;
X$LOCK_NB = 4;
X$LOCK_UN = 8;
X
X$hostname = `hostname`;
X
Xif ($hostname !~ /vax/) {
X    $rsh = 'rsh basvax' if $hostname =~ /mhr/;
X    open(MAILER,"| $rsh /bin/mail $USER@basvax");
X    while (<stdin>) {
X	print MAILER;
X    }
X    exit 0;
X}
X
Xopen(MBOX, ">>/usr/spool/mail/$USER") || die "Can't open mailbox ($< $>): $!";
X
Xopen(MBAK,">>$HOME/mailbackup");
X
Xopen(PUBOX,">>$HOME/pu");
X
Xif (!$NAME || !(chdir $HOME)) {
X    do lock();
X    while (<stdin>) {
X	$pu = 1 if /^From perl-users/;
X	print MBAK;
X	print MBOX;
X	print PUBOX if $pu;
X    }
X    print MBAK "\n\n";
X    print MBOX "\n\n";
X    print PUBOX "\n\n" if $pu;
X    exit 0;
X}
X
Xchop($HOME=`pwd`);
X$ENV{'HOME'} = $HOME;
X$ENV{'USER'} = $USER;
X$ENV{'NAME'} = $NAME;
X
Xumask(022);
X
X$dest = $USER;
X$cmd = '';
Xline: while (<stdin>) {
X    if (1 .. /^\s*$/) {
X	$pu = 1 if /^From perl-users/;
X	s/^From: ([^<]*)\s+<(.*)>$/From: $2 ($1)/;
X	s/^(From: .*Mailer-Daemon@)([^(]*)\(/$1$2($2/i;
X	$header .= $_;
X	chop;
X	if (/^\s*$/) {
X	    foreach $key (keys(header)) {
X		eval "\$H$key = \$header{'$key'}";
X	    }
X	}
X	else {
X	    /^From ([^ 	]*).*$/ && ($dest = $1, next);
X	    if (s/^([-\w]+):\s*//) {
X		($headline = $1) =~ y/A-Z-/a-z_/;
X		$header{$headline} .= "\n" if $header{$headline} ne '';
X	    }
X	    else {
X		s/^\s+/ /;
X	    }
X	    $header{$headline} .= $_;
X	}
X    }
X    else {
X	$body .= $_;
X	/^@RR/ && ($ack = 1);
X	s/^	@SH/@SH/;
X	if (/^@SH/) {
X	    if (!($gotcmds++) && open(CMD,"$HOME/.commands")) {
X		while ($foo = <CMD>) {
X		    chop($foo);
X		    $command{$foo} = 1;
X		}
X		close(CMD);
X	    }
X	    s/\\!/!/g;
X	    if (/[=$^&*([{}`\\|;>?]/) {
X		s/^@SH/bad cmd:/;
X		$bad .= $_;
X		next line;
X	    }
X	    s/ PATH/ $dest/;
X	    s/SH mailpath/SH mailpatch/;
X	    s/SH mailpatch (\w)@(\w)\s/SH mailpatch $2!$1 /;
X	    s/@SH\s*//;
X	    ($first) = split;
X	    $command{'mailpatch'} = 1;
X	    if (!$command{$first}) {
X		s/^/unk cmd "$first":/;
X		$bad .= $_;
X		next line;
X	    }
X	    $cmd .= $_;
X	}
X    }
X}
X
X$all = $header . $body;
X
Xif (open(TWITS,'.twitlist')) {
X    while (<TWITS>) {
X	chop;
X	++$suppress{$_};
X    }
X    close TWITS;
X}
X
X$suppress = 1 if
X#    $Hto =~ /admin/ ||
X#    $Happarently_to =~ /admin/ ||
X#    $Hcc =~ /admin/ ||
X    $body =~ /I got your message, whatever it was/;
X
Xif ($cmd) {
X    $body =~ s/\n\s*@SH.*//g;		# delete @SH lines
X    $body =~ s/\n[ \t]*-[^\0]*//;		# delete signature.
X    $body =~ s/\n\s*thank(s| ?you|s in advance)[,.]?\s*//i;
X    $body =~ s/\n\s*atdhvaannkcse[,.]?\s*//i;
X    $body =~ s/\n\s*Thank[^.!,]*.//;
X    $body =~ s/"[^"]*"//g;		# don't count quotes.
X    $body =~ s/ /  /g;			# so the next thing works right
X    $normwords = ($body =~ s/ [a-z]+ //g);	# count normal words
X    $justcmds = 1 if $normwords < 3;	# Probably is a signature.
X}
X
X$suppress = 1 if $justcmds;
X$suppress = 1 if $suppress{$dest};
X
X$suppress = "[suppress]\n" if $suppress;
X
X$local = ($dest =~ /^[a-zA-Z_0-9@]+$/);	# disallow "." and "!", primarily
X
X$Hto =~ s/.*(<.*>).*/$1/;
X$mailinglist = ($Hto =~ /\S+\s+\S+/ || $Hto !~ /lwall/);
X
Xif ($dest ne $USER) {
X
X    if ($cmd ne '' && ($justcmds || $Hsubject =~ /^command$/i)) {
X	open(CMD,">/tmp/mess.cmd$$");
X	print CMD "set -x\n",$cmd;
X	close CMD;
X	$tmp = `sh -x /tmp/mess.cmd$$ 2>&1`;
X	if ($?) {
X	    open(MAILER,"|/bin/mail $dest $USER");
X	    print MAILER
X"Subject: the following returned a non-zero status
XTo: $dest
X
X$tmp
X
Xmailagent speaking for $USER
X";
X	    close MAILER;
X	    $all .= "[Command failed]\n";
X	    $suppress = '';
X	}
X	unlink "/tmp/mess.cmd$$";
X    }
X
X    $ack = 0 if $dest =~ /DAEMON/;
X    if ($ack) {
X	open(MAILER,"|/bin/mail $dest $USER");
X	print MAILER
X"Subject: $Hsubject
XTo: $dest
X
XHere is the receipt you requested.
X
Xmailagent speaking for $USER
X";
X	close MAILER;
X	$all .= "[Acked]\n";
X    }
X
X    if ($bad) {
X	open(MAILER,"|/bin/mail $dest $USER");
X	print MAILER
X"Subject: the following commands were not executed
XTo: $dest
X
X$bad
X
XIf $NAME can figure out what you wanted he may do it anyway.
X
Xmailagent speaking for $USER
X";
X	close MAILER;
X	$all .= "[Bad Command]\n";
X	$suppress = '';
X    }
X
X    if (!$ack && !$local && !$mailinglist && $Hsubject !~ /^Forwarded:/) {
X	if ($cmd eq '') {		# not a command
X	    if ($dest !~ /mailer-daemon|postmaster/i) {
X		open(VACATION,"|vacation lwall");
X		print VACATION $all;
X		close VACATION;
X		$all .= "[Vacation]\n";
X	    }
X	}
X    }
X
X#    if ($local) {
X#	$all =~ s/From: (.*)\(/From: $1(#/;
X#    }
X}
Xif ($all =~ /^From willie@sm.unisys.com/) {
X    $all =~ s/^.*Unsent message follows -*\n//i &&
X	$all =~ s/Subject: /Subject: (W) /;
X}
X
X$all =~ s/Subject: /Subject: (S) / if $suppress;
X
Xdo lock();
Xprint MBOX $all,$suppress,"\n\n";
Xprint MBAK $all,"\n\n";
Xprint PUBOX $all,"\n\n" if $pu;
Xdo unlock();
X
Xsub lock {
X    eval 'flock(MBOX,$LOCK_EX);';
X    seek(MBOX, 0, 2);		# in case some appended while we were waiting
X    seek(MBAK, 0, 2);		# one lock covers both files
X}
X
Xsub unlock {
X    eval 'flock(MBOX,$LOCK_UN);';
X    seek(MBOX, 0, 2);		# in case some appended while we were waiting
X    seek(MBAK, 0, 2);		# one lock covers both files
X}
!STUFFY!FUNK!
echo Extracting mailpatch
sed >mailpatch <<'!STUFFY!FUNK!' -e 's/X//'
X#!/bin/sh
X
X# You'll have to customize this to know about your own packages.  Also, copy
X# rangeargs to your private bin directory, or change invocations below.
X
Xcmd=`date`"  $@ "
Xcd $HOME
X
Xdest=$1
Xshift
Xsystem=$1
Xshift
Xversion=$1
Xshift
Xcase "$system" in
Xdist|DIST)
X    cd /u/sfoc/lwall/src/dist/bugs
X    maxnum=`/bin/sed -n -e 's/^[^0-9]*\([1-9][0-9]*\).*$/\1/p' ../patchlevel.h`
X    curversion='2.0'
X    ;;
Xperl|PERL)
X    cd /usr/spool/ftp/pub/perl.3.0/patches
X    maxnum=`/bin/sed -n -e 's/^[^0-9]*\([1-9][0-9]*\).*$/\1/p' ../patchlevel.h`
X    curversion='3.0'
X    ;;
Xrn|RN)
X    cd /u/sfoc/lwall/src/rn/bugs
X    maxnum=`/bin/sed -n -e 's/^[^0-9]*\([1-9][0-9]*\).*$/\1/p' ../patchlevel`
X    curversion='4.3'
X    ;;
Xpatch|PATCH)
X    cd /u/sfoc/lwall/src/patch/bugs
X    maxnum=`/bin/sed -n -e 's/^[^0-9]*\([1-9][0-9]*\).*$/\1/p' ../patchlevel.h`
X    curversion='2.0'
X    ;;
Xwarp|WARP)
X    cd /u/sfoc/lwall/src/warp/bugs
X    maxnum=`/bin/sed -n -e 's/^[^0-9]*\([1-9][0-9]*\).*$/\1/p' ../patchlevel.h`
X    curversion='7.0'
X    ;;
Xcdiff|cdiff)
X    cd /u/sfoc/lwall/src/cdiff/bugs
X    maxnum=`/bin/sed -n -e 's/^[^0-9]*\([1-9][0-9]*\).*$/\1/p' ../patchlevel.h`
X    curversion='1.1'
X    ;;
X*)
X    /bin/mail $dest $USER <<EOM
XI don't know how to send patches for a program called $system.  Sorry.
X
XIf $NAME can figure out what you meant you'll get the patches anyway.
X
Xmailpatch speaking for $USER
XEOM
X    echo $cmd FAILED >> $HOME/.patchlog
X    exit 1
X    ;;
Xesac
X
Xcase "$version" in
X$curversion) ;;
X*)
X    /bin/mail $dest $USER <<EOM
XI don't know how to send patches for version $version of $system.  Sorry.
X
XIf $NAME can figure out what you meant you'll get the patches anyway.
X
Xmailpatch speaking for $USER
XEOM
X    echo $cmd FAILED >> $HOME/.patchlog
X    exit 1
X    ;;
Xesac
X
Xargs="$*"
X
Xset X `$HOME/bin/rangeargs -m "$maxnum" $*`
Xshift
X
Xcase $# in
X0) set X `$HOME/bin/rangeargs -m 100 $args`
X    shift
X    set $1
X    ;;
Xesac
X
Xfor num do
X    /bin/cat <<EOM >/tmp/mp$$
XTo: $dest
XSubject: $system version $version patch #$num
X
X[The latest patch for $system version $version is #$maxnum.]
X
Xmailpatch speaking for $USER
X
XEOM
X    if test -f patch$num; then
X	/bin/cat <patch$num >>/tmp/mp$$
X	/bin/echo "### End of Patch $num ###" >>/tmp/mp$$
X    fi
X    /usr/lib/sendmail -odq -t </tmp/mp$$
Xdone
Xrm -f /tmp/mp$$
Xecho $cmd OK >> $HOME/.patchlog
!STUFFY!FUNK!
echo Extracting rangeargs.c
sed >rangeargs.c <<'!STUFFY!FUNK!' -e 's/X//'
X#include <ctype.h>
X#include <stdio.h>
Xmain(argc,argv)
Xint argc;
Xchar **argv;
X{
X    register int i;
X    register int min, max;
X    int maxspec = 0;
X    register char *s;
X
X    for (argc--,argv++; argc; argc--,argv++) {
X	if (strcmp(argv[0],"-m")==0) {
X	    argc--,argv++;
X	    maxspec=atoi(argv[0]);
X	    continue;
X	}
X	s = argv[0];
X	while (*s) {
X	    min=atoi(s);
X	    while (*s && !isdigit(*s))
X		s++;
X	    while (isdigit(*s))
X		s++;
X	    if (*s == ',') {
X		max = min;
X		s++;
X	    }
X	    else if (*s == '-') {
X		max = atoi(s+1);
X		if (max == 0 && maxspec)
X		    max=maxspec;
X		while (*s && *s != ',')
X		    s++;
X		if (*s)
X		    s++;
X	    }
X	    else max=min;
X	    for (i=min; i<=max; i++) {
X		printf("%d",i);
X		if (i != max || argc || *s)
X		    putchar(' ');
X	    }
X	}
X    }
X    putchar('\n');
X}
!STUFFY!FUNK!
echo ""
echo "End of kit"
: I do not append .signature, but someone might mail this.
exit