Source Code 1994 March/Source_Code_CD-ROM_Walnut_Creek_March_1994.iso/compsrcs/misc/volume41/mailagnt/part16

Text File | 1993-12-03 | 54.8 KB | 1,586 lines

Newsgroups: comp.sources.misc
From: Raphael Manfredi <[e-mail]>
Subject: v41i016:  mailagent - Flexible mail filtering and processing package, v3.0, Part16/26
Message-ID: <[e-mail]>
X-Md4-Signature: 70f1f5b8185230e1ae8fd6cf2430e6c8
Sender: [e-mail] (Kent Landfield)
Organization: Advanced Computer Research Institute, Lyon, France.
Date: Fri, 3 Dec 1993 21:32:49 GMT
Approved: [e-mail]

Submitted-by: Raphael Manfredi <[e-mail]>
Posting-number: Volume 41, Issue 16
Archive-name: mailagent/part16
Environment: UNIX, Perl
Supersedes: mailagent: Volume 33, Issue 93-109

#! /bin/sh
# This is a shell archive.  Remove anything before this line, then feed it
# into a shell via "sh file" or similar.  To overwrite existing files,
# type "sh file -c".
# The tool that generated this appeared in the comp.sources.unix newsgroup;
# send mail to [e-mail] if you want that tool.
# Contents:  agent/Makefile.SH agent/files/filter.sh
#   agent/pl/compress.pl agent/pl/hook.pl agent/pl/macros.pl
#   agent/pl/parse.pl agent/test/cmd/split.t misc/shell/server.cf
# Wrapped by ram@soft208 on Mon Nov 29 16:49:57 1993
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
echo If this archive is complete, you will see the following message:
echo '          "shar: End of archive 16 (of 26)."'
if test -f 'agent/Makefile.SH' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'agent/Makefile.SH'\"
else
  echo shar: Extracting \"'agent/Makefile.SH'\" \(6989 characters\)
  sed "s/^X//" >'agent/Makefile.SH' <<'END_OF_FILE'
