From: jkt@SED.Provo.Novell.COM (Jack Thomasson)
Newsgroups: comp.emacs
Subject: Re: anything better than RMAIL around? (LONG)
Date: 3 Sep 92 16:27:39 GMT
Organization: Novell, Inc.

there was a package that came through comp.lang.perl a while ago
called "audit" written by strike@convex.com.  (the author noted that
he was changing jobs so i'm not sure if the mail address is still
valid.)  i added a function to this package which allows me to read my
now-preprocessed mail from gnus.  i'm including the post and my
addition.  the documentation for the audit stuff is decent.
documentation for my gnus-mailer hook is probably non-existant (see my
.signature anyway).  documentation for gnus-on-private-directory is
available.  enjoy :{)}

From: strike@convex.com (Martin Streicher)
Newsgroups: comp.lang.perl,comp.mail.mh,convex.general,comp.mail.misc
Subject: Mail auditing + more package
Date: 1 Jun 92 20:00:07 GMT
Reply-To: strike@convex.com
Organization: CONVEX Computer Corporation, Visualization Development
X-Disclaimer: This message was written by a user at CONVEX Computer
              Corp. The opinions expressed are those of the user and
              not necessarily those of CONVEX.


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...


# ------------------------ cut here -------------------------------
# This is a shell archive.  Remove anything before this line,
# then unpack it by saving it in a file and typing "sh file".
#
# Wrapped by pixel!strike on Mon Jun  1 14:53:15 CDT 1992
# Contents:  Bug_fixes CHANGES Installation README Suggestions audit.pl mh.pl
#	refileto rfolder
 
echo x - Bug_fixes
sed 's/^@//' > "Bug_fixes" <<'@//E*O*F Bug_fixes//'
Bugs fixed since previous release:

	- @to and @cc are always created. 
	- $apparentlyto is set to $headers{"apparently-to"} if it exists.
	- mail header names that contain hyphens (return-path, replty-to,
	  etc.) are parsed correctly.
@//E*O*F Bug_fixes//
chmod u=rw,g=r,o=r Bug_fixes
 
echo x - CHANGES
sed 's/^@//' > "CHANGES" <<'@//E*O*F CHANGES//'
V0.2 Changes 
============

The variable $friendly now is set to the friendly part of the sender's
email address. For example, if the sender's address is:

	strike@convex.com (Martin Streicher)

$friendly would be set to "Martin Streicher"



Keys for the %headers array are all lowercase. That is to say that if a mail
message has headers:

	To: strike
	Cc: george
	From: zombie@foo.edu
	Subject: News

the keys for %header will be "to", "from", "cc", "subject". $header{"subject"}
would be set to "News"



The "Received" headers in a mail message are now saved in an array called
@@received. The first element in the array is the first received header;
that last element in the array would show the message being delivered to
your machine. See the Suggestions file for how to use this feature.



If someone from your local machine sends you email, $organization
is set to "local". If the site name (e.g.,"convex" for "pixel.convex.com")
cannot be determined, $organization is set to "unknown". Also, $organization
is much more reliable (I have not found a case yet where $organization
was not set correctly.) 



$organization is always in lower-case.



audit.pl was broken up to make the code more reusable. The utilities
refileto and refilefrom use some of the routines in audit.pl and mh.pl.



Fixed a bug that sometimes added NULL to an empty message body.



mh.pl has new routines to recursively create a directory path, parse your
MH profile and parse MH-like command line options.


New utilities
=============
There are two new utilities: refileto and rfolder and adjunts refilefrom
and rfolders.

refileto is used to refile messages into log folders according to who
you sent the messages to. refilefrom refiles messages you   have received
according to who sent you the message. 

By default all messages are logged into the folder +log. You can change this
by adding the line:

	Logdir:                 log

to your .mh_profile. Also by default, the current folder is processed.
You can change that also. Here are the command line options for 
refileto/refilefrom:

refileto -help
syntax: refileto [msgs] [switches]
   switches are:
   -debug
   -draft
   -file file
   -help
   -link
   -log +folder
   -nolink
   -nopreserve
   -preserve
   -rmmproc program
   -src +folder
   -verbose


A sample usage might be:

refileto -src +outbox -verbose 

-verbose shows you what is being files and where. Use -debug to check what will
happen without actually refiling the mail messages.

