Date:    Mon, 1 Jun 1992 20:00:07 GMT
Subject: Mail auditing + more package
From:    Martin Streicher <strike@convex.COM>

I am changing jobs, so this will be the final release of my audit
package until I get a new UNIX account established. There are
several little bugs fixed in this release that should fix
lots of parsing problems - other than that, this package seems very solid
and I have gotten good feedback on the usefulness of the package.

Enjoy...

The audit.pl package. 
=====================

What this package does:
=======================
This package provides routines that parse an incoming mail message, divide
it into a header and the body of the message and further decompose
the mail header into its fields. The routines set variables that you
can query and parse in your own PERL script to determine what to do with
the incoming mail message.

To use the package, insert the following two PERL instructions to the very
TOP of your PERL script:

require '/gmaster/home/strike/work/perl/deliver/audit.pl' || 
        die "deliver: cannot include audit.pl: $@";

&initialize();


Variables that &initialize() sets:
---------------------------------
The routine &initialize() reads the incoming mail message and sets
the following variables:

$sender		This is the sender shown on the "From " line.

%headers	An associative array containing the lines in the mail
		header. $header{'Subject'} contains the Subject: line;
		$header{'Date'} contains Date:, etc. 
		
		If the To: or Cc: line appeared more than once in the header,
		those lines are concatenated together into a single
		comma-separated list of names. Other header lines that
		appear twice are clobbered.

There are also many variables and arrays set for your convenience if you
dont want to parse the entries of %headers yourself.

$subject	The Subject: line.

$precedence	The Precedence: line.

$friendly	The friendly (human) name of the sender
		(e.g., Martin Streicher)

$address	The email address of the sender 
		(e.g., strike@pixel.convex.com)

$from		The login name of the sender with all addressing stripped. For
		example, if $address was strike@pixel.convex.com, $from
		is strike.

$organization	The name of the sender's organization. This is derived from
		$address; for example strike@pixel.convex.com yields convex;
		wizard!jim@uunet.uu.net yields wizard; jane@mach.site.co.uk
		yields site.

@to		The list of names on the To: line(s). Note that the 
		name listed on the Apparently-To: line also appears in @to.

@cc		The list of names on the Cc: line(s).

@received	The list of received headers in the mail message that
		show the path the message traveled to be delivered.


Routines that audit.pl provides:
--------------------------------
The package offers some canned routines for handling the incoming
mail message:

&deliver()	Deliver the incoming mail message. &deliver() appends
		the incoming mail message to the end of your UNIX mail
		drop /usr/spool/mail/<user>, where <user> is the name
		specified in the .forward file. 

&vacation()	Reply automatically to the sender if you have a vacation 
		message in $HOME/.vacation.msg. If you do not have this
		file, this routine does absolutely nothing. If you have
		a .vacation.msg file, &vacation sends the sender of the
		message an automatic reply containing that file.

		This routine also records who you sent 
		vacation mail to; it will not send duplicate vacation messages
		to the same person.  If you change your vacation message, the 
		list is zeroed. The list of people you sent vacation mail to
		is kept in $HOME/.vacation.log. 

		Some notes about &vacation():
			- It will send you vacation mail. This is useful
			  to test your vacation message out.

			- It will not send vacation mail to anyone named
			  root, mailer-daemon, postmaster, daemon or mailer.
			  This are not considered to be real users.

			- It will not respond to mail that is labelled
			  with precendence bulk or junk.

&file_from() or 
&file_from($dir)
		This routine files the incoming mail message
		in a hierarchy of mail folders. The top-level of the
		hierarchy is specified in $dir; by default (if no
		directory is specified) it is $HOME/log. The next level
		of the hierachy is sorted by $organization; below this level
		mail is sorted by the sender's login name.

		For example, say you receive a message from 
		strike@pixel.convex.com; if you call &file_from(),
		the corresponsing mail message will be filed into a mail
		folder called $HOME/log/convex/strike. All mail sent to you
		by strike@pixel.convex.com would be filed in this mail folder.

		You can &file_from to file all correspondence for future
		reference.

&openpipe($command)
		You can also use your own commands (scripts/programs)
		to process an incoming mail message. &openpipe($command)
		opens a PERL pipe to $command and pipes the mail message
		to that command.

You can use none, one or all of these routines. You can also repeat
and combine all of these functions to do more than one thing with a piece of 
incoming mail (you probably only want to &deliver() the message once though).

For example, say you get a message from strike@pixel.convex.com. You want 
to file the message away for auditing purposes, save the mail message in your 
mail drop and send some vacation mail if you are gone. Use the &file_from(), 
&deliver() and &vacation() functions to do all of these things to one message.

WARNING: IF YOU EXIT FROM THE PERL SCRIPT WITHOUT DOING SOMETHING
	 WITH THE MAIL MESSAGE, IT IS LOST FOREVER.

Actually, exiting the PERL script can be an effective way of dropping
unwanted mail messages. See the example below.


Other convenience functions for MH users:
-----------------------------------------
If you use MH, other convenience routines are provided to 
pipe the incoming mail message to rcvstore, rcvdist and/or rcvtty.
There is also a special refile routine to file incoming mail messages
in folders according to the sender's organization and login. 

To access the MH functions, add the following line to the TOP of your script:

require '/gmaster/home/strike/work/perl/deliver/mh.pl' || 
        die "deliver: cannot include mh.pl: $@";

This file provides the following functions:

&rcvstore($folder)	
		Pipe the incoming mail message to rcvstore; the $folder
		argument is the name of the folder to store the message
		into.	

&rcvtty()	Pipe the incoming mail message to rcvtty. rcvtty
		is MH's equivalent to biff and its output can be tailored
		exactly like you can customize scan or inc. 