X: Makefile.SH generated from Jmake.tmpl and Jmakefile [jmake 3.0 PL14]
X: $X-Id: Jmake.tmpl,v 3.0.1.1 1993/08/20 07:36:36 ram Exp ram $
X
Xcase $CONFIG in
X'')
X    if test -f config.sh; then TOP=.;
X    elif test -f ../config.sh; then TOP=..;
X    elif test -f ../../config.sh; then TOP=../..;
X    elif test -f ../../../config.sh; then TOP=../../..;
X    elif test -f ../../../../config.sh; then TOP=../../../..;
X    else
X        echo "Can't find config.sh."; exit 1
X    fi
X    . $TOP/config.sh
X    ;;
Xesac
Xcase "$0" in
X*/*) cd `expr X$0 : 'X\(.*\)/'` ;;
Xesac
XCURRENT=agent
XDIR=`echo $CURRENT/ | sed -e 's/\.\///g'`
Xecho "Extracting ${DIR}Makefile (with variable substitutions)"
XDATE=`date`
X$spitshell >Makefile <<!GROK!THIS!
X########################################################################
X# Makefile generated from Makefile.SH on $DATE
X
XSHELL = /bin/sh
XJMAKE = jmake
XTOP = ..
XCURRENT = $CURRENT
XDIR = $DIR
XINSTALL = ../install
X
X########################################################################
X# Parameters set by Configure -- edit config.sh if changes are needed
X
XBINDIR = $installbin
XCTAGS = ctags
XL = $manext
XMANSRC = $installmansrc
XMAKE = make
XMKDEP = $mkdep \$(DPFLAGS) --
XMV = $mv
XRM = $rm -f
XSCRIPTDIR = $installscript
XSED = $sed
X
X########################################################################
X# Automatically generated parameters -- do not edit
X
XSUBDIRS = files filter man test
XSCRIPTS =  \$(BIN)
X
X!GROK!THIS!
X$spitshell >>Makefile <<'!NO!SUBS!'
X########################################################################
X# Jmake rules for building libraries, programs, scripts, and data files
X# $X-Id: Jmake.rules,v 3.0 1993/08/18 12:04:14 ram Exp ram $
X
X########################################################################
X# Force 'make depend' to be performed first -- do not edit
X
X.FORCE_DEPEND::
X
Xall:: .FORCE_DEPEND
X
X########################################################################
X# Start of Jmakefile
X
X# $X-Id: Jmakefile,v 2.9.1.2 92/08/26 12:33:22 ram Exp $
X#
X#  Copyright (c) 1990-1993, Raphael Manfredi
X#
X#  You may redistribute only under the terms of the Artistic License,
X#  as specified in the README file that comes with the distribution.
X#  You may reuse parts of this distribution only within the terms of
X#  that same Artistic License; a copy of which may be found at the root
X#  of the source tree for mailagent 3.0.
X#
X# $X-Log$
X
XBIN = mailpatch mailhelp maillist maildist package
X
Xall:: $(BIN)
X
Xlocal_realclean::
X    $(RM) $(BIN)
X
Xmailpatch: mailpatch.SH
X    /bin/sh mailpatch.SH
X
Xmailhelp: mailhelp.SH
X    /bin/sh mailhelp.SH
X
Xmaillist: maillist.SH
X    /bin/sh maillist.SH
X
Xmaildist: maildist.SH
X    /bin/sh maildist.SH
X
Xpackage: package.SH
X    /bin/sh package.SH
X
X
Xinstall:: $(SCRIPTS) $(LSCRIPTS)
X    @for file in $(SCRIPTS) $(LSCRIPTS); do \
X        case '${MFLAGS}' in *[i]*) set +e;; esac; \
X        (set -x; $(INSTALL) -c -m 555 $$file $(SCRIPTDIR)); \
X    done
X
Xdeinstall::
X    @for file in $(SCRIPTS) $(LSCRIPTS); do \
X        case '${MFLAGS}' in *[i]*) set +e;; esac; \
X        (set -x; $(RM) $(SCRIPTDIR)/$$file); \
X    done
X
X
Xall:: magent
X
Xlocal_realclean::
X    $(RM) magent
X
Xmagent: magent.SH
X    /bin/sh magent.SH
X
X
Xall:: mailagent
X
Xlocal_realclean::
X    $(RM) mailagent
Xmailagent: magent
X    perl $(TOP)/bin/perload -o magent > $@
X    chmod +rx $@
X
Xinstall:: mailagent
X    $(INSTALL) -c -m 555  mailagent $(BINDIR)
X
Xdeinstall::
X    $(RM) $(BINDIR)/mailagent
X
Xdepend::
X    @case '${MFLAGS}' in *[ik]*) set +e;; esac; \
X    for i in filter ;\
X    do \
X        (cd $$i ; echo "Depending" "in $(DIR)$$i..."; \
X            $(MAKE) $(MFLAGS)  depend); \
X    done
X
XBINSH = \
X    mailpatch.SH \
X    mailhelp.SH \
X    maillist.SH \
X    maildist.SH \
X    package.SH \
X    magent.SH
X
Xdepend::
X    ($(SED) '/^# DO NOT DELETE/q' Makefile && \
X    grep '^\$$grep' $(BINSH) | \
X    $(SED) -e "s/^.*' \([^ ]*\) >>\(.*\)/\2: \1/" \
X    ) > Makefile.new
X    cp Makefile Makefile.bak
X    cp Makefile.new Makefile
X    $(RM) Makefile.new
X
X########################################################################
X# Common rules for all Makefiles -- do not edit
X
Xemptyrule::
X
Xclean: sub_clean local_clean
Xrealclean: sub_realclean local_realclean
Xclobber: sub_clobber local_clobber
X
Xlocal_clean::
X    $(RM) core *~ *.o
X
Xlocal_realclean:: local_clean
X
Xlocal_clobber:: local_realclean
X    $(RM) Makefile config.sh
X
XMakefile.SH: Jmakefile
X    -@if test -f $(TOP)/.package; then \
X        if test -f Makefile.SH; then \
X            echo "    $(RM) Makefile.SH~; $(MV) Makefile.SH Makefile.SH~"; \
X            $(RM) Makefile.SH~; $(MV) Makefile.SH Makefile.SH~; \
X        fi; \
X        echo "    $(JMAKE) -DTOPDIR=$(TOP) -DCURDIR=$(CURRENT)" ; \
X        $(JMAKE) -DTOPDIR=$(TOP) -DCURDIR=$(CURRENT) ; \
X    else touch $@; exit 0; fi
X
XMakefile: Makefile.SH
X    /bin/sh Makefile.SH
X
Xtags::
X    $(CTAGS) -w *.[ch]
X    $(CTAGS) -xw *.[ch] > tags
X
Xlocal_clobber::
X    $(RM) tags
X
X########################################################################
X# Rules for building in sub-directories -- do not edit
X
Xsubdirs:
X    @case '${MFLAGS}' in *[ik]*) set +e;; esac; \
X    for i in $(SUBDIRS) ;\
X    do \
X        (cd $$i ; echo $(VERB) "in $(DIR)$$i..."; \
X            $(MAKE) $(MFLAGS) $(FLAGS) $(TARGET)); \
X    done
X
Xinstall::
X    @$(MAKE) subdirs TARGET=install VERB="Installing" FLAGS=
X
Xdeinstall::
X    @$(MAKE) subdirs TARGET=deinstall VERB="Deinstalling" FLAGS=
X
Xinstall.man::
X    @$(MAKE) subdirs TARGET=install.man VERB="Installing man pages" FLAGS=
X
Xdeinstall.man::
X    @$(MAKE) subdirs TARGET=deinstall.man VERB="Deinstalling man pages" FLAGS=
X
Xsub_clean::
X    @$(MAKE) subdirs TARGET=clean VERB="Cleaning" FLAGS=
X    @echo "Back to $(CURRENT) for "clean...
X
Xsub_realclean::
X    @$(MAKE) subdirs TARGET=realclean VERB="Real cleaning" FLAGS=
X    @echo "Back to $(CURRENT) for "realclean...
X
Xsub_clobber::
X    @$(MAKE) subdirs TARGET=clobber VERB="Clobbering" FLAGS=
X    @echo "Back to $(CURRENT) for "clobber...
X
Xtag::
X    @case '${MFLAGS}' in *[ik]*) set +e;; esac; \
X    for i in $(SUBDIRS) ;\
X    do \
X        (cd $$i ; echo "Tagging" "in $(DIR)$$i..."; \
X            $(MAKE) $(MFLAGS)  tag); \
X    done
X
XMakefiles::
X    @case '${MFLAGS}' in *[ik]*) set +e;; esac; \
X    for i in $(SUBDIRS);\
X    do \
X        echo "Making "Makefiles" in $(DIR)$$i..."; \
X        (cd $$i || exit 1; \
X        if test ! -f Makefile; then /bin/sh Makefile.SH; fi; \
X        $(MAKE) $(MFLAGS) Makefiles) \
X    done
X
XMakefiles.SH:: Makefile.SH
X    @case '${MFLAGS}' in *[ik]*) set +e;; esac; \
X    for i in $(SUBDIRS);\
X    do \
X        case "$(DIR)$$i/" in \
X        */*/*/*/) newtop=../../../..;; \
X        */*/*/) newtop=../../..;; \
X        */*/) newtop=../..;; \
X        */) newtop=..;; \
X        esac; \
X        case "$(TOP)" in \
X        /*) newtop="$(TOP)" ;; \
X        esac; \
X        echo "Making Makefiles.SH in $(DIR)$$i..."; \
X        (cd $$i || exit 1; $(MAKE) $(MFLAGS) -f ../Makefile \
X        Makefile TOP=$$newtop CURRENT=$(DIR)$$i;\
X        $(MAKE) $(MFLAGS) Makefiles.SH) \
X    done
X
Xall::
X    @$(MAKE) subdirs TARGET=all VERB="Making all" FLAGS=
X
X########################################################################
X# Dependencies generated by make depend
X# DO NOT DELETE THIS LINE -- make depend relies on it
X
X# Put nothing here or make depend will gobble it up
X.FORCE_DEPEND::
X    @echo "You must run 'make depend' in $(TOP) first."; exit 1
X!NO!SUBS!
Xchmod 644 Makefile
X$eunicefix Makefile
X
END_OF_FILE
  if test 6989 -ne `wc -c <'agent/Makefile.SH'`; then
    echo shar: \"'agent/Makefile.SH'\" unpacked with wrong size!
  fi
  chmod +x 'agent/Makefile.SH'
  # end of 'agent/Makefile.SH'
fi
if test -f 'agent/files/filter.sh' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'agent/files/filter.sh'\"
else
  echo shar: Extracting \"'agent/files/filter.sh'\" \(7691 characters\)
  sed "s/^X//" >'agent/files/filter.sh' <<'END_OF_FILE'
X#!/bin/sh
X
X# $Id: filter.sh,v 3.0 1993/11/29 13:47:51 ram Exp ram $
X#
X#  Copyright (c) 1990-1993, Raphael Manfredi
X#
X#  You may redistribute only under the terms of the Artistic License,
X#  as specified in the README file that comes with the distribution.
X#  You may reuse parts of this distribution only within the terms of
X#  that same Artistic License; a copy of which may be found at the root
X#  of the source tree for mailagent 3.0.
X#
X# $Log: filter.sh,v $
X# Revision 3.0  1993/11/29  13:47:51  ram
X# Baseline for mailagent 3.0 netwide release.
X#
X
X# You'll have to delete comments by yourself if your shell doesn't grok them
X
X# You should install a .forward in your home directory to activate the
X# process (sendmail must be used as a MTA). Mine looks like this:
X#    "|exec /users/ram/mail/filter >>/users/ram/.bak 2>&1"
X
X# Variable HOME *must* correctly be set to your home directory
XHOME=/york/ram
Xexport HOME
X
X# The PATH variable must also correctly be set. This variable will be
X# used by all the mailagent-related programs. If you have chosen to put
X# the mailagent scripts in a dedicated directory (e.g. $HOME/mailagent),
X# be sure to put that directory in the PATH variable.
X# The mailagent scripts could also have been stored in a directory like
X# /usr/local/scripts by your system administrator, because each user does
X# not need to have a private copy of theese scrips.
XPATH="/bin:/usr/bin:/usr/ucb:$HOME/bin/mailagent:$HOME/bin"
X
X# The following will set the right path for some architecture-specific
X# directories. For instance, if you have your home directory viewed on
X# some different machines (e.g. it is NFS-mounted), then you must be
X# sure the mailagent will be invoked with the right executables.
XHOST=`(uname -n || hostname) 2>/dev/null`
Xcase "$HOST" in
Xyork) PATH="$HOME/bin/rs2030:$PATH" ;;
Xeiffel) PATH="/base/common/sun4/bin:$PATH" ;;
X*) ;;
Xesac
Xexport PATH
X
X# The TZ may not correctly be set when sendmail is invoking the filter, hence
X# funny date could appear in the log message (from GMT zone usually).
XTZ='PST8PDT'
Xexport TZ
X
X# You should not have to edit below this line
X
X# This variable, when eval'ed, adds a log message at the end of the log file
X# if any. Assumes the ~/.mailagent file was successfully parsed.
Xaddlog='umask 077; if test -f $logdir/$log;
Xthen /bin/echo "`date \"+%y/%m/%d %H:%M:%S\"` filter[$$]: $1" >> $logdir/$log;
Xelse echo "`date \"+%y/%m/%d %H:%M:%S\"` filter[$$]: $1";
Xfi; umask 277
X'
X
X# This variable, when eval'ed, dumps the message on stdout. For this
X# reason, error messages should be redirected into a file.
Xemergency='echo "*** Could not process the following ($1) ***";
Xcat $temp;
Xecho "----------- `date` -----------";
Xset "FATAL $1";
Xeval $addlog;
Xrm -f $spool/filter.lock $torm
X'
X
X# This is for safety reasons (mailagent may abort suddenly). Save the
X# whole mail in a temporary file, which has very restrictive permissions
X# (prevents unwanted removal). This will be eventually moved to the
X# mailagent's queue if we can locate it.
Xumask 277
Xtemp=/tmp/Fml$$
Xtorm="$temp"
X
X# The magic number '74' is EX_IOERR as understood by sendmail and means that
X# an I/O error occurred. The mail is left in sendmail's queue. I expect "cat"
X# to give a meaningful exit code.
Xcat > $temp || exit 74
X
X# The following is done in a subshell put in background, so that this
X# process can exit with a zero status immediately, which will make
X# sendmail think that the delivery was successful. Hopefully we can
X# do our own error recovery now.
X
X(
X# Script used to save the processed mail in an emergency situation
Xsaver='umask 077; if (cat $temp; echo ""; echo "") >> $HOME/mbox.filter; then
X    set "DUMPED in ~/mbox.filter"; eval $addlog; rm -f $torm; else
X    set "unable to dump in ~/mbox.filter"; eval $emergency;
Xfi'
X
X# Set a trap in case of interruption. Mail will be dumped in ~/mbox.filter
Xtrap 'eval $saver; exit 0' 1 2 3 15
X
X# Look for the ~/.mailagent file, exit if none found
Xif test ! -f $HOME/.mailagent; then
X    set 'FATAL no ~/.mailagent'
X    eval $addlog
X    eval $saver
X    exit 0
Xfi
X
X# Parse ~/.mailagent to get the queue location
Xset X `<$HOME/.mailagent sed -n \
X    -e '/^[     ]*#/d' \
X    -e 's/[     ]*#/#/' \
X    -e 's/^[     ]*\([^     :\/]*\)[     ]*:[     ]*\([^#]*\).*/\1="\2";/p'`
Xshift
X
X# Deal with possible white spaces in variables
Xcmd=''
Xfor line in $*; do
X    cmd="$cmd$line"
Xdone
Xcmd=`echo $cmd | sed -e "s|~|$HOME|g"`
Xeval $cmd
X
X# It would be too hazardous to continue without a valid queue directory
Xif test ! -d "$queue"; then
X    set 'FATAL no valid queue directory'
X    eval $addlog
X    eval $saver
X    exit 0
Xfi
X
X# If there is already a filter.lock file, then we set busy to true. Otherwise,
X# we create the lock file. Note that this scheme is a little lousy (race
X# conditions may occur), but that's not really important because the mailagent
X# will do its own tests with the perl.lock file.The motivation here is to avoid
X# a myriad of filter+perl processes spawned when a lot of mail is delivered
X# via SMTP (for instance after a uucp connection).
Xbusy=''
Xif test -f $spool/filter.lock; then
X    busy='true'
Xelse
X    # Race condition may (and will) occur, but the permissions are kept by 'cp',
X    # so the following will not raise any error message.
X    cp /dev/null $spool/filter.lock >/dev/null 2>&1 || busy='true'
Xfi
X
X# Copy tmp file to the queue directory and call the mailagent. If the file
X# already exists (very unlikely, but...), we append a 'b' for bis.
Xqtemp=$queue/qm$$
Xtqtemp=$queue/Tqm$$
Xif test -f $qtemp; then
X    qtemp=$queue/qmb$$
X    tqtemp=$queue/Tqmb$$
Xfi
X
X# Do not write in a 'qm' file directly, or the mailagent might start
X# its processing on an incomplete file.
Xif cp $temp $tqtemp; then
X    mv $tqtemp $qtemp
X    if test x = "x$busy"; then
X        sleep 60
X        if perl -S mailagent $qtemp; then
X            rm -f $temp $qtemp $spool/filter.lock
X            exit 0
X        fi
X    fi
Xelse
X    set 'ERROR unable to queue mail before processing'
X    eval $addlog
X    if test x = "x$busy"; then
X        sleep 60
X        if perl -S mailagent $temp; then
X            rm -f $temp $spool/filter.lock
X            exit 0
X        fi
X    fi
Xfi
X
X# We come here only if the mailagent failed its processing. The unprocessed
X# mail either left in the queue or is given a meaningful name.
Xif cmp $temp $qtemp >/dev/null 2>&1; then
X    base=`echo $qtemp | sed -e 's/.*\/\(.*\)/\1/'`
X    if test x = "x$busy"; then
X        set "ERROR mailagent failed, [$base] left in queue"
X        rm -f $spool/filter.lock
X    else
X        # Make file a fm* one, so that it will get processed immediately by
X        # the main mailagent when it is ready to deal with the queue.
X        fmbase=`echo $base | sed -e 's/qm/fmx/'`
X        if mv $queue/$base $queue/$fmbase; then
X            set "NOTICE filter busy, [$fmbase] left in queue"
X        else
X            set "NOTICE filter busy, [$base] left in queue"
X        fi
X    fi
X    eval $addlog
X    rm -f $temp
X    exit 0
Xfi
X
X# Change the name of the temporary file.
Xuser=`(logname || whoami) 2>/dev/null`
Xtmpdir=`echo $temp | sed -e 's/\(.*\)\/.*/\1/'`
Xmv $temp $tmpdir/$user.$$
Xtemp="$tmpdir/$user.$$"
Xif test x = "x$busy"; then
X    set "ERROR mailagent failed, mail left in $temp"
X    rm -f $spool/filter.lock
Xelse
X    set "WARNING filter busy, mail left in $temp"
Xfi
Xeval $addlog
X
X# Give the mailagent a clue as to where the mail has been stored. As this
X# should be very very unlikely, no test is done to see whether a mailagent
X# is already updating the agent.wait file. The worse that could result from
X# this shallowness would be having an unprocessed mail.
Xumask 077
Xset 'WARNING mailagent ignores where mail was left'
Xif /bin/echo "$temp" >> $queue/agent.wait; then
X    if grep "$temp" $queue/agent.wait >/dev/null 2>&1; then
X        set "NOTICE $temp memorized into agent.wait"
X    fi
Xfi
Xeval $addlog
Xrm -f $qtemp
X
X# Attempt an emergency saving
Xeval $saver
Xexit 0
X) &
X
X# Delivery was ok -- for sendmail
Xexit 0
END_OF_FILE
  if test 7691 -ne `wc -c <'agent/files/filter.sh'`; then
    echo shar: \"'agent/files/filter.sh'\" unpacked with wrong size!
  fi
  chmod +x 'agent/files/filter.sh'
  # end of 'agent/files/filter.sh'