Here is a sample output of the command 
"refileto -src +log/outgoing -verbose all":

refile  -file /gmaster/home/strike/Mail/log/outgoing/5 +log/local/holt
refile  -file /gmaster/home/strike/Mail/log/outgoing/7 +log/convex/sowton
refile  -file /gmaster/home/strike/Mail/log/outgoing/9 +log/convex/lutz 
	+log/convex/sowton



The rfolder utility is like folders: it can recursively descend 
a list of folders. However, you can use rfolder to run another MH command
in every folder it finds. For example, let say you want to sort
all of the subfolders in your +log folder.

You could say:

rfolder +log -all -recurse -verbose -exec sortm -textfield subject

-debug will show you what might happen without actually executing the
command.

By the way, -clean can be used to remove empty folders (empty folders
must be completely empty, without any .# or # files from rmm's, etc.)


You can even use refileto/refilefrom and rfolder(s) to build a new 
log directory from all your existing mail. Ala:

rfolder -all -recurse -verbose -exec refilefrom -log +log -src


rfolders implis the -all -recurse flags
@//E*O*F CHANGES//
chmod u=rw,g=r,o=r CHANGES
 
echo x - Installation
sed 's/^@//' > "Installation" <<'@//E*O*F Installation//'
1. Create a directory and unpack the perl files.

2. Create a perl script to audit your mail. You might name it something
   like ~/.audit.

3. Follow the instruction in the README and require the files audit.pl
   and mh.pl in your PERL script. 
   
   *
   * BE SURE TO CHANGE THE PATH NAMES to 
   * to the absolute path name of where you unpacked 
   * the files in step 1.
   *

   If you install the .pl file in /usr/lib/perl, you can just
   require them as in "require 'audit.pl';"

4. Create a .forward file in your home directory and add 

   " | <pathname of audit file> <login>"

   where <pathname> is the absolute path of your audit script
   and <login> is your login name.

5. If you are going to use the refileto and rfolder utilities,
   also edit the unshift line to reference the NEW absolute path.

   By default it will look in the path reference by the environment
   variable DELIVERPATH. You can change that to an absolute path
   if you want to.

   If you installed audit.pl and mh.pl in /usr/lib/perl,
   you can delete the unshift line.

6. Make sure you chmod +x your audit file script!


For example,

1. My PERL files are in /gmaster/home/strike/work/perl/deliver.

2. My audit script is in /gmaster/home/strike/.audit and has

    #! /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();


   at the very top of the file.

4. My .forward file has:

   " | /gmaster/home/strike/.audit strike"

5. I edited refileto and rfolder to say:

   unshift(@INC, "/gmaster/home/strike/work/perl/deliver");

   I could also have set DELIVERPATH ala

   setenv DELIVERPATH /gmaster/home/strike/work/perl/deliver

6. I did:

   chmod +x /gmaster/home/strike/.audit
@//E*O*F Installation//
chmod u=rw,g=,o= Installation
 
echo x - README
sed 's/^@//' > "README" <<'@//E*O*F README//'
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.
@//E*O*F README//
chmod u=rw,g=,o= README
 
echo x - Suggestions
sed 's/^@//' > "Suggestions" <<'@//E*O*F Suggestions//'
Date: Mon, 30 Mar 92 08:07:45 PST
@From: David Vezie <dv@cc-mac.nbn.com>

    That is, that the Received: lines might be useful.  For the person who
    wanted to avoid infinite loops, the problem could be solved by your
    package if you enabled the individual Received: lines to be parsed.
    He could, for example do:

	rcvdist("myself@siteB") if ( ! grep (/siteB/, @received));

    (If there is no Received: line for siteB, he would forward it to siteB,
    thus preventing infinite loops).  The mirror system would be on siteB for
    siteA.

    (Actually, I could do the same thing!  I have the same (or a similar)
    problem).

Completed: 3/31/92

@//E*O*F Suggestions//
chmod u=rw,g=r,o=r Suggestions
 
echo x - audit.pl
sed 's/^@//' > "audit.pl" <<'@//E*O*F audit.pl//'
#
#
# $Revision: 1.13 $
# $Date: 92/05/12 14:34:18 $
#
#

# =====
# Subroutine initialize
#	Set up the environment for the user and parse the incoming
#	mail message. 
#
sub initialize {
    local($passwd, $uid, $gid, $quota, $comment, $gcos);

    ($user, $passwd, $uid, $gid, $quota, $comment, $gcos, $home, $shell) = 
	getpwnam($ARGV[0]); shift @ARGV;

    $ENV{'USER'} = $user;
    $ENV{'HOME'} = $home;
    $ENV{'SHELL'} = $shell;
    $ENV{'TERM'} = "vt100";

    &parse_message(STDIN);
}


# =====
# Subroutine parse_message
#	Parse a message into headers, body and special variables
#
sub parse_message {
    local(*INFILE) = @_;

    $/ = '';		# read input in paragraph mode
    %headers = ( );
    @received = ( );
    undef($body);

    $header = <INFILE>;

    $* = 1;
    while (<INFILE>) { 
	s/^From />From /g;
	$body = "" if !defined($body);
	$body .= $_; 
    };
    $/ = "\n";		
    $* = 0;


    ;# -----
    ;# $sender comes from the UNIX-style From line (From strike...)
    ;#
    ($sender) = ($header =~ /^From\s+(\S+)/); 


    ;# -----
    ;# fill out the headers associative array with fields from the mail
    ;# header.
    ;#
    $_ = $header;
    s/\n\s+//g;
    @lines = split('\n');
    for ( @lines ) {
	/^([\w-]*):\s*(.*)/ && do {
	    $mheader = $1;
	    $mheader =~ tr/A-Z/a-z/;
	    if (($mheader eq "cc" || $mheader eq "to") && $headers{$mheader}) {
		$headers{$mheader} .= ", $2";
	    } elsif ($mheader eq "received") {
		push(@received, $2);
	    } else {
		$headers{$mheader} = $2;
	    };
	};
    }
    @received = reverse(@received);


    ;# -----
    ;# for convenience, $subject is $headers{'subject'} and $precedence is
    ;# $headers{'precedence'}
    ;#
    $subject = $headers{'subject'};
    $subject = "(No subject)" unless $subject;
    $subject =~ s/\s+$//;
    $precedence = $headers{'precedence'};


    ;# -----
    ;# create arrays for who was on the To, Cc lines
    ;#
    @cc = &expand($headers{'cc'});
    @to = &expand($headers{'to'}); 
    defined($headers{"apparently-to"}) && do {
	$apparentlyto = $headers{"apparently-to"};
	push(@to, &expand($apparentlyto));
    };

    ;# -----
    ;# $from comes from From: line. $address is their email address.
    ;# $organization is their site. for example, strike@pixel.convex.com 
    ;# yields an organization of convex.
    ;#
    $_ = $headers{'from'} ||
         $headers{'resent-from'} ||
         $headers{'sender'} ||
         $headers{'resent-sender'} ||
         $headers{'return-path'} ||
         $headers{'reply-to'};

    if ($_ eq "") {
       $friendly = $from = $address = $organization = "unknown";
       return;
    };

    ($friendly, $address, $from, $organization) = &parse_email_address($_);
}


# =====
# Subroutine parse_email_address
#	Parse an email address into address, from, organization
#	address is full Internet address, from is just the login
#	name and organization is Internet hostname (without final domain)
#
sub parse_email_address {
    local($_) = @_;
    local($friendly, $address, $from, $organization);

    $organization = "local";
    $friendly = "unknown";

# From: Disk Monitor Daemon (/usr/adm/bin/dfbitch) <daemon@hydra.convex.com>?

    s/^\s*//;
    s/\s*$//;
    if (/(.*)\s*<[^>]+>$|<[^>]+>\s*(.*)$/) {
	$friendly = $+;
	$friendly =~ s/\"//g;
    } elsif (/\(([^\)]+)\)/) {
	$friendly = $1;
    };

    s/.*<([^>]+)>.*/$1/;
    s/\(.*\)//;
    s/\s*$//;
    $address = $_;

    s/@.*//;
    s/%.*//;
    s/.*!//;
    s/\s//g;
    $from = $_;

    $_ = $address;
    tr/A-Z/a-z/;
    if (/!/ && /@/) {
        s/\s//g;
        s/!.*//;
        $organization = $_;
    } elsif (/!/) {
        s/\s//g;
        s/![A-Za-z0-9_@]*$//;
        s/.*!//;
        s/\..*//;
        $organization = $_;
    } elsif (/@/) {
        s/.*@//;
        s/\s//g;
        if (! /\./) {
            $organization = "unknown";
        } else {
            if (/\.(com|edu)$/) {
                s/\.[A-Za-z0-9_]*$//;
                s/.*\.//;
            } else {
                s/\.[A-Za-z0-9_]*$//;
                s/\.[A-Za-z0-9_]*$//;
                s/.*\.//;
            };
            $organization = $_;
        };
    };

    return ($friendly, $address, $from, $organization);
};