&rcvdist($names)
		Pipe the incoming mail message to rcvdist. $names
		is a blank separated list of names to send the
		message to. You can use the &ali() command (see below)
		to expand MH aliases.

&ali($alias)	Expand the MH alias name in $alias to the list
		of addresses it stands for. Unlink all the other routines,
		this routine returns an array of names, where
		each element is an addressee on the alias.

&refile_from() or
&refile_from($dir)
		File a copy of the incoming mail message into a hierarchy of
		MH folders. The top-level directory is "log" by default unless
		you specify another folder (all this below you Mailpath folder,
		of course). The next level is sorted by organization name
		and the level below that is sorted by sender's login name.



Writing a PERL mail auditing script:
====================================
The best way to show what all this can do is with a specific example. Here 
is my script (with comments!):

------ script starts here -------
#! /usr/local/bin/perl

require '/gmaster/home/strike/work/perl/deliver/audit.pl' || 
        die "deliver: cannot include audit.pl: $@";

require '/gmaster/home/strike/work/perl/deliver/mh.pl' || 
        die "deliver: cannot include mh.pl: $@";

&initialize();


# -----
# My mail processing starts here
#

# If this message came from the MAILER, deliver it to me directly
# and do nothing else.
#
($from =~ /MAILER/) && do { &deliver(); exit; };

# If this message is sent to xpixel (either To or Cc, deliver
# the messsage to me and exit.
#
(grep(/^xpixel/, @to, @cc)) && do { &deliver(); exit; };

# If the message is from a place called "lupine", this
# is really NCD.
#
$organization = "ncd" if ($organization eq "lupine");

# If the sender's name is in the password file, the organization
# is CONVEX.
#
$organization = "convex" if ($logname = (getpwnam($from))[0]);

# If I am specifically named on the To or Cc line, do the default.
# The routine &default is below: it delivers the message, refiles
# it in an MH folder, sends vacation mail if I am gone, and
# biffs me if I am logged in somewhere.
#
(grep(/^strike/, @to, @cc)) && do { 
    &default();
    exit;
};

# If the mail message went to x<hostname> where hostname
# is in our /etc/hosts, trash the message (JUST EXIT TO DROP
# THE MESSAGE)
#
exit if (grep((/^x(.*)/ && (@n = gethostbyname($1))), @to, @cc));

# Throw away anything to anyone or any alias named avs-updates
#
exit if (grep(($_ eq "avs-updates"), @to));

# Throw away junk mail from AVS, Inc.
#
if ($organization eq "avs") {
    exit if ($subject =~ /^(Opened|Assigned) to/);
    exit if ($subject =~ /^(Edited|Fixed|Killed) by/);
};


# If the mail message went to an X Consortium alias,
# deliver it to me if it is advisory board mail. Otherwise,
# refile it into an archive and redistribute it to anyone at CONVEX
# that subscribes to it through me.
#
$xcons = 0;
@consortium = (
	'/^advisory/',	'/^blend/',		'/^bug-trackers/',
	'/^color/',	'/^fix-trackers/',	'/^fontwork/',
	'/^imagework/',	'/^xlib/',		'/intrinsics/',
	'/^mltalk/',	'/^pex-si/',		'/^pex-spec/',
	'/^protocol/',	'/^security/',		'/^shape/',		
	'/^trackers/',	'/^transport/',		'/^wmtalk/',		
	'/^xbuffer/',	'/^xc/',		'/^xinput/',			
	'/^xtest/',	'/^consortium/',	'/^serialwork/',
	'/^xie_/',	'/^mtserver/'
);

foreach $list (@consortium) {
	for (grep(eval $list, @to, @cc)) {
	   &deliver() if ($_ =~ "^advisory");
	   $xcons++;
	   &rcvstore("XConsortium/$_"); 
	   @dist = &ali("XConsortium-$_");
	   &rcvdist(join(' ', @dist)) if ((@dist)); 
	};
};
exit if $xcons;


# this mail was not sent to me directly, so dont answer with vacation mail,
#
&deliver();
&rcvtty();

# All done!
#
exit;


# =====
# Subroutine default
# 	defaults specifies what to do when I want to accept a piece
#	of mail. It is a convenience.
sub default {

    &deliver();
    &vacation();
    &rcvtty();
    &refile_from();
}

------ script ends ----------


Testing
========
If you want to test your PERL script, put the following in your .forward file:

	<login>, "| <homedir>/<script> <login>

where <login> is your UNIX login, <homedir> is the absolute path name
to your home directory and <script> is the name of your PERL mail
auditing script. If you put this in .forward, incoming mail messages
will be directly sent to your mail drop AND will be piped through your
PERL script. You may get duplicates of some mail, but this is the best
way to see what your script is doing.

Once you are satisifed that your script works, simply replace your
.forward file with:

	"| <homedir>/<script> <login>

Please note that if your script has syntax errors, the mailer will
not drop your incoming mail; instead it will send you a the incoming
mail message and a note indicating that an unknown mailer error occurred.

Another way to test your script:
--------------------------------
You can also test your script by piping a UNIX mail folder (like your 
mail drop) directly into your script. For example, say you are having
problems with mail from a certain sender or network alias; to debug your
script, copy your incoming mail box in /usr/spool/mail to a local file
and then pipe it to your script ala:

	cat mail | perl -d ~/.audit

You can then step through the script and see how the mail message
is being parsed. You can add breakpoints, print statements, etc. and see
the script operate on the mail. If you use &vacation() or &file_from(),
you can watch those routines operate as well. The mail message is processed 
as if it came directly to your script courtesy of the delivery system.