fi
if test -f 'agent/pl/compress.pl' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'agent/pl/compress.pl'\"
else
  echo shar: Extracting \"'agent/pl/compress.pl'\" \(7102 characters\)
  sed "s/^X//" >'agent/pl/compress.pl' <<'END_OF_FILE'
X;# $Id: compress.pl,v 3.0 1993/11/29 13:48:37 ram Exp ram $
X;#
X;#  Copyright (c) 1990-1993, Raphael Manfredi
X;#
X;#  You may redistribute only under the terms of the Artistic License,
X;#  as specified in the README file that comes with the distribution.
X;#  You may reuse parts of this distribution only within the terms of
X;#  that same Artistic License; a copy of which may be found at the root
X;#  of the source tree for mailagent 3.0.
X;#
X;# $Log: compress.pl,v $
X;# Revision 3.0  1993/11/29  13:48:37  ram
X;# Baseline for mailagent 3.0 netwide release.
X;#
X;#
X;# This module handles compressed folders. Each folder specified in the file
X;# 'compress' from the configuration file is candidate for compression checks.
X;# The file specifies folders using shell patterns. If the pattern does not
X;# start with a /, the match is only attempted to the basename of the folder.
X;#
X;# Folder uncompressed are recompressed only before the mailagent is about
X;# to exit, so that the burden of successive decompressions is avoided should
X;# two or more mails be delivered to the same compressed folder. However, if
X;# there is not enough disk space to hold all the uncompressed folder, the
X;# mailagent will try to recompress them to try to make some room.
X;#
X;# The initial patterns are held in the @compress array, while the compression
X;# status is stored within %compress. The key is the file name, and the value
X;# is 0 if uncompression was attempted but failed somehow so recompression must
X;# not be done, or 1 if uncompression was successful and the folder is flagged
X;# for delayed recompression.
X#
X# Folder compression
X#
X
Xpackage compress;
X
X# Read in the compression file into the @compress array. As usual, shell
X# comments are ignored.
Xsub init {
X    unless (open(COMPRESS, "$cf'compress")) {
X        &'add_log("WARNING cannot open compress file $cf'compress: $!")
X            if $'loglvl > 5;
X        return;
X    }
X    while (<COMPRESS>) {
X        chop;
X        next if /^\s*#/;            # Skip comments
X        next if /^\s*$/;            # And blank lines
X        $_ = &'perl_pattern($_);    # Shell pattern to perl one
X        s/^~/$cf'home/;                # ~ substitution
X        $_ = '.*/'.$_ unless m|^/|;    # Focus on basename unless absolute path
X        push(@compress, $_);        # Record pattern
X    }
X    close COMPRESS;
X}
X
X# Uncompress a folder, and record it in the %compress array for further
X# recompression at the end of the mailagent processing. Return 1 for success.
X# If the $retry parameter is set, other folders will be recompressed should
X# this particular uncompression fail.
Xsub uncompress {
X    local($folder, $retry) = @_;    # Folder to be decompressed
X    return if defined $compress{$folder};    # We already dealt with that folder
X    # Lock folder, in case someone is trying to deliver to the uncompressed
X    # folder while we're decompressing it...
X    if (0 != &'acs_rqst($folder)) {
X        &'add_log("NOTICE unable to lock compressed folder $folder")
X            if $'loglvl > 6;
X        return 0;                # Failure, don't uncompress, sorry
X    }
X    # Make sure there is a .Z file, and that the corresponding folder is not
X    # already present. If there is no .Z file but the folder already exists,
X    # mark it uncompressed.
X    if (-f "$folder.Z") {        # A compressed form exists
X        if (-f $folder) {        # As well as an uncompressed form
X            &'add_log("WARNING both folders $folder and $folder.Z exist")
X                if $'loglvl > 5;
X            &'add_log("NOTICE ignoring compressed file") if $'loglvl > 6;
X            $compress{$folder} = 0;        # Do not recompress it
X            &'free_file($folder);        # Unlock folder
X            return 1;
X        }
X        # Normal case: there is a compressed file and no uncompressed version
X        local($status) = system("uncompress $folder.Z");
X        if ($status) {            # Uncompression failed
X            local($retrying);
X            $retrying = " (retrying)" if $retry;
X            &'add_log("ERROR cannot uncompress $folder$retrying") if $'loglvl;
X            # Maybe there is not enough disk space, and maybe we can get some
X            # by recompressing the folders we have decompressed so far.
X            if ($retry) {                # Attempt is to be retried
X                &recompress;            # Recompress other folders, if any
X                &'free_file($folder);    # Unlock folder
X                return 0;                # And report failure
X            }
X            &'add_log("WARNING $folder present before delivery")
X                if -f $folder && $'loglvl > 5;
X            &'add_log("ERROR original $folder.Z lost")
X                if ! -f "$folder.Z" && $'loglvl;
X            $compress{$folder} = 0;        # Do not recompress it
X        } else {                # Folder should be decompressed
X            if (-f "$folder.Z") {
X                &'add_log("WARNING compressed $folder still present")
X                    if $'loglvl > 5;
X                $compress{$folder} = 0;    # Do not recompress it
X            } else {
X                $compress{$folder} = 1;    # Will be recompressed after delivery
X            }
X            &'add_log("uncompressed $folder") if $'loglvl > 8;
X        }
X    } else {
X        $compress{$folder} = 1;        # Folder will be compressed after creation
X    }
X    &'free_file($folder);    # Unlock folder
X    1;                        # Success
X}
X
X# Compress a folder
Xsub compress {
X    local($folder) = @_;        # Folder to be compressed
X    return unless $compress{$folder};    # Folder not to be recompressed
X    delete $compress{$folder};            # Mark it compressed anyway
X    if (-f "$folder.Z") {        # A compressed form exists
X        &'add_log("ERROR compressed $folder already present") if $'loglvl;
X        return;
X    }
X    if (0 != &'acs_rqst($folder)) {        # Cannot compress if not locked
X        &'add_log("NOTICE $folder locked, skiping compression") if $'loglvl > 6;
X        return;
X    }
X    local($status) = system("compress $folder");
X    if ($status) {
X        &'add_log("ERROR cannot compress $folder") if $'loglvl;
X        if (-f $folder) {
X            unless (unlink "$folder.Z") {
X                &'add_log("ERROR cannot remove $folder.Z: $!") if $'loglvl;
X            } else {
X                &'add_log("NOTICE removing $folder.Z") if $'loglvl > 6;
X            }
X        } else {
X            &'add_log("ERROR original $folder lost") if $'loglvl;
X        }
X    } else {
X        &'add_log("WARNING uncompressed $folder still present")
X            if -f $folder && $'loglvl > 5;
X        &'add_log("compressed $folder") if $'loglvl > 8;
X    }
X    &'free_file($folder);
X}
X
X# Recompress all folders which have been delivered to
Xsub recompress {
X    foreach $file (keys %compress) {
X        &compress($file);
X    }
X}
X
X# Restore uncompressed folder if listed in the compression list
Xsub restore {
X    return unless $cf'compress;        # Do nothing if no compress parameter
X    return unless -s $cf'compress;    # No compress list file, or empty
X    &init unless defined @compress;    # Initialize array only once
X    local($folder) = @_;            # Folder candidate for uncompression
X    &'add_log("candidate folder is $folder") if $'loglvl > 18;
X
X    # Loop over each pattern in the compression file and see if the folder
X    # matches one of them. As soon as one matches, the folder is uncompressed
X    # if necessary and the processing is over.
X    foreach $pattern (@compress) {
X        &'add_log("matching against '$pattern'") if $'loglvl > 19;
X        if ($folder =~ /^$pattern$/) {
X            &'add_log("matched '$pattern'") if $'loglvl > 18;
X            # Give it two shots. The second parameter is a retrying flag.
X            # The difference between the two is that recompression of other
X            # uncompressed folders is attempted the first time if the folder
X            # cannot be uncompressed (assuming low disk space).
X            &uncompress($folder, 0) unless &uncompress($folder, 1);
X            last;
X        }
X    }
X}
X
Xpackage main;
X
END_OF_FILE
  if test 7102 -ne `wc -c <'agent/pl/compress.pl'`; then
    echo shar: \"'agent/pl/compress.pl'\" unpacked with wrong size!
  fi
  # end of 'agent/pl/compress.pl'