# ====
# Subroutine vacation
#	deliver a vacation message to the sender of this mail
#	message.
#
sub vacation {
    local($vacfile) = $ENV{'HOME'} . "/" . ".vacation.msg";
    local($msubject) = "\"Vacation mail for $ENV{'USER'} [Re: $subject]\" ";
    local($vacaudit, $astat, $mstat);
    local(@ignores);
    local(@names);

    return if (length($from) <= 0);
    return if ($precedence =~ /(bulk|junk)/i);
    return if ($from =~ /-REQUEST@/i);

    @ignores = ('daemon', 'postmaster', 'mailer-daemon', 'mailer', 'root',);
    grep(do {return if ($_ eq $from);}, @ignores);

    if (-e $vacfile) {
	($vacaudit = $vacfile) =~ s/\.msg/\.log/;

	$mstat = (stat($vacfile))[9];
	$astat = (stat($vacaudit))[9];
	unlink($vacaudit) if ($mstat > $astat);

        if (-f $vacaudit) {
	    open(VACAUDIT, "< $vacaudit") && do {
		while (<VACAUDIT>) {
		    chop; 
		    return if ($_ eq $from);
		};
		close(VACAUDIT);
	    };
        };

        open(MAIL,"| /usr/ucb/Mail -s $msubject $address") || return;
        open(VACFILE, "< $vacfile") || return;    
        while (<VACFILE>) {
	    s/\$SUBJECT/$subject/g;
            print MAIL $_;
        };
        close(VACFILE);
        close(MAIL);

        open(VACAUDIT, ">> $vacaudit") || return;
        print VACAUDIT "$from\n";
        close(VACAUDIT);
    };
}


