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