fi
if test -f 'agent/pl/hook.pl' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'agent/pl/hook.pl'\"
else
  echo shar: Extracting \"'agent/pl/hook.pl'\" \(7356 characters\)
  sed "s/^X//" >'agent/pl/hook.pl' <<'END_OF_FILE'
X;# $Id: hook.pl,v 3.0 1993/11/29 13:48:51 ram Exp ram $
X;#
X;#  Copyright (c) 1990-1993, Raphael Manfredi
X;#
X;#  You may redistribute only under the terms of the Artistic License,
X;#  as specified in the README file that comes with the distribution.
X;#  You may reuse parts of this distribution only within the terms of
X;#  that same Artistic License; a copy of which may be found at the root
X;#  of the source tree for mailagent 3.0.
X;#
X;# $Log: hook.pl,v $
X;# Revision 3.0  1993/11/29  13:48:51  ram
X;# Baseline for mailagent 3.0 netwide release.
X;#
X;#
X;# A mail hook (in the mailagent terminology) is an external file which
X;# transparently influences some of the mailagent actions by injecting user-
X;# defined actions at some well-defined places. Currently, the only hooks
X;# available are executable folders, activated via the SAVE, STORE, and LEAVE
X;# commands.
X;#
X;# The hook_type function parses the top of the hook file, looking for magic
X;# token which will give hints regarding the type of the hook. Then the
X;# corresponding hook function will be called with the file name where the mail
X;# is stored given as first argument (an empty string meaning the mail is to be
X;# fetched from stdin), the second argument being the hook file name.
X;#
X;# Five types of hooks are currently supported:
X;#   - Simple program: the mail is simply fed to the standard input of the
X;#     program. The exit status is propagated to the mailagent.
X;#   - Rule file: the mail is to be re-analyzed according to the new rules
X;#     held in the hook file. The APPLY command is used, and mode is reset to
X;#       the default INITIAL state.
X;#   - Audit script: This is a perl script. Following the spirit of Martin
X;#     Streicher's audit.pl package, some special variables are magically set
X;#     prior to the invocation of script within the special mailhook package,
X;#     in which the script is compiled.
X;#   - Deliver script: Same as an audit script, excepted that the output of the
X;#     script is monitored and taken as mailagent commands, which will then
X;#     be executed on the original message upon completion of the script.
X;#   - Perl script: This is an audit script with full access to the mailagent
X;#     primitives for filtering (same as the ones provided with a PERL command).
X;#
X#
X# Mailhook handling
X#
X
Xpackage hook;
X
X# Hooks constants definitions
Xsub init {
X    $HOOK_UNKNOWN = "hook'unknown";        # Hook type was not recognized
X    $HOOK_PROGRAM = "hook'program";        # Hook is a filter program
X    $HOOK_AUDIT = "hook'audit";            # Hook is an audit-like script
X    $HOOK_DELIVER = "hook'deliver";        # Hook is a deliver-like script
X    $HOOK_RULES = "hook'rules";            # Hook is a rule file
X    $HOOK_PERL = "hook'perl";            # Hook is a perl script
X}
X
X# Deal with the hook
Xsub process {
X    &init unless $init_done++;            # Initialize hook constants
X    local($hook) = @_;
X    local($type) = &type($hook);        # Get hook type
X    &hooking($hook, $type);                # Print log message
X    unless (chdir $cf'home) {
X        &'add_log("WARNING cannot chdir to $cf'home: $!") if $'loglvl > 5;
X    }
X    eval '&$type($hook)';                # Call hook (inside eval to allow die)
X    &'eval_error;                        # Report errors and propagate status
X}
X
X# Determine the nature of the hook. The top 128 bytes are scanned for a magic
X# number starting with #: and followed by some words. The type of the hook
X# is determined by the first word (case insensitively).
Xsub type {
X    local($file) = @_;            # Name of hook file
X    -f "$file" || return $HOOK_UNKNOWN;
X    -x _ || return $HOOK_UNKNOWN;
X    open(HOOK, $file) || return $HOOK_PROGRAM;
X    local($hook) = ' ' x 128;    # Consider only top 128 bytes
X    sysread(HOOK, $hook, 128);
X    close(HOOK);
X    local($name) = $hook =~ /^#:\s*(\w+)/;
X    $name =~ tr/A-Z/a-z/;
X    return $HOOK_AUDIT if $name eq 'audit';
X    return $HOOK_DELIVER if $name eq 'deliver';
X    return $HOOK_RULES if $name eq 'rules';
X    return $HOOK_PERL if $name eq 'perl';
X    $HOOK_PROGRAM;                # No magic token found
X}
X
X#
X# Hook functions
X#
X
X# The hook file is not valid
Xsub unknown {
X    local($hook) = @_;
X    die("$hook is not a hook file");
X}
X
X# Mail is to be piped to the hook program (on stdin)
Xsub program {
X    local($hook) = @_;
X    &'add_log("hook is a plain program") if $'loglvl > 17;
X    local($failed) = &'shell_command($hook, $'MAIL_INPUT, $'NO_FEEDBACK);
X    die("cannot run $hook") if $failed;
X}
X
X# Mail is to be filetered with rules from hook file
Xsub rules {
X    local($hook) = @_;
X    &'add_log("hook contains mailagent rules") if $'loglvl > 17;
X    local($wmode) = 'INITIAL';        # Force working mode of INITIAL
X    local($failed, $saved) = &'apply($hook);
X    die("cannot apply rules") if $failed;
X    unless ($saved) {
X        &'add_log("NOTICE not saved, leaving in mailbox") if $loglvl > 5;
X        &'xeqte("LEAVE");
X    }
X}
X
X# Mail is to be filtered through a perl script
Xsub perl {
X    local($hook) = @_;
X    &'add_log("hook is a perl script") if $'loglvl > 17;
X    local($failed) = &'run_perl("PERL $hook");
X    die("cannot run perl hook") if $failed;
X}
X
X# Hook is an audit script. Set up a suitable environment and execute the
X# script after having forked a new process. To avoid name clashes, the script
X# is compiled in a dedicated 'mailhook' package and executed.
X# Note: the only difference with the perl hook is that we need to fork an
X# extra process to run the hook, since it might use a plain 'exit', which would
X# be desastrous on the mailagent.
Xsub audit {
X    local($hook) = @_;
X    &'add_log("hook is an audit script") if $'loglvl > 17;
X    local($pid) = fork;
X    $pid = -1 unless defined $pid;
X    if ($pid == 0) {                # Child process
X        &initvar('mailhook');        # Initialize special variables
X        &run($hook);                # Load hook and run it
X        exit(0);
X    } elsif ($pid == -1) {
X        &'add_log("ERROR cannot fork: $!") if $'loglvl;
X        die("cannot audit with hook");
X    }
X    # Parent process comes here
X    wait;
X    die("audit hook failed") unless $? == 0;
X}
X
X# A delivery script is about the same as an audit script, except that the
X# output on stdout is monitored and understood as mailagent commands to be
X# executed upon successful return.
Xsub deliver {
X    local($hook) = @_;
X    &'add_log("hook is a deliver script") if $'loglvl > 17;
X    # Fork and let the child do all the work. The parent simply captures the
X    # output from child's stdout.
X    local($pid);
X    $pid = open(HOOK, "-|");    # Implicit fork
X    unless (defined $pid) {
X        &'add_log("ERROR cannot fork: $!") if $'loglvl;
X        die("cannot deliver to hook");
X    }
X    if (0 == $pid) {            # Child process
X        &initvar('mailhook');    # Initialize special variables
X        &run($hook);            # Load hook and run it
X        exit(0);                # Everything went well
X    }
X    # Parent process comes here
X    local($output) = ' ' x (-s HOOK);
X    {
X        local($/) = undef;        # We wish to slurp the whole output
X        $output = <HOOK>;
X    }
X    close HOOK;                    # An implicit wait -- status put in $?
X    unless (0 == $?) {
X        &'add_log("ERROR hook script failed") if $'loglvl;
X        die("non-zero exit status") unless $output;
X        die("commands ignored");
X    }
X    if ($output eq '') {
X        &'add_log("WARNING no commands from delivery hook") if $'loglvl > 5;
X    } else {
X        &main'xeqte($output);    # Run mailagent commands
X    }
X}
X
X# Log hook operation before it happens, as we may well exec() another program.
Xsub hooking {
X    local($hook, $type) = @_;
X    local($home) = $cf'home;
X    $home =~ s/(\W)/\\$1/g;        # Escape possible meta-characters
X    $type =~ s/^hook'//;
X    $hook =~ s/^$home/~/;
X    &'add_log("HOOKING [$'mfile] to $hook ($type)") if $'loglvl > 4;
X}
X
Xpackage main;
X
END_OF_FILE
  if test 7356 -ne `wc -c <'agent/pl/hook.pl'`; then
    echo shar: \"'agent/pl/hook.pl'\" unpacked with wrong size!
  fi
  # end of 'agent/pl/hook.pl'
