home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1994 March / Source_Code_CD-ROM_Walnut_Creek_March_1994.iso / compsrcs / misc / volume35 / mailagnt / patch18 < prev    next >
Encoding:
Text File  |  1993-02-04  |  37.7 KB  |  1,226 lines
  1. Newsgroups: comp.sources.misc
  2. From: ram@eiffel.com (Raphael Manfredi)
  3. Subject: v35i034:  mailagent - Rule Based Mail Filtering, Patch18
  4. Message-ID: <1993Feb5.030658.776@sparky.imd.sterling.com>
  5. X-Md4-Signature: 7729d8fc0da3d870ee48c336c0756978
  6. Date: Fri, 5 Feb 1993 03:06:58 GMT
  7. Approved: kent@sparky.imd.sterling.com
  8.  
  9. Submitted-by: ram@eiffel.com (Raphael Manfredi)
  10. Posting-number: Volume 35, Issue 34
  11. Archive-name: mailagent/patch18
  12. Environment: Perl, Sendmail, UNIX
  13. Patch-To: mailagent: Volume 33, Issue 93-109
  14.  
  15. [The latest patch for mailagent version 2.9 is #19.]
  16.  
  17. System: mailagent version 2.9
  18. Patch #: 18
  19. Priority: MEDIUM
  20. Subject: patch #17, continued
  21. Date: Mon Feb  1 10:45:58 PST 1993
  22. From: Raphael Manfredi <ram@eiffel.com>
  23.  
  24. Description:
  25.     See patch #17.
  26.  
  27.  
  28. Fix:    From rn, say "| patch -p -N -d DIR", where DIR is your mailagent source
  29.     directory.  Outside of rn, say "cd DIR; patch -p -N <thisarticle".
  30.     If you don't have the patch program, apply the following by hand,
  31.     or get patch (version 2.0, latest patchlevel).
  32.  
  33.     After patching:
  34.         Configure -d
  35.         make depend
  36.         make
  37.         make install
  38.         make install.man
  39.  
  40.     If patch indicates that patchlevel is the wrong version, you may need
  41.     to apply one or more previous patches, or the patch may already
  42.     have been applied.  See the patchlevel.h file to find out what has or
  43.     has not been applied.  In any event, don't continue with the patch.
  44.  
  45.     If you are missing previous patches they can be obtained from me:
  46.  
  47.         Raphael Manfredi <ram@eiffel.com>
  48.  
  49.     If you send a mail message of the following form it will greatly speed
  50.     processing:
  51.  
  52.         Subject: Command
  53.         @SH mailpatch PATH mailagent 2.9 LIST
  54.                ^ note the c
  55.  
  56.     where PATH is a return path FROM ME TO YOU either in Internet notation,
  57.     or in bang notation from some well-known host, and LIST is the number
  58.     of one or more patches you need, separated by spaces, commas, and/or
  59.     hyphens.  Saying 35- says everything from 35 to the end.
  60.  
  61.     To get some more detailed instructions, send me the following mail:
  62.  
  63.         Subject: Command
  64.         @SH mailhelp PATH
  65.  
  66.  
  67. Index: patchlevel.h
  68. Prereq: 17
  69. 4c4
  70. < #define PATCHLEVEL 17
  71. ---
  72. > #define PATCHLEVEL 18
  73.  
  74. Index: agent/pl/newcmd.pl
  75. *** agent/pl/newcmd.pl.old    Mon Feb  1 10:24:39 1993
  76. --- agent/pl/newcmd.pl    Mon Feb  1 10:24:39 1993
  77. ***************
  78. *** 0 ****
  79. --- 1,210 ----
  80. + ;# $Id: newcmd.pl,v 2.9.1.1 93/02/01 10:17:40 ram Exp $
  81. + ;#
  82. + ;#  Copyright (c) 1993, Raphael Manfredi
  83. + ;#
  84. + ;#  You may redistribute only under the terms of the GNU General Public
  85. + ;#  Licence as specified in the README file that comes with dist.
  86. + ;#
  87. + ;# $Log:    newcmd.pl,v $
  88. + ;# Revision 2.9.1.1  93/02/01  10:17:40  ram
  89. + ;# patch17: created
  90. + ;# 
  91. + ;# 
  92. + ;# This package handles the dynamic loading of a perl script in memory,
  93. + ;# providing a dynamic way of enhancing the command set of the mailagent.
  94. + ;#
  95. + ;# New commands are specified in the newcmd file specified in the config file.
  96. + ;# The syntax of this file is the following:
  97. + ;#
  98. + ;#   <cmd_name> <path> <function> [<status_flag> [<seen_flag>]]
  99. + ;#
  100. + ;# cmd_name: this is the command name, eg. RETURN_SENDER
  101. + ;# path: this is the path to the perl script implementing the command.
  102. + ;# function: the perl function within the script which implements the command
  103. + ;# status_flag: states whether the command modifies the execution status
  104. + ;# seen_flag: states whether the command is allowed in _SEEN_ mode
  105. + ;# 
  106. + ;# The last two booleans are optional, and may be specified as either 'yes'
  107. + ;# and 'no' or 'true' and 'false'. Their default value is respectively true
  108. + ;# and false.
  109. + ;#
  110. + ;# New commands are loaded as they are used and put in a special newcmd
  111. + ;# package, so that the names of the routines do not conflict with the
  112. + ;# mailagent's one. They are free to use whatever function the mailagent
  113. + ;# implements by prefixing the routine name with its package: normally, the
  114. + ;# execution of the command is done from within the newcmd package.
  115. + ;#
  116. + ;# Commands are given a single argument: the string forming the command name.
  117. + ;# Therefore, the command may implement the syntax it wishes. However, for
  118. + ;# the user convenience, the special array @newcmd'argv is preset with a
  119. + ;# shell-style parsed version. The mailagent also initializes the same
  120. + ;# special variables as the one set for PERL commands, only does it put them
  121. + ;# in the newcmd package instead of mailhook.
  122. + ;#
  123. + ;# Several data structures are maintained by this package:
  124. + ;#   %Usercmd, maps a command name to a file
  125. + ;#   %Loaded, records whether a file has been loaded or not
  126. + ;#   %Run, maps a command name to a perl function
  127. + ;#
  128. + 
  129. + package newcmd;
  130. + 
  131. + #
  132. + # User-defined commands
  133. + #
  134. + 
  135. + # Parse the newcmd file and record all new commands in the mailagent data
  136. + # structures.
  137. + sub load {
  138. +     return unless -s $cf'newcmd;    # Empty or non-existent file
  139. + 
  140. +     local($ST_MODE) =  2 + $[;        # Field st_mode from inode structure
  141. +     local($S_IWOTH) = 02;            # Writable by world (no .ph files here)
  142. +     local($unsecure) = 0;            # Is command file unsecure?
  143. + 
  144. +     # Security checks. We cannot extend the mailagent commands if the file
  145. +     # describing those new commands is not owned by the user or ir world
  146. +     # writable. Indeed, someone could redefine default commands like LEAVE
  147. +     # and use that to break into the user account.
  148. +     unless (-O "$cf'newcmd") {
  149. +         &'add_log("WARNING you do not own new command file $cf'newcmd")
  150. +             if $'loglvl > 5;
  151. +         $unsecure++;
  152. +     }
  153. +     local($st_mode) = (stat($cf'newcmd))[$ST_MODE];
  154. +     if ($st_mode & $S_IWOTH) {
  155. +         &'add_log("WARNING new command file $cf'newcmd is world writable!")
  156. +             if $'loglvl > 5;
  157. +         $unsecure++;
  158. +     }
  159. + 
  160. +     if ($unsecure) {
  161. +         &'add_log("NOTICE ignoring new commands for security reasons")
  162. +             if $'loglvl > 6;
  163. +         return;
  164. +     }
  165. + 
  166. +     unless (open(NEWCMD, $cf'newcmd)) {
  167. +         &'add_log("ERROR cannot open $cf'newcmd: $!") if $'loglvl;
  168. +         &'add_log("WARNING new commands not loaded") if $'loglvl > 5;
  169. +         return;
  170. +     }
  171. + 
  172. +     local($_);
  173. +     local($cmd, $path, $function, $status, $seen);
  174. +     while (<NEWCMD>) {
  175. +         next if /^\s*#/;            # Skip comments
  176. +         next if /^\s*$/;            # Skip blank lines
  177. +         ($cmd, $path, $function, $status, $seen) = split(' ');
  178. +         $cmd =~ tr/a-z/A-Z/;        # Cannonicalize to upper-case
  179. +         $path =~ s/~/$cf'home/;        # Perform ~ substitution
  180. +         unless (-f $path && -r $path) {
  181. +             $path =~ s/^$cf'home/~/;
  182. +             &'add_log("ERROR command '$cmd' bound to unreadable file $path")
  183. +                 if $'loglvl;
  184. +             next;                    # Skip invalid command
  185. +         }
  186. +         # Load command into data structures by setting internal tables
  187. +         $'Filter{$cmd} = "newcmd'run";        # Main dispatcher for new commands
  188. +         $Usercmd{$cmd} = $path;                # Record command path
  189. +         $Loaded{$path} = 0;                    # File not loaded yet
  190. +         $Run{$cmd} = $function;                # Perl function to call
  191. +         $'Nostatus{$cmd} = 1 if status =~ /^f|n/i;
  192. +         $'Rfilter{$cmd} = 1 unless $seen =~ /^t|y/i;
  193. +         &interface'add($cmd);                # Add interface for perl hooks
  194. + 
  195. +         $path =~ s/^$cf'home/~/;
  196. +         &'add_log("new command $cmd in $path (&$function)")
  197. +             if $'loglvl > 18;
  198. +     }
  199. +     close NEWCMD;
  200. + }
  201. + 
  202. + # This is the main dispatcher for user-defined command.
  203. + # Our caller 'run_command' has set up some special variables, like $mfile
  204. + # and $cmd_name, which are used here. Someday, I'll have to encapsulate that
  205. + # in a better way--RAM.
  206. + sub run {
  207. +     # Make global variables visible in this package. Variables which should
  208. +     # not be changed are marked 'read only'.
  209. +     local($cmd) = $'cmd;                    # Full command line (read only)
  210. +     local($cmd_name) = $'cmd_name;            # Command name (read only)
  211. +     local($mfile) = $'mfile;                # File name (read only)
  212. +     local($ever_saved) = $'ever_saved;        # Saving already occurred?
  213. +     local($cont) = $'cont;                    # Continuation status
  214. +     local($vacation) = $'vacation;            # Vacation message allowed?
  215. +     local($lastcmd) = $'lastcmd;            # Last failure status stored
  216. +     local($wmode) = $'wmode;                # Filter mode
  217. + 
  218. +     &'add_log("user-defined command $cmd_name") if $'loglvl > 15;
  219. + 
  220. +     # Let's see if we already have loaded the perl script which is responsible
  221. +     # for implementing this command.
  222. +     local($path) = $Usercmd{$cmd_name};
  223. +     unless ($path) {
  224. +         &'add_log("ERROR unknown user-defined command $cmd_name") if $'loglvl;
  225. +         return 1;                    # Command failed (should not happen)
  226. +     }
  227. +     local($function) = $Run{$cmd_name};
  228. + 
  229. +     if (!$Loaded{$path}) {            # If implementation not loaded yet
  230. +         unless (open(PERL, $path)) {
  231. +             &'add_log("SYSERR open: $!") if $'loglvl;
  232. +             &'add_log("ERROR cannot load code for user-defined $cmd_name")
  233. +                 if $'loglvl;
  234. +             return 1;                # Command failed
  235. +         }
  236. +         local($/) = undef;
  237. +         local($body) = ' ' x (-s PERL);
  238. +         $body = <PERL>;                # Slurp whole file into pre-extended var
  239. +         close(PERL);
  240. +         local(@saved) = @INC;        # Save perl INC path (might be changed)
  241. +         unshift(@INC, $'privlib);    # Files first searched for in private lib
  242. +         eval $body;                    # Load code into memory
  243. +         @INC = @saved;                # Restore original require search path
  244. +         $Loaded{$path} = 1;            # Mark script as loaded
  245. + 
  246. +         if (chop($@)) {                # Script has an error
  247. +             &'add_log("ERROR in $path: $@") if $'loglvl;
  248. +             &'add_log("ERROR script for $cmd_name had an error") if $'loglvl;
  249. +             return 1;                # Command failed
  250. +         }
  251. + 
  252. +         # Make sure the script we just loaded defines the function we want
  253. +         local($defined) = 0;
  254. +         eval('$defined = 1 if defined &' . $function);
  255. +         unless ($defined) {
  256. +             &'add_log("ERROR script $path did not provide &$function")
  257. +                 if $'loglvl;
  258. +             return 1;                # Command failed
  259. +         }
  260. +     }
  261. + 
  262. +     # At this point, we know we have some code to call in order to run the
  263. +     # user-defined command. Prepare the special array @ARGV and initialize
  264. +     # the mailhook variable in the current package.
  265. +     &hook'initvar('newcmd');        # Initialize convenience variables
  266. +     local(@ARGV);                    # Argument vector for command
  267. +     require 'shellwords.pl';
  268. +     eval '@ARGV = &shellwords($cmd)';
  269. + 
  270. +     # We don't need to protect the following execution within an eval, since
  271. +     # we are currently inside one, via run_command.
  272. +     local($failed) = &$function($cmd);        # Call user-defined function
  273. + 
  274. +     # Propagate changes into global variables
  275. +     $'ever_saved = $ever_saved;
  276. +     $'cont = $cont;
  277. +     $'vacation = $vacation;
  278. +     $'lastcmd = $lastcmd;
  279. +     $'wmode = $wmode;
  280. + 
  281. +     # Log our action
  282. +     local($msg) = $failed ? "and failed" : "successfully";
  283. +     &'add_log("ran $cmd_name [$mfile] $msg") if $'loglvl > 6;
  284. + 
  285. +     $failed;            # Propagate failure status
  286. + }
  287. + 
  288. + package main;
  289. + 
  290.  
  291. Index: agent/pl/mailhook.pl
  292. Prereq: 2.9.1.1
  293. *** agent/pl/mailhook.pl.old    Mon Feb  1 10:24:37 1993
  294. --- agent/pl/mailhook.pl    Mon Feb  1 10:24:37 1993
  295. ***************
  296. *** 1,4 ****
  297. ! ;# $Id: mailhook.pl,v 2.9.1.1 92/08/26 13:16:58 ram Exp $
  298.   ;#
  299.   ;#  Copyright (c) 1992, Raphael Manfredi
  300.   ;#
  301. --- 1,4 ----
  302. ! ;# $Id: mailhook.pl,v 2.9.1.2 93/02/01 10:17:30 ram Exp $
  303.   ;#
  304.   ;#  Copyright (c) 1992, Raphael Manfredi
  305.   ;#
  306. ***************
  307. *** 6,11 ****
  308. --- 6,15 ----
  309.   ;#  Licence as specified in the README file that comes with dist.
  310.   ;#
  311.   ;# $Log:    mailhook.pl,v $
  312. + ;# Revision 2.9.1.2  93/02/01  10:17:30  ram
  313. + ;# patch17: special variables may now be initialized within various packages
  314. + ;# patch17: do not abort with fatal but with die (provision for new mailhooks)
  315. + ;# 
  316.   ;# Revision 2.9.1.1  92/08/26  13:16:58  ram
  317.   ;# patch8: created
  318.   ;# 
  319. ***************
  320. *** 21,41 ****
  321.   # does not have (usually) to do any parsing on the mail. Headers of the mail
  322.   # are available via the %header array and some special variables are set as
  323.   # conveniences.
  324. ! sub hook'initialize {
  325. !     *header = *main'Header;        # User may fetch headers via %header
  326. !     $sender = $header{'Sender'};
  327. !     $subject = $header{'Subject'};
  328. !     $precedence = $header{'Precedence'};
  329. !     $from = $header{'From'};
  330. !     $to = $header{'To'};
  331. !     $cc = $header{'Cc'};
  332. !     ($address, $friendly) = &'parse_address($from);
  333. !     $login = &'login_name($from);
  334. !     @to = split(/,/, $to);
  335. !     @cc = split(/,/, $to);
  336. !     # Leave only the address part in @to and @cc
  337. !     grep(($_ = (&'parse_address($_))[0], 0), @to);
  338. !     grep(($_ = (&'parse_address($_))[0], 0), @cc);
  339.   }
  340.   
  341.   # Load hook script and run it
  342. --- 25,52 ----
  343.   # does not have (usually) to do any parsing on the mail. Headers of the mail
  344.   # are available via the %header array and some special variables are set as
  345.   # conveniences.
  346. ! sub hook'initvar {
  347. !     local($package) = @_;        # Package into which variables should be set
  348. !     local($init) = &'q(<<'EOP');
  349. ! :    *header = *main'Header;        # User may fetch headers via %header
  350. ! :    $sender = $header{'Sender'};
  351. ! :    $subject = $header{'Subject'};
  352. ! :    $precedence = $header{'Precedence'};
  353. ! :    $from = $header{'From'};
  354. ! :    $to = $header{'To'};
  355. ! :    $cc = $header{'Cc'};
  356. ! :    ($address, $friendly) = &'parse_address($from);
  357. ! :    $login = &'login_name($from);
  358. ! :    @to = split(/,/, $to);
  359. ! :    @cc = split(/,/, $to);
  360. ! :    # Leave only the address part in @to and @cc
  361. ! :    grep(($_ = (&'parse_address($_))[0], 0), @to);
  362. ! :    grep(($_ = (&'parse_address($_))[0], 0), @cc);
  363. ! EOP
  364. !     eval(<<EOP);                # Initialize variables inside package
  365. !     package $package;
  366. !     $init
  367. ! EOP
  368.   }
  369.   
  370.   # Load hook script and run it
  371. ***************
  372. *** 50,56 ****
  373.       if (chop($@)) {
  374.           $@ =~ s/ in file \(eval\)//;
  375.           &'add_log("ERROR $@") if $'loglvl;
  376. !         &'fatal("$hook aborted");
  377.       }
  378.   }
  379.   
  380. --- 61,67 ----
  381.       if (chop($@)) {
  382.           $@ =~ s/ in file \(eval\)//;
  383.           &'add_log("ERROR $@") if $'loglvl;
  384. !         die("$hook aborted");
  385.       }
  386.   }
  387.   
  388.  
  389. Index: agent/test/misc/newcmd.t
  390. *** agent/test/misc/newcmd.t.old    Mon Feb  1 10:24:59 1993
  391. --- agent/test/misc/newcmd.t    Mon Feb  1 10:24:59 1993
  392. ***************
  393. *** 0 ****
  394. --- 1,68 ----
  395. + # Test user-defined commands
  396. + do '../pl/misc.pl';
  397. + unlink "$user", 'always', 'test';
  398. + 
  399. + &add_option("-o 'newcmd: ~/.newcmd'");
  400. + open(NEWCMD, '>.newcmd') || print "1\n";
  401. + print NEWCMD <<EOF || print "2\n";
  402. + FIRST_CMD ~/commands first
  403. + SECOND_CMD ~/commands second
  404. + THIRD_CMD ~/commands third
  405. + EOF
  406. + close NEWCMD || print "3\n";
  407. + 
  408. + open(COM, '>commands') || print "4\n";
  409. + print COM <<'EOC' || print "5\n";
  410. + sub first {
  411. +     &mailhook'third_cmd('test');    # Make sure interface function is there
  412. +     open(OUT, '>output1');
  413. +     print OUT join(' ', @ARGV), "\n";
  414. +     print OUT "$to\n";
  415. +     close OUT;
  416. +     0;
  417. + }
  418. + 
  419. + sub second {
  420. +     &main'add_log('second user-defined command ran ok');
  421. +     open(OUT, '>output2');
  422. +     print OUT "$from\n";
  423. +     print OUT "$header{'Date'}\n";
  424. +     close OUT;
  425. +     0;
  426. + }
  427. + 
  428. + sub third {
  429. +     local($cmd) = @_;
  430. +     local(@cmd) = split(' ', $cmd);
  431. +     open(TEST, ">$cmd[1]");
  432. +     print TEST "$cmd\n";
  433. +     close TEST;
  434. +     0;
  435. + }
  436. + EOC
  437. + close COM || print "6\n";
  438. + 
  439. + &add_header('X-Tag: newcmd');
  440. + `$cmd`;
  441. + $? == 0 || print "7\n";
  442. + -f "$user" && print "8\n";        # Haa defaulted to LEAVE -> something's wrong
  443. + -f 'output1' || print "9\n";
  444. + -f 'output2' || print "10\n";
  445. + -f 'test' || print "11\n";
  446. + 
  447. + chop($test = `cat test 2>/dev/null`);
  448. + $test eq 'third_cmd test' || print "12\n";
  449. + 
  450. + chop(@test = `cat output1 2>/dev/null`);
  451. + $test[0] eq 'FIRST_CMD arg1 arg2' || print "13\n";
  452. + $test[1] eq 'ram@eiffel.com' || print "14\n";
  453. + 
  454. + chop(@test = `cat output2 2>/dev/null`);
  455. + $test[0] eq 'compilers-request@iecc.cambridge.ma.us' || print "15\n";
  456. + $test[1] eq '3 Jul 92 00:43:22 EDT (Fri)' || print "16\n";
  457. + 
  458. + &get_log(17);
  459. + &check_log('second user-defined command ran ok', 18) == 1 || print "19\n";
  460. + 
  461. + unlink "$user", 'mail', 'test', 'output1', 'output2', 'commands', '.newcmd';
  462. + print "0\n";
  463.  
  464. Index: MANIFEST
  465. *** MANIFEST.old    Mon Feb  1 10:25:04 1993
  466. --- MANIFEST    Mon Feb  1 10:25:04 1993
  467. ***************
  468. *** 100,105 ****
  469. --- 100,106 ----
  470.   agent/pl/matching.pl       Matching routines used by filter
  471.   agent/pl/mbox.pl           Getting mails from a mailbox file
  472.   agent/pl/mmdf.pl           MMDF-style mailbox handling
  473. + agent/pl/newcmd.pl         Filter command extension driver
  474.   agent/pl/once.pl           Dealing with once commands
  475.   agent/pl/parse.pl          Perl library to parse a mail message
  476.   agent/pl/period.pl         Perl library to compute periods
  477. ***************
  478. *** 106,111 ****
  479. --- 107,113 ----
  480.   agent/pl/plsave.pl         Perl library to handle the plsave cache file
  481.   agent/pl/plural.pl         Perl library to pluralize words
  482.   agent/pl/pqueue.pl         Processing the queued mails
  483. + agent/pl/q.pl              Quote removal function
  484.   agent/pl/queue_mail.pl     Queuing mails
  485.   agent/pl/rangeargs.pl      Perl library to expand a list of patches
  486.   agent/pl/read_conf.pl      Perl library to read configuration file
  487. ***************
  488. *** 182,187 ****
  489. --- 184,190 ----
  490.   agent/test/mail                The mail used by testing routines
  491.   agent/test/misc/compress.t     Folder compression checks
  492.   agent/test/misc/mmdf.t         MMDF-style mailbox checks
  493. + agent/test/misc/newcmd.t       Filter command extension tests
  494.   agent/test/option/             Tests the options to the mailagent program
  495.   agent/test/option/L.t          Test -L option
  496.   agent/test/option/V.t          Test -V option
  497. ***************
  498. *** 204,209 ****
  499. --- 207,213 ----
  500.   agent/test/pl/init.pl          Variable initializations
  501.   agent/test/pl/logfile.pl       Logging file checking
  502.   agent/test/pl/mail.pl          Modifies mail components
  503. + agent/test/pl/misc.pl          Set up for miscellaneous tests
  504.   agent/test/rules               Rules used by filtering tests
  505.   bin/perload                The dataloading/autoloading perl translator
  506.   config.h.SH                Produces config.h
  507.  
  508. Index: agent/pl/filter.pl
  509. Prereq: 2.9.1.6
  510. *** agent/pl/filter.pl.old    Mon Feb  1 10:24:26 1993
  511. --- agent/pl/filter.pl    Mon Feb  1 10:24:27 1993
  512. ***************
  513. *** 1,4 ****
  514. ! ;# $Id: filter.pl,v 2.9.1.6 93/01/12 13:13:12 ram Exp $
  515.   ;#
  516.   ;#  Copyright (c) 1992, Raphael Manfredi
  517.   ;#
  518. --- 1,4 ----
  519. ! ;# $Id: filter.pl,v 2.9.1.7 93/02/01 10:10:24 ram Exp $
  520.   ;#
  521.   ;#  Copyright (c) 1992, Raphael Manfredi
  522.   ;#
  523. ***************
  524. *** 6,11 ****
  525. --- 6,15 ----
  526.   ;#  Licence as specified in the README file that comes with dist.
  527.   ;#
  528.   ;# $Log:    filter.pl,v $
  529. + ;# Revision 2.9.1.7  93/02/01  10:10:24  ram
  530. + ;# patch17: NOTIFY now accepts a list of addresses instead of just one
  531. + ;# patch17: file inclusion to load addresses now available with NOTIFY
  532. + ;# 
  533.   ;# Revision 2.9.1.6  93/01/12  13:13:12  ram
  534.   ;# patch15: undocumented feature commented (WRITE may allow hooks)
  535.   ;# 
  536. ***************
  537. *** 151,162 ****
  538.   
  539.   # Run the NOTIFY command
  540.   sub run_notify {
  541. !     local($address, $msg) = $cmd =~ m|^\w+\s+(\S+)\s+(\S+)|;
  542.       $msg =~ s/~/$cf'home/g;                    # ~ substitution
  543. !     local($failed) = do notify($msg, $address);
  544.       unless ($failed) {
  545.           $msg =~ s|^$cf'home|~|;                # Replace the home directory by ~
  546. !         do add_log("NOTIFIED $msg for [$mfile]") if $loglvl > 2;
  547.       }
  548.       $failed;
  549.   }
  550. --- 155,169 ----
  551.   
  552.   # Run the NOTIFY command
  553.   sub run_notify {
  554. !     local($args) = $cmd =~ m|^\w+\s+(.*)|;
  555. !     local(@args) = split(' ', $args);
  556. !     local($msg) = pop(@args);                # Last argument is message text
  557.       $msg =~ s/~/$cf'home/g;                    # ~ substitution
  558. !     local($address) = join(' ', @args);        # Address list
  559. !     local($failed) = ¬ify($msg, $address);
  560.       unless ($failed) {
  561.           $msg =~ s|^$cf'home|~|;                # Replace the home directory by ~
  562. !         &add_log("NOTIFIED $msg [$mfile] to $addresses") if $loglvl > 2;
  563.       }
  564.       $failed;
  565.   }
  566.  
  567. Index: agent/pl/analyze.pl
  568. Prereq: 2.9.1.5
  569. *** agent/pl/analyze.pl.old    Mon Feb  1 10:24:22 1993
  570. --- agent/pl/analyze.pl    Mon Feb  1 10:24:23 1993
  571. ***************
  572. *** 1,4 ****
  573. ! ;# $Id: analyze.pl,v 2.9.1.5 92/12/01 09:18:49 ram Exp $
  574.   ;#
  575.   ;#  Copyright (c) 1992, Raphael Manfredi
  576.   ;#
  577. --- 1,4 ----
  578. ! ;# $Id: analyze.pl,v 2.9.1.6 93/02/01 10:09:21 ram Exp $
  579.   ;#
  580.   ;#  Copyright (c) 1992, Raphael Manfredi
  581.   ;#
  582. ***************
  583. *** 6,11 ****
  584. --- 6,15 ----
  585.   ;#  Licence as specified in the README file that comes with dist.
  586.   ;#
  587.   ;# $Log:    analyze.pl,v $
  588. + ;# Revision 2.9.1.6  93/02/01  10:09:21  ram
  589. + ;# patch17: now recognizes 'mailer-agent' as a special address
  590. + ;# patch17: logging of sender now focuses only on address part
  591. + ;# 
  592.   ;# Revision 2.9.1.5  92/12/01  09:18:49  ram
  593.   ;# patch13: fixed mode selection pattern (no brace allowed)
  594.   ;# 
  595. ***************
  596. *** 42,47 ****
  597. --- 46,52 ----
  598.           'newsmaster', 1,        # My convention for news administrator--RAM
  599.           'usenet', 1,            # Aka newsmaster
  600.           'mailer-daemon', 1,        # Sendmail
  601. +         'mailer-agent', 1,        # NeXT mailer
  602.           'nobody', 1                # Nobody we've heard of
  603.       );
  604.   }
  605. ***************
  606. *** 332,339 ****
  607.       local($sender) = $Header{'Sender'};
  608.       local($from) = $Header{'From'};
  609.       &add_log("FROM $from");
  610. !     &add_log("VIA $sender")
  611. !         if $sender ne '' && $sender ne (&parse_address($from))[0];
  612.       if ($subject ne '') {
  613.           if ($subject =~ s/^Re:\s*//) {
  614.               &add_log("REPLY $subject");
  615. --- 337,344 ----
  616.       local($sender) = $Header{'Sender'};
  617.       local($from) = $Header{'From'};
  618.       &add_log("FROM $from");
  619. !     &add_log("VIA $sender") if $sender ne '' &&
  620. !         (&parse_address($sender))[0] ne (&parse_address($from))[0];
  621.       if ($subject ne '') {
  622.           if ($subject =~ s/^Re:\s*//) {
  623.               &add_log("REPLY $subject");
  624.  
  625. Index: agent/files/mailagent.cf
  626. Prereq: 2.9.1.2
  627. *** agent/files/mailagent.cf.old    Mon Feb  1 10:23:54 1993
  628. --- agent/files/mailagent.cf    Mon Feb  1 10:23:54 1993
  629. ***************
  630. *** 2,8 ****
  631.   # Configuration file for mailagent
  632.   #
  633.   
  634. ! # $Id: mailagent.cf,v 2.9.1.2 93/01/12 12:07:32 ram Exp $
  635.   #
  636.   #  Copyright (c) 1991, Raphael Manfredi
  637.   #
  638. --- 2,8 ----
  639.   # Configuration file for mailagent
  640.   #
  641.   
  642. ! # $Id: mailagent.cf,v 2.9.1.3 93/02/01 09:53:44 ram Exp $
  643.   #
  644.   #  Copyright (c) 1991, Raphael Manfredi
  645.   #
  646. ***************
  647. *** 10,15 ****
  648. --- 10,19 ----
  649.   #  Licence as specified in the README file that comes with dist.
  650.   #
  651.   # $Log:    mailagent.cf,v $
  652. + # Revision 2.9.1.3  93/02/01  09:53:44  ram
  653. + # patch17: new optional parameter 'newcmd'
  654. + # patch17: both 'compress' and 'newcmd' under same "optional" section
  655. + # 
  656.   # Revision 2.9.1.2  93/01/12  12:07:32  ram
  657.   # patch15: new parameters: nfslock, mmdf, mmdfbox and compress
  658.   # 
  659. ***************
  660. *** 68,74 ****
  661.   mailbox  : $user                # Mailbox file name (optional)
  662.   mmdf     : OFF                    # Allow MMDF-style mailbox delivery
  663.   mmdfbox  : OFF                    # Force new folders to MMDF format
  664. ! compress : ~/.compress            # Folder compression list (optional)
  665.   
  666.   # Database hashing directory (in $spool) and other controls
  667.   hash     : dbr                    # Hashing directory
  668. --- 72,81 ----
  669.   mailbox  : $user                # Mailbox file name (optional)
  670.   mmdf     : OFF                    # Allow MMDF-style mailbox delivery
  671.   mmdfbox  : OFF                    # Force new folders to MMDF format
  672. ! 
  673. ! # Optional parameters (for experts...)
  674. ! #compress : ~/.compress            # Folder compression list
  675. ! #newcmd   : $spool/newcmd        # Definition of new filtering commands
  676.   
  677.   # Database hashing directory (in $spool) and other controls
  678.   hash     : dbr                    # Hashing directory
  679.  
  680. Index: agent/pl/hook.pl
  681. Prereq: 2.9.1.1
  682. *** agent/pl/hook.pl.old    Mon Feb  1 10:24:32 1993
  683. --- agent/pl/hook.pl    Mon Feb  1 10:24:32 1993
  684. ***************
  685. *** 1,4 ****
  686. ! ;# $Id: hook.pl,v 2.9.1.1 92/08/26 13:14:05 ram Exp $
  687.   ;#
  688.   ;#  Copyright (c) 1992, Raphael Manfredi
  689.   ;#
  690. --- 1,4 ----
  691. ! ;# $Id: hook.pl,v 2.9.1.2 93/02/01 10:15:59 ram Exp $
  692.   ;#
  693.   ;#  Copyright (c) 1992, Raphael Manfredi
  694.   ;#
  695. ***************
  696. *** 6,11 ****
  697. --- 6,14 ----
  698.   ;#  Licence as specified in the README file that comes with dist.
  699.   ;#
  700.   ;# $Log:    hook.pl,v $
  701. + ;# Revision 2.9.1.2  93/02/01  10:15:59  ram
  702. + ;# patch17: special variables are now initialized by &initvar
  703. + ;# 
  704.   ;# Revision 2.9.1.1  92/08/26  13:14:05  ram
  705.   ;# patch8: created
  706.   ;# 
  707. ***************
  708. *** 131,137 ****
  709.       local($mail, $hook) = @_;
  710.       &'add_log("hook is an audit script") if $'loglvl > 17;
  711.       &'parse_mail($mail);        # Fill in %Header
  712. !     &initialize;                # Initialize special variables
  713.       &run($hook);                # Load hook and run it
  714.   }
  715.   
  716. --- 134,140 ----
  717.       local($mail, $hook) = @_;
  718.       &'add_log("hook is an audit script") if $'loglvl > 17;
  719.       &'parse_mail($mail);        # Fill in %Header
  720. !     &initvar('mailhook');        # Initialize special variables
  721.       &run($hook);                # Load hook and run it
  722.   }
  723.   
  724. ***************
  725. *** 151,157 ****
  726.           &'fatal("cannot deliver to hook");
  727.       }
  728.       if (0 == $pid) {            # Child process
  729. !         &initialize;            # Initialize special variables
  730.           &run($hook);            # Load hook and run it
  731.           exit 0;                    # Everything went well
  732.       }
  733. --- 154,160 ----
  734.           &'fatal("cannot deliver to hook");
  735.       }
  736.       if (0 == $pid) {            # Child process
  737. !         &initvar('mailhook');    # Initialize special variables
  738.           &run($hook);            # Load hook and run it
  739.           exit 0;                    # Everything went well
  740.       }
  741.  
  742. Index: agent/test/misc/compress.t
  743. *** agent/test/misc/compress.t.old    Mon Feb  1 10:24:54 1993
  744. --- agent/test/misc/compress.t    Mon Feb  1 10:24:55 1993
  745. ***************
  746. *** 0 ****
  747. --- 1,45 ----
  748. + # Test compression feature
  749. + do '../pl/misc.pl';
  750. + unlink "$user.Z", 'always';
  751. + 
  752. + # Look whether compress is available. If not, do not perform this test.
  753. + `compress mail`;
  754. + `uncompress mail` if $? == 0 && -f mail.Z;
  755. + if ($? != 0) {        # No compress available in path, sorry
  756. +     print "-1\n";    # Do not perform any tests
  757. +     exit 0;
  758. + }
  759. + 
  760. + &add_option("-o 'compress: ~/.compress'");
  761. + open(COMPRESS, '>.compress') || print "1\n";
  762. + print COMPRESS <<EOF || print "2\n";
  763. + a[lm]*
  764. + $user
  765. + EOF
  766. + close COMPRESS || print "3\n";
  767. + 
  768. + &add_header('X-Tag: compress');
  769. + `$cmd`;
  770. + $? == 0 || print "4\n";
  771. + -f "$user" && print "5\n";        # Should be compressed
  772. + -f "$user.Z" || print "6\n";
  773. + -f 'always' && print "7\n";        # Should also be compressed
  774. + -f 'always.Z' || print "8\n";
  775. + -f 'another' || print "9\n";    # This one is not compressed
  776. + -f 'another.Z' && print "10\n";
  777. + $msize = -s "$user.Z";
  778. + 
  779. + `cp $user.Z $user >/dev/null 2>&1`;
  780. + `$cmd`;
  781. + $? == 0 || print "11\n";
  782. + -f "$user" || print "12\n";        # Should be not be recompressed
  783. + -f "$user.Z" || print "13\n";    # Should still be there
  784. + -f 'always' && print "14\n";    # Should also be compressed
  785. + -f 'always.Z' || print "15\n";
  786. + -f 'another' || print "16\n";    # This one is not compressed
  787. + -f 'another.Z' && print "17\n";
  788. + (-s $user != $msize) || print "18\n";        # Mail saved there
  789. + (-s "$user.Z" == $msize) || print "19\n";    # This one left undisturbed
  790. + 
  791. + unlink "$user", "$user.Z", 'always', 'always.Z', 'another', 'mail', '.compress';
  792. + print "0\n";
  793.  
  794. Index: agent/filter/parser.c
  795. Prereq: 2.9.1.3
  796. *** agent/filter/parser.c.old    Mon Feb  1 10:23:57 1993
  797. --- agent/filter/parser.c    Mon Feb  1 10:23:58 1993
  798. ***************
  799. *** 11,17 ****
  800.   */
  801.   
  802.   /*
  803. !  * $Id: parser.c,v 2.9.1.3 92/12/01 09:13:21 ram Exp $
  804.    *
  805.    *  Copyright (c) 1992, Raphael Manfredi
  806.    *
  807. --- 11,17 ----
  808.   */
  809.   
  810.   /*
  811. !  * $Id: parser.c,v 2.9.1.4 93/02/01 09:54:21 ram Exp $
  812.    *
  813.    *  Copyright (c) 1992, Raphael Manfredi
  814.    *
  815. ***************
  816. *** 19,24 ****
  817. --- 19,27 ----
  818.    *  Licence as specified in the README file that comes with dist.
  819.    *
  820.    * $Log:    parser.c,v $
  821. +  * Revision 2.9.1.4  93/02/01  09:54:21  ram
  822. +  * patch17: configuration variables may now have '-' in them
  823. +  * 
  824.    * Revision 2.9.1.3  92/12/01  09:13:21  ram
  825.    * patch13: removed spurious inclusion of <sys/types.h>
  826.    * 
  827. ***************
  828. *** 395,402 ****
  829.           return;                            /* Ignore it */
  830.   
  831.       while (*nptr++ = *path) {            /* Copy everything until non alphanum */
  832. !         if (*path == '_') {                /* '_' is valid in variable names */
  833. !             path++;                        /* But is not an alphanumeric char */
  834.               continue;
  835.           } else if (!isalnum(*path++))    /* Reached a non-alphanumeric char */
  836.               break;                        /* We got variable name */
  837. --- 398,406 ----
  838.           return;                            /* Ignore it */
  839.   
  840.       while (*nptr++ = *path) {            /* Copy everything until non alphanum */
  841. !         if (*path == '_' || *path == '-') {
  842. !             /* Valid variable characters, although not 'isalnum' */
  843. !             path++;
  844.               continue;
  845.           } else if (!isalnum(*path++))    /* Reached a non-alphanumeric char */
  846.               break;                        /* We got variable name */
  847.  
  848. Index: agent/pl/history.pl
  849. Prereq: 2.9.1.2
  850. *** agent/pl/history.pl.old    Mon Feb  1 10:24:29 1993
  851. --- agent/pl/history.pl    Mon Feb  1 10:24:30 1993
  852. ***************
  853. *** 1,4 ****
  854. ! ;# $Id: history.pl,v 2.9.1.2 92/11/01 15:50:23 ram Exp $
  855.   ;#
  856.   ;#  Copyright (c) 1992, Raphael Manfredi
  857.   ;#
  858. --- 1,4 ----
  859. ! ;# $Id: history.pl,v 2.9.1.3 93/02/01 10:15:29 ram Exp $
  860.   ;#
  861.   ;#  Copyright (c) 1992, Raphael Manfredi
  862.   ;#
  863. ***************
  864. *** 6,11 ****
  865. --- 6,14 ----
  866.   ;#  Licence as specified in the README file that comes with dist.
  867.   ;#
  868.   ;# $Log:    history.pl,v $
  869. + ;# Revision 2.9.1.3  93/02/01  10:15:29  ram
  870. + ;# patch17: updated comment
  871. + ;# 
  872.   ;# Revision 2.9.1.2  92/11/01  15:50:23  ram
  873.   ;# patch11: now recognizes '(a)' for '@' in a message ID (X-400 gateways)
  874.   ;# 
  875. ***************
  876. *** 20,26 ****
  877.   ;# Each message-id tag is stored in a file, along with a time-stamp (to enable
  878.   ;# its removal after a given period.
  879.   ;#
  880. ! # Record message whose message ID is given as argument and return 0 if the
  881.   # message was recorded for the first time or if there is no valid message ID.
  882.   # Return 1 if the message was already recorded, and hence was already seen.
  883.   sub history_record {
  884. --- 23,29 ----
  885.   ;# Each message-id tag is stored in a file, along with a time-stamp (to enable
  886.   ;# its removal after a given period.
  887.   ;#
  888. ! # Record the message ID of the current message and return 0 if the
  889.   # message was recorded for the first time or if there is no valid message ID.
  890.   # Return 1 if the message was already recorded, and hence was already seen.
  891.   sub history_record {
  892.  
  893. Index: agent/pl/interface.pl
  894. Prereq: 2.9.1.3
  895. *** agent/pl/interface.pl.old    Mon Feb  1 10:24:34 1993
  896. --- agent/pl/interface.pl    Mon Feb  1 10:24:35 1993
  897. ***************
  898. *** 1,4 ****
  899. ! ;# $Id: interface.pl,v 2.9.1.3 92/11/10 10:14:02 ram Exp $
  900.   ;#
  901.   ;#  Copyright (c) 1992, Raphael Manfredi
  902.   ;#
  903. --- 1,4 ----
  904. ! ;# $Id: interface.pl,v 2.9.1.4 93/02/01 10:16:29 ram Exp $
  905.   ;#
  906.   ;#  Copyright (c) 1992, Raphael Manfredi
  907.   ;#
  908. ***************
  909. *** 6,11 ****
  910. --- 6,14 ----
  911.   ;#  Licence as specified in the README file that comes with dist.
  912.   ;#
  913.   ;# $Log:    interface.pl,v $
  914. + ;# Revision 2.9.1.4  93/02/01  10:16:29  ram
  915. + ;# patch17: new &add routine to dynamically build a perl interface
  916. + ;# 
  917.   ;# Revision 2.9.1.3  92/11/10  10:14:02  ram
  918.   ;# patch12: perl command interface changed to return boolean success
  919.   ;# 
  920. ***************
  921. *** 144,149 ****
  922.       return 1 unless $'Filter{$fun};
  923.       0;
  924.   }
  925. !     
  926.   package main;
  927.   
  928. --- 147,166 ----
  929.       return 1 unless $'Filter{$fun};
  930.       0;
  931.   }
  932. ! 
  933. ! # Add a new interface function for user-defined commands
  934. ! sub add {
  935. !     local($cmd) = @_;            # Command name
  936. !     $cmd =~ tr/A-Z/a-z/;        # Cannonicalize to lower case
  937. !     eval &'q(<<EOP);            # Compile new mailhook perl interface function
  938. ! :    sub mailhook'$cmd { &interface'dispatch; }
  939. ! EOP
  940. !     if (chop($@)) {
  941. !         &'add_log("ERROR while adding 'sub $cmd': $@") if $'loglvl;
  942. !         &'add_log("WARNING cannot use '&$cmd' in perl hooks")
  943. !             if $'loglvl > 5;
  944. !     }
  945. ! }
  946. ! 
  947.   package main;
  948.   
  949.  
  950. Index: agent/pl/rfc822.pl
  951. Prereq: 2.9.1.2
  952. *** agent/pl/rfc822.pl.old    Mon Feb  1 10:24:46 1993
  953. --- agent/pl/rfc822.pl    Mon Feb  1 10:24:46 1993
  954. ***************
  955. *** 1,4 ****
  956. ! ;# $Id: rfc822.pl,v 2.9.1.2 92/12/01 09:27:19 ram Exp $
  957.   ;#
  958.   ;#  Copyright (c) 1992, Raphael Manfredi
  959.   ;#
  960. --- 1,4 ----
  961. ! ;# $Id: rfc822.pl,v 2.9.1.3 93/01/19 17:44:03 ram Exp $
  962.   ;#
  963.   ;#  Copyright (c) 1992, Raphael Manfredi
  964.   ;#
  965. ***************
  966. *** 6,11 ****
  967. --- 6,14 ----
  968.   ;#  Licence as specified in the README file that comes with dist.
  969.   ;#
  970.   ;# $Log:    rfc822.pl,v $
  971. + ;# Revision 2.9.1.3  93/01/19  17:44:03  ram
  972. + ;# patch17: now recognizes bogus addresses like '<address> (comment)'
  973. + ;# 
  974.   ;# Revision 2.9.1.2  92/12/01  09:27:19  ram
  975.   ;# patch13: added internet info extraction out of e-mail address
  976.   ;# 
  977. ***************
  978. *** 28,34 ****
  979.       local($comment);
  980.       local($internet);
  981.       if (/^\s*(\S+)\s+\((.*)\)/) {        # address (comment) 
  982. !         ($1, $2);
  983.       } elsif (/^\s*(.*)\s+<(\S+)>/) {    # comment <address>
  984.           $comment = $1;
  985.           $internet = $2;
  986. --- 31,40 ----
  987.       local($comment);
  988.       local($internet);
  989.       if (/^\s*(\S+)\s+\((.*)\)/) {        # address (comment) 
  990. !         $comment = $2;
  991. !         $internet = $1;
  992. !         $internet =~ s/^<(\S+)>/$1/;    # was <address> (comment)
  993. !         ($internet, $comment);
  994.       } elsif (/^\s*(.*)\s+<(\S+)>/) {    # comment <address>
  995.           $comment = $1;
  996.           $internet = $2;
  997.  
  998. Index: agent/examples/rules
  999. *** agent/examples/rules.old    Mon Feb  1 10:23:51 1993
  1000. --- agent/examples/rules    Mon Feb  1 10:23:52 1993
  1001. ***************
  1002. *** 143,148 ****
  1003. --- 143,174 ----
  1004.       system,
  1005.       unknown-user    { SAVE admin };
  1006.   
  1007. + # Mail about the mailagent (sometimes called mail filter, hence the double
  1008. + # pattern) is handled specially. I have a special pattern file held in
  1009. + # ~/mail/auto-msg/agent.key. Every message which is NOT a reply and has one
  1010. + # of those patterns in its body will be automatically replied to, once a week,
  1011. + # by sending the message held in ~/mail/auto-msg/agent.msg. In order for me
  1012. + # to know that this message has been already "replied-to", I annotate it.
  1013. + # Ultimately, the message is dropped in a dedicated folder.
  1014. + 
  1015. + Subject:
  1016. +     /mail\s*agent/i,
  1017. +     /mail\s*filter/i        { BEGIN AGENT; REJECT };
  1018. + <AGENT>
  1019. +     Subject: !/^Re:/,
  1020. +     Body: "~/mail/auto-msg/agent.key"
  1021. +         {
  1022. +             ONCE (%r, agent, 1w) REJECT AGENT_MSG;
  1023. +             SAVE agent;
  1024. +         };
  1025. + <AGENT_MSG>
  1026. +         {
  1027. +             MESSAGE ~/mail/auto-msg/agent.msg;
  1028. +             ANNOTATE Auto-Replied: %r;
  1029. +             SAVE agent;
  1030. +         };
  1031. + <AGENT> { SAVE agent };
  1032. + 
  1033.   # Here, I am detecting mails sent by someone at ISE, i.e. mails with the
  1034.   # domain name ``eiffel.com'' appended or simply mails with no domain name.
  1035.   # I also turn off vacation messages, for when I am away, people at ISE usually
  1036.  
  1037. Index: agent/mhook.SH
  1038. Prereq: 2.9.1.2
  1039. *** agent/mhook.SH.old    Mon Feb  1 10:24:14 1993
  1040. --- agent/mhook.SH    Mon Feb  1 10:24:14 1993
  1041. ***************
  1042. *** 22,28 ****
  1043.   # via the filter. Mine looks like this:
  1044.   #   "|exec /users/ram/mail/filter >>/users/ram/.bak 2>&1"
  1045.   
  1046. ! # $Id: mhook.SH,v 2.9.1.2 93/01/12 12:09:20 ram Exp $
  1047.   #
  1048.   #  Copyright (c) 1991, 1992, Raphael Manfredi
  1049.   #
  1050. --- 22,28 ----
  1051.   # via the filter. Mine looks like this:
  1052.   #   "|exec /users/ram/mail/filter >>/users/ram/.bak 2>&1"
  1053.   
  1054. ! # $Id: mhook.SH,v 2.9.1.3 93/02/01 10:05:35 ram Exp $
  1055.   #
  1056.   #  Copyright (c) 1991, 1992, Raphael Manfredi
  1057.   #
  1058. ***************
  1059. *** 30,35 ****
  1060. --- 30,38 ----
  1061.   #  Licence as specified in the README file that comes with dist.
  1062.   #
  1063.   # $Log:    mhook.SH,v $
  1064. + # Revision 2.9.1.3  93/02/01  10:05:35  ram
  1065. + # patch17: added new file pl/q.pl for quotations
  1066. + # 
  1067.   # Revision 2.9.1.2  93/01/12  12:09:20  ram
  1068.   # patch15: leading perl start up is now configured
  1069.   # 
  1070. ***************
  1071. *** 142,146 ****
  1072. --- 145,150 ----
  1073.   $grep -v '^;#' pl/header.pl >>mhook
  1074.   $grep -v '^;#' pl/rfc822.pl >>mhook
  1075.   $grep -v '^;#' pl/extern.pl >>mhook
  1076. + $grep -v '^;#' pl/q.pl >>mhook
  1077.   chmod 755 mhook
  1078.   $eunicefix mhook
  1079.  
  1080. Index: agent/test/misc/mmdf.t
  1081. *** agent/test/misc/mmdf.t.old    Mon Feb  1 10:24:56 1993
  1082. --- agent/test/misc/mmdf.t    Mon Feb  1 10:24:57 1993
  1083. ***************
  1084. *** 0 ****
  1085. --- 1,37 ----
  1086. + # Test MMDF-style mailboxes
  1087. + do '../pl/misc.pl';
  1088. + unlink "$user", 'always';
  1089. + 
  1090. + &add_option("-o 'mmdf: ON' -o 'mmdfbox: OFF'");
  1091. + &add_header('X-Tag: mmdf');
  1092. + `$cmd`;
  1093. + $? == 0 || print "1\n";
  1094. + -f "$user" || print "2\n";
  1095. + -f 'always' || print "3\n";
  1096. + 
  1097. + sub has_ctrl {
  1098. +     local($file) = @_;
  1099. +     open(FILE, $file) || return 0;
  1100. +     local($count) = 0;
  1101. +     local($_);
  1102. +     while (<FILE>) {
  1103. +         $count++ if /^\01\01\01\01$/;
  1104. +     }
  1105. +     $count;
  1106. + }
  1107. + 
  1108. + &has_ctrl($user) == 0 || print "4\n";
  1109. + &has_ctrl('always') == 0 || print "5\n";
  1110. + 
  1111. + $cmd =~ s/mmdfbox: OFF/mmdfbox: ON/ || print "6\n";
  1112. + unlink 'always';
  1113. + `$cmd`;
  1114. + $? == 0 || print "7\n";
  1115. + -f "$user" || print "8\n";
  1116. + -f 'always' || print "9\n";
  1117. + 
  1118. + &has_ctrl($user) == 0 || print "10\n";
  1119. + &has_ctrl('always') == 4 || print "11\n";
  1120. + 
  1121. + unlink $user, 'always', 'mail';
  1122. + print "0\n";
  1123.  
  1124. Index: agent/pl/q.pl
  1125. *** agent/pl/q.pl.old    Mon Feb  1 10:24:43 1993
  1126. --- agent/pl/q.pl    Mon Feb  1 10:24:44 1993
  1127. ***************
  1128. *** 0 ****
  1129. --- 1,22 ----
  1130. + ;# $Id: q.pl,v 2.9.1.1 93/02/01 10:21:44 ram Exp $
  1131. + ;#
  1132. + ;#  Copyright (c) 1993, Raphael Manfredi
  1133. + ;#
  1134. + ;#  You may redistribute only under the terms of the GNU General Public
  1135. + ;#  Licence as specified in the README file that comes with dist.
  1136. + ;#
  1137. + ;# $Log:    q.pl,v $
  1138. + ;# Revision 2.9.1.1  93/02/01  10:21:44  ram
  1139. + ;# patch17: created
  1140. + ;# 
  1141. + ;# Revision 2.9  92/07/14  16:50:18  ram
  1142. + ;# 3.0 beta baseline.
  1143. + ;# 
  1144. + # Quotation removal routine
  1145. + sub q {
  1146. +     local($_) = @_;
  1147. +     local($*) = 1;
  1148. +     s/^://g;
  1149. +     $_;
  1150. + }
  1151. + 
  1152.  
  1153. Index: README
  1154. *** README.old    Mon Feb  1 10:23:49 1993
  1155. --- README    Mon Feb  1 10:23:49 1993
  1156. ***************
  1157. *** 1,6 ****
  1158.                              mailagent 2.9
  1159.   
  1160. !               Copyright (c) 1990-1992, Raphael Manfredi
  1161.   
  1162.   ------------------------------------------------------------------------
  1163.       This program is free software; you can redistribute it and/or modify
  1164. --- 1,6 ----
  1165.                              mailagent 2.9
  1166.   
  1167. !               Copyright (c) 1990-1993, Raphael Manfredi
  1168.   
  1169.   ------------------------------------------------------------------------
  1170.       This program is free software; you can redistribute it and/or modify
  1171.  
  1172. Index: agent/test/TEST
  1173. *** agent/test/TEST.old    Mon Feb  1 10:24:49 1993
  1174. --- agent/test/TEST    Mon Feb  1 10:24:49 1993
  1175. ***************
  1176. *** 11,17 ****
  1177.   $ENV{'PWD'} = $pwd;
  1178.   $ENV{'LEVEL'} = 0;            # Default loglvl for filter and cmd tests
  1179.   
  1180. ! @tests = ('basic', 'option', 'filter', 'cmd');
  1181.   $failed = 0;
  1182.   $how_many = 0;
  1183.   
  1184. --- 11,17 ----
  1185.   $ENV{'PWD'} = $pwd;
  1186.   $ENV{'LEVEL'} = 0;            # Default loglvl for filter and cmd tests
  1187.   
  1188. ! @tests = ('basic', 'option', 'filter', 'cmd', 'misc');
  1189.   $failed = 0;
  1190.   $how_many = 0;
  1191.   
  1192.  
  1193. Index: agent/test/actions
  1194. *** agent/test/actions.old    Mon Feb  1 10:24:52 1993
  1195. --- agent/test/actions    Mon Feb  1 10:24:52 1993
  1196. ***************
  1197. *** 210,212 ****
  1198. --- 210,215 ----
  1199.   X-Tag: /write #1/    { WRITE mbox };
  1200.   X-Tag: /write #2/    { WRITE path/another/third/mbox };
  1201.   
  1202. + X-Tag: /compress/    { LEAVE; SAVE always; SAVE another };
  1203. + X-Tag: /mmdf/        { LEAVE; SAVE always; SAVE always };
  1204. + X-Tag: /newcmd/        { FIRST_CMD arg1 arg2; SECOND_CMD; DELETE };
  1205.  
  1206. Index: agent/test/pl/misc.pl
  1207. *** agent/test/pl/misc.pl.old    Mon Feb  1 10:25:01 1993
  1208. --- agent/test/pl/misc.pl    Mon Feb  1 10:25:01 1993
  1209. ***************
  1210. *** 0 ****
  1211. --- 1,10 ----
  1212. + # Common actions at the top of each misc test
  1213. + do '../pl/cmd.pl';
  1214. + 
  1215. + # Add option to command string held in $cmd
  1216. + sub add_option {
  1217. +     local($opt) = @_;
  1218. +     local(@cmd) = split(' ', $cmd);
  1219. +     $cmd = join(' ', $cmd[0], $opt, @cmd[1..$#cmd]);
  1220. + }
  1221. + 
  1222.  
  1223. *** End of Patch 18 ***
  1224.  
  1225. exit 0 # Just in case...
  1226.