# =====
# Subroutine expand
# 	expand a line (To, Cc, etc.) into a list of addressees.
#
sub expand {
    local($_) = @_;
    local(@fccs) = ( );

    return(@fccs) if /^$/;

    for (split(/\s*,\s*/)) {
	s/.*<([^>]+)>.*/$1/;
	s/@.*//;
	s/.*!//;
	s/\(.*\)//;
	s/\s//g;
	push(@fccs,$_) unless $seen{$_}++;
    } 

    return(@fccs);
} 


# =====
# Subroutine deliver
#	Deliver the incoming mail message to the user's mail drop
#
sub deliver {

    &deposit("/usr/spool/mail/$user");
}


# =====
#	Put the incoming mail into the specified mail drop (file)
#
sub deposit {
    local($drop) = @_;
    local($LOCK_EX) = 2;
    local($LOCK_UN) = 8;

    open(MAIL, ">> $drop") || die "open: $!\n";
    flock(MAIL, $LOCK_EX);
    seek(MAIL, 0, 2);

    print MAIL "$header";
    print MAIL "$body\n\n" if defined($body);

    flock(MAIL, $LOCK_UN);
    close(MAIL);
}


# =====
# Subroutine file_from
#	Add the mail message to another mail drop in a log directory.
#	The path of the mail drop is toplevel/organization/user
#
sub file_from {
    local($toplevel) = @_;
    local($dir);

    return if (length($from) <= 0);
    return if ($from eq $user);

    $toplevel = "log" if ($toplevel eq '');

    $dir = "$home/$toplevel";
    (!-d $dir) && mkdir($dir, 0700);
    $dir .= "/$organization";
    (!-d $dir) && mkdir($dir, 0700);

    &deposit("$dir/$from");
}


# =====
# Subroutine openpipe
#	Open a pipe to a command and write the mail message to it.
#
sub openpipe{
    local($command) = @_;

    open(CMD, "| $command") || die;
    print CMD "$header\n";
    print CMD "$body\n\n" if defined($body);
}