fi
if test -f 'agent/pl/macros.pl' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'agent/pl/macros.pl'\"
else
  echo shar: Extracting \"'agent/pl/macros.pl'\" \(6718 characters\)
  sed "s/^X//" >'agent/pl/macros.pl' <<'END_OF_FILE'
X;# $Id: macros.pl,v 3.0 1993/11/29 13:48:57 ram Exp ram $
X;#
X;#  Copyright (c) 1990-1993, Raphael Manfredi
X;#
X;#  You may redistribute only under the terms of the Artistic License,
X;#  as specified in the README file that comes with the distribution.
X;#  You may reuse parts of this distribution only within the terms of
X;#  that same Artistic License; a copy of which may be found at the root
X;#  of the source tree for mailagent 3.0.
X;#
X;# $Log: macros.pl,v $
X;# Revision 3.0  1993/11/29  13:48:57  ram
X;# Baseline for mailagent 3.0 netwide release.
X;#
X;#
X;# Macros:
X;# %%     A real percent sign
X;# %A     Sender's main address (host.domain.ct in [e-mail])
X;# %C     CPU name, fully qualified with domain name
X;# %D     Day of the week (0-6)
X;# %H     Host name (name of the machine on which the mailagent runs)
X;# %I     Internet domain from sender (domain.ct in [e-mail])
X;# %L     Length of the message in bytes (without header)
X;# %N     Full name of sender (login name if none)
X;# %O     Organization name from sender address (domain in [e-mail])
X;# %R     Subject of orginal message with leading Re: suppressed
X;# %S     Re: subject of original message
X;# %T     Time of last modification on mailed file (value taken from $macro_T)
X;# %U     Full name of the user
X;# %_     A white space
X;# %#reg  Value of user-defined variable 'reg'
X;# %&     List of selectors which incurred match (among regexps ones)
X;# %~     A null character
X;# %1     Value of the corresponding backreference (limited to 99 per rule)
X;# %d     Day of the month (01-31)
X;# %f     Contents of the "From:" line, something like %N <%r> or %r (%N)
X;# %h     Hour of the day (00-23)
X;# %i     Message ID if available
X;# %l     Number of lines in the message
X;# %m     Month of the year (01-12)
X;# %n     Lower-case login name of sender
X;# %o     Organization (where mailagent runs)
X;# %r     Return address of message
X;# %s     Subject of original message
X;# %t     Current hour and minute (in HH:MM format)
X;# %u     Login name of the user
X;# %y     Year (last two digits)
X;# %[To]  Value of the field in header (here To:)
X;# %=var  Value of the configuration variable (from ~/.mailagent)
X;# %-(x)  User-defined macro (x stands for an arbitrary name)
X;# %-x    Short-cut for single letter user-defined macros
X#
X# Macro handling (system)
X#
X
X# Macros substitutions (in-place)
Xsub macros_subst {
X    local(*str) = shift(@_);            # The string
X    local($_) = $str;                    # Work on a copy
X    return unless /%/;                    # Return immediately if no macros
X
X    local($sender);                            # The from field
X    local(@from);                            # The rfc-822 parsed from line
X    $sender = $Header{'From'};                # Header-derived From address
X    @from = &parse_address($sender);        # Get (address, comment)
X    local($login) = &login_name($from[0]);    # Keep only login name
X    local($fullname) = $from[1];            # The comment part of address
X    $fullname = $login unless $fullname;    # Use login name if no comment part
X    local($reply_to) = $Header{'Reply-To'}; # Return path derived
X    local($subject) = $Header{'Subject'};    # Original subject header
X    $subject =~ s/^\s*Re:\s*(.*)/$1/;        # Strip off leading Re:
X    $subject = "<empty subject>" unless $subject;
X    $reply_to = (&parse_address($reply_to))[0];    # Keep only e-mail address
X
X    # Time computations
X    local($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
X            localtime(time);
X    $mon = sprintf("%.2d", $mon + 1);
X    $mday = sprintf("%.2d", $mday);
X    local($timenow) = sprintf("%.2d:%.2d", $hour, $min);
X    $hour = sprintf("%.2d", $hour);
X
X    # The following dummy block is here only to force perl interpreting
X    # the $ variables in the substitutions correctly...
X    if (0) {
X        $Header{'a'} = 'a';
X        $Variable{'a'} = 'a';
X        $Backref[0] = 0;
X    }
X
X    s/%%/##pr##/g;                        # Protect double percent signs
X    s/%/#%%!/g;                            # Make sure substitutions do not add %
X    s/#%%!A/¯o'internet/eg;            # Main internet address of sender
X    s/#%%!d/$mday/g;                    # Day of the month (01-31)
X    s/#%%!C/&domain_addr/eg;            # CPU name, fully qualified with domain
X    s/#%%!D/$wday/g;                    # Day of the week (0-6)
X    s/#%%!f/$Header{'From'}/g;            # The "From:" line
X    s/#%%!h/$hour/g;                    # Hour of the day (00-23)
X    s/#%%!H/&myhostname/eg;                # Hostname on which mailagent runs
X    s/#%%!i/$Header{'Message-Id'}/g;    # Message-Id (null string if none)
X    s/#%%!I/¯o'domain/eg;            # Internet domain name of sender
X    s/#%%!l/$Header{'Lines'}/g;            # Number if lines in message
X    s/#%%!L/$Header{'Length'}/g;        # Length of message, in bytes
X    s/#%%!m/$mon/g;                        # Month of the year
X    s/#%%!n/$login/g;                    # Lower-cased login name of sender
X    s/#%%!N/$fullname/g;                # Full name of sender (login if none)
X    s/#%%!o/$orgname/g;                    # Organization name
X    s/#%%!O/¯o'org/eg;                # Organization part of sender's address
X    s/#%%!r/$reply_to/g;                # Return path of message
X    s/#%%!R/$subject/g;                    # Subject with leading Re: suppressed
X    s/#%%!s/$Header{'Subject'}/g;        # Subject of message
X    s/#%%!S/Re: $Header{'Subject'}/g;    # Re: subject of original message
X    s/#%%!t/$timenow/g;                    # Current time HH:MM
X    s/#%%!T/$macro_T/g;                    # Time of last modification on file
X    s/#%%!u/$cf'user/go;                # User login name (does not change)
X    s/#%%!U/$cf'name/go;                # User's name (does not change)
X    s/#%%!y/$year/g;                    # Year (last two digits)
X    s/#%%!_/ /g;                        # A white space
X    s/#%%!~//g;                            # A null character
X    s/#%%!&/$macro_ampersand/g;            # List of matched generic selectors
X    s/#%%!(\d\d?)/$Backref[$1 - 1]/g;    # A pattern matching backreference
X    s/#%%!#:(\w+)/&extern'val($1)/eg;    # A persistent user-defined variable
X    s/#%%!#(\w+)/$Variable{$1}/g;        # A user-defined variable
X    s/#%%!\[([\w-]+)\]/$Header{$1}/g;    # The %[Field] macro
X    s/#%%!=(\w+)/eval("\$cf'$1")/ge;    # The %=config_var variable
X    s/#%%!-([^\s(])/¯o'usr($1)/ge;    # A %-x single letter user macro
X    s/#%%!-\(([^\s)]+)\)/¯o'usr($1)/ge;    # A %-(complex) user-defined macro
X    s/#%%!/%/g;                            # Any remaining percent is kept
X    s/##pr##/%/g;                        # A double percent expands to %
X    $str = $_;                            # Update string in-place
X}
X
Xpackage macro;
X
X# Return the internet information of the From address
Xsub info {
X    local($addr) = (&'parse_address($'Header{'From'}))[0];
X    &'internet_info($addr);
X}
X
X# Return the organization name
Xsub org {
X    local($host, $domain, $country) = &info;
X    $domain;
X}
X
X# Return the domain name
Xsub domain {
X    local($host, $domain, $country) = &info;
X    $domain .'.'. $country;
X}
X
X# Return the qualified internet address
Xsub internet {
X    local($host, $domain, $country) = &info;
X    $host ne '' ? $host .'.'. $domain .'.'. $country : $domain .'.'. $country;
X}
X
X;#
X;# User-defined macro handled by ¯o'usr, which is defined in the usrmac.pl
X;# file to emphasize there the link with ¯os_subst.
X;#
X
Xpackage main;
X
END_OF_FILE
  if test 6718 -ne `wc -c <'agent/pl/macros.pl'`; then
    echo shar: \"'agent/pl/macros.pl'\" unpacked with wrong size!
  fi
  # end of 'agent/pl/macros.pl'
