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

Text File | 1993-12-02 | 54.9 KB | 1,759 lines

Newsgroups: comp.sources.misc
From: Raphael Manfredi <[e-mail]>
Subject: v41i015:  mailagent - Flexible mail filtering and processing package, v3.0, Part15/26
Message-ID: <[e-mail]>
X-Md4-Signature: ed4ab781aadd5112421b4c0db07b0d8b
Sender: [e-mail] (Kent Landfield)
Organization: Advanced Computer Research Institute, Lyon, France.
Date: Thu, 2 Dec 1993 13:40:54 GMT
Approved: [e-mail]

Submitted-by: Raphael Manfredi <[e-mail]>
Posting-number: Volume 41, Issue 15
Archive-name: mailagent/part15
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/examples/rules agent/maillist.SH agent/package.SH
#   agent/pl/file_edit.pl agent/pl/mh.pl agent/pl/power.pl misc/README
# Wrapped by ram@soft208 on Mon Nov 29 16:49:56 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 15 (of 26)."'
if test -f 'agent/examples/rules' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'agent/examples/rules'\"
else
  echo shar: Extracting \"'agent/examples/rules'\" \(8076 characters\)
  sed "s/^X//" >'agent/examples/rules' <<'END_OF_FILE'
X#
X# Rule file for mailagent
X#
X
X# The 'maildir' variable tells the mailagent where the folders are located.
X# By default, it is set to ~/Mail (because it is a convention used by other
X# mail-related programs), but the author prefers to use ~/mail.
X
Xmaildir = ~/mail;
X
X# The 'mailfilter' variable points to the place where all the loaded files
X# are stored (e.g. loaded patterns or addresses) and is used only when a
X# relative path is specified.
X
Xmailfilter = ~/mail;
X
X# This set of rules catches command mails early in the process.
X# Currently, only the author, whose login name is 'ram', is allowed to use
X# this feature. All others get a message explaining why their command was
X# rejected (random reasons), and then the message is processed normally
X# by the other set of rules. Note how the BEGIN and REJECT commands
X# inefficiently replace the missing if/else structure.
X
XAll: /^Subject:\s*[Cc]ommand/    { BEGIN CMD; REJECT };
X<CMD> From: ram            { STRIP Received; SAVE cmds; PROCESS };
X<CMD> *                    { BEGIN INITIAL; MESSAGE ~/tmp/nocmds; REJECT };
X
X# Here, I am turning a mailing list into a newsgroup by locally posting the
X# messages I get, so that others can read them too. I have configured inews to
X# mail me any follow-up made into this group, and those are caught with the
X# next rule and bounced directly to the mailing list... which will of course
X# resend the message to me. But the BOUNCE operation left an ``X-Filter'' field
X# in the message and the mailagent enters in the special seen mode, recognizing
X# an already filtered message. The third rule then simply deletes those
X# duplicates.
X
XTo Cc: [e-mail]            { POST -l mail.gue };
XApparently-To: ram,
XNewsgroups: mail.gue            { STRIP Apparently-To; BOUNCE [e-mail] };
X<_SEEN_> Newsgroups: mail.gue    { DELETE };
X
X# The MH users mailing list. I am the sole reader of this list. In the past,
X# I used to get some duplicate messages, but since I've added the UNIQUE
X# command, I havn't seen any... weird! :-)
X
XTo Cc: /^[e-mail]$/i
X    { STRIP Received; UNIQUE -a; SAVE comp.mail.mh };
X
X# This mailing list is a digest version of the comp.unix.wizards newsgroups.
X# It is not perfectly RFC-934, but close, so I simply discard the original
X# message and delete the header which is only the table of contents... Well,
X# I'm not sure there hasn't been any changes...
X
XTo Cc: /^unix-wizards@.*brl.mil$/i
X    { STRIP Received; SPLIT -id unix-wiz };
X
X# Those are news from the French embassy, which are forwarded to us "froggies".
X# I am forwarding this list to all the French people who are working in this
X# company (they are all listed in the file ~/mail/frog-list) and I keep a
X# copy for myself, of course.
X
XTo Cc: /^.*frog:;@guvax.georgetown.edu$/i
X    { FORWARD "frog-list"; STRIP Received; SAVE frog };
X
X# This mailing list is not at all RFC-934, but it usually has no headers. The
X# moderator prefers to add some comments at the end of the digest, hence the
X# -w flag, mainly to keep the trailing garbage.
X
XTo Cc: /^[e-mail]$/i
X    { STRIP Received; SPLIT -eiw magic };
X
X# The following mailing list used to forward messages from many newsgroups,
X# but not all of them are valid now, and Paul Vixie is talking about moving
X# the src list to pa.dec.com. Anyway, I am filtering the messages according
X# to the ``Newsgroups'' field.
X
XTo Cc: /^unix-sources.*@.*brl.mil$/i
X    { STRIP Received; BEGIN SRC; REJECT };
X
X<SRC> Newsgroups:
X        comp.sources.unix,
X        comp.sources.misc        { SAVE unix-src/src }
X        comp.sources.games        { SAVE unix-src/games }
X        comp.sources.x            { SAVE unix-src/x }
X        comp.sources.bugs        { SAVE unix-src/bugs }
X        comp.sources.wanted        { SAVE unix-src/wanted };
X<SRC> *                            { SAVE unix-src/other };
X
X# Other mailing list, with nothing particular. Ftpmail is not really a mailing
X# list, nor is it a valid user name, hence the regular not anchored regular
X# expression.
X
XTo Cc: rdb-interest        { STRIP Received; SAVE rdb };
XFrom: /ftpmail/i        { STRIP Received; SAVE ftp.mail };
X
X# I am working with Harlan Stenn on the dist 3.0 release, and I automatically
X# forward to him every mail with the word ``metaconfig'' in the subject.
X# I avoid mailing him back his own mails though.
X
XFrom: harlan, To Cc: ram    { SAVE dist };
XSubject: /metaconfig/i        { BEGIN DIST; REJECT };
X<DIST> From: harlan            { SAVE dist };
X<DIST>                        { SAVE dist; FORWARD [e-mail] };
X
X# This is administrative stuff. I am a system administrator here, among other
X# things, and we have several MIPS machine with a verbose cron daemon. I have
X# set up a /.forward on all those machines (which redirect all the root mail
X# to me) and I filter the output according to the machine name.
X
XFrom: root, To: root            { BEGIN ROOT; REJECT };
X<ROOT> Subject: /host (\w+)/    { ASSIGN host %1; REJECT };
X<ROOT> /^Daily run output/        { WRITE ~/var/log/%#host/daily.%D };
X<ROOT> /^Weekly run output/        { WRITE ~/var/log/%#host/weekly };
X<ROOT> /^Monthly run output/    { WRITE ~/var/log/%#host/monthly };
X
X# I have a cron job every day a 5:00 a.m. which cleans up my mail folders. I
X# am using the cron program from Paul Vixie, hence the rule testing against
X# the ``X-Cron-Cmd'' header. This is a nice feature from Paul's cron.
X
XTo: ram, X-Cron-Cmd: /mhclean/    { WRITE ~/var/log/mh/mh.%D };
X
X# I belong to multiple internal mailing lists at ISE, and when I send a mail
X# to this list, I do not wish to get a copy of it, as I already saved mine
X# via the ``Fcc' field provided by MH. Therefore, I delete everything which
X# comes from me and is not explicitely directed to me, with the exception of
X# the mailgent error messages which I receive as ``Bcc''.
X
XFrom: ram        { BEGIN RAM; REJECT };
X<RAM> To: ram    { LEAVE };
X<RAM> X-Mailer: /mailagent/i    { LEAVE };
X<RAM>            { DELETE };
X
X# Every system-related mail is saved in a special folder. Note that the pattern
X# matching is done in a case insensitive manner because all these patterns are
X# implicit matches on the ``login name'' of the sender.
X
XTo Cc:
X    postmaster,
X    newsmaster,
X    usenet, news,
X    mailer-daemon,
X    uucp, daemon,
X    system,
X    unknown-user    { SAVE admin };
X
X# Mail about the mailagent (sometimes called mail filter, hence the double
X# pattern) is handled specially. I have a special pattern file held in
X# ~/mail/auto-msg/agent.key. Every message which is NOT a reply and has one
X# of those patterns in its body will be automatically replied to, once a week,
X# by sending the message held in ~/mail/auto-msg/agent.msg. In order for me
X# to know that this message has been already "replied-to", I annotate it.
X# Ultimately, the message is dropped in a dedicated folder.
X
XSubject:
X    /mail\s*agent/i,
X    /mail\s*filter/i        { BEGIN AGENT; REJECT };
X<AGENT>
X    Subject: !/^Re:/,
X    Body: "~/mail/auto-msg/agent.key"
X        {
X            ONCE (%r, agent, 1w) REJECT AGENT_MSG;
X            SAVE agent;
X        };
X<AGENT_MSG>
X        {
X            MESSAGE ~/mail/auto-msg/agent.msg;
X            ANNOTATE Auto-Replied: %r;
X            SAVE agent;
X        };
X<AGENT> { SAVE agent };
X
X# Here, I am detecting mails sent by someone at ISE, i.e. mails with the
X# domain name ``eiffel.com'' appended or simply mails with no domain name.
X# I also turn off vacation messages, for when I am away, people at ISE usually
X# know about it :-).
X
XFrom:
X    /^\w+@.*eiffel\.com$/i
X    /^\w+@\w+$/i
X        { BEGIN ISE; STRIP Received; VACATION off; REJECT };
X
X# A mail explicitely sent to me, leave it in the mailbox.
X
X<ISE> To: ram            { LEAVE };
X
X# Various internal mailing list. Note the ``*eiffel*'' pattern which takes care
X# of various aliases including the word ``eiffel'', as in eiffel, eiffelgroup,
X# ueiffel, etc...
X
X<ISE> To Cc:
X    compiler    { SAVE ise/compiler }
X    *eiffel*    { SAVE ise/eiffel }
X    local        { SAVE ise/local };
X
X# Take care of all the "junk" mails. Usually, I check this mailbox once a week.
X# There is never anything interesting in there, trust me...
X
X<ISE>            { SAVE ise/other };
X
X# Finally, mails coming from the outside world are also filtered into specific
X# folders. This ends the rule file. Anything not matched past this point will
X# simply be left in the mailbox.
X
XTo Cc:
X    *eiffel*,
X    users        { SAVE ise/extern }
X    everyone    { SAVE ise/local };
X
X#
X# End of mailagent rules
X#
END_OF_FILE
  if test 8076 -ne `wc -c <'agent/examples/rules'`; then
    echo shar: \"'agent/examples/rules'\" unpacked with wrong size!
  fi
  # end of 'agent/examples/rules'
fi
if test -f 'agent/maillist.SH' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'agent/maillist.SH'\"
else
  echo shar: Extracting \"'agent/maillist.SH'\" \(7866 characters\)
  sed "s/^X//" >'agent/maillist.SH' <<'END_OF_FILE'
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
Xecho "Extracting agent/maillist (with variable substitutions)"
X$spitshell >maillist <<!GROK!THIS!
X$startperl
X    eval "exec perl -S \$0 \$*"
X        if \$running_under_some_shell;
X
X# $Id: maillist.SH,v 3.0 1993/11/29 13:48:24 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: maillist.SH,v $
X# Revision 3.0  1993/11/29  13:48:24  ram
X# Baseline for mailagent 3.0 netwide release.
X#
X
X\$mversion = '$VERSION';
X\$patchlevel = '$PATCHLEVEL';
X!GROK!THIS!
X
X$spitshell >>maillist <<'!NO!SUBS!'
X
X$prog_name = $0;                # Who I am
X$prog_name =~ s|^.*/(.*)|$1|;    # Keep only base name
X
X&read_config;        # First, read configuration file (in ~/.mailagent)
X
X# take job number and command from environment
X# (passed by mailagent)
X$jobnum = $ENV{'jobnum'};
X$fullcmd = $ENV{'fullcmd'};
X
X$dest=shift;                            # Who should the list to be sent to
X$dest = $ENV{'path'} if $dest eq '';    # If dest was ommitted
X
X# A single '-' as first argument stands for return path
X$dest = $ENV{'path'} if $dest eq '-';
X
X&read_dist;            # Read distributions and descriptions
X
Xopen(INFO, "$cf'proglist") ||
X    &fatal("cannot open description file");
X@sysinfo = <INFO>;
Xclose INFO;
X
X&read_plsave;        # Read patchlevel description file
X
X$tmp_mail = "$cf'tmpdir/xml$$";
X
Xopen(XHEAD, ">$tmp_mail") || &fatal("cannot create $tmp_mail");
Xprint XHEAD
X"To: $dest
XSubject: List of available distributions
XX-Mailer: mailagent [version $mversion PL$patchlevel]
X
XHere are the different packages available. If you want the whole
Xdistribution, send me the following:
X
X    @SH maildist $dest system version
X
XIf you want patches, use:
X
X    @SH mailpatch $dest system version LIST
X
Xwhere LIST is a list of patches number, separated by spaces, commas,
Xand/or hyphens. Saying 23- means everything from 23 to the end.
X
XDetailed instructions can be obtained by:
X
X    @SH mailhelp $dest
X
X
X";
X
Xforeach $pname (keys %Program) {
X    ($system, $version) = $pname =~ /^(\w+)\|([\w\.]+)*$/;
X    $version = '---' if $version eq '0';
X    $location = $Location{$pname};
X    &add_log("dealing with $system $version") if $loglvl > 19;
X
X    # Look for highest patchlevel (even if not maintained)
X    $tmp = "";            # Temporary directory created
X
X    if ($Archived{$pname}) {
X        unless ($PSystem{$pname}) {
X            # Archive not already listed in 'plsave'. Create a new
X            # entry with a modification time of zero.
X            $PSystem{$pname} = 1;
X            $Patch_level{$pname} = -1;    # Not a valid patch level
X            $Mtime{$pname} = 0;            # Force unpacking of archive
X        }
X
X        # We need to unarchive the directory only if archive
X        # modification time is newer than the one in patchlist
X        local($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime, $mtime,
X            $ctime,$blksize,$blocks) = stat(&expand($location));
X
X        if ($mtime != $Mtime{$pname}) {     # Archive was updated
X            $Mtime{$pname} = $mtime;     # Update mod time in 'plsave'
X            # Create a temporary directory
X            $tmp = "$cf'tmpdir/dml$$";
X            mkdir($tmp, 0700) ||
X                &fatal("cannot create $tmp");
X            # Need to unarchive the distribution
X            $location = &unpack($location, $tmp, $Compressed{$pname});
X            $Patch_level{$pname} = -1;    # Force updating
X        } else {
X            &add_log("no changes in $system $version archive")
X                if $loglvl > 15;
X        }
X
X    } else {
X        # System is not archived
X        $Patch_level{$pname} = -1;        # Force computation
X    }
X
X    if ($Patch_level{$pname} == -1) {
X        # We still don't know wether there is a patchlevel or not...
X        # Go to system directory, and look there.
X        if (!chdir("$location")) {
X            &add_log("ERROR cannot go to $location") if $loglvl;
X            next;
X        }
X        if ($Patch_only{$pname}) {        # Only patches available
X            if ($version eq '') {
X                &add_log("ERROR old system $system has no version number")
X                    if $loglvl;
X                next;
X            }
X            if (!chdir("bugs-$version")) {
X                &add_log("ERROR no bugs-$version dir for $system")
X                    if $loglvl;
X                next;
X            }
X            local($maxnum);
X            # There is no patchlevel to look at -- compute by hand.
X            for ($maxnum = 1; ; $maxnum++) {
X                last unless -f "patch$maxnum" || -f "patch$maxnum.Z";
X            }
X            $maxnum--;        # We've gone too far
X            $Patch_level{$pname} = $maxnum;
X        } elsif (! -f 'patchlevel.h') {
X            &add_log("no patchlevel.h for $system $version") if $loglvl > 17;
X        } elsif (!open(PATCHLEVEL, "patchlevel.h")) {
X            &add_log("cannot open patchlevel.h for $system $version")
X                if $loglvl > 5;
X        } else {
X            while (<PATCHLEVEL>) {
X                if (/.*PATCHLEVEL[ \t]*(\w+)/) {    # May have letters
X                    $Patch_level{$pname} = $1;
X                    last;
X                }
X            }
X            close PATCHLEVEL;
X            if ($Patch_level{$pname} == -1) {
X                &add_log("malformed patchlevel.h for $system $version")
X                    if $loglvl > 5;
X            }
X        }
X    }
X
X    if ($Patch_level{$pname} >= 0) {
X        &add_log("patchlevel is #$Patch_level{$pname} for $system $version")
X            if $loglvl > 18;
X    } else {
X        $Patch_level{$pname} = -2;        # Signals: no patchlevel
X        &add_log("no patchlevel for $system $version") if $loglvl > 18;
X    }
X
X    &clean_dir;             # Remove tmp directory, if necessary
X
X    # Now look for a description of the package...
X    $describe = "";
X    $found = 0;
X    foreach (@sysinfo) {
X        next if /^\s*#/;    # Skip comments
X        next if /^\s*$/;    # Skip blank lines
X        next if /^\*\s+$system/ && ($found = 1);
X        last if $found && /^---|^\*/;        # Reached end of description
X        $describe .= "X" . $_ if $found;
X    }
X    $* = 1;
X    $describe =~ s/^X/\t/g;        # Indent description
X    $* = 0;
X
X    print XHEAD "System: $system";
X    print XHEAD " version $version" if $version !~ /---/;
X    print XHEAD "\nStatus: ";
X    print XHEAD $Maintained{$pname} ? "maintained" : "not maintained";
X    print XHEAD " (patches only)" if $Patch_only{$pname};
X    print XHEAD " (official patches available)" if $Patches{$pname};
X    print XHEAD "\n";
X    if ($Maintained{$pname}) {
X        if ($Patch_level{$pname} > 0) {
X            print XHEAD "Highest patch: #$Patch_level{$pname}\n";
X        } else {
X            print XHEAD "No patches yet\n";
X        }
X    } else {
X        print XHEAD "Patch level: #$Patch_level{$pname}\n"
X            if $Patch_level{$pname} > 0;
X    }
X    print XHEAD "\n";
X    print XHEAD "$describe\n" if $describe ne '';
X    print XHEAD "\n";
X}
Xprint XHEAD "-- $prog_name speaking for $cf'user\n";
Xclose XHEAD;
X
Xopen(XHEAD, "$tmp_mail") || &fatal("cannot open mail file");
Xopen(MAILER, "|$cf'sendmail $cf'mailopt $dest");
Xwhile (<XHEAD>) {
X    print MAILER;
X}
Xclose MAILER;
Xif ($?) {
X    &add_log("ERROR couldn't send list to $dest") if $loglvl > 0;
X} else {
X    &add_log("SENT list to $dest") if $loglvl > 2;
X}
Xclose XHEAD;
X
X&write_plsave;            # Write new patchlist file
X&clean_tmp;                # Remove temporary dirs/files
Xexit 0;                    # All OK
X
Xsub clean_dir {
X    chdir $cf'home;        # Leave [to be removed directory] first
X    if ($tmp ne '') {
X        system '/bin/rm', '-rf', $tmp if -d "$tmp";
X        &add_log("directory $tmp removed") if $loglvl > 19;
X        $tmp = "";
X    }
X}
X
Xsub clean_tmp {
X    &clean_dir;
X    unlink "$tmp_mail" if -f "$tmp_mail";
X}
X
X!NO!SUBS!
X$grep -v '^;#' pl/fatal.pl >>maillist
X$grep -v '^;#' pl/acs_rqst.pl >>maillist
X$grep -v '^;#' pl/free_file.pl >>maillist
X$grep -v '^;#' pl/add_log.pl >>maillist
X$grep -v '^;#' pl/read_conf.pl >>maillist
X$grep -v '^;#' pl/unpack.pl >>maillist
X$grep -v '^;#' pl/distribs.pl >>maillist
X$grep -v '^;#' pl/checklock.pl >>maillist
X$grep -v '^;#' pl/plsave.pl >>maillist
X$grep -v '^;#' pl/secure.pl >>maillist
Xchmod 755 maillist
X$eunicefix maillist
END_OF_FILE
  if test 7866 -ne `wc -c <'agent/maillist.SH'`; then
    echo shar: \"'agent/maillist.SH'\" unpacked with wrong size!
  fi
  chmod +x 'agent/maillist.SH'
  # end of 'agent/maillist.SH'
fi
if test -f 'agent/package.SH' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'agent/package.SH'\"
else
  echo shar: Extracting \"'agent/package.SH'\" \(8539 characters\)
  sed "s/^X//" >'agent/package.SH' <<'END_OF_FILE'
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
Xecho "Extracting agent/package (with variable substitutions)"
X$spitshell >package <<!GROK!THIS!
X$startperl
X    eval "exec perl -S \$0 \$*"
X        if \$running_under_some_shell;
X
X# $Id: package.SH,v 3.0 1993/11/29 13:48:32 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#  Original Author: Graham Stoney, 1993
X#
X# $Log: package.SH,v $
X# Revision 3.0  1993/11/29  13:48:32  ram
X# Baseline for mailagent 3.0 netwide release.
X#
X#
X
X\$cat = '$cat';
X\$zcat = '$zcat';
X\$mversion = '$VERSION';
X\$patchlevel = '$PATCHLEVEL';
X!GROK!THIS!
X$spitshell >>package <<'!NO!SUBS!'
X
X$userlist = "users";
X$prog_name = $0;                # Who I am
X$prog_name =~ s|^.*/(.*)|$1|;    # Keep only base name
X
X&read_config;        # First, read configuration file (in ~/.mailagent)
X
X# take job number and command from environment
X# (passed by mailagent)
X$jobnum = $ENV{'jobnum'};
X$fullcmd = $ENV{'fullcmd'};
X$pack = $ENV{'pack'};
X$path = $ENV{'path'};
X
X&read_dist;            # Read distributions
X
X$dest = shift;            # Who should the patches be sent to
X$system = shift;        # Which system do patches belong
X$version = shift;        # Which version it is
X$theirpl = shift;        # which patchlevel they've got
X$request = shift;        # what would they like to ask for
X
X# A single '-' as first argument stands for return path
X$dest = $path if $dest eq '-';
X
X# A single '-' for version means "highest available" version.
X$version = $Version{$system} if $version eq '-';
X
X# Convert empty pl to a dash
X$theirpl = '-' if $theirpl eq '';
X
X# Full name of system for H table access
X$pname = $system . "|" . $version;
X
X$maillist = "To obtain a list of what is available, send me the following mail:
X
X    Subject: Command
X    @SH maillist $path
X        ^ note the l";
X
Xif (!$System{$system}) {
X    open(MAILER, "|$cf'sendmail $cf'mailopt $path $cf'user");
X    print MAILER
X"To: $path
XSubject: No program called $system
XX-Mailer: mailagent [version $mversion PL$patchlevel]
X
XI have not heard of a program called $system.  Sorry.
X
X-- $prog_name speaking for $cf'user
X";
X    close MAILER;
X    &add_log("FAILED (UNKNOWN SYSTEM)") if $loglvl > 1;
X    exit 0;
X}
X
Xif (!$Program{$pname}) {
X    open(MAILER, "|$cf'sendmail $cf'mailopt $path $cf'user");
X    print MAILER
X"To: $path
XSubject: No package $system version $version
XX-Mailer: mailagent [version $mversion PL$patchlevel]
X
XI don't know anything about version $version of $system.  Sorry.";
X    if ($Version{$system} ne '') {
X        print MAILER "
X
X[The highest version for $system is $Version{$system}.]";
X        &add_log("MSG highest version is $Version{$system}")
X            if $loglvl > 8;
X    } else {
X        print MAILER "
X
X[There is no version number for $system.]";
X        &add_log("MSG no version number") if $loglvl > 8;
X    }
X    print MAILER "
X
X-- $prog_name speaking for $cf'user
X";
X    close MAILER;
X    &add_log("FAILED (BAD SYSTEM NUMBER)") if $loglvl > 1;
X    exit 0;
X}
X
X# If the request is not for the most recent version, warn the user and abort.
Xif ($version < $Version{$system}) {
X    open(MAILER, "|$cf'sendmail $cf'mailopt $path $cf'user");
X    print MAILER
X"To: $path
XSubject: Version $version of $system is out-of-date
XX-Mailer: mailagent [version $mversion PL$patchlevel]
X
XThis short note to warn you that $system version $version is not the
Xlattest one available. If you have some interest in $system, I suggest
Xyou upgrade by fetching version $Version{$system} as soon as possible.
X
X$maillist
X
XI did not record you as a $system user since your version is not the
Xone currently maintained.
X
X-- $prog_name speaking for $cf'user
X";
X    close MAILER;
X    &add_log("MSG old version $system $version") if $loglvl > 8;
X    exit 0;
X}
X
Xif (!($Maintained{$pname} || $Patches{$pname})) {
X    open(MAILER, "|$cf'sendmail $cf'mailopt $path $cf'user");
X    print MAILER
X"To: $path
XSubject: $system version $version is not maintained
XX-Mailer: mailagent [version $mversion PL$patchlevel]
X
XI can't keep you up to date on changes to version $version of $system, because
Xthis code is not maintained by $cf'name.
X
X-- $prog_name speaking for $cf'user
X";
X    close MAILER;
X    &add_log("FAILED (NOT MAINTAINED)") if $loglvl > 1;
X    exit 0;
X}
X
X# decode their request into a status letter.
X# they may be asking to be left alone.
Xif ((($theirpl eq '-') && $request eq '') ||
X    $request eq 'leavealone')        { $leavealone = 1; $letter = 'L'; }
Xelsif ($request eq '')            { $letter = 'U'; }    # just a user
Xelsif ($request eq 'mailpatches')    { $letter = 'M'; }    # want patches
Xelsif ($request eq 'notifypatches')    { $letter = 'N'; }    # notify only
Xelse {
X    open(MAILER, "|$cf'sendmail $cf'mailopt $path $cf'user");
X    print MAILER
X"To: $path
XSubject: I didn't understand your package command
XX-Mailer: mailagent [version $mversion PL$patchlevel]
X
XYour package command requested `$request', and I don't know what that means.
X
X-- $prog_name speaking for $cf'user
X";
X    close MAILER;
X    &add_log("FAILED (BAD REQUEST)") if $loglvl > 1;
X    exit 0;
X}
X
X# Go to the system directory.
Xchdir "$Location{$pname}" || &abort("cannot go to $Location{$pname}");
Xopen(PATCHLEVEL, "patchlevel.h") || &abort("cannot open patchlevel.h");
X$maxnum = 0;
Xwhile (<PATCHLEVEL>) {
X    if (/.*PATCHLEVEL[ \t]*(\d+)/) {
X        $maxnum = $1;
X        last;
X    }
X}
Xclose PATCHLEVEL;
X
X# if they have Configured a patchlevel which is not the latest, let them know.
Xif (!$leavealone && $theirpl ne '-' && $maxnum ne $theirpl) {
X    $upgrade = $theirpl + 1;
X
X    # In fact, if they've asked for patch mailing, send it directly. This
X    # works because our environment, set up by mailagent, will be propagated
X    # to the mailpatch command as-is.
X    if ($letter eq 'M') {
X        system('mailpatch', $dest, $system, $version, "$upgrade-");
X        if ($? == 0) {
X            &add_log("MAILED missing patches for $system $version to $dest")
X                if $loglvl > 6;
X        } else {
X            &add_log("WARNING unable to mail patches for $system $version")
X                if $loglvl > 1;
X        }
X    } else {
X        open(MAILER, "|$cf'sendmail $cf'mailopt $path $cf'user");
X        print MAILER
X"To: $dest
XSubject: The latest patchlevel for $system version $version is $maxnum
XX-Mailer: mailagent [version $mversion PL$patchlevel]
X
XJust a quick note to let you know that the latest patchlevel for $system
Xversion $version is $maxnum; if you are still at patchlevel $theirpl, I strongly
Xsuggest you upgrade by applying the more recent patches.
X
XYou can fetch these automatically by sending me the following mail:
X
X    Subject: Command
X    @SH mailpatch $dest $system $version $upgrade-
X           ^ note the c
X
X-- $prog_name speaking for $cf'user
X";
X        close MAILER;
X    }
X}
X
X# look for them in the userlist file
Xif (open(USERLIST,"<$userlist")) {
X    while (<USERLIST>) {
X        next if /^#/;
X        chop if /\n$/;
X        ($status, $pl, $name) = split;
X
X        # convert oldstyle user file format (dist 3.0 PL13).
X        unless (defined $name) {
X            $name = $pl;    # Shift left
X            $pl = '-';
X        }
X
X        # have we heard from them before?
X        if ($name eq $dest) {
X            $found = 1;
X            $status = $letter;
X            $pl = $theirpl if $theirpl ne '-';
X        }
X        push(@status, $status);
X        push(@pl, $pl);
X        push(@name, $name);
X    }
X    close USERLIST;
X}
X
X# add them if they're new.
Xif (!$found) {
X    push(@name, $dest);
X    push(@status, $letter);
X    push(@pl, $theirpl);
X}
X
X# write the file back out.
Xopen(USERLIST,">$userlist.new") || &abort("can't open new $userlist file");
X
Xfor ($i = 0; $i <= $#name; $i++) {
X    print USERLIST $status[$i], "\t", $pl[$i], "\t", $name[$i], "\n"
X        || &abort("error writing new $userlist file");
X}
Xclose(USERLIST) || &abort("error closing new $userlist file");
Xrename("$userlist.new", $userlist);
X
X# Emergency exit with clean-up
Xsub abort {
X    local($reason) = shift(@_);        # Why we are exiting
X    &fatal($reason);
X}
X
X!NO!SUBS!
X$grep -v '^;#' pl/fatal.pl >>package
X$grep -v '^;#' pl/add_log.pl >>package
X$grep -v '^;#' pl/read_conf.pl >>package
X$grep -v '^;#' pl/unpack.pl >>package
X$grep -v '^;#' pl/rangeargs.pl >>package
X$grep -v '^;#' pl/sendfile.pl >>package
X$grep -v '^;#' pl/distribs.pl >>package
X$grep -v '^;#' pl/secure.pl >>package
Xchmod 755 package
X$eunicefix package
END_OF_FILE
  if test 8539 -ne `wc -c <'agent/package.SH'`; then
    echo shar: \"'agent/package.SH'\" unpacked with wrong size!
  fi
  # end of 'agent/package.SH'
fi
if test -f 'agent/pl/file_edit.pl' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'agent/pl/file_edit.pl'\"
else
  echo shar: Extracting \"'agent/pl/file_edit.pl'\" \(8294 characters\)
  sed "s/^X//" >'agent/pl/file_edit.pl' <<'END_OF_FILE'
X;# $Id: file_edit.pl,v 3.0 1993/11/29 13:48:46 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: file_edit.pl,v $
X;# Revision 3.0  1993/11/29  13:48:46  ram
X;# Baseline for mailagent 3.0 netwide release.
X;#
X;#
X;# Inplace file edition. The routine is called as follows:
X;#
X;#   &file_edit(name, description, search, replace)
X;#
X;# where
X;#
X;# name: the path to the file
X;# description: a file description for logging purposes
X;# search: pattern to search, line number or function, undef to append. A
X;# pattern may be specified with // or with ??, in which case an insertion
X;# will be done at the end of the file if the pattern was not found.
X;# replace: string, undef to delete.
X;#
X;# To perform multiple edits simultaneously, use:
X;#
X;#    &file_edit(name, description, srch_1, rep_1, srch_2, rep_2, ...)
X;#
X;# followed by as many search/replace pairs as needed. The main advantage is
X;# that the file is locked only once, then all the edits are performed.
X;#
X# Inplace file edition, with one letter backup file. The routine returns a
X# success status, i.e. 1 if ok and 0 if anything went wrong.
Xsub file_edit {
X    local($name, $desc, @pairs) = @_;
X    local(@backup) = ('~', '#', '@', '%', '=');
X    local($bak);        # File used for backup
X    local(*OLD, *NEW);    # Localize filehandles
X    local($error) = 0;    # Error flag
X
X    return 1 unless @pairs;        # Nothing to do
X
X    if (-d $name) {
X        &add_log("ERROR cannot edit a directory!! ($name)") if $loglvl;
X        return 0;        # Failed
X    }
X
X    # First, lock file to prevent concurrent access
X    if (0 != &acs_rqst($name)) {
X        &add_log("WARNING cannot lock $desc file $name") if $loglvl > 5;
X    }
X
X    # If no search pattern are provided at all, then we only need to do some
X    # appending, and therefore need only the NEW file.
X    local($i);
X    local($need_editing) = 0;
X    for ($i = 0; $i < @pairs; $i += 2) {            # Scan only search items
X        $need_editing = 1 if defined $pairs[$i];    # Search pattern defined?
X        last if $need_editing;
X    }
X
X    # Now try to find a suitable backup character, which is only needed when
X    # we really need to search something for replacing. If we only append to
X    # the file, no backup is necessary.
X    if ($need_editing) {                # Not trying to append
X        foreach $c (@backup) {            # Loop for suitable backup char
X            unless (-e "$name$c") {        # No such file?
X                $bak = "$name$c";        # Ok, grab this extension
X                last;
X            }
X        }
X        unless ($bak) {                    # Nothing found?
X            &add_log("ERROR cannot create backup for $desc file $name")
X                if $loglvl;
X            &free_file($name);            # Release lock
X            return 0;                    # Error
X        }
X    }
X
X    # Open the necessary files, only NEW for appending, or OLD and NEW for
X    # editing (when a search pattern is provided).
X    if ($need_editing) {            # Not trying to append -> needs backup
X        unless (open(OLD, $name)) {
X            &add_log("ERROR cannot open $desc file $name: $!") if $loglvl;
X            &free_file($name);        # Release lock
X            return 0;                # Error
X        }
X        unless (open(NEW, ">$bak")) {
X            &add_log("ERROR cannot create backup for $desc file as $bak: $!")
X                if $loglvl;
X            close OLD;                # We won't need it anymore
X            &free_file($name);        # Release lock
X            return 0;                # Error
X        }
X    } else {                        # Merely trying to append to the old file
X        unless (open(NEW, ">>$name")) {
X            &add_log("ERROR cannot append to $desc file $name: $!")
X                if $loglvl;
X            &free_file($name);        # Release lock
X            return 0;                # Error
X        }
X        for ($i = 1; $i < @pairs; $i += 2) {        # Scan only replace items
X            next unless defined $pairs[$i];
X            unless (print NEW $pairs[$i], "\n") {
X                &add_log("SYSERR write: $!") if $loglvl;
X                $error++;
X            }
X            last if $error;            # Abort immediately if error
X        }
X        unless (close NEW) {
X            &add_log("SYSERR close: $!") if $loglvl;
X            $error++;
X        }
X        &free_file($name);            # Release lock
X        if ($error) {
X            &add_log("WARNING $desc file $name may be corrupted")
X                if $loglvl > 5;
X        }
X        return $error ? 0 : 1;        # Return success (1) if file not corrupted
X    }
X
X    local(@search);            # Searching patterns
X    local(@replace);        # Replacing strings
X    local(@insert);            # Insertion flag for ?? patterns
X    local(@type);            # Type of searching pattern
X
X    # Build the search and replacing arrays, a search/replace pair being
X    # identified by entries at the same index
X    for ($i = 0; $i < @pairs; $i++) {
X        push(@search, $pairs[$i++]);
X        push(@replace, $pairs[$i]);
X    }
X
X    # Here, we must go through the line by line scanning of the OLD file until
X    # a match occurs, at which time the replacing string is written (or the
X    # record skipped when the replacing string is not defined). The search
X    # string can be a verbatim string, a pattern, a numeric value understood as
X    # a line number or a function to call, giving the line as parameter, along
X    # with the current line number and understanding a true value as a match.
X    # If the search pattern is introduced by '?' instead of '/', then the
X    # replacement value is inserted at the end if no match occurred.
X
X    local($NUMBER, $STRING, $PATTERN, $SUB) = (0 .. 3);
X    local($_);
X
X    # Build type array and set up entries in @insert when ?? patterns are used
X    foreach (@search) {
X        unless (defined $_) {        # No search pattern means appending
X            push(@type, undef);
X            next;
X        }
X        if (/^\d+$/) {                # Plain value is a line number
X            push(@type, $NUMBER);
X            $_ = int($_);
X        } elsif (m|^([/?])|) {        # Looks like a pattern
X            push(@type, $PATTERN);
X            $insert[$#type] = 1 if $1 eq '?';
X            s|^[/?](.*)[/?]$|$1|;
X        } elsif (m|^&|) {        # Function to apply
X            push(@type, $SUB);
X            s/^&//;
X        } else {                            # Must be a verbatim string then
X            push(@type, $STRING);
X        }
X    }
X    local($.);
X    local($found);
X    local($val);        # Searching value
X    local($type);        # Current searching type
X    local($replace);    # Replacing value
X    local($studied);    # Was line studied?
X
X    # Now loop over the OLD file and write into NEW
X    while (<OLD>) {
X        chop;
X        $studied = @type < 3 ? 1 : 0;        # Do not study if small amount
X        $found = 0;
X        for ($i = 0; $i < @type; $i++) {
X            $type = $type[$i];
X            next unless defined $type;        # Already dealt with or no search
X            $val = $search[$i];                # Searching value
X            if ($type == $NUMBER && $. == $val) {
X                $type[$i] = undef;            # Avoid further inspection
X                $found++;
X            } elsif ($type == $STRING && $_ eq $val) {
X                $found++;
X            } elsif ($type == $PATTERN) {
X                study unless $studied++;    # Optimize pattern matching
X                ($found++, @insert[$i] = 0) if /$val/;
X            } elsif ($type == $SUB && &$val($_, $.)) {
X                $found++;
X            }
X            last if $found;
X        }
X        if ($found) {
X            $replace = $replace[$i];
X            if (defined $replace) {
X                (print NEW $replace, "\n") || $error++;
X            }
X        } else {
X            (print NEW $_, "\n") || $error++;
X        }
X        if ($error) {
X            &add_log("SYSERR write: $!") if $loglvl;
X            last;
X        }
X    }
X
X    # If insertion was wanted on no-match, and no error has ever occurred, then
X    # do the necessary insertions now. Also add all those replacing values
X    # associated with an undefined search string.
X
X    unless ($error) {
X        for ($i = 0; $i < @type; $i++) {
X            next unless $insert[$i] || !defined($type[$i]);
X            next unless defined $replace[$i];
X            (print NEW $replace[$i], "\n") || $error++;
X        }
X        &add_log("SYSERR write: $!") if $error && $loglvl;
X    }
X
X    # Edition is completed. Close files and make sure NEW is correctly flushed
X    # to disk by checking the return value from close.
X
X    close OLD;
X    unless (close NEW) {
X        &add_log("SYSERR close: $!") if $loglvl;
X        $error++;
X    }
X
X    # If no error has occurred so far, rename backup file as the original file
X    # name, in effect putting an end to the editing phase.
X
X    if ($error == 0 && !rename($bak, $name)) {
X        &add_log("SYSERR rename: $!") if $loglvl;
X        $error++;
X    }
X    &free_file($name);            # Lock may now safely be released
X
X    if ($error) {
X        &add_log("ERROR cannot inplace edit $desc file $name") if $loglvl;
X        unless (unlink $bak) {
X            &add_log("SYSERR unlink: $!") if $loglvl;
X            &add_log("ERROR cannot remove temporary file $bak") if $loglvl;
X        }
X        return 0;                # Editing failed
X    }
X
X    &add_log("edited $desc file $name") if $loglvl > 18;
X
X    1;        # Success
X}
X
END_OF_FILE
  if test 8294 -ne `wc -c <'agent/pl/file_edit.pl'`; then
    echo shar: \"'agent/pl/file_edit.pl'\" unpacked with wrong size!
  fi
  # end of 'agent/pl/file_edit.pl'
fi
if test -f 'agent/pl/mh.pl' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'agent/pl/mh.pl'\"
else
  echo shar: Extracting \"'agent/pl/mh.pl'\" \(8777 characters\)
  sed "s/^X//" >'agent/pl/mh.pl' <<'END_OF_FILE'
X;# $Id: mh.pl,v 3.0 1993/11/29 13:49:02 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: mh.pl,v $
X;# Revision 3.0  1993/11/29  13:49:02  ram
X;# Baseline for mailagent 3.0 netwide release.
X;#
X;#
X;# This set of routine handles MH-style folders, which differ from the
X;# traditional Unix-style folders by being directories, individual messages
X;# being stored in distinct files (numbers).
X;#
X;# Note: MH packed folders are simply MMDF-style mailboxes.
X;#
X#
X# MH-style saving routines
X#
X
Xpackage mh;
X
X# Attempt to save in a MH directory folder. Note that the profile entry
X# Msg-Protect is not honored (always 0600, mailagent's default).
Xsub save {
X    local($folder) = @_;        # MH folder name (without leading '+')
X    &profile;                    # Get MH profile, once and for all
X    $folder = "$cf'home/$Profile{'Path'}/$folder";
X    local($mode) = oct("0$Profile{'Folder-Protect'}" || '0700');
X    &'makedir($folder, $mode);    # Create folder dir with right permissions
X    &save_msg($folder, 'MH');    # Propagate failure status
X}
X
X# Save in a directory, not really an MH folder.
Xsub savedir {
X    local($folder) = @_;        # Directory folder name
X    &save_msg($folder, 'DIR');    # Propagate failure status
X}
X
X# Common subroutine to &save and &savedir
Xsub save_msg {
X    local($folder, $mh) = @_;
X    unless (-d $folder) {
X        &'add_log("ERROR $mh folder $folder is not a directory")
X            if $'loglvl > 1;
X        return 1;    # Failed
X    }
X    local($name) = &new_msg($folder);
X    unless ($name) {
X        &'add_log("ERROR cannot get message number in $mh folder $folder")
X            if $'loglvl > 1;
X        return 1;    # Failed
X    }
X
X    # Now initiate saving by opening file for appending, then calling the
X    # MMDF-style saving routine with MH type (skips emission of ^A lines).
X
X    unless (open(MHMSG, ">>$name")) {
X        &'add_log("ERROR cannot reopen $name: $!") if $'loglvl > 1;
X        return 1;    # Failed, don't unlink message
X    }
X
X    # There is no need to lock the file here, since MH will never select an
X    # existing file when computing a new message number.
X
X    local($failed, $amount) = &mmdf'save_mmdf(*MHMSG, 'MH');
X
X    # Now the size of the message must be *exactly* the amount returned.
X    close MHMSG;
X    local($size) = -s $name;
X
X    &'add_log("ERROR $name has $size bytes (should have $amount)")
X        if $size != $amount && $loglvl;
X
X    $failed = 1 if $size != $amount;
X
X    # Update the unseen sequence, if needed and saving succeeded. An entry
X    # is also made in the logfile for easy grep'ing and locating of messages
X    # saved in directories.
X
X    &unseen($name)
X        if $mh eq 'MH' && $Profile{'Unseen-Sequence'} ne '' && !$failed;
X
X    &'add_log("UNSEEN $name") if $'loglvl > 6;    # Mark clearly in log
X    return $failed;        # Return failure status
X}
X
X#
X# MH profile and sequence management.
X#
X
X# Read MH profile, fill in %Profile entries.
Xsub profile {
X    return if defined %Profile;
X    # Make sure there is at least a valid Path entry, in case they made a
X    # mistake and asked for MH folder saving without a valid .mh_profile...
X    local($dflt) = defined($'XENV{'maildir'}) ? $'XENV{'maildir'} : 'Mail';
X    $dflt = &'tilda($dflt);        # Restore possible leading '~'
X    $dflt =~ s|^~/||;            # Strip down (relative path under ~)
X    $Profile{'Path'} = $dflt;
X    local($mhprofile) = &'tilda_expand($cf'mhprofile || '~/.mh_profile');
X    unless (open(PROFILE, $mhprofile)) {
X        &'add_log("ERROR cannot open MH profile '$mhprofile': $!")
X            if $'loglvl > 1;
X        return;
X    }
X    local($_);
X    while (<PROFILE>) {
X        next unless /^([^:]+):\s*(.*)/;
X        $Profile{$1} = $2;
X    }
X    close PROFILE;
X}
X
X# Compute new message number/name.
X# If true MH folder, get next available number. If directory, see if there is
X# a .msg_prefix file to use as a basename. Otherwise, select an MH message
X# number.
Xsub new_msg {
X    local($dir) = @_;
X    unless (opendir(DIR, $dir)) {
X        &'add_log("ERROR unable to open dir $dir: $!") if $'loglvl > 1;
X        return 0;        # Marks failure
X    }
X    if (0 != &'acs_rqst($dir)) {
X        &'add_log("WARNING could not lock dir $dir") if $'loglvl > 5;
X    }
X    local(@dir) = readdir DIR;        # Slurp it as a whole
X    closedir DIR;
X
X    # See if we have to use message prefix
X    local($prefix) = $cf'msgprefix || '.msg_prefix';
X    local($msg) = "$dir/$prefix";
X    local($msg_prefix) = '';
X    if (-f $msg) {                    # Not an MH folder it would seem
X        unless (open(PREFIX, $msg)) {
X            &'add_log("ERROR can't open msg prefix $msg: $!") if $'loglvl > 1;
X            # Continue, will use MH-style numbering then
X        } else {
X            chop($msg_prefix = <PREFIX>);    # First line gives prefix
X            close PREFIX;
X        }
X    }
X
X    # If prefix is used, keep only those messages starting with that prefix.
X    # Otherwise, keep only numbers.
X    local($pat) = $msg_prefix eq '' ? '/^\d+$/' : "s/^$msg_prefix(\\d+)\$/\$1/";
X    eval '@dir = grep(' . $pat . ', @dir)';
X
X    # Now sort in ascending order and get highest number
X    @dir = sort { $a <=> $b; } @dir;
X    local($highest) = pop(@dir);
X
X    # Now create new message before unlocking the directory. Use appending
X    # instead of plain creation in case our lock was not honoured for some
X    # reason.
X    $highest++;
X    local($new) = "$dir/$msg_prefix$highest";
X    unless (open(NEW, ">>$new")) {
X        &'add_log("ERROR cannot create $msg: $!") if $'loglvl > 1;
X        $new = 0;    # Signal no creation (directory still locked)
X    } else {
X        close NEW;    # File is now created
X    }
X
X    &'free_file($dir);        # Unlock directory
X    return $new;            # Return message name, or 0 if error
X}
X
X# Mark MH message as unseen by adding it to the sequences listed in the
X# profile entry Unseen-Sequence.
Xsub unseen {
X    local($name) = @_;        # Full path of unseen mail message
X    local($dir, $num) = $name =~ m|(.*)/(\d+)|;
X    unless ($num) {
X        &'add_log("WARNING cannot mark $name as unseen (not an MH message)")
X            if $'loglvl > 5;
X        return;
X    }
X
X    # Lock the .mh_sequences file first. It's a pity MH does not itself lock
X    # this file when syncing it... (routine m_sync() in MH 6.8).
X
X    local($seqfile) = "$dir/.mh_sequences";
X    if (0 != &'acs_rqst($seqfile)) {
X        &'add_log("WARNING could not lock MH sequence in $dir")
X            if $'loglvl > 5;
X    }
X
X    # Create new .mh_sequences file
X    unless (open(MHSEQ, ">$seqfile.x")) {
X        &'add_log("ERROR cannot create new MH sequence file in $dir: $!")
X            if $'loglvl > 1;
X        &'free_file($seqfile);
X        return;
X    }
X
X    open(OLDSEQ, $seqfile);    # May not exist yet, so no error check
X
X    # Get the name of the sequences we need to update, save in %seq.
X    local(%seq);
X    foreach $seq (split(/,/, $Profile{'Unseen-Sequence'})) {
X        $seq =~ s/^\s*//;    # Remove leading and trailing spaces
X        $seq =~ s/\s*$//;
X        $seq{$seq}++;        # Record unseen sequence
X    }
X
X    # Now loop over the existing sequences in the old .mh_sequences file
X    # and update them. If some unseen sequences were not present yet, create
X    # them.
X
X    local($_);
X    local($seqname);
X
X    while (<OLDSEQ>) {
X        if (s/^(\S+)://) {    # Found a sequence
X            $seqname = $1;
X            unless (defined $seq{$seqname}) {
X                print MHSEQ "$seqname:", $_;
X                next;
X            }
X            # Ok, it's an useen sequence and we need to update it
X            chop;
X            print MHSEQ "$seqname: ", &seqadd($_, $num), "\n";
X            delete $seq{$seqname};
X        } else {
X            print MHSEQ $_;    # Whatever it was, propagate it
X        }
X    }
X    close OLDSEQ;
X
X    foreach $seq (keys %seq) {    # Create remaining sequences
X        print MHSEQ "$seq: $num\n";
X    }
X    close MHSEQ;
X
X    unless (rename("$seqfile.x", $seqfile)) {
X        &'add_log("ERROR cannot rename $seqfile.x as $seqfile: $!")
X            if $'loglvl > 1;
X    }
X
X    &'free_file($seqfile);
X}
X
X# Add a message to an MH sequence (sorted on input).
Xsub seqadd {
X    local($seq, $num) = @_;
X    local(@seq) = split(' ', $seq);
X    local($min, $max);    # Ranges in sequences are min-max
X    local($i);
X    local(@new);        # New sequence we are building
X    local($item);        # Current item
X    for ($i = 0; $i < @seq; $i++) {
X        $item = $seq[$i];
X        if ($num == 0) {    # Message already inserted
X            push(@new, $item);
X            next;            # Flush sequence
X        }
X        if ($item =~ /-/) {
X            ($min, $max) = $item =~ /(\d+)-(\d+)/;
X        } else {
X            $min = $max = $item;
X        }
X        if ($num > $max) {    # New message has to be inserted later on
X            if ($num == $max + 1) {
X                push(@new, "$min-$num");
X                $num = 0;    # Signals: inserted
X            } else {
X                push(@new, $item);
X            }
X            next;
X        }
X        # Here, $num <= $max
X        if ($num < $min) {    # Item to be inserted before
X            if ($num == $min - 1) {
X                push(@new, "$num-$max");
X            } else {
X                push(@new, $num);
X                push(@new, $item);
X            }
X        } else {
X            push(@new, $item);    # Item already within that range !?
X        }
X        $num = 0;                # Item was inserted
X    }
X    push(@new, $num) if $num;    # At sequence's tail if not inserted yet
X    return join(' ', @new);        # Return new sequence
X}
X
Xpackage main;
X
END_OF_FILE
  if test 8777 -ne `wc -c <'agent/pl/mh.pl'`; then
    echo shar: \"'agent/pl/mh.pl'\" unpacked with wrong size!
  fi
  # end of 'agent/pl/mh.pl'
fi
if test -f 'agent/pl/power.pl' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'agent/pl/power.pl'\"
else
  echo shar: Extracting \"'agent/pl/power.pl'\" \(8058 characters\)
  sed "s/^X//" >'agent/pl/power.pl' <<'END_OF_FILE'
X;# $Id: power.pl,v 3.0 1993/11/29 13:49:08 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: power.pl,v $
X;# Revision 3.0  1993/11/29  13:49:08  ram
X;# Baseline for mailagent 3.0 netwide release.
X;#
X;#
X;# Power manipulation package. Each power is stored in the 'passwd' file and
X;# is protected by a password. Additionally, a list of authorized e-mail
X;# addresses is stored in 'powedir'. When the power name is longer than 12
X;# characters, it is aliased in the 'powerlist' file. This is to ensure that
X;# no filesystem limit will get into the way, ever (2 characters are reserved
X;# at the end for temporary backup, hence the limit fixed to 12).
X;#
X#
X# Power control
X#
X
Xpackage power;
X
X# Grant power to user, returning 1 if ok, 0 if failed.
Xsub grant {
X    local($name, $clear_passwd, $user) = @_;
X    unless (&'file_secure($cf'passwd, 'password')) {
X        &add_log("WARNING cannot grant power '$name'") if $'loglvl > 5;
X        return 0;        # Failed
X    }
X    unless (&valid($name, $clear_passwd)) {
X        &add_log("ERROR user '$user' gave invalid password for power '$name'")
X            if $'loglvl > 1;
X        return 0;        # Power not granted
X    }
X    unless (&authorized($name, $user)) {
X        &add_log("ERROR user '$user' may not request power '$name'")
X            if $'loglvl > 1;
X        return 0;        # Power not granted
X    }
X    1;            # Power may be granted
X}
X
X# Check whether user is authorized to get this power or change its password.
X# Returns 1 if user may proceed, 0 otherwise.
Xsub authorized {
X    local($name, $user) = @_;
X    local($auth) = &authfile($name);
X    unless (&'file_secure($auth, 'authentication')) {
X        &add_log("WARNING cannot authenticate power '$name'") if $'loglvl > 5;
X        return 0;        # Failed
X    }
X    unless (open(AUTH, $auth)) {
X        &add_log("ERROR cannot open auth file $auth for power '$name': $!")
X            if $'loglvl > 1;
X        return 0;        # Cannot verify identity -> cannot grant power
X    }
X    local($_);
X    local($ok) = 0;
X    study $user;                # Various searches will be attempted
X    while (<AUTH>) {
X        chop;
X        $_ = &'perl_pattern($_);    # Shell style patterns may be used
X        if ($user =~ /^$_$/) {        # User may request for this power
X            $ok = 1;                # Ok, we found him
X            last;
X        }
X    }
X    close(AUTH);
X    $ok;            # Boolean status
X}
X
X# Check whether a power password is valid or not. Returns 0 if password is
X# invalid or the power is undefined, 1 when password is ok.
Xsub valid {
X    local($name, $clear_passwd) = @_;
X    unless (&'file_secure($cf'passwd, 'password')) {
X        &add_log("WARNING cannot verify password for power '$name'")
X            if $'loglvl > 5;
X        return 0;        # Failed
X    }
X    local($power, $passwd, $comment) = &getpwent($name);
X    return 0 unless defined $power;            # Unknown power -> illegal password
X    if ($passwd =~ s/^<(.*)>$/$1/) {        # Password given as <clear>
X        $clear_passwd eq $passwd;
X    } else {                                # Password encrypted
X        crypt($clear_passwd, $passwd) eq $passwd;
X    }
X}
X
X#
X# Power aliases
X#
X
X# Compute file name where list of authorized users is kept.
Xsub authfile {
X    local($name) = @_;
X    return $cf'powerdir . "/$name" if length($name) <= 12;
X    unless (open(ALIASES, $cf'powerlist)) {
X        &add_log("ERROR cannot open power list $cf'powerlist: $!")
X            if $'loglvl > 1;
X        return '/dev/null';
X    }
X    local($_);
X    local($power, $alias);
X    while (<ALIASES>) {
X        ($power, $alias) = split(' ');
X        if ($power eq $name) {
X            close ALIASES;
X            return $cf'powerdir . "/$alias"
X        }
X    }
X    close ALIASES;
X    return '/dev/null';
X}
X
X# Set clearance file, returning 1 for success, 0 for failure
Xsub set_auth {
X    local($name, *text) = @_;
X    local($file) = &authfile($name);
X    if (-e $file) {
X        unless (unlink $file) {
X            &add_log("SYSERR unlink: $!") if $'loglvl;
X            &add_log("WARNING appending to $file (should have replaced it)")
X                if $'loglvl > 5;
X        }
X    }
X    local($ok) =
X        &'file_edit($file, 'power clearance', undef, join("\n", @text));
X    $ok;
X}
X
X# Append users to clearance file, returning 1 on success and 0 on failure
Xsub add_auth {
X    local($name, *text) = @_;
X    local($file) = &authfile($name);
X    local($ok) =
X        &'file_edit($file, 'power clearance', undef, join("\n", @text));
X    $ok;
X}
X
X# Remove users from clearance file, returning 1 on success and 0 on failure
Xsub rem_auth {
X    local($name, *text) = @_;
X    local($file) = &authfile($name);
X    local(@pairs);    # Search/replace pairs for file_edit
X    foreach $addr (@text) {
X        push(@pairs, $addr, undef);
X    }
X    local($ok) = &'file_edit($file, 'power clearance', @pairs);
X    $ok;
X}
X
X# Is alias already used?
Xsub used_alias {
X    local($alias) = @_;
X    open(ALIAS, $cf'powerlist) || return 0;
X    local($_);
X    local($pow, $ali);
X    local($found) = 0;
X    while (<ALIAS>) {
X        ($pow, $ali) = split(' ');
X        $found = 1 if $ali eq $alias;
X        last if $found;
X    }
X    close ALIAS;
X    $found;        # Return true when alias already used
X}
X
X# Add new power alias, returning 1 for ok and 0 for failure.
Xsub add_alias {
X    local($power, $alias) = @_;
X    local($ok) =
X        &'file_edit($cf'powerlist, 'power aliases', undef, "$power $alias");
X    &add_log("aliased power '$power' into '$alias'") if $'loglvl > 6 && $ok;
X    $ok;
X}
X
X# Delete power from alias file, returning 1 for ok and 0 for failure.
Xsub del_alias {
X    local($power) = @_;
X    local($ok) =
X        &'file_edit($cf'powerlist, 'power aliases', "/^$power\\s/", undef);
X    &add_log("ERROR cannot delete power '$power' from aliases")
X        if $'loglvl > 1 && !$ok;
X    &add_log("deleted power '$power' from aliases")
X        if $'loglvl > 6 && $ok;
X    $ok;
X}
X
X#
X# Setting password information
X#
X
X# Set power password, returning 0 if ok, -1 for failure
Xsub set_passwd {
X    local($name, $clear_newpasswd) = @_;
X
X    # Make sure entry already exists (i.e. power is defined)
X    local($power, $passwd, $comment) = &getpwent($name);
X    return -1 unless defined $power;        # Unknown power
X
X    # Choose a salt randomly, using the two lowest bytes of current time stamp
X    local($t) = time;
X    local($c1, $c2) = ($t, $t & 0xffff);
X    $c1 -= ($t & 0xff) * ($c2 + (($t & 0xffff0000) >> 16));
X    $c1 = $c1 > 0 ? $c1 : -$c1;
X    local(@saltset) = ('a' .. 'z', 'A' .. 'Z', '0' .. '9', '.', '/');
X    local($salt) = $saltset[$c1 % @saltset] . $saltset[$c2 % @saltset];
X    $passwd = crypt($clear_newpasswd, $salt);
X
X    # Set new password entry
X    &setpwent($power, $passwd, $comment);    # Propagate status
X}
X
X# Get password entry, and return ($power, $password, $comment) if found or
X# undef if error or not found.
Xsub getpwent {
X    local($wanted) = @_;        # Power entry wanted
X    unless (open(PASSWD, "$cf'passwd")) {
X        &add_log("ERROR cannot open password file: $!") if $'loglvl;
X        return undef;
X    }
X    local($power, $password, $comment);
X    local($_);
X    while (<PASSWD>) {
X        chop;
X        ($power, $password, $comment) = split(/:/);
X        if ($power eq $wanted) {
X            close PASSWD;
X            return ($power, $password, $comment);
X        }
X    }
X    close PASSWD;
X    undef;            # Not found
X}
X
X# Set password entry, given ($power, $password, $comment) and return 0 for
X# success, -1 on failure.
Xsub setpwent {
X    local($power, $password, $comment) = @_;
X    local($ok) = &'file_edit(
X        $cf'passwd, 'password',
X        "?^$power:?", "$power:$password:$comment"
X    );
X    &add_log("ERROR cannot set new password entry for '$power'")
X        if $'loglvl > 1 && !$ok;
X    $ok ? 0 : -1;
X}
X
X# Remove passoword entry, returning 0 for success and -1 on failure.
Xsub rempwent {
X    local($power) = @_;
X    local($ok) = &'file_edit(
X        $cf'passwd, 'password',
X        "/^$power:/", undef
X    );
X    &add_log("ERROR cannot remove password entry for '$power'")
X        if $'loglvl > 1 && !$ok;
X    $ok ? 0 : -1;
X}
X
X#
X# Logging control
X#
X
X# Replaces main'add_log by remapping to powerlog...
X# Opens new user-defined logfile 'powerlog' to extract power-related
X# messages there. If not defined in ~/.mailagent, messages will go to the
X# default log file. A copy of the log message is kept there anyway.
Xsub add_log {
X    local($msg) = @_;
X    &usrlog'new('powerlog', $cf'powerlog, 'COPY') if $cf'powerlog;
X    &'usr_log('powerlog', $msg);
X}
X
Xpackage main;
X
END_OF_FILE
  if test 8058 -ne `wc -c <'agent/pl/power.pl'`; then
    echo shar: \"'agent/pl/power.pl'\" unpacked with wrong size!
  fi
  # end of 'agent/pl/power.pl'
fi
if test -f 'misc/README' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'misc/README'\"
else
  echo shar: Extracting \"'misc/README'\" \(192 characters\)
  sed "s/^X//" >'misc/README' <<'END_OF_FILE'
XThis directory contains:
X
X    - unkit: an example of filtering command extension
X    - shell: an example of server command
X
XThose files are not installed, they are only provided as living examples.
END_OF_FILE
  if test 192 -ne `wc -c <'misc/README'`; then
    echo shar: \"'misc/README'\" unpacked with wrong size!
  fi
  # end of 'misc/README'
fi
echo shar: End of archive 15 \(of 26\).
cp /dev/null ark15isdone
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...