home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1993 #1 / NN_1993_1.iso / spool / comp / sources / bugs / 326 < prev    next >
Encoding:
Internet Message Format  |  1993-01-12  |  44.9 KB
  1. Path: sparky!uunet!eiffel!ram
  2. From: ram@eiffel.com (Raphael Manfredi)
  3. Newsgroups: comp.sources.bugs
  4. Subject: mailagent 2.9 patch #15
  5. Summary: This is an official patch for mailagent 2.9.  Please apply it.
  6. Message-ID: <168@eiffel.eiffel.com>
  7. Date: 12 Jan 93 21:54:36 GMT
  8. Organization: Interactive Software Engineering, Santa Barbara CA
  9. Lines: 1266
  10.  
  11. System: mailagent version 2.9
  12. Patch #: 15
  13. Priority: MEDIUM
  14. Subject: military timezones did not parse correctly
  15. Subject: (fix by Paul Marquess <pmarquess@rosebud.bfsec.bt.co.uk>)
  16. Subject: Configure now asks if #! is to be used to start perl
  17. Subject: minor tr argument problem fixed within Configure
  18. Subject: new standard format for vacation message
  19. Subject: new parameters: nfslock, mmdf, mmdfbox and compress
  20. Subject: can now deal with compression
  21. Subject: knows about MMDF-style mailboxes
  22. Subject: leading perl start up is now configured
  23. Subject: documents new features: compression and MMDF mailboxes
  24. Subject: can now perform NFS-safe lockings
  25. Subject: locking operation automatically checks for outdated locks
  26. Subject: saving operation now knows about compression
  27. Subject: sanity checks performed on saved mail for NFS failure
  28. Subject: outdated locks checking now performed by &acs_rqst
  29. Subject: typo fix
  30. Subject: now checks for error on file closing (buffer flushing)
  31. Subject: undocumented feature commented (WRITE may allow hooks)
  32. Subject: now knows about NFS-safe locks
  33. Subject: lock outdating now performed by &acs_rqst
  34. Subject: make sure tests are not run as super-user
  35. Subject: perload now knows about leading ':' for shell startup
  36. Subject: two new (empty) test files in agent/test/misc
  37. Subject: new library files for folder compression and MMDF support
  38. Date: Tue Jan 12 13:41:57 PST 1993
  39. From: Raphael Manfredi <ram@eiffel.com>
  40.  
  41. Description:
  42.     Military timezones did not parse correctly.
  43.     (fix by Paul Marquess <pmarquess@rosebud.bfsec.bt.co.uk> posted
  44.     on comp.lang.perl and integrated)
  45.  
  46.     Configure now asks if #! is to be used to start perl. This should take
  47.     care of the "Illegal variable name" error message emitted when csh
  48.     attempts to start a perl script!
  49.  
  50.     New standard format for vacation message.
  51.  
  52.     New configuration parameters: nfslock, mmdf, mmdfbox and compress.
  53.     It is now possible to get NFS-safe locks. Moreover, the mailagent
  54.     can now deal with compression and knows about MMDF-style mailboxes.
  55.  
  56.     Documents new features: compression and MMDF mailboxes.
  57.  
  58.     Sanity checks are now performed on saved mail for NFS failure. The
  59.     mail file is stat()'ed to make sure all the NFS write() have been
  60.     correctly performed. Otherwise, some soft-mounted partitions could
  61.     end-up with an empty mail message without any error report!
  62.     Thank you NFS.
  63.  
  64.     Make sure tests are not run as super-user. Some of the tests involve
  65.     writing permissions checks, which does not concern the super-user.
  66.     The test suite expects some failure which cannot happen when root is
  67.     involved.
  68.  
  69.     Perload now knows about leading ':' for shell startup. Putting a
  70.     leading colon should tell the kernel that the file is a "shell"
  71.     script to be run using the Bourne shell and not by the current
  72.     shell held in the SHELL environment variable. We want to avoid all
  73.     the csh-like shells.
  74.  
  75.     Two new (empty) test files in agent/test/misc. You will have to create
  76.     those files by hand at the end of the patching process, or further
  77.     patches will not apply. Those files are empty because I did not find
  78.     the time to write them, but this set of patches had to get out.
  79.  
  80.     New library files for folder compression and MMDF support.
  81.  
  82.  
  83. Fix:    From rn, say "| patch -p -N -d DIR", where DIR is your mailagent source
  84.     directory.  Outside of rn, say "cd DIR; patch -p -N <thisarticle".
  85.     If you don't have the patch program, apply the following by hand,
  86.     or get patch (version 2.0, latest patchlevel).
  87.  
  88.     After patching:
  89.         *** DO NOTHING--INSTALL ALL PATCHES UP THROUGH #16 FIRST ***
  90.  
  91.     If patch indicates that patchlevel is the wrong version, you may need
  92.     to apply one or more previous patches, or the patch may already
  93.     have been applied.  See the patchlevel.h file to find out what has or
  94.     has not been applied.  In any event, don't continue with the patch.
  95.  
  96.     If you are missing previous patches they can be obtained from me:
  97.  
  98.         Raphael Manfredi <ram@eiffel.com>
  99.  
  100.     If you send a mail message of the following form it will greatly speed
  101.     processing:
  102.  
  103.         Subject: Command
  104.         @SH mailpatch PATH mailagent 2.9 LIST
  105.                ^ note the c
  106.  
  107.     where PATH is a return path FROM ME TO YOU either in Internet notation,
  108.     or in bang notation from some well-known host, and LIST is the number
  109.     of one or more patches you need, separated by spaces, commas, and/or
  110.     hyphens.  Saying 35- says everything from 35 to the end.
  111.  
  112.     To get some more detailed instructions, send me the following mail:
  113.  
  114.         Subject: Command
  115.         @SH mailhelp PATH
  116.  
  117.  
  118. Index: patchlevel.h
  119. Prereq: 14
  120. 4c4
  121. < #define PATCHLEVEL 14
  122. ---
  123. > #define PATCHLEVEL 15
  124.  
  125. Index: agent/pl/compress.pl
  126. *** agent/pl/compress.pl.old    Tue Jan 12 13:41:15 1993
  127. --- agent/pl/compress.pl    Tue Jan 12 13:41:15 1993
  128. ***************
  129. *** 0 ****
  130. --- 1,172 ----
  131. + ;# $Id: compress.pl,v 2.9.1.1 93/01/12 12:12:08 ram Exp $
  132. + ;#
  133. + ;#  Copyright (c) 1992, Raphael Manfredi
  134. + ;#
  135. + ;#  You may redistribute only under the terms of the GNU General Public
  136. + ;#  Licence as specified in the README file that comes with dist.
  137. + ;#
  138. + ;# $Log:    compress.pl,v $
  139. + ;# Revision 2.9.1.1  93/01/12  12:12:08  ram
  140. + ;# patch15: created
  141. + ;# 
  142. + ;# 
  143. + ;# This module handles compressed folders. Each folder specified in the file
  144. + ;# 'compress' from the configuration file is candidate for compression checks.
  145. + ;# The file specifies folders using shell patterns. If the pattern does not
  146. + ;# start with a /, the match is only attempted to the basename of the folder.
  147. + ;# 
  148. + ;# Folder uncompressed are recompressed only before the mailagent is about
  149. + ;# to exit, so that the burden of successive decompressions is avoided should
  150. + ;# two or more mails be delivered to the same compressed folder. However, if
  151. + ;# there is not enough disk space to hold all the uncompressed folder, the
  152. + ;# mailagent will try to recompress them to try to make some room.
  153. + ;#
  154. + ;# The initial patterns are held in the @compress array, while the compression
  155. + ;# status is stored within %compress. The key is the file name, and the value
  156. + ;# is 0 if uncompression was attempted but failed somehow so recompression must
  157. + ;# not be done, or 1 if uncompression was successful and the folder is flagged
  158. + ;# for delayed recompression.
  159. + #
  160. + # Folder compression
  161. + #
  162. + 
  163. + package compress;
  164. + 
  165. + # Read in the compression file into the @compress array. As usual, shell
  166. + # comments are ignored.
  167. + sub init {
  168. +     unless (open(COMPRESS, "$cf'compress")) {
  169. +         &'add_log("WARNING cannot open compress file $cf'compress: $!")
  170. +             if $'loglvl > 5;
  171. +         return;
  172. +     }
  173. +     while (<COMPRESS>) {
  174. +         chop;
  175. +         next if /^\s*#/;            # Skip comments
  176. +         next if /^\s*$/;            # And blank lines
  177. +         $_ = &'perl_pattern($_);    # Shell pattern to perl one
  178. +         s/^~/$cf'home/;                # ~ substitution
  179. +         $_ = '.*/'.$_ unless m|^/|;    # Focus on basename unless absolute path
  180. +         push(@compress, $_);        # Record pattern
  181. +     }
  182. +     close COMPRESS;
  183. + }
  184. + 
  185. + # Uncompress a folder, and record it in the %compress array for further
  186. + # recompression at the end of the mailagent processing. Return 1 for success.
  187. + # If the $retry parameter is set, other folders will be recompressed should
  188. + # this particular uncompression fail.
  189. + sub uncompress {
  190. +     local($folder, $retry) = @_;    # Folder to be decompressed
  191. +     return if defined $compress{$folder};    # We already dealt with that folder
  192. +     # Make sure there is a .Z file, and that the corresponding folder is not
  193. +     # already present. If there is no .Z file but the folder already exists,
  194. +     # mark it uncompressed.
  195. +     if (-f "$folder.Z") {        # A compressed form exists
  196. +         if (-f $folder) {        # As well as an uncompressed form
  197. +             &'add_log("WARNING both folders $folder and $folder.Z exist")
  198. +                 if $'loglvl > 5;
  199. +             &'add_log("NOTICE ignoring compressed file") if $'loglvl > 6;
  200. +             $compress{$folder} = 0;        # Do not recompress it
  201. +             return 1;
  202. +         }
  203. +         # Normal case: there is a compressed file and no uncompressed version
  204. +         local($status) = system("uncompress $folder.Z");
  205. +         if ($status) {            # Uncompression failed
  206. +             local($retrying);
  207. +             $retrying = " (retrying)" if $retry;
  208. +             &'add_log("ERROR cannot uncompress $folder$retrying") if $'loglvl;
  209. +             # Maybe there is not enough disk space, and maybe we can get some
  210. +             # by recompressing the folders we have decompressed so far.
  211. +             if ($retry) {            # Attempt is to be retried
  212. +                 &recompress;        # Recompress other folders, if any
  213. +                 return 0;            # And report failure
  214. +             }
  215. +             &'add_log("WARNING $folder present before delivery")
  216. +                 if -f $folder && $'loglvl > 5;
  217. +             &'add_log("ERROR original $folder.Z lost")
  218. +                 if ! -f "$folder.Z" && $'loglvl;
  219. +             $compress{$folder} = 0;        # Do not recompress it
  220. +         } else {                # Folder should be decompressed
  221. +             if (-f "$folder.Z") {
  222. +                 &'add_log("WARNING compressed $folder still present")
  223. +                     if $'loglvl > 5;
  224. +                 $compress{$folder} = 0;    # Do not recompress it
  225. +             } else {
  226. +                 $compress{$folder} = 1;    # Will be recompressed after delivery
  227. +             }
  228. +             &'add_log("uncompressed $folder") if $'loglvl > 8;
  229. +         }
  230. +     } else {
  231. +         $compress{$folder} = 1;        # Folder will be compressed after creation
  232. +     }
  233. +     1;            # Success
  234. + }
  235. + 
  236. + # Compress a folder
  237. + sub compress {
  238. +     local($folder) = @_;        # Folder to be compressed
  239. +     return unless $compress{$folder};    # Folder not to be recompressed
  240. +     delete $compress{$folder};            # Mark it compressed anyway
  241. +     if (-f "$folder.Z") {        # A compressed form exists
  242. +         &'add_log("ERROR compressed $folder already present") if $'loglvl;
  243. +         return;
  244. +     }
  245. +     if (0 != &'acs_rqst($folder)) {        # Cannot compress if not locked
  246. +         &'add_log("NOTICE $folder locked, skiping compression") if $'loglvl > 6;
  247. +         return;
  248. +     }
  249. +     local($status) = system("compress $folder");
  250. +     if ($status) {
  251. +         &'add_log("ERROR cannot compress $folder") if $'loglvl;
  252. +         if (-f $folder) {
  253. +             unless (unlink "$folder.Z") {
  254. +                 &'add_log("ERROR cannot remove $folder.Z: $!") if $'loglvl;
  255. +             } else {
  256. +                 &'add_log("NOTICE removing $folder.Z") if $'loglvl > 6;
  257. +             }
  258. +         } else {
  259. +             &'add_log("ERROR original $folder lost") if $'loglvl;
  260. +         }
  261. +     } else {
  262. +         &'add_log("WARNING uncompressed $folder still present")
  263. +             if -f $folder && $'loglvl > 5;
  264. +         &'add_log("compressed $folder") if $'loglvl > 8;
  265. +     }
  266. +     &'free_file($folder);
  267. + }
  268. + 
  269. + # Recompress all folders which have been delivered to
  270. + sub recompress {
  271. +     foreach $file (keys %compress) {
  272. +         &compress($file);
  273. +     }
  274. + }
  275. + 
  276. + # Restore uncompressed folder if listed in the compression list
  277. + sub restore {
  278. +     return unless $cf'compress;        # Do nothing if no compress parameter
  279. +     return unless -s $cf'compress;    # No compress list file, or empty
  280. +     &init unless defined @compress;    # Initialize array only once
  281. +     local($folder) = @_;            # Folder candidate for uncompression
  282. +     &'add_log("candidate folder is $folder") if $'loglvl > 18;
  283. + 
  284. +     # Loop over each pattern in the compression file and see if the folder
  285. +     # matches one of them. As soon as one matches, the folder is uncompressed
  286. +     # if necessary and the processing is over.
  287. +     foreach $pattern (@compress) {
  288. +         &'add_log("matching against '$pattern'") if $'loglvl > 19;
  289. +         if ($folder =~ /^$pattern$/) {
  290. +             &'add_log("matched '$pattern'") if $'loglvl > 18;
  291. +             # Give it two shots. The second parameter is a retrying flag.
  292. +             # The difference between the two is that recompression of other
  293. +             # uncompressed folders is attempted the first time if the folder
  294. +             # cannot be uncompressed (assuming low disk space).
  295. +             &uncompress($folder, 0) unless &uncompress($folder, 1);
  296. +             last;
  297. +         }
  298. +     }
  299. + }
  300. + 
  301. + package main;
  302. + 
  303.  
  304. Index: agent/man/mailagent.SH
  305. Prereq: 2.9.1.7
  306. *** agent/man/mailagent.SH.old    Tue Jan 12 13:41:03 1993
  307. --- agent/man/mailagent.SH    Tue Jan 12 13:41:05 1993
  308. ***************
  309. *** 18,24 ****
  310.   .TH MAILAGENT $manext "Version $VERSION PL$PATCHLEVEL"
  311.   ''' @(#) Manual page for mailagent's filter -- (c) ram February 1991
  312.   '''
  313. ! ''' $Id: mailagent.SH,v 2.9.1.7 92/12/01 09:16:23 ram Exp $
  314.   '''
  315.   '''  Copyright (c) 1991, 1992, Raphael Manfredi
  316.   '''
  317. --- 18,24 ----
  318.   .TH MAILAGENT $manext "Version $VERSION PL$PATCHLEVEL"
  319.   ''' @(#) Manual page for mailagent's filter -- (c) ram February 1991
  320.   '''
  321. ! ''' $Id: mailagent.SH,v 2.9.1.8 93/01/12 12:09:46 ram Exp $
  322.   '''
  323.   '''  Copyright (c) 1991, 1992, Raphael Manfredi
  324.   '''
  325. ***************
  326. *** 26,31 ****
  327. --- 26,34 ----
  328.   '''  License as specified in the README file that comes with dist.
  329.   '''
  330.   ''' $Log:    mailagent.SH,v $
  331. + ''' Revision 2.9.1.8  93/01/12  12:09:46  ram
  332. + ''' patch15: documents new features: compression and MMDF mailboxes
  333. + ''' 
  334.   ''' Revision 2.9.1.7  92/12/01  09:16:23  ram
  335.   ''' patch13: fixed various typos on the word "Precedence"
  336.   ''' patch13: new paragraph about file inclusion
  337. ***************
  338. *** 186,191 ****
  339. --- 189,198 ----
  340.   Name of the file containing authorized commands. Needed when PROCESS is used.
  341.   (suggested: \$spool/commands).
  342.   .TP
  343. + .I compress
  344. + Name of the file containing the list of compressed folders. See section about
  345. + folder compression. This is an optional parameter. (suggested: ~/.compress).
  346. + .TP
  347.   .I context
  348.   File holding the mailagent context. The context saves some variables which
  349.   need to be kept over the life of the process. Needed if auto cleaning is
  350. ***************
  351. *** 230,239 ****
  352. --- 237,264 ----
  353.   Maximum size in bytes of files before using \fIkit\fR for sending files. This
  354.   is used by PROCESS. (suggested: 150000).
  355.   .TP
  356. + .I mmdf
  357. + Set this to ON if you wish to be able to save mail in MMDF-style mailboxes.
  358. + (suggested: OFF, unless you use MMDF or MH).
  359. + .TP
  360. + .I mmdfbox
  361. + The value of this variable only matters when \fImmdf\fR is on. If set to ON,
  362. + then new folders will be created as MMDF ones. This variable is not used when
  363. + saving to an existing folder, since in that case the \fImailagent\fR will
  364. + automatically determine the type and save the message accordingly.
  365. + (suggested: OFF, unless you use MMDF or wish to use MH's \fImshf\fR).
  366. + .TP
  367.   .I name
  368.   First name of the user, used by the mailagent when referring to you. This sets
  369.   the value of the %U macro.
  370.   .TP
  371. + .I nfslock
  372. + Set it to ON to ensure NFS-secure locks. The difference is that the hostname
  373. + is used in conjunction with the PID to obtain a lock. However, the mailagent
  374. + has to fork/exec to obtain that information. This is an optional parameter
  375. + which is set to OFF by default. (suggested: OFF if you deliver
  376. + mail from only one machine, even though it's via NFS).
  377. + .TP
  378.   .I path
  379.   Minimum path to be used by C filter program. To set a specific path
  380.   for a machine \fIhost\fR, set up a \fIp_host\fR variable. This will
  381. ***************
  382. *** 2083,2088 ****
  383. --- 2108,2170 ----
  384.   For those hooks which are finally ran by perl, the special @INC array has
  385.   the mailagent's own private library path prepended to it, so that \fIrequire\fR
  386.   first looks in this place.
  387. + .SH "FOLDERS"
  388. + A folder is a file which can be the target of a delivery by the mailagent,
  389. + that is to say the argument of SAVE-like commands.
  390. + '''
  391. + .SS "Folder Format"
  392. + .PP
  393. + By default, mails are written into folders according to the standard UNIX-style
  394. + mailbox format: each mail starts with a leading \fIFrom\fR line bearing the
  395. + sender's address and the date. However, by setting the \fImmdf\fR parameter
  396. + from the \fI~/.mailagent\fR to ON, the \fImailagent\fR will be able to save
  397. + messages in MMDF format: each message is sandwiched between two lines of four
  398. + ctrl-A characters (ASCII code 1) and the leading \fIFrom\fR line is removed.
  399. + .PP
  400. + When MMDF mode is activated, each folder will be scanned to see if it is a
  401. + UNIX-style or MMDF-style mailbox and the message will be saved accordingly.
  402. + When saving to a new folder, the default is to create a UNIX-style mailbox,
  403. + unless the \fImmdfbox\fR configuration variable was set to ON, in which case
  404. + the MMDF format prevails.
  405. + .PP
  406. + Note that the MMDF format is also the standard for MH packed folders, so by
  407. + enabling the MMDF mode, you can actually deliver directly to those packed
  408. + folders. The MH command \fIinc\fR is able to incorporate mail from either
  409. + form anyway, i.e. it does not matter whether the folder is in UNIX format
  410. + (also called UUCP-style) or in MMDF format.
  411. + '''
  412. + .SS "Folder Compression"
  413. + .PP
  414. + If you have \fIcompress\fR in your PATH (as set up by \fI~/.mailagent\fR), then
  415. + you may wish to use folder compression to save some disk space, especially when
  416. + you are away for some time and do not want to see your mail fill-up the
  417. + filesystem.
  418. + .PP
  419. + To achieve folder compression, you have to set up a file, referred to by the
  420. + \fIcompress\fR configuration variable. This file must list folder names, one
  421. + per line, with blank lines ignored and shell-style (#) comments allowed. You
  422. + may use shell-style patterns to specify the folders, and the match will be
  423. + attempted on the full pathname of the folder (~ subsitution occurs). If you
  424. + do not specify a pattern starting with a leading '/' character, then the match
  425. + will be attempted on the basename of the folder (i.e. the last componenent of
  426. + the folder path). If you want to compress all your folders, then simply put
  427. + a single '*' inside this file.
  428. + .PP
  429. + When attempting delivery, the mailagent will check the folder name against
  430. + the list of patterns in the compress file. If there is a match, the folder is
  431. + flagged as compressed. Then the mailagent attempts decompression if there
  432. + is already a compressed form (a .Z file) and if no uncompressed form is present.
  433. + Delivery is then made to the uncompressed folder. However, recompression is not
  434. + done immediately, since it is still possible to get messages to that folder in
  435. + a single batch delivery. Should disk space become so tight that decompression
  436. + of other folders is impossible, the mailagent will recompress the folders
  437. + it has already uncompressed. Otherwise, it waits until the last moment.
  438. + .PP
  439. + If for some reason there is a .Z compresed folder which cannot be decompressed,
  440. + the mailagent will deliver the mail to the plain folder. Further delivery
  441. + to that folder will be faced with both a compressed and a plain version of the
  442. + folder, and that will get you a warning in the log file, but delivery will be
  443. + made automatically to the plain file.
  444.   .SH EXAMPLES
  445.   Here are some examples of rule files. First, if you do not specify a rule
  446.   file or if it is empty, the following built-in rule applies:
  447.  
  448. Index: agent/pl/actions.pl
  449. Prereq: 2.9.1.4
  450. *** agent/pl/actions.pl.old    Tue Jan 12 13:41:12 1993
  451. --- agent/pl/actions.pl    Tue Jan 12 13:41:13 1993
  452. ***************
  453. *** 1,4 ****
  454. ! ;# $Id: actions.pl,v 2.9.1.4 92/12/01 09:18:05 ram Exp $
  455.   ;#
  456.   ;#  Copyright (c) 1992, Raphael Manfredi
  457.   ;#
  458. --- 1,4 ----
  459. ! ;# $Id: actions.pl,v 2.9.1.5 93/01/12 12:11:44 ram Exp $
  460.   ;#
  461.   ;#  Copyright (c) 1992, Raphael Manfredi
  462.   ;#
  463. ***************
  464. *** 6,11 ****
  465. --- 6,15 ----
  466.   ;#  Licence as specified in the README file that comes with dist.
  467.   ;#
  468.   ;# $Log:    actions.pl,v $
  469. + ;# Revision 2.9.1.5  93/01/12  12:11:44  ram
  470. + ;# patch15: saving operation now knows about compression
  471. + ;# patch15: sanity checks performed on saved mail for NFS failure
  472. + ;# 
  473.   ;# Revision 2.9.1.4  92/12/01  09:18:05  ram
  474.   ;# patch13: allowed file inclusion for KEEP and STRIP
  475.   ;# patch13: file inclusion processing now handled by &include_file
  476. ***************
  477. *** 55,83 ****
  478.       local($failed) = 0;                # Printing status
  479.       &add_log("starting SAVE $mailbox") if $loglvl > 15;
  480.       if (-x $mailbox) {                # Folder hook
  481. !         &save_hook;
  482. !     } else {
  483. !         &save_folder;
  484.       }
  485.       &emergency_save if $failed;
  486.       ($mailbox, $failed);            # Where save was made and failure status
  487.   }
  488.   
  489. ! # Called by &save when folder is a regular one (i.e. not a hook). Manipulates
  490. ! # variables in the context of &save.
  491.   sub save_folder {
  492.       if (open(MBOX, ">>$mailbox")) {
  493. !         do mbox_lock($mailbox);            # Lock mailbox
  494. !         # First print the Header, and add the X-Filter: line.
  495. !         (print MBOX $Header{'Head'}) || ($failed = 1);
  496. !         (print MBOX $FILTER, "\n\n") || ($failed = 1);
  497. !         (print MBOX $Header{'Body'}) || ($failed = 1);
  498. !         print MBOX "\n";                # Allow parsing by other tools
  499. !         do mbox_unlock($mailbox);        # Will close file
  500. !         # Logging only in case of error
  501. !         if ($failed) {
  502. !             do add_log("ERROR could not save mail in $mailbox") if $loglvl > 0;
  503.           }
  504.       } else {
  505.           if (-f "$mailbox") {
  506.               do add_log("ERROR cannot append to $mailbox") if $loglvl;
  507. --- 59,116 ----
  508.       local($failed) = 0;                # Printing status
  509.       &add_log("starting SAVE $mailbox") if $loglvl > 15;
  510.       if (-x $mailbox) {                # Folder hook
  511. !         $failed = &save_hook;        # Deliver to program
  512. !     } else {                        # Saving to a normal folder
  513. !         # Uncompress folders if necessary. The restore routine will perform
  514. !         # the necessary checks and return immediately if no compression is
  515. !         # wanted for that particular folder. However, we can avoid the overhead
  516. !         # of calling this routine (and loading it when using dataloading) if
  517. !         # the 'compress' configuration parameter is missing.
  518. !         &compress'restore($mailbox) if $cf'compress;
  519. !         $failed = &save_folder($mailbox);
  520.       }
  521. +     &add_log("ERROR could not save mail in $mailbox") if $failed && $loglvl;
  522.       &emergency_save if $failed;
  523.       ($mailbox, $failed);            # Where save was made and failure status
  524.   }
  525.   
  526. ! # Called by &save when folder is a regular one (i.e. not a hook).
  527.   sub save_folder {
  528. +     local($mailbox) = @_;            # Where mail should be saved
  529. +     local($amount);                    # Amount of bytes written
  530. +     local($failed);
  531.       if (open(MBOX, ">>$mailbox")) {
  532. ! 
  533. !         &mbox_lock($mailbox);        # Lock mailbox, now have exclusive access
  534. !         local($size) = -s $mailbox;    # Initial mailbox size
  535. ! 
  536. !         # If MMDF-style mailboxes are allowed, then the saving routine will
  537. !         # try to determine what kind of folder it is delivering to and choose
  538. !         # the right format. Otherwise, standard Unix format is assumed.
  539. !         if ($cf'mmdf =~ /on/i) {    # MMDF-style allowed
  540. !             # Save to mailbox, selecting the right format (UNIX vs MMDF)
  541. !             ($failed, $amount) = &mmdf'save(*MBOX, $mailbox);
  542. !         } else {
  543. !             # Save to UNIX folder
  544. !             ($failed, $amount) = &mmdf'save_unix(*MBOX);
  545.           }
  546. + 
  547. +         # Because we might write over NFS, and because we might have had to
  548. +         # force fate to get a lock, it is wise to make sure the folder has the
  549. +         # right size, which would tend to indicate the mail made it to the
  550. +         # buffer cache, if not to the disk itself.
  551. +         local($should) = $size + $amount;    # Computed new size for mailbox
  552. +         local($new_size) = -s $mailbox;        # Last write was flushed to disk
  553. +         &add_log("ERROR $mailbox has $new_size bytes (should have $should)")
  554. +             if $new_size != $should && $loglvl;
  555. +         $failed = 1 if $new_size != $should;
  556. + 
  557. +         # Finally, release the lock on the mailbox and close the file. If the
  558. +         # closing operation fails for whatever reason, the routine will return
  559. +         # a 1, so $failed will be set. Of course, "normally" it should not
  560. +         # fail at that point, since the mail was previously flushed.
  561. +         $failed |= &mbox_unlock($mailbox);    # Will close file
  562. + 
  563.       } else {
  564.           if (-f "$mailbox") {
  565.               do add_log("ERROR cannot append to $mailbox") if $loglvl;
  566. ***************
  567. *** 86,91 ****
  568. --- 119,125 ----
  569.           }
  570.           $failed = 1;
  571.       }
  572. +     $failed;        # Propagate failure status
  573.   }
  574.   
  575.   # Called by &save when folder is a hook. This simply calls the mailhook
  576. ***************
  577. *** 92,99 ****
  578.   # program, which will analyze the hook and perform the necessary actions.
  579.   sub save_hook {
  580.       &add_log("hooking mail on folder") if $loglvl > 15;
  581. !     $failed =
  582. !         &shell_command("$privlib/mailhook $mailbox", $MAIL_INPUT, $NO_FEEDBACK);
  583.   }
  584.   
  585.   # The "PROCESS" command
  586. --- 126,133 ----
  587.   # program, which will analyze the hook and perform the necessary actions.
  588.   sub save_hook {
  589.       &add_log("hooking mail on folder") if $loglvl > 15;
  590. !     # Return command failure status (0 means ok)
  591. !     &shell_command("$privlib/mailhook $mailbox", $MAIL_INPUT, $NO_FEEDBACK);
  592.   }
  593.   
  594.   # The "PROCESS" command
  595.  
  596. Index: agent/pl/acs_rqst.pl
  597. Prereq: 2.9
  598. *** agent/pl/acs_rqst.pl.old    Tue Jan 12 13:41:08 1993
  599. --- agent/pl/acs_rqst.pl    Tue Jan 12 13:41:08 1993
  600. ***************
  601. *** 1,4 ****
  602. ! ;# $Id: acs_rqst.pl,v 2.9 92/07/14 16:49:28 ram Exp $
  603.   ;#
  604.   ;#  Copyright (c) 1991, Raphael Manfredi
  605.   ;#
  606. --- 1,4 ----
  607. ! ;# $Id: acs_rqst.pl,v 2.9.1.1 93/01/12 12:10:37 ram Exp $
  608.   ;#
  609.   ;#  Copyright (c) 1991, Raphael Manfredi
  610.   ;#
  611. ***************
  612. *** 6,46 ****
  613.   ;#  Licence as specified in the README file that comes with dist.
  614.   ;#
  615.   ;# $Log:    acs_rqst.pl,v $
  616.   ;# Revision 2.9  92/07/14  16:49:28  ram
  617.   ;# 3.0 beta baseline.
  618.   ;# 
  619.   ;#
  620. ! # Asks for the exclusive access of a file
  621. ! # The given parameter (let's say F) is the absolute path
  622. ! # of the file we want to access. The routine checks for the
  623. ! # presence of F.lock. If it exists, it sleeps 1 second and tries
  624. ! # again. After 10 trys, it reports failure by returning -1.
  625. ! # Otherwise, file F.lock is created and the pid of the current
  626.   # process is written. It is checked afterwards.
  627.   sub acs_rqst {
  628.       local($file) = @_;    # file to be locked
  629.       local($max) = 10;    # max number of attempts
  630.       local($mask);        # to save old umask
  631.       while ($max) {
  632.           $max--;
  633.           if (-f "$file.lock") {
  634. !             sleep(2);    # busy: wait
  635.               next;
  636.           }
  637.           # Attempt to create lock
  638.           $mask = umask(0333);            # no write permission
  639.           if (open(FILE, ">$file.lock")) {
  640. !             print FILE "$$\n";            # write pid
  641.               close FILE;
  642.               umask($mask);                # restore old umask
  643.               # Check lock
  644.               open(FILE, "$file.lock");
  645. !             $_ = <FILE>;                # read contents
  646.               close FILE;
  647. !             last if int($_) == $$;        # lock is ok
  648.           } else {
  649.               umask($mask);                # restore old umask
  650. !             sleep(2);                    # busy: wait
  651.           }
  652.       }
  653.       if ($max) {
  654. --- 6,77 ----
  655.   ;#  Licence as specified in the README file that comes with dist.
  656.   ;#
  657.   ;# $Log:    acs_rqst.pl,v $
  658. + ;# Revision 2.9.1.1  93/01/12  12:10:37  ram
  659. + ;# patch15: can now perform NFS-safe lockings
  660. + ;# patch15: locking operation automatically checks for outdated locks
  661. + ;# 
  662.   ;# Revision 2.9  92/07/14  16:49:28  ram
  663.   ;# 3.0 beta baseline.
  664.   ;# 
  665.   ;#
  666. ! ;# The basic file locking scheme implemented here by acs_rqst is not completely
  667. ! ;# suitable with NFS if multiple mailagent can run, since they could have the
  668. ! ;# same PID on different machine and both think they got a lock. To make this
  669. ! ;# work with NFS, the ~/.mailagent config file must have the 'nfslock' variable
  670. ! ;# set to 'YES', which will cause the mailagent to include hostname informations
  671. ! ;# in the lock file.
  672. ! ;#
  673. ! ;# The traditional NFS scheme of having a `hostname`.pid file linked to .lock
  674. ! ;# (since the linking operation remains atomic even with NFS) does not seem
  675. ! ;# suitable here, since I want to be able to recover from crashes, and detect
  676. ! ;# out-of-date locks. Therefore, I must be able to know what is the name of the
  677. ! ;# lock file. The link/unlink trick could leave some temporary files around.
  678. ! ;# Since write on disks are atomic anyway, only one process can conceivably
  679. ! ;# obtain a lock with my scheme.
  680. ! ;#
  681. ! ;# The NFS-secure lock is made optional because, in order to get the hostname,
  682. ! ;# perl must fork to exec an appropriate program. This added overhead might not
  683. ! ;# be necessary in all the situations.
  684. ! ;#
  685. ! # Asks for the exclusive access of a file. The config variable 'nfslock'
  686. ! # determines whether the locking scheme has to be NFS-secure or not.
  687. ! # The given parameter (let's say F) is the absolute path of the file we want
  688. ! # to access. The routine checks for the presence of F.lock. If it exists, it
  689. ! # sleeps 2 seconds and tries again. After 10 trys, it reports failure by
  690. ! # returning -1. Otherwise, file F.lock is created and the pid of the current
  691.   # process is written. It is checked afterwards.
  692.   sub acs_rqst {
  693.       local($file) = @_;    # file to be locked
  694.       local($max) = 10;    # max number of attempts
  695. +     local($delay) = 2;    # seconds to wait between attempts
  696.       local($mask);        # to save old umask
  697. +     local($stamp);        # string written in lock file
  698. +     &checklock($file);    # avoid long-lasting locks
  699. +     if ($cf'nfslock =~ /on/i) {            # NFS-secure lock wanted
  700. +         $stamp = "$$" . &hostname;        # use PID and hostname
  701. +     } else {
  702. +         $stamp = "$$";                    # use PID only (may spare a fork)
  703. +     }
  704.       while ($max) {
  705.           $max--;
  706.           if (-f "$file.lock") {
  707. !             sleep($delay);                # busy: wait
  708.               next;
  709.           }
  710.           # Attempt to create lock
  711.           $mask = umask(0333);            # no write permission
  712.           if (open(FILE, ">$file.lock")) {
  713. !             print FILE "$stamp\n";        # write locking stamp
  714.               close FILE;
  715.               umask($mask);                # restore old umask
  716.               # Check lock
  717.               open(FILE, "$file.lock");
  718. !             chop($_ = <FILE>);            # read contents
  719.               close FILE;
  720. !             last if $_ eq $stamp;        # lock is ok
  721.           } else {
  722.               umask($mask);                # restore old umask
  723. !             sleep($delay);                # busy: wait
  724.           }
  725.       }
  726.       if ($max) {
  727.  
  728. Index: agent/pl/mmdf.pl
  729. *** agent/pl/mmdf.pl.old    Tue Jan 12 13:41:40 1993
  730. --- agent/pl/mmdf.pl    Tue Jan 12 13:41:40 1993
  731. ***************
  732. *** 0 ****
  733. --- 1,110 ----
  734. + ;# $Id: mmdf.pl,v 2.9.1.1 93/01/12 13:34:34 ram Exp $
  735. + ;#
  736. + ;#  Copyright (c) 1992, Raphael Manfredi
  737. + ;#
  738. + ;#  You may redistribute only under the terms of the GNU General Public
  739. + ;#  Licence as specified in the README file that comes with dist.
  740. + ;#
  741. + ;# $Log:    mmdf.pl,v $
  742. + ;# Revision 2.9.1.1  93/01/12  13:34:34  ram
  743. + ;# patch15: created
  744. + ;# 
  745. + ;# 
  746. + ;# This set of routine handles MMDF-style mailboxes, which differ from the
  747. + ;# traditional Unix-style boxes by encapsulating each message between 2 lines
  748. + ;# of 4 ^A, one at the begining and one at the end. The leading From_ line is
  749. + ;# consequently not needed and is removed.
  750. + ;#
  751. + ;# Note: this MMDF-style mailbox is also used by MH packed folders.
  752. + ;#
  753. + #
  754. + # MMDF-style saving routines
  755. + #
  756. + 
  757. + package mmdf;
  758. + 
  759. + # Attempt to save in a possible MMDF mailbox. The routine opens the mailbox
  760. + # and tries to determine what kind of mailbox it is, then selects the
  761. + # appropriate saving routine.
  762. + sub save {
  763. +     local(*FD, $mailbox) = @_;    # File descriptor and mailbox name
  764. +     if (&is_mmdf($mailbox)) {    # Folder looks like an MMDF mailbox
  765. +         &save_mmdf(*FD);        # Use MMDF format then
  766. +     } else {
  767. +         &save_unix(*FD);        # Be conservative and use standard format
  768. +     }
  769. + }
  770. +     
  771. + # Save to a MMDF-style mailbox and return failure status with message length
  772. + sub save_mmdf {
  773. +     local(*FD) = @_;            # File descriptor
  774. +     local($amount) = 0;            # Amount of bytes saved
  775. +     local($failed);
  776. +     local($from);
  777. +     local(@head) = split(/\n/, $'Header{'Head'});
  778. +     $from = shift(@head);        # The first From_ line has to be skipped
  779. +     unless ($from =~ /^From\s/) {
  780. +         &'add_log("WARNING leading From line absent") if $'loglvl > 5;
  781. +         unshift(@head, $from);    # Put it back if not a From_ line
  782. +     }
  783. +     (print FD "\01\01\01\01\n") || ($failed = 1);
  784. +     foreach $line (@head) {
  785. +         (print FD $line, "\n") || ($failed = 1);
  786. +         $amount += length($line) + 1;
  787. +     }
  788. +     (print FD $'FILTER, "\n\n") || ($failed = 1);
  789. +     (print FD $'Header{'Body'}) || ($failed = 1);
  790. +     &force_flushing(*FD);
  791. +     (print FD "\01\01\01\01\n") || ($failed = 1);
  792. +     $amount +=
  793. +         length($'Header{'Body'}) +    # Message body
  794. +         length($'FILTER) + 2 +        # X-Filter line plus two newlines
  795. +         5 + 5;                        # MMDF message delimiter lines
  796. +     ($failed, $amount);
  797. + }
  798. + 
  799. + # Save to a Unix-style mailbox and return failure status with message length
  800. + sub save_unix {
  801. +     local(*FD) = @_;            # File descriptor
  802. +     local($amount) = 0;            # Amount of bytes saved
  803. +     local($failed);
  804. +     # First print the Header, then add the X-Filter: line, followed by body.
  805. +     (print FD $'Header{'Head'}) || ($failed = 1);
  806. +     (print FD $'FILTER, "\n\n") || ($failed = 1);
  807. +     (print FD $'Header{'Body'}) || ($failed = 1);
  808. +     &force_flushing(*FD);
  809. +     (print FD "\n") || ($failed = 1);        # Allow parsing by other tools
  810. +     $amount +=
  811. +         length($'Header{'Head'}) +    # Message header
  812. +         length($'Header{'Body'}) +    # Message body
  813. +         length($'FILTER) + 2 +        # X-Filter line plus two newlines
  814. +         1;                            # Trailing new-line
  815. +     ($failed, $amount);
  816. + }
  817. + 
  818. + # Force flushing on file descriptor, so that after next print, we may rest
  819. + # assured everything as been written on disk. That way, we may stat the file
  820. + # without closing it (since that would release any flock-style lock).
  821. + sub force_flushing {
  822. +     local(*FD) = @_;            # File descriptor we want to flush
  823. +     select((select(FD), $| = 1)[0]);
  824. + }
  825. + 
  826. + # Guess whether the folder we are writing to is MMDF-style or not.
  827. + sub is_mmdf {
  828. +     local($folder) = @_;        # The folder to be scanned
  829. +     open(FOLDER, "$folder") || return 0;    # Can't open -> not MMDF, say.
  830. +     local($_);                    # First line from folder
  831. +     $_ = <FOLDER>;                # Can be empty
  832. +     close FOLDER;
  833. +     return 0 if /^From\s/;            # Looks like an Unix-style mailbox
  834. +     return 1 if /^\01\01\01\01\n/;    # This must be an MMDF-style mailbox
  835. +     # If we can't decide (most probably because $_ is empty), then choose
  836. +     # according to the 'mmdfbox' parameter.
  837. +     &'add_log("WARNING folder $folder may be corrupted")
  838. +         if $_ ne '' && $'loglvl > 5;
  839. +     $cf'mmdfbox =~ /on/i ? 1 : 0;    # Force MMDF if mmdfbox is ON
  840. + }
  841. + 
  842. + package main;
  843. + 
  844.  
  845. Index: agent/magent.SH
  846. Prereq: 2.9.1.3
  847. *** agent/magent.SH.old    Tue Jan 12 13:40:43 1993
  848. --- agent/magent.SH    Tue Jan 12 13:40:44 1993
  849. ***************
  850. *** 14,20 ****
  851.   esac
  852.   echo "Extracting agent/magent (with variable substitutions)"
  853.   $spitshell >magent <<!GROK!THIS!
  854. ! # feed this into perl
  855.       eval 'exec perl -S \$0 "\$@"'
  856.           if \$running_under_some_shell;
  857.   
  858. --- 14,20 ----
  859.   esac
  860.   echo "Extracting agent/magent (with variable substitutions)"
  861.   $spitshell >magent <<!GROK!THIS!
  862. ! $startperl
  863.       eval 'exec perl -S \$0 "\$@"'
  864.           if \$running_under_some_shell;
  865.   
  866. ***************
  867. *** 22,28 ****
  868.   # via the filter. Mine looks like this:
  869.   #   "|exec /users/ram/mail/filter >>/users/ram/.bak 2>&1"
  870.   
  871. ! # $Id: magent.SH,v 2.9.1.3 92/12/01 09:14:07 ram Exp $
  872.   #
  873.   #  Copyright (c) 1991, 1992, Raphael Manfredi
  874.   #
  875. --- 22,28 ----
  876.   # via the filter. Mine looks like this:
  877.   #   "|exec /users/ram/mail/filter >>/users/ram/.bak 2>&1"
  878.   
  879. ! # $Id: magent.SH,v 2.9.1.4 93/01/12 12:08:31 ram Exp $
  880.   #
  881.   #  Copyright (c) 1991, 1992, Raphael Manfredi
  882.   #
  883. ***************
  884. *** 30,35 ****
  885. --- 30,40 ----
  886.   #  Licence as specified in the README file that comes with dist.
  887.   #
  888.   # $Log:    magent.SH,v $
  889. + # Revision 2.9.1.4  93/01/12  12:08:31  ram
  890. + # patch15: can now deal with compression
  891. + # patch15: knows about MMDF-style mailboxes
  892. + # patch15: leading perl start up is now configured
  893. + # 
  894.   # Revision 2.9.1.3  92/12/01  09:14:07  ram
  895.   # patch13: hostname is now computed once and cached
  896.   # patch13: three new .pl files are now appended
  897. ***************
  898. *** 190,196 ****
  899.   $jobnum = &jobnum;                # Compute a job number
  900.   
  901.   # Allow only ONE mailagent at a time (resource consumming)
  902. ! do checklock($baselock);        # Make sure old locks do not remain
  903.   unless (-f $lockfile) {
  904.       # Try to get the lock file (acting as a token). We do not need locking if
  905.       # we have been invoked with an option and that option is not -q.
  906. --- 195,201 ----
  907.   $jobnum = &jobnum;                # Compute a job number
  908.   
  909.   # Allow only ONE mailagent at a time (resource consumming)
  910. ! &checklock($baselock);            # Make sure old locks do not remain
  911.   unless (-f $lockfile) {
  912.       # Try to get the lock file (acting as a token). We do not need locking if
  913.       # we have been invoked with an option and that option is not -q.
  914. ***************
  915. *** 287,292 ****
  916. --- 292,298 ----
  917.   
  918.   # End of mailagent processing
  919.   &write_stats;                    # Resynchronizes the statistics file
  920. + &compress'recompress;            # Compress some of the folders we delivered to
  921.   &contextual_operations;            # Perform all the contextual operations
  922.   &add_log("mailagent exits") if $loglvl > 17;
  923.   unlink $lockfile if $locked;
  924. ***************
  925. *** 446,456 ****
  926.       seek(MBOX, 0, 2);                # Someone may have appended something
  927.   }
  928.   
  929. ! # Remove lock on mailbox
  930.   sub mbox_unlock {
  931.       local($file) = @_;                # File name
  932. !     close MBOX;                        # Closing will remove flock lock
  933.       &free_file($file) unless $flock_only;        # Remove the .lock
  934.   }
  935.   
  936.   # Computes the e-mail address of the user
  937. --- 452,464 ----
  938.       seek(MBOX, 0, 2);                # Someone may have appended something
  939.   }
  940.   
  941. ! # Remove lock on mailbox and return a failure status if closing failed
  942.   sub mbox_unlock {
  943.       local($file) = @_;                # File name
  944. !     local($status);                    # Error status from close
  945. !     $status = close(MBOX);            # Closing will remove flock lock
  946.       &free_file($file) unless $flock_only;        # Remove the .lock
  947. +     $status ? 0 : 1;                # Return 0 for ok, 1 if close failed
  948.   }
  949.   
  950.   # Computes the e-mail address of the user
  951. ***************
  952. *** 575,579 ****
  953. --- 583,589 ----
  954.   $grep -v '^;#' pl/include.pl >>magent
  955.   $grep -v '^;#' pl/plural.pl >>magent
  956.   $grep -v '^;#' pl/hostname.pl >>magent
  957. + $grep -v '^;#' pl/mmdf.pl >>magent
  958. + $grep -v '^;#' pl/compress.pl >>magent
  959.   chmod 755 magent
  960.   $eunicefix magent
  961.  
  962. Index: Configure
  963. Prereq: 2.9.1.1
  964. *** Configure.old    Tue Jan 12 13:40:34 1993
  965. --- Configure    Tue Jan 12 13:40:35 1993
  966. ***************
  967. *** 16,22 ****
  968.   # Write to ram@eiffel.com (Raphael Manfredi) and I will send you the
  969.   # latest revision of the dist package, which includes metaconfig.)
  970.   
  971. ! # $Id: Configure,v 2.9.1.1 92/12/01 09:09:08 ram Exp $
  972.   #
  973.   # Generated on Tue Jul 14 19:38:33 PDT 1992 [metaconfig 2.8 PL13]
  974.   
  975. --- 16,22 ----
  976.   # Write to ram@eiffel.com (Raphael Manfredi) and I will send you the
  977.   # latest revision of the dist package, which includes metaconfig.)
  978.   
  979. ! # $Id: Configure,v 2.9.1.2 93/01/12 12:06:33 ram Exp $
  980.   #
  981.   # Generated on Tue Jul 14 19:38:33 PDT 1992 [metaconfig 2.8 PL13]
  982.   
  983. ***************
  984. *** 205,210 ****
  985. --- 205,211 ----
  986.   orgname=''
  987.   package=''
  988.   perlpath=''
  989. + startperl=''
  990.   pidtype=''
  991.   privlib=''
  992.   reg10=''
  993. ***************
  994. *** 2548,2553 ****
  995. --- 2549,2583 ----
  996.       esac
  997.   done
  998.   
  999. + : figure out how to guarantee perl startup
  1000. + case "$sharpbang" in
  1001. + *!)
  1002. +     $cat <<EOH
  1003. + 
  1004. + I can use the #! construct to start perl on your system. This will make
  1005. + startup of perl scripts faster, but may cause problems if you want to share
  1006. + those scripts and perl is not in a standard place (/usr/bin/perl) on all your
  1007. + platforms. The alternative is to force a shell by starting the script with a
  1008. + single ':' character.
  1009. + 
  1010. + EOH
  1011. +     dflt=n
  1012. +     case "$startperl" in
  1013. +     *!*) dflt=y;;
  1014. +     '') case "$d_portable" in
  1015. +         "$define") ;;
  1016. +         *) dflt=y;;
  1017. +         esac;;
  1018. +     esac
  1019. +     rp='Shall I use #! to start up perl?'
  1020. +     . ./myread
  1021. +     case "$ans" in
  1022. +     y*|Y*) startperl="#!$perlpath";;
  1023. +     *) startperl=": # use perl";;
  1024. +     esac;;
  1025. + *) startperl=": # use perl";;
  1026. + esac
  1027. + 
  1028.   : see what type pids are declared as in the kernel
  1029.   case "$pidtype" in
  1030.   '')
  1031. ***************
  1032. *** 2672,2678 ****
  1033.   
  1034.   : get C preprocessor symbols handy
  1035.   echo " "
  1036. ! echo $attrlist | $tr '[ - ]' '[\012-\012]' >Cppsym.know
  1037.   $cat <<EOSS >Cppsym
  1038.   $startsh
  1039.   case "\$1" in
  1040. --- 2702,2708 ----
  1041.   
  1042.   : get C preprocessor symbols handy
  1043.   echo " "
  1044. ! echo $attrlist | $tr ' ' '\012' >Cppsym.know
  1045.   $cat <<EOSS >Cppsym
  1046.   $startsh
  1047.   case "\$1" in
  1048. ***************
  1049. *** 2699,2705 ****
  1050.   case \$# in
  1051.   0) exit 1;;
  1052.   esac
  1053. ! echo \$* | $tr '[ - ]' '[\012-\012]' | $sed -e 's/\(.*\)/\\
  1054.   #ifdef \1\\
  1055.   exit 0; _ _ _ _\1\\     \1\\
  1056.   #endif\\
  1057. --- 2729,2735 ----
  1058.   case \$# in
  1059.   0) exit 1;;
  1060.   esac
  1061. ! echo \$* | $tr ' ' '\012' | $sed -e 's/\(.*\)/\\
  1062.   #ifdef \1\\
  1063.   exit 0; _ _ _ _\1\\     \1\\
  1064.   #endif\\
  1065. ***************
  1066. *** 3044,3049 ****
  1067. --- 3074,3080 ----
  1068.   orgname='$orgname'
  1069.   package='$package'
  1070.   perlpath='$perlpath'
  1071. + startperl='$startperl'
  1072.   pidtype='$pidtype'
  1073.   privlib='$privlib'
  1074.   reg10='$reg10'
  1075.  
  1076. Index: agent/pl/free_file.pl
  1077. Prereq: 2.9
  1078. *** agent/pl/free_file.pl.old    Tue Jan 12 13:41:29 1993
  1079. --- agent/pl/free_file.pl    Tue Jan 12 13:41:30 1993
  1080. ***************
  1081. *** 1,4 ****
  1082. ! ;# $Id: free_file.pl,v 2.9 92/07/14 16:50:00 ram Exp $
  1083.   ;#
  1084.   ;#  Copyright (c) 1991, Raphael Manfredi
  1085.   ;#
  1086. --- 1,4 ----
  1087. ! ;# $Id: free_file.pl,v 2.9.1.1 93/01/12 13:28:16 ram Exp $
  1088.   ;#
  1089.   ;#  Copyright (c) 1991, Raphael Manfredi
  1090.   ;#
  1091. ***************
  1092. *** 6,11 ****
  1093. --- 6,14 ----
  1094.   ;#  Licence as specified in the README file that comes with dist.
  1095.   ;#
  1096.   ;# $Log:    free_file.pl,v $
  1097. + ;# Revision 2.9.1.1  93/01/12  13:28:16  ram
  1098. + ;# patch15: now knows about NFS-safe locks
  1099. + ;# 
  1100.   ;# Revision 2.9  92/07/14  16:50:00  ram
  1101.   ;# 3.0 beta baseline.
  1102.   ;# 
  1103. ***************
  1104. *** 13,30 ****
  1105.   # Remove the lock on a file. Returns 0 if ok, -1 otherwise
  1106.   sub free_file {
  1107.       local($file) = @_;
  1108.   
  1109.       if ( -f "$file.lock") {
  1110.           # if lock exists, check for pid
  1111.           open(FILE, "$file.lock");
  1112. !         $_ = <FILE>;
  1113.           close FILE;
  1114. !         if (int($_) == $$) {
  1115. !             # pid is correct
  1116.               $result = 0;
  1117.               unlink "$file.lock";
  1118.           } else {
  1119. !             # pid is not correct
  1120.               $result = -1;
  1121.           }
  1122.       } else {
  1123. --- 16,40 ----
  1124.   # Remove the lock on a file. Returns 0 if ok, -1 otherwise
  1125.   sub free_file {
  1126.       local($file) = @_;
  1127. +     local($stamp);        # string written in lock file
  1128. + 
  1129. +     if ($cf'nfslock =~ /on/i) {            # NFS-secure lock wanted
  1130. +         $stamp = "$$" . &hostname;        # use PID and hostname
  1131. +     } else {
  1132. +         $stamp = "$$";                    # use PID only (may spare a fork)
  1133. +     }
  1134.   
  1135.       if ( -f "$file.lock") {
  1136.           # if lock exists, check for pid
  1137.           open(FILE, "$file.lock");
  1138. !         chop($_ = <FILE>);
  1139.           close FILE;
  1140. !         if ($_ eq $stamp) {
  1141. !             # pid (plus hostname eventually) is correct
  1142.               $result = 0;
  1143.               unlink "$file.lock";
  1144.           } else {
  1145. !             # pid is not correct (we did not get that lock)
  1146.               $result = -1;
  1147.           }
  1148.       } else {
  1149.  
  1150. Index: agent/pl/matching.pl
  1151. Prereq: 2.9.1.2
  1152. *** agent/pl/matching.pl.old    Tue Jan 12 13:41:38 1993
  1153. --- agent/pl/matching.pl    Tue Jan 12 13:41:38 1993
  1154. ***************
  1155. *** 1,4 ****
  1156. ! ;# $Id: matching.pl,v 2.9.1.2 92/12/01 09:25:48 ram Exp $
  1157.   ;#
  1158.   ;#  Copyright (c) 1992, Raphael Manfredi
  1159.   ;#
  1160. --- 1,4 ----
  1161. ! ;# $Id: matching.pl,v 2.9.1.3 93/01/12 13:34:10 ram Exp $
  1162.   ;#
  1163.   ;#  Copyright (c) 1992, Raphael Manfredi
  1164.   ;#
  1165. ***************
  1166. *** 6,11 ****
  1167. --- 6,14 ----
  1168.   ;#  Licence as specified in the README file that comes with dist.
  1169.   ;#
  1170.   ;# $Log:    matching.pl,v $
  1171. + ;# Revision 2.9.1.3  93/01/12  13:34:10  ram
  1172. + ;# patch15: typo fix
  1173. + ;# 
  1174.   ;# Revision 2.9.1.2  92/12/01  09:25:48  ram
  1175.   ;# patch13: new perl_pattern function to transform shell-style patterns
  1176.   ;# patch13: file inclusion now handled by include_file
  1177. ***************
  1178. *** 115,121 ****
  1179.           # one of them matches, we stop and return true. A selector may contain
  1180.           # metacharacters, in which case a regular pattern matching is attempted
  1181.           # on the true *header* fields (i.e. we skip the pseudo keys like Body,
  1182. !         # Head, etc..). For instance, Return* would attempt a match on the
  1183.           # field Return-Receipt-To:, if present. The special macro %& is set
  1184.           # to the list of all the fields on which the match succeeded
  1185.           # (alphabetically sorted).
  1186. --- 118,124 ----
  1187.           # one of them matches, we stop and return true. A selector may contain
  1188.           # metacharacters, in which case a regular pattern matching is attempted
  1189.           # on the true *header* fields (i.e. we skip the pseudo keys like Body,
  1190. !         # Head, etc..). For instance, Return.* would attempt a match on the
  1191.           # field Return-Receipt-To:, if present. The special macro %& is set
  1192.           # to the list of all the fields on which the match succeeded
  1193.           # (alphabetically sorted).
  1194.  
  1195. Index: agent/pl/emergency.pl
  1196. Prereq: 2.9.1.1
  1197. *** agent/pl/emergency.pl.old    Tue Jan 12 13:41:23 1993
  1198. --- agent/pl/emergency.pl    Tue Jan 12 13:41:23 1993
  1199. ***************
  1200. *** 1,4 ****
  1201. ! ;# $Id: emergency.pl,v 2.9.1.1 92/08/12 21:33:04 ram Exp $
  1202.   ;#
  1203.   ;#  Copyright (c) 1992, Raphael Manfredi
  1204.   ;#
  1205. --- 1,4 ----
  1206. ! ;# $Id: emergency.pl,v 2.9.1.2 93/01/12 12:13:41 ram Exp $
  1207.   ;#
  1208.   ;#  Copyright (c) 1992, Raphael Manfredi
  1209.   ;#
  1210. ***************
  1211. *** 6,11 ****
  1212. --- 6,14 ----
  1213.   ;#  Licence as specified in the README file that comes with dist.
  1214.   ;#
  1215.   ;# $Log:    emergency.pl,v $
  1216. + ;# Revision 2.9.1.2  93/01/12  12:13:41  ram
  1217. + ;# patch15: now checks for error on file closing (buffer flushing)
  1218. + ;# 
  1219.   ;# Revision 2.9.1.1  92/08/12  21:33:04  ram
  1220.   ;# patch6: do not read mail if stdin is connected to a tty
  1221.   ;# 
  1222. ***************
  1223. *** 95,101 ****
  1224.       if (open(MBOX, ">>$mbox")) {
  1225.           (print MBOX $Header{'All'}) && ($ok = 1);
  1226.           print MBOX "\n";                # allow parsing by other mail tools
  1227. !         close MBOX;
  1228.           if ($ok) {
  1229.               do add_log("DUMPED in $mbox") if $loglvl > 5;
  1230.               return 1;
  1231. --- 98,104 ----
  1232.       if (open(MBOX, ">>$mbox")) {
  1233.           (print MBOX $Header{'All'}) && ($ok = 1);
  1234.           print MBOX "\n";                # allow parsing by other mail tools
  1235. !         close(MBOX) || ($ok = 0);
  1236.           if ($ok) {
  1237.               do add_log("DUMPED in $mbox") if $loglvl > 5;
  1238.               return 1;
  1239. ***************
  1240. *** 126,132 ****
  1241.                   $printed = 1;
  1242.               }
  1243.           }
  1244. !         close WAITING;
  1245.           if ($printed) {
  1246.               if (!$ok) {
  1247.                   do add_log("ERROR could not update waiting file") if $loglvl;
  1248. --- 129,135 ----
  1249.                   $printed = 1;
  1250.               }
  1251.           }
  1252. !         close(WAITING) || ($ok = 0);
  1253.           if ($printed) {
  1254.               if (!$ok) {
  1255.                   do add_log("ERROR could not update waiting file") if $loglvl;
  1256.  
  1257. Index: agent/test/TEST
  1258. *** agent/test/TEST.old    Tue Jan 12 13:41:45 1993
  1259. --- agent/test/TEST    Tue Jan 12 13:41:46 1993
  1260. ***************
  1261. *** 26,31 ****
  1262. --- 26,32 ----
  1263.   -f "../$mailagent" && -x _ || die "No $mailagent.\n";
  1264.   -f "../mailhook" && -x _ || die "No mailhook.\n";
  1265.   -f '../filter/filter' && -x _ || die "No filter.\n";
  1266. + $> || die "Cannot run tests as super-user.\n";
  1267.   
  1268.   &load_ok;        # Don't rerun successful tests if up to date
  1269.   
  1270.  
  1271. *** End of Patch 15 ***
  1272. -- 
  1273. Raphael Manfredi <ram@eiffel.com>
  1274. Interactive Software Engineering Inc.
  1275. 270 Storke Road, Suite #7                      / Tel +1 (805) 685-1006 \
  1276. Goleta, California 93117, USA                  \ Fax +1 (805) 685-6869 /
  1277.