home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1994 March / Source_Code_CD-ROM_Walnut_Creek_March_1994.iso / compsrcs / misc / volume34 / mserv / part06 < prev    next >
Encoding:
Text File  |  1993-01-05  |  52.1 KB  |  1,855 lines
  1. Newsgroups: comp.sources.misc
  2. From: jv@squirrel.mh.nl (Johan Vromans)
  3. Subject: v34i097:  mserv - Squirrel Mail Server Software, version 3.1, Part06/06
  4. Message-ID: <1993Jan7.035021.11861@sparky.imd.sterling.com>
  5. X-Md4-Signature: 12f4bd265872fd362578dfc193d06659
  6. Date: Thu, 7 Jan 1993 03:50:21 GMT
  7. Approved: kent@sparky.imd.sterling.com
  8.  
  9. Submitted-by: jv@squirrel.mh.nl (Johan Vromans)
  10. Posting-number: Volume 34, Issue 97
  11. Archive-name: mserv/part06
  12. Environment: Perl
  13. Supersedes: mserv-3.0: Volume 30, Issue 46-49
  14.  
  15. #! /bin/sh
  16. # This is a shell archive.  Remove anything before this line, then feed it
  17. # into a shell via "sh file" or similar.  To overwrite existing files,
  18. # type "sh file -c".
  19. # Contents:  mserv-3.1/CRONTAB.sample mserv-3.1/README
  20. #   mserv-3.1/do_runq.sh mserv-3.1/dr_pack.pl mserv-3.1/dr_uucp.pl
  21. #   mserv-3.1/ixlookup.patch mserv-3.1/makeindex.pl
  22. #   mserv-3.1/ms_common.pl mserv-3.1/ms_lock.pl mserv-3.1/mserv.hints
  23. #   mserv-3.1/mserv.notes mserv-3.1/patchlevel.h
  24. #   mserv-3.1/pr_doindex.pl mserv-3.1/pr_dsearch.pl
  25. #   mserv-3.1/pr_isearch.pl mserv-3.1/rfc822.pl mserv-3.1/testlock.pl
  26. #   mserv-3.1/ud_sample2.pl mserv-3.1/unpack.pl
  27. # Wrapped by kent@sparky on Wed Jan  6 21:39:50 1993
  28. PATH=/bin:/usr/bin:/usr/ucb:/usr/local/bin:/usr/lbin ; export PATH
  29. echo If this archive is complete, you will see the following message:
  30. echo '          "shar: End of archive 6 (of 6)."'
  31. if test -f 'mserv-3.1/CRONTAB.sample' -a "${1}" != "-c" ; then 
  32.   echo shar: Will not clobber existing file \"'mserv-3.1/CRONTAB.sample'\"
  33. else
  34.   echo shar: Extracting \"'mserv-3.1/CRONTAB.sample'\" \(302 characters\)
  35.   sed "s/^X//" >'mserv-3.1/CRONTAB.sample' <<'END_OF_FILE'
  36. X# CRONTAB -- cron entries for mail server -- @(#)@ CRONTAB.sample    1.3
  37. X30 0,2,4,6,18,20,22 * * * /usr/local/lib/mserv/do_runq
  38. X0 3 * * * /usr/local/lib/mserv/makeindex
  39. X0 7 * * * /usr/local/lib/mserv/do_report -errors -since .errrun
  40. X10 7 * * 7 /usr/local/lib/mserv/do_report -full -collect -ftp -ftpclean
  41. END_OF_FILE
  42.   if test 302 -ne `wc -c <'mserv-3.1/CRONTAB.sample'`; then
  43.     echo shar: \"'mserv-3.1/CRONTAB.sample'\" unpacked with wrong size!
  44.   fi
  45.   # end of 'mserv-3.1/CRONTAB.sample'
  46. fi
  47. if test -f 'mserv-3.1/README' -a "${1}" != "-c" ; then 
  48.   echo shar: Will not clobber existing file \"'mserv-3.1/README'\"
  49. else
  50.   echo shar: Extracting \"'mserv-3.1/README'\" \(2770 characters\)
  51.   sed "s/^X//" >'mserv-3.1/README' <<'END_OF_FILE'
  52. X    Announcing: Squirrel Mail Server Software, version 3.1
  53. X    ======================================================
  54. X
  55. XFor the user:
  56. X-------------
  57. XThe Squirrel Mail Server is a mail response program. You can send
  58. Xemail to it, and it will try to react sensible to your message.
  59. X
  60. XMain purpose of the mail server is to obtain files from a local
  61. Xarchive or FTP servers. It is also possible to search for files and to
  62. Xgenerate directory listings. A powerful index mechanism obsoletes the
  63. Xneed to transfer huge "ls-lR" files.
  64. X
  65. XWhile looking for files, the server knows about commonly used
  66. Xextensions to filenames (e.g. ".tar.Z" in "foo.tar.Z") and pseudo-
  67. Xstandard version numbering (e.g. "gcc-2.1.tar.Z").  It is quite well
  68. Xpossible that a simple request for "emacs" will actually transmit the
  69. Xfile "gnu/emacs-18/dist/emacs-18.59.tar.Z".
  70. X
  71. XDelivery of information can take place via email or UUCP or both.
  72. XFiles are compressed if possible, encoded if necessary, and split into
  73. Xpieces if needed. If a transfer fails, it it always possible to
  74. Xrequest retransmission of the failed parts only.
  75. X
  76. XFor the implementor:
  77. X--------------------
  78. XAll written in perl, hence portable and easily maintainable.  Code is
  79. Xreadable; useful, plentiful comments. Very extentable and easily
  80. Xmodified. Easy to install. Over 2000 lines of documentation.
  81. X
  82. XArchives can be split over a number of directories or file systems.
  83. X
  84. XRequests are queued and processed by a separate daemon process (e.g.
  85. Xfrom cron) to cut down on the system load. Moreover, the implementor
  86. Xcan control when the queue is being run.
  87. X
  88. XAll transfers are logged. Maintenance procedures include a reporting
  89. Xtool.
  90. X
  91. XFiles retrieved via FTP are kept on local store for some time, so
  92. Xsubsequent requests can be honoured from the cache.
  93. X
  94. XRequirements:
  95. X-------------
  96. XPerl 4.0 patchlevel 35 or later.
  97. XNOTE that perl 4.0 pl35 contains a bug that can be fixed by an
  98. X(unofficial) patch obtainable from the NLUUG mail server -- see below.
  99. X
  100. XGNU find 3.6 or later (only if you want to exploit the index
  101. Xfeatures).
  102. X
  103. XA decent mail system that can deliver mail to a process (sendmail,
  104. Xsmail3, or smail2.5 w/ mods).
  105. X
  106. XCommon tools like compress, zoo, zip, uuencode etc.
  107. X
  108. XHow to get it:
  109. X--------------
  110. XSend a mail message to <mail-server@nluug.nl> with contents
  111. X
  112. X    begin
  113. X    send mserv-3.1.tar.Z
  114. X    send XPatch-4.035.tar.Z
  115. X    end
  116. X
  117. XThe latter file contains some unofficial patches to perl 4.0
  118. Xpatchlevel 35.
  119. X
  120. XAlso available are nicely formatted PostScript versions of the 
  121. XUser Guide and Installation Guide:
  122. X
  123. X    send usrguide.ps.Z
  124. X    send mservmgr.ps.Z
  125. X
  126. XThe Squirrel Mail Server Software is 
  127. X
  128. X    Copyright 1988,1992,1993 Johan Vromans.
  129. X
  130. XIt is distributed under the terms of the GNU Public Licence.
  131. X
  132. XFor more information: Johan Vromans <jv@mh.nl> .
  133. END_OF_FILE
  134.   if test 2770 -ne `wc -c <'mserv-3.1/README'`; then
  135.     echo shar: \"'mserv-3.1/README'\" unpacked with wrong size!
  136.   fi
  137.   # end of 'mserv-3.1/README'
  138. fi
  139. if test -f 'mserv-3.1/do_runq.sh' -a "${1}" != "-c" ; then 
  140.   echo shar: Will not clobber existing file \"'mserv-3.1/do_runq.sh'\"
  141. else
  142.   echo shar: Extracting \"'mserv-3.1/do_runq.sh'\" \(328 characters\)
  143.   sed "s/^X//" >'mserv-3.1/do_runq.sh' <<'END_OF_FILE'
  144. X#!/bin/sh
  145. X# do_runq.sh -- run mail server queue
  146. X# SCCS Status     : @(#)@ do_runq    1.1
  147. X# Author          : Johan Vromans
  148. X# Created On      : Sat May  2 14:15:16 1992
  149. X# Last Modified By: Johan Vromans
  150. X# Last Modified On: Sat May  2 14:16:50 1992
  151. X# Update Count    : 1
  152. X# Status          : OK
  153. X
  154. Xexec `dirname $0`/dorequest ${1+"$@"}
  155. END_OF_FILE
  156.   if test 328 -ne `wc -c <'mserv-3.1/do_runq.sh'`; then
  157.     echo shar: \"'mserv-3.1/do_runq.sh'\" unpacked with wrong size!
  158.   fi
  159.   # end of 'mserv-3.1/do_runq.sh'
  160. fi
  161. if test -f 'mserv-3.1/dr_pack.pl' -a "${1}" != "-c" ; then 
  162.   echo shar: Will not clobber existing file \"'mserv-3.1/dr_pack.pl'\"
  163. else
  164.   echo shar: Extracting \"'mserv-3.1/dr_pack.pl'\" \(2830 characters\)
  165.   sed "s/^X//" >'mserv-3.1/dr_pack.pl' <<'END_OF_FILE'
  166. X# dr_pack.pl -- handle packing
  167. X# SCCS Status     : @(#)@ dr_pack.pl    3.3
  168. X# Author          : Johan Vromans
  169. X# Created On      : Thu Jun  4 22:22:49 1992
  170. X# Last Modified By: Johan Vromans
  171. X# Last Modified On: Sat Dec 12 01:56:08 1992
  172. X# Update Count    : 8
  173. X# Status          : OK
  174. X
  175. Xsub pack_mail_request {
  176. X    local ($rcpt, $dest, $uunote, $request, $file, 
  177. X       $coding, $limit, $packing, $parts) = @_;
  178. X
  179. X    if ( $opt_debug ) {
  180. X    print STDERR ("&pack_mail_request(rcpt=$rcpt, address=$dest, ",
  181. X              "request=$request,\n",
  182. X              "    file=$file,\n",
  183. X              "    limit=$limit, packing=$packing, parts=$parts)\n");
  184. X    }
  185. X
  186. X    ($request, $file) = &packing ($request, $file, $packing);
  187. X    require "$libdir/dr_mail.pl";
  188. X    &mail_request ($rcpt, $dest, $uunote, $request, $file, 
  189. X           $coding, $limit, $parts);
  190. X    unlink ($file) unless $opt_keep;
  191. X}
  192. X
  193. Xsub pack_uucp_request {
  194. X    local ($rcpt, $uupath, $uunote, $request, $file, 
  195. X       $coding, $limit, $packing, $parts) = @_;
  196. X
  197. X    if ( $opt_debug ) {
  198. X    print STDERR ("&pack_uucp_request(rcpt=$rcpt, uupath=$uupath,\n",
  199. X              "    uunote=$uunote, request=$request,\n",
  200. X              "    file=$file,\n",
  201. X              "    limit=$limit, oacking=$packing, parts=$parts)\n");
  202. X    }
  203. X
  204. X    ($request, $file) = &packing ($request, $file, $packing);
  205. X    require "$libdir/dr_uucp.pl";
  206. X    &uucp_request ($rcpt, $uupath, $uunote, $request, $file, 
  207. X           $coding, $limit, $parts);
  208. X    unlink ($file) unless $opt_keep;
  209. X}
  210. X
  211. Xsub packing {
  212. X    local ($request, $file, $packing) = @_;
  213. X
  214. X    # Packs the files in directory $file into an $packing-archive, and
  215. X    # returns an array containing the modified name of the request
  216. X    # and the name of the archive file.
  217. X
  218. X    &check_file ($file, 1);
  219. X
  220. X    local ($dir, $realname) = &fnsplit ($file);
  221. X    local ($tmpfile_prefix) = $opt_keep || "$tmpdir/pck$$.";
  222. X    local ($cmd) = "$find $realname -follow -type f ! -name '.*' -print | ";
  223. X
  224. X    chdir $dir || &die ("Cannot chdir to $dir [$!]");
  225. X
  226. X    if ( $packing eq "tar" ) {
  227. X    $file = $tmpfile_prefix . "tar.Z";
  228. X    $cmd .= $pdtar ? "$pdtar -z -c -h -T - -f $file"
  229. X        : "$tar -c -h -T - -f - | $compress > $file";
  230. X    &system ($cmd);
  231. X    &die ("Problem executing \"$cmd\"") unless -s $file;
  232. X    return ($request . "-tar.Z", $file);
  233. X    }
  234. X
  235. X    if ( $packing eq "zoo" ) {
  236. X    $file = $tmpfile_prefix . "zoo";
  237. X    $cmd .= "$zoo aIqq $file";
  238. X    &system ($cmd);
  239. X    &die ("Problem executing \"$cmd\"") unless -s $file;
  240. X    return ($request . "-zoo", $file);
  241. X    }
  242. X
  243. X    if ( $packing eq "zip" ) {
  244. X    $file = $tmpfile_prefix . "zip";
  245. X    # It is not really necessary to use find for zip,
  246. X    # but this is the only way to exclude .-files.
  247. X    $cmd .= "$zip -n Z -q -b $tmpdir -@ $file";
  248. X    &system ($cmd);
  249. X    &die ("Problem executing \"$cmd\"") unless -s $file;
  250. X    return ($request . "-zip", $file);
  251. X    }
  252. X
  253. X    &die ("Invalid packing code in queue");
  254. X    (undef, undef);
  255. X}
  256. X
  257. X1;
  258. END_OF_FILE
  259.   if test 2830 -ne `wc -c <'mserv-3.1/dr_pack.pl'`; then
  260.     echo shar: \"'mserv-3.1/dr_pack.pl'\" unpacked with wrong size!
  261.   fi
  262.   # end of 'mserv-3.1/dr_pack.pl'
  263. fi
  264. if test -f 'mserv-3.1/dr_uucp.pl' -a "${1}" != "-c" ; then 
  265.   echo shar: Will not clobber existing file \"'mserv-3.1/dr_uucp.pl'\"
  266. else
  267.   echo shar: Extracting \"'mserv-3.1/dr_uucp.pl'\" \(3896 characters\)
  268.   sed "s/^X//" >'mserv-3.1/dr_uucp.pl' <<'END_OF_FILE'
  269. X# dr_uucp.pl -- handle request via uucp
  270. X# SCCS Status     : @(#)@ dr_uucp.pl    3.7
  271. X# Author          : Johan Vromans
  272. X# Created On      : Thu Jun  4 22:22:49 1992
  273. X# Last Modified By: Johan Vromans
  274. X# Last Modified On: Tue Dec 15 23:12:24 1992
  275. X# Update Count    : 25
  276. X# Status          : OK
  277. X
  278. Xsub uucp_request {
  279. X
  280. X    local ($rcpt, $uupath, $uunote, $request, $file, $encoding, $limit, $parts) = @_;
  281. X
  282. X    if ( $opt_debug ) {
  283. X    print STDERR ("&uucp_request(rcpt=$rcpt, uupath=$uupath,\n",
  284. X              "    uunote=$uunote, request=$request,\n",
  285. X              "    file=$file,\n",
  286. X              "    encoding=$encoding, limit=$limit, parts=$parts,",
  287. X              " remove=$remove_file)\n");
  288. X    }
  289. X
  290. X    # This routine handles the requests.
  291. X
  292. X    &check_file ($file, 0);
  293. X
  294. X    local ($fname);        # Basename of file to send
  295. X    local ($size);        # Size of file
  296. X    local ($files);        # Number of files to send
  297. X    local (@parts);        # List of parts to send
  298. X    local ($tmpfile_prefix) = $opt_keep || "$tmpdir/drq$$.";
  299. X    local ($compressed) = '';    # we compressed it
  300. X
  301. X    # Limit must be between 10 and 1024K, with 256K default.
  302. X    $limit =   32*1024 unless defined $limit;
  303. X    $limit = $` * 1024 if $limit =~ /K$/;
  304. X    $limit =   10*1024 if $limit <   10*1024;
  305. X    $limit = 1024*1024 if $limit > 1024*1024;
  306. X
  307. X    # Build an acceptable filename for uucp.
  308. X    if ( $request =~ m|[\s\047\042?%*{}]| ) {
  309. X    $fname = (&fnsplit ($file))[1];
  310. X    }
  311. X    else {
  312. X    if ( index ($request, $tmpdir) == $[ ) {
  313. X        # Get last part (basename) of the requested file.
  314. X        $fname = (&fnsplit ($request))[1];
  315. X    }
  316. X    else {
  317. X        $fname = &canon_fname ($request);
  318. X    }
  319. X    }
  320. X
  321. X    # Compress first, if requested.
  322. X    if ( $encoding =~ /^[^ap].*z$/i && $compress ) {
  323. X    local ($tmp) = &fttemp;
  324. X    print STDERR ("Using compression\n") if $opt_debug;
  325. X    &system ("$compress < $file > $tmp");
  326. X    if ( $remove_file ) {
  327. X        print STDERR ("Unlinking $file\n") if $opt_debug;
  328. X        unlink ($file);
  329. X    }
  330. X    $remove_file = 1;
  331. X    $file = $tmp;
  332. X    $compressed = chop ($encoding);
  333. X    }
  334. X
  335. X    $size = (stat ($file))[7];
  336. X    if ( $size > $limit ) {
  337. X
  338. X    open (F, $file) || &die ("Cannot read $file [$!]");
  339. X
  340. X    $files = int (($size - 1 ) / $limit) + 1;
  341. X    print STDERR ("Size = $size, files = $files\n")
  342. X        if $opt_debug;
  343. X
  344. X    if (  $parts =~ /\S/ ) {
  345. X        @parts = grep ($_ && $_ <= $files, split (/,/, $parts));
  346. X    }
  347. X    else {
  348. X        @parts = (1..$files);
  349. X    }
  350. X    
  351. X    local ($i) = length "$files";
  352. X    local ($partfmt) = "part%0${i}dof%0${i}d";
  353. X    
  354. X    foreach $the_part ( @parts ) {
  355. X
  356. X        local ($cnt) = 0;
  357. X        local ($need) = $limit;
  358. X        local ($uutmp) = $tmpfile_prefix . "uu";
  359. X
  360. X        print STDERR ("Sending $file, part $the_part of $files\n")
  361. X        if $opt_debug;
  362. X
  363. X        seek (F, ($the_part-1) * $limit, 0);
  364. X        open (S, ">$uutmp") || &die ("Cannot create $uutmp [$!]");
  365. X        while ( $need > 0 ) {
  366. X        local ($try) = 10240;
  367. X        $try = $need if $try > $need;
  368. X        $res = sysread (F, $buf, $try);
  369. X        last unless defined $res && $res > 0;
  370. X        syswrite (S, $buf, $res);
  371. X        $need -= $res;
  372. X        $cnt += $res;
  373. X        }
  374. X        close (S);
  375. X
  376. X        # Send it (w/ copy to UUCP spool).
  377. X        &system ("$uucp -d -r -C -n$uunote $uutmp ".
  378. X             "$uupath/$fname/".sprintf ($partfmt, $the_part, $files));
  379. X
  380. X        # Write a log message.
  381. X        $uupath =~ /!/;
  382. X        &writelog ("U \"$`!$uunote\" $request $compressed$the_part".
  383. X               "/$files $cnt");
  384. X
  385. X        unlink ($uutmp) unless $opt_keep;
  386. X    }
  387. X    close (F);
  388. X    }
  389. X    else {
  390. X    print STDERR ("Sending file: ", $file, "\n")
  391. X        if $opt_debug;
  392. X
  393. X    # Send it. Prevent copy to spool if possible.
  394. X    $cmd = "$uucp -d -r " .
  395. X           ($remove_file ? '-C' : '-c') .
  396. X           " -n$uunote $file $uupath/$fname";
  397. X
  398. X    if ( $opt_nouucp ) {
  399. X        print STDERR ("[Would call \"$cmd\"]\n");
  400. X    }
  401. X    else {
  402. X        &system ($cmd);
  403. X    }
  404. X
  405. X    # Write a log message.
  406. X    $uupath =~ /!/;
  407. X    &writelog ("U \"$`!$uunote\" $request ${compressed}1/1 $size");
  408. X    }
  409. X
  410. X    if ( $remove_file ) {
  411. X    print STDERR ("Unlinking $file\n") if $opt_debug;
  412. X    unlink ($file);
  413. X    }
  414. X}
  415. X
  416. X1;
  417. END_OF_FILE
  418.   if test 3896 -ne `wc -c <'mserv-3.1/dr_uucp.pl'`; then
  419.     echo shar: \"'mserv-3.1/dr_uucp.pl'\" unpacked with wrong size!
  420.   fi
  421.   # end of 'mserv-3.1/dr_uucp.pl'
  422. fi
  423. if test -f 'mserv-3.1/ixlookup.patch' -a "${1}" != "-c" ; then 
  424.   echo shar: Will not clobber existing file \"'mserv-3.1/ixlookup.patch'\"
  425. else
  426.   echo shar: Extracting \"'mserv-3.1/ixlookup.patch'\" \(1123 characters\)
  427.   sed "s/^X//" >'mserv-3.1/ixlookup.patch' <<'END_OF_FILE'
  428. X# ixlookup.patch -- patch to GNU locate
  429. X# SCCS Status     : @(#)@ ixlookup.patch    1.3
  430. X# Author          : Johan Vromans
  431. X# Created On      : Thu May  7 20:51:33 1992
  432. X# Last Modified By: Johan Vromans
  433. X# Last Modified On: Wed Jun 10 11:57:25 1992
  434. X# Update Count    : 2
  435. X# Status          : OK
  436. X
  437. XThis patch enhances GNU locate with the possibility to select a
  438. Xdatabase using environment variable FCODES.
  439. X
  440. XThis patch is based on GNU find 3.5.
  441. X
  442. X*** /usr/local/src/find-3.5/locate/locate.c    Tue Dec 24 08:37:44 1991
  443. X--- ixlookup.c    Wed Apr 22 13:28:51 1992
  444. X***************
  445. X*** 97,106 ****
  446. X    int path_max;
  447. X    char bigram1[128], bigram2[128];
  448. X    int found = NO;
  449. X  
  450. X!   fp = fopen (FCODES, "r");
  451. X    if (fp == NULL)
  452. X!     error (1, errno, "%s", FCODES);
  453. X  
  454. X    path_max = PATH_MAX;
  455. X    if (path_max < 1)
  456. X--- 97,109 ----
  457. X    int path_max;
  458. X    char bigram1[128], bigram2[128];
  459. X    int found = NO;
  460. X+   char *fcodes = (char*) getenv ("LOCATE_DB");
  461. X+   if ( fcodes == NULL )
  462. X+     fcodes = FCODES;
  463. X  
  464. X!   fp = fopen (fcodes, "r");
  465. X    if (fp == NULL)
  466. X!     error (1, errno, "%s", fcodes);
  467. X  
  468. X    path_max = PATH_MAX;
  469. X    if (path_max < 1)
  470. END_OF_FILE
  471.   if test 1123 -ne `wc -c <'mserv-3.1/ixlookup.patch'`; then
  472.     echo shar: \"'mserv-3.1/ixlookup.patch'\" unpacked with wrong size!
  473.   fi
  474.   # end of 'mserv-3.1/ixlookup.patch'
  475. fi
  476. if test -f 'mserv-3.1/makeindex.pl' -a "${1}" != "-c" ; then 
  477.   echo shar: Will not clobber existing file \"'mserv-3.1/makeindex.pl'\"
  478. else
  479.   echo shar: Extracting \"'mserv-3.1/makeindex.pl'\" \(3594 characters\)
  480.   sed "s/^X//" >'mserv-3.1/makeindex.pl' <<'END_OF_FILE'
  481. X#!/usr/local/bin/perl
  482. X# makeindex.pl -- make index for mail server
  483. X# SCCS Status     : @(#)@ makeindex    1.11
  484. X# Author          : Johan Vromans
  485. X# Created On      : Tue Apr 21 20:36:56 1992
  486. X# Last Modified By: Johan Vromans
  487. X# Last Modified On: Wed Dec 23 23:02:37 1992
  488. X# Update Count    : 38
  489. X# Status          : Going steady
  490. X
  491. X# makeindex.pl, based on GNU find's updatedb.
  492. X$my_name = "makeindex";
  493. X$my_version = "1.11";
  494. X#
  495. X################ Common stuff ################
  496. X
  497. X$libdir = $ENV{"MSERVLIB"} || "/usr/local/lib/mserv";
  498. Xunshift (@INC, $libdir);
  499. X
  500. X################ Options handling ################
  501. X
  502. X&options if @ARGV > 0 && $ARGV[0] =~ /^-+[^-]+/;
  503. Xrequire "ms_common.pl";
  504. X@ARGV = ("-") unless @ARGV > 0;
  505. Xprint STDERR "$my_package [$my_name $my_version]\n"
  506. X    if defined $opt_ident;
  507. X
  508. X################ Setup ################
  509. X
  510. X&die ("Index search not selected -- nothing to do")
  511. X    unless $doindexsearch;
  512. X
  513. X# Work files.
  514. X$bigrams  = "$tmpdir/f.bigrams$$";
  515. X$filelist = "$tmpdir/f.list$$";
  516. X$errs     = "$tmpdir/f.errs$$";
  517. X
  518. X$SIG{"INT"}  = "catch";
  519. X$SIG{"QUIT"} = "catch";
  520. X$SIG{"HUP"}  = "IGNORE";
  521. X$SIG{"TERM"} = "catch";
  522. X
  523. X################ Go! ################
  524. X
  525. Xif ( $indexfile =~ m|^/| ) {
  526. X    # Create one single index file.
  527. X    &makeindex (defined $indexlib ? $indexlib : "@libdirs", $indexfile,
  528. X        shift(@libprunes));
  529. X}
  530. Xelse {
  531. X    # Create one index file per library dir.
  532. X    local (@prunes) = @libprunes;
  533. X    foreach $lib ( @libdirs ) {
  534. X    &makeindex ($lib, "$lib/$indexfile", shift(@prunes));
  535. X    }
  536. X}
  537. X
  538. Xexit (0);
  539. X
  540. X################ Subroutines ################
  541. X
  542. Xsub makeindex {
  543. X    local ($list, $indexfile, $pruneregex) = @_;
  544. X    local ($cmd) = "-follow ! -type d -printf \"%P\\t%k\\t%Ty%Tm%Td\\n\"";
  545. X
  546. X    $cmd = "\\( -type d -regex $pruneregex -prune \\) -o \\( $cmd \\)"
  547. X    if defined $pruneregex && $pruneregex ne "";
  548. X
  549. X    # Make a file list.  Alphabetize '/' before any other char with 'tr'.
  550. X    &system ("$gfind $list " . $cmd . " " .
  551. X         "| tr '/' '\\001' | sort -f 2> $errs " .
  552. X         "| tr '\\001' '/' > $filelist");
  553. X
  554. X    # Compute common bigrams.
  555. X    &system ("$locatelib/bigram < $filelist | sort 2>> $errs | uniq -c " .
  556. X         "| sort -nr | awk '{ if (NR <= 128) print \$2 }' " .
  557. X         "| tr -d '\\012' > $bigrams");
  558. X
  559. X    printf STDERR ($my_name, ": Out of sort space\n")
  560. X    if -s $errs;
  561. X
  562. X    # Code the file list.
  563. X    &system ("$locatelib/code $bigrams < $filelist > $indexfile~");
  564. X    &rename ("$indexfile~", $indexfile);
  565. X    chmod (0644, $indexfile);
  566. X
  567. X    &cleanup;
  568. X}
  569. X
  570. Xsub system {
  571. X    local ($cmd) = (@_);
  572. X    local ($ret);
  573. X    print STDERR ("+ $cmd\n");
  574. X    $ret = system ($cmd);
  575. X    &die (sprintf ("Return 0x%x from \"$cmd\"", $ret))
  576. X    unless $ret == 0;
  577. X    $ret;
  578. X}
  579. X
  580. Xsub rename {
  581. X    local ($old, $new) = @_;
  582. X    print STDERR ("+ rename $old $new\n");
  583. X    rename ($old, $new) || &system ("mv $old $new");
  584. X}
  585. X
  586. Xsub die {
  587. X    local ($msg) = (@_);
  588. X    warn ($my_name . ": " . $msg . "\n");
  589. X    &cleanup;
  590. X    exit (1);
  591. X}
  592. X
  593. Xsub catch {
  594. X    print STDERR ("+ Ouch!\n");
  595. X    &cleanup;
  596. X    exit(1);
  597. X}
  598. X
  599. Xsub cleanup {
  600. X    unlink ($bigrams, $filelist, $errs);
  601. X}
  602. X
  603. Xsub options {
  604. X    require "newgetopt.pl";
  605. X    if ( !&NGetOpt ("config=s", "debug", "ident", "trace", "help")
  606. X    || defined $opt_help ) {
  607. X    &usage;
  608. X    }
  609. X    $config_file = $opt_config if defined $opt_config;
  610. X}
  611. X
  612. Xsub usage {
  613. X    require "ms_common.pl";
  614. X    print STDERR <<EndOfUsage;
  615. X$my_package [$my_name $my_version]
  616. X
  617. XUsage: $my_name [options]
  618. X
  619. XOptions:
  620. X    -config XX    use alternate config file
  621. X    -help    this message
  622. X    -trace    show commands
  623. X    -ident    show identification
  624. X    -debug    for debugging
  625. XEndOfUsage
  626. X    exit (!defined $opt_help);
  627. X}
  628. END_OF_FILE
  629.   if test 3594 -ne `wc -c <'mserv-3.1/makeindex.pl'`; then
  630.     echo shar: \"'mserv-3.1/makeindex.pl'\" unpacked with wrong size!
  631.   fi
  632.   # end of 'mserv-3.1/makeindex.pl'
  633. fi
  634. if test -f 'mserv-3.1/ms_common.pl' -a "${1}" != "-c" ; then 
  635.   echo shar: Will not clobber existing file \"'mserv-3.1/ms_common.pl'\"
  636. else
  637.   echo shar: Extracting \"'mserv-3.1/ms_common.pl'\" \(4338 characters\)
  638.   sed "s/^X//" >'mserv-3.1/ms_common.pl' <<'END_OF_FILE'
  639. X# ms_common.pl -- common info for mail server
  640. X# SCCS Status     : @(#)@ ms_common    1.38
  641. X# Author          : Johan Vromans
  642. X# Created On      : Fri Apr 17 11:02:58 1992
  643. X# Last Modified By: Johan Vromans
  644. X# Last Modified On: Tue Jan  5 19:43:48 1993
  645. X# Update Count    : 110
  646. X# Status          : OK
  647. X
  648. X################ Preamble ################
  649. X#
  650. X# Package info. Do not change this.
  651. X$my_package = "Squirrel Mail Server Software V3.01";
  652. X#
  653. Xif ( defined $config_file && $config_file ne '' ) {
  654. X    require $config_file;
  655. X}
  656. Xelse {
  657. X    require "ms_config.pl";
  658. X}
  659. Xrequire "ms_lock.pl";
  660. X#
  661. X# It is not always clear if 'not setting' means 'not defining' or
  662. X# 'leaving it empty'.
  663. X# This guarantees some consistency.
  664. X
  665. Xundef $uucp
  666. X    unless defined $uucp && $uucp ne "";
  667. X$email = 1 unless defined $uucp;
  668. Xundef $email
  669. X    unless defined $email && $email;
  670. X$chunkmail = $sendmail
  671. X    unless defined $chunkmail && $chunkmail ne "";
  672. X$mserv_bcc = ""
  673. X    unless defined $mserv_bcc;
  674. Xundef $sender
  675. X    unless defined $sender && $sender ne "";
  676. Xundef $mailer_delay
  677. X    unless defined $mailer_delay && $mailer_delay > 0;
  678. Xundef $lockfile
  679. X    unless defined $lockfile && $lockfile ne "";
  680. Xundef $lock_lockf
  681. X    unless defined $lock_lockf && $lock_lockf != 0;
  682. Xundef $lock_flock
  683. X    unless defined $lock_flock && $lock_flock != 0;
  684. Xundef $lock_fcntl
  685. X    unless defined $lock_fcntl && $lock_fcntl != 0;
  686. Xundef $sender
  687. X    unless defined $sender && $sender ne "";
  688. Xundef @x_headers
  689. X    unless defined @x_headers && @x_headers ne 0;
  690. Xundef $logfile
  691. X    unless defined $logfile && $logfile ne "";
  692. Xundef $indexfile
  693. X    unless defined $indexfile && $indexfile ne "";
  694. Xundef $indexlib
  695. X    unless defined $indexfile && defined $indexlib && $indexlib ne "";
  696. X$maxindexlines = 0
  697. X    unless defined $maxindexlines && $maxindexlines > 0;
  698. X$uuname = ""
  699. X    unless defined $uuname;
  700. Xundef $auto_packing
  701. X    unless defined $auto_packing && $auto_packing && $packing_limit > 0;
  702. Xundef $packing_limit 
  703. X    unless defined $packing_limit && $packing_limit > 0;
  704. Xundef $pdtar
  705. X    unless defined $pdtar && $pdtar ne "";
  706. X$auto_runrequest = 0
  707. X    unless defined $auto_runrequest && $auto_runrequest > 0;
  708. X$auto_compress = 0
  709. X    unless defined $auto_compress && $auto_compress && $compress;
  710. Xundef @black_list
  711. X    unless defined @black_list && @black_list > 0;
  712. X
  713. X################ Subroutines ################
  714. X
  715. Xsub fnsplit {
  716. X    local ($file) = @_;
  717. X    # Normalize $file -> ($dir, $basename)
  718. X
  719. X    return ($1, $2) if $file =~ /^(\[.*\])(.*)$/;    # VMS
  720. X
  721. X    local (@path) = split (/\/+/, $file);
  722. X    (join ("/", @path[0..$#path-1]), $path[$#path]);
  723. X}
  724. X
  725. Xsub fttemp {
  726. X    $int'fttemp = 'aa' unless defined $int'fttemp;
  727. X    local ($thefile) = "$tmpdir/ft$$." . $int'fttemp;
  728. X    $int'fttemp++;
  729. X    $thefile;
  730. X}
  731. X
  732. Xsub canon_fname {
  733. X    local ($fname) = @_;
  734. X
  735. X    # Canonical form for filename.
  736. X
  737. X    if ( $fname =~ /^([-a-z0-9._]+):/i ) {
  738. X    &ftp_archname ($1, $');
  739. X    }
  740. X    else {
  741. X    &ftp_archname ('', $fname);
  742. X    }
  743. X}
  744. X
  745. Xsub ftp_archname {
  746. X    local ($host, $file) = @_;
  747. X
  748. X    # Transforms host:filename into ftp cache name.
  749. X
  750. X    # Reverse the elements of the host name, and lowcase it.
  751. X    local ($result) = '';
  752. X    $result = join ('/', reverse(split(/\./,$host))) . '/' if $host;
  753. X
  754. X    if ( $file =~ /^\[(\.?PUB)?([^\]]*)\]([^\[\]]+)$/i ) {
  755. X    # VMS file name.
  756. X    # $2 contains the path (with [ ] stripped), and
  757. X    # $3 the file name. 
  758. X    # $1 has been used to strip off an optional leading .PUB.
  759. X    $result .= join ('/', split(/\.+/, $2), $3);
  760. X
  761. X    # Lowercase the result.
  762. X    $result =~ tr/A-Z/a-z/;
  763. X    }
  764. X    else {
  765. X    # Assume UNIX file name.
  766. X    # Strip leading / and pub/ .
  767. X    $file = $' if $file =~ m|^/+|;
  768. X    $file = $' if $file =~ m|^pub/+|i;
  769. X
  770. X    # Lowcase the host name, and append the file.
  771. X    $result =~ tr/A-Z/a-z/;
  772. X    $result .= $file;
  773. X    }
  774. X
  775. X    # Squeeze multiple slashes.
  776. X    $result =~ s|//+|/|g;
  777. X
  778. X    $result;
  779. X}
  780. X
  781. Xsub writelog {
  782. X
  783. X    # Write message to logfile, if possible, Otherwise use STDERR.
  784. X
  785. X    local (@tm) = localtime (time);
  786. X    local ($msg) = sprintf ("%02d%02d%02d %02d:%02d %s\n", 
  787. X                $tm[5], $tm[4]+1, $tm[3], $tm[2], $tm[1], $_[0]);
  788. X
  789. X    if ( !$opt_nolog && defined $logfile && ( -w $logfile ) && 
  790. X    open (LOG, ">>" . $logfile) ) {
  791. X    if ( &locking (*LOG, 1) ) {
  792. X        seek (LOG, 0, 2);
  793. X        print LOG $msg;
  794. X        close LOG;
  795. X        return unless $opt_debug;
  796. X    }
  797. X    }
  798. X
  799. X    print STDERR $msg;
  800. X}
  801. X
  802. X################ 1 ################
  803. X1;
  804. X
  805. END_OF_FILE
  806.   if test 4338 -ne `wc -c <'mserv-3.1/ms_common.pl'`; then
  807.     echo shar: \"'mserv-3.1/ms_common.pl'\" unpacked with wrong size!
  808.   fi
  809.   # end of 'mserv-3.1/ms_common.pl'
  810. fi
  811. if test -f 'mserv-3.1/ms_lock.pl' -a "${1}" != "-c" ; then 
  812.   echo shar: Will not clobber existing file \"'mserv-3.1/ms_lock.pl'\"
  813. else
  814.   echo shar: Extracting \"'mserv-3.1/ms_lock.pl'\" \(2911 characters\)
  815.   sed "s/^X//" >'mserv-3.1/ms_lock.pl' <<'END_OF_FILE'
  816. X# ms_lock.pl -- locking
  817. X# SCCS Status     : @(#)@ ms_lock.pl    3.1
  818. X# Author          : Johan Vromans
  819. X# Created On      : Thu Jun  4 21:22:45 1992
  820. X# Last Modified By: Johan Vromans
  821. X# Last Modified On: Sat Jun  6 21:01:29 1992
  822. X# Update Count    : 67
  823. X# Status          : OK
  824. X
  825. X# This file defines the function 'locking' as follows:
  826. X#
  827. X#    &locking (*FH, $wait)
  828. X#
  829. X#    FH is a handle to an opened file, with r/w access.
  830. X#    $wait indicates if the process is to wait for the lock.
  831. X#
  832. X# Return values:
  833. X#     1  lock succeeded
  834. X#     0  lock not succeeded, $wait == 0
  835. X#    -1  lock failed
  836. X#
  837. X# Preferrably, &locking is implemented using the fcntl(2) system
  838. X# call that is available on most modern systems.
  839. X# As an alternative, code is included to use flock(2) style locking
  840. X# available on BSD systems.
  841. X# Also code is included to use lockf(2), but this has not been tested.
  842. X# Note that this is lockf(2), not lockf(3): the system call, not the
  843. X# library routine.
  844. X#
  845. X# The functioning of this module can be tested using the program
  846. X# testlock.pl.
  847. X
  848. Xif ( defined $lock_fcntl && $lock_fcntl ) {
  849. X    eval <<'EOD';
  850. X    sub locking {            # using fcntl(2)
  851. X        local (*FH, $wait) = @_;
  852. X
  853. X        require "errno.ph";
  854. X        require "fcntl.ph";
  855. X
  856. X        local ($func) = 
  857. X        $wait ? &F_SETLKW    # set lock and wait for it
  858. X            : &F_SETLK;        # don't wait for it
  859. X        local ($lck) = 
  860. X        pack ("sslli",    # see man for flock(2)
  861. X              &F_WRLCK,    # short l_type (F_WRLCK: write lock)
  862. X              0,    # short l_whence (as in lseek(2))
  863. X              0,    # long l_start (start of region)
  864. X              0,    # long l_len (0 -> whole file)
  865. X              0);    # int l_pid (not used)
  866. X        local ($ret) = fcntl (FH, $func, $lck);
  867. X        return 1 if $ret eq "0 but true";
  868. X        # print STDERR ("=> ret = $ret, \$! = $! [", 0+$!, "]\n");
  869. X        return 0 if $! == &EACCES && !$wait;
  870. X        -1;            # failed
  871. X    }
  872. XEOD
  873. X}
  874. Xelsif ( defined $lock_flock && $lock_flock ) {
  875. X    eval <<'EOD';
  876. X    sub locking {            # using flock(2)
  877. X        local (*FH, $wait) = @_;
  878. X
  879. X        require "sys/file.ph";
  880. X        require "errno.ph";
  881. X
  882. X        local ($wp) = &LOCK_EX;
  883. X        $wp |= &LOCK_NB unless $wait;
  884. X        local ($ret) = flock (FH, $wp);
  885. X        return 1 if $ret;
  886. X        # print STDERR ("=> ret = $ret, \$! = $! [", 0+$!, "]\n");
  887. X        return 0 if $! == &EWOULDBLOCK && !$wait;
  888. X        -1;                # failed
  889. X    }
  890. XEOD
  891. X}
  892. Xelsif ( defined $lock_lockf && $lock_lockf) {
  893. X    eval <<'EOD';
  894. X    sub locking {            # using lockf(2) **UNTESTED**
  895. X        local (*FH, $wait) = @_;
  896. X
  897. X        require "errno.ph";
  898. X        require "unistd.ph";
  899. X        require "sys/syscall.ph";
  900. X
  901. X        local ($func) = $wait ? &F_LOCK : &F_TLOCK;
  902. X        local ($here) = tell (FH);
  903. X
  904. X        seek (FH, 0, 0);
  905. X        local ($ret) = syscall (&SYS_lockf, fileno(FH), $func, 0);
  906. X        seek (FH, $here, 0);
  907. X        return 1 if $ret == 0;
  908. X        return 0 if $! == &EACCES && !$wait;
  909. X        -1;                # failed
  910. X    }
  911. XEOD
  912. X}
  913. Xelse {
  914. X    eval <<'EOD';
  915. X    sub locking {            # no locking
  916. X        local (*FH, $wait) = @_;
  917. X        return $wait ? 1 : 0;
  918. X    }
  919. XEOD
  920. X}
  921. X
  922. X1;
  923. END_OF_FILE
  924.   if test 2911 -ne `wc -c <'mserv-3.1/ms_lock.pl'`; then
  925.     echo shar: \"'mserv-3.1/ms_lock.pl'\" unpacked with wrong size!
  926.   fi
  927.   # end of 'mserv-3.1/ms_lock.pl'
  928. fi
  929. if test -f 'mserv-3.1/mserv.hints' -a "${1}" != "-c" ; then 
  930.   echo shar: Will not clobber existing file \"'mserv-3.1/mserv.hints'\"
  931. else
  932.   echo shar: Extracting \"'mserv-3.1/mserv.hints'\" \(410 characters\)
  933.   sed "s/^X//" >'mserv-3.1/mserv.hints' <<'END_OF_FILE'
  934. XYou may obtain the following packages from the server:
  935. X
  936. X    btoa    btoa/atob support programs
  937. X    uudecode    uuencode/uudecode support programs
  938. X    xxdecode    xxencode/xxdecode support programs
  939. X    uux        Dumas' uud/uue encoding programs
  940. X    compress    compress/uncompress support programs
  941. X    mail-server The mail server software itself
  942. X
  943. XExcept for the mail-server, these packages are send unencoded, in
  944. X"shar" format.
  945. END_OF_FILE
  946.   if test 410 -ne `wc -c <'mserv-3.1/mserv.hints'`; then
  947.     echo shar: \"'mserv-3.1/mserv.hints'\" unpacked with wrong size!
  948.   fi
  949.   # end of 'mserv-3.1/mserv.hints'
  950. fi
  951. if test -f 'mserv-3.1/mserv.notes' -a "${1}" != "-c" ; then 
  952.   echo shar: Will not clobber existing file \"'mserv-3.1/mserv.notes'\"
  953. else
  954.   echo shar: Extracting \"'mserv-3.1/mserv.notes'\" \(79 characters\)
  955.   sed "s/^X//" >'mserv-3.1/mserv.notes' <<'END_OF_FILE'
  956. X>>> PLEASE DO NOT REPLY TO THIS MESSAGE. REPLIES ARE AUTOMATICALLY DISCARDED.
  957. X
  958. END_OF_FILE
  959.   if test 79 -ne `wc -c <'mserv-3.1/mserv.notes'`; then
  960.     echo shar: \"'mserv-3.1/mserv.notes'\" unpacked with wrong size!
  961.   fi
  962.   # end of 'mserv-3.1/mserv.notes'
  963. fi
  964. if test -f 'mserv-3.1/patchlevel.h' -a "${1}" != "-c" ; then 
  965.   echo shar: Will not clobber existing file \"'mserv-3.1/patchlevel.h'\"
  966. else
  967.   echo shar: Extracting \"'mserv-3.1/patchlevel.h'\" \(244 characters\)
  968.   sed "s/^X//" >'mserv-3.1/patchlevel.h' <<'END_OF_FILE'
  969. X# @(#)@ patchlevel.h    3.1.19        -*- perl -*-
  970. X# Squirrel Mail Server Software -- Copyright 1988, 1992 Johan Vromans
  971. X# This file is used to verify the correctness of a batch of patches.
  972. X$ms_version = "V3.01";        # Should match version in ms_common.pl
  973. END_OF_FILE
  974.   if test 244 -ne `wc -c <'mserv-3.1/patchlevel.h'`; then
  975.     echo shar: \"'mserv-3.1/patchlevel.h'\" unpacked with wrong size!
  976.   fi
  977.   # end of 'mserv-3.1/patchlevel.h'
  978. fi
  979. if test -f 'mserv-3.1/pr_doindex.pl' -a "${1}" != "-c" ; then 
  980.   echo shar: Will not clobber existing file \"'mserv-3.1/pr_doindex.pl'\"
  981. else
  982.   echo shar: Extracting \"'mserv-3.1/pr_doindex.pl'\" \(2062 characters\)
  983.   sed "s/^X//" >'mserv-3.1/pr_doindex.pl' <<'END_OF_FILE'
  984. X# pr_doindex.pl -- execute index requests
  985. X# SCCS Status     : @(#)@ pr_doindex.pl    3.4
  986. X# Author          : Johan Vromans
  987. X# Created On      : Thu Jun  4 22:15:51 1992
  988. X# Last Modified By: Johan Vromans
  989. X# Last Modified On: Wed Dec 23 22:06:54 1992
  990. X# Update Count    : 6
  991. X# Status          : OK
  992. X
  993. Xsub index_loop {
  994. X
  995. X    local ($entries) = 0;
  996. X    local ($name, $size, $date);
  997. X    local ($tally);
  998. X    local ($list_type) = "Index";
  999. X    local ($limit);
  1000. X
  1001. X    print STDOUT ("Index results:\n");
  1002. X
  1003. X    foreach $query ( @indexq ) {
  1004. X
  1005. X    $~ = "list_header";
  1006. X    write;
  1007. X    $~ = "list_format";
  1008. X    $: = " /";        # break filenames at logical places
  1009. X    $= = 99999;
  1010. X    $tally = 0;
  1011. X    $limit = $maxindexlines > 0 ? $maxindexlines : 65535;
  1012. X
  1013. X    if ( $indexfile =~ m|^/| ) {
  1014. X        if ( -r "$indexfile" ) {
  1015. X        print STDOUT ("Index $query in $indexfile...\n")
  1016. X            if $opt_debug;
  1017. X        $ENV{"LOCATE_DB"} = $indexfile;        # GNU find 3.6
  1018. X        $ENV{"LOCATE_PATH"} = $indexfile;    # GNU find 3.7
  1019. X        open ( IX, "$ixlookup '$query' |");
  1020. X        while ( <IX> ) {
  1021. X            ($name, $size, $date) = /^(.+)\?(\d+)\?(\d+)$/;
  1022. X            $date =~ s|^(..)(..)(..)|1900+$1."/$2/$3"|e;
  1023. X            $size .= "K";
  1024. X            write;
  1025. X            last if ++$tally >= $limit;
  1026. X        }
  1027. X        close (IX);
  1028. X        }
  1029. X    }
  1030. X    else {
  1031. X        foreach $lib ( @libdirs ) {
  1032. X        next unless -r "$lib/$indexfile" || $tally > $limit;
  1033. X        print STDOUT ("Index $query in $lib/$indexfile...\n")
  1034. X            if $opt_debug;
  1035. X        $ENV{"LOCATE_DB"} = "$lib/$indexfile";        # GNU find 3.6
  1036. X        $ENV{"LOCATE_PATH"} = "$lib/$indexfile";    # GNU find 3.7
  1037. X
  1038. X        open ( IX, "$ixlookup '$query' |");
  1039. X        while ( <IX> ) {
  1040. X            ($name, $size, $date) = /^(.+)\?(\d+)\?(\d+)$/;
  1041. X            $date =~ s|^(..)(..)(..)|1900+$1."/$2/$3"|e;
  1042. X            $size .= "K";
  1043. X            write;
  1044. X            last if ++$tally >= $limit;
  1045. X        }
  1046. X        close (IX);
  1047. X        }
  1048. X    }
  1049. X    if ( $tally == 0 ) {
  1050. X        $name = "***not found***";
  1051. X        write;
  1052. X    }
  1053. X    elsif ( $tally >= $limit ) {
  1054. X        print STDOUT ("*** Too much output, remaining lines flushed ***\n");
  1055. X        # Lower the limit, but avoid zero value.
  1056. X        $maxindexlines = int ($maxindexlines / 2) + 1;
  1057. X    }
  1058. X    }
  1059. X    @indexq = ();
  1060. X    print STDOUT ("\n");
  1061. X}
  1062. X
  1063. X1;
  1064. END_OF_FILE
  1065.   if test 2062 -ne `wc -c <'mserv-3.1/pr_doindex.pl'`; then
  1066.     echo shar: \"'mserv-3.1/pr_doindex.pl'\" unpacked with wrong size!
  1067.   fi
  1068.   # end of 'mserv-3.1/pr_doindex.pl'
  1069. fi
  1070. if test -f 'mserv-3.1/pr_dsearch.pl' -a "${1}" != "-c" ; then 
  1071.   echo shar: Will not clobber existing file \"'mserv-3.1/pr_dsearch.pl'\"
  1072. else
  1073.   echo shar: Extracting \"'mserv-3.1/pr_dsearch.pl'\" \(2649 characters\)
  1074.   sed "s/^X//" >'mserv-3.1/pr_dsearch.pl' <<'END_OF_FILE'
  1075. X# pr_dsearch.pl -- directory search
  1076. X# SCCS Status     : @(#)@ pr_dsearch.pl    3.1
  1077. X# Author          : Johan Vromans
  1078. X# Created On      : Thu Jun  4 22:13:23 1992
  1079. X# Last Modified By: Johan Vromans
  1080. X# Last Modified On: Thu Jun  4 23:05:39 1992
  1081. X# Update Count    : 4
  1082. X# Status          : OK
  1083. X
  1084. Xsub dirsearch {
  1085. X
  1086. X    local ($libdir, $request) = @_;
  1087. X
  1088. X    # Locate an archive item $request in library $libdir by
  1089. X    # performing a directory lookup.
  1090. X    # Eligible items are in the format XXX.EXT, or XXX-VVV.EXT, where
  1091. X    # VVV is assumed to be a version indicator (and must start with a digit).
  1092. X    # If an eligible item appears to be a directory, the search continues
  1093. X    # recursively.
  1094. X    #
  1095. X    # See "sub search" for a description of the return values.
  1096. X
  1097. X    local ($size);
  1098. X    local (@retval);        # return value
  1099. X    local (@a);            # to hold stat() result
  1100. X
  1101. X    # Normalize the request. 
  1102. X    # $tryfile will be the basename of the request.
  1103. X    # $subdir holds the part between $libdir and $tryfile.
  1104. X    local ($subdir, $tryfile) = &fnsplit ($request);
  1105. X
  1106. X    print STDOUT ("Search $libdir$subdir for $tryfile...\n") if $opt_debug;
  1107. X
  1108. X    $subdir .= "/" if $subdir && $subdir !~ m|/$|;
  1109. X    $libdir .= "/" if $libdir && $libdir !~ m|/$|;
  1110. X
  1111. X    # Gather files info for the lib dir.
  1112. X    local (@files, @found, $pat);
  1113. X
  1114. X    # Get all filenames.
  1115. X    opendir (DIR, $libdir.$subdir);
  1116. X    @files = readdir (DIR);
  1117. X    closedir (DIR);
  1118. X    local ($tmp) = 0+@files if $opt_debug;
  1119. X    return @retval unless @files > 0;    # No need to proceed.
  1120. X
  1121. X    # Form pattern to match search arg.
  1122. X    ($pat = $tryfile) =~ s/(\W)/\\\1/g;
  1123. X
  1124. X    # Extract valid items.
  1125. X    @found = grep(/^$pat/, @files);
  1126. X    print STDOUT ("Found ", 0+@found, " candidates out of ", $tmp, " files.\n")
  1127. X    if $opt_debug;
  1128. X    @files = ();        # Deallocate.
  1129. X
  1130. X    return @retval unless @found > 0;    # No need to proceed.
  1131. X
  1132. X    foreach $file ( @found ) {
  1133. X
  1134. X    local ($base, $version, $extension);
  1135. X
  1136. X    (($base, $version, $extension) =
  1137. X     $file =~ /^($pat)(-\d.*|)$extpat$/)
  1138. X        || (($base, $version, $extension) =
  1139. X        $file =~ /^($pat)(-\d.*|)$/);
  1140. X
  1141. X    # Nope.
  1142. X    next unless defined $base;
  1143. X
  1144. X    $extension = "" unless defined $extension;
  1145. X
  1146. X    # Recurse if directory.
  1147. X    if ( -d $libdir.$subdir.$file && -r _ ) {
  1148. X        print STDOUT ("File $libdir$subdir$file (directory)\n")
  1149. X        if $opt_debug;
  1150. X        push (@retval, 
  1151. X          &dirsearch ($libdir, "$subdir$file/$tryfile"));
  1152. X        next;
  1153. X    }
  1154. X
  1155. X    # Try file.
  1156. X    next unless -f _ && -r _ ;
  1157. X
  1158. X    # We have a file.
  1159. X    @a = stat(_);
  1160. X    print STDOUT ("File $libdir$subdir$file (known)\n")
  1161. X        if $opt_debug;
  1162. X    push (@retval, 
  1163. X          &zp ($base.$version.$extension, $a[7], $a[9], $libdir, $subdir));
  1164. X    }
  1165. X
  1166. X    return @retval;
  1167. X}
  1168. X
  1169. X1;
  1170. END_OF_FILE
  1171.   if test 2649 -ne `wc -c <'mserv-3.1/pr_dsearch.pl'`; then
  1172.     echo shar: \"'mserv-3.1/pr_dsearch.pl'\" unpacked with wrong size!
  1173.   fi
  1174.   # end of 'mserv-3.1/pr_dsearch.pl'
  1175. fi
  1176. if test -f 'mserv-3.1/pr_isearch.pl' -a "${1}" != "-c" ; then 
  1177.   echo shar: Will not clobber existing file \"'mserv-3.1/pr_isearch.pl'\"
  1178. else
  1179.   echo shar: Extracting \"'mserv-3.1/pr_isearch.pl'\" \(2388 characters\)
  1180.   sed "s/^X//" >'mserv-3.1/pr_isearch.pl' <<'END_OF_FILE'
  1181. X# pr_isearch.pl -- index search
  1182. X# SCCS Status     : @(#)@ pr_isearch.pl    3.3
  1183. X# Author          : Johan Vromans
  1184. X# Created On      : Thu Jun  4 22:13:56 1992
  1185. X# Last Modified By: Johan Vromans
  1186. X# Last Modified On: Mon Aug 17 17:38:56 1992
  1187. X# Update Count    : 8
  1188. X# Status          : OK
  1189. X
  1190. Xsub indexsearch {
  1191. X
  1192. X    local ($ixfile, $lib, $request) = @_;
  1193. X
  1194. X    # Locate an archive item $request in library $libdir by
  1195. X    # inspecting the associated index file.
  1196. X    # Eligible items are in the format XXX.EXT, or XXX-VVV.EXT, where
  1197. X    # VVV is assumed to be a version indicator (and must start with a digit).
  1198. X    #
  1199. X    # See "sub search" for a description of the return values.
  1200. X
  1201. X    return () unless -s $ixfile;
  1202. X
  1203. X    # Lookup a request in index.
  1204. X
  1205. X    local ($tryfile, $subdir, $pat);
  1206. X    local (@retval);        # return value
  1207. X
  1208. X    # Normalize the request.
  1209. X    ($subdir, $tryfile) = &fnsplit ($request);
  1210. X    $pat = $subdir ne "" ? "$subdir/$tryfile" : $tryfile;
  1211. X    $pat =~ s/(\W)/\\\1/g;
  1212. X
  1213. X    print STDOUT ("Lookup $tryfile ($pat) in $ixfile...\n") if $opt_debug;
  1214. X
  1215. X    # GNU locate 3.6 (or a customized version of GNU locate 3.5)
  1216. X    # will return info.
  1217. X    $ENV{"LOCATE_DB"} = $ixfile;    # find 3.6 or 3.5cust
  1218. X    $ENV{"LOCATE_PATH"} = $ixfile;    # find 3.7
  1219. X    open (INDEX, "$ixlookup '$tryfile' |");
  1220. X
  1221. X    local ($base, $version, $extension);
  1222. X    local ($date, $size, $file);
  1223. X
  1224. X    while ( <INDEX> ) {
  1225. X    chop;
  1226. X
  1227. X    # Returned info: path?size in K?mdate, e.g.
  1228. X    # zoo-2.01/zoo.TZ?172?910807
  1229. X
  1230. X    ($file, $size, $date) = /^(.+)\?(\d+)\?(\d+)$/;
  1231. X
  1232. X    if ( defined $file ) {
  1233. X
  1234. X        (($base, $version, $extension) =
  1235. X         $file =~ m:^($pat|.+/$pat)(-\d[^/]*|)$extpat$:)
  1236. X        || (($base, $version, $extension) =
  1237. X            $file =~ m:^($pat|.+/$pat)(-\d[^/]*|)$:);
  1238. X
  1239. X        # Nope.
  1240. X        next unless defined $base;
  1241. X        $file = $base;
  1242. X
  1243. X        # Adjust XX -YYY.tar .Z -> XX -YYY .tar.Z 
  1244. X        $extension = "" unless defined $extension;
  1245. X        ($version, $extension) = ($`, $&.$extension) 
  1246. X        if $extension eq ".Z" && $version =~ /\.(sh|t)ar$/;
  1247. X
  1248. X        $date =~ s|^(..)(..)(..)|1900+$1."/$2/$3"|e;
  1249. X
  1250. X        ($subdir, $base) = &fnsplit ($file);
  1251. X        $subdir .= "/" if $subdir ne "";
  1252. X        $lib .= "/" unless $lib =~ m|/$|;
  1253. X
  1254. X        push (@retval,
  1255. X          &zp ($base.$version.$extension, $size."K", "T".$date,
  1256. X               $lib, $subdir));
  1257. X        next;
  1258. X    }
  1259. X
  1260. X    }
  1261. X
  1262. X    close (INDEX);
  1263. X    print STDOUT ("Found ", 0+@retval, " entries\n") if $opt_debug;
  1264. X    @retval;
  1265. X}
  1266. X
  1267. X1;
  1268. END_OF_FILE
  1269.   if test 2388 -ne `wc -c <'mserv-3.1/pr_isearch.pl'`; then
  1270.     echo shar: \"'mserv-3.1/pr_isearch.pl'\" unpacked with wrong size!
  1271.   fi
  1272.   # end of 'mserv-3.1/pr_isearch.pl'
  1273. fi
  1274. if test -f 'mserv-3.1/rfc822.pl' -a "${1}" != "-c" ; then 
  1275.   echo shar: Will not clobber existing file \"'mserv-3.1/rfc822.pl'\"
  1276. else
  1277.   echo shar: Extracting \"'mserv-3.1/rfc822.pl'\" \(4456 characters\)
  1278.   sed "s/^X//" >'mserv-3.1/rfc822.pl' <<'END_OF_FILE'
  1279. X# rfc822.pl -- RFC822 support
  1280. X# SCCS Status     : @(#)@ rfc822    2.2
  1281. X# Author          : Johan Vromans
  1282. X# Created On      : Oct 26 20:39:18 1989
  1283. X# Last Modified By: Johan Vromans
  1284. X# Last Modified On: Thu Apr 30 14:56:44 1992
  1285. X# Update Count    : 29
  1286. X# Status          : OK
  1287. X#
  1288. X# Copyright 1989, 1992 Johan Vromans
  1289. X#
  1290. X# This software may be redistributed on the same terms as the 
  1291. X# GNU Public Licence.
  1292. X
  1293. X# Exported routines
  1294. X#
  1295. X#   start_read -- initializes this module
  1296. X#
  1297. X#    must be passed the filename to read from
  1298. X#
  1299. X#   read_header -- reads, and parses RFC822 header
  1300. X#
  1301. X#    returns $VALID_HEADER if a valid RFC822 header was found.
  1302. X#    $header and $contents contain the header and contents.
  1303. X#    $line contains the normalized header.
  1304. X#
  1305. X#   read_body -- reads a line from the message body
  1306. X#
  1307. X#    returns $EMPTY_LINE if an empty line was read.
  1308. X#
  1309. X#    returns $DATA_LINE otherwise.
  1310. X#    $line contains the contents of the line.
  1311. X#
  1312. X#   parse_addresses -- parses an address specification.
  1313. X#
  1314. X#    return addresses in @addresses, the address
  1315. X#    comments in %addr_comments.
  1316. X#
  1317. X
  1318. X# Export the routines in the requiring package.
  1319. X*start_read = *rfc822'start_read;
  1320. X*read_header = *rfc822'read_header;
  1321. X*read_body = *rfc822'read_body;
  1322. X*parse_addresses = *rfc822'parse_addresses;
  1323. X
  1324. X# Switch to package context.
  1325. Xpackage rfc822;
  1326. X
  1327. X$[ = 0;                # let arrays start at 0 ];
  1328. X
  1329. X################ Global constants ################
  1330. X$EOF = 0;
  1331. X$VALID_HEADER = 1;
  1332. X$EMPTY_LINE = 2;
  1333. X$DATA_LINE = 3;
  1334. X
  1335. X################ Variables ################
  1336. X$version = "@(#)@ rfc822    2.2 - rfc822.pl";
  1337. Xundef $line_in_cache;
  1338. X$have_input_stream = 0;
  1339. X$line = "";
  1340. X$header = "";
  1341. X$contents = "";
  1342. X@addresses = ();
  1343. X%addr_comments = ();
  1344. Xlocal (*INPUT);
  1345. X
  1346. X################ Subroutines ################
  1347. X
  1348. Xsub start_read {
  1349. X    local ($file) = @_;
  1350. X
  1351. X    close (INPUT) if $have_input_stream;
  1352. X
  1353. X    return 0 unless open (INPUT, $file);
  1354. X
  1355. X    # Initialize the read ahead system.
  1356. X    $line_in_cache = <INPUT>;
  1357. X
  1358. X    # Will supply return value.
  1359. X    $have_input_stream = 1;
  1360. X}
  1361. X
  1362. Xsub read_body {
  1363. X
  1364. X    if ( defined $line_in_cache ) {
  1365. X    $line = $line_in_cache;
  1366. X    undef $line_in_cache;
  1367. X    } 
  1368. X    else {
  1369. X    return $EOF if eof(INPUT);
  1370. X    $line = <INPUT>;
  1371. X    }
  1372. X
  1373. X    chop ($line);
  1374. X    $header = $contents = undef;
  1375. X    return ($line eq "") ? $EMPTY_LINE : $DATA_LINE;
  1376. X}
  1377. X
  1378. Xsub read_header {
  1379. X
  1380. X    if ( defined $line_in_cache ) {
  1381. X    $line = $line_in_cache;
  1382. X    undef $line_in_cache;
  1383. X    } 
  1384. X    else {
  1385. X    return $EOF if eof(INPUT);
  1386. X    $line = <INPUT>;
  1387. X    }
  1388. X
  1389. X    chop ($line);
  1390. X    if ( $line =~ /^([-\w]+)\s*:\s*/ ) {
  1391. X    $header = $1;
  1392. X    $contents = $';            #';
  1393. X    } 
  1394. X    else {
  1395. X    $header = $contents = undef;
  1396. X    return ($line eq "") ? $EMPTY_LINE : $DATA_LINE;
  1397. X    }
  1398. X
  1399. X    # Handle continuation lines.
  1400. X    while ( ! eof(INPUT) ) {
  1401. X    chop ($line = <INPUT>);
  1402. X    if ( $line =~ /^\s+/ ) {
  1403. X        # Append.
  1404. X        $contents .= " " . $';        #';
  1405. X    }
  1406. X    else {
  1407. X        # Too far.
  1408. X        $line_in_cache = $line . "\n";
  1409. X        last;
  1410. X    }
  1411. X    }
  1412. X
  1413. X    $line = $header . ": " . $contents;
  1414. X    return $VALID_HEADER;
  1415. X}
  1416. X
  1417. Xsub parse_addresses {
  1418. X
  1419. X    # Given an RFC822 compliant series of addresses, parse them, and
  1420. X    # return:
  1421. X    #    @addresses -- array with parsed addresses.
  1422. X    #    %addr_comments -- the comments for each of the addresses.
  1423. X    #
  1424. X    # RFC822 syntax:
  1425. X    #    address [, address ...]
  1426. X    #    address: addr [ ( comment ) ] | [ comment ] <addr>
  1427. X
  1428. X    local ($addr) = shift (@_);
  1429. X    local ($left);
  1430. X    local (@left);
  1431. X    local ($right);
  1432. X    local ($comment);
  1433. X
  1434. X    @addresses = ();
  1435. X    %addr_comments = ();
  1436. X
  1437. X    # First break out the (...) comments.
  1438. X    while ( $addr =~ /\(([^)]*)\)/ ) {
  1439. X    $right = $';
  1440. X    $comment = $1;
  1441. X    @left = split (/[ \t]+/, $`);
  1442. X    if ( $#left >= 0 ) {
  1443. X        # print "() match: \"", $left[$#left], "\" -> \"$1\"\n";
  1444. X        unshift (@addresses, pop (@left));
  1445. X        $addr_comments{$addresses[0]} = $1;
  1446. X    }
  1447. X    if ( $right =~ /^\s*,\s*/ ) {
  1448. X        $right = $';
  1449. X    }
  1450. X    $addr = join (" ", @left) . " " . $right;
  1451. X    # print "todo: $addr\n";
  1452. X    }
  1453. X
  1454. X    # Then split on commas, and handle each part separately.
  1455. X    @addr = split (/,/, $addr);
  1456. X
  1457. X    while ( $#addr >= 0 ) {
  1458. X    $addr = shift (@addr);
  1459. X    # print "doing: \"$addr\"\n";
  1460. X    $addr = $' if $addr =~ /^\s+/ ;
  1461. X    $addr = $` if $addr =~ /\s+$/ ;
  1462. X    next if $addr eq "";
  1463. X    if ( $addr =~ /<([^>]+)>/ ) {
  1464. X        # print "\"$addr\" matched: \"$`\"-\"$+\"-\"$'\"\n";
  1465. X        unshift (@addresses, $1);
  1466. X        $addr_comments{$1} = join (" ", split (/[ \t]+/, "$` $'"));
  1467. X    }
  1468. X    else {
  1469. X        unshift (@addresses, $addr);
  1470. X        $addr_comments{$addr} = "";
  1471. X        # print "did: \"$addr\"\n";
  1472. X    }
  1473. X    }
  1474. X}
  1475. X
  1476. X1;
  1477. END_OF_FILE
  1478.   if test 4456 -ne `wc -c <'mserv-3.1/rfc822.pl'`; then
  1479.     echo shar: \"'mserv-3.1/rfc822.pl'\" unpacked with wrong size!
  1480.   fi
  1481.   # end of 'mserv-3.1/rfc822.pl'
  1482. fi
  1483. if test -f 'mserv-3.1/testlock.pl' -a "${1}" != "-c" ; then 
  1484.   echo shar: Will not clobber existing file \"'mserv-3.1/testlock.pl'\"
  1485. else
  1486.   echo shar: Extracting \"'mserv-3.1/testlock.pl'\" \(1539 characters\)
  1487.   sed "s/^X//" >'mserv-3.1/testlock.pl' <<'END_OF_FILE'
  1488. X#!/usr/local/bin/perl -s
  1489. X# testlock.pl -- test locking
  1490. X# SCCS Status     : @(#)@ testlock    1.2
  1491. X# Author          : Johan Vromans
  1492. X# Created On      : Thu Jun  4 21:22:45 1992
  1493. X# Last Modified By: Johan Vromans
  1494. X# Last Modified On: Sun Jul 19 13:52:56 1992
  1495. X# Update Count    : 65
  1496. X# Status          : 
  1497. X
  1498. X# Simpel testbed for mail server locking.
  1499. X#
  1500. X# To test, execute
  1501. X#
  1502. X#   % perl -s testlock.pl -test1 &
  1503. X#
  1504. X# It should say "Got the lock -- waiting ...".
  1505. X# Then execute
  1506. X#
  1507. X#   % perl -s testlock.pl -test2 &
  1508. X#
  1509. X# It should say "Good. Could not lock -- waiting ...".
  1510. X# Now kill the first process. The second process should print "ret = 1" 
  1511. X# and exit.
  1512. X
  1513. X$my_name = "testlock";
  1514. X$my_version = "1.2";
  1515. X#
  1516. X################ Common stuff ################
  1517. X
  1518. X$libdir = $ENV{"MSERVLIB"} || "/usr/local/lib/mserv";
  1519. Xunshift (@INC, $libdir);
  1520. Xrequire "ms_common.pl";
  1521. X
  1522. X################ Main ################
  1523. X
  1524. X$tf = "/usr/tmp/f1lock";
  1525. X
  1526. Xif ( defined $test1 ) {
  1527. X
  1528. X    open ( F1, ">$tf");
  1529. X
  1530. X    local ($ret) =  &locking (*F1, 0);
  1531. X    if ( $ret == 1 ) {
  1532. X    print ("Got the lock -- waiting ...\n");
  1533. X    sleep 600;
  1534. X    close (F1);
  1535. X    unlink ($tf);
  1536. X    exit (0);
  1537. X    }
  1538. X
  1539. X    print ("Locking problem: ret = $ret [$!]\n");
  1540. X}
  1541. X
  1542. Xif ( defined $test2 ) {
  1543. X
  1544. X    open (F2, "+<$tf") || print ("Cannot open $tf [$!]\n");
  1545. X
  1546. X    local ($ret) = &locking (*F2, 0);
  1547. X    if ( $ret == 0 ) {
  1548. X    print ("Good, could not lock -- waiting ...\n");
  1549. X    $ret = &locking (*F2, 1);
  1550. X    print ("Ret = $ret\n");
  1551. X    close (F2);
  1552. X    unlink ($tf);
  1553. X    exit (0);
  1554. X    }
  1555. X
  1556. X    print ("Cannot lock exclusive: ret = $ret [$!]\n");
  1557. X    close (F2);
  1558. X}
  1559. END_OF_FILE
  1560.   if test 1539 -ne `wc -c <'mserv-3.1/testlock.pl'`; then
  1561.     echo shar: \"'mserv-3.1/testlock.pl'\" unpacked with wrong size!
  1562.   fi
  1563.   # end of 'mserv-3.1/testlock.pl'
  1564. fi
  1565. if test -f 'mserv-3.1/ud_sample2.pl' -a "${1}" != "-c" ; then 
  1566.   echo shar: Will not clobber existing file \"'mserv-3.1/ud_sample2.pl'\"
  1567. else
  1568.   echo shar: Extracting \"'mserv-3.1/ud_sample2.pl'\" \(1141 characters\)
  1569.   sed "s/^X//" >'mserv-3.1/ud_sample2.pl' <<'END_OF_FILE'
  1570. X# ud_sample2.pl -- 
  1571. X# SCCS Status     : @(#)@ ud_sample2.pl    1.3
  1572. X# Author          : Johan Vromans
  1573. X# Created On      : Sat Dec 19 16:02:45 1992
  1574. X# Last Modified By: Johan Vromans
  1575. X# Last Modified On: Fri Jan  1 18:03:37 1993
  1576. X# Update Count    : 2
  1577. X# Status          : Unknown, Use with caution!
  1578. X
  1579. X# As an example, the following code modifies the SEND request to add 
  1580. X# special behaviour to 'SEND CONFIG'.
  1581. X
  1582. X# Save original SEND command routine.
  1583. X$cmd_config'orig_send = $cmd_tbl{'SEND'};
  1584. X
  1585. Xsub cmd_config {
  1586. X    # Check syntax.
  1587. X    # $cmd is the command verb, upcased.
  1588. X    # @cmd has the remainder of the command.
  1589. X
  1590. X    # Pass to original SEND command unless it is for us.
  1591. X    return &$cmd_config'orig_send
  1592. X    unless @cmd == 1 && "\L$cmd[0]\E" eq 'config';
  1593. X
  1594. X    # Push exe command on work queue.
  1595. X    push (@workq, &zp ('c'));
  1596. X
  1597. X    # Feedback.
  1598. X    print STDOUT ("=> Okay\n");
  1599. X    1;
  1600. X}
  1601. X
  1602. X# Store new command.
  1603. X$cmd_tbl{'SEND'} = 'cmd_config';
  1604. X
  1605. Xsub exe_config {
  1606. X    &do_unix ("$libdir/chkconfig");
  1607. X    1;
  1608. X}
  1609. X
  1610. X$exe_tbl{'c'} = 'exe_config';
  1611. X
  1612. X&add_help ('SEND CONFIG',
  1613. X       'Generate a mail server configuration report.');
  1614. X
  1615. X################ 1 ################
  1616. X1;
  1617. END_OF_FILE
  1618.   if test 1141 -ne `wc -c <'mserv-3.1/ud_sample2.pl'`; then
  1619.     echo shar: \"'mserv-3.1/ud_sample2.pl'\" unpacked with wrong size!
  1620.   fi
  1621.   # end of 'mserv-3.1/ud_sample2.pl'
  1622. fi
  1623. if test -f 'mserv-3.1/unpack.pl' -a "${1}" != "-c" ; then 
  1624.   echo shar: Will not clobber existing file \"'mserv-3.1/unpack.pl'\"
  1625. else
  1626.   echo shar: Extracting \"'mserv-3.1/unpack.pl'\" \(4362 characters\)
  1627.   sed "s/^X//" >'mserv-3.1/unpack.pl' <<'END_OF_FILE'
  1628. X#!/usr/local/bin/perl
  1629. X# unpack.pl -- unpack files
  1630. X# SCCS Status     : @(#)@ unpack    2.5
  1631. X# Author          : Johan Vromans
  1632. X# Created On      : Oct  2 21:33:00 1989
  1633. X# Last Modified By: Johan Vromans
  1634. X# Last Modified On: Sat Dec 12 00:55:19 1992
  1635. X# Update Count    : 8
  1636. X# Status          : Going steady
  1637. X
  1638. X# Unpack a set of files sent by the mail server with a tiny bit
  1639. X# of error detection.
  1640. X#
  1641. X# Usage: save all the parts in one big file (in the correct order), 
  1642. X# say "foo", and then execute:
  1643. X#
  1644. X#   perl unpack.pl foo
  1645. X#
  1646. X# Note: if the filename contains a path, all subdirectories should 
  1647. X# exist!
  1648. X# Multiple files in one input stream are allowed: e.g:
  1649. X#
  1650. X#------ begin of INDEX -- ascii -- complete ------
  1651. X#------ end of INDEX -- ascii -- complete ------
  1652. X#------ begin of zoo.TZ -- btoa encoded -- part 1 of 2 ------
  1653. X#------ end of zoo.TZ -- btoa encoded -- part 1 of 2 ------
  1654. X#------ begin of zoo.TZ -- btoa encoded -- part 2 of 2 ------
  1655. X#------ end of zoo.TZ -- btoa encoded -- part 2 of 2 ------
  1656. X#
  1657. X#
  1658. X################ configuration section ################
  1659. X#
  1660. X# Where to find these...
  1661. X#
  1662. X$atob = "atob";            # Ascii -> Binary
  1663. X$uudecode = "uudecode";        # UU
  1664. X$xxdecode = "xxdecode";        # XX
  1665. X$uud = "uud";            # Dumas' uue/uud programs.
  1666. X$uncompress = "compress -d";    # Uncompress.
  1667. X#
  1668. X################ end of configuration section ################
  1669. X
  1670. X&init;
  1671. X
  1672. Xwhile ( $line = <> ) {
  1673. X
  1674. X    if ( $line =~ /^------ begin of (.+) -- (.+) -- (.+) ------/ ) {
  1675. X    print STDERR $line;
  1676. X
  1677. X    # If a filename is known, it must be the same.
  1678. X    if ( $file ) {
  1679. X        if ( $file != $1 ) {
  1680. X        &errmsg ("Filename mismatch");
  1681. X        }
  1682. X    }
  1683. X    else {
  1684. X        $file = $1;
  1685. X    }
  1686. X
  1687. X    # If an encoding is known, it must be the same.
  1688. X    if ( $encoding ) {
  1689. X        if ( $encoding != $2 ) {
  1690. X        &errmsg ("Encoding mismatch");
  1691. X        }
  1692. X    }
  1693. X    else {
  1694. X        # Determine encoding and build command.
  1695. X        $enc = $2;
  1696. X        if ( $enc =~ /^compressed,/ ) {
  1697. X        $encoding = $';
  1698. X        $comp = "|$uncompress";
  1699. X        }
  1700. X        else {
  1701. X        $comp = '';
  1702. X        $encoding = $enc;
  1703. X        }
  1704. X
  1705. X        if ( $encoding eq "uuencoded" ) {
  1706. X        $cmd = "|$uudecode";
  1707. X        }
  1708. X        elsif ( $encoding eq "xxencoded" ) {
  1709. X        $cmd = "|$xxdecode";
  1710. X        }
  1711. X        elsif ( $encoding eq "btoa encoded" ) {
  1712. X        $cmd = "|$atob $comp > $file";
  1713. X        }
  1714. X        elsif ( $encoding eq "uue-encoded" ) {
  1715. X        $cmd = "|$uud - ";
  1716. X        }
  1717. X        else {
  1718. X        $cmd = "$comp >$file";
  1719. X        }
  1720. X    }
  1721. X
  1722. X    # If a 'parts' section is known, it must match.
  1723. X    # A bit more complex ...
  1724. X    $tparts = $3;
  1725. X    if ( $parts ) {
  1726. X        if ( $tparts =~ /part (\d+) of (\d+)/ ) {
  1727. X
  1728. X        $thispart++;    # Increment part number and check.
  1729. X        if ( $thispart != $1 ) {
  1730. X            &errmsg ("Sequence mismatch");
  1731. X        }
  1732. X
  1733. X        # Total number must match also.
  1734. X        if ( $numparts ) {
  1735. X            if ( $numparts != $2 ) {
  1736. X            &errmsg ("Numparts mismatch");
  1737. X            }
  1738. X        }
  1739. X        else {
  1740. X            $numparts = $2;
  1741. X        }
  1742. X        }
  1743. X        elsif ( $parts ne $tparts ) {
  1744. X        &errmsg ("Parts mismatch");
  1745. X        }
  1746. X    }
  1747. X    else {
  1748. X
  1749. X        # No 'parts' known yet.
  1750. X        $parts = $tparts;
  1751. X        if ( $tparts =~ /part (\d+) of (\d+)/ ) {
  1752. X        $thispart = $1;
  1753. X        # Should be first part.
  1754. X        if ( $thispart != 1 ) {
  1755. X            &errmsg ("Sequence mismatch");
  1756. X        }
  1757. X        $numparts = $2;
  1758. X        }
  1759. X        else {
  1760. X        $numparts = $thispart = 1;
  1761. X        }
  1762. X    }
  1763. X
  1764. X    # If we have a file open, enable copying.
  1765. X    if ( $fileok ) {
  1766. X        $copy = 1;
  1767. X    }
  1768. X    elsif ( open (OUTFILE, $cmd) ) {
  1769. X        $fileok = 1;
  1770. X        $copy = 1;
  1771. X    }
  1772. X    else {
  1773. X        &errmsg ("Cannot create $cmd");
  1774. X    }
  1775. X
  1776. X    # Matching end header to look for.
  1777. X    $trailer = "------ end " . substr ($line, 13, length($line)-13);
  1778. X
  1779. X    }
  1780. X    elsif ( $line =~ /^------ end of (.+) -- (.+) -- (.+) ------/ ) {
  1781. X
  1782. X    print STDERR $line;
  1783. X
  1784. X    # Check that the header matches.
  1785. X    if ( $line ne $trailer ) {
  1786. X        &errmsg ("Header/trailer mismatch");
  1787. X    }
  1788. X
  1789. X    # Wrap up if this was the last part.
  1790. X    &wrapup if $thispart == $numparts;
  1791. X
  1792. X    # Stop copying.
  1793. X    $copy = 0;
  1794. X    }
  1795. X    else {
  1796. X    if ( $copy ) {
  1797. X        print OUTFILE $line;
  1798. X    }
  1799. X    }
  1800. X}
  1801. X
  1802. Xif ( $numparts && ( $thispart != $numparts )) {
  1803. X    &errmsg ("Only $thispart of $numparts parts found");
  1804. X}
  1805. X
  1806. Xif ( $fileok) {
  1807. X    &errmsg ("Unterminated section") if $?;
  1808. X}
  1809. X
  1810. X################ Subroutines ################
  1811. X
  1812. Xsub init {
  1813. X    $encoding = "";
  1814. X    $parts = "";
  1815. X    $numparts = "";
  1816. X    $file = "";
  1817. X    $copy = 0;
  1818. X    $thispart = 0;
  1819. X    $fileok = "";
  1820. X}
  1821. X
  1822. Xsub wrapup {
  1823. X    close (OUTFILE);
  1824. X    &errmsg ("Output close error [$?]") if $?;
  1825. X    &init;
  1826. X}
  1827. X
  1828. Xsub errmsg {
  1829. X    print STDERR ($my_name, ": ", pop(@_), " at input line $..\n");
  1830. X    exit 1;
  1831. X}
  1832. END_OF_FILE
  1833.   if test 4362 -ne `wc -c <'mserv-3.1/unpack.pl'`; then
  1834.     echo shar: \"'mserv-3.1/unpack.pl'\" unpacked with wrong size!
  1835.   fi
  1836.   # end of 'mserv-3.1/unpack.pl'
  1837. fi
  1838. echo shar: End of archive 6 \(of 6\).
  1839. cp /dev/null ark6isdone
  1840. MISSING=""
  1841. for I in 1 2 3 4 5 6 ; do
  1842.     if test ! -f ark${I}isdone ; then
  1843.     MISSING="${MISSING} ${I}"
  1844.     fi
  1845. done
  1846. if test "${MISSING}" = "" ; then
  1847.     echo You have unpacked all 6 archives.
  1848.     rm -f ark[1-9]isdone
  1849. else
  1850.     echo You still must unpack the following archives:
  1851.     echo "        " ${MISSING}
  1852. fi
  1853. exit 0
  1854. exit 0 # Just in case...
  1855.