Source Code 1994 March/Source_Code_CD-ROM_Walnut_Creek_March_1994.iso/compsrcs/misc/volume34/mserv/part04

Text File | 1993-01-05 | 59.5 KB | 2,324 lines

Newsgroups: comp.sources.misc
From: [e-mail] (Johan Vromans)
Subject: v34i095:  mserv - Squirrel Mail Server Software, version 3.1, Part04/06
Message-ID: <[e-mail]>
X-Md4-Signature: 14efc7190c4ec552c8b196893b9b0c55
Date: Thu, 7 Jan 1993 03:49:10 GMT
Approved: [e-mail]

Submitted-by: [e-mail] (Johan Vromans)
Posting-number: Volume 34, Issue 95
Archive-name: mserv/part04
Environment: Perl
Supersedes: mserv-3.0: Volume 30, Issue 46-49

#! /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".
# Contents:  mserv-3.1/ChangeLog mserv-3.1/chkconfig.pl
#   mserv-3.1/dorequest.pl mserv-3.1/pr_parse.pl
# Wrapped by kent@sparky on Wed Jan  6 21:39:47 1993
PATH=/bin:/usr/bin:/usr/ucb:/usr/local/bin:/usr/lbin ; export PATH
echo If this archive is complete, you will see the following message:
echo '          "shar: End of archive 4 (of 6)."'
if test -f 'mserv-3.1/ChangeLog' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'mserv-3.1/ChangeLog'\"
else
  echo shar: Extracting \"'mserv-3.1/ChangeLog'\" \(18184 characters\)
  sed "s/^X//" >'mserv-3.1/ChangeLog' <<'END_OF_FILE'
