home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #27 / NN_1992_27.iso / spool / comp / sources / misc / 4112 < prev    next >
Encoding:
Text File  |  1992-11-20  |  54.3 KB  |  1,666 lines

  1. Newsgroups: comp.sources.misc
  2. Path: sparky!kent
  3. From: ram@eiffel.com (Raphael Manfredi)
  4. Subject:  v33i107:  mailagent - Rule Based Mail Filtering, Part15/17
  5. Message-ID: <1992Nov20.231151.27892@sparky.imd.sterling.com>
  6. Followup-To: comp.sources.d
  7. X-Md4-Signature: eb42251cefa5883e149313e85289360d
  8. Sender: kent@sparky.imd.sterling.com (Kent Landfield)
  9. Organization: Sterling Software
  10. References: <csm-v33i093=mailagent.230117@sparky.IMD.Sterling.COM>
  11. Date: Fri, 20 Nov 1992 23:11:51 GMT
  12. Approved: kent@sparky.imd.sterling.com
  13. Lines: 1651
  14.  
  15. Submitted-by: ram@eiffel.com (Raphael Manfredi)
  16. Posting-number: Volume 33, Issue 107
  17. Archive-name: mailagent/part15
  18. Environment: Perl, Sendmail, UNIX
  19.  
  20. #! /bin/sh
  21. # This is a shell archive.  Remove anything before this line, then feed it
  22. # into a shell via "sh file" or similar.  To overwrite existing files,
  23. # type "sh file -c".
  24. # Contents:  agent/Jmakefile agent/examples/README agent/files/README
  25. #   agent/filter/README agent/filter/hash.h agent/filter/msg.c
  26. #   agent/filter/portable.h agent/filter/user.c agent/mailhelp.SH
  27. #   agent/pl/acs_rqst.pl agent/pl/history.pl agent/pl/mailhook.pl
  28. #   agent/pl/once.pl agent/pl/period.pl agent/pl/rfc822.pl
  29. #   agent/pl/unpack.pl agent/test/basic/config.t
  30. #   agent/test/basic/mailagent.t agent/test/cmd/assign.t
  31. #   agent/test/cmd/once.t agent/test/cmd/record.t
  32. #   agent/test/cmd/unique.t agent/test/cmd/write.t agent/test/mail
  33. #   agent/test/option/s.t
  34. # Wrapped by kent@sparky on Wed Nov 18 22:42:32 1992
  35. PATH=/bin:/usr/bin:/usr/ucb:/usr/local/bin:/usr/lbin ; export PATH
  36. echo If this archive is complete, you will see the following message:
  37. echo '          "shar: End of archive 15 (of 17)."'
  38. if test -f 'agent/Jmakefile' -a "${1}" != "-c" ; then 
  39.   echo shar: Will not clobber existing file \"'agent/Jmakefile'\"
  40. else
  41.   echo shar: Extracting \"'agent/Jmakefile'\" \(1541 characters\)
  42.   sed "s/^X//" >'agent/Jmakefile' <<'END_OF_FILE'
  43. X/*
  44. X * Jmakefile for mailagent
  45. X */
  46. X
  47. X;# $Id: Jmakefile,v 2.9.1.2 92/08/26 12:33:22 ram Exp $
  48. X;#
  49. X;#  Copyright (c) 1991, Raphael Manfredi
  50. X;#
  51. X;#  You may redistribute only under the terms of the GNU General Public
  52. X;#  Licence as specified in the README file that comes with dist.
  53. X;#
  54. X;# $Log:    Jmakefile,v $
  55. X;# Revision 2.9.1.2  92/08/26  12:33:22  ram
  56. X;# patch8: new mailhook target, installed in private library directory
  57. X;# 
  58. X;# Revision 2.9.1.1  92/08/12  21:27:08  ram
  59. X;# patch6: mailagent is now built with offset table (perload -o)
  60. X;# 
  61. X;# Revision 2.9  92/07/14  16:47:06  ram
  62. X;# 3.0 beta baseline.
  63. X;# 
  64. X
  65. XBIN = mailpatch mailhelp maillist maildist
  66. X
  67. XNoManPages()
  68. XShellScriptTarget($(BIN))
  69. XSimpleShellScriptTarget(magent)
  70. XSimpleShellScriptTarget(mhook)
  71. X
  72. X/* The mailagent itself is derived from 'magent' through perload, hence
  73. X * making the program more efficient (the whole script need not be compiled
  74. X * by perl). Idem for mailhook.
  75. X */
  76. X
  77. XAllTarget(mailagent)
  78. Xmailagent: magent
  79. X    $(TOP)/bin/perload -o magent > $@
  80. X    chmod +rx $@
  81. X
  82. XAllTarget(mailhook)
  83. Xmailhook: mhook
  84. X    $(TOP)/bin/perload -o mhook > $@
  85. X    chmod +rx $@
  86. X
  87. X/* The mailagent carries some machine-dependant parts (for file locking)
  88. X * so it is a binary, not a script (viz it may not be shared accross
  89. X * different architectures).
  90. X */
  91. X
  92. X>BINDIR
  93. XInstallScript(mailagent,$(BINDIR))
  94. X
  95. XSetSubdirs(files filter man test)
  96. XDependDirs(filter)
  97. X
  98. X>PRIVLIB    /* Force metaconfig to ask for privlib location */
  99. X
  100. XMakeInstallDirectories($(PRIVLIB))
  101. XInstallMultipleDestFlags(install,mailhook,$(PRIVLIB),-m 555)
  102. END_OF_FILE
  103.   if test 1541 -ne `wc -c <'agent/Jmakefile'`; then
  104.     echo shar: \"'agent/Jmakefile'\" unpacked with wrong size!
  105.   fi
  106.   # end of 'agent/Jmakefile'
  107. fi
  108. if test -f 'agent/examples/README' -a "${1}" != "-c" ; then 
  109.   echo shar: Will not clobber existing file \"'agent/examples/README'\"
  110. else
  111.   echo shar: Extracting \"'agent/examples/README'\" \(1409 characters\)
  112.   sed "s/^X//" >'agent/examples/README' <<'END_OF_FILE'
  113. XThis directory contains examples of rule files for the mailagent and
  114. Xother aspects from my own environment.
  115. X
  116. Xdaemon:
  117. X    A small rule file which basically simulates the behaviour of the
  118. X    vacation program (except that vacation messages are sent every day,
  119. X    not once).
  120. X
  121. Xmailfolders:
  122. X    This file is a copy of my ~/.mailfolders. It lists all the folders or
  123. X    directories where the filter drops its incoming mail (appart from my
  124. X    system mailbox, which is implicetely included). This file is used by
  125. X    my ~/.profile to compute a suitable MAILPATH value (a colon separated
  126. X    list of files ksh should monitor for new mail). It is also used by the
  127. X    mchk script.
  128. X
  129. Xmchk:
  130. X    Check all the folders for new mail.
  131. X
  132. Xmhinc:
  133. X    This script incorporates the filtered mails or news into the
  134. X    corresponding MH folder.
  135. X    
  136. Xnocmds:
  137. X    A copy of my ~/tmp/nocmds file, which will be mailed back to anybody
  138. X    who sends me a Command mail, except when sent by myself.
  139. X
  140. Xprofile:
  141. X    An excerpt from my ~/.profile file where the mail related variables
  142. X    are set. I am using ksh, but some plain sh also handle those variables,
  143. X    which is why it is not in a ~/.kshrc.
  144. X
  145. Xrules:
  146. X    The rule file I am currently using as of today, June 30th 1992. It is
  147. X    a good example of what can be done, although it is far from using all
  148. X    the available features. Heavily commented.
  149. X
  150. Xvacation:
  151. X    A generic vacation message held in ~/.vacation. It shows typical macro
  152. X    substitutions.
  153. X
  154. END_OF_FILE
  155.   if test 1409 -ne `wc -c <'agent/examples/README'`; then
  156.     echo shar: \"'agent/examples/README'\" unpacked with wrong size!
  157.   fi
  158.   # end of 'agent/examples/README'
  159. fi
  160. if test -f 'agent/files/README' -a "${1}" != "-c" ; then 
  161.   echo shar: Will not clobber existing file \"'agent/files/README'\"
  162. else
  163.   echo shar: Extracting \"'agent/files/README'\" \(1362 characters\)
  164.   sed "s/^X//" >'agent/files/README' <<'END_OF_FILE'
  165. XThis directory holds the shell version of the filter, and some other
  166. Xsample files which will be installed in the public mailagent directory.
  167. X
  168. Xagenthelp:
  169. X    The generic help message used by the @SH mailhelp command. You may
  170. X    of course rewrite this completely to fit your taste.
  171. X
  172. Xchkagent.sh:
  173. X    A small script I am using to monitor the whole mailagent installation.
  174. X    This is run by cron every night, and mails me problems logged in the
  175. X    log file, or unusual messages from my ~/.bak, etc...
  176. X    (The name chkagent.sh was chosen to leave room for the RCS ,v extension
  177. X    on some old systems with 14 characters limit in the file names.)
  178. X    Here is my crontab entry:
  179. X
  180. X        # Check the mailagent log file for the current day
  181. X        55 23 * * *        $HOME/etc/checkagent
  182. X
  183. Xcommands:
  184. X    This file holds the allowed commands for @SH hooks.
  185. X
  186. Xdistribs:
  187. X    A description table which states where each program is located,
  188. X    whether it is archived or not, or has patches, etc... This is
  189. X    used by the @SH commands.
  190. X
  191. Xfilter.sh:
  192. X    The shell version of the filter program. Note that this script is
  193. X    not tested by the automatic regression tests and needs some tailoring
  194. X    before it can be used. It is provided only as a guideline for people
  195. X    who cannot use the C version.
  196. X
  197. Xmailagent.cf:
  198. X    A template for your ~/.mailagent.
  199. X
  200. Xproglist:
  201. X    A list of program description which will be used by the 'maillist'
  202. X    command.
  203. X
  204. END_OF_FILE
  205.   if test 1362 -ne `wc -c <'agent/files/README'`; then
  206.     echo shar: \"'agent/files/README'\" unpacked with wrong size!
  207.   fi
  208.   # end of 'agent/files/README'
  209. fi
  210. if test -f 'agent/filter/README' -a "${1}" != "-c" ; then 
  211.   echo shar: Will not clobber existing file \"'agent/filter/README'\"
  212. else
  213.   echo shar: Extracting \"'agent/filter/README'\" \(2156 characters\)
  214.   sed "s/^X//" >'agent/filter/README' <<'END_OF_FILE'
  215. XThis is the root directory for the C filter.
  216. X
  217. XUsing the C version of the filter instead of the shell version is up to you.
  218. XThis is not really a filter in the common sense, because it does not actually
  219. Xfilter anything based on the contents of your mails. It only distills your
  220. Xincoming mail into the mailagent's queue, avoiding the spawning of multiple
  221. Xperl processes which are resource consuming.
  222. X
  223. XI had to write a C version for the filter because I was loosing some mail on
  224. Xmy machine when I used the shell script. This occurred seldom, but still...
  225. XThe reason was due to the delivery mode at our site. We get our mail from a
  226. Xuucp feed. Once in a while, 20 or more mails were delivered at the same time,
  227. Xand the shell script was not fast enough, and sendmail + filter were eating
  228. Xall my system's resources.
  229. X
  230. XThis program was written in two days, in self defense, when I decided I could
  231. Xnot afford seeing my precious mail sweeping into /dev/null any longer. It
  232. Xmight not be as portable as I wanted it too.
  233. X
  234. XIf you have an internet connection and receive only a small amount of mail
  235. Xat a time, or if you have NFS mounted mailboxes, then the shell script filter
  236. Xmay well be the winner.
  237. X
  238. XIn case you are lucky enough to have a uucp connection *and* NFS mounted
  239. Xmailboxes where you may receive mail on multiple machines :-), then you may
  240. Xrun into difficulties while setting up your .forward. The best thing to do is
  241. Xto have the filter executable installed at the same location on all the
  242. Xmachines, say in /usr/local/bin/filter.
  243. X
  244. XIf your sendmail does not always set the uid correctly before invoking the
  245. Xmailer specified in the .forward, then you will have to use the C filter and
  246. Xmake a local copy with the setuid bit set. This is yet another reason for me
  247. Xto use this program on my MIPS workstation, grrr...
  248. X
  249. XThe C filter pays attention to more variables in the ~/.mailagent than the
  250. Xshell script one, mainly to ensure a proper PATH variable. Also note that
  251. Xthe algorithms used by the two programs are completely different. Despite the
  252. Xfact it was written in a hurry, I believe it is a little safer than its shell
  253. Xcounterpart. At least it is *much* faster.
  254. X
  255. END_OF_FILE
  256.   if test 2156 -ne `wc -c <'agent/filter/README'`; then
  257.     echo shar: \"'agent/filter/README'\" unpacked with wrong size!
  258.   fi
  259.   # end of 'agent/filter/README'
  260. fi
  261. if test -f 'agent/filter/hash.h' -a "${1}" != "-c" ; then 
  262.   echo shar: Will not clobber existing file \"'agent/filter/hash.h'\"
  263. else
  264.   echo shar: Extracting \"'agent/filter/hash.h'\" \(1733 characters\)
  265.   sed "s/^X//" >'agent/filter/hash.h' <<'END_OF_FILE'
  266. X/*
  267. X
  268. X #    #    ##     ####   #    #          #    #
  269. X #    #   #  #   #       #    #          #    #
  270. X ######  #    #   ####   ######          ######
  271. X #    #  ######       #  #    #   ###    #    #
  272. X #    #  #    #  #    #  #    #   ###    #    #
  273. X #    #  #    #   ####   #    #   ###    #    #
  274. X
  275. X    Declarations for hash table.
  276. X*/
  277. X
  278. X/*
  279. X * $Id: hash.h,v 2.9 92/07/14 16:48:11 ram Exp $
  280. X *
  281. X *  Copyright (c) 1992, Raphael Manfredi
  282. X *
  283. X *  You may redistribute only under the terms of the GNU General Public
  284. X *  Licence as specified in the README file that comes with dist.
  285. X *
  286. X * $Log:    hash.h,v $
  287. X * Revision 2.9  92/07/14  16:48:11  ram
  288. X * 3.0 beta baseline.
  289. X * 
  290. X */
  291. X
  292. X#ifndef _hash_h
  293. X#define _hash_h
  294. X
  295. X/* Structure which describes the hash table: array of keys and array of
  296. X * values, along with the table's size and the number of recorded elements.
  297. X */
  298. Xstruct htable {
  299. X    int32 h_size;        /* Size of table (prime number) */
  300. X    int32 h_items;        /* Number of items recorded in table */
  301. X    char **h_keys;        /* Array of keys (strings) */
  302. X    int h_pos;            /* Last position in table (iterations) */
  303. X    char **h_values;    /* Array of values (strings) */
  304. X};
  305. X
  306. X/* Function declaration */
  307. Xextern int ht_create();                /* Create H table */
  308. Xextern char *ht_value();            /* Get value given some key */
  309. Xextern char *ht_put();                /* Insert value in H table */
  310. Xextern char *ht_force();            /* Like ht_put, but replace old value */
  311. Xextern int ht_xtend();                /* Extend size of full H table */
  312. Xextern int ht_start();                /* Start iteration over H table */
  313. Xextern int ht_next();                /* Go to next item in H table */
  314. Xextern char *ht_ckey();                /* Fetch current key */
  315. Xextern char *ht_cvalue();            /* Fetch current value */
  316. Xextern int ht_count();                /* Number of items in H table */
  317. X
  318. X#endif
  319. END_OF_FILE
  320.   if test 1733 -ne `wc -c <'agent/filter/hash.h'`; then
  321.     echo shar: \"'agent/filter/hash.h'\" unpacked with wrong size!
  322.   fi
  323.   # end of 'agent/filter/hash.h'
  324. fi
  325. if test -f 'agent/filter/msg.c' -a "${1}" != "-c" ; then 
  326.   echo shar: Will not clobber existing file \"'agent/filter/msg.c'\"
  327. else
  328.   echo shar: Extracting \"'agent/filter/msg.c'\" \(1707 characters\)
  329.   sed "s/^X//" >'agent/filter/msg.c' <<'END_OF_FILE'
  330. X/*
  331. X
  332. X #    #   ####    ####            ####
  333. X ##  ##  #       #    #          #    #
  334. X # ## #   ####   #               #
  335. X #    #       #  #  ###   ###    #
  336. X #    #  #    #  #    #   ###    #    #
  337. X #    #   ####    ####    ###     ####
  338. X
  339. X    Fatal messages.
  340. X*/
  341. X
  342. X/*
  343. X * $Id: msg.c,v 2.9 92/07/14 16:48:32 ram Exp $
  344. X *
  345. X *  Copyright (c) 1992, Raphael Manfredi
  346. X *
  347. X *  You may redistribute only under the terms of the GNU General Public
  348. X *  Licence as specified in the README file that comes with dist.
  349. X *
  350. X * $Log:    msg.c,v $
  351. X * Revision 2.9  92/07/14  16:48:32  ram
  352. X * 3.0 beta baseline.
  353. X * 
  354. X */
  355. X
  356. X#include "config.h"
  357. X#include "portable.h"
  358. X#include <stdio.h>
  359. X#include <sys/types.h>
  360. X#include "sysexits.h"
  361. X#include "logfile.h"
  362. X#include "lock.h"
  363. X#include "io.h"
  364. X
  365. X#define MAX_STRING    1024        /* Maximum length for error string */
  366. X
  367. X/* VARARGS2 */
  368. Xpublic void fatal(reason, arg1, arg2, arg3, arg4, arg5)
  369. Xchar *reason;
  370. Xint arg1, arg2, arg3, arg4, arg5;
  371. X{
  372. X    /* Fatal error -- die with a meaningful error status for sendmail. If the
  373. X     * logfile has been opened, the reason will also be logged there.
  374. X     */
  375. X    char buffer[MAX_STRING];
  376. X    int status;                        /* Status from emergency_save() */
  377. X    
  378. X    status = emergency_save();        /* Attempt emergency saving */
  379. X
  380. X    fprintf(stderr, "%s: ", progname);
  381. X    fprintf(stderr, reason, arg1, arg2, arg3, arg4, arg5);
  382. X    fputc('\n', stderr);
  383. X    sprintf(buffer, "FATAL %s", reason);
  384. X    add_log(1, buffer, arg1, arg2, arg3, arg4, arg5);
  385. X    release_lock();
  386. X
  387. X    if (!was_queued()) {
  388. X        add_log(6, "NOTICE leaving mail in MTA's queue");
  389. X        exit(EX_TEMPFAIL);
  390. X    } else if (status == -1) {
  391. X        add_log(5, "WARNING no saving was ever done");
  392. X        add_log(6, "NOTICE leaving mail in MTA's queue");
  393. X        exit(EX_TEMPFAIL);
  394. X    }
  395. X
  396. X    exit(EX_OK);
  397. X}
  398. X
  399. END_OF_FILE
  400.   if test 1707 -ne `wc -c <'agent/filter/msg.c'`; then
  401.     echo shar: \"'agent/filter/msg.c'\" unpacked with wrong size!
  402.   fi
  403.   # end of 'agent/filter/msg.c'
  404. fi
  405. if test -f 'agent/filter/portable.h' -a "${1}" != "-c" ; then 
  406.   echo shar: Will not clobber existing file \"'agent/filter/portable.h'\"
  407. else
  408.   echo shar: Extracting \"'agent/filter/portable.h'\" \(1377 characters\)
  409.   sed "s/^X//" >'agent/filter/portable.h' <<'END_OF_FILE'
  410. X/*
  411. X
  412. X #####    ####   #####    #####    ##    #####   #       ######          #    #
  413. X #    #  #    #  #    #     #     #  #   #    #  #       #               #    #
  414. X #    #  #    #  #    #     #    #    #  #####   #       #####           ######
  415. X #####   #    #  #####      #    ######  #    #  #       #        ###    #    #
  416. X #       #    #  #   #      #    #    #  #    #  #       #        ###    #    #
  417. X #        ####   #    #     #    #    #  #####   ######  ######   ###    #    #
  418. X
  419. X    Some portable declarations.
  420. X*/
  421. X
  422. X/*
  423. X * $Id: portable.h,v 2.9 92/07/14 16:48:41 ram Exp $
  424. X *
  425. X *  Copyright (c) 1992, Raphael Manfredi
  426. X *
  427. X *  You may redistribute only under the terms of the GNU General Public
  428. X *  Licence as specified in the README file that comes with dist.
  429. X *
  430. X * $Log:    portable.h,v $
  431. X * Revision 2.9  92/07/14  16:48:41  ram
  432. X * 3.0 beta baseline.
  433. X * 
  434. X */
  435. X
  436. X#ifndef _portable_h_
  437. X#define _portable_h_
  438. X
  439. X/*
  440. X * Standard types
  441. X */
  442. X#if INTSIZE < 4
  443. Xtypedef int int16;
  444. Xtypedef long int32;
  445. Xtypedef unsigned int uint16;
  446. Xtypedef unsigned long uint32;
  447. X#else
  448. Xtypedef short int16;
  449. Xtypedef int int32;
  450. Xtypedef unsigned short uint16;
  451. Xtypedef unsigned int uint32;
  452. X#endif
  453. X
  454. X/*
  455. X * Scope control pseudo-keywords
  456. X */
  457. X#define public                /* default C scope */
  458. X#define private static        /* static outside a block means private */
  459. X#define shared                /* data shared between modules, but not public */
  460. X
  461. X#endif
  462. END_OF_FILE
  463.   if test 1377 -ne `wc -c <'agent/filter/portable.h'`; then
  464.     echo shar: \"'agent/filter/portable.h'\" unpacked with wrong size!
  465.   fi
  466.   # end of 'agent/filter/portable.h'
  467. fi
  468. if test -f 'agent/filter/user.c' -a "${1}" != "-c" ; then 
  469.   echo shar: Will not clobber existing file \"'agent/filter/user.c'\"
  470. else
  471.   echo shar: Extracting \"'agent/filter/user.c'\" \(1665 characters\)
  472.   sed "s/^X//" >'agent/filter/user.c' <<'END_OF_FILE'
  473. X/*
  474. X
  475. X #    #   ####   ######  #####            ####
  476. X #    #  #       #       #    #          #    #
  477. X #    #   ####   #####   #    #          #
  478. X #    #       #  #       #####    ###    #
  479. X #    #  #    #  #       #   #    ###    #    #
  480. X  ####    ####   ######  #    #   ###     ####
  481. X
  482. X    Compute user login name.
  483. X*/
  484. X
  485. X/*
  486. X * $Id: user.c,v 2.9 92/07/14 16:48:46 ram Exp $
  487. X *
  488. X *  Copyright (c) 1992, Raphael Manfredi
  489. X *
  490. X *  You may redistribute only under the terms of the GNU General Public
  491. X *  Licence as specified in the README file that comes with dist.
  492. X *
  493. X * $Log:    user.c,v $
  494. X * Revision 2.9  92/07/14  16:48:46  ram
  495. X * 3.0 beta baseline.
  496. X * 
  497. X */
  498. X
  499. X#include "config.h"
  500. X#include "portable.h"
  501. X#include <sys/types.h>                    /* For uid_t */
  502. X#include <pwd.h>
  503. X
  504. X#ifdef I_STRING
  505. X#include <string.h>
  506. X#else
  507. X#include <strings.h>
  508. X#endif
  509. X
  510. X#define LOGIN_LEN    8                    /* Maximum login name length */
  511. X
  512. Xextern struct passwd *getpwuid();        /* Get password entry for UID */
  513. Xextern Uid_t geteuid();                    /* Effective user UID */
  514. X
  515. Xpublic char *logname()
  516. X{
  517. X    /* Return pointer to static data holding the user login name. Note that we
  518. X     * look-up in /etc/passwd. Hence, if the user has duplicate entries in the
  519. X     * file, the first one will be reported. This may or may not bother you.
  520. X     * NB: we use the *effective* user ID, not the real one.
  521. X     */
  522. X    
  523. X    static char login[LOGIN_LEN + 1];    /* Where login name is stored */
  524. X    struct passwd *pw;                    /* Pointer to password entry */
  525. X
  526. X    pw = getpwuid(geteuid());            /* Get first entry matching UID */
  527. X    if (pw == (struct passwd *) 0)
  528. X        return (char *) 0;                /* User not found */
  529. X
  530. X    strncpy(login, pw->pw_name, LOGIN_LEN);
  531. X    login[LOGIN_LEN] = '\0';
  532. X
  533. X    return login;
  534. X}
  535. X
  536. END_OF_FILE
  537.   if test 1665 -ne `wc -c <'agent/filter/user.c'`; then
  538.     echo shar: \"'agent/filter/user.c'\" unpacked with wrong size!
  539.   fi
  540.   # end of 'agent/filter/user.c'
  541. fi
  542. if test -f 'agent/mailhelp.SH' -a "${1}" != "-c" ; then 
  543.   echo shar: Will not clobber existing file \"'agent/mailhelp.SH'\"
  544. else
  545.   echo shar: Extracting \"'agent/mailhelp.SH'\" \(2102 characters\)
  546.   sed "s/^X//" >'agent/mailhelp.SH' <<'END_OF_FILE'
  547. Xcase $CONFIG in
  548. X'')
  549. X    if test ! -f config.sh; then
  550. X        ln ../config.sh . || \
  551. X        ln ../../config.sh . || \
  552. X        ln ../../../config.sh . || \
  553. X        (echo "Can't find config.sh."; exit 1)
  554. X    fi 2>/dev/null
  555. X    . config.sh
  556. X    ;;
  557. Xesac
  558. Xcase "$0" in
  559. X*/*) cd `expr X$0 : 'X\(.*\)/'` ;;
  560. Xesac
  561. Xecho "Extracting agent/mailhelp (with variable substitutions)"
  562. X$spitshell >mailhelp <<!GROK!THIS!
  563. X# feed this into perl
  564. X    eval "exec perl -S \$0 \$*"
  565. X        if \$running_under_some_shell;
  566. X
  567. X# $Id: mailhelp.SH,v 2.9 92/07/14 16:48:54 ram Exp $
  568. X#
  569. X#  Copyright (c) 1991, 1992, Raphael Manfredi
  570. X#
  571. X#  You may redistribute only under the terms of the GNU General Public
  572. X#  Licence as specified in the README file that comes with dist.
  573. X#
  574. X# $Log:    mailhelp.SH,v $
  575. X# Revision 2.9  92/07/14  16:48:54  ram
  576. X# 3.0 beta baseline.
  577. X# 
  578. X
  579. X\$mversion = '$VERSION';
  580. X\$patchlevel = '$PATCHLEVEL';
  581. X!GROK!THIS!
  582. X
  583. X$spitshell >>mailhelp <<'!NO!SUBS!'
  584. X
  585. X$prog_name = $0;                # Who I am
  586. X$prog_name =~ s|^.*/(.*)|$1|;    # Keep only base name
  587. X
  588. Xdo read_config();    # First, read configuration file (in ~/.mailagent)
  589. X
  590. X# take job number and command from environment
  591. X# (passed by mailagent)
  592. X$jobnum = $ENV{'jobnum'};
  593. X$fullcmd = $ENV{'fullcmd'};
  594. X
  595. X$dest=shift;                            # Who should the help be sent to
  596. X$dest = $ENV{'path'} if $dest eq '';    # If dest was ommitted
  597. X
  598. X# A single '-' as first argument stands for return path
  599. X$dest = $ENV{'path'} if $dest eq '-';
  600. X
  601. Xopen(HELP, "$cf'spool/agenthelp") || do fatal("no help file!\n");
  602. Xopen(MAILER, "|/usr/lib/sendmail -odq -t");
  603. Xprint MAILER
  604. X"To: $dest
  605. XSubject: How to use my mail agent
  606. XX-Mailer: mailagent [version $mversion PL$patchlevel]
  607. X
  608. X";
  609. Xwhile (<HELP>) {
  610. X    # Replace some tokens by parameters
  611. X    s/=DEST=/$dest/g;
  612. X    s/=MAXSIZE=/$cf'maxsize/g;
  613. X    print MAILER;
  614. X}
  615. Xprint MAILER
  616. X"
  617. X-- $prog_name speaking for $cf'user
  618. X";
  619. Xclose MAILER;
  620. Xif ($?) {
  621. X    do add_log("ERROR couldn't send help to $dest") if $loglvl > 0;
  622. X} else {
  623. X    do add_log("SENT help to $dest") if $loglvl > 2;
  624. X}
  625. Xclose HELP;
  626. X
  627. X!NO!SUBS!
  628. X$grep -v '^;#' pl/fatal.pl >>mailhelp
  629. X$grep -v '^;#' pl/add_log.pl >>mailhelp
  630. X$grep -v '^;#' pl/read_conf.pl >>mailhelp
  631. Xchmod 755 mailhelp
  632. X$eunicefix mailhelp
  633. END_OF_FILE
  634.   if test 2102 -ne `wc -c <'agent/mailhelp.SH'`; then
  635.     echo shar: \"'agent/mailhelp.SH'\" unpacked with wrong size!
  636.   fi
  637.   chmod +x 'agent/mailhelp.SH'
  638.   # end of 'agent/mailhelp.SH'
  639. fi
  640. if test -f 'agent/pl/acs_rqst.pl' -a "${1}" != "-c" ; then 
  641.   echo shar: Will not clobber existing file \"'agent/pl/acs_rqst.pl'\"
  642. else
  643.   echo shar: Extracting \"'agent/pl/acs_rqst.pl'\" \(1490 characters\)
  644.   sed "s/^X//" >'agent/pl/acs_rqst.pl' <<'END_OF_FILE'
  645. X;# $Id: acs_rqst.pl,v 2.9 92/07/14 16:49:28 ram Exp $
  646. X;#
  647. X;#  Copyright (c) 1991, Raphael Manfredi
  648. X;#
  649. X;#  You may redistribute only under the terms of the GNU General Public
  650. X;#  Licence as specified in the README file that comes with dist.
  651. X;#
  652. X;# $Log:    acs_rqst.pl,v $
  653. X;# Revision 2.9  92/07/14  16:49:28  ram
  654. X;# 3.0 beta baseline.
  655. X;# 
  656. X;#
  657. X# Asks for the exclusive access of a file
  658. X# The given parameter (let's say F) is the absolute path
  659. X# of the file we want to access. The routine checks for the
  660. X# presence of F.lock. If it exists, it sleeps 1 second and tries
  661. X# again. After 10 trys, it reports failure by returning -1.
  662. X# Otherwise, file F.lock is created and the pid of the current
  663. X# process is written. It is checked afterwards.
  664. Xsub acs_rqst {
  665. X    local($file) = @_;    # file to be locked
  666. X    local($max) = 10;    # max number of attempts
  667. X    local($mask);        # to save old umask
  668. X    while ($max) {
  669. X        $max--;
  670. X        if (-f "$file.lock") {
  671. X            sleep(2);    # busy: wait
  672. X            next;
  673. X        }
  674. X        # Attempt to create lock
  675. X        $mask = umask(0333);            # no write permission
  676. X        if (open(FILE, ">$file.lock")) {
  677. X            print FILE "$$\n";            # write pid
  678. X            close FILE;
  679. X            umask($mask);                # restore old umask
  680. X            # Check lock
  681. X            open(FILE, "$file.lock");
  682. X            $_ = <FILE>;                # read contents
  683. X            close FILE;
  684. X            last if int($_) == $$;        # lock is ok
  685. X        } else {
  686. X            umask($mask);                # restore old umask
  687. X            sleep(2);                    # busy: wait
  688. X        }
  689. X    }
  690. X    if ($max) {
  691. X        $result = 0;    # ok
  692. X    } else {
  693. X        $result = -1;    # could not lock
  694. X    }
  695. X    $result;            # return status
  696. X}
  697. X
  698. END_OF_FILE
  699.   if test 1490 -ne `wc -c <'agent/pl/acs_rqst.pl'`; then
  700.     echo shar: \"'agent/pl/acs_rqst.pl'\" unpacked with wrong size!
  701.   fi
  702.   # end of 'agent/pl/acs_rqst.pl'
  703. fi
  704. if test -f 'agent/pl/history.pl' -a "${1}" != "-c" ; then 
  705.   echo shar: Will not clobber existing file \"'agent/pl/history.pl'\"
  706. else
  707.   echo shar: Extracting \"'agent/pl/history.pl'\" \(2538 characters\)
  708.   sed "s/^X//" >'agent/pl/history.pl' <<'END_OF_FILE'
  709. X;# $Id: history.pl,v 2.9.1.2 92/11/01 15:50:23 ram Exp $
  710. X;#
  711. X;#  Copyright (c) 1992, Raphael Manfredi
  712. X;#
  713. X;#  You may redistribute only under the terms of the GNU General Public
  714. X;#  Licence as specified in the README file that comes with dist.
  715. X;#
  716. X;# $Log:    history.pl,v $
  717. X;# Revision 2.9.1.2  92/11/01  15:50:23  ram
  718. X;# patch11: now recognizes '(a)' for '@' in a message ID (X-400 gateways)
  719. X;# 
  720. X;# Revision 2.9.1.1  92/08/26  13:13:35  ram
  721. X;# patch8: rewrote computation of message ID when absent from mail
  722. X;# 
  723. X;# Revision 2.9  92/07/14  16:50:08  ram
  724. X;# 3.0 beta baseline.
  725. X;# 
  726. X;# 
  727. X;# Handle the message history mechanism, which is used to reject duplicates.
  728. X;# Each message-id tag is stored in a file, along with a time-stamp (to enable
  729. X;# its removal after a given period.
  730. X;#
  731. X# Record message whose message ID is given as argument and return 0 if the
  732. X# message was recorded for the first time or if there is no valid message ID.
  733. X# Return 1 if the message was already recorded, and hence was already seen.
  734. Xsub history_record {
  735. X    local($msg_id) = $Header{'Message-Id'};        # Message-ID header
  736. X
  737. X    # If there is no message ID, use the concatenation of date + from fields.
  738. X    if ($msg_id) {
  739. X        # Keep only the ID stored within <> brackets
  740. X        ($msg_id) = $msg_id =~ m|^<(.*)>\s*$|;
  741. X    } else {
  742. X        # Use date + from iff there is a date. We cannot use the from field
  743. X        # alone, obviously!! We also have to ensure there is an '@' in the
  744. X        # message id, which is the case unless the address is in uucp form.
  745. X        $msg_id = $Header{'Date'};
  746. X        local($from, $comment) = &parse_address($Header{'From'});
  747. X        $from =~ s/^([\w-.]+)!([\w-.]+)/@$1:$2/;    # host!user -> @host:user
  748. X        $msg_id .= '.' . $from if $msg_id;
  749. X    }
  750. X    $msg_id =~ s/\s+/./g;            # Suppress all spaces
  751. X    $msg_id =~ s/\(a\)/@/;            # X-400 gateways sometimes use (a) for @
  752. X    return 0 unless $msg_id;        # Cannot record message without an ID
  753. X
  754. X    # Hashing of the message ID is done based on the two first letters of
  755. X    # the host name (assuming message ID has the form whatever@host).
  756. X    local($stamp, $host) = $msg_id =~ m|^(.*)@([.\w]+)|;
  757. X    unless ($stamp) {
  758. X        &add_log("WARNING incorrect message ID <$msg_id>") if $loglvl > 5;
  759. X        return 0;                    # Cannot record message if invalid ID
  760. X    }
  761. X
  762. X    local($time, $line) = &dbr'info($host, 'HISTORY', $stamp);
  763. X    return 0 if $time == -1;                # An error occurred
  764. X    if ($time > 0) {                        # Message already recorded
  765. X        &add_log("history duplicate <$msg_id>") if $loglvl > 6;
  766. X        return 1;
  767. X    }
  768. X    &dbr'update($host, 'HISTORY', 0, $stamp);    # Record message (appending)
  769. X    0;            # First time ever seen
  770. X}
  771. X
  772. END_OF_FILE
  773.   if test 2538 -ne `wc -c <'agent/pl/history.pl'`; then
  774.     echo shar: \"'agent/pl/history.pl'\" unpacked with wrong size!
  775.   fi
  776.   # end of 'agent/pl/history.pl'
  777. fi
  778. if test -f 'agent/pl/mailhook.pl' -a "${1}" != "-c" ; then 
  779.   echo shar: Will not clobber existing file \"'agent/pl/mailhook.pl'\"
  780. else
  781.   echo shar: Extracting \"'agent/pl/mailhook.pl'\" \(1687 characters\)
  782.   sed "s/^X//" >'agent/pl/mailhook.pl' <<'END_OF_FILE'
  783. X;# $Id: mailhook.pl,v 2.9.1.1 92/08/26 13:16:58 ram Exp $
  784. X;#
  785. X;#  Copyright (c) 1992, Raphael Manfredi
  786. X;#
  787. X;#  You may redistribute only under the terms of the GNU General Public
  788. X;#  Licence as specified in the README file that comes with dist.
  789. X;#
  790. X;# $Log:    mailhook.pl,v $
  791. X;# Revision 2.9.1.1  92/08/26  13:16:58  ram
  792. X;# patch8: created
  793. X;# 
  794. X;# 
  795. X#
  796. X# Various hook utilities
  797. X# (name in package hook, compiled in package mailhook)
  798. X#
  799. X
  800. Xpackage mailhook;
  801. X
  802. X# Parse mail and initialize special variables. The perl script used as hook
  803. X# does not have (usually) to do any parsing on the mail. Headers of the mail
  804. X# are available via the %header array and some special variables are set as
  805. X# conveniences.
  806. Xsub hook'initialize {
  807. X    *header = *main'Header;        # User may fetch headers via %header
  808. X    $sender = $header{'Sender'};
  809. X    $subject = $header{'Subject'};
  810. X    $precedence = $header{'Precedence'};
  811. X    $from = $header{'From'};
  812. X    $to = $header{'To'};
  813. X    $cc = $header{'Cc'};
  814. X    ($address, $friendly) = &'parse_address($from);
  815. X    $login = &'login_name($from);
  816. X    @to = split(/,/, $to);
  817. X    @cc = split(/,/, $to);
  818. X    # Leave only the address part in @to and @cc
  819. X    grep(($_ = (&'parse_address($_))[0], 0), @to);
  820. X    grep(($_ = (&'parse_address($_))[0], 0), @cc);
  821. X}
  822. X
  823. X# Load hook script and run it
  824. Xsub hook'run {
  825. X    local($hook) = @_;
  826. X    open(HOOK, $hook) || &'fatal("cannot open $hook: $!");
  827. X    local($/) = undef;
  828. X    local($body) = <HOOK>;        # Slurp whole file
  829. X    close(HOOK);
  830. X    unshift(@INC, $'privlib);    # Files first searched for in mailagent's lib
  831. X    eval $body;                    # Load, compile and execute within mailhook
  832. X    if (chop($@)) {
  833. X        $@ =~ s/ in file \(eval\)//;
  834. X        &'add_log("ERROR $@") if $'loglvl;
  835. X        &'fatal("$hook aborted");
  836. X    }
  837. X}
  838. X
  839. Xpackage main;
  840. X
  841. END_OF_FILE
  842.   if test 1687 -ne `wc -c <'agent/pl/mailhook.pl'`; then
  843.     echo shar: \"'agent/pl/mailhook.pl'\" unpacked with wrong size!
  844.   fi
  845.   # end of 'agent/pl/mailhook.pl'
  846. fi
  847. if test -f 'agent/pl/once.pl' -a "${1}" != "-c" ; then 
  848.   echo shar: Will not clobber existing file \"'agent/pl/once.pl'\"
  849. else
  850.   echo shar: Extracting \"'agent/pl/once.pl'\" \(1644 characters\)
  851.   sed "s/^X//" >'agent/pl/once.pl' <<'END_OF_FILE'
  852. X;# $Id: once.pl,v 2.9 92/07/14 16:50:24 ram Exp $
  853. X;#
  854. X;#  Copyright (c) 1992, Raphael Manfredi
  855. X;#
  856. X;#  You may redistribute only under the terms of the GNU General Public
  857. X;#  Licence as specified in the README file that comes with dist.
  858. X;#
  859. X;# $Log:    once.pl,v $
  860. X;# Revision 2.9  92/07/14  16:50:24  ram
  861. X;# 3.0 beta baseline.
  862. X;# 
  863. X;# 
  864. X;# Handling of the "once" directory for ONCE commands. A once command is
  865. X;# tagged with a tuple (name,ruletag). The name is used for hashing, and
  866. X;# the ruletag sepecifies the entry to be used by the command for timestamp
  867. X;# recording. The dbr package is used to maintain the database
  868. X;#
  869. X# Given a tuple (name, tag) and a period, make sure the command may be
  870. X# executed. If it can, update the timestamp and return true. false otherwise.
  871. Xsub once_check {
  872. X    local($hname, $tag, $period) = @_;
  873. X    $hname =~ s/\s//g;                    # There cannot be spaces in the name
  874. X    local($ok) = 1;                        # Is once ok ?
  875. X    local($timestamp) = 0;                # Time stamp attached to entry
  876. X    local($linenum) = 0;                # Line where entry was found
  877. X    if (-f $file) {
  878. X        ($timestamp, $linenum) = &dbr'info($hname, 'ONCE', $tag);
  879. X        return 0 if $timestamp == -1;    # An error occurred
  880. X    }
  881. X    local($now) = time;                    # Number of seconds since The Epoch
  882. X    if (($timestamp + $period) > $now) {
  883. X        &'add_log("we have to wait for ($hname, $tag)") if $'loglvl > 18;
  884. X        return 0;
  885. X    }
  886. X    # Now we know we can execute the command. So update the database entry.
  887. X    # If the timestamp is 0, then an append has to be done, otherwise it's
  888. X    # a single replacement.
  889. X    if ($timestamp > 0) {
  890. X        &dbr'update($hname, 'ONCE', $linenum, $tag);
  891. X    } else {
  892. X        &dbr'update($hname, 'ONCE', 0, $tag);
  893. X    }
  894. X    1;
  895. X}
  896. X
  897. END_OF_FILE
  898.   if test 1644 -ne `wc -c <'agent/pl/once.pl'`; then
  899.     echo shar: \"'agent/pl/once.pl'\" unpacked with wrong size!
  900.   fi
  901.   # end of 'agent/pl/once.pl'
  902. fi
  903. if test -f 'agent/pl/period.pl' -a "${1}" != "-c" ; then 
  904.   echo shar: Will not clobber existing file \"'agent/pl/period.pl'\"
  905. else
  906.   echo shar: Extracting \"'agent/pl/period.pl'\" \(1384 characters\)
  907.   sed "s/^X//" >'agent/pl/period.pl' <<'END_OF_FILE'
  908. X;# $Id: period.pl,v 2.9 92/07/14 16:50:26 ram Exp $
  909. X;#
  910. X;#  Copyright (c) 1992, Raphael Manfredi
  911. X;#
  912. X;#  You may redistribute only under the terms of the GNU General Public
  913. X;#  Licence as specified in the README file that comes with dist.
  914. X;#
  915. X;# $Log:    period.pl,v $
  916. X;# Revision 2.9  92/07/14  16:50:26  ram
  917. X;# 3.0 beta baseline.
  918. X;# 
  919. X;# 
  920. X# Compute the number of seconds in the period. An atomic period is a digit
  921. X# possibly followed by a modifier. The default modifier is 'd'.
  922. X# Here are the available modifiers (case is significant):
  923. X#  m  minute
  924. X#  h  hour
  925. X#  d  day
  926. X#  w  week
  927. X#  M  month (30 days of 24 hours)
  928. X#  y  year
  929. Xsub seconds_in_period {
  930. X    local($_) = @_;                # The string to parse
  931. X    s|^(\d+)||;
  932. X    local ($number) = int($1);    # Number of elementary periods
  933. X    $_ = 'd' unless /^\s*\w$/;    # Period modifier (defaults to day)
  934. X    local($sec);                # Number of seconds in an atomic period
  935. X    if ($_ eq 'm') {
  936. X        $sec = 60;                # One minute = 60 seconds
  937. X    } elsif ($_ eq 'h') {
  938. X        $sec = 3600;            # One hour = 3600 seconds
  939. X    } elsif ($_ eq 'd') {
  940. X        $sec = 86400;            # One day = 24 hours
  941. X    } elsif ($_ eq 'w') {
  942. X        $sec = 604800;            # One week = 7 days
  943. X    } elsif ($_ eq 'M') {
  944. X        $sec = 2592000;            # One month = 30 days
  945. X    } elsif ($_ eq 'y') {
  946. X        $sec = 31536000;        # One year = 365 days
  947. X    } else {
  948. X        $sec = 86400;            # Unrecognized: defaults to one day
  949. X    }
  950. X    $number * $sec;                # Number of seconds in the period
  951. X}
  952. X
  953. END_OF_FILE
  954.   if test 1384 -ne `wc -c <'agent/pl/period.pl'`; then
  955.     echo shar: \"'agent/pl/period.pl'\" unpacked with wrong size!
  956.   fi
  957.   # end of 'agent/pl/period.pl'
  958. fi
  959. if test -f 'agent/pl/rfc822.pl' -a "${1}" != "-c" ; then 
  960.   echo shar: Will not clobber existing file \"'agent/pl/rfc822.pl'\"
  961. else
  962.   echo shar: Extracting \"'agent/pl/rfc822.pl'\" \(2208 characters\)
  963.   sed "s/^X//" >'agent/pl/rfc822.pl' <<'END_OF_FILE'
  964. X;# $Id: rfc822.pl,v 2.9.1.1 92/11/01 15:51:46 ram Exp $
  965. X;#
  966. X;#  Copyright (c) 1992, Raphael Manfredi
  967. X;#
  968. X;#  You may redistribute only under the terms of the GNU General Public
  969. X;#  Licence as specified in the README file that comes with dist.
  970. X;#
  971. X;# $Log:    rfc822.pl,v $
  972. X;# Revision 2.9.1.1  92/11/01  15:51:46  ram
  973. X;# patch11: allows _ as separator in names (as in First_Last)
  974. X;# 
  975. X;# Revision 2.9  92/07/14  16:50:42  ram
  976. X;# 3.0 beta baseline.
  977. X;# 
  978. X;#
  979. X;# The following routines do some parsing on RFC822 headers (such as the
  980. X;# ones provided by sendmail).
  981. X;#
  982. X# Parse an address and returns (internet, comment)
  983. X# Examples:
  984. X#    ram@eiffel.com (Raphael Manfredi)  -> (ram@eiffel.com, Raphael Manfredi)
  985. X#    Raphael Manfredi <ram@eiffel.com>  -> (ram@eiffel.com, Raphael Manfredi)
  986. Xsub parse_address {
  987. X    local($_) = shift(@_);        # The address to be parsed
  988. X    local($comment);
  989. X    local($internet);
  990. X    if (/^\s*(\S+)\s+\((.*)\)/) {        # address (comment) 
  991. X        ($1, $2);
  992. X    } elsif (/^\s*(.*)\s+<(\S+)>/) {    # comment <address>
  993. X        $comment = $1;
  994. X        $internet = $2;
  995. X        $comment =~ s/^"(.*)"/$1/;        # "comment" -> comment
  996. X        ($internet, $comment);
  997. X    } elsif (/^\s*<(\S+)>/) {            # <address>
  998. X        ($1, "");
  999. X    } else {                            # address
  1000. X        s/^\s+//;
  1001. X        ($_, "");
  1002. X    }
  1003. X}
  1004. X
  1005. X# Parses an internet address and returns the login name of the sender
  1006. Xsub login_name {
  1007. X    local($_) = shift(@_);                # The internet address
  1008. X    if (s/^"(\S+)"@\S+/$1/) {            # "user@domain"@other
  1009. X        do login_name($_);                # parse user@domain
  1010. X    } elsif (s/^(\S+)@\S+/$1/) {        # user@domain.name
  1011. X        do login_name($_);                # parse user
  1012. X    } elsif (s/^(\S+)%\S+/$1/) {        # user%domain.name
  1013. X        do login_name($_);                # parse user
  1014. X    } elsif (s/^\S+!(\S+)/$1/) {        # ...!backbone!user
  1015. X        do last_name($_);                # user can only be a simple name
  1016. X    } else {                            # everything else must be a single name
  1017. X        do last_name($_);                # keep only last name
  1018. X    }
  1019. X}
  1020. X
  1021. X# Extract last name from a login name like First_name.Last_name and put it
  1022. X# in lowercase. Hence, Raphael.Manfredi will become manfredi.
  1023. Xsub last_name {
  1024. X    local($_) = shift(@_);            # The sender's login name
  1025. X    s/.*\.(\w+)/$1/;                # Keep only the last name (. separation)
  1026. X    s/.*_(\w+)/$1/;                    # Same as above (_ separation)
  1027. X    tr/A-Z/a-z/;                    # And lowercase it
  1028. X    $_;
  1029. X}
  1030. X
  1031. END_OF_FILE
  1032.   if test 2208 -ne `wc -c <'agent/pl/rfc822.pl'`; then
  1033.     echo shar: \"'agent/pl/rfc822.pl'\" unpacked with wrong size!
  1034.   fi
  1035.   # end of 'agent/pl/rfc822.pl'
  1036. fi
  1037. if test -f 'agent/pl/unpack.pl' -a "${1}" != "-c" ; then 
  1038.   echo shar: Will not clobber existing file \"'agent/pl/unpack.pl'\"
  1039. else
  1040.   echo shar: Extracting \"'agent/pl/unpack.pl'\" \(1883 characters\)
  1041.   sed "s/^X//" >'agent/pl/unpack.pl' <<'END_OF_FILE'
  1042. X;# $Id: unpack.pl,v 2.9 92/07/14 16:50:55 ram Exp $
  1043. X;#
  1044. X;#  Copyright (c) 1991, Raphael Manfredi
  1045. X;#
  1046. X;#  You may redistribute only under the terms of the GNU General Public
  1047. X;#  Licence as specified in the README file that comes with dist.
  1048. X;#
  1049. X;# $Log:    unpack.pl,v $
  1050. X;# Revision 2.9  92/07/14  16:50:55  ram
  1051. X;# 3.0 beta baseline.
  1052. X;# 
  1053. X;#
  1054. X# Expands an archive's name
  1055. Xsub expand {
  1056. X    local($path) = shift;        # The archive
  1057. X    # Look for extension of base path (eg: .cpio.Z)
  1058. X    local(@fullpath) = <${path}.*>;
  1059. X    if (-1 == $#fullpath) {
  1060. X        do clean_tmp();
  1061. X        do fatal("no archive file");
  1062. X    }
  1063. X    $path = $fullpath[0];        # Name with archive extension
  1064. X}
  1065. X
  1066. X# Unpack(path,dir,flag) restores archive `path' into `dir'
  1067. X# and returns the location of the main directory.
  1068. Xsub unpack {
  1069. X    local($path) = shift;        # The archive
  1070. X    local($dir) = shift;        # Storage place
  1071. X    local($compflag) = shift;    # Flag for compression (useful for short names)
  1072. X    local($unpack) = "";        # Will hold the restore command
  1073. X    $path = do expand($path);    # Name with archive extension
  1074. X    do add_log("archive is $path") if $loglvl > 19;
  1075. X    # First determine wether it is compressed
  1076. X    if ($compflag) {
  1077. X        $unpack = "zcat | ";
  1078. X    }
  1079. X    # Cpio or tar ?
  1080. X    if ($path =~ /\.tar/) {
  1081. X        $unpack .= "tar xof -";
  1082. X    } else {
  1083. X        $unpack .= "cpio -icmd";
  1084. X    }
  1085. X    system "< $path (cd $dir; $unpack)";
  1086. X    $path =~ s|.*/(\w+)|$1|;    # Keep only basename
  1087. X    local ($stat) = $?;            # Return status
  1088. X    if ($stat) {
  1089. X        do clean_tmp();
  1090. X        do fatal("unable to unpack $path");
  1091. X    }
  1092. X    do add_log("unpacked $path with \"$unpack\"") if $loglvl > 12;
  1093. X
  1094. X    # The top level directory is the only file in $dir
  1095. X    local(@top) = <${dir}/*>;
  1096. X    if ($#top < 0) {
  1097. X        do clean_tmp();
  1098. X        do fatal("$prog_name: no top-level dir for $path");
  1099. X    }
  1100. X    if ($#top > 0) {
  1101. X        do add_log("WARNING more than one file in $dir") if $loglvl > 4;
  1102. X    }
  1103. X    do add_log("top-level dir for $path is $top[0]") if $loglvl > 19;
  1104. X    $top[0];        # Top-level directory
  1105. X}
  1106. X
  1107. END_OF_FILE
  1108.   if test 1883 -ne `wc -c <'agent/pl/unpack.pl'`; then
  1109.     echo shar: \"'agent/pl/unpack.pl'\" unpacked with wrong size!
  1110.   fi
  1111.   # end of 'agent/pl/unpack.pl'
  1112. fi
  1113. if test -f 'agent/test/basic/config.t' -a "${1}" != "-c" ; then 
  1114.   echo shar: Will not clobber existing file \"'agent/test/basic/config.t'\"
  1115. else
  1116.   echo shar: Extracting \"'agent/test/basic/config.t'\" \(2021 characters\)
  1117.   sed "s/^X//" >'agent/test/basic/config.t' <<'END_OF_FILE'
  1118. X# This MUST be the first test ever run
  1119. Xdo '../pl/init.pl';
  1120. Xdo '../pl/logfile.pl';
  1121. Xchdir '../out' || exit 0;
  1122. Xchop($pwd = `pwd`);
  1123. X$path = $ENV{'PATH'};
  1124. X$host = $ENV{'HOST'};
  1125. X$user = $ENV{'USER'};
  1126. Xopen(CONFIG, ">.mailagent") || print "1\n";
  1127. Xprint CONFIG <<EOF;
  1128. Xhome     : $pwd
  1129. Xlevel    : 21            # Undocumented of course
  1130. Xtmpdir   : /tmp
  1131. Xemergdir : $pwd/emerg
  1132. Xtrack    : OFF
  1133. Xpath     : .
  1134. Xp_$host  : .
  1135. Xuser     : $user
  1136. Xname     : Mailagent Test Suite
  1137. Xvacation : OFF
  1138. Xvacfile  : ~/.vacation
  1139. Xvacperiod: 1d
  1140. Xspool    : ~
  1141. Xqueue    : ~/queue        # This is a good test for comments
  1142. Xlogdir   : ~
  1143. Xcontext  : \$spool/context
  1144. Xlog      : agentlog
  1145. Xseq      : .seq
  1146. Xtimezone : PST8PDT
  1147. Xstatfile : \$spool/mailagent.st
  1148. Xrules    : ~/.rules
  1149. Xmaildrop : $pwd            # Do not LEAVE messages in /usr/spool/mail
  1150. Xmailbox  : \$user        # Use config variable, not current perl $user
  1151. Xhash     : dbr
  1152. Xcleanlaps: 1M
  1153. Xautoclean: OFF
  1154. Xagemax   : 1y
  1155. Xcomfile  : \$spool/commands
  1156. Xdistlist : \$spool/distribs
  1157. Xproglist : \$spool/proglist
  1158. Xmaxsize  : 150000
  1159. Xplsave   : \$spool/plsave
  1160. Xauthfile : \$spool/auth
  1161. XEOF
  1162. Xclose CONFIG;
  1163. X`rm -rf queue emerg`;
  1164. X`mkdir emerg`;
  1165. X$? == 0 || print "2\n";
  1166. X# Use the special undocumented -t option from filter to get HOME directory
  1167. X# via environment instead of /etc/passwd.
  1168. Xopen(FILTER, "|$filter -t >/dev/null 2>&1") || print "3\n";
  1169. Xprint FILTER <<EOF;
  1170. XDummy mail
  1171. XEOF
  1172. Xclose FILTER;
  1173. X$? != 0 || print "4\n";            # No valid queue directory
  1174. X$file = <emerg/*>;
  1175. Xif (-f "$file") {
  1176. X    open(FILE, $file) || print "5\n";
  1177. X    @file = <FILE>;
  1178. X    close FILE;
  1179. X    $file[0] eq "Dummy mail\n" || print "6\n";
  1180. X    unlink "$file";
  1181. X} else {
  1182. X    print "5\n";                # No emergency dump
  1183. X}
  1184. X-s 'agentlog' || print "6\n";    # No logfile or empty
  1185. X&get_log(7);
  1186. X&check_log('FATAL', 8);                # There must be a FATAL
  1187. X&check_log('MTA', 9);                # Filter must think mail is in MTA's queue
  1188. X&check_log('updating PATH', 10);    # Make sure hostname is computed
  1189. X&check_log('unable to queue', 11);    # Filter did not queue mail
  1190. Xunlink 'agentlog';
  1191. X`mkdir queue`;
  1192. X$? == 0 || print "12\n";        # Cannot make queue
  1193. Xprint "0\n";
  1194. END_OF_FILE
  1195.   if test 2021 -ne `wc -c <'agent/test/basic/config.t'`; then
  1196.     echo shar: \"'agent/test/basic/config.t'\" unpacked with wrong size!
  1197.   fi
  1198.   # end of 'agent/test/basic/config.t'
  1199. fi
  1200. if test -f 'agent/test/basic/mailagent.t' -a "${1}" != "-c" ; then 
  1201.   echo shar: Will not clobber existing file \"'agent/test/basic/mailagent.t'\"
  1202. else
  1203.   echo shar: Extracting \"'agent/test/basic/mailagent.t'\" \(2013 characters\)
  1204.   sed "s/^X//" >'agent/test/basic/mailagent.t' <<'END_OF_FILE'
  1205. X# Basic mailagent test: ensure it is correctly invoked by filter.
  1206. Xdo '../pl/init.pl';
  1207. Xdo '../pl/logfile.pl';
  1208. X$user = $ENV{'USER'};
  1209. Xchdir '../out' || exit 0;
  1210. X# Make sure we'll find the mailagent
  1211. Xsystem 'perl', '-i', '-p', '-e', "s|^path.*|path     :.:$up|", '.mailagent';
  1212. X$? == 0 || print "1\n";
  1213. Xopen(RULES, ">.rules") || print "2\n";
  1214. Xprint RULES "{ DELETE };\n";
  1215. Xclose RULES;
  1216. Xopen(FILTER, "|$filter -t >/dev/null 2>&1") || print "3\n";
  1217. Xprint FILTER <<EOF;
  1218. XFrom: test
  1219. X
  1220. XDummy body
  1221. XEOF
  1222. Xclose FILTER;
  1223. X$? == 0 || print "4\n";
  1224. X&get_log(5);
  1225. X&check_log('WARNING.*assuming', 6);        # No To: field
  1226. X&check_log('FILTERED', 7);                # Mail filtered
  1227. X&check_log('DELETED', 8);                # Mail deleted by only rule
  1228. X@files = <queue/qm*>;
  1229. X@files == 0 || print "9\n";                # Queued mail deleted when filtered
  1230. Xunlink 'agentlog', '.rules';
  1231. Xsleep 1 while -f 'perl.lock';            # Let background mailagent die
  1232. X# Check empty rules...
  1233. Xopen(FILTER, "|$filter -t >/dev/null 2>&1") || print "10\n";
  1234. Xprint FILTER <<EOF;
  1235. XFrom: test
  1236. X
  1237. XDummy body
  1238. XEOF
  1239. Xclose FILTER;
  1240. X$? == 0 || print "11\n";
  1241. X&get_log(12);
  1242. X&check_log('FILTERED', 13);                # Mail filtered
  1243. X&check_log('LEFT', 14);                    # Mail left in mbox
  1244. X&check_log('building default', 15);        # Used default rules
  1245. X-s "$user" || print "16\n";                # Maildrop is here, so is mbox
  1246. X@files = <queue/qm*>;
  1247. X@files == 0 || print "17\n";            # Queued mail deleted when filtered
  1248. X-f 'context' && print "18\n";            # Empty context must be deleted
  1249. Xunlink 'agentlog', "$user";
  1250. Xsleep 1 while -f 'perl.lock';            # Let background mailagent die
  1251. X# Make sure file is correctly queued when another mailagent is running
  1252. X`cp /dev/null perl.lock`;
  1253. X$? == 0 || print "19\n";
  1254. Xopen(FILTER, "|$filter -t >/dev/null 2>&1") || print "20\n";
  1255. Xprint FILTER <<EOF;
  1256. XDummy mail
  1257. XEOF
  1258. Xclose FILTER;
  1259. X$? == 0 || print "21\n";    # Must terminate correctly (queued)
  1260. X&get_log(22);
  1261. X&check_log('QUEUED', 23);    # Mail was queued
  1262. X$file = <queue/fm*>;
  1263. X-f "$file" || print "24\n";    # Must have been left in queue as a 'fm' file
  1264. Xunlink "$file", 'agentlog', 'perl.lock';
  1265. Xprint "0\n";
  1266. END_OF_FILE
  1267.   if test 2013 -ne `wc -c <'agent/test/basic/mailagent.t'`; then
  1268.     echo shar: \"'agent/test/basic/mailagent.t'\" unpacked with wrong size!
  1269.   fi
  1270.   # end of 'agent/test/basic/mailagent.t'
  1271. fi
  1272. if test -f 'agent/test/cmd/assign.t' -a "${1}" != "-c" ; then 
  1273.   echo shar: Will not clobber existing file \"'agent/test/cmd/assign.t'\"
  1274. else
  1275.   echo shar: Extracting \"'agent/test/cmd/assign.t'\" \(544 characters\)
  1276.   sed "s/^X//" >'agent/test/cmd/assign.t' <<'END_OF_FILE'
  1277. X# Test ASSIGN command
  1278. Xdo '../pl/cmd.pl';
  1279. Xunlink 'output';
  1280. X
  1281. X&add_header('X-Tag: assign #1');
  1282. X`$cmd`;
  1283. X$? == 0 || print "1\n";
  1284. X-f 'output' || print "2\n";        # Result of various assign commands
  1285. Xchop($output = `cat output 2>/dev/null`);
  1286. X$output eq 'ram,try,try.2' || print "3\n";
  1287. Xunlink 'output';
  1288. X
  1289. X&replace_header('X-Tag: assign #2');
  1290. X`$cmd`;
  1291. X$? == 0 || print "4\n";
  1292. X-f 'output' || print "5\n";        # Result of various assign commands
  1293. Xchop($output = `cat output 2>/dev/null`);
  1294. X$output eq '7,1+2,7' || print "6\n";
  1295. X
  1296. Xunlink 'output', 'mail';
  1297. Xprint "0\n";
  1298. END_OF_FILE
  1299.   if test 544 -ne `wc -c <'agent/test/cmd/assign.t'`; then
  1300.     echo shar: \"'agent/test/cmd/assign.t'\" unpacked with wrong size!
  1301.   fi
  1302.   # end of 'agent/test/cmd/assign.t'
  1303. fi
  1304. if test -f 'agent/test/cmd/once.t' -a "${1}" != "-c" ; then 
  1305.   echo shar: Will not clobber existing file \"'agent/test/cmd/once.t'\"
  1306. else
  1307.   echo shar: Extracting \"'agent/test/cmd/once.t'\" \(1298 characters\)
  1308.   sed "s/^X//" >'agent/test/cmd/once.t' <<'END_OF_FILE'
  1309. X# The ONCE command and autocleaning feature
  1310. Xdo '../pl/cmd.pl';
  1311. Xunlink 'one', 'two', 'three', 'four', "$user";
  1312. X
  1313. X&add_header('X-Tag: once');
  1314. X`rm -rf dbr` if -d 'dbr';
  1315. X`$cmd`;
  1316. X$? == 0 || print "1\n";
  1317. X-f "$user" && print "2\n";
  1318. X-f 'one' || print "3\n";
  1319. X-f 'two' && print "4\n";
  1320. X-f 'three' || print "5\n";
  1321. X-f 'four' || print "6\n";
  1322. X-d 'dbr' || print "7\n";
  1323. X@files = <dbr/*/*>;
  1324. X@files == 3 || print "8\n";
  1325. X
  1326. X# Make sure ONCE dbr database not disturbed by autocleaning, and, along
  1327. X# the way, check that auto cleaning is correctly run.
  1328. X
  1329. X$level = $ENV{'LEVEL'};
  1330. X`$mailagent -L $level -q -o 'autoclean: ON' 2>/dev/null`;
  1331. X$? == 0 || print "9\n";
  1332. X@new_files = <dbr/*/*>;
  1333. X@new_files == @files || print "10\n";
  1334. Xunlink 'one', 'two', 'three', 'four', "$user";
  1335. X-f 'context' || print "11\n";
  1336. X
  1337. X`$cmd`;
  1338. X$? == 0 || print "12\n";
  1339. X-f "$user" && print "13\n";
  1340. X-f 'one' && print "14\n";
  1341. X-f 'two' && print "15\n";
  1342. X-f 'three' && print "16\n";
  1343. X-f 'four' || print "17\n";
  1344. X-d 'dbr' || print "18\n";
  1345. X
  1346. X# Make sure autocleaning leaves things in a coherent state
  1347. X
  1348. X`$mailagent -q -L $level -o 'autoclean: ON' -o 'agemax: 0m' 2>/dev/null`;
  1349. X-d 'dbr' && print "19\n";
  1350. X-f 'context' || print "20\n";
  1351. X
  1352. X`$mailagent -q -L $level 2>/dev/null`;
  1353. X-f 'context' && print "21\n";
  1354. X
  1355. Xunlink 'one', 'two', 'three', 'four', "$user", 'mail';
  1356. Xprint "0\n";
  1357. END_OF_FILE
  1358.   if test 1298 -ne `wc -c <'agent/test/cmd/once.t'`; then
  1359.     echo shar: \"'agent/test/cmd/once.t'\" unpacked with wrong size!
  1360.   fi
  1361.   # end of 'agent/test/cmd/once.t'
  1362. fi
  1363. if test -f 'agent/test/cmd/record.t' -a "${1}" != "-c" ; then 
  1364.   echo shar: Will not clobber existing file \"'agent/test/cmd/record.t'\"
  1365. else
  1366.   echo shar: Extracting \"'agent/test/cmd/record.t'\" \(1302 characters\)
  1367.   sed "s/^X//" >'agent/test/cmd/record.t' <<'END_OF_FILE'
  1368. X# The RECORD command
  1369. Xdo '../pl/cmd.pl';
  1370. Xunlink "$user.1", "$user.2", "$user.3";
  1371. X
  1372. X&add_header('X-Tag: record #1');
  1373. X`rm -rf dbr` if -d 'dbr';
  1374. X`$cmd`;
  1375. X$? == 0 || print "1\n";
  1376. X-f "$user.1" || print "2\n";    # Was saved, first time.
  1377. Xunlink "$user.1";
  1378. X
  1379. X-d 'dbr' || print "3\n";        # Make sure history recording works
  1380. X-f 'dbr/i/e' || print "4\n";    # Hashing done on domain name
  1381. X
  1382. X`$cmd`;
  1383. X$? == 0 || print "5\n";
  1384. X-f "$user.1" && print "6\n";    # We rejected this time, in SEEN mode
  1385. X-f "$user.2" || print "7\n";    # And saved it here
  1386. Xunlink "$user.2";
  1387. X
  1388. X&replace_header('X-Tag: record #2');
  1389. X`$cmd`;
  1390. X$? == 0 || print "8\n";
  1391. X-f "$user.1" && print "9\n";    # We restarted this time
  1392. X-f "$user.3" || print "10\n";    # And caught that rule in RECORD mode
  1393. X-f "$user" && print "11\n";        # Nothing here
  1394. Xunlink "$user.3";
  1395. X
  1396. X&replace_header('X-Tag: record #3');
  1397. X`$cmd`;
  1398. X$? == 0 || print "12\n";
  1399. X-f "$user.1" && print "13\n";    # We aborted
  1400. X-f "$user" || print "14\n";        # Must be there (aborted, no match)
  1401. Xunlink "$user.1", "$user";
  1402. X
  1403. X&replace_header('X-Tag: record #4');
  1404. X`$cmd`;
  1405. X$? == 0 || print "15\n";
  1406. X-f "$user.1" && print "16\n";    # We rejected
  1407. X-f "$user.2" || print "17\n";    # Must be there (saved in mode RECORD)
  1408. X-f "$user" && print "18\n";
  1409. X
  1410. X`rm -rf dbr` if -d 'dbr';
  1411. Xunlink "$user", "$user.1", "$user.2", "$user.3", 'mail';
  1412. Xprint "0\n";
  1413. END_OF_FILE
  1414.   if test 1302 -ne `wc -c <'agent/test/cmd/record.t'`; then
  1415.     echo shar: \"'agent/test/cmd/record.t'\" unpacked with wrong size!
  1416.   fi
  1417.   # end of 'agent/test/cmd/record.t'
  1418. fi
  1419. if test -f 'agent/test/cmd/unique.t' -a "${1}" != "-c" ; then 
  1420.   echo shar: Will not clobber existing file \"'agent/test/cmd/unique.t'\"
  1421. else
  1422.   echo shar: Extracting \"'agent/test/cmd/unique.t'\" \(1293 characters\)
  1423.   sed "s/^X//" >'agent/test/cmd/unique.t' <<'END_OF_FILE'
  1424. X# The UNIQUE command
  1425. Xdo '../pl/cmd.pl';
  1426. Xunlink "$user.1", "$user.2", "$user.3";
  1427. X
  1428. X&add_header('X-Tag: unique #1');
  1429. X`rm -rf dbr` if -d 'dbr';
  1430. X`$cmd`;
  1431. X$? == 0 || print "1\n";
  1432. X-f "$user.1" || print "2\n";    # Was saved, first time.
  1433. Xunlink "$user.1";
  1434. X
  1435. X-d 'dbr' || print "3\n";        # Make sure history recording works
  1436. X-f 'dbr/i/e' || print "4\n";    # Hashing done on domain name
  1437. X
  1438. X`$cmd`;
  1439. X$? == 0 || print "5\n";
  1440. X-f "$user.1" && print "6\n";    # We rejected this time, NOT in SEEN mode
  1441. X-f "$user.2" || print "7\n";    # And saved it here
  1442. Xunlink "$user.2";
  1443. X
  1444. X&replace_header('X-Tag: unique #2');
  1445. X`$cmd`;
  1446. X$? == 0 || print "8\n";
  1447. X-f "$user.1" && print "9\n";    # We restarted this time
  1448. X-f "$user.3" || print "10\n";    # And caught that rule
  1449. X-f "$user" && print "11\n";        # Nothing here
  1450. Xunlink "$user.3";
  1451. X
  1452. X&replace_header('X-Tag: unique #3');
  1453. X`$cmd`;
  1454. X$? == 0 || print "12\n";
  1455. X-f "$user.1" && print "13\n";    # We aborted
  1456. X-f "$user" && print "14\n";        # Must not be there (tagged as saved)
  1457. Xunlink "$user.1", "$user";
  1458. X
  1459. X&replace_header('X-Tag: unique #4');
  1460. X`$cmd`;
  1461. X$? == 0 || print "15\n";
  1462. X-f "$user.1" && print "16\n";    # We rejected
  1463. X-f "$user.2" || print "17\n";    # Must be there (saved in mode UNIQUE)
  1464. X-f "$user" && print "18\n";
  1465. X
  1466. X`rm -rf dbr` if -d 'dbr';
  1467. Xunlink "$user", "$user.1", "$user.2", "$user.3", 'mail';
  1468. Xprint "0\n";
  1469. END_OF_FILE
  1470.   if test 1293 -ne `wc -c <'agent/test/cmd/unique.t'`; then
  1471.     echo shar: \"'agent/test/cmd/unique.t'\" unpacked with wrong size!
  1472.   fi
  1473.   # end of 'agent/test/cmd/unique.t'
  1474. fi
  1475. if test -f 'agent/test/cmd/write.t' -a "${1}" != "-c" ; then 
  1476.   echo shar: Will not clobber existing file \"'agent/test/cmd/write.t'\"
  1477. else
  1478.   echo shar: Extracting \"'agent/test/cmd/write.t'\" \(1299 characters\)
  1479.   sed "s/^X//" >'agent/test/cmd/write.t' <<'END_OF_FILE'
  1480. X# The WRITE command
  1481. Xdo '../pl/cmd.pl';
  1482. X$mbox = 'mbox';
  1483. X
  1484. X&add_header('X-Tag: write #1');
  1485. X`$cmd`;
  1486. X$? == 0 || print "1\n";
  1487. X-f "$mbox" || print "2\n";        # Mail saved here
  1488. X-f "$user" && print "3\n";        # Must not exist (yet)
  1489. X
  1490. X# When mailbox protected against writing...
  1491. Xunlink <emerg/*>;
  1492. X$size = -s "$mbox";
  1493. Xchmod 0444, "$mbox";
  1494. X`$cmd`;
  1495. X$? == 0 || print "4\n";
  1496. X-f "$mbox" || print "5\n";                # Must still be there
  1497. X$size == -s "$mbox" || print "6\n";        # And not altered
  1498. X@emerg = <emerg/*>;
  1499. X@emerg == 1 || print "7\n";                # Emeregency as SAVE failed
  1500. X-f "$user" || print "8\n";                # Not saved -> leave in mbox
  1501. X-s "$user" == -s "$mbox" || print "9\n";
  1502. X
  1503. X# There is no X-Filter mail in the emergency saving
  1504. X`grep -v X-Filter: $mbox > ok`;
  1505. X$? == 0 || print "10\n";
  1506. X-s $emerg[0] eq -s 'ok' || print "11\n";    # Full mail saved, of course
  1507. X
  1508. X# Now verify WRITE actually overwrites the contentes
  1509. Xunlink "$user";
  1510. Xchmod 0644, "$mbox";
  1511. X`$cmd`;
  1512. X$? == 0 || print "12\n";
  1513. X$size == -s "$mbox" || print "13\n";
  1514. X-f "$user" && print "14\n";
  1515. X
  1516. X# Make sure WRITE creates full path when needed
  1517. X&replace_header('X-Tag: write #2');
  1518. X`rm -rf path` if -d 'path';
  1519. X`$cmd`;
  1520. X$? == 0 || print "15\n";
  1521. X-f 'path/another/third/mbox' || print "16\n";
  1522. X`rm -rf path` if -d 'path';
  1523. X
  1524. Xunlink <emerg/*>;
  1525. Xunlink "$mbox", "$user", 'mail', 'ok';
  1526. Xprint "0\n";
  1527. END_OF_FILE
  1528.   if test 1299 -ne `wc -c <'agent/test/cmd/write.t'`; then
  1529.     echo shar: \"'agent/test/cmd/write.t'\" unpacked with wrong size!
  1530.   fi
  1531.   # end of 'agent/test/cmd/write.t'
  1532. fi
  1533. if test -f 'agent/test/mail' -a "${1}" != "-c" ; then 
  1534.   echo shar: Will not clobber existing file \"'agent/test/mail'\"
  1535. else
  1536.   echo shar: Extracting \"'agent/test/mail'\" \(1620 characters\)
  1537.   sed "s/^X//" >'agent/test/mail' <<'END_OF_FILE'
  1538. XFrom compilers-request@iecc.cambridge.ma.us Sun Jul 12 14:45:54 PDT 1992
  1539. XReceived: from eiffel.eiffel.com by lyon.eiffel.com (5.61/1.34)
  1540. X    id AA13012; Thu, 2 Jul 92 22:34:10 -0700
  1541. XReceived: from uunet.UUCP by eiffel.eiffel.com (4.0/SMI-4.0)
  1542. X    id AA09695; Thu, 2 Jul 92 22:31:36 PDT
  1543. XReceived: from ursa-major.spdcc.com by relay2.UU.NET with SMTP 
  1544. X    (5.61/UUNET-internet-primary) id AA21794; Fri, 3 Jul 92 01:17:38 -0400
  1545. XReceived: by ursa-major.spdcc.com with sendmail-5.65/4.7 
  1546. X    id <AA13205@ursa-major.spdcc.com>; Fri, 3 Jul 92 01:17:34 -0400
  1547. XReceived: by iecc.cambridge.ma.us (smail2.5+)
  1548. X    id AA04311; 3 Jul 92 00:43:22 EDT (Fri)
  1549. XTo: ram@eiffel.com
  1550. XFrom: compilers-request@iecc.cambridge.ma.us
  1551. XSubject: Re: melting ice technology?
  1552. XDate: 3 Jul 92 00:43:22 EDT (Fri)
  1553. XMessage-Id: <9207030043.AA04311@iecc.cambridge.ma.us>
  1554. X
  1555. XYour message to the moderated usenet group comp.compilers has been
  1556. Xreceived.  Within a few days, it should either be posted to usenet or, if
  1557. Xfor some reason it's not suitable for posting, returned to you.
  1558. X
  1559. XWhen you send a message to comp.compilers, I understand that to mean that
  1560. Xyou want me to post it to usenet, which means it will be sent to tens of
  1561. Xthousands of potential readers at thousands of computers all around the
  1562. Xworld.  It may also appear in a printed comp.compilers annual and other
  1563. Xbooks, in the ACM SIGPLAN Notices and other magazines, in on-line and
  1564. Xoff-line archives, CD-ROMs, and anywhere else that some reader decides to
  1565. Xuse it.
  1566. X
  1567. XIf you don't want me to post something, please send it instead to
  1568. Xcompilers-request@iecc.cambridge.ma.us.
  1569. X
  1570. XRegards,
  1571. XJohn Levine, comp.compilers moderator
  1572. END_OF_FILE
  1573.   if test 1620 -ne `wc -c <'agent/test/mail'`; then
  1574.     echo shar: \"'agent/test/mail'\" unpacked with wrong size!
  1575.   fi
  1576.   # end of 'agent/test/mail'
  1577. fi
  1578. if test -f 'agent/test/option/s.t' -a "${1}" != "-c" ; then 
  1579.   echo shar: Will not clobber existing file \"'agent/test/option/s.t'\"
  1580. else
  1581.   echo shar: Extracting \"'agent/test/option/s.t'\" \(1803 characters\)
  1582.   sed "s/^X//" >'agent/test/option/s.t' <<'END_OF_FILE'
  1583. X# -s: report gathered statistics (special)
  1584. Xdo '../pl/init.pl';
  1585. Xdo '../pl/logfile.pl';
  1586. Xchdir '../out';
  1587. Xunlink 'mailagent.st';
  1588. X$out = `$mailagent -summary 2>/dev/null`;
  1589. X$? == 0 || print "1\n";
  1590. X`cp /dev/null mailagent.st`;
  1591. X$mail_test = <<'EOM';
  1592. XFrom ram Sat Jul 11 18:51:16 PDT 1992
  1593. XFrom: ram
  1594. XTo: ram
  1595. XSubject: test
  1596. X
  1597. XThis is a test.
  1598. XEOM
  1599. X# First time creates new statistics, second time updates them.
  1600. Xfor ($i = 0; $i < 2; $i++) {
  1601. X    open(MAILAGENT, "|$mailagent -e 'STRIP Nothing; LEAVE' 2>/dev/null") ||
  1602. X    print "2x$i\n";
  1603. X    print MAILAGENT $mail_test;
  1604. X    close MAILAGENT;
  1605. X    $? == 0 || print "3x$i\n";
  1606. X    sleep 1 while -f 'perl.lock';    # Wait for background process to finish
  1607. X}
  1608. X$user = $ENV{'USER'};
  1609. X-s "$user" || print "4\n";
  1610. X$out = `$mailagent -s 2>/dev/null`;
  1611. X$out ne '' || print "5\n";
  1612. X@out = split(/\n/, $out);
  1613. X@leave = grep(/LEAVE/, @out);
  1614. X@strip = grep(/STRIP/, @out);
  1615. X@leave == @strip || print "6\n";
  1616. X@leave == 1 || print "7\n";
  1617. X$out = `$mailagent -sm 2>/dev/null`;
  1618. X@out = split(/\n/, $out);
  1619. X@leave = grep(/LEAVE/, @out);
  1620. X@strip = grep(/STRIP/, @out);
  1621. X@leave == @strip || print "8\n";
  1622. X@leave == 2 || print "9\n";
  1623. X$out = `$mailagent -sr 2>/dev/null`;
  1624. X@out = split(/\n/, $out);
  1625. Xgrep(/STRIP.*LEAVE/, @out) || print "10\n";
  1626. X&get_log(11, 'mailagent.st');
  1627. X&check_log('^---', 12) == 1 || print "13\n";    # Rules did not changed
  1628. X&check_log('^\+\+\+', 14) == 1 || print "15\n";
  1629. X
  1630. X# Now change rules slightly
  1631. Xopen(MAILAGENT, "|$mailagent -e 'STRIP Other; LEAVE' 2>/dev/null") ||
  1632. Xprint "16\n";
  1633. Xprint MAILAGENT $mail_test;
  1634. Xclose MAILAGENT;
  1635. X$? == 0 || print "17\n";
  1636. Xsleep 1 while -f 'perl.lock';        # Wait for background process to finish
  1637. X&get_log(18, 'mailagent.st');
  1638. X&check_log('^---', 19) == 2 || print "20\n";    # Rules did changed
  1639. X&check_log('^\+\+\+', 21) == 2 || print "22\n";
  1640. X
  1641. Xunlink 'mailagent.st', "$user";
  1642. Xprint "0\n";
  1643. END_OF_FILE
  1644.   if test 1803 -ne `wc -c <'agent/test/option/s.t'`; then
  1645.     echo shar: \"'agent/test/option/s.t'\" unpacked with wrong size!
  1646.   fi
  1647.   # end of 'agent/test/option/s.t'
  1648. fi
  1649. echo shar: End of archive 15 \(of 17\).
  1650. cp /dev/null ark15isdone
  1651. MISSING=""
  1652. for I in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 ; do
  1653.     if test ! -f ark${I}isdone ; then
  1654.     MISSING="${MISSING} ${I}"
  1655.     fi
  1656. done
  1657. if test "${MISSING}" = "" ; then
  1658.     echo You have unpacked all 17 archives.
  1659.     rm -f ark[1-9]isdone ark[1-9][0-9]isdone
  1660. else
  1661.     echo You still must unpack the following archives:
  1662.     echo "        " ${MISSING}
  1663. fi
  1664. exit 0
  1665. exit 0 # Just in case...
  1666.