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