XTue Jan  5 19:43:53 1993  Johan Vromans  (jv@squirrel)
X
X    * patchlevel.h 1.19:
X    * ms_common.pl 1.38:
X      Bump to V3.01.
X
X    * mservmgr.txt 1.12:
X    * usrguide.txt 1.12:
X    * mservmgr.txt 1.11:
X      Update to V3.01.
X
X    * README 3.11:
X      Replaced.
X
XSat Jan  2 14:21:36 1993  Johan Vromans  (jv@squirrel)
X
X    * usrguide.txt 1.11:
X      Small updates.
X
X    * pr_dowork.pl 3.24:
X      Fix typo in encoding messages.
X
X    * pr_help.pl 1.6:
X      Add support for @black_list and $black_list_warning.
X
X    * process.pl 3.67:
X      Improve subs errmsg and warning (allow multiple lines).
X      Only verify the recipient name in the UUCP/RFC822 headers
X      against the black list.
X      Add support for $black_list_warning.
X
X    * chkconfig.pl 1.32:
X      Provide $black_list_warning so offending users get a warning
X      instead of being rejected.
X
XFri Jan  1 15:19:18 1993  Johan Vromans  (jv@squirrel)
X
X    * usrguide.txt 1.10:
X    * mservmgr.txt 1.10:
X      Update to Y3.01Q.
X
X    * pr_help.pl 1.5:
X    * process.pl 3.66:
X    * ud_sample1.pl 1.3:
X    * ud_sample2.pl 1.3:
X      Redesign the auto-configuring help system.
X
X    * pr_parse.pl 1.7:
X      Use sub warning where appropriate.
X      Add sub check_ftp (from process.pl).
X
X    * process.pl 3.65:
X      Add support for @black_list (subs discard and verify_recipient).
X      Add a real warning routine.
X      Prefix messages with Warning: or Error: .
X      Move sub check_ftp to pr_parse.pl.
X      Clarify $ftp_uucp_only restriction.
X      Add hint for $prefer_uucp case.
X
X    * chkconfig.pl 1.31:
X      Add support for @black_list.
X
X    * ms_common.pl 1.37:
X      Bump to Y3.01Q.
X      Add @black_list consistency check.
X
X    * patchlevel.h 1.18:
X      Bump to Y3.01Q.
X
XThu Dec 31 15:20:14 1992  Johan Vromans  (jv@squirrel)
X
X    * pr_ftp.pl 1.6:
X      Handle symlinks on FTP servers. Chase them if possible.
X      Do not switch ftp'type that often.
X
X    * process.pl 3.64:
X      Add '-nointeractive' option.
X
XWed Dec 30 14:31:42 1992  Johan Vromans  (jv@squirrel)
X
X    * patchlevel.h 1.17:
X    * ms_common.pl 1.36:
X      Bump to Y3.01P.
X
X    * usrguide.txt 1.9:
X      Add COMPRESS and ENCODING commands.
X      Document FTP restrictions in case of unknown email address.
X
X    * pr_parse.pl 1.6:
X      Move common code of subs command_loop and interactive loop to
X      sub split_and_exec_line.
X      Add sub cmd_ignore as helper.
X      Inititalize REPLY and RESET to ingore in interactive mode.
X      Add COMPRESS and ENCODE commands.
X
X    * pr_help.pl 1.4:
X      Add ENCODING command help.
X
X    * pr_dowork.pl 3.23:
X      Sort encoding messages on encoding key.
X
X    * pr_dowork.pl 3.22:
X      Make work_loop settings ($limit, $encoding, ...) retain their
X      values between calls.
X      Use $uunote for FTP password if no recipient known (i.e. in
X      interactive use).
X
X    * ftp.pl 1.3:
X      Show password string if user is anonymous.
X
XFri Dec 25 16:22:36 1992  Johan Vromans  (jv@squirrel)
X
X    * do_report.pl 1.13:
X    * report.pl 3.14:
X      Correct formfeeds between reports.
X
XThu Dec 24 17:31:06 1992  Johan Vromans  (jv@squirrel)
X
X    * patchlevel.h 1.16:
X    * ms_common.pl 1.35:
X      Bump to Y3.01O.
X
X    * usrguide.txt 1.8:
X    * mservmgr.txt 1.9:
X      Update to Y3.01O.
X
X    * pr_dowork.pl 3.21:
X    * chkconfig.pl 1.30:
X    * ms_common.pl 1.34:
X      Add auto-packing.
X      A request for 'file.XXX' will be turned into a packed
X      request for directory 'file'. XXX must be 'zoo', 'zip', 'tar' or
X      'tar.Z'.
X
X    * ms_common.pl 1.33:
X    * pr_dowork.pl 3.20:
X    * chkconfig.pl 1.29:
X      Add auto-compression.
X      A request for 'file.Z' may be turned into 'file' (with
X      compression by 'dorequest') if $auto_compress is set in the
X      config file.
X
X    * process.pl 3.63:
X    * pr_parse.pl 1.5:
X      Adapt more commands to interactive use.
X
XWed Dec 23 22:52:47 1992  Johan Vromans  (jv@squirrel)
X
X    * process.pl 3.62:
X      Start dorequest only if the queue is not empty.
X
X    * process.pl 3.61:
X      Add (undocumented) -i0 option to be called from inetd.
X
X    * report.pl 3.13:
X    * mlistener.pl 1.7:
X    * makeindex.pl 1.11:
X    * dorequest.pl 3.28:
X    * do_report.pl 1.12:
X    * chkconfig.pl 1.28:
X      Require ms_common.pl before &usage to supply defaults.
X
X    * patchlevel.h 1.15:
X    * ms_common.pl 1.32:
X      Bump to Y3.01N.
X
X    * usrguide.txt 1.7:
X    * mservmgr.txt 1.8:
X    * README 3.10:
X    * MANIFEST 1.15:
X    * MANIFEST 1.14:
X    * pr_doindex.pl 3.4:
X    * pr_dowork.pl 3.19:
X    * pr_parse.pl 1.4:
X    * process.pl 3.60:
X    * process.pl 3.59:
X      Implement interactive mode.
X
XSat Dec 19 00:15:16 1992  Johan Vromans  (jv@squirrel)
X
X    * mservmgr.txt 1.7:
X      Update to Y3.01M.
X
X    * MANIFEST 1.13:
X      Add ud_sample?.pl files.
X      Remove userdefs.pl.
X
X    * README 3.9:
X      Small updates.
X
X    * ud_sample1.pl 1.2 (new file):
X      Sample userdefs: REPORT command.
X
X    * ud_sample2.pl 1.2 (new file):
X        Sample userdefs: SEND CONFIG command.
X
X    * patchlevel.h 1.14:
X    * ms_common.pl 1.31:
X      Bump to Y3.01M.
X
X    * pr_dowork.pl 3.18:
X      Prevent empty 'coding' messages.
X
X    * mservmgr.txt 1.6:
X      Document extending the command set.
X
X    * chkconfig.pl 1.27:
X    * pr_ftp.pl 1.5:
X      Prevent muliple inclusion of 'ftp.pl'.
X
XFri Dec 18 12:55:17 1992  Johan Vromans  (jv@squirrel)
X
X    * chkconfig.pl 1.26:
X    * ms_config.pl:
X      Add $cmd_extend.
X
X    * pr_dowork.pl 3.17:
X      Make work queue execution table driven.
X
X    * MANIFEST 1.12:
X      Add userdefs.pl, pr_parse.pl.
X
X    * pr_help.pl 1.3:
X      Add support for user defined help.
X
X    * process.pl 3.58:
X      Moved command loop to pr_parse.pl.
X
X    * pr_parse.pl 1.3:
X    * pr_parse.pl 1.2 (new file):
X      Implements the command_loop and command parsing.
X      The command loop is now table driven.
X
X    * userdefs.pl 1.3:
X    * userdefs.pl 1.2 (new file):
X      Sample user definition file.
X
X    * do_report.pl 1.11:
X      Correct unlinking algorithm.
X      Allow ftp scan independent of reports.
X      Add -ftpkeep options to override config value.
X
XTue Dec 15 23:17:20 1992  Johan Vromans  (jv@squirrel)
X
X    * usrguide.txt 1.6:
X    * mservmgr.txt 1.5:
X      Update to Y3.01L.
X
X    * patchlevel.h 1.13:
X      Bump to Y3.01L.
X
X    * pr_dowork.pl 3.16:
X      Reduce formats to one single format for both email and uucp.
X      Be very friendly with the feedback on encodings.
X
X    * process.pl 3.57:
X      Move formats for request reports to pr_dowork.pl.
X
X    * dr_uucp.pl 3.7:
X      Use &canon_fname to construct the UUCP file name.
X
X    * pr_ftp.pl 1.4:
X      Move sub ftp_archname to ms_common.pl.
X
X    * ms_common.pl 1.30:
X    * ms_common.pl 1.29:
X      Bump to Y3.01L.
X      Add sub canon_fname (new) and ftp_archname (from pr_ftp.pl).
X
XSun Dec 13 21:04:19 1992  Johan Vromans  (jv@squirrel)
X
X    * MANIFEST 1.11:
X      Add pr_help.pl.
X
X    * pr_help.pl 1.2:
X    * process.pl 3.56:
X      Move sub help to pr_help.pl.
X
X    * pr_dowork.pl 3.15:
X    * usrguide.txt 1.5:
X      Add enhanced 'encoding' message.
X
X    * usrguide.txt 1.4:
X    * mservmgr.txt 1.4:
X      Misc.
X
X    * CRONTAB.sample 1.3:
X      Add -ftp -ftpclean
X
X    * chkconfig.pl 1.25:
X      Add ARCHIE command.
X
XSat Dec 12 00:13:13 1992  Johan Vromans  (jv@squirrel)
X
X    * process.pl 3.55:
X      Catch STDERR on output.
X      Move sub enqueue to pr_dowork.pl.
X      Move sub fttemp to ms_common.pl.
X      Add ARCHIE command.
X
X    * pr_dowork.pl 3.14:
X      Add ARCHIE command.
X      Move sub enqueue from process.pl.
X      Support automatic compression.
X      Adapt to new queue file format (tab separated, same arguments
X      for mail and uucp).
X
X    * dr_pack.pl 3.3:
X    * dr_mail.pl 3.5:
X    * dr_uucp.pl 3.6:
X    * dorequest.pl 3.27:
X    * dorequest.pl 3.25:
X    * dorequest.pl 3.26:
X      Support automatic compression.
X      Adapt to new queue file format.
X
X    * unpack.pl 2.5:
X      Add support for compressed encoding.
X
X    * patchlevel.h 1.12:
X    * ms_common.pl 1.28:
X      Bump to Y3.01K.
X      Add fttemp routine from process.pl
X
X    * report.pl 3.12:
X      Allow blanks in package entries in logfile.
X
XThu Dec 10 15:41:48 1992  Johan Vromans  (jv@largo)
X
X    * pr_ftp.pl 1.3:
X      Add support for VMS filenames.
X      (Not directory info...
X
X    * mservmgr.txt 1.2:
X      New install guide. Rewritten, enhanced....
X
X    * chkconfig.pl 1.24:
X      Add -current to force using the current directory instead of
X      LIBDIR.
X
XSun Dec  6 16:04:09 1992  Johan Vromans  (jv@squirrel)
X
X    * usrguide.txt 1.2:
X      New user guide. Rewritten, enhanced....
X
X    * ftp.pl 1.2:
X      Require 'sys/socket.ph' instead of 'socket.ph'.
X
XSat Dec  5 01:29:11 1992  Johan Vromans  (jv@squirrel)
X
X    * ================ Released Y3.01J ================
X
X    * do_report.pl 1.10:
X      Add report/cleanup FTP cache.
X
X    * process.pl 3.54:
X      Allow continuation lines.
X      Remove CD command (too dangerous).
X      Add FTP info in HELP.
X
X    * HELP 3.12:
X      Add documentation on FTP commands.
X
X    * chkconfig.pl 1.23:
X      Add $ftp_keep.
X
X    * ms_config.pl:
X      Add more documentation.
X      Add $ftp_keep.
X
X    * ms_common.pl 1.27:
X    * patchlevel.h 1.11:
X      Bump to Y3.01J.
X
X    * chkconfig.pl 1.22:
X      Check FTP cache.
X
X    * pr_dowork.pl 3.13:
X    * pr_dowork.pl 3.12:
X      Moved most of the FTP stuff to pr_ftp.pl.
X      Implemented FTP file cacheing.
X      FTP DIR is now subject to $dirlimit. Small dirs are included
X      in the feedback.
X      Combined &ftbatch and &ftqueue.
X
X    * README 3.8:
X    * MANIFEST 1.10:
X      Add pr_ftp.pl, dateconv.pl.
X
X    * pr_ftp.pl 1.2:
X      New module. Contains most of the FTP stuff.
X
X    * dateconv.pl 1.2:
X      Borrowed from Lee McLoughlin's 'mirror' package.
X
X    * dorequest.pl 3.24:
X    * ms_common.pl 1.26:
X      Move writelog routine from dorequest.pl to ms_common.pl.
X
XFri Dec  4 00:02:22 1992  Johan Vromans  (jv@squirrel)
X
X    * pr_dowork.pl 3.11:
X      Correct FTP command execution messages.
X
X    * process.pl 3.53:
X      Allow empty 'dir' if FTP connection is open.
X      Allow 'host.uucp' (strip .uucp)
X
X    * ================ Released Y3.01I ================
X
X    * MANIFEST 1.10:
X    * README 3.7:
X    * chkconfig.pl 1.21:
X    * ms_config.pl:
X      Add new FTP support.
X
X    * chat2.pl, ftp.pl:
X      Borrowed from Lee McLoughlin's 'mirror' package.
X
XThu Dec  3 23:51:05 1992  Johan Vromans  (jv@squirrel)
X
X    * pr_dowork.pl 3.10:
X      Use ftp/chat2 package to handle FTP directly.
X      This gives us more control.
X
X    * process.pl 3.52:
X      If archive item foo exists 'as is' as well as with known
X      extensions, and the user requests 'foo', then do not return an
X      ambigous request.
X
XSat Nov 28 17:47:50 1992  Johan Vromans  (jv@squirrel)
X
X    * process.pl:
X      More places where /to/ was used instead of /^to$/.
X      Leave "mserv.last" in $tmpdir.
X
XSun Nov  8 14:15:50 1992  Johan Vromans  (jv@squirrel)
X
X    * dorequest.pl 3.23:
X      Correct options, add nolog and nouucp.
X
X    * dr_uucp.pl 3.5:
X      Implement $opt_nouucp.
X
XSat Nov  7 14:01:15 1992  Johan Vromans  (jv@squirrel)
X
X    * process.pl 3.51:
X    * process.pl 3.50:
X      Implement mail header tracing.
X
X    * dorequest.pl 3.22:
X    * chkconfig.pl 1.20:
X      Implement $nice.
X
X    * process.pl 3.49:
X      Implement $nice.
X      Alow more room for large resend parts lists.
X
XMon Oct 26 10:08:14 1992  Johan Vromans  (jv at pronto)
X
X    * process.pl 3.48:
X      Correct feedback on UUCP headers. The're not always bogus, just
X      unusable...
X
X    * report.pl 3.11:
X      Was too picky on selecting the first part of a multi-part
X      transfer. It left out UUCP transfers too...
X
X    * chkconfig.pl 1.19:
X      Note that MSERVLIB need not to be set.
X      Note that defining $pdtar overrides $tar.
X
X    * patchlevel.h 1.10:
X    * ms_common.pl 1.25:
X      Bump to Y3.01I.
X
XFri Oct 23 13:28:17 1992  Johan Vromans  (jv at pronto)
X
X
X    * ================ Released Y3.01H ================
X
X    * process.pl 3.47:
X      Allow VMS-style filnames.
X      Check $ftp on implicit FTP commands.
X
X    * pr_dowork.pl 3.9:
X    * pr_dowork.pl 3.8:
X      Allow VMS-style filenames.
X      Protect argument of $dircmd with ''.
X      Eliminate some un-necessary joins.
X
X    * ms_common.pl 1.24:
X      Allow VMS-style filnames.
X      Bump to Y3.01H.
X
X    * patchlevel.h 1.9:
X      Bump to Y3.01H.
X
XThu Oct 22 13:46:08 1992  Johan Vromans  (jv at pronto)
X
X    * ================ Released Y3.01G ================
X
X    * patchlevel.h 1.8:
X    * ms_common.pl 1.23:
X      Bump to Y3.01G.
X
X    * dr_uucp.pl 3.4:
X      Make sure partXXofYY is always sortable.
X
X    * pr_dowork.pl 3.7:
X      Correct $limit and $size handling and notification.
X
XWed Oct 21 00:23:29 1992  Johan Vromans  (jv@squirrel)
X
X    * ================ Released Y3.01F ================
X
X    * dr_mail.pl 3.4:
X      Supply request name in the Subject: instead of the file name.
X
X    * do_report.pl 1.9:
X      Correct argument passing to report.pl.
X
X    * pr_dowork.pl 3.6:
X      Do not remap normal commands to FTP commands anymore.
X      Be more specific with the name of requests.
X      Enhance feedback.
X      Denote limit with 'K' in feedback.
X
X    * process.pl 3.46:
X      Correct processing UUCP headers. Check for valid UUCP host name.
X      Only use it iff very reliable.
X      Allow implicit FTP with single command scope. Aplies to SEND,
X      RESEND and DIR.
X      Set defaults before DIR. Can lead to transfer!
X      Normalize use of $ftphost.
X      Use global exit to COMMAND_LOOP where appropriate.
X      Be liberate in putting FTP OPEN commands in the workQ.
X      Prevent global @_ to be used by uucp_defaults when called from
X      setdefaults.
X      Allow unknown UUCP hosts if debugging.
X      Don't test known UUCP host name.
X
X    * patchlevel.h 1.7:
X    * ms_common.pl 1.22:
X      Bump to Y3.01F.
X
X    * do_report.pl 1.9:
X      Correct arguments and destination handling.
X
X    * dr_uucp.pl 3.3:
X      Typo.
X
XTue Oct 20 23:15:04 1992  Johan Vromans  (jv@squirrel)
X
X    * ================ Released Y3.01E ================
X
X    * ms_common.pl 1.21:
X    * patchlevel.h 1.6:
X      Bump to Y3.01E.
X
X    * process.pl 3.45:
X      Strip own system name from uucp address.
X
X    * chkconfig.pl 1.18:
X      Add $prefer_uucp configuration variable.
X
X    * pr_dowork.pl 3.5:
X      Record encoding type with the requests in the ftp queue.
X      Do not close/open ftp host if already connected.
X
X    * process.pl 3.44:
X      Continued.
X      Add $prefer_uucp configuration variable.
X
XSun Oct 18 19:22:12 1992  Johan Vromans  (jv@squirrel)
X
X    * process.pl 3.43:
X    * process.pl 3.42:
X      More on FTP.
X      Correct $ftp_uucp_only requirement.
X      Do not split command line on ':' unless there's whitespace also.
X      Allow implicit FTP when send/resend items contain a "host:"
X      prefix.
X      Allow "FTP host" command.
X      Suppress help when TESTing.
X      Add CD as an alias to CWD.
X
X    * pr_dowork.pl 3.4:
X      More on the FTP handling.
X
X    * chkconfig.pl 1.17:
X      Check $ftp and $dircmd.
X
X    * process.pl 3.41:
X      Remove sub fnsplit.
X      Implement DIR command.
X      Implement basic FTP command.
X      Add sub fttemp to generate temp file names.
X
X    * pr_dowork.pl 3.3:
X      Add documentation on the work queue contents.
X      Add possibility to gather output to temp files, and enqueue
X      these for transfer.
X      Implement DIR command.
X      Implement basic FTP command.
X
X    * dr_uucp.pl 3.2:
X    * dr_mail.pl 3.3:
X      Add $remove_file support.
X
X    * dorequest.pl 3.21:
X      Add $remove_file support.
X      Move sub fnsplit to ms_common.pl.
X
X    * HELP 3.11:
X      Document DIR command.
X
X    * ms_common.pl 1.20:
X      Bump to Y3.01D.
X      Add sub fnsplit (from dorequest.pl).
X
X    * patchlevel.h 1.5:
X      Bump to Y3.01D.
X
XSat Oct 17 16:06:16 1992  Johan Vromans  (jv@squirrel)
X
X    * ================ Released Y3.01C ================
X
X    * ms_common.pl 1.19:
X    * patchlevel.h 1.4:
X      Bump to Y3.01C.
X
X    * HELP 3.10:
X    * INSTALL 3.17:
X    * README 3.6:
X    * ms_common.pl 1.18:
X    * chkconfig.pl 1.16:
X      Allow mail server to be uucp only.
X
X    * process.pl 3.40:
X      Extract uucp defaults from From_ header.
X      Allow mail server to be uucp only.
X      Streamline email / uucp setting code.
X      Allow defaults in UUCP command.
X
X    * process.pl 3.39:
X    * dorequest.pl 3.20:
X    * mlistener.pl 1.6:
X    * do_report.pl 1.8:
X    * chkconfig.pl 1.15:
X    * report.pl 3.10:
X      Correct handling of -config.
X
X    * makeindex.pl 1.10:
X      Add handling of prune dirs.
X
X    * report.pl 3.9:
X      Allow multi-char transfer types (e.g. MP, UP).
X      Better restriction to first part of a transfer only.
X      Correct variable clash (localize variables in report routines).
X      Add totals per month.
X
XWed Oct 14 20:58:07 1992  Johan Vromans  (jv@pasta)
X
X    * dr_pack.pl 3.2:
X      Correct 'zip' calling options.
X
XWed Sep 16 21:11:38 1992  Johan Vromans  (jv@pasta)
X
X    * ================ Released Y3.01B ================
X
X    * process.pl 3.38:
X      Oops. A PATH that contained the string "to" failed...
X
XMon Sep 14 20:59:51 1992  Johan Vromans  (jv@pasta)
X
X    * INSTALL 3.16:
X      Add -config option.
X      Document how to use it.
X
X    * mlistener.pl 1.5:
X      Add -config option.
X      Have listener pass command line args to process.
X
X    * chkconfig.pl 1.14:
X    * do_report.pl 1.7:
X    * report.pl 3.8:
X    * makeindex.pl 1.9:
X    * process.pl 3.37:
X    * dorequest.pl 3.19:
X    * process.pl 3.36:
X      Add -config option to select an alternate config file from
X      the command line.
X
X    * ms_common.pl 1.17:
X      Require $config_file || "ms_config.pl".
X
X    * ms_common.pl 1.16:
X    * patchlevel.h 1.3:
X      Bump to Y3.01B.
X
XSat Sep 12 21:38:02 1992  Johan Vromans  (jv@pasta)
X
X    * ================ Released Y3.01A ================
X
X    * pr_isearch.pl 3.3:
X      Add $ENV{LOCATE_PATH} for GNU find 3.7.
X
X    * pr_doindex.pl 3.3:
X      Add $ENV{LOCATE_PATH} for GNU find 3.7.
X      Lower maxindexlines upon exceeding the limit.
X
X    * process.pl 3.35:
X      Prevent the first part of the feedback message to be suppressed
X      if BEGIN commands were issued.
X      Clarify feedback on PACK command.
X
XMon Aug 24 22:16:55 1992  Johan Vromans  (jv@pasta)
X
X    * pr_dowork.pl 3.2:
X      Correct typos in english texts.
X
XMon Aug 17 15:47:51 1992  Johan Vromans  (jv@pasta)
X
X    * mserv.notes 1.4:
X      Update message.
X
X    * mlistener.pl 1.4:
X      Change mserv_common.pl -> ms_common.pl.
X
X    * patchlevel.h 1.2:
X    * ms_common.pl 1.15:
X      Bump to Y3.01A.
X
XSun Jul 19 13:36:04 1992  Johan Vromans  (jv@pasta)
X
X    * ================ Released Y3.01 ================
X
X    * chkconfig.pl 1.13:
X      Require patchlevel.h.
X      Verify match between version numbers in ms_common.pl and
X      patchlevel.h.
X
X    * README 3.5:
X    * INSTALL 3.15:
X    * MANIFEST 1.9:
X      Change mserv_common.pl -> ms_common.pl.
X      Change mserv_config.pl -> ms_config.pl.
X      Add patchlevel.h.
X
X    * patchlevel.h 1.1:
X      New file.
X
X    * chkconfig.pl 1.12:
X    * do_report.pl 1.6:
X    * dorequest.pl 3.18:
X    * listener.pl 1.3:
X    * makeindex.pl 1.8:
X    * process.pl 3.34:
X    * report.pl 3.7:
X    * testlock.pl 1.2:
X      Change mserv_common.pl -> ms_common.pl.
X
X    * ms_common.pl 1.14:
X      Formerly mserv_common.pl.
X      Change mserv_config.pl -> ms_config.pl.
X      Bump to Y3.01.
X
X    * ms_config.pl
X      Formerly mserv_config.pl.
X
X    * process.pl 3.33:
X      Disallow garbage after BEGIN command.
X      Ignore garbage after END command.
X      Make REQUEST END identical to END.
X
X    * dr_mail.pl 3.2:
X      Prepend leading zeroes to part numbers to keep them sortable.
X
XWed Jun 10 11:57:44 1992  Johan Vromans  (jv at largo)
X
X    * ================ Released V3.00 ================
X
END_OF_FILE
  if test 18184 -ne `wc -c <'mserv-3.1/ChangeLog'`; then
    echo shar: \"'mserv-3.1/ChangeLog'\" unpacked with wrong size!
  fi
  # end of 'mserv-3.1/ChangeLog'
fi
if test -f 'mserv-3.1/chkconfig.pl' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'mserv-3.1/chkconfig.pl'\"
else
  echo shar: Extracting \"'mserv-3.1/chkconfig.pl'\" \(11186 characters\)
  sed "s/^X//" >'mserv-3.1/chkconfig.pl' <<'END_OF_FILE'
X#!/usr/local/bin/perl
X# chkconfig.pl -- check mserv configuration
X# SCCS Status     : @(#)@ chkconfig    1.32
X# Author          : Johan Vromans
X# Created On      : Mon Apr 27 21:47:41 1992
X# Last Modified By: Johan Vromans
X# Last Modified On: Sat Jan  2 14:21:33 1993
X# Update Count    : 146
X# Status          : Development
X
X# DISCLAIMER: This prograim aids in finding configuration values
X# and potential problems. No guarantees, however.
X
X$my_name = "chkconfig";
X$my_version = "1.32";
X#
X################ Common stuff ################
X
X$libdir = $ENV{"MSERVLIB"} || "/usr/local/lib/mserv";
Xunshift (@INC, $libdir);
X&options if @ARGV > 0 && $ARGV[0] =~ /^-+[^-]+/;
X@ARGV = ("-") unless @ARGV > 0;
Xif ( $opt_current) {
X    chop ($libdir = `pwd`);
X    $INC[0] = $libdir;
X}
Xrequire "ms_common.pl";
Xrequire "patchlevel.h";
X
Xprint ($my_package, " [", $my_name, " ", $my_version, "]\n");
X
X################ Main ################
X
X# Verify version.
Xlocal ($version) = $my_package =~ /([XYV]\d+\.\d+[A-Z]*)$/;
X
Xif ( $ms_version ne $version ) {
X    print ("FATAL: Version mismatch\n",
X       '  patchlevel.h ', $ms_version, ' <-> ',
X       $version, ' ms_common.pl', "\n");
X    die ("Aborted.\n");
X}
X
Xprint ("MSERVLIB = ", $ENV{"MSERVLIB"} || "(not set, but that's OK)", "\n");
Xprint ("Program library: ", $libdir, " ", &fstat($libdir,1,1), "\n");
Xprint ("\n");
X
Xif ( defined $mserv_owner && $mserv_owner ) {
X    if ( @u = getpwnam ($mserv_owner) ) {
X    print ("Server owner: ", $mserv_owner, ", uid = $u[2], gid = $u[3]",
X           ", \"", $u[6], "\"\n");
X    }
X    else {
X    print ("Server owner: ", $mserv_owner, " *** Unknown ***\n");
X    }
X}
Xelse {
X    die ("\$mserv_owner is not defined!\n");
X}
Xif ( defined $mserv_bcc && $mserv_bcc ) {
X    if ( @u = getpwnam ($mserv_bcc) ) {
X    print ("Bcc user: ", $mserv_bcc, ", uid = $u[2], gid = $u[3]",
X           ", \"", $u[6], "\"\n");
X    }
X    else {
X    print ("Bcc user: ", $mserv_bcc, " *** Unknown ***\n");
X    }
X}
Xprint ("\n");
X
Xif ( $have_setruid ) {
X    print ("The 'listener' program will use the setruid system call\n");
X    print ("  It will change identity to compiled-in uid $u[2]\n")
X    if $use_uid;
X    print ("  (setenv will be used to set USER, LOGNAME and HOME)\n")
X    if $have_setenv;
X    if ( -x "$libdir/listener" ) {
X    @st = stat (_);
X    unless ( $st[4] == $u[2] && $st[2] & 0004000 == 0004000 ) {
X        print ("The 'listener' program is not installed correctly!\n",
X           "  It should be installed setuid $mserv_owner\n");
X    }
X    }
X    else {
X    print ("The 'listener' program is not yet installed.\n",
X           "  Do not forget to install it setuid $mserv_owner\n");
X    }
X}
Xelse {
X    print ("The 'listener' program will use 'su' to change identity\n");
X    if ( -x "$libdir/listener" ) {
X    @st = stat (_);
X    unless ( $st[4] == 0 && $st[2] & 0004000 == 0004000 ) {
X        print ("The 'listener' program is not installed correctly!\n",
X           "  It should be installed setuid root\n");
X    }
X    }
X    else {
X    print ("The 'listener' program is not yet installed\n",
X           "  Do not forget to install it setuid root\n");
X    }
X}
Xprint "\n";
X
X$f = $sendmail;
X$f = $` if $f =~ / /;
Xprint ("Replies will be sent using \"$sendmail\" ", &fstat($f,0,1), "\n");
Xprint ("Preset mail headers:\n");
Xprint (defined $sender ? "  $sender\n" : "  *** sender not defined ***\n");
Xprint ("  ", join ("\n  ", @x_headers), "\n") if defined @x_headers;
Xprint ("\n");
X
Xif ( defined @black_list ) {
X    print ("Mail messages from the following users will be ",
X       $black_list_warning ?
X       "flagged with\na warning that they will be rejected in the future:"
X       : "rejected:",
X       "\n");
X    select (STDOUT);
X    $~ = multi_line;
X    $multi = join (' ', @black_list);
X    $= = 999;
X    write;
X    print ("\n");
X}
X
Xprint ("Transfer strategies:\n");
Xif ( defined $email ) {
X    $f = $chunkmail;
X    $f = $` if $f =~ / /;
X    print ("  email: \"$chunkmail\" ", &fstat($f,0,1), "\n");
X    print ("         wait ", $mailer_delay, " seconds between chunks\n")
X    if defined $mailer_delay;
X    print ("         limits: ", $email_limits[1], "K (default), ",
X       $email_limits[0], "K (min), ", $email_limits[2], "K (max)\n");
X}
Xif ( defined $uucp ) {
X    $f = $uucp;
X    $f = $` if $f =~ / /;
X    print ("  uucp : \"$uucp\" ", &fstat($f,0,1), "\n");
X    $f = $uuname;
X    $f = $` if $f =~ / /;
X    print ("         check host names using \"$uuname\" ", &fstat($f,0,1), "\n")
X    if $uuname ne "";
X    print ("         limits: ", $uucp_limits[1], "K (default), ",
X       $uucp_limits[0], "K (min), ", $uucp_limits[2], "K (max)\n");
X    print ("         uucp transfer is preferred, if possible\n")
X    if $prefer_uucp;
X}
Xunless ( defined $email || defined $uucp ) {
X    print ("  None. *** ARE YOU SURE? ***\n");
X}
Xprint ("\n");
X
Xprint ("Search strategies:");
Xprint (" File") if $dofilesearch;
Xprint (" Directory") if $dodirsearch;
Xprint (" Index") if $doindexsearch;
Xprint ("\n");
Xprint ("\n");
X
Xif ( ! ($dofilesearch || $dodirsearch || $doindexsearch) ) {
X    print ("*** No search strategy defined ***\n\n");
X}
X
Xprint ("Archives:\n");
Xforeach $lib ( @libdirs ) {
X    print ("  ", $lib, " ", &fstat($lib,1,1), "\n");
X}
Xif ( defined $indexfile && defined $indexlib ) {
X    print ("Archive for Index:\n");
X    print ("  ", $indexlib, " ", &fstat($indexlib,1,1), "\n");
X}
Xprint ("\n");
X
Xif ( $doindexsearch && !( defined $indexfile ) ) {
X    print ("*** No value for `indexfile' ***\n\n");
X}
X
Xif ( $doindexsearch && defined $indexfile ) {
X    print ("Indexfiles:\n");
X    if ( $indexfile =~ m|^/| ) {
X    print ("  ", $indexfile, " ", &fstat($indexfile), "\n");
X    print ("  Archive for this index: ", $indexlib, "\n")
X        if defined $indexlib;
X    }
X    else {
X    foreach $lib ( @libdirs ) {
X        local ($indexfile) = $lib . "/" . $indexfile;
X        print ("  ", $indexfile, " ", &fstat($indexfile), "\n");
X    }
X    }
X    print ("Limit per index request: ", $maxindexlines, " lines.\n")
X    if $maxindexlines > 0;
X    print ("\n");
X    print ("Index tools:\n");
X    print ("  gfind      ", $gfind, " ", &fstat($gfind,0,1), "\n");
X    print ("  ixlookup   ", $ixlookup, " ", &fstat($ixlookup,0,1), "\n");
X    print ("  locatelib  ", $locatelib, " ", &fstat($locatelib,1,1), "\n");
X    print ("\n");
X}
X
Xprint ("Server files:\n");
Xprint ("  queue      ", $queue, " ", &fstat($queue), "\n");
Xprint ("  logfile    ", $logfile, " ", &fstat($logfile), "\n");
Xprint ("  lockfile   ", $lockfile, " ", &fstat($lockfile), "\n");
Xprint ("  notes      ", $notesfile, " ", &fstat($notesfile), "\n");
Xprint ("  hints      ", $hintsfile, " ", &fstat($hintsfile), "\n");
Xprint ("\n");
X
X# Locking
Xif ( defined $lock_fcntl ) {
X    print ("Locking with fcntl(2).\n");
X}
Xif ( defined $lock_flock ) {
X    print ("Locking with flock(2).\n");
X}
Xif ( defined $lock_lockf ) {
X    print ("Locking with syscall(2)/lockf(2).\n");
X}
Xif ( defined $lock_fcntl + defined $lock_flock + defined $lock_lockf > 1 ) {
X    print ("*** Select one lock method.\n");
X}
Xif ( defined $lock_fcntl + defined $lock_flock + defined $lock_lockf == 0 ) {
X    print ("No locking selected. Proceed at your own risk\n");
X}
Xelse {
X    # Just a quick test to see if things fit.
X    local ($lf) = "/usr/tmp/fl$$";
X    open (LF, ">$lf");
X    eval { &locking (*LF, 0); };
X    print "$@" if "$@";
X    close (LF);
X    unlink ($lf);
X    print ("Use the 'testlock' program to verify the locking! (See INSTALL)\n");
X}
Xprint ("\n");
X
X%enctab = ("B", "btoa", "U", "uuencode", "X", "xxencode", "D", "uue");
X
Xprint ("Default encoding is ", $default_encoding,
X       " (", $enctab{$default_encoding}, ")\n");
Xprint ("Encoders:\n");
Xforeach $f ( "btoa", "uuencode", "uue", "xxencode" ) {
X    $exec = eval("\$$f");
X    printf ("  %-10s %s %s\n", $f, $exec,
X        &fstat($exec,0,
X           $f eq "uuencode" || $f eq $enctab{$default_encoding}),
X        "\n");
X}
Xprint ("\n");
X
Xprint ("Tools:\n");
X$f = $dircmd;
X$f = $` if $f =~ / /;
Xprint ("  dir: \"$dircmd\" ", &fstat($f, 0, 1), "\n");
Xif ( $archie ) {
X    $f = $archie;
X    $f = $` if $f =~ / /;
X    print ("  archie: \"$archie\" ", &fstat($f, 0, 1), "\n");
X}
Xif ( $cmd_extend ) {
X    print ("  extensions: $cmd_extend ",
X       &fstat ($cmd_extend,0,1), "\n");
X}
X
Xprint ("  feedback limit = ", $fb_limit, "K\n") if $fb_limit;
Xprint ("\n");
X
Xif ( $auto_compress ) {
X    print ("Support for auto-compression is included.\n");
X    print ("  Known extensions are tried BEFORE '.Z'.\n")
X    if $auto_compress > 1;
X    print ("  Compress using \"$compress\" ", &fstat($compress,0,1), "\n");
X    print ("\n");
X}
X
Xif ( defined $ftp && $ftp ) {
X    print ("Support for FTP is included.\n");
X    print ("  Limited to uucp only.\n") if $ftp_uucp_only;
X    print ("  Cache dir = ", $ftp_cache, " ",
X       &fstat ($ftp_cache,1,1), "\n") if $ftp_cache;
X    print ("  Files are kept for ", $ftp_keep, " days in the cache.\n")
X    if $ftp_keep;
X    require "$libdir/pr_ftp.pl";
X    require "$libdir/dateconv.pl";
X}
Xprint ("\n");
X
Xif ( defined $packing_limit ) {
X    print ("Support for packing is included.\n",
X       "  Packing limit = $packing_limit blocks.\n",
X       "  Dusk usage obtained using \"$du\" ", &fstat($du,0,1), "\n",
X       "  File list obtained using \"$find\" ", &fstat($find,0,1), "\n",
X       "  Methods:");
X    if ( defined $pdtar ) {
X    print (" tar ", &fstat($pdtar,0,1));
X    }
X    else {
X    print (" tar ", &fstat($tar,0,1));
X    }
X    print (" zip ", &fstat($zip,0,1));
X    print (" zoo ", &fstat($zoo,0,1));
X    print ("\n");
X    if ( defined $pdtar ) {
X    print ("  Compress/Tar using \"$pdtar\" ", &fstat($pdtar,0,1), "\n");
X    }
X    else {
X    print ("  Compress/Tar using \"$tar\" ", &fstat($tar,0,1), " and ",
X           "\"$compress\" ", &fstat($compress,0,1), "\n");
X    }
X    print ("  Automatic packing of directories is allowed.\n")
X    if $auto_packing;
X    print ("\n");
X}
Xelse {
X    print ("Packing functionality not selected.\n\n");
X}
Xprint ("Working storage: $tmpdir ", &fstat($tmpdir,1,1), "\n\n");
Xprint ("The queue will ", $auto_runrequest ? "automatically" : "not",
X       " be run upon completion of process.\n");
Xif ( $nice ) {
X    eval {
X    if ( setpriority (0, $$, $nice ) ) {
X        print ("The mail server will be niced with $nice.\n");
X    }
X    else {
X        print ("Cannot set nice value $nice: $!\n");
X    }
X    };
X
X    if ( $@ ) {
X    print ("Cannot set nice value $nice: $@\n");
X    }
X}
Xprint ("\n");
X
X################ Subroutines ################
X
Xsub fstat {
X    local ($file, $dir, $mustexist) = @_;
X    return "[*** Not found ***]" if ! -e $file && $mustexist;
X    return "[Not found, but that's OK]" unless -e _;
X    return "[*** Not a directory ***]" if $dir && ! -d _;
X    "[OK]";
X}
X
Xsub options {
X    require "newgetopt.pl";
X    $opt_ident = $opt_help = 0;
X    if ( !&NGetOpt ("config=s", "current", "ident", "help")
X    || $opt_help
X    || (@ARGV > 0)) {
X    &usage;
X    }
X    $config_file = $opt_config if defined $opt_config;
X}
X
Xsub usage {
X    require "ms_common.pl";
X    print STDERR <<EndOfUsage;
X$my_package [$my_name $my_version]
X
XUsage: $my_name [-options]
X
XOptions:
X    -config XX    use alternate config
X    -current    use current directory instead of $libdir
X    -help    this message
X    -ident    print identification
XEndOfUsage
X    exit (1);
X}
X
Xformat multi_line =
X~~^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
X$multi
X.
END_OF_FILE
  if test 11186 -ne `wc -c <'mserv-3.1/chkconfig.pl'`; then
    echo shar: \"'mserv-3.1/chkconfig.pl'\" unpacked with wrong size!
  fi
  # end of 'mserv-3.1/chkconfig.pl'