1;
@//E*O*F audit.pl//
chmod u=rw,g=r,o=r audit.pl
 
echo x - mh.pl
sed 's/^@//' > "mh.pl" <<'@//E*O*F mh.pl//'


# =====
# Subroutine mh_profile
#	Parse the user's .mh_profile and get arguments and settings
#
sub mh_profile {
    local($PROFILE);

    ($PROFILE = $ENV{"MH"}) || ($PROFILE = $ENV{"HOME"} . "/.mh_profile");

    open PROFILE || "$0: can't read mh_profile $PROFILE: $!\n";

    while (<PROFILE>) {
	next if /^#/;
	next unless ($key, $value) = /([^:\s]+):\s*(.+)/;
	$key =~ tr/A-Z/a-z/;
	$MH{$key} = $value;
    } 
    close PROFILE;

    $MH{'path'} = $ENV{'HOME'} . '/' . $MH{'path'};
} 


# =====
# Subroutine rcvstore
#	Convenience routine for MH users. Pipes incoming
#	mail message to rcvstore. Expects one argument - the 
#	name of the folder to rcvstore into.
#
sub rcvstore {
    local($folder) = @_;

    &openpipe("/usr/local/bin/mh/lib/rcvstore +$folder -create");
}


# =====
# Subroutine rcvdist
#	Convenience routine for MH users. Pipes incoming
#	mail message to rcvdist. Expects one argument - the 
#	list of users to distribute the mail message to
#
sub rcvdist {
    local($recips) = @_;

    &openpipe("/usr/local/bin/mh/lib/rcvdist $recips");
}


# =====
# Subroutine rcvtty
#	Convenience routine for MH users. Pipes incoming
#	mail message to rcvtty. This is MH's version of biff.
#
sub rcvtty {

    &openpipe("/usr/local/bin/mh/lib/rcvtty");
}


# =====
# Subroutine ali
#       Expand an MH alias into a list of names usable by
#       rcvdist
#
sub ali {
    local($alias) = @_;
    local($recips); 
    local(@list) = ();

    $recips = `/usr/local/bin/mh/ali $alias`;
    chop $recips;
    return(@list) if ($alias eq $recips);

    @list = split(/,/, $recips);
    return(@list);
}


# =====
# Subroutine refile_from
#	Refile a message into a folder by organization and 
#	sender name. The top-level folder is an argument
#	the user can specify.
#
sub refile_from {
    local($toplevel) = @_;

    return if (length($from) <= 0);
    return if ($from eq $user);

    $toplevel = "log" if ($toplevel eq '');
    &rcvstore("$toplevel/$organization/$from");
}

# =====
# Subroutine make_mhpath
#	Make a directory path recursively. 
#
sub make_mhpath {
    local($dir) = @_;
    local($i);
    local($mode) = 0755;

    $mode = oct($MH{'folder-protect'}) if (defined $MH{'folder-protect'});

    $_ = $dir;
    s#^/.*#/# || s#^[^/].*#.#;
    $start = $_;
    foreach $i (split('/', $dir)) {
	$start = $start . '/' . $i;
	next if (-d $start);
	mkdir($start, $mode) || return(1);
    };

    return(0);
} 


