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