From: chip@tct.uucp (Chip Salzenberg) Newsgroups: comp.mail.misc,alt.sources Subject: Automatic E-Mail archival Message-ID: <264F099A.6FDF@tct.uucp> Date: 14 May 90 19:40:09 GMT 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 '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©MSG; 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©MSG; 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 (
) { 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 () { 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 ,