fi
if test -f 'agent/pl/parse.pl' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'agent/pl/parse.pl'\"
else
  echo shar: Extracting \"'agent/pl/parse.pl'\" \(6649 characters\)
  sed "s/^X//" >'agent/pl/parse.pl' <<'END_OF_FILE'
X;# $Id: parse.pl,v 3.0 1993/11/29 13:49:05 ram Exp ram $
X;#
X;#  Copyright (c) 1990-1993, Raphael Manfredi
X;#
X;#  You may redistribute only under the terms of the Artistic License,
X;#  as specified in the README file that comes with the distribution.
X;#  You may reuse parts of this distribution only within the terms of
X;#  that same Artistic License; a copy of which may be found at the root
X;#  of the source tree for mailagent 3.0.
X;#
X;# $Log: parse.pl,v $
X;# Revision 3.0  1993/11/29  13:49:05  ram
X;# Baseline for mailagent 3.0 netwide release.
X;#
X;#
X#
X# Parsing mail
X#
X
X# Parse the mail and fill-in the Header associative array. The special entries
X# All, Body and Head respectively hold the whole message, the body and the
X# header of the message.
Xsub parse_mail {
X    local($file_name) = shift(@_);    # Where mail is stored ("" for stdin)
X    local($head_only) = shift(@_);    # Optional parameter: parse only header
X    local($last_header) = "";        # Name of last header (for continuations)
X    local($first_from) = "";        # The first From line in mails
X    local($lines) = 0;                # Number of lines in the body
X    local($length) = 0;                # Length of body, in bytes
X    local($last_was_nl) = 1;        # True when last line was a '\n' (1 for EOH)
X    local($fd) = STDIN;                # Where does the mail come from ?
X    local($value);                    # Value of current field line
X    local($_);
X    undef %Header;                    # Reset the all structure holding message
X
X    if ($file_name ne '') {            # Mail spooled in a file
X        unless(open(MAIL, $file_name)) {
X            &add_log("ERROR cannot open $file_name: $!");
X            return;
X        }
X        $fd = MAIL;
X    }
X    $Userpath = "";                    # Reset path from possible previous @PATH
X
X    # Pre-extend 'All', 'Body' and 'Head'
X    $Header{'All'} = ' ' x 5000;
X    $Header{'Body'} = ' ' x 4500;
X    $Header{'Head'} = ' ' x 500;
X    $Header{'All'} = '';
X    $Header{'Body'} = '';
X    $Header{'Head'} = '';
X
X    &add_log ("parsing mail") if $loglvl > 18;
X    while (<$fd>) {
X        $Header{'All'} .= $_;
X        if (1../^$/) {                        # EOH is a blank line
X            next if /^$/;                    # Skip EOH marker
X            $Header{'Head'} .= $_;            # Record line in header
X
X            if (/^\s/) {                    # It is a continuation line
X                s/^\s+/ /;                    # Swallow multiple spaces
X                chop;                        # Remove final new-line
X                $Header{$last_header} .= "\n$_" if $last_header ne '';
X                &add_log("WARNING bad continuation in header, line $.")
X                    if $last_header eq '' && $loglvl > 4;
X            } elsif (/^([\w-]+):\s*(.*)/) {    # We found a new header
X                # Guarantee only one From: header line. If multiple From: are
X                # found, keep the last one.
X                # Multiple headers like 'Received' are separated by a new-
X                # line character. All headers end on a non new-line.
X                # Case is normalized before recording, so apparently-to will
X                # be recorded as Apparently-To but header is not changed.
X                $value = $2;                # Bug in perl 4.0 PL19
X                $last_header = &header'normalize($1);    # Normalize case
X                if ($last_header eq 'From' && defined $Header{$last_header}) {
X                    $Header{$last_header} = $value;
X                    &add_log("WARNING duplicate From in header, line $.")
X                        if $loglvl > 4;
X                } elsif ($Header{$last_header} ne '') {
X                    $Header{$last_header} .= "\n$value";
X                } else {
X                    $Header{$last_header} .= $value;
X                }
X            } elsif (/^From\s+(\S+)/) {        # The very first From line
X                $first_from = $1;
X            }
X
X        } else {
X            last if $head_only;        # Stop parsing if only header wanted
X            $lines++;                                # One more line in body
X            $length += length($_);                    # Update length of message
X            s/^From(\s)/>From$1/ if $last_was_nl;    # Escape From keyword
X            $last_was_nl = /^$/;                    # Keep track of single '\n'
X            $Header{'Body'} .= $_;
X            chop;
X            # Deal with builtin commands
X            if (s/^@(\w+)\s*//) {                    # A builtin command ?
X                local($subroutine) = $Builtin{$1};
X                &$subroutine($_) if $subroutine;
X            }
X        }
X    }
X    close MAIL if $file_name ne '';
X    $Header{'Head'} = "$FAKE_FROM\n" .  $Header{'Head'} unless $first_from;
X    &header_check($first_from, $lines);    # Sanity checks
X}
X
X# Now do some sanity checks:
X# - if there is no From: header, fill it in with the first From
X# - if there is no To: but an Apparently-To:, copy it also as a To:
X# - if an Envelope field was defined in the header, override it (sorry)
X#
X# We guarantee the following header entries:
X#   From:         the value of the From field
X#   To:           to whom the mail was sent
X#   Lines:        number of lines in the message
X#   Length:       number of bytes in the message
X#   Reply-To:     the address we may use to reply
X#   Sender:       the value of the Sender field, same as From usually
X#   Envelope:     the actual sender of the message, empty if cannot compute
X
Xsub header_check {
X    local($first_from, $lines) = @_;    # First From line, number of lines
X    unless (defined $Header{'From'}) {
X        &add_log("WARNING no From: field, assuming $first_from") if $loglvl > 4;
X        $Header{'From'} = $first_from;
X    }
X
X    # There is usually one Apparently-To line per address. Remove all new lines
X    # in the header line and replace them with ','. Likewise for To: and Cc:.
X    # although it is far less likely to occur.
X    local($*) = 1;
X    foreach $field ('Apparently-To', 'To', 'Cc') {
X        $Header{$field} =~ s/\n/,/g;    # Remove new-lines
X        $Header{$field} =~ s/,$/\n/;    # Restore last new-line
X    }
X    $* = 0;
X
X    # If no To: field, then maybe there is an Apparently-To: instead. If so,
X    # make them identical. Otherwise, assume the mail was directed to the user.
X    if (!$Header{'To'} && $Header{'Apparently-To'}) {
X        $Header{'To'} = $Header{'Apparently-To'};
X    }
X    unless ($Header{'To'}) {
X        &add_log("WARNING no To: field, assuming $cf'user") if $loglvl > 4;
X        $Header{'To'} = $cf'user;
X    }
X
X    # Set number of lines in body, unless there is already a Lines:
X    # header in which case we trust it. Same for Length.
X    $Header{'Lines'} = $lines unless defined($Header{'Lines'});
X    $Header{'Length'} = $length unless defined($Header{'Length'});
X
X    # If there is no Reply-To: line, then take the address in From, if any.
X    # Otherwise use the address found in the return-path
X    if (!$Header{'Reply-To'}) {
X        local($tmp) = (&parse_address($Header{'From'}))[0];
X        $Header{'Reply-To'} = $tmp if $tmp ne '';
X        $Header{'Reply-To'} = (&parse_address($Header{'Return-Path'}))[0]
X            if $tmp eq '';
X    }
X
X    # Unless there is already a sender line, fake one using From field
X    if (!$Header{'Sender'}) {
X        $Header{'Sender'} = $first_from;
X        $Header{'Sender'} = $Header{'From'} unless $first_from;
X    }
X
X    # Now override any Envelope header and grab it from the first From field
X    # If such a field was defined in the message header, then sorry but it
X    # was a mistake: RFC 822 doesn't define it, so it should have been
X    # an X-Envelope instead.
X
X    $Header{'Envelope'} = $first_from;
X}
X
END_OF_FILE
  if test 6649 -ne `wc -c <'agent/pl/parse.pl'`; then
    echo shar: \"'agent/pl/parse.pl'\" unpacked with wrong size!
  fi
  # end of 'agent/pl/parse.pl'