# =====
# Subroutine mh_parse
#	Parse the command line options
#
sub mh_parse {
    local(@argdesc) =  @SW;
    local($wantarg);

    while (($#ARGV >= 0) && ($ARGV[0] !~ /^-.+/)) { # must be a message list
	push(@MSGS, shift @ARGV);
    };

    grep(s/(\W)/\\$1/g, @argdesc);

    @ARGV = (split(' ', $MH{$program}), @ARGV) if defined($MH{$program});

    return if ($#ARGV < 0);

    while ($ARGV[0] =~ /^-.+/) {

        $ARGV = shift @ARGV;

        unless (@matches = grep(/$ARGV/, @argdesc)) {
            print "$program: unknown option: $ARGV\n";
            exit 1;
            &usage;
        } 

        for (@matches) { s/\\(\W)/$1/g; } 

        if ($#matches > $[) {
            print "$program: ambiguous switch $ARGV matches:\n";
            for (@matches) { 
                print "\    ", $_, "\n"; 
            }
            exit 1;
        } 

        ($switch,$wantarg) = $matches[$[] =~ /^-(\S+)\s*(\S*)/;

        $SW{$switch} = $wantarg ? shift @ARGV : 1;
        if ($SW{$switch} =~ /^(['"]).*$/ && $SW{$switch} !~ /^(['"]).*\1$/) {
            do {
                $SW{$switch} .= ' ' . (shift @ARGV);
            } until $#ARGV < 0 || $SW{$switch} =~ /^(['"]).*\1$/;
            $SW{$switch} =~ s/^(['"])(.*)\1$/$2/;
        } 
    }
}


# =====
# Subroutine print_switches
#	print the valid command line switches
#
sub print_switches {
    local(@argdesc) = @SW;

    print "   switches are:\n";
    for (sort @SW) {
	print "   $_\n";
    };
    print "\n";
}


1;
@//E*O*F mh.pl//
chmod u=rw,g=r,o=r mh.pl
 
echo x - refileto
sed 's/^@//' > "refileto" <<'@//E*O*F refileto//'
#!/usr/bin/perl

$program = $0;
$program =~ s|.*/||;
$| = 1;

unshift(@INC, $ENV{'DELIVERPATH'});
require 'audit.pl' || die "$program: cannot include audit.pl: $@";
require 'mh.pl' || die "$program: cannot include mh.pl: $@";

@@SW = (
	'-debug',
	'-draft',
        '-file file',
	'-help',
	'-link',
	'-log +folder',		# defaults to +log
	'-nolink',
	'-nopreserve',
	'-preserve',
  	'-rmmproc program',
	'-src +folder',		# defaults to current folder
	'-verbose',
      );


&mh_profile();
&mh_parse();


defined($SW{'help'}) && do {
    print "syntax: $program [msgs] [switches]\n";
    &print_switches();
    exit;
};


@@args = (defined(@MSGS) ? @MSGS : @ARGV);


$logdir = $SW{'log'} || $MH{'logdir'} || "+log";
($logdir = '+' . $logdir) if ($logdir !~ /\+/);
$folder = `mhpath cur`; chop $folder; $folder =~ s|/\d+$||;
$folder = $SW{'src'} if defined($SW{'src'});
($folder = '+' . $folder) if ($folder !~ /\+/);


$SW{'file'} = "$MH{'path'}/draft" if defined($SW{'draft'});
if (defined($SW{'file'})) {
    @paths = ($file);
} else {
    @paths = `mhpath $folder @args`; chop @paths;
};


@@refileargs = ( );
for ('link', 'nolink', 'preserve', 'nopreserve') {
    push(@refileargs, "-$_") if defined($SW{$_});
};
push(@refileargs, "-rmmproc", $SW{'rmmproc'}) if defined($SW{'rmmproc'});


foreach $msg (@paths) {
    open(MESSAGE, "< $msg") || next;

    &local_parse_message(MESSAGE);

    # -----
    # if -from was specified use the From line; if -to is specified use
    # the To line. 
    #
    $header = $headers{'from'} if ($program eq "refilefrom");
    $header = $headers{'to'} if ($program eq "refileto");
    $header = $header . ',' . $headers{'cc'} if 
	(($program eq "refileto") && defined($headers{'cc'}));

    @nfolders = ( ); 
    foreach $addr (split(',', $header)) {
       ($friendly, $address, $name, $org) = &parse_email_address($addr);
       $org = "local" if ($org eq "unknown");
       push(@nfolders, "$logdir/$org/$name");
    };

    @mfolders = ( );
    foreach $folder (@nfolders) {
       $fpath = `mhpath $folder`; chop $fpath;
       if (-d $fpath || ! &make_mhpath($fpath)) {
           push(@mfolders, $folder);
       } else {
	   warn "cannot make directory $fpath: $!\n";
       };
    };

    print "refile @refileargs -file $msg @mfolders\n" if 
	(@mfolders && defined($SW{'verbose'}));
    system "refile -file $msg @mfolders" if 
	(@mfolders && !defined($SW{'debug'}));

    close(MESSAGE);
};


# =====
# Subroutine local_parse_message
#	A simplified version of parse_message that does
#	not care about the body of the message
#
sub local_parse_message {
    local(*INFILE) = @_;
    local($header, $body, $mheader);

    $/ = '';		# read input in paragraph mode
    %headers = ( );
    @received = ( );

    $header = <INFILE>;
    $/ = "\n";		
    $* = 0;

    # -----
    # fill out the headers associative array with fields from the mail
    # header.
    #
    $_ = $header;
    s/\n\s+//g;
    @lines = split('\n');
    for ( @lines ) {
	/^(\w*):\s*(.*)/ && do {
	    $mheader = $1;
	    $mheader =~ tr/A-Z/a-z/;
	    if (($mheader eq "cc" || $mheader eq "to") && $headers{$mheader}) {
		$headers{$mheader} .= ", $2";
	    } else {
		$headers{$mheader} = $2;
	    };
	};
    }

    return;
}
@//E*O*F refileto//
chmod u=rwx,g=,o= refileto
 
echo x - rfolder
sed 's/^@//' > "rfolder" <<'@//E*O*F rfolder//'
#!/usr/bin/perl

$program = $0;
$program =~ s|.*/||;
$| = 1;

unshift(@INC, $ENV{'DELIVERPATH'});
require 'audit.pl' || die "$program: cannot include audit.pl: $@";
require 'mh.pl' || die "$program: cannot include mh.pl: $@";


@@SW = (
	'-exec',
	'-except "+folder..."',
	'-all',
	'-verbose',
	'-clean',
	'-debug',
	'-recurse',
	'-norecurse',
	'-help',
      );


&mh_profile();

($folder = shift @ARGV) if ($ARGV[0] =~ /^\+/);

&mh_parse();

defined($SW{'help'}) && do {
    print "syntax: $program [+folder] [switches] [-exec MH command]\n";
    &print_switches();
    exit;
};


#if (!defined($folder)) {
#    $mailpath = $MH{'path'} . '/';
#    $folder = `mhpath`; chop $folder; 
#    $folder =~ s|^$mailpath|\+|;
#};


@@args = (($program =~ /s$/) ? ("-all") : ( )); 
for ('all', 'recurse', 'norecurse') {
    push(@args, "-$_") if defined($SW{$_});
};


if (defined($SW{'exec'})) {
    @command = @ARGV;
} else {
    exec "folder $folder @args";
};


$path = `mhpath $folder`; chop $path;
die "$0: unable to change directory to $path: No such file or directory.\n" 
    if (! -d $path);


open(FOLDERS, "folder $folder @args -fast -noheader |") || die 
	"$0: cannot find list of folders: $?";

@@exceptions = split(' ', $SW{'except'});

SKIP:
while (<FOLDERS>) {
    chop; 
    for $ef (@exceptions) {
	($f = $ef) =~ s/^\+//;
	next SKIP if ($_ =~ m|$f|);
	$f = `mhpath +$f`; chop $f;
	next SKIP if ($_ eq $f);
    };

    if (defined($SW{'clean'})) {
	$contents = `folder +$_ -total`; 
	if ($contents =~ /\s+0\s+messages/) {
	    print "removing empty folder +$_...\n" if defined($SW{'verbose'});
	    $f = `mhpath +$_`; chop $f;
	    rmdir($f) unless defined($SW{'debug'});
	    next; 
	};
    };

    print "@command +$_ \n" if defined($SW{'verbose'});
    system "@command +$_" unless (defined($SW{'debug'})); 
    print "\n";
};

close(FOLDERS);

@//E*O*F rfolder//
chmod u=rwx,g=,o= rfolder
 
echo Inspecting for damage in transit...
temp=/tmp/shar$$; dtemp=/tmp/.shar$$
trap "rm -f $temp $dtemp; exit" 0 1 2 3 15
cat > $temp <<\!!!
       6      34     237 Bug_fixes
     132     538    3600 CHANGES
      71     275    1896 Installation
     345    1791   11654 README
      19     103     659 Suggestions
     331     882    7162 audit.pl
     188     530    3927 mh.pl
     140     422    3242 refileto
      94     247    1855 rfolder
    1326    4822   34232 total
!!!
wc  Bug_fixes CHANGES Installation README Suggestions audit.pl mh.pl refileto rfolder | sed 's=[^ ]*/==' | diff -b $temp - >$dtemp
if [ -s $dtemp ]
then echo "Ouch [diff of wc output]:" ; cat $dtemp
else echo "No problems found."
fi
echo "Making links..."
ln -s rfolder rfolders
ln -s refile refilefrom
exit 0


---Begin attached file gnusmail.pl---


# require 'sys/file.ph';
# i've grabbed the lines i want out of the file... this keeps me from
# including tons of garbage
eval 'sub LOCK_SH {1;}';
eval 'sub LOCK_EX {2;}';
eval 'sub LOCK_NB {4;}';
eval 'sub LOCK_UN {8;}';


sub gnusmail {
  local($group) = @_;

  # dir will contain the path, defaults to ~/Mail
  local($dir) = "Mail";
  # if NNTPSERVER looks like :directory use that
  $dir = $1 if ($ENV{"NNTPSERVER"} =~ /^:(\S*)/);
  $dir = $ENV{"HOME"} . "/" . $dir . "/" . $group;

  # if the directory doesn't exist and we can't make it deliver the usual way
  if (! -d $dir) {
    system("mkdir -p $dir; echo 0 >$dir/.last")	&& &gnuserror();
  }

  # open .last and use it as a lock file, get the next number out
  open(LAST, "+< $dir/.last") || &gnuserror();
  flock(LAST, &LOCK_EX);
  $file = <LAST> + 1;

  # create the new file and write the current message out
  open(MAIL, "> $dir/$file") || &gnuserror();
  print MAIL "$header";
  print MAIL "$body" if defined($body);
  close(MAIL);

  # write the new last value into .last
  seek(LAST, 0, 0);
  print LAST "$file\n";
  flock(LAST, &LOCK_UN);
  close(LAST);

  return 0;
}

sub gnuserror {
  &deliver();
  exit;
}

1;

---End attached file gnusmail.pl---

and lastly my mail filter for grins:

---Begin attached file filter---

#! /usr/local/bin/perl --		# -*-Perl-*-

require 'audit.pl'
  || die "deliver: cannot include audit.pl: $@";

require 'gnusmail.pl'
  || die "deliver: cannot include gnusmail.pl: $@";

&initialize();


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

# lowercase all addresses in-place
foreach (@to) {
  tr/A-Z/a-z/;
}
foreach (@cc) {
  tr/A-Z/a-z/;
}

# if this message is from one of the mailing lists put into
# appropriate list directory
@lists = ("grapevine",
	  "tech-forum",
	  "syseng",
	  "inet-admin");
$lists = join("|", @lists);
($which = (grep(/$lists/, @to, @cc))[$[]) && do {
  $which =~ /($lists)/;
  &gnusmail("lists/$1");
  exit;
};

# other parsing, mostly on who it's from
#
($from =~ /^Mailer/i) && do {
  &gnusmail("mail/daemon");
  exit;
};

%from = ("tadpole|tadusa", "mail/tadpole",
	 "70562.662@CompuServe.COM", "mail/dirtbag",
	 );
while (($key, $value) = each(%from)) {
  if ($address =~ /$key/i) {
    &gnusmail($value);
    &vacation();
    exit;
  }
}

($from =~ /infodist/i) && do {
  if ($subject =~ /press/i) {
    &gnusmail("lists/infodist/press");
  }
  else {
    &gnusmail("list/infodist");
  }
  exit;
};

# If I am specifically named on the To or Cc line, do the default.
#
(grep(/^(jkt|jack_thomasson)/, @to, @cc)) && do { 
  &gnusmail("mail");
  &vacation();
  exit;
};

# this mail was not sent to me directly, so dont answer with vacation mail,
#
&gnusmail("mail/junk");

# All done!
#
exit;

---End attached file filter---
--
---------------------------------------------------------------------
Jack Thomasson                   :{)}               (the bearded one)
Internet:Jack_Thomasson@SED.Provo.Novell.COM           MHS:JKT@NOVELL
Novell, Inc. /  MS E-23-2 /  122 East 1700 South /   Provo, UT  84606
Phone: (800)453-1267x7604 | (801)429-7604          FAX: (801)429-5511
"WARNING: the comments do not necessarily reflect the implementation"
Xref: sparky comp.emacs:3030 gnu.emacs.sources:651 gnu.misc.discuss:2914