fi
if test -f 'mserv-3.1/dorequest.pl' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'mserv-3.1/dorequest.pl'\"
else
  echo shar: Extracting \"'mserv-3.1/dorequest.pl'\" \(8553 characters\)
  sed "s/^X//" >'mserv-3.1/dorequest.pl' <<'END_OF_FILE'
X#!/usr/local/bin/perl
X# dorequest.pl --
X# SCCS Status     : @(#)@ dorequest    3.28
X# Author          : Johan Vromans
X# Created On      : ***
X# Last Modified By: Johan Vromans
X# Last Modified On: Wed Dec 23 23:02:01 1992
X# Update Count    : 149
X# Status          : Going steady
X
X# Usage: dorequest [options] -- to run the queue
X#
X#     dorequest [options] address file [ encoding [ limit [ list ] ] ]
X#        -- to send a file 'by hand'.
X#
X#   address : where to send the information to.
X#          If left empty, no splitting is done, and the result
X#          is written to stdout.
X#
X#   file    : the file to send.
X#
X#   encoding: how to encode it: U (uuencode), B (btoa), D (Dumas uue)
X#          or A (plain).
X#             Default is btoa.
X#          Adding a Z to the encoding will have the file compressed first.
X#
X#   limit   : how many bytes per transmission.
X#             Default is 32768
X#
X#   parts   : comma-separated list of part numbers.
X#             When used, only these parts are sent.
X#
X$my_name = "dorequest";
X$my_version = "3.28";
X#
X################ Common stuff ################
X
X$libdir = $ENV{"MSERVLIB"} || "/usr/local/lib/mserv";
Xunshift (@INC, $libdir);
X
X################ Options handling ################
X
X&options if @ARGV > 0 && $ARGV[0] =~ /^-+[^-]+/;
Xundef $mailer_delay if $opt_debug;
X
X################ More common stuff ################
X
X# Require common here, so $opt_config can be used to select an
X# alternate configuration file.
Xrequire "ms_common.pl";
X
X################ Setting up ################
X
Xif ( @ARGV > 0 ) {
X    &usage unless @ARGV > 1;
X    local ($rcpt, $address, $request, $file, $encoding, $limit, $parts);
X    local ($remove_file) = 0;
X    ($rcpt, $file, $encoding, $limit, $parts) = @ARGV;
X    $request = $file;
X    $address = $rcpt;
X    require "$libdir/dr_mail.pl";
X    &mail_request ($rcpt, $address, '', $request, $file,
X           $encoding, $limit, $parts);
X}
Xelse {
X    &synchronize;
X    &seize_queue;
X
X    # Be nice and forgiving
X    eval { setpriority (0, $$, $nice) } if $nice;
X
X    while ( @queue > 0 ) {
X    local ($current_queue_entry) = &shift_queue;
X    local (@arg) = split (/[\t\n]/, $current_queue_entry);
X    $current_queue_entry = join ("\t", @arg);
X    local ($cmd) = shift (@arg);
X    local ($remove_file) = $cmd =~ /^[a-z]+$/;
X
X    $cmd =~ tr/a-z/A-Z/ if $remove_file;
X
X    if ( $cmd eq "M" ) {
X        require "$libdir/dr_mail.pl";
X        eval { &mail_request (@arg); };
X    }
X    elsif ( $cmd eq "U" ) {
X        require "$libdir/dr_uucp.pl";
X        eval { &uucp_request (@arg); };
X    }
X    elsif ( $cmd eq "MP" ) {
X        require "$libdir/dr_pack.pl";
X        eval { &pack_mail_request (@arg); };
X    }
X    elsif ( $cmd eq "UP" ) {
X        require "$libdir/dr_pack.pl";
X        eval { &pack_uucp_request (@arg); };
X    }
X    else {
X        # This is fatal!
X        &die ("Illegal request in queue: $cmd @arg");
X    }
X    }
X    # Get rid of queue backup file.
X    unlink ("$queue~");
X}
X
Xexit (0);
X
X################ Subroutines ################
X
Xsub synchronize {
X
X    # NOTE: It is very important to prevent multiple copies
X    #        of this program to run at the same time!
X
X    # Proceed at your own risk here...
X    return unless defined $lockfile;
X
X    # Create lockfile if it does not exists.
X    if ( ! -e $lockfile ) {
X    open (LF, ">$lockfile");
X    close (LF);
X    }
X
X    # Open it, and get exclusive access.
X    open (LF, "+<$lockfile")
X    || &die ("Cannot gain lock [$!]");
X    local ($ret) = &locking (*LF, 0);
X    # Exit gracefully if some other invocation has the lock.
X    exit (0) if $ret == 0;
X    &die ("Cannot lock lockfile [$!]") unless $ret == 1;
X
X    # We keep it locked until process termination.
X}
X
Xsub seize_queue {
X
X    local ($queuecnt);
X
X    # First, check the queue backup. This file can exists only
X    # if a previous run failed to terminate normally.
X    if (open (QUEUE, "$queue~")) {
X    @queue = <QUEUE>;    # Slurp.
X    close (QUEUE);
X    unlink ("$queue~")
X        || &die ("Cannot unlink queue~ [$!]");
X    $queuecnt = @queue;
X    print STDERR ("Got $queuecnt entries from $queue~\n")
X        if $opt_debug;
X    }
X    else {
X    @queue = ();
X    $queuecnt = 0;
X    }
X
X    # Now check the current queue. We use exclusive access to make
X    # sure no other process is updating it.
X    # Again, proceed at your own risk if you're not using locks.
X    if (open (QUEUE, "+<$queue" )) {
X    # We cannot use rename queue -> queue~, since some other process
X    # may already be waiting for the queue to become free.
X    # Therefore slurp + truncate it.
X    if ( &locking (*QUEUE, 1) ) {
X        push (@queue, <QUEUE>); # Slurp.
X        truncate ($queue, 0)
X        || &die ("Cannot truncate queue [$!]");
X        close (QUEUE);
X    }
X    else {
X        &die ("Cannot seize queue [$!]");
X    }
X    print STDERR ("Got ",  @queue-$queuecnt, " entries from $queue\n")
X        if $opt_debug;
X    }
X    # 'No queue' is a normal situation....
X}
X
Xsub shift_queue {
X    # Sync the memory copy of the queue to disk (in the queue backup
X    # file), and extract the first entry of it.
X
X    open (QUEUE, ">$queue~")
X    || &die ("Cannot sync queue [$!]");
X    print QUEUE @queue;        # Blurb.
X    close (QUEUE);
X
X    # Get entry from queue and return it.
X    shift (@queue);
X}
X
Xsub check_file {
X    local ($file, $dir) = @_;
X
X    # Check if a given file still exists. Non-existent files are
X    # trapped anyway, but this gives a better error message.
X
X    return 1 if -r $file && ( $dir ? ( -d _ && -x _ ) : -f _ );
X    &die (($dir ? "Directory" : "File") .
X      " \"$file\" is no longer available");
X}
X
X################ subroutines ################
X
Xsub system {
X    local ($cmd) = (@_);
X    local ($ret);
X    local ($opt_nolog) = 0;
X    print STDERR ("+ $cmd\n") if $opt_trace;
X    $ret = system ($cmd);
X    &die (sprintf ("Return 0x%x from \"$cmd\"", $ret))
X    unless $ret == 0;
X    $ret;
X}
X
Xsub symlink {
X    local ($old, $new) = @_;
X    print STDERR ("+ symlink $old $new\n") if $opt_trace;
X    symlink ($old, $new)
X    || &die ("Cannot symlink $old to $new [$!]\n");
X}
X
Xsub die {
X    local ($msg) = (@_);
X    local ($opt_nolog) = 0;    # Will force logging
X    local ($opt_debug) = 1;    # Will force msg to STDERR
X    &writelog ("F $msg");
X    if ( defined $current_queue_entry ) {
X    &writelog ("Q $current_queue_entry");
X    &feedback ($current_queue_entry, $msg);
X    }
X    die ("Aborted\n");
X}
X
Xsub feedback {
X    local ($q, $msg) = @_;
X
X    # Try to send a message to the requestor indicating
X    # something went wrong.
X
X    local ($type, $rcpt, @q) = split (/ /, $q);
X    local ($file, $req, $method);
X    if ( $type =~ /^U/ ) {
X    ($req, $file) = @q[2,3];
X    $method = "via UUCP to \"$q[0]\"";
X    }
X    else {
X    ($req, $file) = @q[1,2];
X    $method = "via email to \"$q[0]\"";
X    }
X
X    local ($cmd) = "$sendmail '" . $rcpt . "'";
X
X    print STDERR ("+ |", $cmd, "\n") if $opt_trace;
X
X    return unless open (MAIL, "|" . $cmd);
X    print MAIL <<EOD;
XTo: $rcpt
XSubject: Mail Server error
XX-Server: $my_package [$my_name $my_version]
XX-Oops: I am sorry for the inconvenience
X
XDear user,
X
XEOD
X    $message = "A mail server error has occurred while trying to transfer ".
X    "\"$file\" $method in response to your request for \"$req\".";
X    select (MAIL);
X    $~ = "fill";
X    write;
X    print MAIL <<EOD;
X
XThe error message was:
X   $msg
X
XYou may wish to resubmit your request, or consult the mail server
Xmaintainer.
X(He knows about the error already, no need to inform him.)
X
XEOD
X    close (MAIL);
X    select (STDOUT);
X}
X
Xformat fill =
X^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~~
X$message
X.
X
Xsub options {
X    require "newgetopt.pl";
X    if ( !&NGetOpt ("config=s", "nomail", "nouucp", "nolog", "keep=s",
X            "debug", "trace", "help")
X    || defined $opt_help ) {
X    &usage;
X    }
X    $opt_trace |= $opt_debug;
X    $config_file = $opt_config if defined $opt_config;
X}
X
Xsub usage {
X    require "ms_common.pl";
X    print STDERR <<EndOfUsage;
X$my_package [$my_name $my_version]
X
XUsage: $my_name [options] [address file [coding [size [parts]]]]
X
XOptions:
X    -config XX    use alternate config file
X    -keep XXX    keep temporary files, using prefix XXX (for debugging)
X    -help    this message
X    -nolog    do not make entries in the logfile
X    -trace    show commands
X    -debug    for debugging
X    -nomail    do not deliver via email (for debugging)
X    -nouucp    do not deliver via uucp (for debugging)
X
Xaddress        destination for this request.
X        If empty: do not split and write to STDOUT.
Xfile        the file to send.
Xcoding        encoding (Btoa, Uuencode, Dumas uue or Plain, def Btoa).
Xsize        max. size per chunk, def 32K.
Xparts        comma-separated list of parts to re-send.
X        If omitted: send all parts
XEndOfUsage
X    exit (!defined $opt_help);
X}
END_OF_FILE
  if test 8553 -ne `wc -c <'mserv-3.1/dorequest.pl'`; then
    echo shar: \"'mserv-3.1/dorequest.pl'\" unpacked with wrong size!
  fi
  # end of 'mserv-3.1/dorequest.pl'
