home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 October / usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso / misc / volume44 / mailagent / patch15 < prev    next >
Internet Message Format  |  1994-09-22  |  45KB

  1. From: Raphael Manfredi <ram@acri.fr>
  2. Newsgroups: comp.sources.misc
  3. Subject: v44i089:  mailagent - Flexible mail filtering and processing package, v3.0, Patch15
  4. Date: 22 Sep 1994 12:13:34 -0500
  5. Organization: Advanced Computer Research Institute, Lyon, France
  6. Sender: kent@sparky.sterling.com
  7. Approved: kent@sparky.sterling.com
  8. Message-ID: <35sdvu$r61@sparky.sterling.com>
  9. X-Md4-Signature: 0339e7f8db2cb18c857919fa40217f01
  10.  
  11. Submitted-by: Raphael Manfredi <ram@acri.fr>
  12. Posting-number: Volume 44, Issue 89
  13. Archive-name: mailagent/patch15
  14. Environment: UNIX, Perl
  15. Patch-To: mailagent: Volume 41, Issue 1-26
  16.  
  17. [The latest patch for mailagent version 3.0 is #16.]
  18.  
  19. System: mailagent version 3.0
  20. Patch #: 15
  21. Priority: MEDIUM
  22. Subject: patch #12, continued
  23. Date: Thu Sep 22 17:04:37 MET DST 1994
  24. From: Raphael Manfredi <ram@acri.fr>
  25.  
  26. Description:
  27.     See patch #12.
  28.  
  29.  
  30. Fix:    From rn, say "| patch -p -N -d DIR", where DIR is your mailagent source
  31.     directory.  Outside of rn, say "cd DIR; patch -p -N <thisarticle".
  32.     If you don't have the patch program, apply the following by hand,
  33.     or get patch (version 2.0, latest patchlevel).
  34.  
  35.     After patching:
  36.         *** DO NOTHING--INSTALL ALL PATCHES UP THROUGH #16 FIRST ***
  37.  
  38.     If patch indicates that patchlevel is the wrong version, you may need
  39.     to apply one or more previous patches, or the patch may already
  40.     have been applied.  See the patchlevel.h file to find out what has or
  41.     has not been applied.  In any event, don't continue with the patch.
  42.  
  43.     If you are missing previous patches they can be obtained from me:
  44.  
  45.         Raphael Manfredi <ram@acri.fr>
  46.  
  47.     If you send a mail message of the following form it will greatly speed
  48.     processing:
  49.  
  50.         Subject: Command
  51.         @SH mailpatch PATH mailagent 3.0 LIST
  52.                ^ note the c
  53.  
  54.     where PATH is a return path FROM ME TO YOU either in Internet notation,
  55.     or in bang notation from some well-known host, and LIST is the number
  56.     of one or more patches you need, separated by spaces, commas, and/or
  57.     hyphens.  Saying 35- says everything from 35 to the end.
  58.  
  59.     To get some more detailed instructions, send me the following mail:
  60.  
  61.         Subject: Command
  62.         @SH mailhelp PATH
  63.  
  64.  
  65. Index: patchlevel.h
  66. Prereq: 14
  67. 4c4
  68. < #define PATCHLEVEL 14
  69. ---
  70. > #define PATCHLEVEL 15
  71.  
  72. Index: MANIFEST
  73. *** MANIFEST.old    Thu Sep 22 16:43:32 1994
  74. --- MANIFEST    Thu Sep 22 16:43:32 1994
  75. ***************
  76. *** 10,15 ****
  77. --- 10,16 ----
  78.   agent/Jmakefile            High level description of Makefile
  79.   agent/Makefile.SH          Makefile which builds and installs mailagent
  80.   agent/README               Welcome to mailagent
  81. + agent/edusers.SH           Edits users file with proper locking procedure
  82.   agent/examples/            A set of files from my own environment
  83.   agent/examples/README      Explains what the examples are
  84.   agent/examples/daemon      Rules for "vacation" emulation
  85. ***************
  86. *** 83,88 ****
  87. --- 84,90 ----
  88.   agent/man/                 Manual pages for mailagent
  89.   agent/man/Jmakefile        Makefile description for jmake
  90.   agent/man/Makefile.SH      Makefile for manual pages extraction
  91. + agent/man/edusers.SH       Produces a manual page for edusers
  92.   agent/man/mailagent.SH     Produces a manual page for mailagent
  93.   agent/man/maildist.SH      Produces a manual page for maildist
  94.   agent/man/mailhelp.SH      Produces a manual page for mailhelp
  95. ***************
  96. *** 94,101 ****
  97. --- 96,105 ----
  98.   agent/pl/acs_rqst.pl       Perl library to ask for private file access
  99.   agent/pl/actions.pl        Implementation of mailagent's actions
  100.   agent/pl/add_log.pl        Perl library to add logs to logfile
  101. + agent/pl/addr.pl           Approximate address matching and validation
  102.   agent/pl/analyze.pl        Perl library analyzing the incoming mail
  103.   agent/pl/builtins.pl       Perl library dealing with builtins
  104. + agent/pl/callout.pl        Perl library to handle callout queue
  105.   agent/pl/checklock.pl      Perl library to check for long lasting locks
  106.   agent/pl/cmdserv.pl        Implements generic mail server
  107.   agent/pl/compress.pl       Folder compression library
  108. ***************
  109. *** 131,136 ****
  110. --- 135,141 ----
  111.   agent/pl/mmdf.pl           MMDF-style mailbox handling
  112.   agent/pl/newcmd.pl         Filter command extension driver
  113.   agent/pl/once.pl           Dealing with once commands
  114. + agent/pl/package.pl        Sources dist's .package file into pkg package
  115.   agent/pl/parse.pl          Perl library to parse a mail message
  116.   agent/pl/period.pl         Perl library to compute periods
  117.   agent/pl/plsave.pl         Perl library to handle the plsave cache file
  118. ***************
  119. *** 146,151 ****
  120. --- 151,157 ----
  121.   agent/pl/runcmd.pl         Filter commands ran from here
  122.   agent/pl/secure.pl         Make sure a file is "secure" and can be trusted
  123.   agent/pl/sendfile.pl       Perl library to send files in shar / kit mode
  124. + agent/pl/signals.pl        Installs emergency signal handlers
  125.   agent/pl/stats.pl          Mailagent's statistics recording and printing
  126.   agent/pl/tilde.pl          Perl library to perform ~name expansion
  127.   agent/pl/umask.pl          Handles UMASK in local mode
  128. ***************
  129. *** 157,168 ****
  130. --- 163,176 ----
  131.   agent/test/README          About the regression tests
  132.   agent/test/TEST            Runs the full test suite
  133.   agent/test/actions         Rule file for cmd tests
  134. + agent/test/atail           Active monitoring of the out/agentlog file
  135.   agent/test/basic/              Basic tests
  136.   agent/test/basic/config.t      Main test initialization and sanity checks
  137.   agent/test/basic/filter.t      Make sure C filter works
  138.   agent/test/basic/mailagent.t   Make sure mailagent basically works
  139.   agent/test/cmd/                Tests of mailagent's filtering commands
  140.   agent/test/cmd/abort.t         Test ABORT command
  141. + agent/test/cmd/after.t         Test AFTER command
  142.   agent/test/cmd/annotate.t      Test ANNOTATE command
  143.   agent/test/cmd/apply.t         Test APPLY command
  144.   agent/test/cmd/assign.t        Test ASSIGN command
  145. ***************
  146. *** 170,175 ****
  147. --- 178,184 ----
  148.   agent/test/cmd/begin.t         Test BEGIN command
  149.   agent/test/cmd/bounce.t        Test BOUNCE command
  150.   agent/test/cmd/delete.t        Test DELETE command
  151. + agent/test/cmd/do.t            Test DO command
  152.   agent/test/cmd/feed.t          Test FEED command
  153.   agent/test/cmd/forward.t       Test FORWARD command
  154.   agent/test/cmd/give.t          Test GIVE command
  155.  
  156. Index: agent/pl/addr.pl
  157. *** agent/pl/addr.pl.old    Thu Sep 22 16:43:04 1994
  158. --- agent/pl/addr.pl    Thu Sep 22 16:43:04 1994
  159. ***************
  160. *** 0 ****
  161. --- 1,96 ----
  162. + ;# $Id: addr.pl,v 3.0.1.1 1994/09/22 14:08:28 ram Exp $
  163. + ;#
  164. + ;#  Copyright (c) 1990-1993, Raphael Manfredi
  165. + ;#  
  166. + ;#  You may redistribute only under the terms of the Artistic License,
  167. + ;#  as specified in the README file that comes with the distribution.
  168. + ;#  You may reuse parts of this distribution only within the terms of
  169. + ;#  that same Artistic License; a copy of which may be found at the root
  170. + ;#  of the source tree for mailagent 3.0.
  171. + ;#
  172. + ;# $Log: addr.pl,v $
  173. + ;# Revision 3.0.1.1  1994/09/22  14:08:28  ram
  174. + ;# patch12: created
  175. + ;#
  176. + ;#
  177. + package addr;
  178. + #
  179. + # Address stuff, for mailing list maintainance (package command)
  180. + #
  181. + # Is address valid?
  182. + # Addresses containing either '|' or '/' in them are considered hostile, since
  183. + # sendmail for instance would attempt to deliver to a program or to a file...
  184. + # Also, the address must not contain any space or control characters.
  185. + sub valid {
  186. +     local($_) = @_;
  187. +     return 0 if $_ eq '';        # Empty address
  188. +     return 0 if tr/\0-\31//;    # Control character found
  189. +     return 0 if /\s/;            # No space in address
  190. +     return 0 if m,/|\|,;        # No / or | please
  191. +     1;                            # Address is ok
  192. + }
  193. + # Simplify address for comparaison purposes
  194. + sub simplify {
  195. +     local($_) = @_;
  196. +     return &simplify($_) if s/^@[\w-.]+://;            # @b.c:x -> x and retry
  197. +     return "$2@$1.uucp" if /^([\w-]+)!(\w+)$/;        # b!u -> u@b.uucp
  198. +     return "$2@$1" if /^([\w-.]+)!(\w+)$/;            # b.c!u -> u@b.c
  199. +     return $_ if /^\w+@[\w-.]+$/;                    # u@b.c
  200. +     return &simplify("$2!$3")
  201. +         if /([^%@]+)!([\w-.]+)!(\w+)$/;                # ...!b!u -> b!u
  202. +     return "$1@$2" if /^(\w+)%([\w-.]+)@[\w-.]+/;    # u%b.c@d.e -> u@b.c
  203. +     return &simplify($1) if s/(.*)@[\w-.]+$//;        # x@b.c -> x and retry
  204. +     return &simplify("$1@$2")
  205. +         if /^([\w-.%!]+)%([\w-.]+)$/;                # x%b -> x@b and retry
  206. +     return $_;        # Hmm... Better stop here, since we are clueless!!
  207. + }
  208. + # Does first address matches second address?
  209. + sub match {
  210. +     local($a1, $a2) = @_;        # Two plain e-mail addresses (no comments)
  211. +     $a1 =~ tr/A-Z/a-z/;            # Cannonicalize to lower case
  212. +     $a2 =~ tr/A-Z/a-z/;
  213. +     local($s1) = &simplify($a1);
  214. +     local($s2) = &simplify($a2);
  215. +     return 1 if $s1 eq $s2;
  216. +     # Face ram@lyon.eiffel.com versus ram@york.eiffel.com or ram@eiffel.com
  217. +     # We do not want a match in the first case, but it's ok for the other one.
  218. +     local($p1, $p2) = ($s1, $s2);
  219. +     $p1 =~ s/(\W)/\\$1/g;
  220. +     $p2 =~ s/(\W)/\\$1/g;
  221. +     $p1 =~ s/@/@[\\w-]+\\./;
  222. +     $p2 =~ s/@/@[\\w-]+\\./;
  223. +     $s1 =~ /^$p2$/ || $s2 =~ /^$p1$/;
  224. + }
  225. + # Are the two addresses close?
  226. + # They are if they match or if their login name is the same or they are
  227. + # within the same subdomain.domain.country or domain.country.
  228. + sub close {
  229. +     local($a1, $a2) = @_;        # Two plain e-mail addresses (no comments)
  230. +     return 1 if &match($a1, $a2);
  231. +     $a1 =~ tr/A-Z/a-z/;            # Cannonicalize to lower case
  232. +     $a2 =~ tr/A-Z/a-z/;
  233. +     $a1 = &simplify($a1);
  234. +     $a2 = &simplify($a2);
  235. +     local($l1, $l2);            # Login names
  236. +     local($d1, $d2);            # Domain names
  237. +     ($l1) = $a1 =~ /^(.*)@/;
  238. +     ($l2) = $a2 =~ /^(.*)@/;
  239. +     return 1 if $l1 ne '' && $l1 eq $l2;
  240. +     ($d1) = $a1 =~ /([\w-]+\.[\w-]+\.[\w]+)$/;
  241. +     ($d2) = $a2 =~ /([\w-]+\.[\w-]+\.[\w]+)$/;
  242. +     return 1 if $d1 ne '' && $d1 eq $d2;
  243. +     ($d1) = $a1 =~ /([\w-]+\.[\w]+)$/;
  244. +     ($d2) = $a2 =~ /([\w-]+\.[\w]+)$/;
  245. +     return 1 if $d1 ne '' && $d1 eq $d2;
  246. +     return 0;
  247. + }
  248. + package main;
  249.  
  250. Index: agent/pl/dynload.pl
  251. Prereq: 3.0
  252. *** agent/pl/dynload.pl.old    Thu Sep 22 16:43:08 1994
  253. --- agent/pl/dynload.pl    Thu Sep 22 16:43:08 1994
  254. ***************
  255. *** 1,4 ****
  256. ! ;# $Id: dynload.pl,v 3.0 1993/11/29 13:48:40 ram Exp $
  257.   ;#
  258.   ;#  Copyright (c) 1990-1993, Raphael Manfredi
  259.   ;#  
  260. --- 1,4 ----
  261. ! ;# $Id: dynload.pl,v 3.0.1.1 1994/09/22 14:17:09 ram Exp $
  262.   ;#
  263.   ;#  Copyright (c) 1990-1993, Raphael Manfredi
  264.   ;#  
  265. ***************
  266. *** 9,14 ****
  267. --- 9,17 ----
  268.   ;#  of the source tree for mailagent 3.0.
  269.   ;#
  270.   ;# $Log: dynload.pl,v $
  271. + ;# Revision 3.0.1.1  1994/09/22  14:17:09  ram
  272. + ;# patch12: added the &do routine to support new DO filtering command
  273. + ;#
  274.   ;# Revision 3.0  1993/11/29  13:48:40  ram
  275.   ;# Baseline for mailagent 3.0 netwide release.
  276.   ;#
  277. ***************
  278. *** 18,23 ****
  279. --- 21,37 ----
  280.   ;# array. The %Loaded array records the files which have already been loaded
  281.   ;# so that we do not load the same file twice. The key records the package
  282.   ;# name and then the file, separated by a ':'.
  283. + ;#
  284. + ;# Additionally, the &do routine can be given an argument of the form:
  285. + ;#    package'routine
  286. + ;#    COMMAND:package'routine
  287. + ;#    file:package'routine
  288. + ;# and would then call &load with the proper arguments. Of course, in the first
  289. + ;# case, nothing is to be done but to check that the routine is already there.
  290. + ;# The second and third case enable loading of a routine from a specific file,
  291. + ;# of from a file defining a new command. Distinction is made by looking at
  292. + ;# the commands first, which should not be the source of too many conflicts
  293. + ;# when a path with '/' is given...
  294.   #
  295.   # Load function into package
  296.   #
  297. ***************
  298. *** 82,87 ****
  299. --- 96,140 ----
  300.           return 0;                # Eval failed
  301.       }
  302.       1;        # Ok so far
  303. + }
  304. + # Inspect their request closely, trying to guess what they really want. The
  305. + # general pattern they can give us is:
  306. + #     something:routine
  307. + # where something may be a command name or a path name, or may be missing
  308. + # entirely up to the ':' separator, and routine is a qualified or unqualified
  309. + # routine name, using the single quote as package separator, and not :: as in
  310. + # perl5 or C++ -- I loathe that token, maybe because I loathe C++ so much?
  311. + # Returns success condition, or undef if file cannot be loaded (missing?).
  312. + sub do {
  313. +     local($routine) = @_;
  314. +     $routine =~ s/::/'/;    # Despite what leading comment says, be perl5 aware
  315. +     local($something);
  316. +     $routine =~ s/^([^:]*):// && ($something = $1);
  317. +     $routine = "main'$routine" unless $routine =~ /'/;
  318. +     return 1 if $something eq '' && defined &$routine;    # Already there
  319. +     return 0 if $something eq '';        # Not there, no clue how to get it
  320. +     # Ok, at that point we know the routine is not there, but by looking
  321. +     # at $something, we might be able to find out where that routine might
  322. +     # be found... First check whether it is the name of a user-defined command
  323. +     # in which case we load that file and get the command. Otherwise, the
  324. +     # remaining is taken as a path where the routine may be found.
  325. +     local($cmd) = $something;
  326. +     local($path);
  327. +     $cmd =~ tr/a-z/A-Z/;                # Cannonicalize to upper case
  328. +     if (defined $newcmd'Usercmd{$cmd}) {
  329. +         $path = $newcmd'Usercmd{$cmd};    # Get command's path
  330. +     } else {
  331. +         $path = $something;                # Must be a path then
  332. +         $path =~ s/~/$cf'home/;            # ~ substitution
  333. +     }
  334. +     
  335. +     local($package);
  336. +     ($package, $routine) = $routine =~ m|(.*)'(.*)|;
  337. +     return &load($package, $path, $routine);
  338.   }
  339.   
  340.   package main;
  341.  
  342. Index: agent/pl/filter.pl
  343. Prereq: 3.0.1.2
  344. *** agent/pl/filter.pl.old    Thu Sep 22 16:43:11 1994
  345. --- agent/pl/filter.pl    Thu Sep 22 16:43:11 1994
  346. ***************
  347. *** 1,4 ****
  348. ! ;# $Id: filter.pl,v 3.0.1.2 1994/07/01 15:00:30 ram Exp $
  349.   ;#
  350.   ;#  Copyright (c) 1990-1993, Raphael Manfredi
  351.   ;#  
  352. --- 1,4 ----
  353. ! ;# $Id: filter.pl,v 3.0.1.3 1994/09/22 14:20:43 ram Exp $
  354.   ;#
  355.   ;#  Copyright (c) 1990-1993, Raphael Manfredi
  356.   ;#  
  357. ***************
  358. *** 9,14 ****
  359. --- 9,18 ----
  360.   ;#  of the source tree for mailagent 3.0.
  361.   ;#
  362.   ;# $Log: filter.pl,v $
  363. + ;# Revision 3.0.1.3  1994/09/22  14:20:43  ram
  364. + ;# patch12: propagated change to the &queue_mail interface
  365. + ;# patch12: added stubs for DO and AFTER commands
  366. + ;#
  367.   ;# Revision 3.0.1.2  1994/07/01  15:00:30  ram
  368.   ;# patch8: new UMASK command
  369.   ;#
  370. ***************
  371. *** 52,58 ****
  372.   sub run_process {
  373.       if (0 != &process) {
  374.           &add_log("ERROR while processing [$mfile]--queing it") if $loglvl;
  375. !         &queue_mail($file_name);
  376.           return 1;
  377.       }
  378.       &add_log("PROCESSED [$mfile]") if $loglvl > 8;
  379. --- 56,62 ----
  380.   sub run_process {
  381.       if (0 != &process) {
  382.           &add_log("ERROR while processing [$mfile]--queing it") if $loglvl;
  383. !         &queue_mail($file_name, 'fm');
  384.           return 1;
  385.       }
  386.       &add_log("PROCESSED [$mfile]") if $loglvl > 8;
  387. ***************
  388. *** 561,569 ****
  389.       # Mail is saved as a 'qm' file, to avoid endless loops when mailagent
  390.       # processes the queue. This means the mail will be deferred for at
  391.       # least half an hour.
  392. !     local($failed) = &queue_mail('', 1);    # No file name, mail in %Header
  393. !     $ever_saved = 1 unless $failed;            # Queuing counts as saving
  394. !     $failed;
  395.   }
  396.   
  397.   # Run the PERL command
  398. --- 565,573 ----
  399.       # Mail is saved as a 'qm' file, to avoid endless loops when mailagent
  400.       # processes the queue. This means the mail will be deferred for at
  401.       # least half an hour.
  402. !     local($name) = &queue_mail('', 'qm');    # No file name, mail in %Header
  403. !     $ever_saved = 1 if defined $name;        # Queuing counts as saving
  404. !     defined $name ? 0 : 1;                    # Failed if $name is undef
  405.   }
  406.   
  407.   # Run the PERL command
  408. ***************
  409. *** 617,622 ****
  410. --- 621,653 ----
  411.       $local = $local ? ' locally' : '';
  412.       &add_log("UMASK [$mfile] set to ${omask}$local") if $loglvl > 7;
  413.       0;    # Ok
  414. + }
  415. + # Run the AFTER command
  416. + sub run_after {
  417. +     local($type, $time, $action) = $cmd =~ m|^\w+\s+(-[sanc]\s+)?\((.*)\)(.*)|;
  418. +     local($failed, $queued) = &after($time, $action, $type);
  419. +     unless ($failed) {
  420. +         local(@msg);
  421. +         push(@msg, 'shell') if $type =~ /s/;
  422. +         push(@msg, 'agent') if $type =~ /a/ || $type eq '';
  423. +         push(@msg, 'command') if $type =~ /c/;
  424. +         push(@msg, 'no input') if $type =~ /n/;
  425. +         local($type) = join(', ', @msg);
  426. +         local($qmsg) = $queued ne '-' ? "-> $queued" : '';
  427. +         &add_log("AFTER [$mfile$qmsg] $time {$action} ($type)") if $loglvl > 3;
  428. +     }
  429. +     $failed;    # Failure status
  430. + }
  431. + # Run the DO command
  432. + sub run_do {
  433. +     local($what, $args) = $cmd =~ m|^\w+\s+([^()\s]*)(.*)|;
  434. +     local($something, $routine) = $what =~ m|^([^:]*):(.*)|;
  435. +     $routine = $what if $something eq '';
  436. +     local($failed) = &do($something, $routine, $args);
  437. +     &add_log("DONE [$mfile] $routine$args") if $loglvl > 7 && !$failed;
  438. +     $failed;    # Failure status
  439.   }
  440.   
  441.   # For SAVE, STORE or WRITE, the job is the same
  442.  
  443. Index: agent/pl/rules.pl
  444. Prereq: 3.0.1.1
  445. *** agent/pl/rules.pl.old    Thu Sep 22 16:43:22 1994
  446. --- agent/pl/rules.pl    Thu Sep 22 16:43:22 1994
  447. ***************
  448. *** 1,4 ****
  449. ! ;# $Id: rules.pl,v 3.0.1.1 1994/04/25 15:23:03 ram Exp $
  450.   ;#
  451.   ;#  Copyright (c) 1990-1993, Raphael Manfredi
  452.   ;#  
  453. --- 1,4 ----
  454. ! ;# $Id: rules.pl,v 3.0.1.2 1994/09/22 14:36:40 ram Exp $
  455.   ;#
  456.   ;#  Copyright (c) 1990-1993, Raphael Manfredi
  457.   ;#  
  458. ***************
  459. *** 9,14 ****
  460. --- 9,17 ----
  461.   ;#  of the source tree for mailagent 3.0.
  462.   ;#
  463.   ;# $Log: rules.pl,v $
  464. + ;# Revision 3.0.1.2  1994/09/22  14:36:40  ram
  465. + ;# patch12: lock rule cache before reading to prevent from concurrent updates
  466. + ;#
  467.   ;# Revision 3.0.1.1  1994/04/25  15:23:03  ram
  468.   ;# patch7: added locking protections when updating rule cache
  469.   ;#
  470. ***************
  471. *** 237,243 ****
  472.                   $printed += length($pattern) + 7;
  473.               }
  474.           }
  475. !         print "  " if $lines == 1 && $printed += 2;
  476.   
  477.           # Split actions, but take care of escaped \; (layout purposes)
  478.           $action =~ s/\\\\/\02/g;            # \\ -> ^B
  479. --- 240,246 ----
  480.                   $printed += length($pattern) + 7;
  481.               }
  482.           }
  483. !         print "  " if $lines == 1 && ($printed += 2);
  484.   
  485.           # Split actions, but take care of escaped \; (layout purposes)
  486.           $action =~ s/\\\\/\02/g;            # \\ -> ^B
  487. ***************
  488. *** 324,336 ****
  489.   # Since the '-r' option may also need to cache rules and no mailagent lock
  490.   # is taken in that case, we need to lock the rule file before accessing it.
  491.   sub read_cache {
  492. -     return 0 unless &cache_ok;
  493. -     local(*CACHE);                    # File handle used to read the cache
  494. -     local($_);
  495.       if (0 != &'acs_rqst($cf'rulecache)) {
  496.           &'add_log("NOTICE unable to read-lock $cf'rulecache") if $'loglvl > 6;
  497.           return 0;                    # Cannot read
  498.       }
  499.       open(CACHE, $cf'rulecache) || return 0;    # Cannot open, assume out of date
  500.       $_ = <CACHE>;                    # Disregard top line
  501.       while (<CACHE>) {                # First read the @Rules
  502. --- 327,342 ----
  503.   # Since the '-r' option may also need to cache rules and no mailagent lock
  504.   # is taken in that case, we need to lock the rule file before accessing it.
  505.   sub read_cache {
  506.       if (0 != &'acs_rqst($cf'rulecache)) {
  507.           &'add_log("NOTICE unable to read-lock $cf'rulecache") if $'loglvl > 6;
  508.           return 0;                    # Cannot read
  509.       }
  510. +     unless (&cache_ok) {
  511. +         &'free_file($cf'rulecache);
  512. +         return 0;                    # Cache outdated
  513. +     }
  514. +     local(*CACHE);                    # File handle used to read the cache
  515. +     local($_);
  516.       open(CACHE, $cf'rulecache) || return 0;    # Cannot open, assume out of date
  517.       $_ = <CACHE>;                    # Disregard top line
  518.       while (<CACHE>) {                # First read the @Rules
  519. ***************
  520. *** 355,360 ****
  521. --- 361,367 ----
  522.   }
  523.   
  524.   # Is cache up-to-date with respect to the rule file? Returns true if cache ok.
  525. + # The rule file should be read-locked by the caller.
  526.   sub cache_ok {
  527.       return 0 unless defined $cf'rulecache;
  528.       local(*CACHE);                    # File handle used to read the cache
  529.  
  530. Index: agent/pl/interface.pl
  531. Prereq: 3.0.1.1
  532. *** agent/pl/interface.pl.old    Thu Sep 22 16:43:13 1994
  533. --- agent/pl/interface.pl    Thu Sep 22 16:43:13 1994
  534. ***************
  535. *** 1,4 ****
  536. ! ;# $Id: interface.pl,v 3.0.1.1 1994/07/01 15:01:19 ram Exp $
  537.   ;#
  538.   ;#  Copyright (c) 1990-1993, Raphael Manfredi
  539.   ;#  
  540. --- 1,4 ----
  541. ! ;# $Id: interface.pl,v 3.0.1.2 1994/09/22 14:23:38 ram Exp $
  542.   ;#
  543.   ;#  Copyright (c) 1990-1993, Raphael Manfredi
  544.   ;#  
  545. ***************
  546. *** 9,14 ****
  547. --- 9,18 ----
  548.   ;#  of the source tree for mailagent 3.0.
  549.   ;#
  550.   ;# $Log: interface.pl,v $
  551. + ;# Revision 3.0.1.2  1994/09/22  14:23:38  ram
  552. + ;# patch12: mailhook package cleaning now done only for subroutines
  553. + ;# patch12: package name is separated with '::' in perl5
  554. + ;#
  555.   ;# Revision 3.0.1.1  1994/07/01  15:01:19  ram
  556.   ;# patch8: new UMASK command
  557.   ;# patch8: cannot dataload exit
  558. ***************
  559. *** 97,103 ****
  560.       local($args) = join(' ', @_);            # Arguments for the command
  561.       local($name) = (caller(1))[3];            # Function which called us
  562.       local($status);                            # Continuation status
  563. !     $name =~ s/^\w+'//;                        # Strip leading package name
  564.       &'add_log("calling '$name $args'") if $'loglvl > 18;
  565.       $status = &'run_command("$name $args");    # Case does not matter
  566.   
  567. --- 101,107 ----
  568.       local($args) = join(' ', @_);            # Arguments for the command
  569.       local($name) = (caller(1))[3];            # Function which called us
  570.       local($status);                            # Continuation status
  571. !     $name =~ s/^\w+('|::)//;                # Strip leading package name
  572.       &'add_log("calling '$name $args'") if $'loglvl > 18;
  573.       $status = &'run_command("$name $args");    # Case does not matter
  574.   
  575. ***************
  576. *** 135,144 ****
  577.       # Loop over perl's symbol table for the mailhook package
  578.       while (($key, $val) = each(%_mailhook)) {
  579.           local(*entry) = $val;    # Get definitions of current slot
  580. !         undef $entry unless length($key) == 1 && $key !~ /^\w/;
  581. !         undef @entry;
  582. !         undef %entry unless $key =~ /^_/ || $key eq 'header';
  583. !         undef &entry if &valid($key);
  584.           $_mailhook{$key} = *entry;    # Commit our changes
  585.       }
  586.   }
  587. --- 139,152 ----
  588.       # Loop over perl's symbol table for the mailhook package
  589.       while (($key, $val) = each(%_mailhook)) {
  590.           local(*entry) = $val;    # Get definitions of current slot
  591. !         # Temporarily disable those. They are causing problems with perl
  592. !         # 4.0 PL36 on some machines when running PERL escapes. Keep only
  593. !         # the removal of functions since the re-definition of routines is
  594. !         # the most harmful with perl 4.0.
  595. !         #undef $entry unless length($key) == 1 && $key !~ /^\w/;
  596. !         #undef @entry;
  597. !         #undef %entry unless $key =~ /^_/ || $key eq 'header';
  598. !         undef &entry if defined &entry && &valid($key);
  599.           $_mailhook{$key} = *entry;    # Commit our changes
  600.       }
  601.   }
  602.  
  603. Index: agent/test/TEST
  604. Prereq: 3.0.1.1
  605. *** agent/test/TEST.old    Thu Sep 22 16:43:26 1994
  606. --- agent/test/TEST    Thu Sep 22 16:43:26 1994
  607. ***************
  608. *** 2,8 ****
  609.       eval 'exec perl -S $0 "$@"'
  610.           if $running_under_some_shell;
  611.   
  612. ! # $Id: TEST,v 3.0.1.1 1993/12/15 09:04:45 ram Exp $
  613.   #
  614.   #  Copyright (c) 1990-1993, Raphael Manfredi
  615.   #  
  616. --- 2,8 ----
  617.       eval 'exec perl -S $0 "$@"'
  618.           if $running_under_some_shell;
  619.   
  620. ! # $Id: TEST,v 3.0.1.2 1994/09/22 14:40:10 ram Exp $
  621.   #
  622.   #  Copyright (c) 1990-1993, Raphael Manfredi
  623.   #  
  624. ***************
  625. *** 13,18 ****
  626. --- 13,21 ----
  627.   #  of the source tree for mailagent 3.0.
  628.   #
  629.   # $Log: TEST,v $
  630. + # Revision 3.0.1.2  1994/09/22  14:40:10  ram
  631. + # patch12: new -m option to monitor agentlog changes via atail
  632. + #
  633.   # Revision 3.0.1.1  1993/12/15  09:04:45  ram
  634.   # patch3: now force . into PATH for msend/nsend
  635.   #
  636. ***************
  637. *** 28,33 ****
  638. --- 31,37 ----
  639.   $ENV{'USER'} = 'nobody';    # In case we get mails back from RUN and friends
  640.   $ENV{'PWD'} = $pwd;
  641.   $ENV{'LEVEL'} = 0;            # Default loglvl for filter and cmd tests
  642. + delete $ENV{'ENV'};            # For ksh
  643.   
  644.   @tests = ('basic', 'option', 'filter', 'cmd', 'misc');
  645.   $failed = 0;
  646. ***************
  647. *** 53,58 ****
  648. --- 57,73 ----
  649.       $ENV{'LEVEL'} = int($level);
  650.   }
  651.   
  652. + # Launch atail if -m to monitor the agentlog file
  653. + if ($opt_m) {
  654. +     $atail_pid = fork;
  655. +     unlink 'out/agentlog';
  656. +     if (defined $atail_pid && $atail_pid == 0) {
  657. +         # Child process
  658. +         exec 'perl ./atail';
  659. +         die "TEST: could not launch atail: $!\n";
  660. +     }
  661. + }
  662.   unless (-f 'OK') {
  663.       %Ok = ();
  664.       `rm -rf out` if -d 'out';
  665. ***************
  666. *** 86,97 ****
  667.   }
  668.   
  669.   &clean_up;
  670. ! exit 0;        # End of tests
  671.   
  672.   #
  673.   # Subroutines
  674.   #
  675.   
  676.   sub clean_up {
  677.       return if $failed || $opt_i;    # -i asks for incrementality
  678.       unlink 'OK';
  679. --- 101,118 ----
  680.   }
  681.   
  682.   &clean_up;
  683. ! &exit(0);        # End of tests
  684.   
  685.   #
  686.   # Subroutines
  687.   #
  688.   
  689. + sub exit {
  690. +     local($code) = @_;
  691. +     kill(15, $atail_pid) if $atail_pid;
  692. +     exit $code;
  693. + }
  694.   sub clean_up {
  695.       return if $failed || $opt_i;    # -i asks for incrementality
  696.       unlink 'OK';
  697. ***************
  698. *** 139,145 ****
  699.       }
  700.       if ($failed && $opt_s) {    # Stop at first error if -s
  701.           print "Aborted tests.\n";
  702. !         exit 0;
  703.       }
  704.   }
  705.   
  706. --- 160,166 ----
  707.       }
  708.       if ($failed && $opt_s) {    # Stop at first error if -s
  709.           print "Aborted tests.\n";
  710. !         &exit(0);
  711.       }
  712.   }
  713.   
  714. ***************
  715. *** 166,172 ****
  716.   sub basic_failed {
  717.       print "Failed a basic test, cannot continue.\n";
  718.       unlink 'OK';
  719. !     exit 0;
  720.   }
  721.   
  722.   sub load_ok {
  723. --- 187,193 ----
  724.   sub basic_failed {
  725.       print "Failed a basic test, cannot continue.\n";
  726.       unlink 'OK';
  727. !     &exit(0);
  728.   }
  729.   
  730.   sub load_ok {
  731.  
  732. Index: agent/pl/runcmd.pl
  733. Prereq: 3.0.1.1
  734. *** agent/pl/runcmd.pl.old    Thu Sep 22 16:43:22 1994
  735. --- agent/pl/runcmd.pl    Thu Sep 22 16:43:23 1994
  736. ***************
  737. *** 1,4 ****
  738. ! ;# $Id: runcmd.pl,v 3.0.1.1 1994/07/01 15:04:58 ram Exp $
  739.   ;#
  740.   ;#  Copyright (c) 1990-1993, Raphael Manfredi
  741.   ;#  
  742. --- 1,4 ----
  743. ! ;# $Id: runcmd.pl,v 3.0.1.2 1994/09/22 14:37:08 ram Exp $
  744.   ;#
  745.   ;#  Copyright (c) 1990-1993, Raphael Manfredi
  746.   ;#  
  747. ***************
  748. *** 9,14 ****
  749. --- 9,17 ----
  750.   ;#  of the source tree for mailagent 3.0.
  751.   ;#
  752.   ;# $Log: runcmd.pl,v $
  753. + ;# Revision 3.0.1.2  1994/09/22  14:37:08  ram
  754. + ;# patch12: new DO and AFTER commands
  755. + ;#
  756.   ;# Revision 3.0.1.1  1994/07/01  15:04:58  ram
  757.   ;# patch8: new UMASK command
  758.   ;#
  759. ***************
  760. *** 22,33 ****
  761. --- 25,38 ----
  762.   ;#
  763.   ;# The following commands are available (case is irrelevent):
  764.   ;#  ABORT                    Aborts filtering right away
  765. + ;#  AFTER time <cmd>         Records command in the callout queue
  766.   ;#  ANNOTATE field <value>   Annotation in header a la MH
  767.   ;#  APPLY rulefile           Apply an alternate rule file on message
  768.   ;#  ASSIGN var <value>       Assign value to the user-defined variable
  769.   ;#  BACK <cmd>               Execute <cmd> and eval its output
  770.   ;#  BEGIN state              Enter in a new state for analysis
  771.   ;#  BOUNCE address(es)       As FORWARD but leave header intact
  772. + ;#  DO routine(args)         Call perl routine
  773.   ;#  DELETE                   Trash the mail away
  774.   ;#  FEED program             Same as PASS, but the whole message is given
  775.   ;#  FORWARD address(es)      Forwards mail to specified addresses
  776. ***************
  777. *** 165,176 ****
  778. --- 170,183 ----
  779.   sub init_filter {
  780.       %Filter = (
  781.           'ABORT', 'run_abort',        # Aborts application of filtering rules
  782. +         'AFTER', 'run_after',        # Records callout action
  783.           'ANNOTATE', 'run_annotate',    # Add new field into header
  784.           'APPLY', 'run_apply',        # Apply alternate rule file on message
  785.           'ASSIGN', 'run_assign',        # Assign value to variable
  786.           'BACK', 'run_back',            # Eval feedback
  787.           'BEGIN', 'run_begin',        # Enter in a new state
  788.           'BOUNCE', 'run_bounce',        # Bounce message
  789. +         'DO', 'run_do',                # Call perl routine directly
  790.           'DELETE', 'run_delete',        # Throw mail away, explicitely
  791.           'FEED', 'run_feed',            # Feed back mail through program
  792.           'FORWARD', 'run_forward',    # Forward mail
  793. ***************
  794. *** 213,218 ****
  795. --- 220,226 ----
  796.       %Rfilter = (
  797.           'BACK', 1,
  798.           'BOUNCE', 1,
  799. +         'DO', 1,
  800.           'FEED', 1,
  801.           'FORWARD', 1,
  802.           'GIVE', 1,
  803.  
  804. Index: agent/Jmakefile
  805. Prereq: 3.0
  806. *** agent/Jmakefile.old    Thu Sep 22 16:42:45 1994
  807. --- agent/Jmakefile    Thu Sep 22 16:42:45 1994
  808. ***************
  809. *** 2,8 ****
  810.    * Jmakefile for mailagent
  811.    */
  812.   
  813. ! ;# $Id: Jmakefile,v 3.0 1993/11/29 13:47:37 ram Exp $
  814.   ;#
  815.   ;#  Copyright (c) 1990-1993, Raphael Manfredi
  816.   ;#  
  817. --- 2,8 ----
  818.    * Jmakefile for mailagent
  819.    */
  820.   
  821. ! ;# $Id: Jmakefile,v 3.0.1.1 1994/09/22 13:39:09 ram Exp $
  822.   ;#
  823.   ;#  Copyright (c) 1990-1993, Raphael Manfredi
  824.   ;#  
  825. ***************
  826. *** 13,23 ****
  827.   ;#  of the source tree for mailagent 3.0.
  828.   ;#
  829.   ;# $Log: Jmakefile,v $
  830.   ;# Revision 3.0  1993/11/29  13:47:37  ram
  831.   ;# Baseline for mailagent 3.0 netwide release.
  832.   ;#
  833.   
  834. ! BIN = mailpatch mailhelp maillist maildist package
  835.   
  836.   NoManPages()
  837.   ShellScriptTarget($(BIN))
  838. --- 13,26 ----
  839.   ;#  of the source tree for mailagent 3.0.
  840.   ;#
  841.   ;# $Log: Jmakefile,v $
  842. + ;# Revision 3.0.1.1  1994/09/22  13:39:09  ram
  843. + ;# patch12: new edusers script to edit users file
  844. + ;#
  845.   ;# Revision 3.0  1993/11/29  13:47:37  ram
  846.   ;# Baseline for mailagent 3.0 netwide release.
  847.   ;#
  848.   
  849. ! BIN = mailpatch mailhelp maillist maildist package edusers
  850.   
  851.   NoManPages()
  852.   ShellScriptTarget($(BIN))
  853.  
  854. Index: agent/man/Jmakefile
  855. Prereq: 3.0
  856. *** agent/man/Jmakefile.old    Thu Sep 22 16:42:55 1994
  857. --- agent/man/Jmakefile    Thu Sep 22 16:42:55 1994
  858. ***************
  859. *** 2,8 ****
  860.    * Jmakefile for mailagent's manual pages
  861.    */
  862.   
  863. ! ;# $Id: Jmakefile,v 3.0 1993/11/29 13:48:25 ram Exp $
  864.   ;#
  865.   ;#  Copyright (c) 1990-1993, Raphael Manfredi
  866.   ;#  
  867. --- 2,8 ----
  868.    * Jmakefile for mailagent's manual pages
  869.    */
  870.   
  871. ! ;# $Id: Jmakefile,v 3.0.1.1 1994/09/22 13:52:52 ram Exp $
  872.   ;#
  873.   ;#  Copyright (c) 1990-1993, Raphael Manfredi
  874.   ;#  
  875. ***************
  876. *** 13,18 ****
  877. --- 13,21 ----
  878.   ;#  of the source tree for mailagent 3.0.
  879.   ;#
  880.   ;# $Log: Jmakefile,v $
  881. + ;# Revision 3.0.1.1  1994/09/22  13:52:52  ram
  882. + ;# patch12: new manual page for edusers
  883. + ;#
  884.   ;# Revision 3.0  1993/11/29  13:48:25  ram
  885.   ;# Baseline for mailagent 3.0 netwide release.
  886.   ;#
  887. ***************
  888. *** 20,25 ****
  889.   >L        /* I expect to fix this with an |append command */
  890.   
  891.   MPAGES = mailagent.$(L) maildist.$(L) maillist.$(L) mailhelp.$(L) \
  892. !     mailpatch.$(L) package.$(L)
  893.   
  894.   ComplexShellManualTarget($(MPAGES))
  895. --- 23,28 ----
  896.   >L        /* I expect to fix this with an |append command */
  897.   
  898.   MPAGES = mailagent.$(L) maildist.$(L) maillist.$(L) mailhelp.$(L) \
  899. !     mailpatch.$(L) package.$(L) edusers.$(L)
  900.   
  901.   ComplexShellManualTarget($(MPAGES))
  902.  
  903. Index: agent/test/atail
  904. *** agent/test/atail.old    Thu Sep 22 16:43:27 1994
  905. --- agent/test/atail    Thu Sep 22 16:43:27 1994
  906. ***************
  907. *** 0 ****
  908. --- 1,79 ----
  909. + : # feed this into perl
  910. +     eval 'exec perl -S $0 "$@"'
  911. +         if $running_under_some_shell;
  912. + # $Id: atail,v 3.0.1.1 1994/09/22 14:40:37 ram Exp $
  913. + #
  914. + #  Copyright (c) 1990-1993, Raphael Manfredi
  915. + #  
  916. + #  You may redistribute only under the terms of the Artistic License,
  917. + #  as specified in the README file that comes with the distribution.
  918. + #  You may reuse parts of this distribution only within the terms of
  919. + #  that same Artistic License; a copy of which may be found at the root
  920. + #  of the source tree for mailagent 3.0.
  921. + #
  922. + # $Log: atail,v $
  923. + # Revision 3.0.1.1  1994/09/22  14:40:37  ram
  924. + # patch12: created
  925. + #
  926. + # Active monitoring of out/agentlog. This is going to be a CPU hog, but is
  927. + # intended to debug stall cases or weird mailagent errors.
  928. + # Launched automatically with the -m (monitor) option of TEST.
  929. + # Aborts when parent becomes init after 5 seconds of delay, just in case
  930. + # the TEST program dies without having a chance to kill us.
  931. + $LOG = 'out/agentlog';        # Log file
  932. + $open = 0;                    # True when file opened
  933. + $size = 0;                    # Last file size
  934. + $SIG{'ALRM'} = 'check_parent';
  935. + alarm(5);
  936. + select STDOUT;
  937. + $| = 1;
  938. + for (;;) {
  939. +     &close_file if !-e $LOG && $open;
  940. +     next unless -f _;
  941. +     &new_file unless $open;
  942. +     &check_size if $open;
  943. + }
  944. + # Log file disappeared
  945. + sub close_file {
  946. +     print "** Log removed\n";
  947. +     close LOG;
  948. +     $open = 0;
  949. +     $size = 0;
  950. + }
  951. + # File reappeared
  952. + sub new_file {
  953. +     print "** New log file\n";
  954. +     open(LOG, $LOG);
  955. +     $open = 1;
  956. + }
  957. + # Print whatever there is in the file after $size bytes
  958. + sub check_size {
  959. +     $now = -s _;
  960. +     if ($now < $size) {
  961. +         print "** Replaced log file\n";
  962. +         open(LOG, $LOG);
  963. +         $size = 0;
  964. +     }
  965. +     seek(LOG, $size, 0);
  966. +     sysread(LOG, $buf, $now - $size);
  967. +     $size = $now;
  968. +     print $buf;
  969. + }
  970. + # Make sure our parent is not init
  971. + sub check_parent {
  972. +     die "atail: parent process died, exiting\n" if getppid == 1;
  973. +     # Don't know whether perl re-instantiates handlers when kernel doesn't
  974. +     $SIG{'ALRM'} = 'check_parent';
  975. +     alarm(5);
  976. + }
  977.  
  978. Index: agent/files/filter.sh
  979. Prereq: 3.0
  980. *** agent/files/filter.sh.old    Thu Sep 22 16:42:48 1994
  981. --- agent/files/filter.sh    Thu Sep 22 16:42:48 1994
  982. ***************
  983. *** 1,6 ****
  984.   #!/bin/sh
  985.   
  986. ! # $Id: filter.sh,v 3.0 1993/11/29 13:47:51 ram Exp $
  987.   #
  988.   #  Copyright (c) 1990-1993, Raphael Manfredi
  989.   #  
  990. --- 1,6 ----
  991.   #!/bin/sh
  992.   
  993. ! # $Id: filter.sh,v 3.0.1.1 1994/09/22 13:41:43 ram Exp $
  994.   #
  995.   #  Copyright (c) 1990-1993, Raphael Manfredi
  996.   #  
  997. ***************
  998. *** 11,16 ****
  999. --- 11,19 ----
  1000.   #  of the source tree for mailagent 3.0.
  1001.   #
  1002.   # $Log: filter.sh,v $
  1003. + # Revision 3.0.1.1  1994/09/22  13:41:43  ram
  1004. + # patch12: filter.sh now honours queuewait when defined
  1005. + #
  1006.   # Revision 3.0  1993/11/29  13:47:51  ram
  1007.   # Baseline for mailagent 3.0 netwide release.
  1008.   #
  1009. ***************
  1010. *** 154,165 ****
  1011.       tqtemp=$queue/Tqmb$$
  1012.   fi
  1013.   
  1014.   # Do not write in a 'qm' file directly, or the mailagent might start
  1015.   # its processing on an incomplete file.
  1016.   if cp $temp $tqtemp; then
  1017.       mv $tqtemp $qtemp
  1018.       if test x = "x$busy"; then
  1019. !         sleep 60
  1020.           if perl -S mailagent $qtemp; then
  1021.               rm -f $temp $qtemp $spool/filter.lock
  1022.               exit 0
  1023. --- 157,172 ----
  1024.       tqtemp=$queue/Tqmb$$
  1025.   fi
  1026.   
  1027. + # Set a proper waiting time. If queuewait is not defined in the config file,
  1028. + # let it default to 60 seconds.
  1029. + test "$queuewait" || queuewait=60
  1030.   # Do not write in a 'qm' file directly, or the mailagent might start
  1031.   # its processing on an incomplete file.
  1032.   if cp $temp $tqtemp; then
  1033.       mv $tqtemp $qtemp
  1034.       if test x = "x$busy"; then
  1035. !         sleep $queuewait
  1036.           if perl -S mailagent $qtemp; then
  1037.               rm -f $temp $qtemp $spool/filter.lock
  1038.               exit 0
  1039. ***************
  1040. *** 169,175 ****
  1041.       set 'ERROR unable to queue mail before processing'
  1042.       eval $addlog
  1043.       if test x = "x$busy"; then
  1044. !         sleep 60
  1045.           if perl -S mailagent $temp; then
  1046.               rm -f $temp $spool/filter.lock
  1047.               exit 0
  1048. --- 176,182 ----
  1049.       set 'ERROR unable to queue mail before processing'
  1050.       eval $addlog
  1051.       if test x = "x$busy"; then
  1052. !         sleep $queuewait
  1053.           if perl -S mailagent $temp; then
  1054.               rm -f $temp $spool/filter.lock
  1055.               exit 0
  1056.  
  1057. Index: agent/pl/analyze.pl
  1058. Prereq: 3.0.1.3
  1059. *** agent/pl/analyze.pl.old    Thu Sep 22 16:43:05 1994
  1060. --- agent/pl/analyze.pl    Thu Sep 22 16:43:05 1994
  1061. ***************
  1062. *** 1,4 ****
  1063. ! ;# $Id: analyze.pl,v 3.0.1.3 1994/07/01 14:59:58 ram Exp $
  1064.   ;#
  1065.   ;#  Copyright (c) 1990-1993, Raphael Manfredi
  1066.   ;#  
  1067. --- 1,4 ----
  1068. ! ;# $Id: analyze.pl,v 3.0.1.4 1994/09/22 14:09:03 ram Exp $
  1069.   ;#
  1070.   ;#  Copyright (c) 1990-1993, Raphael Manfredi
  1071.   ;#  
  1072. ***************
  1073. *** 9,14 ****
  1074. --- 9,17 ----
  1075.   ;#  of the source tree for mailagent 3.0.
  1076.   ;#
  1077.   ;# $Log: analyze.pl,v $
  1078. + ;# Revision 3.0.1.4  1994/09/22  14:09:03  ram
  1079. + ;# patch12: defines new folder_saved variable to store folder path
  1080. + ;#
  1081.   ;# Revision 3.0.1.3  1994/07/01  14:59:58  ram
  1082.   ;# patch8: general umask is now reset before analyzing a message
  1083.   ;# patch8: added support for the UMASK command for local rule scope
  1084. ***************
  1085. *** 60,65 ****
  1086. --- 63,69 ----
  1087.       # are external to &apply_rules.
  1088.       local($ever_matched) = 0;    # Did we ever matched a single saving rule ?
  1089.       local($ever_saved) = 0;        # Did we ever saved a message ?
  1090. +     local($folder_saved) = '';    # Last folder we saved into (full path)
  1091.   
  1092.       # Other local variables used only in this function
  1093.       local($ever_seen) = 0;        # Did we ever enter seen mode ?
  1094. ***************
  1095. *** 73,79 ****
  1096.       &parse_mail($file);            # Parse the mail and fill-in H tables
  1097.       return 0 unless defined $Header{'All'};        # Mail not parsed correctly
  1098.       &reception if $loglvl > 8;    # Log mail reception
  1099. !     &run_builtins;                # Execute builtins, if any were found
  1100.   
  1101.       # Now analyze the mail. If there is already a X-Filter header, then the
  1102.       # mail has already been processed. In that case, the default action is
  1103. --- 77,83 ----
  1104.       &parse_mail($file);            # Parse the mail and fill-in H tables
  1105.       return 0 unless defined $Header{'All'};        # Mail not parsed correctly
  1106.       &reception if $loglvl > 8;    # Log mail reception
  1107. !     &run_builtins;                # Execute builtins, if any
  1108.   
  1109.       # Now analyze the mail. If there is already a X-Filter header, then the
  1110.       # mail has already been processed. In that case, the default action is
  1111.  
  1112. Index: agent/test/option/l.t
  1113. Prereq: 3.0
  1114. *** agent/test/option/l.t.old    Thu Sep 22 16:43:29 1994
  1115. --- agent/test/option/l.t    Thu Sep 22 16:43:29 1994
  1116. ***************
  1117. *** 1,6 ****
  1118.   # -l: list message queue (special)
  1119.   
  1120. ! # $Id: l.t,v 3.0 1993/11/29 13:50:18 ram Exp $
  1121.   #
  1122.   #  Copyright (c) 1990-1993, Raphael Manfredi
  1123.   #  
  1124. --- 1,6 ----
  1125.   # -l: list message queue (special)
  1126.   
  1127. ! # $Id: l.t,v 3.0.1.1 1994/09/22 14:41:21 ram Exp $
  1128.   #
  1129.   #  Copyright (c) 1990-1993, Raphael Manfredi
  1130.   #  
  1131. ***************
  1132. *** 11,21 ****
  1133. --- 11,25 ----
  1134.   #  of the source tree for mailagent 3.0.
  1135.   #
  1136.   # $Log: l.t,v $
  1137. + # Revision 3.0.1.1  1994/09/22  14:41:21  ram
  1138. + # patch12: now checks that callout messages are properly listed
  1139. + #
  1140.   # Revision 3.0  1993/11/29  13:50:18  ram
  1141.   # Baseline for mailagent 3.0 netwide release.
  1142.   #
  1143.   
  1144.   do '../pl/init.pl';
  1145. + do '../pl/logfile.pl';
  1146.   chdir '../out';
  1147.   unlink <queue/*>;
  1148.   open(MBOX, ">mbox") || print "1\n";
  1149. ***************
  1150. *** 58,62 ****
  1151.   $? == 0 || print "5\n";
  1152.   $output_bis = `./mailqueue 2>/dev/null`;
  1153.   $output eq $output_bis || print "6\n";
  1154. ! unlink <queue/*>, 'mbox', 'mailqueue';
  1155.   print "0\n";
  1156. --- 62,81 ----
  1157.   $? == 0 || print "5\n";
  1158.   $output_bis = `./mailqueue 2>/dev/null`;
  1159.   $output eq $output_bis || print "6\n";
  1160. ! # Ensure callout messages are also listed
  1161. ! `$mailagent -f mbox -e 'AFTER -a (now + 1 day) DELETE; DELETE' 2>/dev/null`;
  1162. ! $? == 0 || print "7\n";
  1163. ! @qfiles = <queue/[qf]m*>;
  1164. ! @cfiles = <queue/cm*>;
  1165. ! @qfiles == 3 || print "8\n";
  1166. ! @cfiles == 3 || print "9\n";
  1167. ! # Make sure there are three messages queued and three callouts reported
  1168. ! @log = `$mailagent -l 2>/dev/null`;
  1169. ! &check_log('Now', 10) == 3 || print "11\n";
  1170. ! &check_log('Skipped', 12) == 3 || print "13\n";
  1171. ! &check_log('Callout', 14) == 3 || print "15\n";
  1172. ! unlink <queue/*>, 'mbox', 'mailqueue', 'context', 'callout';
  1173.   print "0\n";
  1174.  
  1175. Index: agent/filter/misc.c
  1176. Prereq: 3.0
  1177. *** agent/filter/misc.c.old    Thu Sep 22 16:42:51 1994
  1178. --- agent/filter/misc.c    Thu Sep 22 16:42:51 1994
  1179. ***************
  1180. *** 11,17 ****
  1181.   */
  1182.   
  1183.   /*
  1184. !  * $Id: misc.c,v 3.0 1993/11/29 13:48:16 ram Exp $
  1185.    *
  1186.    *  Copyright (c) 1990-1993, Raphael Manfredi
  1187.    *  
  1188. --- 11,17 ----
  1189.   */
  1190.   
  1191.   /*
  1192. !  * $Id: misc.c,v 3.0.1.1 1994/09/22 13:45:30 ram Exp $
  1193.    *
  1194.    *  Copyright (c) 1990-1993, Raphael Manfredi
  1195.    *  
  1196. ***************
  1197. *** 22,27 ****
  1198. --- 22,30 ----
  1199.    *  of the source tree for mailagent 3.0.
  1200.    *
  1201.    * $Log: misc.c,v $
  1202. +  * Revision 3.0.1.1  1994/09/22  13:45:30  ram
  1203. +  * patch12: added fallback implementation for strcasecmp()
  1204. +  *
  1205.    * Revision 3.0  1993/11/29  13:48:16  ram
  1206.    * Baseline for mailagent 3.0 netwide release.
  1207.    *
  1208. ***************
  1209. *** 29,34 ****
  1210. --- 32,38 ----
  1211.   
  1212.   #include "config.h"
  1213.   #include "portable.h"
  1214. + #include <ctype.h>
  1215.   #include "confmagic.h"
  1216.   
  1217.   extern char *malloc();                /* Memory allocation */
  1218. ***************
  1219. *** 48,51 ****
  1220. --- 52,82 ----
  1221.       strcpy(new, string);
  1222.       return new;
  1223.   }
  1224. + #ifndef HAS_STRCASECMP
  1225. + /*
  1226. +  * This is a rather inefficient version of the strcasecmp() routine which
  1227. +  * compares two strings in a case-independant manner. The libc routine uses
  1228. +  * an array, which when indexed by character code, directly yields the lower
  1229. +  * case version of that character. Here however, since the routine is only
  1230. +  * used in a few places, we don't bother being as efficient.
  1231. +  */
  1232. + public int strcasecmp(s1, s2)
  1233. + char *s1;
  1234. + char *s2;
  1235. + {
  1236. +     char c1, c2;
  1237. +     while (c1 = *s1++, c2 = *s2++, c1 && c2) {
  1238. +         if (isupper(c1))
  1239. +             c1 = tolower(c1);
  1240. +         if (isupper(c2))
  1241. +             c2 = tolower(c2);
  1242. +         if (c1 != c2)
  1243. +             break;            /* Strings are different */
  1244. +     }
  1245. +     return c1 - c2;            /* Will be 0 if both string ended */
  1246. + }
  1247. + #endif
  1248.   
  1249.  
  1250. Index: config_h.SH
  1251. Prereq: 3.0.1.2
  1252. *** config_h.SH.old    Thu Sep 22 16:43:31 1994
  1253. --- config_h.SH    Thu Sep 22 16:43:31 1994
  1254. ***************
  1255. *** 25,31 ****
  1256.    * that running config.h.SH again will wipe out any changes you've made.
  1257.    * For a more permanent change edit config.sh and rerun config.h.SH.
  1258.    *
  1259. !  * \$Id: config_h.SH,v 3.0.1.2 1994/07/01 15:15:19 ram Exp $
  1260.    */
  1261.   
  1262.   /* Configuration time: $cf_time
  1263. --- 25,31 ----
  1264.    * that running config.h.SH again will wipe out any changes you've made.
  1265.    * For a more permanent change edit config.sh and rerun config.h.SH.
  1266.    *
  1267. !  * \$Id: config_h.SH,v 3.0.1.3 1994/09/22 14:41:59 ram Exp $
  1268.    */
  1269.   
  1270.   /* Configuration time: $cf_time
  1271. ***************
  1272. *** 94,99 ****
  1273. --- 94,105 ----
  1274.    */
  1275.   #$d_setsid HAS_SETSID    /**/
  1276.   
  1277. + /* HAS_STRCASECMP:
  1278. +  *    This symbol, if defined, indicates that the strcasecmp() routine is
  1279. +  *    available for case-insensitive string compares.
  1280. +  */
  1281. + #$d_strccmp HAS_STRCASECMP    /**/
  1282.   /* HAS_INDEX:
  1283.    *    This symbol is defined to indicate that the index()/rindex()
  1284.    *    functions are available for string searching.
  1285. ***************
  1286. *** 183,188 ****
  1287. --- 189,200 ----
  1288.   #$i_sysioctl    I_SYS_IOCTL        /**/
  1289.   #$d_voidtty USE_TIOCNOTTY    /**/
  1290.   
  1291. + /* I_SYS_PARAM:
  1292. +  *    This symbol, if defined, indicates to the C program that it should
  1293. +  *    include <sys/param.h>.
  1294. +  */
  1295. + #$i_sysparam I_SYS_PARAM        /**/
  1296.   /* I_SYS_WAIT:
  1297.    *    This symbol, if defined, indicates to the C program that it should
  1298.    *    include <sys/wait.h>.
  1299. ***************
  1300. *** 264,269 ****
  1301. --- 276,286 ----
  1302.   #define register4 $reg4        /**/
  1303.   #define register5 $reg5        /**/
  1304.   #define register6 $reg6        /**/
  1305. + /* ROOTID:
  1306. +  *    This symbol contains the uid of root, normally 0.
  1307. +  */
  1308. + #define ROOTID $rootid        /**/
  1309.   
  1310.   /* Uid_t:
  1311.    *    This symbol holds the type used to declare user ids in the kernel.
  1312.  
  1313. Index: agent/pl/parse.pl
  1314. Prereq: 3.0.1.2
  1315. *** agent/pl/parse.pl.old    Thu Sep 22 16:43:20 1994
  1316. --- agent/pl/parse.pl    Thu Sep 22 16:43:20 1994
  1317. ***************
  1318. *** 1,4 ****
  1319. ! ;# $Id: parse.pl,v 3.0.1.2 1994/07/01 15:04:02 ram Exp $
  1320.   ;#
  1321.   ;#  Copyright (c) 1990-1993, Raphael Manfredi
  1322.   ;#  
  1323. --- 1,4 ----
  1324. ! ;# $Id: parse.pl,v 3.0.1.3 1994/09/22 14:33:38 ram Exp $
  1325.   ;#
  1326.   ;#  Copyright (c) 1990-1993, Raphael Manfredi
  1327.   ;#  
  1328. ***************
  1329. *** 9,14 ****
  1330. --- 9,17 ----
  1331.   ;#  of the source tree for mailagent 3.0.
  1332.   ;#
  1333.   ;# $Log: parse.pl,v $
  1334. + ;# Revision 3.0.1.3  1994/09/22  14:33:38  ram
  1335. + ;# patch12: builtins handled in &run_builtins to allow re-entrance
  1336. + ;#
  1337.   ;# Revision 3.0.1.2  1994/07/01  15:04:02  ram
  1338.   ;# patch8: now systematically escape leading From if fromall is ON
  1339.   ;#
  1340. ***************
  1341. *** 37,43 ****
  1342.       local($fd) = STDIN;                # Where does the mail come from ?
  1343.       local($value);                    # Value of current field line
  1344.       local($_);
  1345. !     undef %Header;                    # Reset the all structure holding message
  1346.   
  1347.       if ($file_name ne '') {            # Mail spooled in a file
  1348.           unless(open(MAIL, $file_name)) {
  1349. --- 40,46 ----
  1350.       local($fd) = STDIN;                # Where does the mail come from ?
  1351.       local($value);                    # Value of current field line
  1352.       local($_);
  1353. !     undef %Header;                    # Reset the whole structure holding message
  1354.   
  1355.       if ($file_name ne '') {            # Mail spooled in a file
  1356.           unless(open(MAIL, $file_name)) {
  1357. ***************
  1358. *** 102,113 ****
  1359.               s/^From(\s)/>From$1/ if $last_was_nl && $cf'fromesc =~ /on/i;
  1360.               $last_was_nl = /^$/ || $cf'fromall =~ /on/i;
  1361.               $Header{'Body'} .= $_;
  1362. -             chop;
  1363. -             # Deal with builtin commands
  1364. -             if (s/^@(\w+)\s*//) {                    # A builtin command ?
  1365. -                 local($subroutine) = $Builtin{$1};
  1366. -                 &$subroutine($_) if $subroutine;
  1367. -             }
  1368.           }
  1369.       }
  1370.       close MAIL if $file_name ne '';
  1371. --- 105,110 ----
  1372.  
  1373. Index: agent/pl/newcmd.pl
  1374. Prereq: 3.0
  1375. *** agent/pl/newcmd.pl.old    Thu Sep 22 16:43:17 1994
  1376. --- agent/pl/newcmd.pl    Thu Sep 22 16:43:17 1994
  1377. ***************
  1378. *** 1,4 ****
  1379. ! ;# $Id: newcmd.pl,v 3.0 1993/11/29 13:49:03 ram Exp $
  1380.   ;#
  1381.   ;#  Copyright (c) 1990-1993, Raphael Manfredi
  1382.   ;#  
  1383. --- 1,4 ----
  1384. ! ;# $Id: newcmd.pl,v 3.0.1.1 1994/09/22 14:28:06 ram Exp $
  1385.   ;#
  1386.   ;#  Copyright (c) 1990-1993, Raphael Manfredi
  1387.   ;#  
  1388. ***************
  1389. *** 9,14 ****
  1390. --- 9,18 ----
  1391.   ;#  of the source tree for mailagent 3.0.
  1392.   ;#
  1393.   ;# $Log: newcmd.pl,v $
  1394. + ;# Revision 3.0.1.1  1994/09/22  14:28:06  ram
  1395. + ;# patch12: ensures the newcmd file is secure
  1396. + ;# patch12: propagates glob for folder_saved
  1397. + ;#
  1398.   ;# Revision 3.0  1993/11/29  13:49:03  ram
  1399.   ;# Baseline for mailagent 3.0 netwide release.
  1400.   ;#
  1401. ***************
  1402. *** 90,95 ****
  1403. --- 94,104 ----
  1404.                   if $'loglvl > 1;
  1405.               next;                    # Skip invalid command
  1406.           }
  1407. +         unless (&'file_secure($path, "user command $cmd")) {
  1408. +             &'add_log("ERROR command '$cmd' is not secure")
  1409. +                 if $'loglvl > 1;
  1410. +             next;                    # Skip unsecure command
  1411. +         }
  1412.           # Load command into data structures by setting internal tables
  1413.           $'Filter{$cmd} = "newcmd'run";        # Main dispatcher for new commands
  1414.           $Usercmd{$cmd} = $path;                # Record command path
  1415. ***************
  1416. *** 117,122 ****
  1417. --- 126,132 ----
  1418.       local($cmd_name) = $'cmd_name;            # Command name (read only)
  1419.       local($mfile) = $'mfile;                # File name (read only)
  1420.       local(*ever_saved) = *'ever_saved;        # Saving already occurred?
  1421. +     local(*folder_saved) = *'folder_saved;    # Last folder saved to
  1422.       local(*cont) = *'cont;                    # Continuation status
  1423.       local(*vacation) = *'vacation;            # Vacation message allowed?
  1424.       local(*lastcmd) = *'lastcmd;            # Last failure status stored
  1425.  
  1426. *** End of Patch 15 ***
  1427.  
  1428. exit 0 # Just in case...
  1429.