home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #30 / NN_1992_30.iso / spool / comp / sources / misc / 4165 < prev    next >
Encoding:
Text File  |  1992-12-12  |  46.4 KB  |  1,380 lines
  1. Newsgroups: comp.sources.misc
  2. Path: sparky!kent
  3. From: ram@eiffel.com (Raphael Manfredi)
  4. Subject:  v34i025:  mailagent - Rule Based Mail Filtering, Patch13
  5. Message-ID: <1992Dec13.022249.29882@sparky.imd.sterling.com>
  6. Followup-To: comp.sources.d
  7. X-Md4-Signature: a3c760916049925ca96b1720928a195c
  8. Sender: kent@sparky.imd.sterling.com (Kent Landfield)
  9. Organization: Interactive Software Engineering, Santa Barbara CA
  10. Date: Sun, 13 Dec 1992 02:22:49 GMT
  11. Approved: kent@sparky.imd.sterling.com
  12. Lines: 1366
  13.  
  14. Submitted-by: ram@eiffel.com (Raphael Manfredi)
  15. Posting-number: Volume 34, Issue 25
  16. Archive-name: mailagent/patch13
  17. Environment: Perl, Sendmail, UNIX
  18. Patch-To: mailagent: Volume 33, Issue 93-109
  19.  
  20. [Please note that mailagent was initially posted to comp.sources.misc]
  21. [at patchlevel 12. This is the first of two patches (13 and 14) being]
  22. [posted, bringing mailagent to version 2.9 patchlevel 14.    -Kent+  ]
  23.  
  24. System: mailagent version 2.9
  25. Patch #: 13
  26. Priority: MEDIUM
  27. Subject: changed Configure test for 'union wait'
  28. Subject: chkagent could report errors due to spurious matches
  29. Subject: added extra checking for writes to soft NFS-mounted disks
  30. Subject: filter now also complains when using -t in setgid mode
  31. Subject: removed spurious inclusion of <sys/types.h>
  32. Subject: hostname is now computed once and cached
  33. Subject: fixed various typos on the word "Precedence"
  34. Subject: new paragraph about file inclusion
  35. Subject: allowed file inclusion for KEEP and STRIP
  36. Subject: new macros %A, %C, %I and %O
  37. Subject: remove context file lock when excessively old
  38. Subject: action parsing rewritten to handle nested braces
  39. Subject: forgot to handle the %H macro
  40. Subject: (reported by David Giddy <d.giddy@trl.oz.au>)
  41. Subject: now also understands multiple To and Cc lines in headers
  42. Subject: added internet info extraction out of e-mail address
  43. Subject: now takes care of escaped ';' for layout purposes
  44. Subject: read statistics lines one at a time to limit memory usage
  45. Subject: added new tests for file inclusion with KEEP and STRIP
  46. Date: Tue Dec  1 09:48:46 PST 1992
  47. From: Raphael Manfredi <ram@eiffel.com>
  48.  
  49. Description:
  50.     Changed Configure test for 'union wait'. A lot of platforms had
  51.     problems with that and had to manually undefine UNION_WAIT from
  52.     config.h. Configure now looks for 'union.*wait.*{' in <sys/wait.h>
  53.     to see whether your system wants a plain int pointer or a union
  54.     wait pointer.
  55.  
  56.     chkagent could report errors due to spurious matches. This script
  57.     (intended to be run through cron) gave false alarms when a message
  58.     subject contained the word 'ERROR' for instance, and was logged.
  59.     The script now makes sure such a word is preceded by ': ' in the
  60.     logfile. This should reduce the chance of getting an error report
  61.     whereas nothing went wrong.
  62.  
  63.     Added extra checking for writes to soft NFS-mounted disks. The filter
  64.     program makes all the necessary system call status checks when queuing
  65.     a message. However, when writing on a soft NFS partition, I once got
  66.     an empty message with no error report from write. So the filter now
  67.     stats the queued file to make sure its size matches the size of the
  68.     mail read from sendmail.
  69.  
  70.     The filter now also complains when using -t in setgid mode. It already
  71.     complained when used in setuid mode, but I discovered a way to breach
  72.     through security by using only the setgid bit, so...
  73.  
  74.     Removed spurious inclusion of <sys/types.h> in parser.c. This could
  75.     prevent the parser from actually compiling.
  76.  
  77.     Fixed various typos on the word "Precedence" throughout the manual page.
  78.  
  79.     There is a new paragraph about file inclusion in the manual page,
  80.     explaining what it is and how it works.
  81.  
  82.     Allowed file inclusion for KEEP and STRIP. I've also made sure that
  83.     those worked even when mail headers are not normalized. For instance,
  84.     'STRIP Cc' should strip a 'cc:' line in the message header.
  85.  
  86.     New macros %A, %C, %I and %O. Refer to the manual page for details.
  87.  
  88.     Action parsing was rewritten to handle nested braces, in anticipation
  89.     for other features I'd like to add.
  90.  
  91.     Forgot to handle the %H macro (reported by David Giddy
  92.     <d.giddy@trl.oz.au>).
  93.  
  94.     Now understands multiple To and Cc lines in headers. The fields
  95.     are correctly concatenated, for filtering purposes, into a long list
  96.     of comma separated addresses.
  97.  
  98.     Now takes care of escaped ';' for layout purposes (when dumping rules).
  99.  
  100.     Read statistics lines one at a time to limit memory usage. If you are
  101.     collecting statistics and have changed your rule file so often that
  102.     your statistics file is huge (say 400 Kb), then you may have noticed
  103.     excessive memory consumptions, since the mailagent was trying to load
  104.     that file into memory without any pre-extension, thus causing the
  105.     process to grow rapidly as numerous realloc() occured.
  106.  
  107.     Added new tests for file inclusion with KEEP and STRIP and make sure
  108.     they behave in a case insensitive manner.
  109.  
  110.     Three new files were added in agent/pl/.
  111.  
  112.  
  113. Fix:    From rn, say "| patch -p -N -d DIR", where DIR is your mailagent source
  114.     directory.  Outside of rn, say "cd DIR; patch -p -N <thisarticle".
  115.     If you don't have the patch program, apply the following by hand,
  116.     or get patch (version 2.0, latest patchlevel).
  117.  
  118.     After patching:
  119.         *** DO NOTHING--INSTALL ALL PATCHES UP THROUGH #14 FIRST ***
  120.  
  121.     If patch indicates that patchlevel is the wrong version, you may need
  122.     to apply one or more previous patches, or the patch may already
  123.     have been applied.  See the patchlevel.h file to find out what has or
  124.     has not been applied.  In any event, don't continue with the patch.
  125.  
  126.     If you are missing previous patches they can be obtained from me:
  127.  
  128.         Raphael Manfredi <ram@eiffel.com>
  129.  
  130.     If you send a mail message of the following form it will greatly speed
  131.     processing:
  132.  
  133.         Subject: Command
  134.         @SH mailpatch PATH mailagent 2.9 LIST
  135.                ^ note the c
  136.  
  137.     where PATH is a return path FROM ME TO YOU either in Internet notation,
  138.     or in bang notation from some well-known host, and LIST is the number
  139.     of one or more patches you need, separated by spaces, commas, and/or
  140.     hyphens.  Saying 35- says everything from 35 to the end.
  141.  
  142.     To get some more detailed instructions, send me the following mail:
  143.  
  144.         Subject: Command
  145.         @SH mailhelp PATH
  146.  
  147.  
  148. Index: patchlevel.h
  149. Prereq: 12
  150. 4c4
  151. < #define PATCHLEVEL 12
  152. ---
  153. > #define PATCHLEVEL 13
  154.  
  155. Index: agent/man/mailagent.SH
  156. Prereq: 2.9.1.6
  157. *** agent/man/mailagent.SH.old    Tue Dec  1 09:47:54 1992
  158. --- agent/man/mailagent.SH    Tue Dec  1 09:47:56 1992
  159. ***************
  160. *** 18,24 ****
  161.   .TH MAILAGENT $manext "Version $VERSION PL$PATCHLEVEL"
  162.   ''' @(#) Manual page for mailagent's filter -- (c) ram February 1991
  163.   '''
  164. ! ''' $Id: mailagent.SH,v 2.9.1.6 92/11/10 10:12:13 ram Exp $
  165.   '''
  166.   '''  Copyright (c) 1991, 1992, Raphael Manfredi
  167.   '''
  168. --- 18,24 ----
  169.   .TH MAILAGENT $manext "Version $VERSION PL$PATCHLEVEL"
  170.   ''' @(#) Manual page for mailagent's filter -- (c) ram February 1991
  171.   '''
  172. ! ''' $Id: mailagent.SH,v 2.9.1.7 92/12/01 09:16:23 ram Exp $
  173.   '''
  174.   '''  Copyright (c) 1991, 1992, Raphael Manfredi
  175.   '''
  176. ***************
  177. *** 26,31 ****
  178. --- 26,37 ----
  179.   '''  License as specified in the README file that comes with dist.
  180.   '''
  181.   ''' $Log:    mailagent.SH,v $
  182. + ''' Revision 2.9.1.7  92/12/01  09:16:23  ram
  183. + ''' patch13: fixed various typos on the word "Precedence"
  184. + ''' patch13: new paragraph about file inclusion
  185. + ''' patch13: allowed file inclusion for KEEP and STRIP
  186. + ''' patch13: new macros %A, %C, %I and %O
  187. + ''' 
  188.   ''' Revision 2.9.1.6  92/11/10  10:12:13  ram
  189.   ''' patch12: perl interface functions now return 1 for success
  190.   ''' 
  191. ***************
  192. *** 54,60 ****
  193.   ''' 
  194.   ''' Revision 2.9.1.1  92/07/25  12:35:51  ram
  195.   ''' patch1: now respects English uppercased title conventions
  196. ! ''' patch1: a bulk or junk Precendence header voids vacation message
  197.   ''' patch1: documents the minimal set of header selectors available
  198.   ''' patch1: host name in p_host config variable cannot have domain name
  199.   ''' 
  200. --- 60,66 ----
  201.   ''' 
  202.   ''' Revision 2.9.1.1  92/07/25  12:35:51  ram
  203.   ''' patch1: now respects English uppercased title conventions
  204. ! ''' patch1: a bulk or junk Precedence header voids vacation message
  205.   ''' patch1: documents the minimal set of header selectors available
  206.   ''' patch1: host name in p_host config variable cannot have domain name
  207.   ''' 
  208. ***************
  209. *** 1267,1273 ****
  210.   a "KEEP From To Cc Subject" will keep only the principal fields from the
  211.   mail message. This is suitable for archving mailing lists messages.
  212.   You may add a ':' after each header field name if you wish, but that is not
  213. ! strictly necessary.
  214.   (Does not modify existing status)
  215.   .TP
  216.   LEAVE
  217. --- 1273,1280 ----
  218.   a "KEEP From To Cc Subject" will keep only the principal fields from the
  219.   mail message. This is suitable for archving mailing lists messages.
  220.   You may add a ':' after each header field name if you wish, but that is not
  221. ! strictly necessary. Headers may be specified using shell-style regular
  222. ! expressions, and file inclusion is allowed to get headers from a file.
  223.   (Does not modify existing status)
  224.   .TP
  225.   LEAVE
  226. ***************
  227. *** 1431,1437 ****
  228.   Remove the corresponding lines in the header of the mail. For instance,
  229.   a "STRIP Newsgroups Apparently-To" will remove the appropriate lines to wipe
  230.   out any Newsgroups: or Apparently-To: header. You may add a ':' after each
  231. ! header field name if you wish, but that is not strictly necessary.
  232.   (Does not alter execution status)
  233.   .TP
  234.   SUBST \fIvar expression\fR
  235. --- 1438,1445 ----
  236.   Remove the corresponding lines in the header of the mail. For instance,
  237.   a "STRIP Newsgroups Apparently-To" will remove the appropriate lines to wipe
  238.   out any Newsgroups: or Apparently-To: header. You may add a ':' after each
  239. ! header field name if you wish, but that is not strictly necessary. Headers
  240. ! may be specified via shell-style regular expressions or via "file" inclusion.
  241.   (Does not alter execution status)
  242.   .TP
  243.   SUBST \fIvar expression\fR
  244. ***************
  245. *** 1616,1622 ****
  246.   The login name of the address on the From: line.
  247.   .TP
  248.   .I \$precedence
  249. ! The content of the Precendence: line, if any at all.
  250.   .TP
  251.   .I \$sender
  252.   The sender of the message (may have a comment), derived in the same way the
  253. --- 1624,1630 ----
  254.   The login name of the address on the From: line.
  255.   .TP
  256.   .I \$precedence
  257. ! The content of the Precedence: line, if any at all.
  258.   .TP
  259.   .I \$sender
  260.   The sender of the message (may have a comment), derived in the same way the
  261. ***************
  262. *** 1666,1671 ****
  263. --- 1674,1693 ----
  264.   includes scripts started via the PERL command and mail hooks. The latter will
  265.   be described in detail further down.
  266.   '''
  267. + .SS "File inclusion"
  268. + .PP
  269. + Some commands like FORWARD or KEEP allow you to specify a file name between
  270. + double quotes to actually load parameters from this file. Unless a full path
  271. + is given, the following method is used to locate the file: first in the location
  272. + pointed to by the \fImailfilter\fR variable if set, otherwise in \fImaildir\fR
  273. + and finally in the home directory. Note that this is not a search path in the
  274. + sense that if \fImailfilter\fR is defined and the file is not there, an error
  275. + will be reported.
  276. + .PP
  277. + The file should list each parameter (be it an address, a header or a pattern)
  278. + on a line by itself. Shell-style comments (#) are allowed within that file and
  279. + leading white spaces are trimmed (but not trailing spaces).
  280. + '''
  281.   .SS "Macros Substitutions"
  282.   .PP
  283.   All the commands go through a macro substitution mechanism before being
  284. ***************
  285. *** 1676,1686 ****
  286.   %%
  287.   A real percent sign
  288.   .TP
  289.   %D
  290.   Day of the week (0-6)
  291.   .TP
  292.   %H
  293. ! Host name (name of the machine on which the \fImailagent\fR runs)
  294.   .TP
  295.   %L
  296.   Length of the body part, in bytes
  297. --- 1698,1721 ----
  298.   %%
  299.   A real percent sign
  300.   .TP
  301. + %A
  302. + The internet address extracted out of the \fIFrom:\fR field (\fIa.b.c\fR
  303. + in \fIu@a.b.c\fR), converted to lower-case.
  304. + .TP
  305. + %C
  306. + CPU name on which the mailagent runs. That is a fully qualified hostname
  307. + with the domain name, e.g. \fIlyon.eiffel.com\fR.
  308. + .TP
  309.   %D
  310.   Day of the week (0-6)
  311.   .TP
  312.   %H
  313. ! Host name (name of the machine on which the \fImailagent\fR runs), without
  314. ! any domain name. Always in lower-case, regardless of the machine name.
  315. ! .TP
  316. ! %I
  317. ! The internet domain name extracted out of the \fIFrom:\fR field (\fIb.c\fR
  318. ! in \fIu@a.b.c\fR), converted to lower-case.
  319.   .TP
  320.   %L
  321.   Length of the body part, in bytes
  322. ***************
  323. *** 1688,1693 ****
  324. --- 1723,1732 ----
  325.   %N
  326.   Full name of the sender (login name if none)
  327.   .TP
  328. + %O
  329. + The organization name extracted out of the \fIFrom:\fR field (\fIb\fR in
  330. + \fIu@a.b.c\fR), converted to lower-case.
  331. + .TP
  332.   %R
  333.   Subject of the original message with leading Re: suppressed
  334.   .TP
  335. ***************
  336. *** 1891,1897 ****
  337.   
  338.   Sincerely,
  339.   --
  340. ! %U <%u@%H>
  341.   .fi
  342.   .in -5
  343.   .sp
  344. --- 1930,1936 ----
  345.   
  346.   Sincerely,
  347.   --
  348. ! %U <%u@%C>
  349.   .fi
  350.   .in -5
  351.   .sp
  352. ***************
  353. *** 1905,1911 ****
  354.   \fInewsmaster\fR, \fIusenet\fR, \fIMAILER-DAEMON\fR or \fInobody\fR).
  355.   Matches are done in a case insentive manner, so \fIMailer-Daemon\fR will also
  356.   be recognized as a special user.
  357. ! Furthermore, any message tagged with a \fIPrecendence:\fR field set to
  358.   \fIbulk\fR or \fIjunk\fR will not trigger a vacation message. This built-in
  359.   behaviour can of course be overloaded by suitable rules (by testing and
  360.   issuing the vacation message yourself via MESSAGE).
  361. --- 1944,1950 ----
  362.   \fInewsmaster\fR, \fIusenet\fR, \fIMAILER-DAEMON\fR or \fInobody\fR).
  363.   Matches are done in a case insentive manner, so \fIMailer-Daemon\fR will also
  364.   be recognized as a special user.
  365. ! Furthermore, any message tagged with a \fIPrecedence:\fR field set to
  366.   \fIbulk\fR or \fIjunk\fR will not trigger a vacation message. This built-in
  367.   behaviour can of course be overloaded by suitable rules (by testing and
  368.   issuing the vacation message yourself via MESSAGE).
  369.  
  370. Index: agent/pl/actions.pl
  371. Prereq: 2.9.1.3
  372. *** agent/pl/actions.pl.old    Tue Dec  1 09:48:00 1992
  373. --- agent/pl/actions.pl    Tue Dec  1 09:48:01 1992
  374. ***************
  375. *** 1,4 ****
  376. ! ;# $Id: actions.pl,v 2.9.1.3 92/11/01 15:44:28 ram Exp $
  377.   ;#
  378.   ;#  Copyright (c) 1992, Raphael Manfredi
  379.   ;#
  380. --- 1,4 ----
  381. ! ;# $Id: actions.pl,v 2.9.1.4 92/12/01 09:18:05 ram Exp $
  382.   ;#
  383.   ;#  Copyright (c) 1992, Raphael Manfredi
  384.   ;#
  385. ***************
  386. *** 6,11 ****
  387. --- 6,15 ----
  388.   ;#  Licence as specified in the README file that comes with dist.
  389.   ;#
  390.   ;# $Log:    actions.pl,v $
  391. + ;# Revision 2.9.1.4  92/12/01  09:18:05  ram
  392. + ;# patch13: allowed file inclusion for KEEP and STRIP
  393. + ;# patch13: file inclusion processing now handled by &include_file
  394. + ;# 
  395.   ;# Revision 2.9.1.3  92/11/01  15:44:28  ram
  396.   ;# patch11: the PERL command now sets up @ARGV as if invoked from shell
  397.   ;# patch11: fixed message substitution bug (for MESSAGE and NOTIFY)
  398. ***************
  399. *** 407,413 ****
  400.       local($address) = &email_addr;    # Address of user
  401.       # Any address included withing "" is in fact a file name where actual
  402.       # forwarding addresses are found.
  403. !     $addresses = &complete_addr($addresses);    # Process "include-requests"
  404.       unless (open(MAILER,"|/usr/lib/sendmail -odq $addresses")) {
  405.           do add_log("cannot run sendmail to forward message") if $loglvl > 0;
  406.           return 1;
  407. --- 411,418 ----
  408.       local($address) = &email_addr;    # Address of user
  409.       # Any address included withing "" is in fact a file name where actual
  410.       # forwarding addresses are found.
  411. !     $addresses =
  412. !         &complete_list($addresses, 'address');    # Process "include-requests"
  413.       unless (open(MAILER,"|/usr/lib/sendmail -odq $addresses")) {
  414.           do add_log("cannot run sendmail to forward message") if $loglvl > 0;
  415.           return 1;
  416. ***************
  417. *** 439,445 ****
  418.       local($addresses) = @_;            # Address(es) mail should be bounced to
  419.       # Any address included withing "" is in fact a file name where actual
  420.       # bouncing addresses are found.
  421. !     $addresses = &complete_addr($addresses);    # Process "include-requests"
  422.       unless (open(MAILER,"|/usr/lib/sendmail -odq $addresses")) {
  423.           do add_log("cannot run sendmail to bounce message") if $loglvl > 0;
  424.           return 1;
  425. --- 444,451 ----
  426.       local($addresses) = @_;            # Address(es) mail should be bounced to
  427.       # Any address included withing "" is in fact a file name where actual
  428.       # bouncing addresses are found.
  429. !     $addresses =
  430. !         &complete_list($addresses, 'address');    # Process "include-requests"
  431.       unless (open(MAILER,"|/usr/lib/sendmail -odq $addresses")) {
  432.           do add_log("cannot run sendmail to bounce message") if $loglvl > 0;
  433.           return 1;
  434. ***************
  435. *** 955,975 ****
  436.   # Removes or keeps some headers and update the Header structure
  437.   sub alter_header {
  438.       local($headers, $action) = @_;
  439.       local(@list) = split(/\s/, $headers);
  440.       local(@head) = split(/\n/, $Header{'Head'});
  441.       local(@newhead);                # The constructed header
  442.       local($last_was_altered) = 0;    # Set to true when header is altered
  443.       local($matched);                # Did any header matched ?
  444.       foreach (@head) {
  445.           if (/^From\s/) {            # First From line...
  446.               push(@newhead, $_);        # Keep it anyway
  447.               next;
  448.           }
  449.           unless (/^\s/) {            # If not a continuation line
  450.               $last_was_altered = 0;    # Reset header alteration flag
  451.               $matched = 0;            # Assume no match
  452.               foreach $h (@list) {    # Loop over to-be-altered lines
  453. -                 $h =~ s/:$//;        # Remove trailing ':' if any
  454.                   if (/^$h:/i) {        # We found a line to be removed/kept
  455.                       $matched = 1;
  456.                       last;
  457. --- 961,992 ----
  458.   # Removes or keeps some headers and update the Header structure
  459.   sub alter_header {
  460.       local($headers, $action) = @_;
  461. +     $headers =
  462. +         &complete_list($headers, 'header');    # Process "file-inclusion"
  463.       local(@list) = split(/\s/, $headers);
  464.       local(@head) = split(/\n/, $Header{'Head'});
  465.       local(@newhead);                # The constructed header
  466.       local($last_was_altered) = 0;    # Set to true when header is altered
  467.       local($matched);                # Did any header matched ?
  468. +     local($line);                    # Original header line
  469. + 
  470. +     foreach $h (@list) {            # Prepare patterns
  471. +         $h =~ s/:$//;                # Remove trailing ':' if any
  472. +         $h = &perl_pattern($h);        # Headers specified by shell patterns
  473. +     }
  474. + 
  475.       foreach (@head) {
  476.           if (/^From\s/) {            # First From line...
  477.               push(@newhead, $_);        # Keep it anyway
  478.               next;
  479.           }
  480. +         $line = $_;                    # Save original
  481. +         # Make sure header field name is normalized before attempting a match
  482. +         s/^([\w-]+):/&header'normalize($1).':'/e;
  483.           unless (/^\s/) {            # If not a continuation line
  484.               $last_was_altered = 0;    # Reset header alteration flag
  485.               $matched = 0;            # Assume no match
  486.               foreach $h (@list) {    # Loop over to-be-altered lines
  487.                   if (/^$h:/i) {        # We found a line to be removed/kept
  488.                       $matched = 1;
  489.                       last;
  490. ***************
  491. *** 984,990 ****
  492.           } else {                                    # Action is $HD_KEEP
  493.               next if /^\s/ && !$last_was_altered;    # Header was not kept
  494.           }
  495. !         push(@newhead, $_);                        # Add line to the new header
  496.       }
  497.       $Header{'Head'} = join("\n", @newhead) . "\n";
  498.   }
  499. --- 1001,1007 ----
  500.           } else {                                    # Action is $HD_KEEP
  501.               next if /^\s/ && !$last_was_altered;    # Header was not kept
  502.           }
  503. !         push(@newhead, $line);        # Add line to the new header
  504.       }
  505.       $Header{'Head'} = join("\n", @newhead) . "\n";
  506.   }
  507. ***************
  508. *** 1158,1194 ****
  509.       0;
  510.   }
  511.   
  512. ! # Given a list of addresses separated by white spaces, return a new list of
  513. ! # addresses, but with "include-request" processed.
  514. ! sub complete_addr {
  515.       local(@addr) = split(' ', $_[0]);    # Original list
  516.       local(@result);                        # Where result list is built
  517.       local($filename);                    # Name of include file
  518.       local($_);
  519.       foreach $addr (@addr) {
  520. !         if ($addr !~ /^"/) {            # Address not enclosed within ""
  521.               push(@result, $addr);        # Kept as-is
  522.           } else {
  523. !             ($filename) = $addr =~ /^"(.*)"$/;
  524. !             $filename = &locate_file($filename);
  525. !             if ($filename && open(ADDRESSES, "$filename")) {
  526. !                 while (<ADDRESSES>) {
  527. !                     next if /^\s*#/;    # Skip shell comments
  528. !                     chop;
  529. !                     s/^\s+//;            # Remove leading spaces
  530. !                     push(@result, $_);
  531. !                 }
  532. !                 close ADDRESSES;
  533. !             } elsif ($filename) {        # Could not open file
  534. !                 &add_log("WARNING couldn't open $filename for addresses: $!")
  535. !                     if $loglvl > 4;
  536. !             } else {
  537. !                 &add_log("WARNING incorrect file inclusion request")
  538. !                     if $loglvl > 4;
  539. !             }
  540.           }
  541.       }
  542. !     join(' ', @result);        # Return space separated addresses
  543.   }
  544.   
  545.   # Save digest mail into a folder, or queue it if no folder is provided
  546. --- 1175,1197 ----
  547.       0;
  548.   }
  549.   
  550. ! # Given a list of items separated by white spaces, return a new list of
  551. ! # items, but with "include-request" processed.
  552. ! sub complete_list {
  553.       local(@addr) = split(' ', $_[0]);    # Original list
  554. +     local($type) = $_[1];                # Type of item (header, address, ...)
  555.       local(@result);                        # Where result list is built
  556.       local($filename);                    # Name of include file
  557.       local($_);
  558.       foreach $addr (@addr) {
  559. !         if ($addr !~ /^"/) {            # Item not enclosed within ""
  560.               push(@result, $addr);        # Kept as-is
  561.           } else {
  562. !             # Load items from file whose name is given between "quotes"
  563. !             push(@result, &include_file($addr, $type));
  564.           }
  565.       }
  566. !     join(' ', @result);        # Return space separated items
  567.   }
  568.   
  569.   # Save digest mail into a folder, or queue it if no folder is provided
  570.  
  571. Index: agent/pl/lexical.pl
  572. Prereq: 2.9.1.2
  573. *** agent/pl/lexical.pl.old    Tue Dec  1 09:48:13 1992
  574. --- agent/pl/lexical.pl    Tue Dec  1 09:48:13 1992
  575. ***************
  576. *** 1,4 ****
  577. ! ;# $Id: lexical.pl,v 2.9.1.2 92/11/01 15:50:52 ram Exp $
  578.   ;#
  579.   ;#  Copyright (c) 1992, Raphael Manfredi
  580.   ;#
  581. --- 1,4 ----
  582. ! ;# $Id: lexical.pl,v 2.9.1.3 92/12/01 09:22:16 ram Exp $
  583.   ;#
  584.   ;#  Copyright (c) 1992, Raphael Manfredi
  585.   ;#
  586. ***************
  587. *** 6,11 ****
  588. --- 6,15 ----
  589.   ;#  Licence as specified in the README file that comes with dist.
  590.   ;#
  591.   ;# $Log:    lexical.pl,v $
  592. + ;# Revision 2.9.1.3  92/12/01  09:22:16  ram
  593. + ;# patch13: now counts lines even when reading rules from memory
  594. + ;# patch13: action parsing rewritten to handle nested braces
  595. + ;# 
  596.   ;# Revision 2.9.1.2  92/11/01  15:50:52  ram
  597.   ;# patch11: fixed English typo
  598.   ;# 
  599. ***************
  600. *** 29,34 ****
  601. --- 33,39 ----
  602.   # The following subroutine is called in place of read_rule when rules are
  603.   # coming from the command line via @Linerules.
  604.   sub read_linerule {
  605. +     $.++;                        # One more line
  606.       shift(@Linerules);            # Read a new line from array
  607.   }
  608.   
  609. ***************
  610. *** 116,135 ****
  611.       $pattern;
  612.   }
  613.   
  614.   sub get_action {
  615.       local(*line) = shift(@_);    # edited in place
  616.       local($_) = $line;            # make a copy of original
  617. !     local($action) = "";
  618. !     if (s/^\s*{([^}]*)}//) {
  619. !         $action = $1;
  620. !     } else {
  621. !         unless (/\{.*\}/) {        # trash line if no { action } is present
  622. !             &add_log("ERROR expected action, discarded '$_'") if $loglvl;
  623. !             $_ = '';
  624.           }
  625.       }
  626. -     $line = $_;                    # eventually updates the line
  627. -     $action =~ s/\s+$//;        # remove trailing spaces
  628. -     $action;
  629.   }
  630.   
  631. --- 121,182 ----
  632.       $pattern;
  633.   }
  634.   
  635. + # Extract the action part from the line (by editing it in place) and return
  636. + # the first action encountered. Nesting of {...} blocks may occur.
  637.   sub get_action {
  638.       local(*line) = shift(@_);    # edited in place
  639.       local($_) = $line;            # make a copy of original
  640. !     return '' unless s/^\s*\{/{/;
  641. !     local($action) = &action_parse(*_, 0);
  642. !     &add_log("ERROR no action, discarding '$_'") if $loglvl && $action eq '';
  643. !     $line = $_;                    # eventually update the line
  644. !     $action =~ s/^\{\s*//;        # remove leading and trailing braces
  645. !     $action =~ s/\s*\}$//;
  646. !     $action;                    # return new action block
  647. ! }
  648. ! 
  649. ! # Recursively parse the action string and return the parsed portion of the text
  650. ! # with proper nesting wherever necessary. The string given as parameter is
  651. ! # edited in place and the remaining is the unparsed part.
  652. ! sub action_parse {
  653. !     local(*_) = shift(@_);        # edited in place
  654. !     local($level) = shift(@_);    # recursion level
  655. !     local($parsed) = '';        # the part we parsed so far
  656. !     local($block);                # block recognized
  657. !     local($follow);                # recursion string returned
  658. !     for (;;) {
  659. !         # Go to first un-escaped '{', if possible and save leading string
  660. !         # up-to first '{'. Note that any '}' immediately stops scanning.
  661. !         s/^(([^\\{}]|\\.)*{)// && ($parsed .= $1);
  662. !         # Go to first un-escaped '}', with any '{' stopping scan.
  663. !         $block = '';
  664. !         s/^(([^\\{}]|\\.)*\})// && ($block = $1);
  665. !         $parsed .= $block;        # block may be empty, or has trailing '}'
  666. !         if ($parsed =~ s/\{$//) {    # recursion if '{' found
  667. !             $follow = &action_parse(*_, $level + 1);
  668. !             # If a null string is returned, then no matching '}' was found
  669. !             &add_log("WARNING no closing brace (added for you)")
  670. !                 if $follow eq '' && $loglvl > 5;
  671. !             $parsed .= '{' . $follow . '}';
  672. !         } elsif (s/^\}//) {            # reached end of a block
  673. !             &add_log("WARNING extra closing brace ignored")
  674. !                 if $level == 0 && $loglvl > 5;
  675. !             return $parsed;
  676. !         } else {
  677. !             # Get the whole string until the next '}' and return. If a '{'
  678. !             # interposes, the first match will return an empty string. In that
  679. !             # case, we continue if we are not at level #0. Otherwise we got the
  680. !             # whole action and may return now.
  681. !             $block = '';
  682. !             s/^(([^\\{}]|\\.)*\})// && ($block = $1);
  683. !             if ($block eq '' && $level) {        # Advance until '{'
  684. !                 s/^(([^\\}]|\\.)*\{)// && ($block = $1);
  685. !                 $parsed .= $block;
  686. !                 next;
  687. !             }
  688. !             $block =~ s/\}//;
  689. !             return $parsed . $block;
  690.           }
  691.       }
  692.   }
  693.   
  694.  
  695. Index: agent/pl/macros.pl
  696. Prereq: 2.9.1.2
  697. *** agent/pl/macros.pl.old    Tue Dec  1 09:48:16 1992
  698. --- agent/pl/macros.pl    Tue Dec  1 09:48:16 1992
  699. ***************
  700. *** 1,4 ****
  701. ! ;# $Id: macros.pl,v 2.9.1.2 92/08/26 13:16:14 ram Exp $
  702.   ;#
  703.   ;#  Copyright (c) 1992, Raphael Manfredi
  704.   ;#
  705. --- 1,4 ----
  706. ! ;# $Id: macros.pl,v 2.9.1.3 92/12/01 09:24:09 ram Exp $
  707.   ;#
  708.   ;#  Copyright (c) 1992, Raphael Manfredi
  709.   ;#
  710. ***************
  711. *** 6,11 ****
  712. --- 6,16 ----
  713.   ;#  Licence as specified in the README file that comes with dist.
  714.   ;#
  715.   ;# $Log:    macros.pl,v $
  716. + ;# Revision 2.9.1.3  92/12/01  09:24:09  ram
  717. + ;# patch13: new macros %A, %C, %I and %O
  718. + ;# patch13: forgot to handle the %H macro
  719. + ;# patch13: (reported by David Giddy <d.giddy@trl.oz.au>)
  720. + ;# 
  721.   ;# Revision 2.9.1.2  92/08/26  13:16:14  ram
  722.   ;# patch8: added support for external variables (persistent)
  723.   ;# 
  724. ***************
  725. *** 18,27 ****
  726. --- 23,36 ----
  727.   ;# 
  728.   # Macros:
  729.   # %%     A real percent sign
  730. + # %A     Sender's main address (host.domain.ct in user@loc.host.domain.ct)
  731. + # %C     CPU name, fully qualified with domain name
  732.   # %D     Day of the week (0-6)
  733.   # %H     Host name (name of the machine on which the mailagent runs)
  734. + # %I     Internet domain from sender (domain.ct in user@host.domain.ct)
  735.   # %L     Length of the message in bytes (without header)
  736.   # %N     Full name of sender (login name if none)
  737. + # %O     Organization name from sender address (domain in user@host.domain.ct)
  738.   # %R     Subject of orginal message with leading Re: suppressed
  739.   # %S     Re: subject of original message
  740.   # %T     Time of last modification on mailed file (value taken from $macro_T)
  741. ***************
  742. *** 83,93 ****
  743. --- 92,106 ----
  744.   
  745.       s/%%/##pr##/g;                        # Protect double percent signs
  746.       s/%/#%%!/g;                            # Make sure substitutions do not add %
  747. +     s/#%%!A/¯o'internet/eg;            # Main internet address of sender
  748.       s/#%%!d/$mday/g;                    # Day of the month (01-31)
  749. +     s/#%%!C/&domain_addr/eg;            # CPU name, fully qualified with domain
  750.       s/#%%!D/$wday/g;                    # Day of the week (0-6)
  751.       s/#%%!f/$Header{'From'}/g;            # The "From:" line
  752.       s/#%%!h/$hour/g;                    # Hour of the day (00-23)
  753. +     s/#%%!H/&myhostname/eg;                # Hostname on which mailagent runs
  754.       s/#%%!i/$Header{'Message-Id'}/g;    # Message-Id (null string if none)
  755. +     s/#%%!I/¯o'domain/eg;            # Internet domain name of sender
  756.       s/#%%!l/$Header{'Lines'}/g;            # Number if lines in message
  757.       s/#%%!L/$Header{'Length'}/g;        # Length of message, in bytes
  758.       s/#%%!m/$mon/g;                        # Month of the year
  759. ***************
  760. *** 94,99 ****
  761. --- 107,113 ----
  762.       s/#%%!n/$login/g;                    # Lower-cased login name of sender
  763.       s/#%%!N/$fullname/g;                # Full name of sender (login if none)
  764.       s/#%%!o/$orgname/g;                    # Organization name
  765. +     s/#%%!O/¯o'org/eg;                # Organization part of sender's address
  766.       s/#%%!r/$reply_to/g;                # Return path of message
  767.       s/#%%!R/$subject/g;                    # Subject with leading Re: suppressed
  768.       s/#%%!s/$Header{'Subject'}/g;        # Subject of message
  769. ***************
  770. *** 114,117 ****
  771. --- 128,159 ----
  772.       s/##pr##/%/g;                        # A double percent expands to %
  773.       $str = $_;                            # Update string in-place
  774.   }
  775. + 
  776. + package macro;
  777. + 
  778. + # Return the internet information of the From address
  779. + sub info {
  780. +     local($addr) = (&'parse_address($'Header{'From'}))[0];
  781. +     &'internet_info($addr);
  782. + }
  783. + 
  784. + # Return the organization name
  785. + sub org {
  786. +     local($host, $domain, $country) = &info;
  787. +     $domain;
  788. + }
  789. + 
  790. + # Return the domain name
  791. + sub domain {
  792. +     local($host, $domain, $country) = &info;
  793. +     $domain .'.'. $country;
  794. + }
  795. + 
  796. + # Return the qualified internet address
  797. + sub internet {
  798. +     local($host, $domain, $country) = &info;
  799. +     $host ne '' ? $host .'.'. $domain .'.'. $country : $domain .'.'. $country;
  800. + }
  801. + 
  802. + package main;
  803.   
  804.  
  805. Index: agent/pl/matching.pl
  806. Prereq: 2.9.1.1
  807. *** agent/pl/matching.pl.old    Tue Dec  1 09:48:18 1992
  808. --- agent/pl/matching.pl    Tue Dec  1 09:48:19 1992
  809. ***************
  810. *** 1,4 ****
  811. ! ;# $Id: matching.pl,v 2.9.1.1 92/08/02 16:11:54 ram Exp $
  812.   ;#
  813.   ;#  Copyright (c) 1992, Raphael Manfredi
  814.   ;#
  815. --- 1,4 ----
  816. ! ;# $Id: matching.pl,v 2.9.1.2 92/12/01 09:25:48 ram Exp $
  817.   ;#
  818.   ;#  Copyright (c) 1992, Raphael Manfredi
  819.   ;#
  820. ***************
  821. *** 6,11 ****
  822. --- 6,15 ----
  823.   ;#  Licence as specified in the README file that comes with dist.
  824.   ;#
  825.   ;# $Log:    matching.pl,v $
  826. + ;# Revision 2.9.1.2  92/12/01  09:25:48  ram
  827. + ;# patch13: new perl_pattern function to transform shell-style patterns
  828. + ;# patch13: file inclusion now handled by include_file
  829. + ;# 
  830.   ;# Revision 2.9.1.1  92/08/02  16:11:54  ram
  831.   ;# patch2: added support for negated selectors
  832.   ;# 
  833. ***************
  834. *** 39,44 ****
  835. --- 43,57 ----
  836.       );
  837.   }
  838.   
  839. + # Transform a shell-style pattern into a perl pattern
  840. + sub perl_pattern {
  841. +     local($_) = @_;        # The shell pattern
  842. +     s/\./\\./g;            # Escape .
  843. +     s/\*/.*/g;            # Transform * into .*
  844. +     s/\?/./g;            # Transform ? into .
  845. +     $_;                    # Perl pattern
  846. + }
  847. + 
  848.   # Take a pattern as written in the rule file and make it suitable for
  849.   # pattern matching as understood by perl. If the pattern starts with a
  850.   # leading /, nothing is done. Otherwise, a set of / are added.
  851. ***************
  852. *** 46,56 ****
  853.   sub make_pattern {
  854.       local($_) = shift(@_);
  855.       unless (m|^/|) {                # Pattern does not start with a /
  856. !         # With simple words, patterns have the same form as shell ones
  857. !         s/\./\\./g;            # Escape .
  858. !         s/\*/.*/g;            # Transform * into .*
  859. !         s/\?/./g;            # Transform ? into .
  860. !         $_ = "/^$_\$/";        # Anchor pattern
  861.       }
  862.       # The whole pattern is inserted within () to make at least one
  863.       # backreference. Otherwise, the following could happen:
  864. --- 59,66 ----
  865.   sub make_pattern {
  866.       local($_) = shift(@_);
  867.       unless (m|^/|) {                # Pattern does not start with a /
  868. !         $_ = &perl_pattern($_);        # Simple words specified via shell patterns
  869. !         $_ = "/^$_\$/";                # Anchor pattern
  870.       }
  871.       # The whole pattern is inserted within () to make at least one
  872.       # backreference. Otherwise, the following could happen:
  873. ***************
  874. *** 76,106 ****
  875.       if ($pattern !~ /^"/) {
  876.           $matched = do apply_match($selector, $pattern);
  877.       } else {
  878. !         local(@filepat) = ();            # File pattern
  879. !         local($filename);                # Where pattern should be read from
  880. !         ($filename) =
  881. !             $pattern =~ /^"(.*)"$/;        # The filename is held within ""
  882. !         $filename =
  883. !             &locate_file($filename);    # Path may not be absolute
  884. !         if ($filename) {
  885. !             if (open(PATTERN, "$filename")) {
  886. !                 while (<PATTERN>) {
  887. !                     next if /^\s*#/;    # Skip shell comments
  888. !                     chop;
  889. !                     s/^\s*//;            # Remove leading spaces
  890. !                     push(@filepat, $_);
  891. !                     do add_log ("loading pattern $_") if $loglvl > 19;
  892. !                 }
  893. !                 close PATTERN;
  894. !             } else {
  895. !                 do add_log("WARNING couldn't open $filename for patterns")
  896. !                     if $loglvl > 4;
  897. !                 push(@filepat, "*");    # Ensure anything matches
  898. !             }
  899. !         } else {
  900. !             do add_log("WARNING incorrect file name $pattern") if $loglvl > 4;
  901. !             push(@filepat, "*");    # Ensure anything matches
  902. !         }
  903.           # Now do the match for all the patterns. Stop as soon as one matches.
  904.           foreach (@filepat) {
  905.               $matched = do apply_match($selector, $_);
  906. --- 86,93 ----
  907.       if ($pattern !~ /^"/) {
  908.           $matched = do apply_match($selector, $pattern);
  909.       } else {
  910. !         # Load patterns from file whose name is given between "quotes"
  911. !         local(@filepat) = &include_file($pattern, 'pattern');
  912.           # Now do the match for all the patterns. Stop as soon as one matches.
  913.           foreach (@filepat) {
  914.               $matched = do apply_match($selector, $_);
  915.  
  916. Index: agent/filter/io.c
  917. Prereq: 2.9
  918. *** agent/filter/io.c.old    Tue Dec  1 09:47:40 1992
  919. --- agent/filter/io.c    Tue Dec  1 09:47:41 1992
  920. ***************
  921. *** 11,17 ****
  922.   */
  923.   
  924.   /*
  925. !  * $Id: io.c,v 2.9 92/07/14 16:48:13 ram Exp $
  926.    *
  927.    *  Copyright (c) 1992, Raphael Manfredi
  928.    *
  929. --- 11,17 ----
  930.   */
  931.   
  932.   /*
  933. !  * $Id: io.c,v 2.9.1.1 92/12/01 09:11:51 ram Exp $
  934.    *
  935.    *  Copyright (c) 1992, Raphael Manfredi
  936.    *
  937. ***************
  938. *** 19,24 ****
  939. --- 19,27 ----
  940.    *  Licence as specified in the README file that comes with dist.
  941.    *
  942.    * $Log:    io.c,v $
  943. +  * Revision 2.9.1.1  92/12/01  09:11:51  ram
  944. +  * patch13: added extra checking for writes to soft NFS-mounted disks
  945. +  * 
  946.    * Revision 2.9  92/07/14  16:48:13  ram
  947.    * 3.0 beta baseline.
  948.    * 
  949. ***************
  950. *** 497,502 ****
  951. --- 500,506 ----
  952.       register1 char *mailptr;        /* Pointer into mail buffer */
  953.       register2 int length;            /* Number of bytes already written */
  954.       register3 int amount;            /* Amount of bytes written by last call */
  955. +     struct stat buf;                /* Stat buffer */
  956.   
  957.       sprintf(path, "%s/%s.%d", dir, template, progpid);
  958.   
  959. ***************
  960. *** 506,512 ****
  961.           return (char *) 0;
  962.       }
  963.   
  964. !     /* Write the mail on disc. We do not call a single write on the mail buffer
  965.        * as in "write(fd, mail, len)" in case the mail length exceeds the maximum
  966.        * amount of bytes the system can atomically write.
  967.        */
  968. --- 510,516 ----
  969.           return (char *) 0;
  970.       }
  971.   
  972. !     /* Write the mail on disk. We do not call a single write on the mail buffer
  973.        * as in "write(fd, mail, len)" in case the mail length exceeds the maximum
  974.        * amount of bytes the system can atomically write.
  975.        */
  976. ***************
  977. *** 524,535 ****
  978.               if (n == -1)
  979.                   add_log(1, "SYSERR write: %m (%e)");
  980.               add_log(2, "ERROR cannot write to file %s", path);
  981. -             if (-1 == unlink(path)) {
  982. -                 add_log(1, "SYSERR unlink: %m (%e)");
  983. -                 add_log(4, "WARNING leaving %s around", path);
  984. -             }
  985.               close(fd);
  986. !             return (char *) 0;
  987.           }
  988.       }
  989.   
  990. --- 528,535 ----
  991.               if (n == -1)
  992.                   add_log(1, "SYSERR write: %m (%e)");
  993.               add_log(2, "ERROR cannot write to file %s", path);
  994.               close(fd);
  995. !             goto error;                /* Remove file and report error */
  996.           }
  997.       }
  998.   
  999. ***************
  1000. *** 536,542 ****
  1001. --- 536,568 ----
  1002.       close(fd);
  1003.       add_log(19, "mail in %s", path);
  1004.   
  1005. +     /* I don't really trust writes through NFS soft-mounted partitions, and I
  1006. +      * am also suspicious about hard-mounted ones. I could have opened the file
  1007. +      * with the O_SYNC flag, but the effect on NFS is not well defined either.
  1008. +      * So, let's just make sure the mail has been correctly written on the disk
  1009. +      * by comparing the file size and the orginal message size. If they differ,
  1010. +      * complain and return an error.
  1011. +      */
  1012. + 
  1013. +     if (-1 == stat(path, &buf))        /* No entry in file system, probably */
  1014. +         return (char *) 0;            /* Saving failed */
  1015. + 
  1016. +     if (buf.st_size != len) {        /* Not written entirely */
  1017. +         add_log(2, "ERROR mail truncated to %d bytes (had %d)",
  1018. +             buf.st_size, len);
  1019. +         goto error;                    /* Remove file and report error */
  1020. +     }
  1021. + 
  1022.       return path;            /* Where mail was writen (static data) */
  1023. + 
  1024. + error:        /* Come here when a write error has been detected */
  1025. + 
  1026. +     if (-1 == unlink(path)) {
  1027. +         add_log(1, "SYSERR unlink: %m (%e)");
  1028. +         add_log(4, "WARNING leaving %s around", path);
  1029. +     }
  1030. + 
  1031. +     return (char *) 0;
  1032.   }
  1033.   
  1034.   #ifndef RENAME
  1035.  
  1036. Index: agent/pl/rules.pl
  1037. Prereq: 2.9.1.2
  1038. *** agent/pl/rules.pl.old    Tue Dec  1 09:48:28 1992
  1039. --- agent/pl/rules.pl    Tue Dec  1 09:48:29 1992
  1040. ***************
  1041. *** 1,4 ****
  1042. ! ;# $Id: rules.pl,v 2.9.1.2 92/11/01 15:52:24 ram Exp $
  1043.   ;#
  1044.   ;#  Copyright (c) 1992, Raphael Manfredi
  1045.   ;#
  1046. --- 1,4 ----
  1047. ! ;# $Id: rules.pl,v 2.9.1.3 92/12/01 09:30:01 ram Exp $
  1048.   ;#
  1049.   ;#  Copyright (c) 1992, Raphael Manfredi
  1050.   ;#
  1051. ***************
  1052. *** 6,11 ****
  1053. --- 6,15 ----
  1054.   ;#  Licence as specified in the README file that comes with dist.
  1055.   ;#
  1056.   ;# $Log:    rules.pl,v $
  1057. + ;# Revision 2.9.1.3  92/12/01  09:30:01  ram
  1058. + ;# patch13: fixed mode selection pattern (no brace allowed)
  1059. + ;# patch13: now takes care of escaped ';' for layout purposes
  1060. + ;# 
  1061.   ;# Revision 2.9.1.2  92/11/01  15:52:24  ram
  1062.   ;# patch11: fixed English typo
  1063.   ;# patch11: makes sure default rules apply if no valid rules are present
  1064. ***************
  1065. *** 180,186 ****
  1066.           next unless &before($rulenum);                # Call 'before' hook
  1067.           $selnum = 0;
  1068.           $rules = $_;        # Work on a copy
  1069. !         $rules =~ s/^(.*){// && ($mode = $1);        # First "word" is the mode
  1070.           $rules =~ s/\s*(.*)}// && ($action = $1);    # Then action within {}
  1071.           $mode =~ s/\s*$//;                            # Remove trailing spaces
  1072.           print "<$mode> ";                            # Mode in which it applies
  1073. --- 184,190 ----
  1074.           next unless &before($rulenum);                # Call 'before' hook
  1075.           $selnum = 0;
  1076.           $rules = $_;        # Work on a copy
  1077. !         $rules =~ s/^([^{]*){// && ($mode = $1);    # First "word" is the mode
  1078.           $rules =~ s/\s*(.*)}// && ($action = $1);    # Then action within {}
  1079.           $mode =~ s/\s*$//;                            # Remove trailing spaces
  1080.           print "<$mode> ";                            # Mode in which it applies
  1081. ***************
  1082. *** 213,219 ****
  1083. --- 217,232 ----
  1084.               }
  1085.           }
  1086.           print "  " if $lines == 1;
  1087. + 
  1088. +         # Split actions, but take care of escaped \; (layout purposes)
  1089. +         $action =~ s/\\\\/\02/g;            # \\ -> ^B
  1090. +         $action =~ s/\\;/\01/g;                # \; -> ^A
  1091.           @action = split(/;/, $action);
  1092. +         foreach (@action) {                    # Restore escapes by in-place edit
  1093. +             s/\01/\\;/g;                    # ^A -> \;
  1094. +             s/\02/\\\\/g;                    # ^B -> \\
  1095. +         }
  1096. + 
  1097.           # If action is large enough, format differently (one action/line)
  1098.           if (length($action) > 60 && @action > 1) {
  1099.               print "\n\t{\n";
  1100.  
  1101. Index: agent/pl/rfc822.pl
  1102. Prereq: 2.9.1.1
  1103. *** agent/pl/rfc822.pl.old    Tue Dec  1 09:48:26 1992
  1104. --- agent/pl/rfc822.pl    Tue Dec  1 09:48:26 1992
  1105. ***************
  1106. *** 1,4 ****
  1107. ! ;# $Id: rfc822.pl,v 2.9.1.1 92/11/01 15:51:46 ram Exp $
  1108.   ;#
  1109.   ;#  Copyright (c) 1992, Raphael Manfredi
  1110.   ;#
  1111. --- 1,4 ----
  1112. ! ;# $Id: rfc822.pl,v 2.9.1.2 92/12/01 09:27:19 ram Exp $
  1113.   ;#
  1114.   ;#  Copyright (c) 1992, Raphael Manfredi
  1115.   ;#
  1116. ***************
  1117. *** 6,11 ****
  1118. --- 6,14 ----
  1119.   ;#  Licence as specified in the README file that comes with dist.
  1120.   ;#
  1121.   ;# $Log:    rfc822.pl,v $
  1122. + ;# Revision 2.9.1.2  92/12/01  09:27:19  ram
  1123. + ;# patch13: added internet info extraction out of e-mail address
  1124. + ;# 
  1125.   ;# Revision 2.9.1.1  92/11/01  15:51:46  ram
  1126.   ;# patch11: allows _ as separator in names (as in First_Last)
  1127.   ;# 
  1128. ***************
  1129. *** 63,67 ****
  1130. --- 66,93 ----
  1131.       s/.*_(\w+)/$1/;                    # Same as above (_ separation)
  1132.       tr/A-Z/a-z/;                    # And lowercase it
  1133.       $_;
  1134. + }
  1135. + 
  1136. + # Parse an e-mail address and return a three element array:
  1137. + #   ($host, $domain, $country)
  1138. + sub internet_info {
  1139. +     local($_) = shift(@_);                # The internet address
  1140. +     local($login) = &login_name($_);    # Get the address login name
  1141. +     local($internet);                    # The internet part of the address
  1142. +     # Try with uucp form first, to detect things like eiffel!ram@inria.fr
  1143. +     # We use the login name to anchor the last '!' or the first '@' or '%'
  1144. +     ($internet) = /([^!]*)!$login/i;
  1145. +     ($internet) = /$login[@%]([\w.-]*)/i unless $internet;
  1146. +     $internet =~ tr/A-Z/a-z/;                # Always lower-cased
  1147. +     local(@parts) = split(/\./, $internet);    # Break on dots
  1148. +     if (@parts == 1) {                        # Only a host name
  1149. +         # Maybe this is a local address, maybe this is a uucp name. Assume that
  1150. +         # it is local if there is an '@' sign, as in 'ram@lyon'. Otherwise, it
  1151. +         # is a uucp name, as in 'eiffel!ram'.
  1152. +         push(@parts, 'uucp') if /!$login/;    # UUCP name
  1153. +         push(@parts, split(/\./, $mydomain)) if @parts == 1;
  1154. +     }
  1155. +     unshift(@parts, '') if @parts == 2;        # No host name
  1156. +     @parts[($#parts - 2) .. $#parts];        # ($host, $domain, $country)
  1157.   }
  1158.   
  1159.  
  1160. Index: agent/magent.SH
  1161. Prereq: 2.9.1.2
  1162. *** agent/magent.SH.old    Tue Dec  1 09:47:48 1992
  1163. --- agent/magent.SH    Tue Dec  1 09:47:49 1992
  1164. ***************
  1165. *** 22,28 ****
  1166.   # via the filter. Mine looks like this:
  1167.   #   "|exec /users/ram/mail/filter >>/users/ram/.bak 2>&1"
  1168.   
  1169. ! # $Id: magent.SH,v 2.9.1.2 92/08/26 12:41:27 ram Exp $
  1170.   #
  1171.   #  Copyright (c) 1991, 1992, Raphael Manfredi
  1172.   #
  1173. --- 22,28 ----
  1174.   # via the filter. Mine looks like this:
  1175.   #   "|exec /users/ram/mail/filter >>/users/ram/.bak 2>&1"
  1176.   
  1177. ! # $Id: magent.SH,v 2.9.1.3 92/12/01 09:14:07 ram Exp $
  1178.   #
  1179.   #  Copyright (c) 1991, 1992, Raphael Manfredi
  1180.   #
  1181. ***************
  1182. *** 30,35 ****
  1183. --- 30,39 ----
  1184.   #  Licence as specified in the README file that comes with dist.
  1185.   #
  1186.   # $Log:    magent.SH,v $
  1187. + # Revision 2.9.1.3  92/12/01  09:14:07  ram
  1188. + # patch13: hostname is now computed once and cached
  1189. + # patch13: three new .pl files are now appended
  1190. + # 
  1191.   # Revision 2.9.1.2  92/08/26  12:41:27  ram
  1192.   # patch8: better no-lock handling
  1193.   # patch8: now maintains the notion of private library directory
  1194. ***************
  1195. *** 459,465 ****
  1196.       local($_);                            # Our host name
  1197.       $_ = $hiddennet if $hiddennet ne '';
  1198.       if ($_ eq '') {
  1199. !         chop($_ = `$phostname`);        # Must fork to get hostname, grr...
  1200.           $_ .= $mydomain unless /\./;    # We want something fully qualified
  1201.       }
  1202.       $_;
  1203. --- 463,469 ----
  1204.       local($_);                            # Our host name
  1205.       $_ = $hiddennet if $hiddennet ne '';
  1206.       if ($_ eq '') {
  1207. !         $_ = &hostname;                    # Must fork to get hostname, grr...
  1208.           $_ .= $mydomain unless /\./;    # We want something fully qualified
  1209.       }
  1210.       $_;
  1211. ***************
  1212. *** 568,572 ****
  1213. --- 572,579 ----
  1214.   $grep -v '^;#' pl/mailhook.pl >>magent
  1215.   $grep -v '^;#' pl/interface.pl >>magent
  1216.   $grep -v '^;#' pl/getdate.pl >>magent
  1217. + $grep -v '^;#' pl/include.pl >>magent
  1218. + $grep -v '^;#' pl/plural.pl >>magent
  1219. + $grep -v '^;#' pl/hostname.pl >>magent
  1220.   chmod 755 magent
  1221.   $eunicefix magent
  1222.  
  1223. Index: agent/pl/parse.pl
  1224. Prereq: 2.9.1.1
  1225. *** agent/pl/parse.pl.old    Tue Dec  1 09:48:21 1992
  1226. --- agent/pl/parse.pl    Tue Dec  1 09:48:21 1992
  1227. ***************
  1228. *** 1,4 ****
  1229. ! ;# $Id: parse.pl,v 2.9.1.1 92/08/26 13:17:47 ram Exp $
  1230.   ;#
  1231.   ;#  Copyright (c) 1992, Raphael Manfredi
  1232.   ;#
  1233. --- 1,4 ----
  1234. ! ;# $Id: parse.pl,v 2.9.1.2 92/12/01 09:26:19 ram Exp $
  1235.   ;#
  1236.   ;#  Copyright (c) 1992, Raphael Manfredi
  1237.   ;#
  1238. ***************
  1239. *** 6,11 ****
  1240. --- 6,14 ----
  1241.   ;#  Licence as specified in the README file that comes with dist.
  1242.   ;#
  1243.   ;# $Log:    parse.pl,v $
  1244. + ;# Revision 2.9.1.2  92/12/01  09:26:19  ram
  1245. + ;# patch13: now also understands multiple To and Cc lines in headers
  1246. + ;# 
  1247.   ;# Revision 2.9.1.1  92/08/26  13:17:47  ram
  1248.   ;# patch8: created by extraction from analyze.pl
  1249.   ;# patch8: parsing can now be done on header only
  1250. ***************
  1251. *** 122,132 ****
  1252.       }
  1253.   
  1254.       # There is usually one Apparently-To line per address. Remove all new lines
  1255. !     # in the header line and replace them with ','.
  1256. !     $* = 1;
  1257. !     $Header{'Apparently-To'} =~ s/\n/,/g;    # Remove new-lines
  1258.       $* = 0;
  1259. -     $Header{'Apparently-To'} =~ s/,$/\n/;    # Restore last new-line
  1260.   
  1261.       # If no To: field, then maybe there is an Apparently-To: instead. If so,
  1262.       # make them identical. Otherwise, assume the mail was directed to the user.
  1263. --- 125,138 ----
  1264.       }
  1265.   
  1266.       # There is usually one Apparently-To line per address. Remove all new lines
  1267. !     # in the header line and replace them with ','. Likewise for To: and Cc:.
  1268. !     # although it is far less likely to occur.
  1269. !     local($*) = 1;
  1270. !     foreach $field ('Apparently-To', 'To', 'Cc') {
  1271. !         $Header{$field} =~ s/\n/,/g;    # Remove new-lines
  1272. !         $Header{$field} =~ s/,$/\n/;    # Restore last new-line
  1273. !     }
  1274.       $* = 0;
  1275.   
  1276.       # If no To: field, then maybe there is an Apparently-To: instead. If so,
  1277.       # make them identical. Otherwise, assume the mail was directed to the user.
  1278.  
  1279. Index: agent/pl/include.pl
  1280. *** agent/pl/include.pl.old    Tue Dec  1 09:48:11 1992
  1281. --- agent/pl/include.pl    Tue Dec  1 09:48:11 1992
  1282. ***************
  1283. *** 0 ****
  1284. --- 1,45 ----
  1285. + ;# $Id: include.pl,v 2.9.1.1 92/12/01 09:21:10 ram Exp $
  1286. + ;#
  1287. + ;#  Copyright (c) 1992, Raphael Manfredi
  1288. + ;#
  1289. + ;#  You may redistribute only under the terms of the GNU General Public
  1290. + ;#  Licence as specified in the README file that comes with dist.
  1291. + ;#
  1292. + ;# $Log:    include.pl,v $
  1293. + ;# Revision 2.9.1.1  92/12/01  09:21:10  ram
  1294. + ;# patch13: created
  1295. + ;# 
  1296. + ;# 
  1297. + # Process "include-file" requests. The file is allowed to have shell comments
  1298. + # and leading spaces are trimmed. The function returns an array, each item
  1299. + # being one of the non-comment lines found in the file.
  1300. + sub include_file {
  1301. +     local($inc) = shift(@_);    # Include request "file-name"
  1302. +     local($what) = shift(@_);    # What we are looking for (singular)
  1303. +     local(*INCLUDE);            # Local file handle
  1304. +     local($filename) = $inc =~ /^"(.*)"$/;
  1305. +     local(@result);
  1306. +     local($_);
  1307. +     # Find file using mailfilter, maildir variables if not specified with an
  1308. +     # absolute pathname (starting iwht a '/').
  1309. +     $filename = &locate_file($filename);
  1310. +     &add_log("loading ".&plural($what)." from $filename") if $loglvl > 18;
  1311. +     if ($filename ne '' && open(INCLUDE, "$filename")) {
  1312. +         while (<INCLUDE>) {
  1313. +             next if /^\s*#/;    # Skip shell comments
  1314. +             chop;
  1315. +             s/^\s+//;            # Remove leading spaces
  1316. +             push(@result, $_);
  1317. +             &add_log("loaded $what '$_'") if $loglvl > 19;
  1318. +         }
  1319. +         close INCLUDE;
  1320. +     } elsif ($filename ne '') {        # Could not open file
  1321. +         &add_log("WARNING couldn't open $filename for ".&plural($what).": $!")
  1322. +             if $loglvl > 4;
  1323. +     } else {
  1324. +         &add_log("WARNING incorrect file inclusion request: $inc")
  1325. +             if $loglvl > 4;
  1326. +     }
  1327. +     @result;        # List of non-comment lines held in file
  1328. + }
  1329. + 
  1330.  
  1331. Index: agent/files/chkagent.sh
  1332. Prereq: 2.9
  1333. *** agent/files/chkagent.sh.old    Tue Dec  1 09:47:38 1992
  1334. --- agent/files/chkagent.sh    Tue Dec  1 09:47:38 1992
  1335. ***************
  1336. *** 5,13 ****
  1337.   #  You may redistribute only under the terms of the GNU General Public
  1338.   #  Licence as specified in the README file that comes with dist.
  1339.   #
  1340. ! # $Id: chkagent.sh,v 2.9 92/07/14 16:47:41 ram Exp $
  1341.   #
  1342.   # $Log:    chkagent.sh,v $
  1343.   # Revision 2.9  92/07/14  16:47:41  ram
  1344.   # 3.0 beta baseline.
  1345.   # 
  1346. --- 5,16 ----
  1347.   #  You may redistribute only under the terms of the GNU General Public
  1348.   #  Licence as specified in the README file that comes with dist.
  1349.   #
  1350. ! # $Id: chkagent.sh,v 2.9.1.1 92/12/01 09:10:33 ram Exp $
  1351.   #
  1352.   # $Log:    chkagent.sh,v $
  1353. + # Revision 2.9.1.1  92/12/01  09:10:33  ram
  1354. + # patch13: chkagent could report errors due to spurious matches
  1355. + # 
  1356.   # Revision 2.9  92/07/14  16:47:41  ram
  1357.   # 3.0 beta baseline.
  1358.   # 
  1359. ***************
  1360. *** 42,48 ****
  1361.   
  1362.   if test -f "$logfile"; then
  1363.       grep "$today" $logfile > $todaylog
  1364. !     egrep "$lookat" $todaylog > $output
  1365.       if test -s "$output"; then
  1366.           echo "*** Errors from logfile ($logfile):" > $report
  1367.           echo " " >> $report
  1368. --- 45,51 ----
  1369.   
  1370.   if test -f "$logfile"; then
  1371.       grep "$today" $logfile > $todaylog
  1372. !     egrep ": ($lookat)" $todaylog > $output
  1373.       if test -s "$output"; then
  1374.           echo "*** Errors from logfile ($logfile):" > $report
  1375.           echo " " >> $report
  1376.  
  1377. *** End of Patch 13 ***
  1378.  
  1379. exit 0 # Just in case...
  1380.