fi
if test -f 'mserv-3.1/pr_parse.pl' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'mserv-3.1/pr_parse.pl'\"
else
  echo shar: Extracting \"'mserv-3.1/pr_parse.pl'\" \(17491 characters\)
  sed "s/^X//" >'mserv-3.1/pr_parse.pl' <<'END_OF_FILE'
X# pr_parse.pl --
X# SCCS Status     : @(#)@ pr_parse.pl    1.7
X# Author          : Johan Vromans
X# Created On      : Fri Dec 18 21:03:34 1992
X# Last Modified By: Johan Vromans
X# Last Modified On: Fri Jan  1 15:10:55 1993
X# Update Count    : 97
X# Status          : Unknown, Use with caution!
X
X$cmd_tbl{'END'}      = 'cmd_end';
X$cmd_tbl{'EXIT'}     = $cmd_tbl{'END'};
X$cmd_tbl{'QUIT'}     = $cmd_tbl{'END'};
X$cmd_tbl{'BEGIN'}    = $interactive ? 'cmd_ignore' : 'cmd_begin';
X$cmd_tbl{'RESET'}    = $cmd_tbl{'BEGIN'};
X$cmd_tbl{'REPLY'}    = $interactive ? 'cmd_ignore' : 'cmd_reply';
X$cmd_tbl{'PATH'}     = $cmd_tbl{'REPLY'};
X$cmd_tbl{'MAIL'}     = 'cmd_mail' if defined $email;
X$cmd_tbl{'UUCP'}     = 'cmd_uucp' if defined $uucp;
X$cmd_tbl{'LIMIT'}    = 'cmd_limit';
X$cmd_tbl{'UUENCODE'} = 'cmd_uuencode';
X$cmd_tbl{'UUDECODE'} = $cmd_tbl{'UUENCODE'};
X$cmd_tbl{'UU'}       = $cmd_tbl{'UUENCODE'};
X$cmd_tbl{'XXENCODE'} = 'cmd_xxencode';
X$cmd_tbl{'XXDECODE'} = $cmd_tbl{'XXENCODE'};
X$cmd_tbl{'XX'}       = $cmd_tbl{'XXENCODE'};
X$cmd_tbl{'UUE'}      = 'cmd_uue';
X$cmd_tbl{'UUD'}      = $cmd_tbl{'UUE'};
X$cmd_tbl{'BTOA'}     = 'cmd_btoa';
X$cmd_tbl{'ATOB'}     = $cmd_tbl{'BTOA'};
X$cmd_tbl{'ENCODE'}   = 'cmd_encode';
X$cmd_tbl{'ENCODING'} = $cmd_tbl{'ENCODE'};
X$cmd_tbl{'COMPRESS'} = 'cmd_compress';
X$cmd_tbl{'SEND'}     = 'cmd_send';
X$cmd_tbl{'TOPIC'}    = $cmd_tbl{'SEND'};
X$cmd_tbl{'GET'}      = $cmd_tbl{'SEND'};
X$cmd_tbl{'RESEND'}   = 'cmd_resend';
X$cmd_tbl{'PACK'}     = 'cmd_pack' if defined $packing_limit && $packing_limit;
X$cmd_tbl{'SEARCH'}   = 'cmd_search';
X$cmd_tbl{'INDEX'}    = 'cmd_index';
X$cmd_tbl{'HELP'}     = 'cmd_help';
X$cmd_tbl{'REQUEST'}  = 'cmd_request';
X$cmd_tbl{'DIR'}      = 'cmd_dir';
X$cmd_tbl{'LIST'}     = $cmd_tbl{'DIR'};
X$cmd_tbl{'LS'}       = $cmd_tbl{'DIR'};
X$cmd_tbl{'CWD'}      = 'cmd_cwd';
X$cmd_tbl{'FTP'}      = 'cmd_ftp' if $ftp;
X$cmd_tbl{'ARCHIE'}   = 'cmd_archie' if $archie;
X$cmd_tbl{'TEST'}     = 'cmd_test';
X
X# Add user commands...
Xdo $cmd_extend if $cmd_extend && -r $cmd_extend;
X
Xsub command_loop {
X
X    local ($res, $cmd, @cmd);
X    local ($curdir) = "";    # track current directory
X    local ($ftphost);        # empty -> no FTP, otherwise -> FTP
X    local (*line, *DATA_LINE) = (*rfc822'line, *rfc822'DATA_LINE);
X    local (*line_in_cache) = (*rfc822'line_in_cache);
X    local ($tmp, $proc, $result);
X
X    while ( $res = &read_body ) {
X
X    next if $res != $DATA_LINE;
X
X    # Allow continuation lines.
X    $tmp = '';
X    while ( $line =~ /\\$/ && $res == $DATA_LINE ) {
X        $tmp .= $line;    # Append w/o intervening space
X        chop ($tmp);    # Get rid of \
X        if (  ($res = &read_body) == $DATA_LINE ) {
X        $line =~ s/^\s+//; # Strip leading spaces.
X        }
X    }
X    $line = $tmp . $line;
X
X    last unless &split_and_exec_line;
X
X    print STDOUT ("\n");
X    }
X    print STDOUT ("\n");
X}
X
Xsub interactive_loop {
X    # Yes, this is almost a copy of command_loop.
X
X    local ($cmd, @cmd);
X    local ($curdir) = "";    # track current directory
X    local ($ftphost);        # empty -> no FTP, otherwise -> FTP
X    local ($line, $line_in_cache);
X    local ($tmp, $proc, $result);
X
X    print STDOUT ("Enter HELP for a list of commands.\n\n");
X    print STDOUT ("Command> ");
X
X    while ( $line = $line_in_cache ? $line_in_cache : scalar(<STDIN>) ) {
X
X    chop ($line);
X    undef $line_in_cache;
X    next unless $line =~ /\S/;
X
X    # Allow continuation lines.
X    $tmp = '';
X    while ( $line =~ /\\$/ ) {
X        $tmp .= $line;    # Append w/o intervening space
X        chop ($tmp);    # Get rid of \
X        print STDOUT ("       > ");
X        if (  ($line = <STDIN> ) ) {
X        $line =~ s/^\s+//; # Strip leading spaces.
X        }
X    }
X    $line = $tmp . $line;
X
X    last unless &split_and_exec_line;
X
X    print STDOUT ("\nCommand> ") unless $line_in_cache;
X    }
X
X    if ( $ftphost ) {
X    push (@workq, &zp ('G', 'C'));
X    require "$libdir/pr_dowork.pl";
X    &work_loop;
X    }
X
X    print STDOUT ("\n");
X    $errflag = 0;
X}
X
Xsub split_and_exec_line {
X
X    # Allow multiple commands on a line.
X    if ( $line =~ /\s*;\s*/ ) {
X    $line_in_cache = "$'\n";
X    $line = $`;
X    }
X
X    $line =~ s/\s+/ /g;
X    $commands++;
X    print STDOUT "Command: $line\n";
X
X    # Try to handle "REQUEST: foo" neatly
X    $line =~ s/(\s+:|:\s+)/ /g;
X
X    @cmd = split (/[\t ,=]+/, $line);
X    @cmd = grep ( $_ ne "", @cmd);
X
X    # Get command verb, shifting leading "set" verb.
X    do {
X    $cmd = shift (@cmd);
X    last unless $cmd;
X    $cmd  =~ tr/[a-z]/[A-Z]/;
X    } while ( $cmd eq "SET" );
X
X    # Execute command parsing procedure.
X    # A command parsing procedure may return one of the following values:
X    #  > 0 : command parsed (either OK or in error)
X    #   0  : pretend that command does not exist
X    #  < 0 : terminate processing
X
X    if ( defined ( $proc = $cmd_tbl{$cmd} ) &&
X    ( $result = &$proc ) != 0 ) {
X
X    # This is to implement the END command...
X    return 0 if $result < 0;
X
X    # And this is for interactive use.
X    return 1 unless $interactive;
X
X    if ( @indexq > 0 ) {
X        require "$libdir/pr_doindex.pl";
X        &index_loop;
X    }
X    if ( @searchq > 0 ) {
X        &search_loop;
X    }
X    if ( @workq > 0 ) {
X        require "$libdir/pr_dowork.pl";
X        &work_loop;
X    }
X    }
X    else {
X    # Unknown, or &$proc returned zero.
X    &errmsg ("Command $cmd unknown");
X    }
X    1;
X}
X
Xsub cmd_ignore {
X    &warning ("$cmd command ignored");
X}
X
X################ exit | end ################
X
Xsub cmd_end {
X    print STDOUT ("=> Okay");
X    print STDOUT (" (rest of command ignored)") if @cmd;
X    print STDOUT ("\n");
X
X    # Terminate outer loop.
X    return -1;
X}
X
X################ begin ################
X
Xsub cmd_begin {
X    return &errmsg ("Usage: $cmd") if @cmd != 0;
X
X    print STDOUT "=> Resetting\n";
X    &reset;
X    1;
X}
X
X################ reply <address> ################
X
Xsub cmd_reply {
X    return &errmsg ("$cmd command must precede all other commands")
X    if @workq + @searchq + @indexq;
X
X    shift (@cmd) if $cmd[0] =~ /^to$/i;
X
X    return &errmsg ("Usage: $cmd email-address") if @cmd != 1;
X
X    &parse_addresses ($cmd[0]);
X    return &errmsg ("Invalid return address: \"$cmd[0]\"")
X    if @rfc822'addresses != 1;    #';
X
X    $recipient = shift (@rfc822'addresses);    #');
X    push (@workq, &zp ("M", $recipient));
X    print STDOUT "=> Return address: \"$recipient\"\n";
X    1;
X}
X
X################ mail <address> ################
X
Xsub cmd_mail {
X    if ( @cmd == 0 && $interactive && $method ) {
X    &method_msg;
X    return 1;
X    }
X
X    return &errmsg ("$cmd command must precede other commands")
X    if $method && !$interactive;
X
X    shift (@cmd) if $cmd[0] =~ /^to$/i;
X
X    return &errmsg ("Usage: $cmd email-address") if @cmd != 1;
X
X    &parse_addresses ($cmd[0]);
X    return &errmsg ("Invalid return address: \"$sender\"")
X    if @rfc822'addresses != 1;    #';
X
X    &email_defaults ($rfc822'addresses[0]);    #');
X    1;
X}
X
X################ uucp <path> ################
X
Xsub cmd_uucp {
X    if ( @cmd == 0 && $interactive && $method ) {
X    &method_msg;
X    return 1;
X    }
X
X    return &errmsg ("$cmd command must precede other commands")
X    if $method && !$interactive;
X
X    local ($msg) = "Usage: $cmd host!path user";
X
X    shift (@cmd) if $cmd[0] =~ /^to$/i;
X
X    if ( @cmd < 2 && $h_uufrom && $h_uuhost ) {
X    if ( @cmd == 0 ) {
X        @cmd = ('!', '');
X    }
X    elsif ( @cmd == 1 ) {
X        if ($cmd[0] =~ /^\w[-\w]*$/ ) {
X        unshift (@cmd, '!');
X        }
X        else {
X        push (@cmd, '');
X        }
X    }
X    }
X
X    return &errmsg ($msg) unless @cmd == 2;
X
X    local ($uupath, $uunote) = @cmd;
X
X    if ( $uupath !~ /!/ && $h_uuhost ) {
X    $uupath = $h_uuhost . '!' . $uupath;
X    }
X
X    if ( $uupath =~ /!/ ) {
X    &uucp_defaults ($`, $', $uunote);
X    }
X    else {
X    return &errmsg ($msg);
X    }
X    1;
X}
X
X################ limit [ <number>[K] ] ################
X
Xsub cmd_limit {
X    if ( @cmd == 0 ) {
X    push (@workq, &zp ("L", $limits[1]));
X    print STDOUT "=> Limit = $limits[1]K (default)\n";
X    }
X    elsif ( $cmd[0] =~ /^(\d+)K?$/i ) {
X    local ($new) = $1;
X    local ($msg) = "LIMIT must be between ".
X        "$limits[0]K and $limits[2]K";
X
X    if ( $new < $limits[0] ) {
X        $new = $limits[0];
X        &warning ($msg);
X    }
X    elsif ( $new > $limits[2] ) {
X        $new = $limits[2];
X        &warning ($msg);
X    }
X    push (@workq, &zp ("L", $new));
X    print STDOUT "=> Limit = ${new}K\n";
X    }
X    else {
X    return &errmsg ("Usage: $cmd [ number[K] ]");
X    }
X    1;
X}
X
X################ various encoders ################
X
Xsub cmd_encode {
X    if (  @cmd == 1 ) {
X    local ($tag) = shift (@cmd);
X    return &cmd_uuencode
X        if $tag =~ /^uu(en|de)cod(e|ing)$/i;
X    return &cmd_xxencode
X        if $tag =~ /^xx(en|de)cod(e|ing)$/i;
X    return &cmd_uue
X        if $tag =~ /^uu(e|d)$/i;
X    return &cmd_btoa
X        if $tag =~ /^(btoa|atob)$/i;
X    }
X    return &errmsg ("Usage: $cmd [ uuencode | xxencode | uue | btoa ]")
X}
Xsub cmd_uuencode {
X    &setencoding ("uuencoding", $uuencode, "U");
X}
Xsub cmd_xxencode {
X    &setencoding ("xxencoding", $xxencode, "X");
X}
Xsub cmd_uue {
X    &setencoding ("uue", $uue, "D");
X}
Xsub cmd_btoa {
X    &setencoding ("btoa", $btoa, "B");
X}
X
Xsub setencoding {
X    local ($tag, $encoder, $encoding) = @_;
X    if ( @cmd == 0 ) {
X    if ( -x $encoder ) {
X        push (@workq, &zp ("E", $encoding));
X        print STDOUT "=> Encoding = $encoding ($tag)\n";
X    }
X    else {
X        print STDOUT "=> Encoding '$tag' not available\n";
X    }
X    }
X    else {
X    $tag =~ tr/a-z/A-Z/;
X    &errmsg ("$tag does not take any arguments");
X    }
X}
X
Xsub cmd_compress {
X    &cmd_ignore;
X    print STDOUT <<EOD if $auto_compress;
X=> If you request 'file.Z' I'll compress it automatically if I find
X   an uncompressed version of it.
XEOD
X    1;
X}
X
X################ send <item> [ <item>...] ################
X
Xsub cmd_send {
X    return &errmsg ("Usage: $cmd item [ item ... ]") unless @cmd > 0;
X
X    local ($ftphost) = $ftphost;
X    foreach $item ( @cmd ) {
X    if ( $item =~ m:(^\.|/\.|[*?%]): ) {
X        return &errmsg ("Illegal request");
X    }
X    if ( $item =~ /:/ || $ftphost ) {
X        return 1 unless &check_ftp;
X        push (@workq, &zp ('G', 'G', $curdir.$item));
X        print STDOUT "=> Send: $curdir$item\n";
X    }
X    else {
X        return 1 unless &setdefaults;
X        push (@workq, &zp ("S", $curdir.$item));
X        print STDOUT "=> Send: $curdir$item\n";
X    }
X    }
X    1;
X}
X
X################ resend <item> <number> [ <number>...] ################
X
Xsub cmd_resend {
X    local ($msg) = "Usage: $cmd item part# [ part# ... ]";
X
X    return &errmsg ($msg) unless @cmd > 1;
X
X    local ($item) = shift (@cmd);
X    local ($plist) = "";
X    local ($ftphost) = $ftphost;
X
X    if ( $item =~ m:(^\.|/\.|[*?%]): ) {
X    return &errmsg ("Illegal request");
X    }
X    foreach $num (@cmd) {
X    if ( $num =~ /^\d+$/ ) {
X        $plist .= 0+$num . ",";
X    }
X    else {
X        return &errmsg ($msg);
X    }
X    }
X    if ( $item =~ /:/ || $ftphost ) {
X    return 1 unless &check_ftp;
X    chop ($plist);
X    push (@workq, &zp ('G', 'G', $curdir.$item, $plist));
X    print STDOUT ("=> Resend: $curdir$item, part",
X              (@plist > 0) ? "s " : " ",
X              $plist, "\n");
X    }
X    else {
X    return 1 unless &setdefaults;
X    chop ($plist);
X    push (@workq, &zp ("S", $curdir.$item, $plist));
X    print STDOUT ("=> Resend: $curdir$item, part",
X              (@plist > 0) ? "s " : " ",
X              $plist, "\n");
X    }
X    1;
X}
X
X################ pack ################
X
Xsub cmd_pack {
X    if ( @cmd != 1 ) {
X    return     &errmsg ("Usage: $cmd { ".
X         (-x $tar ? "tar | " : "").
X         (-x $zip ? "zip | " : "").
X         (-x $zoo ? "zoo | " : "").
X         "off }");
X    }
X
X    local ($packing);
X
X    ($packing = $cmd[0]) =~ tr/[A-Z]/[a-z]/;
X    if ( ($packing eq "tar" && (-x $tar || -x $pdtar)) ||
X     ($packing eq "zip" && -x $zip) ||
X     ($packing eq "zoo" && -x $zoo) ) {
X    push (@workq, &zp ("P", $packing));
X    print STDOUT ("=> Subsequent requests must be directories",
X              " that will be ",
X              "packed using '$packing'.\n",
X              "   Note that a limit of ",
X              int ($packing_limit/2),
X              " Kbytes applies to each request.\n",
X              "   Requests exceeding this limit ",
X              "will be discarded.\n");
X    }
X    elsif ( $packing eq "off" ) {
X    push (@workq, &zp ("P"));
X    print STDOUT "=> No more packing\n";
X    }
X    else {
X    return &errmsg ("Wrong argument for PACK");
X    }
X    1;
X}
X
X################ search <item> [ <item>...] ################
X
Xsub cmd_search {
X    return &errmsg ("Usage: $cmd item [ item ... ]") unless @cmd > 0;
X
X    foreach $item ( @cmd ) {
X    if ( $item =~ m:(^\.|/\.|[*?%]): ) {
X        return &errmsg ("Illegal request");
X    }
X    push (@searchq, $curdir.$item);
X    print STDOUT "=> Search: $curdir$item\n";
X    }
X    1;
X}
X
X################ index ################
X
Xsub cmd_index {
X    return 0 unless @cmd == 0 || defined $indexfile;
X
X    if ( @cmd == 0 ) {
X    return 1 unless &setdefaults;
X    push (@workq, &zp ("S", $curdir."INDEX"));
X    print STDOUT "=> Send: ${curdir}INDEX\n";
X    }
X    elsif ( @cmd > 0 ) {
X    foreach $item ( @cmd ) {
X        if ( $item =~ m:(^\.|/\.|[*?%]): ) {
X        return &errmsg ("Illegal request");
X        }
X        push (@indexq, $curdir.$item);
X        print STDOUT "=> Index: $curdir$item\n";
X    }
X    }
X    else {
X    return &errmsg ("Usage: $cmd item [ item ... ]");
X    }
X    1;
X}
X
X################ help ################
X
Xsub cmd_help {
X    return &errmsg ("HELP does not take any arguments ".
X            "(but you'll get help anyway)")
X    if @cmd != 0;
X
X    if ( $interactive ) {
X    &help;
X    }
X    else {
X    print STDOUT ("=> Okay, I'll append some help ".
X              "at the end of this message\n");
X    $needhelp = 1;
X    }
X    1;
X}
X
X################ CWD ################
X
Xsub cmd_request {
X    if ( $cmd[0] =~ /^end$/i ) {
X    shift @cmd;
X    return &cmd_end;
X    }
X    &cmd_cwd;
X}
X
Xsub cmd_cwd {
X    if ( @cmd == 0 ) {
X    print STDOUT ("=> No current directory\n");
X    $curdir = "";
X    return 1;
X    }
X    elsif ( @cmd == 1 ) {
X    if ( $cmd[0] =~ m:(^\.|/\.|[*?%]): ) {
X        return &errmsg ("Illegal directory");
X    }
X
X    $curdir = $cmd[0];
X    print STDOUT ("=> Current directory = $curdir\n");
X    $curdir .= "/"
X        unless $curdir =~ m|/$| || $curdir =~ /^\[.*\]$/;
X    }
X    else {
X    return &errmsg ("Usage: $cmd [ path ]");
X    }
X    1;
X}
X
X################ DIR ################
X
Xsub cmd_dir {
X    return &errmsg ("Usage: $cmd [filename]") if @cmd > 1;
X
X    local ($item) = $curdir . shift (@cmd);
X    if ( $item eq '' && $ftphost eq '' ) {
X    return &errmsg ("No current directory");
X    }
X
X    if ( $item =~ m:(^\.|/\.|[\047]): ) {
X    return &errmsg ("Illegal directory");
X    }
X
X    local ($ftphost) = $ftphost;
X    if ( $item =~ /:/ || $ftphost ) {
X    &check_ftp || return 1;
X    push (@workq, &zp ('G', 'O', $ftphost));
X    push (@workq, &zp ('G', 'D', $item));
X    }
X    else {
X    return 1 unless &setdefaults;
X    $item = $` if $item =~ m|/+$|;
X    push (@workq, &zp ('D', $item));
X    }
X
X    print STDOUT ("=> Dir: $item\n");
X    1;
X}
X
X################ FTP ################
X
Xsub cmd_ftp {
X    local ($subcmd);
X    ($subcmd = shift (@cmd)) =~ tr/A-Z/a-z/;
X
X    if ( $subcmd =~ /^[-\w]+\.[-\w.]*$/ ) {
X    unshift (@cmd, $subcmd);
X    $subcmd = "open";
X    }
X
X    if ( $subcmd eq "open" ) {
X    if ( @cmd != 1 ) {
X        return &errmsg ("Usage: $cmd $subcmd hostname");
X    }
X    &ftp_defaults (shift (@cmd)) || return 1;
X    }
X    elsif ( $subcmd eq "close" ) {
X    if ( @cmd > 0 ) {
X        return &errmsg ("Usage: $cmd $subcmd");
X    }
X    $ftphost = '';
X    push (@workq, &zp ('G', 'C'));
X    print STDOUT ("=> Okay\n");
X    }
X    elsif ( $subcmd eq "user" ) {
X    if ( @cmd == 0 || $cmd > 2 ) {
X        return &errmsg ("Usage: $cmd $subcmd login [password]");
X    }
X    push (@cmd, $recipient) if @cmd == 1;
X    push (@workq, &zp ('G', 'U', @cmd));
X    print STDOUT ("=> FTP Login: @cmd\n");
X    }
X    else {
X    return &errmsg ("Invalid $cmd subcommand: \"$subcmd\"");
X    }
X    1;
X}
X
X################ ARCHIE ################
X
X
X#        local ($flags) = '';
X#        local ($subcmd);
X#        local ($usage) = "Usage: archie [-cersl] [-mNN] arg";
X#        local ($arg) = pop (@cmd);
X#
X#        while ( @cmd ) {
X#        $subcmd = shift (@cmd);
X#        if ( $subcmd !~ /^-/ ) {
X#            &errmsg ($usage.1);
X#            next COMMAND_LOOP;
X#        }
X#        $subcmd = $';
X#        while ( $subcmd ) {
X#            if ( $subcmd =~ /^[cersl]/i ) {
X#            $flags .= " -\l$+";
X#            $subcmd = $';
X#            }
X#            elsif ( $subcmd =~ /^m\d+/i ) {
X#            $subcmd = $';
X#            $flags .= " -\l$+";
X#            }
X#            else {
X#            &errmsg ($usage.2);
X#            next COMMAND_LOOP;
X#            }
X#        }
X#        }
X#
X#        if ( $arg =~ /'";\\\s/ ) {
X#        &errmsg ("Invalid argument to Archie");
X#        next COMMAND_LOOP;
X#        }
X#        $flags =~ s/^\s+//;
X#        return 1 unless &setdefaults;
X#        push (@workq, &zp ('A', $arg, $flags));
X#        print STDOUT ("=> Archie: $flags $arg\n");
X#    }
X
Xsub cmd_archie {
X    local ($subtype);
X    local ($subcmd) = shift (@cmd);
X    local ($arg) = shift (@cmd);
X    local ($usage) = "Usage: ARCHIE PROG regexp";
X
X    if ( $subcmd =~ /^prog$/i ) {
X    $subtype = 'P';
X    }
X    else {
X    return &errmsg ($usage);
X    }
X
X#    if ( $arg =~ /'";\\\s/ ) {
X#    return &errmsg ("Invalid argument to Archie");
X#    }
X
X    return 1 unless &setdefaults;
X    push (@workq, &zp ('A', $subtype, $arg));
X    print STDOUT ("=> Archie: \L$subcmd\E $arg\n");
X    1;
X}
X
X################ test ################
X
Xsub cmd_test {
X    return 0 unless @cmd == 0;
X
X    $opt_noqueue = 1;
X    $didhelp = 1;
X    print STDOUT "=> Okay\n";
X    1;
X}
X
X################ subroutines ################
X
Xsub check_ftp {
X
X    # Check for implicit FTP in $item.
X    # Sets up FTP if allowed.
X    # Modifies $item if needed.
X
X    unless ( $ftp ) {
X    &errmsg ("Illegal request");
X    return 0;
X    }
X
X    if ( $ftphost ) {
X    if ( $item =~ /:/ ) {
X        if ( $` ne $ftphost) {
X        &errmsg ("Use FTP CLOSE before " .
X             "connecting to another host");
X        return 0;
X        }
X        $item = $';
X    }
X    return 1;
X    }
X
X    $item = $';
X    return &ftp_defaults ($`);
X}
X
X################ 1 ################
X1;
END_OF_FILE
  if test 17491 -ne `wc -c <'mserv-3.1/pr_parse.pl'`; then
    echo shar: \"'mserv-3.1/pr_parse.pl'\" unpacked with wrong size!
  fi
  # end of 'mserv-3.1/pr_parse.pl'
fi
echo shar: End of archive 4 \(of 6\).
cp /dev/null ark4isdone
MISSING=""
for I in 1 2 3 4 5 6 ; do
    if test ! -f ark${I}isdone ; then
    MISSING="${MISSING} ${I}"
    fi
done
if test "${MISSING}" = "" ; then
    echo You have unpacked all 6 archives.
    rm -f ark[1-9]isdone
else
    echo You still must unpack the following archives:
    echo "        " ${MISSING}
fi
exit 0
exit 0 # Just in case...