fi
if test -f 'agent/test/cmd/split.t' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'agent/test/cmd/split.t'\"
else
  echo shar: Extracting \"'agent/test/cmd/split.t'\" \(6596 characters\)
  sed "s/^X//" >'agent/test/cmd/split.t' <<'END_OF_FILE'
X# The SPLIT command
X
X# $Id: split.t,v 3.0 1993/11/29 13:49:50 ram Exp ram $
X#
X#  Copyright (c) 1990-1993, Raphael Manfredi
X#
X#  You may redistribute only under the terms of the Artistic License,
X#  as specified in the README file that comes with the distribution.
X#  You may reuse parts of this distribution only within the terms of
X#  that same Artistic License; a copy of which may be found at the root
X#  of the source tree for mailagent 3.0.
X#
X# $Log: split.t,v $
X# Revision 3.0  1993/11/29  13:49:50  ram
X# Baseline for mailagent 3.0 netwide release.
X#
X
Xdo '../pl/cmd.pl';
X
X&add_header('X-Tag: digest #2');
X&make_digest;
X
X# First time, normal split: one (empty) header plus 3 digest items.
X# A single 'SPLIT here' is run
X&add_header('X-Tag: split #1', 'digest');
X`cp digest mail`;
X`$cmd`;
X$? == 0 || print "1\n";
X-f "$user" && print "2\n";            # Was not split in-place, but also saved
X-f 'here' || print "3\n";            # Where digest was split...
X&get_log(4, 'here');                # Slurp folder in @log
X&check_log('^X-Tag: digest #1', 5) == 2 || print "6\n";
X&check_log('^X-Tag: digest #2', 7) == 2 || print "8\n";
X&check_log('^X-Tag: digest #3', 9) == 2 || print "10\n";
X&check_log('^X-Tag: split #1', 11) == 2 || print "12\n";
X&check_log('^X-Filter-Note:', 13) == 2 || print "14\n";
Xunlink 'here';
X
X# Seconde time: a single 'SPLIT -id here' is run
X&replace_header('X-Tag: split #2', 'digest');
X`cp digest mail`;
X`$cmd`;
X$? == 0 || print "15\n";
X-f "$user" && print "16\n";            # Was not split in-place, but in folder
X-f 'here' || print "17\n";            # Where digest was split...
X&get_log(18, 'here');                # Slurp folder in @log
X&check_log('^X-Tag: digest #1', 19) == 1 || print "20\n";
X&check_log('^X-Tag: digest #2', 21) == 1 || print "22\n";
X&check_log('^X-Tag: digest #3', 23) == 1 || print "24\n";
X¬_log('^X-Tag: split #2', 25);    # Header was deleted by -d
X&check_log('^X-Filter-Note:', 26) == 2 || print "27\n";
X&check_log('^X-Digest-To:', 84) == 3 || print "85\n";
Xunlink 'here';
X
X# Third time: a single 'SPLIT -iew here' is run
X&replace_header('X-Tag: split #3', 'digest');
X`cp digest mail`;
X`$cmd`;
X$? == 0 || print "28\n";
X-f "$user" && print "29\n";            # Was not split in-place, but in folder
X-f 'here' || print "30\n";            # Where digest was split...
X&get_log(31, 'here');                # Slurp folder in @log
X&check_log('^X-Tag: digest #1', 32) == 1 || print "33\n";
X&check_log('^X-Tag: digest #2', 34) == 1 || print "35\n";
X&check_log('^X-Tag: digest #3', 36) == 1 || print "37\n";
X¬_log('^X-Tag: split #3', 38);    # Header was deleted by -e
X&check_log('^X-Filter-Note:', 39) == 3 || print "40\n";    # Trailing garbage...
X&check_log('anticonstitutionellement', 41) == 1 || print "42\n";
Xunlink 'here';
X
X# Fourth time: a single 'SPLIT -iew' is run. All the digest items will still
X# be saved in 'here' because they all bear a X-Tag: header. The trailing
X# garbage will not match anything and will be left in the mailbox.
X&replace_header('X-Tag: split #4', 'digest');
X`cp digest mail`;
X`$cmd`;
X$? == 0 || print "43\n";
X-f "$user" || print "44\n";            # That must be the trailing garbage
X-f 'here' || print "45\n";            # Where digest was split...
X&get_log(46, 'here');                # Slurp folder in @log
X&check_log('^X-Tag: digest #1', 47) == 1 || print "48\n";
X&check_log('^X-Tag: digest #2', 49) == 1 || print "50\n";
X&check_log('^X-Tag: digest #3', 51) == 1 || print "52\n";
X¬_log('^X-Tag: split #3', 53);    # Header was deleted by -e
X&check_log('^X-Filter-Note:', 54) == 2 || print "55\n";    # No trailing garbage...
X¬_log('anticonstitutionellement', 56);
X&get_log(57, "$user");
X&check_log('anticonstitutionellement', 58) == 1 || print "59\n";
X&check_log('^X-Filter-Note:', 60) == 1 || print "61\n";
Xunlink 'here', "$user";
X
X# Fifth time: a single 'SPLIT -iew here', but this time header is not empty...
X# Besides, there will be an empty message between encapsulation boundaries
X# and we want to make sure SPLIT deals correctly with it. Trailing garbage
X# is removed.
Xopen(MAIL, ">mail");
Xclose MAIL;
X&make_digest('Not empty digest header');
X`cp digest mail`;
X&add_header('X-Tag: split #5');
X`$cmd`;
X$? == 0 || print "62\n";
X-f 'here' || print "63\n";            # Where digest was split...
X&get_log(64, 'here');                # Slurp folder in @log
X&check_log('^X-Tag: digest #1', 65) == 1 || print "66\n";
X&check_log('^X-Tag: digest #3', 67) == 1 || print "68\n";
X¬_log('^X-Tag: digest #2', 69);    # Empty second message
X¬_log('Mailagent-Test-Suite', 70);    # No trailing garbage
X&check_log('^X-Filter-Note:', 71) == 2 || print "72\n";
X&check_log('^From ', 73) == 4 || print "74\n";    # One built up for last item
X&check_log('^Message-Id:', 75) == 1 || print "76\n";
X&check_log('^>From', 80) == 2 || print "81\n";
X&check_log('^From which', 82) == 1 || print "83\n";
X
X# Sixth time: mail is not in digest format.
X`cp ../mail .`;
X$? == 0 || print "77\n";        # Fool guard for myself
X&add_header('X-Tag: split #5');
X`$cmd`;
X$? == 0 || print "78\n";
X-f 'here' || print "79\n";        # Where mail was saved (not in digest format)
X
Xunlink 'mail', 'here', 'digest';
X# Last is 85
Xprint "0\n";
X
X# Build digest out of mail
Xsub make_digest {
X    local($msg) = @_;        # Optional, first line in header
X    &get_log(100, 'mail');    # Slurp mail in @log
X    open(DIGEST, ">digest");
X    print DIGEST <<EOH;
XReceived: from eiffel.eiffel.com by lyon.eiffel.com (5.61/1.34)
X    id AA25370; Fri, 10 Jul 92 23:48:30 -0700
XReceived: by eiffel.eiffel.com (4.0/SMI-4.0)
X    id AA27809; Fri, 10 Jul 92 23:45:14 PDT
XDate: Fri, 10 Jul 92 23:45:14 PDT
XFrom: [e-mail] (Postmaster)
XMessage-Id: <[e-mail]>
XTo: [e-mail]
XSubject: Mail Report - 10/07
X
X$msg
X----------------------------------------------
XFrom ram Sun Jul 12 18:20:27 PDT 1992
XFrom: ram
XSubject: Notice
XX-Tag: digest #1
X
XJust to tell you there was no digest header... unless $msg set
X
X----
X
XEOH
X    print DIGEST @log;
X    print DIGEST <<'EOM';
X----
XFrom: ram
XX-Tag: digest #3
X
XFrom line should be >escaped.
XAnother message with a really minimum set of header!!
XFrom which should NOT be
X
XFrom escaped again...
X----
X
XEOM
X    if ($msg eq '') {
X        print DIGEST <<'EOM';
XThis is trailing garbage. I will use the SPLIT command with the '-w'
Xoption and this will be saved is a separate mail with the subject
Xtaken from that of the whole digest, with the words (trailing garbage)
Xappended to it... This token, "anticonstitutionellement " will make
Xit obvious for grep -- it's the longest word in French, and it means
Xthe government is not doing its job, roughly speaking :-).
XEOM
X    } else {
X        print DIGEST <<'EOM';
XEnd of digest Mailagent-Test-Suite
X**********************************
XEOM
X    }
X    close DIGEST;
X}
X
END_OF_FILE
  if test 6596 -ne `wc -c <'agent/test/cmd/split.t'`; then
    echo shar: \"'agent/test/cmd/split.t'\" unpacked with wrong size!
  fi
  # end of 'agent/test/cmd/split.t'
fi
if test -f 'misc/shell/server.cf' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'misc/shell/server.cf'\"
else
  echo shar: Extracting \"'misc/shell/server.cf'\" \(118 characters\)
  sed "s/^X//" >'misc/shell/server.cf' <<'END_OF_FILE'
X#
X# Add the following to your 'comserver' file to allow shell processing.
X#
X
Xshell        shell    -    y    shell
Xshell        var        -    -    -
END_OF_FILE
  if test 118 -ne `wc -c <'misc/shell/server.cf'`; then
    echo shar: \"'misc/shell/server.cf'\" unpacked with wrong size!
  fi
  # end of 'misc/shell/server.cf'
fi
echo shar: End of archive 16 \(of 26\).
cp /dev/null ark16isdone
MISSING=""
for I in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 ; do
    if test ! -f ark${I}isdone ; then
    MISSING="${MISSING} ${I}"
    fi
done
if test "${MISSING}" = "" ; then
    echo You have unpacked all 26 archives.
    echo "Now run 'sh PACKNOTES', then read README and type Configure.'"
    rm -f ark[1-9]isdone ark[1-9][0-9]isdone
else
    echo You still must unpack the following archives:
    echo "        " ${MISSING}
fi
exit 0

exit 0 # Just in case...