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