🚀 go-pugleaf

According to les@chinet.chi.il.us (Leslie Mikesell):
>The idea here is to archive a single copy of each message coming into
>(or originating at) a group of machines, even if the destination is
>multiple addresses or a mailing list.  Then at delivery (which may be
>on another machine) I want a log entry that will allow me to find the
>archive copy.

It still sounds like a Deliver special.  Below is a sample post-user
delivery file that will archive, and add an "X-Archived:" header to,
messages that are from or to a given set of sites.  It will also log
all messages delivered that already have an "X-Archived:" header.

Further elaboration may be desirable.  For example, checking for the
sender's host is mentioned; that's easily glommed on by checking
$SENDER after checking all the destinations.

Note that the archive file, as well as the archive log file, are
written as mailboxes, by spawning child Delivers with "-b".  I do it
that way because Deliver automatically locks mailboxes before writing
to them, which is nice for logs.

(Please indulge my choice of Perl as the language of choice for
post-user delivery files.  I'm a bit tired of spawning a dozen
processes for each message, and worrying about shell metacharacters
and null arguments and the correct number of backslashes.)

Install this file as a post-user delivery file with Deliver 2.0 and
Perl 3.  Presto: mail archiving with a log.  Hey, the price is right.

#! /bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#		"End of shell archive."
# Contents:  del-archive
# Wrapped by chip@tct on Mon May 14 15:35:49 1990
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'del-archive' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'del-archive'\"
else
echo shar: Extracting \"'del-archive'\" \(2283 characters\)
sed "s/^X//" >'del-archive' <<'END_OF_FILE'
X#!/bin/perl
X# Archive mail and log archived messages.
X
X## CONFIGURATION: Target sites that require archiving.
X
X@ARCHSITES = ("sitea", "siteb", "uunet");   ## a joke, son
X
X## CONFIGURATION: Where will I archive mail if required?
X
X$ARCHFILE = "/usr/tmp/mail-$$";		## you need to fix this
X
X## Collect important environment variables.
X
X$SENDER   = $ENV{'SENDER'};
X$HEADER   = $ENV{'HEADER'};
X$BODY     = $ENV{'BODY'};
X$HOSTNAME = $ENV{'HOSTNAME'};
X
X## Collect important header fields.
X
X$H_From       = `header -nf From       $HEADER`;
X$H_To         = `header -nf To         $HEADER`;
X$H_Subject    = `header -nf Subject    $HEADER`;
X$H_X_Archived = `header -nf X-Archived $HEADER`;
X
X## Check to see if archiving is required.
X
X$archive = 0;
Xforeach (@ARGV) {
X	@B = split(/!/);
X	next unless @B > 1;
X	$dest = $B[$#B - 1];
X	++$archive if grep($_ eq $dest, @ARCHSITES);
X}
X
X## If this message is already archived elsewhere,
X## or if we're about to archive it, log it.
X
Xif ($archive || $H_X_Archived) {
X    &DEL("-r", $SENDER, "-b", "/usr/adm/del-arch.log");
X    print DEL $H_From, $H_To, $H_Subject, $H_X_Archived;
X    print DEL "\n";
X    print DEL "Archived locally as $ARCHFILE" if $archive;
X    close(DEL);
X}
X
X## If no archiving requested, deliver normally.
X
Xunless ($archive) {
X	foreach (@ARGV) {
X		print $_, "\n";
X	}
X	exit;
X}
X
X## Send the message with an X-Archived header line added.
X## Note the "-n" flag -- don't execute this recursively!
X
X&DEL("-n", @ARGV);
X&COPYMSG;
Xclose(DEL);
X
X## Have Deliver write the archive copy like a mailbox.
X## Do this last, in case the script aborts early.
X
X&DEL("-b", $ARCHFILE);
X&COPYMSG;
Xclose(DEL);
X
X## We are outahere!
X
Xexit;
X
X## Subroutine to spawn a child Deliver process.
X
Xsub DEL {
X	local($pid);
X	$pid = open(DEL, "|-");
X	warn "Can't open child deliver: $!" unless defined($pid);
X	exec "deliver", @_ if defined($pid) && $pid == 0;
X}
X
X## Subroutine to send a copy of the message to a child Deliver.
X## The copy includes an X-Archived header.
X
Xsub COPYMSG {
X	open(HEADER) || warn "Can't open $HEADER: $!";
X	while (<HEADER>) {
X		print DEL $_ unless /^$/;
X	}
X	close(HEADER);
X
X	print DEL "X-Archived: host $HOSTNAME, file $ARCHFILE\n";
X	print DEL "\n";
X
X	open(BODY) || warn "Can't open $BODY: $!";
X	while (<BODY>) {
X		print DEL $_;
X	}
X	close(BODY);
X}
END_OF_FILE
if test 2283 -ne `wc -c <'del-archive'`; then
    echo shar: \"'del-archive'\" unpacked with wrong size!
fi
# end of 'del-archive'
fi
echo shar: End of shell archive.
exit 0
-- 
Chip Salzenberg at ComDev/TCT   <chip%tct@ateng.com>, <uunet!ateng!tct!chip>