home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 October / usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso / misc / volume44 / mailagent / patch13 < prev    next >
Encoding:
Internet Message Format  |  1994-09-22  |  45.4 KB
  1. From: Raphael Manfredi <ram@acri.fr>
  2. Newsgroups: comp.sources.misc
  3. Subject: v44i087:  mailagent - Flexible mail filtering and processing package, v3.0, Patch13
  4. Date: 22 Sep 1994 12:12:49 -0500
  5. Organization: Advanced Computer Research Institute, Lyon, France
  6. Sender: kent@sparky.sterling.com
  7. Approved: kent@sparky.sterling.com
  8. Message-ID: <35sduh$r4q@sparky.sterling.com>
  9. X-Md4-Signature: 54a601f5e0d0ff502086866c67008bb6
  10.  
  11. Submitted-by: Raphael Manfredi <ram@acri.fr>
  12. Posting-number: Volume 44, Issue 87
  13. Archive-name: mailagent/patch13
  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 #: 13
  21. Priority: MEDIUM
  22. Subject: patch #12, continued
  23. Date: Thu Sep 22 17:04:30 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: 12
  67. 4c4
  68. < #define PATCHLEVEL 12
  69. ---
  70. > #define PATCHLEVEL 13
  71.  
  72. Index: agent/pl/callout.pl
  73. *** agent/pl/callout.pl.old    Thu Sep 22 16:43:06 1994
  74. --- agent/pl/callout.pl    Thu Sep 22 16:43:06 1994
  75. ***************
  76. *** 0 ****
  77. --- 1,286 ----
  78. + ;# $Id: callout.pl,v 3.0.1.1 1994/09/22 14:13:07 ram Exp $
  79. + ;#
  80. + ;#  Copyright (c) 1990-1993, Raphael Manfredi
  81. + ;#  
  82. + ;#  You may redistribute only under the terms of the Artistic License,
  83. + ;#  as specified in the README file that comes with the distribution.
  84. + ;#  You may reuse parts of this distribution only within the terms of
  85. + ;#  that same Artistic License; a copy of which may be found at the root
  86. + ;#  of the source tree for mailagent 3.0.
  87. + ;#
  88. + ;# $Log: callout.pl,v $
  89. + ;# Revision 3.0.1.1  1994/09/22  14:13:07  ram
  90. + ;# patch12: created
  91. + ;#
  92. + ;#
  93. + ;# This package implements a callout queue for a limited "at" support in
  94. + ;# mailagent commands. Since items in the callout queue can only be dispatched
  95. + ;# by another call to the mailagent command, execution at an exact time cannot
  96. + ;# be guaranteed; instead we say the action will be launched "after" a certain
  97. + ;# date.
  98. + ;#
  99. + ;# It is quite admissible, however, to schedule a periodic cron job launching
  100. + ;# a 'mailagent -q' command to actually force processing of the queue and also
  101. + ;# of the callout queue, as a side effect... This is up to you, the user, to
  102. + ;# ensure that, depending on the required accuracy for your AFTER commands.
  103. + ;#
  104. + ;# The callout queue is handled as a sorted list with a single text file:
  105. + ;#
  106. + ;#   <timestamp> <type> <filename> <command>
  107. + ;#
  108. + ;# where:
  109. + ;#  - timestamp is the time in seconds elapsed since the Epoch, after which
  110. + ;#    the job should be launched.
  111. + ;#  - type is either 'agent' or 'shell' depending on whether the command is
  112. + ;#    a shell command or a mailagent filtering command (which can be a possible
  113. + ;#    mailagent call back to a perl routine via DO).
  114. + ;#  - command is the command to be run. Everything up to the new line.
  115. + ;#
  116. + ;# When loaded in memory, the callout queue is held in three hash tables:
  117. + ;#  %Calltype: associates a timestamp to a list of ^@-separated types
  118. + ;#  %Callout: associates a timestamp to a list of ^@-separated actions
  119. + ;#  %Callfile: associates a timestamp with a list of file names
  120. + ;# This separation by means of ^@ is necessary since more than one event may
  121. + ;# be associated to a single point in time.
  122. + ;#
  123. + package callout;
  124. + 
  125. + #
  126. + # Callout queue handling
  127. + #
  128. + 
  129. + # Init constants -- must be called after mailagent context was loaded
  130. + sub init {
  131. +     $AGENT = 'agent';        # Action is a mailagent command
  132. +     $SHELL = 'shell';        # Action is a standalone shell command
  133. +     $CMD = 'cmd';            # Action is a shell command on a mail message
  134. +     $first_callout = &context'get('next-callout');    # undef if not there
  135. +     $callout_changed = 0;    # Records changes in callout queue
  136. + }
  137. + 
  138. + # Load callout queue file into memory. Before exiting, mailagent will flush
  139. + # it again to the disk if it has been modified in some way. It is not an error
  140. + # for the file not to exist: it means the callout queue has been emptied.
  141. + sub load {
  142. +     unless (open(CALLOUT, $cf'callout)) {
  143. +         &'add_log("WARNING unable to open callout queue file: $!")
  144. +             if -f $cf'callout && $'loglvl > 5;
  145. +         return;
  146. +     }
  147. +     &'add_log("loading mailagent callout queue") if $'loglvl > 15;
  148. +     local($_, $.);
  149. +     while (<CALLOUT>) {
  150. +         next if /^\s*#/;
  151. +         if (/^(\d+)\s+(\w+)\s+(\S+)\s+(.*)/) {
  152. +             $Calltype{$1} .= "$2\0";
  153. +             $Callfile{$1} .= "$3\0";
  154. +             $Callout{$1} .= "$4\0";
  155. +             next;
  156. +         }
  157. +         &'add_log("WARNING callout queue corrupted, line $.") if $'loglvl > 5;
  158. +         last;
  159. +     }
  160. +     close CALLOUT;
  161. +     return unless defined %Callout;        # Nothing loaded, empty file...
  162. + 
  163. +     local($next_callout) = (sort keys %Callout)[0];
  164. +     if ($next_callout != $first_callout) {
  165. +         &'add_log(
  166. +             "NOTICE next-callout is $first_callout, should be $next_callout"
  167. +         ) if $'loglvl > 6;
  168. +         &'add_log("WARNING inconsistency in mailagent context (next-callout)")
  169. +             if $'loglvl > 5;
  170. +     }
  171. +     $first_callout = $next_callout;        # Trust callout queue over context
  172. + }
  173. + 
  174. + # Enqueue a new job to be performed after a certain time. If the job is to be
  175. + # launched before the first one in the queue, the next-callout value in the
  176. + # mailagent context is updated.
  177. + # Return the queued file name, or '-' if none, undef on errors.
  178. + sub queue {
  179. +     local($time, $action, $type, $no_input) = @_;
  180. +     $callout_changed++;
  181. +     &load unless defined %Callout;
  182. +     local($qname) = '-';            # File not queued by default
  183. +     if ($type ne $SHELL && !$no_input) {
  184. +         # 'agent' or 'cmd' callouts have input by default, unless $no_input
  185. +         # is specified in the arguments.
  186. +         local(@mail);                # Temporary mail storage
  187. +         @mail = split(/\n/, $'Header{'All'});
  188. +         $qname = &'qmail(*mail, 'cm');
  189. +         unless (defined $qname) {
  190. +             &'add_log("ERROR cannot record $type callout $action for $time")
  191. +                 if $'loglvl > 1;
  192. +             return undef;
  193. +         }
  194. +     }
  195. +     $Callfile{$time} .= "$qname\0";    # Add queue name to the list
  196. +     $Calltype{$time} .= "$type\0";    # Add type to the list
  197. +     $Callout{$time} .= "$action\0";    # Add action at this time stamp
  198. +     $first_callout = $time if $time < $first_callout;
  199. +     return $qname;
  200. + }
  201. + 
  202. + # Return trigger time for a callout, based on its file name. This is primarily
  203. + # used to list the callout queue. If no callout is found, returns 0.
  204. + sub trigger {
  205. +     local($file) = @_;
  206. +     local($directory, $base) = $file =~ m|(.*)/(.*)|;
  207. +     $file = $directory eq $cf'queue ? $base : $file;
  208. +     &load unless defined %Callout;
  209. +     local($time, $files);
  210. +     foreach $time (keys %Callfile) {
  211. +         $files = $Callfile{$time};
  212. +         next unless "\0$files" =~ /\0$file\0/;
  213. +         return $time;
  214. +     }
  215. +     return 0;
  216. + }
  217. + 
  218. + # Run the queue, by poping off the first set in the queue, and executing
  219. + # it. If by that time another timeout expires, loop again.
  220. + sub run {
  221. +     &'add_log("running callout queue") if $'loglvl > 15;
  222. +     $callout_changed++;
  223. +     &load unless defined %Callout;
  224. +     local(@type, @action, @file);
  225. +     local($type, $action, $file);
  226. +     do {
  227. +         chop($type = $Calltype{$first_callout});    # Remove trailing \0
  228. +         chop($action = $Callout{$first_callout});
  229. +         chop($file = $Callfile{$first_callout});
  230. +         @type = split(/\0/, $type);
  231. +         @action = split(/\0/, $action);
  232. +         @file = split(/\0/, $file);
  233. +         while ($type = shift(@type)) {
  234. +             $action = shift(@action);
  235. +             $file = shift(@file);
  236. +             &spawn($type, $file, $action);        # Spawn callout action
  237. +         }
  238. +         delete $Calltype{$first_callout};
  239. +         delete $Callout{$first_callout};
  240. +         delete $Callfile{$first_callout};
  241. +         $first_callout = (sort keys %Callout)[0];
  242. +     } while (time >= $first_callout);
  243. + }
  244. + 
  245. + # Flush the callout queue to the disk. This operation launches the commands
  246. + # that have expired, then rewrites a new callout queue file to the disk if
  247. + # required. When all the jobs from the queue have been run, the callout file
  248. + # is removed and the next-callout value is deleted from the context.
  249. + # NOTE: this is called by &main'contextual_operations in pl/context.pl, before
  250. + # the new mailagent context is actually saved to the disk. Therefore, we are
  251. + # able to update next-callout for the next mailagent run.
  252. + sub flush {
  253. +     return unless defined $first_callout;
  254. +     &run if time >= $first_callout;        # Run queue if time reached
  255. +     return unless $callout_changed;        # Done if no change since &init
  256. +     &save;
  257. +     &context'set('next-callout', $first_callout);
  258. + }
  259. + 
  260. + # Save the callout queue on disk. If the %Callout table is empty, the
  261. + # callout file is removed.
  262. + sub save {
  263. +     local($count) = scalar(keys %Callout);
  264. +     unless ($count) {
  265. +         &'add_log("removing mailagent callout queue") if $'loglvl > 15;
  266. +         unlink($cf'callout);
  267. +         return;
  268. +     }
  269. +     &'add_log("saving $count entries in callout queue") if $'loglvl > 15;
  270. + 
  271. +     local($existed) = -f $cf'callout;
  272. +     &'acs_rqst($cf'callout) if $existed;    # Lock existing file
  273. + 
  274. +     unless (open(CALLOUT, ">$cf'callout")) {
  275. +         &'add_log("ERROR cannot overwrite callout queue $cf'callout: $!")
  276. +             if $'loglvl > 1;
  277. +         &'free_file($cf'callout) if $existed;
  278. +         return;
  279. +     }
  280. + 
  281. +     require 'ctime.pl';
  282. +     print CALLOUT "# Mailagent callout queue, last updated " . &'ctime(time);
  283. + 
  284. +     local(@type, @action, @file);
  285. +     local($type, $action, $file);
  286. + 
  287. +     # De-compile callout data structure back into a human-readable table
  288. +     foreach $time (sort keys %Callout) {
  289. +         chop($type = $Calltype{$time});        # Remove trailing \0
  290. +         chop($action = $Callout{$time});
  291. +         chop($file = $Callfile{$time});
  292. +         @type = split(/\0/, $type);            # Type and action lists per time
  293. +         @action = split(/\0/, $action);
  294. +         @file = split(/\0/, $file);
  295. +         while ($type = shift(@type)) {
  296. +             $action = shift(@action);
  297. +             $file = shift(@file);
  298. +             print CALLOUT "$time\t$type\t$file\t$action\n";
  299. +         }
  300. +     }
  301. + 
  302. +     close CALLOUT;
  303. +     &'free_file($cf'callout) if $existed;
  304. + }
  305. + 
  306. + #
  307. + # Spawning engine
  308. + #
  309. + 
  310. + # Spawn callout action given its type, and the mail file on which the action
  311. + # takes place. If the file name is '-', then no input, but only for shell
  312. + # commands.
  313. + sub spawn {
  314. +     local($type, $action, $file) = @_;
  315. +     local($sub) = 'spawn_' . $type;
  316. +     local($file_name) = $file;        # Where mail is held (within queue usually)
  317. +     local(%Header);                    # Where filtering information is stored
  318. +     # File name is absolute if not within mailagent's queue, otherwise it
  319. +     # is only a relative path name, as returned by &qmail. Shell commands
  320. +     # specify '-', meaning no input is to be taken.
  321. +     $file_name = $cf'queue . '/' . $file_name unless $file_name =~ m|^/|;
  322. +     if (defined &$sub) {
  323. +         &'add_log("setting up mailagent data structures for $file")
  324. +             if $'loglvl > 15;
  325. +         &'parse_mail($file_name) if $file ne '-';    # Fill in %Header
  326. +         &'add_log("spawning callout $type type on $file: $action")
  327. +             if $'loglvl > 15;
  328. +         local($failed);
  329. +         $failed = &$sub($action);        # Invoke call-out action
  330. +         $failed = 'FAILED' if $failed;
  331. +         &'add_log("${failed}CALLOUT ($type) [$file] $action") if $'loglvl > 7;
  332. +     } else {
  333. +         &'add_log("ERROR unknown callout type $type -- skipping $action")
  334. +             if $'loglvl;
  335. +     }
  336. +     unlink $file_name unless $file eq '-';
  337. + }
  338. + 
  339. + # Spawn filtering command
  340. + sub spawn_agent {
  341. +     local($action) = @_;
  342. +     local($mode) = '_CALLOUT_';    # Initial working mode
  343. +     local($wmode) = $mode;        # Needed for statistics routines
  344. +     umask($cf'umask);            # Reset default umask
  345. +     &'xeqte($action);            # Run action
  346. +     umask($cf'umask);            # Reset umask anyway
  347. +     return 0;
  348. + }
  349. + 
  350. + # Spawn command-on-mail, i.e. shell command with mail on stdin
  351. + sub spawn_cmd {
  352. +     local($action) = @_;
  353. +     return &'shell_command($action, $'MAIL_INPUT, $'NO_FEEDBACK);
  354. + }
  355. + 
  356. + # Spawn shell command
  357. + sub spawn_shell {
  358. +     local($action) = @_;
  359. +     return &'shell_command($action, $'NO_INPUT, $'NO_FEEDBACK);
  360. + }
  361. + 
  362. + package main;
  363. + 
  364.  
  365. Index: agent/pl/actions.pl
  366. Prereq: 3.0.1.3
  367. *** agent/pl/actions.pl.old    Thu Sep 22 16:43:02 1994
  368. --- agent/pl/actions.pl    Thu Sep 22 16:43:03 1994
  369. ***************
  370. *** 1,4 ****
  371. ! ;# $Id: actions.pl,v 3.0.1.3 1994/07/01 14:57:49 ram Exp $
  372.   ;#
  373.   ;#  Copyright (c) 1990-1993, Raphael Manfredi
  374.   ;#  
  375. --- 1,4 ----
  376. ! ;# $Id: actions.pl,v 3.0.1.4 1994/09/22 14:07:26 ram Exp $
  377.   ;#
  378.   ;#  Copyright (c) 1990-1993, Raphael Manfredi
  379.   ;#  
  380. ***************
  381. *** 9,14 ****
  382. --- 9,21 ----
  383.   ;#  of the source tree for mailagent 3.0.
  384.   ;#
  385.   ;# $Log: actions.pl,v $
  386. + ;# Revision 3.0.1.4  1994/09/22  14:07:26  ram
  387. + ;# patch12: now updates new variable folder_saved with folder path
  388. + ;# patch12: added various escapes in strings for perl5 support
  389. + ;# patch12: create ~/agent.trace if unable to mail command trace back
  390. + ;# patch12: interface change for &qmail allows for better log messages
  391. + ;# patch12: implements new AFTER and DO filtering commands
  392. + ;#
  393.   ;# Revision 3.0.1.3  1994/07/01  14:57:49  ram
  394.   ;# patch8: timeout for RUN commands now defined by runmax config variable
  395.   ;# patch8: now systematically escape leading From if fromall is ON
  396. ***************
  397. *** 116,125 ****
  398.           }
  399.           $failed = 1;
  400.       }
  401. !     $failed;        # Propagate failure status
  402.   }
  403.   
  404.   # Called by &save when folder is a hook.
  405.   # Return command failure status.
  406.   sub save_hook {
  407.       local($failed) = &hook'process($mailbox);
  408. --- 123,137 ----
  409.           }
  410.           $failed = 1;
  411.       }
  412. !     $folder_saved = $mailbox;    # Keep track of last folder we save into
  413. !     $failed;                    # Propagate failure status
  414.   }
  415.   
  416.   # Called by &save when folder is a hook.
  417. + # Note that as opposed to other folder saving routines, we do not update the
  418. + # $folder_saved variable when saving into a hook. This is because the hook
  419. + # might be another set of filtering rules or a perl escape taking care of its
  420. + # own saving, in which case we do not want to corrupt the saved location.
  421.   # Return command failure status.
  422.   sub save_hook {
  423.       local($failed) = &hook'process($mailbox);
  424. ***************
  425. *** 152,158 ****
  426.       $dest =~ /<(.*)>/ && ($dest = $1);
  427.   
  428.       # Debugging purposes
  429. !     &add_log("@PATH was '$Userpath' and sender was '$sender'") if $loglvl > 18;
  430.       &add_log("computed destination: $dest") if $loglvl > 15;
  431.   
  432.       # Copy body of message in an array, one line per entry
  433. --- 164,171 ----
  434.       $dest =~ /<(.*)>/ && ($dest = $1);
  435.   
  436.       # Debugging purposes
  437. !     &add_log("\@PATH was '$Userpath' and sender was '$sender'")
  438. !         if $loglvl > 18;
  439.       &add_log("computed destination: $dest") if $loglvl > 15;
  440.   
  441.       # Copy body of message in an array, one line per entry
  442. ***************
  443. *** 170,191 ****
  444.   
  445.       line: foreach (@body) {
  446.           # Built-in commands
  447. !         if (/^@PACK\s*(.*)/) {        # Pack mode
  448.               $pack = $1 if $1 ne '';
  449.               $pack = "" if ($pack =~ /[=$^&*([{}`\\|;><?]/);
  450.           }
  451. !         s/^[ \t]@SH/@SH/;    # allow one blank only
  452. !         if (/^@SH/) {
  453.               s/\\!/!/g;        # if uucp address, un-escape `!'
  454.               if (/[=\$^&*([{}`\\|;><?]/) {
  455. !                 s/^@SH/bad command:/;    # space after ":" will be added
  456.                   $bad .= $_ . "\n";
  457.                   next line;
  458.               }
  459.               # Some useful substitutions
  460. !             s/@SH[ \t]*//;                # Allow leading blanks
  461.               s/ PATH/ $dest/;             # PATH is a macro
  462. !             s/^mial(\w*)/mail\1/;        # Common mis-spellings
  463.               s/^mailpath/mailpatch/;
  464.               s/^mailist/maillist/;
  465.               # Now fetch command's name (first symbol)
  466. --- 183,204 ----
  467.   
  468.       line: foreach (@body) {
  469.           # Built-in commands
  470. !         if (/^\@PACK\s*(.*)/) {        # Pack mode
  471.               $pack = $1 if $1 ne '';
  472.               $pack = "" if ($pack =~ /[=$^&*([{}`\\|;><?]/);
  473.           }
  474. !         s/^[ \t]\@SH/\@SH/;    # allow one blank only
  475. !         if (/^\@SH/) {
  476.               s/\\!/!/g;        # if uucp address, un-escape `!'
  477.               if (/[=\$^&*([{}`\\|;><?]/) {
  478. !                 s/^\@SH/bad command:/;    # space after ":" will be added
  479.                   $bad .= $_ . "\n";
  480.                   next line;
  481.               }
  482.               # Some useful substitutions
  483. !             s/\@SH[ \t]*//;                # Allow leading blanks
  484.               s/ PATH/ $dest/;             # PATH is a macro
  485. !             s/^mial(\w*)/mail$1/;        # Common mis-spellings
  486.               s/^mailpath/mailpatch/;
  487.               s/^mailist/maillist/;
  488.               # Now fetch command's name (first symbol)
  489. ***************
  490. *** 282,288 ****
  491.   It produced the following output and failed:
  492.   
  493.   EOM
  494. !                 if (open(TRACE, "$trace")) {
  495.                       while (<TRACE>) {
  496.                           print MAILER;
  497.                       }
  498. --- 295,301 ----
  499.   It produced the following output and failed:
  500.   
  501.   EOM
  502. !                 if (open(TRACE, $trace)) {
  503.                       while (<TRACE>) {
  504.                           print MAILER;
  505.                       }
  506. ***************
  507. *** 295,300 ****
  508. --- 308,324 ----
  509.                   close MAILER;
  510.                   if ($?) {
  511.                       &add_log("ERROR cannot report failure") if $loglvl;
  512. +                     # Dump trace in ~/agent.trace
  513. +                     local($ok) = 1;
  514. +                     open(DUMP, ">>$cf'home/agent.trace") || ($ok = 0);
  515. +                     print DUMP "--- Trace for failed $fullcmd ---\n";
  516. +                     print DUMP "--- (was unable to mail it back) ---\n";
  517. +                     open(TRACE, $trace) || ($ok = 0);
  518. +                     while (<TRACE>) { print DUMP; }
  519. +                     print DUMP "--- End of trace for $fullcmd ---\n";
  520. +                     close DUMP;
  521. +                     &add_log("DUMPED trace in ~/agent.trace")
  522. +                         if $ok && $loglvl > 2;
  523.                   }
  524.                   &add_log("FAILED $fullcmd") if $loglvl > 1;
  525.               } else {
  526. ***************
  527. *** 1299,1304 ****
  528. --- 1323,1397 ----
  529.       0;        # Success
  530.   }
  531.   
  532. + # The "DO" command
  533. + # The routine name can be one of pack'routine, COMMAND:pack'routine or
  534. + # /some/path:pack'routine. The following parsing duplicates the one done
  535. + # in &dynload'do, so beware, should the interface change.
  536. + sub do {
  537. +     local($something, $routine, $args) = @_;
  538. +     $routine = $what if $something eq '';
  539. +     unless (&dynload'do($what)) {
  540. +         local($under);
  541. +         $under = " under $something" if $something ne '';
  542. +         &add_log("ERROR couldn't locate routine $routine$under") if $loglvl > 1;
  543. +         return 1;    # Failed
  544. +     }
  545. +     $args = '()' unless $args;
  546. +     &add_log("calling routine $routine$args") if $loglvl > 15;
  547. +     eval "package main; &$routine$args;";
  548. + 
  549. +     # I want to allow people to call mailhook commands from a DO routine call.
  550. +     # However, commands modifying the filtering control flow are performing a
  551. +     # die() with 'Status x' as the error message where 'x' defines the new
  552. +     # continuation value for run_command. This is trapped specially here.
  553. +     # Note however that convenience variables typically set for PERL escapes
  554. +     # are not available via a DO.
  555. + 
  556. +     if (chop($@)) {
  557. +         local($_) = $@;
  558. +         $@ = '';                # Avoid cascades: we're within an eval already
  559. +         if (/^Status (\d+)$/) {    # Filter automaton continuation status
  560. +             $cont = $1;            # Propagate status ($cont from &run_command)
  561. +             &add_log("NOTICE $routine shifted automaton to status $cont")
  562. +                 if $loglvl > 1;
  563. +         } else {
  564. +             &add_log("ERROR cannot call $routine$args: $_") if $loglvl > 1;
  565. +             return 1;
  566. +         }
  567. +     }
  568. +     0;        # Success
  569. + }
  570. + 
  571. + # The "AFTER" command
  572. + sub after {
  573. +     local($time, $action, $type) = @_;
  574. +     local($no_input) = $type =~ /n/;
  575. +     local($agent_cmd) = $type =~ /a/ || $type eq '';
  576. +     local($shell_cmd) = $type =~ /s/;
  577. +     local($cmd_cmd) = $type =~ /c/;
  578. +     local($now) = time;                    # Current time
  579. +     local($start);                        # Action's starting time
  580. +     $start = &getdate($time, $now);
  581. +     if ($start == -1) {
  582. +         &add_log("ERROR in AFTER: time '$time' is incorrect") if $loglvl > 1;
  583. +         return (1,undef);
  584. +     }
  585. +     if ($start < $now) {
  586. +         &add_log("NOTICE time '$time' ($start) is before now ($now)")
  587. +             if $loglvl > 5;
  588. +         &add_log("ERROR in AFTER: command should have run already!")
  589. +             if $loglvl > 1;
  590. +         return (1,undef);
  591. +     }
  592. +     local($atype) = $agent_cmd ? $callout'AGENT :
  593. +         ($shell_cmd ? $callout'SHELL : $callout'CMD);
  594. +     local($qfile) = &callout'queue($start, $action, $atype, $no_input);
  595. +     unless (defined $qfile) {
  596. +         &add_log("ERROR in AFTER: cannot queue action $action") if $loglvl > 1;
  597. +         return (1,undef);
  598. +     }
  599. +     (0, $qfile);        # Success
  600. + }
  601.   
  602.   # Modify control flow within automaton by calling a non-existant function
  603.   # &perform, which has been dynamically bound to one of the do_* functions.
  604. ***************
  605. *** 1393,1400 ****
  606.       }
  607.       # Now @array holds the whole digest item
  608.       if ($folder =~ /^\s*$/) {        # No folder means we have to queue message
  609. !         $failed = &qmail(*array);
  610. !         $log_message = 'mailagent\'s queue';
  611.           foreach (@array) {
  612.               $length += length($_) + 1;    # No trailing new-lines
  613.           }
  614. --- 1486,1494 ----
  615.       }
  616.       # Now @array holds the whole digest item
  617.       if ($folder =~ /^\s*$/) {        # No folder means we have to queue message
  618. !         local($name) = &qmail(*array);
  619. !         $failed = defined $name ? 0 : 1;
  620. !         $log_message = $name =~ m|/| ? "file [$name]" : "queue [$name]";
  621.           foreach (@array) {
  622.               $length += length($_) + 1;    # No trailing new-lines
  623.           }
  624.  
  625. Index: agent/pl/lexical.pl
  626. Prereq: 3.0
  627. *** agent/pl/lexical.pl.old    Thu Sep 22 16:43:14 1994
  628. --- agent/pl/lexical.pl    Thu Sep 22 16:43:14 1994
  629. ***************
  630. *** 1,4 ****
  631. ! ;# $Id: lexical.pl,v 3.0 1993/11/29 13:48:55 ram Exp $
  632.   ;#
  633.   ;#  Copyright (c) 1990-1993, Raphael Manfredi
  634.   ;#  
  635. --- 1,4 ----
  636. ! ;# $Id: lexical.pl,v 3.0.1.1 1994/09/22 14:24:44 ram Exp $
  637.   ;#
  638.   ;#  Copyright (c) 1990-1993, Raphael Manfredi
  639.   ;#  
  640. ***************
  641. *** 9,14 ****
  642. --- 9,18 ----
  643.   ;#  of the source tree for mailagent 3.0.
  644.   ;#
  645.   ;# $Log: lexical.pl,v $
  646. + ;# Revision 3.0.1.1  1994/09/22  14:24:44  ram
  647. + ;# patch12: added logging at level 25 to debug lexer
  648. + ;# patch12: better mismatched braces handling
  649. + ;#
  650.   ;# Revision 3.0  1993/11/29  13:48:55  ram
  651.   ;# Baseline for mailagent 3.0 netwide release.
  652.   ;#
  653. ***************
  654. *** 33,42 ****
  655. --- 37,48 ----
  656.   # Assemble a whole rule in one line and return it. The end of a line is
  657.   # marked by a ';' at the end of an input line.
  658.   sub get_line {
  659. +     &add_log("IN get_line") if $loglvl > 24;
  660.       local($result) = "";        # what will be returned
  661.       local($in_braces) = 0;        # are we inside braces ?
  662.       for (;;) {
  663.           $_ = &read_rule;        # new rule line (pseudo from compile_rules)
  664. +         &add_log("READ <<$_>>") if $loglvl > 24;
  665.           last if $_ eq '';        # end of file reached
  666.           s/\n$//;                # don't use chop in case we read from array
  667.           next if /^\s*#/;        # skip comments
  668. ***************
  669. *** 44,72 ****
  670.           s/\s\s+/ /;                # reduce white spaces
  671.           $result .= $_;
  672.           # Very simple braces handling
  673. !         /.*{/ && ($in_braces = 1);
  674. !         if ($in_braces) {
  675. !             /.*}/ && ($in_braces = 0);
  676. !         }
  677. !         last if !$in_braces && /;\s*$/;
  678.       }
  679.       $result;
  680.   }
  681.   
  682.   # Get optional mode (e.g. <TEST>) at the beginning of the line and return
  683.   # it, or ALL if none was present. A mode can be negated by pre-pending a '!'.
  684.   sub get_mode {
  685.       local(*line) = shift(@_);    # edited in place
  686.       local($_) = $line;            # make a copy of original
  687.       local($mode) = "ALL";        # default mode
  688.       s/^\s*<([\s\w,!]+)>// && ($mode = $1);
  689.       $mode =~ s/\s//g;            # no spaces in returned mode
  690.       $line = $_;                    # eventually updates the line
  691.       $mode;
  692.   }
  693.   
  694.   # A selector is either a script or a list of header fields ending with a ':'.
  695.   sub get_selector {
  696.       local(*line) = shift(@_);    # edited in place
  697.       local($_) = $line;            # make a copy of original
  698.       local($selector) = "";
  699. --- 50,79 ----
  700.           s/\s\s+/ /;                # reduce white spaces
  701.           $result .= $_;
  702.           # Very simple braces handling
  703. !         $in_braces += tr/{/{/ - tr/}/}/;
  704. !         last if $in_braces <= 0 && /;\s*$/;
  705.       }
  706. +     &add_log("OUT get_line: $result") if $loglvl > 24;
  707.       $result;
  708.   }
  709.   
  710.   # Get optional mode (e.g. <TEST>) at the beginning of the line and return
  711.   # it, or ALL if none was present. A mode can be negated by pre-pending a '!'.
  712.   sub get_mode {
  713. +     &add_log("IN get_mode") if $loglvl > 24;
  714.       local(*line) = shift(@_);    # edited in place
  715.       local($_) = $line;            # make a copy of original
  716.       local($mode) = "ALL";        # default mode
  717.       s/^\s*<([\s\w,!]+)>// && ($mode = $1);
  718.       $mode =~ s/\s//g;            # no spaces in returned mode
  719.       $line = $_;                    # eventually updates the line
  720. +     &add_log("OUT get_mode: $mode") if $loglvl > 24;
  721.       $mode;
  722.   }
  723.   
  724.   # A selector is either a script or a list of header fields ending with a ':'.
  725.   sub get_selector {
  726. +     &add_log("IN get_selector") if $loglvl > 24;
  727.       local(*line) = shift(@_);    # edited in place
  728.       local($_) = $line;            # make a copy of original
  729.       local($selector) = "";
  730. ***************
  731. *** 77,82 ****
  732. --- 84,90 ----
  733.           s/^\s*([^\/,{\n]*(<[\d\s,-]+>)?\s*:)// && ($selector = $1);
  734.       }
  735.       $line = $_;                    # eventually updates the line
  736. +     &add_log("OUT get_selector: $selector") if $loglvl > 24;
  737.       $selector;
  738.   }
  739.   
  740. ***************
  741. *** 85,90 ****
  742. --- 93,99 ----
  743.   # modifiers.
  744.   # Patterns may be preceded by a single '!' to negate the matching value.
  745.   sub get_pattern {
  746. +     &add_log("IN get_pattern") if $loglvl > 24;
  747.       local(*line) = shift(@_);        # edited in place
  748.       local($_) = $line;                # make a copy of original
  749.       local($pattern) = "";            # the recognized pattern
  750. ***************
  751. *** 112,131 ****
  752.       } else {
  753.           $pattern = $not . $pattern;
  754.       }
  755.       $pattern;
  756.   }
  757.   
  758.   # Extract the action part from the line (by editing it in place) and return
  759.   # the first action encountered. Nesting of {...} blocks may occur.
  760.   sub get_action {
  761.       local(*line) = shift(@_);    # edited in place
  762.       local($_) = $line;            # make a copy of original
  763. !     return '' unless s/^\s*\{/{/;
  764.       local($action) = &action_parse(*_, 0);
  765.       &add_log("ERROR no action, discarding '$_'") if $loglvl && $action eq '';
  766.       $line = $_;                    # eventually update the line
  767.       $action =~ s/^\{\s*//;        # remove leading and trailing braces
  768.       $action =~ s/\s*\}$//;
  769.       $action;                    # return new action block
  770.   }
  771.   
  772. --- 121,146 ----
  773.       } else {
  774.           $pattern = $not . $pattern;
  775.       }
  776. +     &add_log("OUT get_pattern: $pattern") if $loglvl > 24;
  777.       $pattern;
  778.   }
  779.   
  780.   # Extract the action part from the line (by editing it in place) and return
  781.   # the first action encountered. Nesting of {...} blocks may occur.
  782.   sub get_action {
  783. +     &add_log("IN get_action") if $loglvl > 24;
  784.       local(*line) = shift(@_);    # edited in place
  785.       local($_) = $line;            # make a copy of original
  786. !     unless (s/^\s*\{/{/) {
  787. !         &add_log("OUT get_action (none)") if $loglvl > 24;
  788. !         return '';
  789. !     }
  790.       local($action) = &action_parse(*_, 0);
  791.       &add_log("ERROR no action, discarding '$_'") if $loglvl && $action eq '';
  792.       $line = $_;                    # eventually update the line
  793.       $action =~ s/^\{\s*//;        # remove leading and trailing braces
  794.       $action =~ s/\s*\}$//;
  795. +     &add_log("OUT get_action: $action") if $loglvl > 24;
  796.       $action;                    # return new action block
  797.   }
  798.   
  799. ***************
  800. *** 135,143 ****
  801. --- 150,160 ----
  802.   sub action_parse {
  803.       local(*_) = shift(@_);        # edited in place
  804.       local($level) = shift(@_);    # recursion level
  805. +     &add_log("IN action_parse $level: $_") if $loglvl > 24;
  806.       local($parsed) = '';        # the part we parsed so far
  807.       local($block);                # block recognized
  808.       local($follow);                # recursion string returned
  809. + 
  810.       for (;;) {
  811.           # Go to first un-escaped '{', if possible and save leading string
  812.           # up-to first '{'. Note that any '}' immediately stops scanning.
  813. ***************
  814. *** 146,160 ****
  815.           $block = '';
  816.           s/^(([^\\{}]|\\.)*\})// && ($block = $1);
  817.           $parsed .= $block;        # block may be empty, or has trailing '}'
  818.           if ($parsed =~ s/\{$//) {    # recursion if '{' found
  819.               $follow = &action_parse(*_, $level + 1);
  820.               # If a null string is returned, then no matching '}' was found
  821.               &add_log("WARNING no closing brace (added for you)")
  822.                   if $follow eq '' && $loglvl > 5;
  823.               $parsed .= '{' . $follow . '}';
  824. !         } elsif (s/^\}//) {            # reached end of a block
  825.               &add_log("WARNING extra closing brace ignored")
  826.                   if $level == 0 && $loglvl > 5;
  827.               return $parsed;
  828.           } else {
  829.               # Get the whole string until the next '}' and return. If a '{'
  830. --- 163,179 ----
  831.           $block = '';
  832.           s/^(([^\\{}]|\\.)*\})// && ($block = $1);
  833.           $parsed .= $block;        # block may be empty, or has trailing '}'
  834. +         &add_log("action_parse $level: $parsed") if $loglvl > 24;
  835.           if ($parsed =~ s/\{$//) {    # recursion if '{' found
  836.               $follow = &action_parse(*_, $level + 1);
  837.               # If a null string is returned, then no matching '}' was found
  838.               &add_log("WARNING no closing brace (added for you)")
  839.                   if $follow eq '' && $loglvl > 5;
  840.               $parsed .= '{' . $follow . '}';
  841. !         } elsif (s/^\}//) {        # reached end of a block
  842.               &add_log("WARNING extra closing brace ignored")
  843.                   if $level == 0 && $loglvl > 5;
  844. +             &add_log("OUT action_parse $level: $parsed") if $loglvl > 24;
  845.               return $parsed;
  846.           } else {
  847.               # Get the whole string until the next '}' and return. If a '{'
  848. ***************
  849. *** 166,176 ****
  850. --- 185,201 ----
  851.               if ($block eq '' && $level) {        # Advance until '{'
  852.                   s/^(([^\\}]|\\.)*\{)// && ($block = $1);
  853.                   $parsed .= $block;
  854. +                 last if $block eq '';    # Reached the end... prematurely!
  855.                   next;
  856.               }
  857.               $block =~ s/\}//;
  858. +             &add_log("OUT action_parse $level: $parsed$block") if $loglvl > 24;
  859.               return $parsed . $block;
  860.           }
  861.       }
  862. + 
  863. +     &add_log("WARNING mismatched braces in rule file") if $loglvl > 5;
  864. +     &add_log("OUT action_parse $level: $parsed <EOF>") if $loglvl > 24;
  865. +     return $parsed;
  866.   }
  867.   
  868.  
  869. Index: agent/pl/queue_mail.pl
  870. Prereq: 3.0
  871. *** agent/pl/queue_mail.pl.old    Thu Sep 22 16:43:20 1994
  872. --- agent/pl/queue_mail.pl    Thu Sep 22 16:43:20 1994
  873. ***************
  874. *** 1,4 ****
  875. ! ;# $Id: queue_mail.pl,v 3.0 1993/11/29 13:49:11 ram Exp $
  876.   ;#
  877.   ;#  Copyright (c) 1990-1993, Raphael Manfredi
  878.   ;#  
  879. --- 1,4 ----
  880. ! ;# $Id: queue_mail.pl,v 3.0.1.1 1994/09/22 14:34:16 ram Exp $
  881.   ;#
  882.   ;#  Copyright (c) 1990-1993, Raphael Manfredi
  883.   ;#  
  884. ***************
  885. *** 9,14 ****
  886. --- 9,17 ----
  887.   ;#  of the source tree for mailagent 3.0.
  888.   ;#
  889.   ;# $Log: queue_mail.pl,v $
  890. + ;# Revision 3.0.1.1  1994/09/22  14:34:16  ram
  891. + ;# patch12: changed interface of &qmail and &queue_mail for wider usage
  892. + ;#
  893.   ;# Revision 3.0  1993/11/29  13:49:11  ram
  894.   ;# Baseline for mailagent 3.0 netwide release.
  895.   ;#
  896. ***************
  897. *** 16,29 ****
  898.   ;# Queue a mail file. Needs add_log(). Calls fatal() in emergency situations.
  899.   ;# Requires a parsed config file.
  900.   ;# 
  901. ! # Queue mail in a 'fm' file. The mail is held in memory. It returns 0 if the
  902. ! # mail was queued, 1 otherwise.
  903.   sub qmail {
  904. !     local(*array) = @_;            # In which array mail is located.
  905.       local($queue_file);            # Where we attempt to save the mail
  906.       local($failed) = 0;            # Be positive and look forward :-)
  907. !     $queue_file = "$cf'queue/Tqm$$";
  908. !     $queue_file = "$cf'queue/Tqmb$$" if -f "$queue_file";    # Paranoid
  909.       unless (open(QUEUE, ">$queue_file")) {
  910.           &add_log("ERROR unable to create $queue_file: $!") if $loglvl > 1;
  911.           return 1;        # Failed
  912. --- 19,35 ----
  913.   ;# Queue a mail file. Needs add_log(). Calls fatal() in emergency situations.
  914.   ;# Requires a parsed config file.
  915.   ;# 
  916. ! # Queue mail in a 'fm' file (or whatever is specified for type). The mail is
  917. ! # held in memory, within an array passed via a type-glob.
  918. ! # Returns the name of queued file if success, undef if failed. File name will
  919. ! # be absolute only when queued outside of the regular queue.
  920.   sub qmail {
  921. !     local(*array, $type) = @_;    # In which array mail is located.
  922.       local($queue_file);            # Where we attempt to save the mail
  923.       local($failed) = 0;            # Be positive and look forward :-)
  924. !     local($name);                # Name of queued file
  925. !     $queue_file = "$cf'queue/Mqm$$";
  926. !     $queue_file = "$cf'queue/Mqmb$$" if -f "$queue_file";    # Paranoid
  927.       unless (open(QUEUE, ">$queue_file")) {
  928.           &add_log("ERROR unable to create $queue_file: $!") if $loglvl > 1;
  929.           return 1;        # Failed
  930. ***************
  931. *** 43,79 ****
  932.       }
  933.       close QUEUE;
  934.       unlink "$queue_file" if $failed;
  935. !     $failed = &queue_mail($queue_file) unless $failed;
  936. !     $failed;            # 0 means success
  937.   }
  938.   
  939. ! # Queue mail in a 'fm' file. The mail is supposed to be either on disk or
  940. ! # is expected from standard input. Returns 0 for success, 1 if failed.
  941.   # In case mail comes from stdin, may not return at all but raise a fatal error.
  942.   sub queue_mail {
  943.       local($file_name) = shift(@_);        # Where mail to-be-queued is
  944. !     local($deferred) = shift(@_);        # True when 'qm' mail wanted instead
  945.       local($dirname);                    # Directory name of processed file
  946.       local($tmp_queue);                    # Tempoorary storing of queued file
  947.       local($queue_file);                    # Final name of queue file
  948.       local($ok) = 1;                        # Print status
  949.       local($_);
  950. !     &add_log("queuing mail for delayed processing") if $loglvl > 18;
  951.       chdir $cf'queue || &fatal("cannot chdir to $cf'queue");
  952.   
  953.       # The following ensures unique queue mails. As the mailagent itself may
  954.       # queue intensively throughout the SPLIT command, a queue counter is kept
  955.       # and is incremented each time a mail is successfully queued.
  956. !     local($base) = $deferred ? 'qm' : 'fm';
  957. !     $queue_file = "$base$$";        # 'fm' stands for Full Mail
  958. !     $queue_file = "$base$$x" . $queue_count if -f "$queue_file";
  959.       $queue_file = "${queue_file}x" if -f "$queue_file";    # Paranoid
  960.       ++$queue_count;                    # Counts amount of queued mails
  961.       &add_log("queue file is $queue_file") if $loglvl > 19;
  962.   
  963.       # Do not write directly in the fm file, otherwise the main
  964.       # mailagent process could start its processing on it...
  965. !     $tmp_queue = "Tfm$$";
  966.       local($sender) = "<someone>";    # Attempt to report the sender of message
  967.       if ($file_name) {                # Mail is already on file system
  968.           # Mail already in a file
  969. --- 49,103 ----
  970.       }
  971.       close QUEUE;
  972.       unlink "$queue_file" if $failed;
  973. !     unless ($failed) {
  974. !         $type = 'fm' unless defined $type;    # Defaults to a 'fm' file
  975. !         $name = &queue_mail($queue_file, $type);
  976. !         $failed = defined $name ? 0 : 1;
  977. !     }
  978. !     $failed ? undef : $name;    # File path name, undef if failed
  979.   }
  980.   
  981. ! # Queue mail in a queue file. There are three types of queued mails:
  982. ! #   . qm: messages whose handling will be delayed by at most cf'queuehold secs
  983. ! #   . fm: messages queued for immediate processing by next 'mailagent -q'
  984. ! #   . cm: callout queue messages, meant for input by callout command
  985. ! # The mail is supposed to be either on disk or is expected from standard input.
  986.   # In case mail comes from stdin, may not return at all but raise a fatal error.
  987. + # Returns the name of queued file if success, undef if failed. File name will
  988. + # be absolute only when queued outside of the regular queue.
  989.   sub queue_mail {
  990.       local($file_name) = shift(@_);        # Where mail to-be-queued is
  991. !     local($type) = shift(@_);            # Type of mail message, must be known
  992.       local($dirname);                    # Directory name of processed file
  993.       local($tmp_queue);                    # Tempoorary storing of queued file
  994.       local($queue_file);                    # Final name of queue file
  995.       local($ok) = 1;                        # Print status
  996.       local($_);
  997. !     &add_log("queuing mail ($type) for delayed processing") if $loglvl > 18;
  998.       chdir $cf'queue || &fatal("cannot chdir to $cf'queue");
  999.   
  1000. +     local(%known_type) = (                # Known queue message types
  1001. +         'qm', 1,
  1002. +         'fm', 1,
  1003. +         'cm', 1,
  1004. +     );
  1005. +     unless ($known_type{$type}) {
  1006. +         &add_log("ERROR unknown type $type, defaulting to qm") if $loglvl > 1;
  1007. +         $type = 'qm';
  1008. +     }
  1009. + 
  1010.       # The following ensures unique queue mails. As the mailagent itself may
  1011.       # queue intensively throughout the SPLIT command, a queue counter is kept
  1012.       # and is incremented each time a mail is successfully queued.
  1013. !     $queue_file = "$type$$";        # Append PID for uniqueness
  1014. !     $queue_file = "$type$$x" . $queue_count if -f "$queue_file";
  1015.       $queue_file = "${queue_file}x" if -f "$queue_file";    # Paranoid
  1016.       ++$queue_count;                    # Counts amount of queued mails
  1017.       &add_log("queue file is $queue_file") if $loglvl > 19;
  1018.   
  1019.       # Do not write directly in the fm file, otherwise the main
  1020.       # mailagent process could start its processing on it...
  1021. !     $tmp_queue = "T$type$$";
  1022.       local($sender) = "<someone>";    # Attempt to report the sender of message
  1023.       if ($file_name) {                # Mail is already on file system
  1024.           # Mail already in a file
  1025. ***************
  1026. *** 141,148 ****
  1027.           # in the queue directory. This file contains the names of the mails
  1028.           # stored outside of the mailagent's queue and waiting to be processed.
  1029.           $ok = &waiting_mail($tmp_queue);
  1030. !         return 1 unless $ok;    # Queuing failed if not ok
  1031. !         return 0;
  1032.       }
  1033.   
  1034.       # We succeeded in writing the temporary queue mail. Now rename it so that
  1035. --- 165,172 ----
  1036.           # in the queue directory. This file contains the names of the mails
  1037.           # stored outside of the mailagent's queue and waiting to be processed.
  1038.           $ok = &waiting_mail($tmp_queue);
  1039. !         return undef unless $ok;        # Queuing failed if not ok
  1040. !         return $tmp_queue;
  1041.       }
  1042.   
  1043.       # We succeeded in writing the temporary queue mail. Now rename it so that
  1044. ***************
  1045. *** 155,163 ****
  1046.       } else {
  1047.           &add_log("ERROR cannot rename $tmp_queue to $queue_file") if $loglvl;
  1048.           $ok = &waiting_mail($tmp_queue);
  1049.       }
  1050. !     return 1 unless $ok;        # Queuing failed if not ok
  1051. !     0;
  1052.   }
  1053.   
  1054.   # Adds mail into the agent.wait file, if possible. This file records all the
  1055. --- 179,188 ----
  1056.       } else {
  1057.           &add_log("ERROR cannot rename $tmp_queue to $queue_file") if $loglvl;
  1058.           $ok = &waiting_mail($tmp_queue);
  1059. +         $queue_file = $tmp_queue;
  1060.       }
  1061. !     return undef unless $ok;            # Queuing failed if not ok
  1062. !     $queue_file;                        # Return file name for success
  1063.   }
  1064.   
  1065.   # Adds mail into the agent.wait file, if possible. This file records all the
  1066.  
  1067. Index: agent/man/mailagent.SH
  1068. Prereq: 3.0.1.4
  1069. *** agent/man/mailagent.SH.old    Thu Sep 22 16:42:58 1994
  1070. --- agent/man/mailagent.SH    Thu Sep 22 16:42:59 1994
  1071. ***************
  1072. *** 20,26 ****
  1073.   .TH MAILAGENT $manext "Version $VERSION PL$PATCHLEVEL"
  1074.   ''' @(#) Manual page for mailagent's filter -- (c) ram February 1991
  1075.   '''
  1076. ! ''' $Id: mailagent.SH,v 3.0.1.4 1994/07/01 14:56:20 ram Exp $
  1077.   '''
  1078.   '''  Copyright (c) 1990-1993, Raphael Manfredi
  1079.   '''  
  1080. --- 20,26 ----
  1081.   .TH MAILAGENT $manext "Version $VERSION PL$PATCHLEVEL"
  1082.   ''' @(#) Manual page for mailagent's filter -- (c) ram February 1991
  1083.   '''
  1084. ! ''' $Id: mailagent.SH,v 3.0.1.5 1994/09/22 13:57:09 ram Exp $
  1085.   '''
  1086.   '''  Copyright (c) 1990-1993, Raphael Manfredi
  1087.   '''  
  1088. ***************
  1089. *** 31,36 ****
  1090. --- 31,42 ----
  1091.   '''  of the source tree for mailagent 3.0.
  1092.   '''
  1093.   ''' $Log: mailagent.SH,v $
  1094. + ''' Revision 3.0.1.5  1994/09/22  13:57:09  ram
  1095. + ''' patch12: documents new config parameters callout and linkdirs
  1096. + ''' patch12: new filtering actions AFTER and DO
  1097. + ''' patch12: variable msgpath is now defined within a PERL escape
  1098. + ''' patch12: mention that PERL escape variables are available to new commands
  1099. + '''
  1100.   ''' Revision 3.0.1.4  1994/07/01  14:56:20  ram
  1101.   ''' patch8: documents new eleven configuration variables
  1102.   ''' patch8: sub-section on timeouts has been expanded
  1103. ***************
  1104. *** 204,209 ****
  1105. --- 210,220 ----
  1106.   (suggested: OFF, unless you use ONCE, UNIQUE or RECORD commands, or activate
  1107.   the vacation mode.)
  1108.   .TP
  1109. + .I callout
  1110. + The name of the callout queue file where batched jobs are kept. This
  1111. + parameter must be defined when using the AFTER command.
  1112. + (suggested: $spool/callout)
  1113. + .TP
  1114.   .I cleanlaps
  1115.   Cleaning period for database entries. The value of the last clean up is saved
  1116.   into the context file. This is optional, but needed if \fIautoclean\fR is on.
  1117. ***************
  1118. *** 266,277 ****
  1119.   .I level
  1120.   Log level, see below for a definition of available levels (suggested: 9).
  1121.   .TP
  1122.   .I lockdekay
  1123.   The delay in seconds between two locking attempts. (optional, defaults to: 2).
  1124.   .TP
  1125.   .I lockhold
  1126.   The maximum delay in seconds for holding a lock. After that time, the lock
  1127. ! will be broken. (optional, defaults to: 3600)
  1128.   .TP
  1129.   .I lockmax
  1130.   Maximum number of locking attempts before giving up. (optional,
  1131. --- 277,296 ----
  1132.   .I level
  1133.   Log level, see below for a definition of available levels (suggested: 9).
  1134.   .TP
  1135. + .I linkdirs
  1136. + When set to ON, carefully checks symbolic links to directories when performing
  1137. + security checks on sensitive files. This will (recursively) check for each
  1138. + symbolic link level that the target directory is not world writable or group
  1139. + writable and that the parent directory of each target link is not world
  1140. + writable. If the \fIsecure\fR option is OFF, this parameter is ignored.
  1141. + (optional, defaults to: ON, suggested: ON when secure is also ON).
  1142. + .TP
  1143.   .I lockdekay
  1144.   The delay in seconds between two locking attempts. (optional, defaults to: 2).
  1145.   .TP
  1146.   .I lockhold
  1147.   The maximum delay in seconds for holding a lock. After that time, the lock
  1148. ! will be broken. (optional, defaults to: 3600).
  1149.   .TP
  1150.   .I lockmax
  1151.   Maximum number of locking attempts before giving up. (optional,
  1152. ***************
  1153. *** 1362,1367 ****
  1154. --- 1381,1404 ----
  1155.   Abort application of filtering rules immediately. See REJECT for the meaning
  1156.   of the optional parameters. (Does not modify existing status)
  1157.   .TP
  1158. + AFTER [-sanc] \fI(time) action\fR
  1159. + Records a callback for after the specified \fItime\fR, where \fIaction\fR will
  1160. + be performed. By default, a mailagent filtering action is assumed (\fB\-a\fR
  1161. + option), on the current mail message. A shell command (\fB\-c\fR) may be
  1162. + given instead, receiving the current mail message as standard input. Finally,
  1163. + a plain shell command may be run (with no input) using the \fB\-s\fR option.
  1164. + The option \fB-n\fR may be used when the current mail message does not need
  1165. + to be kept for input. For instance:
  1166. + .Ex
  1167. + AFTER \fB-an\fR (1 day) DO ~/process:proc'run(%u)
  1168. + .Ef
  1169. + would call \fIproc'run\fR defined in the \fI~/process\fR file in one day
  1170. + from now, without giving any input (the action here does not require any).
  1171. + Note that the command is not called \fIAT\fR because the call will only
  1172. + be performed at the next mailagent invocation after the specified time has
  1173. + elapsed. Dates are specified using the same format as in SELECT.
  1174. + (Fails if the action cannot be recorded in the callout queue).
  1175. + .TP
  1176.   ANNOTATE [-d] \fIfield value\fR
  1177.   Annotate message by adding \fIfield\fR into the mail header, with the
  1178.   supplied \fIvalue\fR. This is like the MH command \fIanno\fR, but the
  1179. ***************
  1180. *** 1422,1427 ****
  1181. --- 1459,1482 ----
  1182.   for pattern loading.
  1183.   (Fails if mail cannot be resent)
  1184.   .TP
  1185. + DO \fIroutine\fR [\fI(arg1, arg2, ... , argn)\fR]
  1186. + Calls the perl \fIroutine\fR, with the supplied arguments if any. This is a
  1187. + very low level hook into \fImailagent's\fR internal. The routine can be
  1188. + specified by itself (\fIpackage'name\fR, \fIpackage\fR being \fImain\fR by
  1189. + default), or identified by a leading \fItag\fR, followed by a ':', then the
  1190. + routine name as before. The \fItag\fR can be a path to a file where the routine
  1191. + is defined, or a command name (for user-defined commands which are loaded
  1192. + dynamically). For instance
  1193. + .Ex
  1194. + DO UNKIT:newcmd'unkit('true')
  1195. + .Ef
  1196. + would lookup
  1197. + the user-defined \fIUNKIT\fR command, load the file where it is defined (in the
  1198. + \fInewcmd\fR package), then call the routine with \fI'true'\fR as argument.
  1199. + The \fIpackage\fR specified determines where the loading is done, so be sure
  1200. + it is consistent with the definition in the file where the routine is defined.
  1201. + (Fails if the routine cannot be located and executed)
  1202. + .TP
  1203.   DELETE
  1204.   Delete the current message. Actually, this does not do anything, it just marks
  1205.   the mail as saved. If no further action involving saving is done, then the
  1206. ***************
  1207. *** 1850,1855 ****
  1208. --- 1905,1915 ----
  1209.   This table, indexed by field name, returns the raw content on the
  1210.   corresponding header line. See below.
  1211.   .TP
  1212. + .I \$msgpath
  1213. + The full path name of the folder (or message within an MH folder) where
  1214. + the last saving operation has occurred. This is intended to be used if
  1215. + you wish to construct your own mail reception notification.
  1216. + .TP
  1217.   .I \$login
  1218.   The login name of the address on the From: line.
  1219.   .TP
  1220. ***************
  1221. *** 2771,2776 ****
  1222. --- 2831,2841 ----
  1223.   saving operation has been completed. If at the end of the filtering, this
  1224.   variable is still \fB0\fR, then the default LEAVE will be executed.
  1225.   .TP
  1226. + .I \$folder_saved
  1227. + The value of that variable governs the \fI\$msgpath\fR convenience variable
  1228. + set for PERL escapes. It is updated whenever a message is written to a file,
  1229. + to hold the path of the written file.
  1230. + .TP
  1231.   .I \$vacation
  1232.   This is a boolean, which when \fIset\fR to \fB1\fR will allow vacation messages.
  1233.   It is mainly used by the VACATION command, but if you wish to re-implement that
  1234. ***************
  1235. *** 2795,2800 ****
  1236. --- 2860,2869 ----
  1237.   This records the current state of the filter automaton (working mode), in a
  1238.   literal string form, typically modified by the BEGIN command or as a side
  1239.   effect, as in REJECT for instance.
  1240. + .PP
  1241. + All the special variables set-up for PERL escapes are also installed within
  1242. + the \fInewcmd\fR package. Those are \fI\$login\fR, \fI%header\fR, etc... You
  1243. + may peruse them at will.
  1244.   .PP
  1245.   Other variables you might have a need for are configuration parameters, held
  1246.   in the \fI~/.mailagent\fR configuration file. Well, the rule is simple. The
  1247.  
  1248. Index: agent/test/cmd/after.t
  1249. *** agent/test/cmd/after.t.old    Thu Sep 22 16:43:28 1994
  1250. --- agent/test/cmd/after.t    Thu Sep 22 16:43:28 1994
  1251. ***************
  1252. *** 0 ****
  1253. --- 1,18 ----
  1254. + # The AFTER command
  1255. + 
  1256. + # $Id: after.t,v 3.0.1.1 1994/09/22 14:40:57 ram Exp $
  1257. + #
  1258. + #  Copyright (c) 1990-1993, Raphael Manfredi
  1259. + #  
  1260. + #  You may redistribute only under the terms of the Artistic License,
  1261. + #  as specified in the README file that comes with the distribution.
  1262. + #  You may reuse parts of this distribution only within the terms of
  1263. + #  that same Artistic License; a copy of which may be found at the root
  1264. + #  of the source tree for mailagent 3.0.
  1265. + #
  1266. + # $Log: after.t,v $
  1267. + # Revision 3.0.1.1  1994/09/22  14:40:57  ram
  1268. + # patch12: created
  1269. + #
  1270. + 
  1271. + print "-1\n";    # Automatic testing difficult
  1272.  
  1273. *** End of Patch 13 ***
  1274.  
  1275. exit 0 # Just in case...
  1276.