home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #19 / NN_1992_19.iso / spool / comp / emacs / 3024 < prev    next >
Encoding:
Text File  |  1992-09-03  |  40.6 KB  |  1,597 lines
  1. Path: sparky!uunet!crdgw1!newsun!ns.novell.com!jkt
  2. From: jkt@SED.Provo.Novell.COM (Jack Thomasson)
  3. Newsgroups: comp.emacs
  4. Subject: Re: anything better than RMAIL around? (LONG)
  5. Message-ID: <JKT.92Sep3092739@seneca.SED.Provo.Novell.COM>
  6. Date: 3 Sep 92 16:27:39 GMT
  7. References: <1992Sep2.173148.13480@colorado.edu>
  8. Sender: usenet@Novell.COM (Usenet News)
  9. Organization: Novell, Inc.
  10. Lines: 1583
  11. In-Reply-To: ejh@khonshu.colorado.edu's message of Wed, 2 Sep 1992 17:31:48 GMT
  12. Nntp-Posting-Host: seneca.sed.provo.novell.com
  13.  
  14. there was a package that came through comp.lang.perl a while ago
  15. called "audit" written by strike@convex.com.  (the author noted that
  16. he was changing jobs so i'm not sure if the mail address is still
  17. valid.)  i added a function to this package which allows me to read my
  18. now-preprocessed mail from gnus.  i'm including the post and my
  19. addition.  the documentation for the audit stuff is decent.
  20. documentation for my gnus-mailer hook is probably non-existant (see my
  21. .signature anyway).  documentation for gnus-on-private-directory is
  22. available.  enjoy :{)}
  23.  
  24. From: strike@convex.com (Martin Streicher)
  25. Newsgroups: comp.lang.perl,comp.mail.mh,convex.general,comp.mail.misc
  26. Subject: Mail auditing + more package
  27. Date: 1 Jun 92 20:00:07 GMT
  28. Reply-To: strike@convex.com
  29. Organization: CONVEX Computer Corporation, Visualization Development
  30. Nntp-Posting-Host: pixel.convex.com
  31. X-Disclaimer: This message was written by a user at CONVEX Computer
  32.               Corp. The opinions expressed are those of the user and
  33.               not necessarily those of CONVEX.
  34.  
  35.  
  36. I am changing jobs, so this will be the final release of my audit
  37. package until I get a new UNIX account established. There are
  38. several little bugs fixed in this release that should fix
  39. lots of parsing problems - other than that, this package seems very solid
  40. and I have gotten good feedback on the usefulness of the package.
  41.  
  42. Enjoy...
  43.  
  44.  
  45. # ------------------------ cut here -------------------------------
  46. # This is a shell archive.  Remove anything before this line,
  47. # then unpack it by saving it in a file and typing "sh file".
  48. #
  49. # Wrapped by pixel!strike on Mon Jun  1 14:53:15 CDT 1992
  50. # Contents:  Bug_fixes CHANGES Installation README Suggestions audit.pl mh.pl
  51. #    refileto rfolder
  52.  
  53. echo x - Bug_fixes
  54. sed 's/^@//' > "Bug_fixes" <<'@//E*O*F Bug_fixes//'
  55. Bugs fixed since previous release:
  56.  
  57.     - @to and @cc are always created. 
  58.     - $apparentlyto is set to $headers{"apparently-to"} if it exists.
  59.     - mail header names that contain hyphens (return-path, replty-to,
  60.       etc.) are parsed correctly.
  61. @//E*O*F Bug_fixes//
  62. chmod u=rw,g=r,o=r Bug_fixes
  63.  
  64. echo x - CHANGES
  65. sed 's/^@//' > "CHANGES" <<'@//E*O*F CHANGES//'
  66. V0.2 Changes 
  67. ============
  68.  
  69. The variable $friendly now is set to the friendly part of the sender's
  70. email address. For example, if the sender's address is:
  71.  
  72.     strike@convex.com (Martin Streicher)
  73.  
  74. $friendly would be set to "Martin Streicher"
  75.  
  76.  
  77.  
  78. Keys for the %headers array are all lowercase. That is to say that if a mail
  79. message has headers:
  80.  
  81.     To: strike
  82.     Cc: george
  83.     From: zombie@foo.edu
  84.     Subject: News
  85.  
  86. the keys for %header will be "to", "from", "cc", "subject". $header{"subject"}
  87. would be set to "News"
  88.  
  89.  
  90.  
  91. The "Received" headers in a mail message are now saved in an array called
  92. @@received. The first element in the array is the first received header;
  93. that last element in the array would show the message being delivered to
  94. your machine. See the Suggestions file for how to use this feature.
  95.  
  96.  
  97.  
  98. If someone from your local machine sends you email, $organization
  99. is set to "local". If the site name (e.g.,"convex" for "pixel.convex.com")
  100. cannot be determined, $organization is set to "unknown". Also, $organization
  101. is much more reliable (I have not found a case yet where $organization
  102. was not set correctly.) 
  103.  
  104.  
  105.  
  106. $organization is always in lower-case.
  107.  
  108.  
  109.  
  110. audit.pl was broken up to make the code more reusable. The utilities
  111. refileto and refilefrom use some of the routines in audit.pl and mh.pl.
  112.  
  113.  
  114.  
  115. Fixed a bug that sometimes added NULL to an empty message body.
  116.  
  117.  
  118.  
  119. mh.pl has new routines to recursively create a directory path, parse your
  120. MH profile and parse MH-like command line options.
  121.  
  122.  
  123. New utilities
  124. =============
  125. There are two new utilities: refileto and rfolder and adjunts refilefrom
  126. and rfolders.
  127.  
  128. refileto is used to refile messages into log folders according to who
  129. you sent the messages to. refilefrom refiles messages you   have received
  130. according to who sent you the message. 
  131.  
  132. By default all messages are logged into the folder +log. You can change this
  133. by adding the line:
  134.  
  135.     Logdir:                 log
  136.  
  137. to your .mh_profile. Also by default, the current folder is processed.
  138. You can change that also. Here are the command line options for 
  139. refileto/refilefrom:
  140.  
  141. refileto -help
  142. syntax: refileto [msgs] [switches]
  143.    switches are:
  144.    -debug
  145.    -draft
  146.    -file file
  147.    -help
  148.    -link
  149.    -log +folder
  150.    -nolink
  151.    -nopreserve
  152.    -preserve
  153.    -rmmproc program
  154.    -src +folder
  155.    -verbose
  156.  
  157.  
  158. A sample usage might be:
  159.  
  160. refileto -src +outbox -verbose 
  161.  
  162. -verbose shows you what is being files and where. Use -debug to check what will
  163. happen without actually refiling the mail messages.
  164.  
  165. Here is a sample output of the command 
  166. "refileto -src +log/outgoing -verbose all":
  167.  
  168. refile  -file /gmaster/home/strike/Mail/log/outgoing/5 +log/local/holt
  169. refile  -file /gmaster/home/strike/Mail/log/outgoing/7 +log/convex/sowton
  170. refile  -file /gmaster/home/strike/Mail/log/outgoing/9 +log/convex/lutz 
  171.     +log/convex/sowton
  172.  
  173.  
  174.  
  175. The rfolder utility is like folders: it can recursively descend 
  176. a list of folders. However, you can use rfolder to run another MH command
  177. in every folder it finds. For example, let say you want to sort
  178. all of the subfolders in your +log folder.
  179.  
  180. You could say:
  181.  
  182. rfolder +log -all -recurse -verbose -exec sortm -textfield subject
  183.  
  184. -debug will show you what might happen without actually executing the
  185. command.
  186.  
  187. By the way, -clean can be used to remove empty folders (empty folders
  188. must be completely empty, without any .# or # files from rmm's, etc.)
  189.  
  190.  
  191. You can even use refileto/refilefrom and rfolder(s) to build a new 
  192. log directory from all your existing mail. Ala:
  193.  
  194. rfolder -all -recurse -verbose -exec refilefrom -log +log -src
  195.  
  196.  
  197. rfolders implis the -all -recurse flags
  198. @//E*O*F CHANGES//
  199. chmod u=rw,g=r,o=r CHANGES
  200.  
  201. echo x - Installation
  202. sed 's/^@//' > "Installation" <<'@//E*O*F Installation//'
  203. 1. Create a directory and unpack the perl files.
  204.  
  205. 2. Create a perl script to audit your mail. You might name it something
  206.    like ~/.audit.
  207.  
  208. 3. Follow the instruction in the README and require the files audit.pl
  209.    and mh.pl in your PERL script. 
  210.    
  211.    *
  212.    * BE SURE TO CHANGE THE PATH NAMES to 
  213.    * to the absolute path name of where you unpacked 
  214.    * the files in step 1.
  215.    *
  216.  
  217.    If you install the .pl file in /usr/lib/perl, you can just
  218.    require them as in "require 'audit.pl';"
  219.  
  220. 4. Create a .forward file in your home directory and add 
  221.  
  222.    " | <pathname of audit file> <login>"
  223.  
  224.    where <pathname> is the absolute path of your audit script
  225.    and <login> is your login name.
  226.  
  227. 5. If you are going to use the refileto and rfolder utilities,
  228.    also edit the unshift line to reference the NEW absolute path.
  229.  
  230.    By default it will look in the path reference by the environment
  231.    variable DELIVERPATH. You can change that to an absolute path
  232.    if you want to.
  233.  
  234.    If you installed audit.pl and mh.pl in /usr/lib/perl,
  235.    you can delete the unshift line.
  236.  
  237. 6. Make sure you chmod +x your audit file script!
  238.  
  239.  
  240. For example,
  241.  
  242. 1. My PERL files are in /gmaster/home/strike/work/perl/deliver.
  243.  
  244. 2. My audit script is in /gmaster/home/strike/.audit and has
  245.  
  246.     #! /usr/local/bin/perl
  247.  
  248.     require '/gmaster/home/strike/work/perl/deliver/audit.pl' || 
  249.         die "deliver: cannot include audit.pl: $@";
  250.  
  251.     require '/gmaster/home/strike/work/perl/deliver/mh.pl' || 
  252.         die "deliver: cannot include mh.pl: $@";
  253.  
  254.     &initialize();
  255.  
  256.  
  257.    at the very top of the file.
  258.  
  259. 4. My .forward file has:
  260.  
  261.    " | /gmaster/home/strike/.audit strike"
  262.  
  263. 5. I edited refileto and rfolder to say:
  264.  
  265.    unshift(@INC, "/gmaster/home/strike/work/perl/deliver");
  266.  
  267.    I could also have set DELIVERPATH ala
  268.  
  269.    setenv DELIVERPATH /gmaster/home/strike/work/perl/deliver
  270.  
  271. 6. I did:
  272.  
  273.    chmod +x /gmaster/home/strike/.audit
  274. @//E*O*F Installation//
  275. chmod u=rw,g=,o= Installation
  276.  
  277. echo x - README
  278. sed 's/^@//' > "README" <<'@//E*O*F README//'
  279. The audit.pl package. 
  280. =====================
  281.  
  282. What this package does:
  283. =======================
  284. This package provides routines that parse an incoming mail message, divide
  285. it into a header and the body of the message and further decompose
  286. the mail header into its fields. The routines set variables that you
  287. can query and parse in your own PERL script to determine what to do with
  288. the incoming mail message.
  289.  
  290. To use the package, insert the following two PERL instructions to the very
  291. TOP of your PERL script:
  292.  
  293. require '/gmaster/home/strike/work/perl/deliver/audit.pl' || 
  294.         die "deliver: cannot include audit.pl: $@";
  295.  
  296. &initialize();
  297.  
  298.  
  299. Variables that &initialize() sets:
  300. ---------------------------------
  301. The routine &initialize() reads the incoming mail message and sets
  302. the following variables:
  303.  
  304. $sender        This is the sender shown on the "From " line.
  305.  
  306. %headers    An associative array containing the lines in the mail
  307.         header. $header{'Subject'} contains the Subject: line;
  308.         $header{'Date'} contains Date:, etc. 
  309.         
  310.         If the To: or Cc: line appeared more than once in the header,
  311.         those lines are concatenated together into a single
  312.         comma-separated list of names. Other header lines that
  313.         appear twice are clobbered.
  314.  
  315. There are also many variables and arrays set for your convenience if you
  316. dont want to parse the entries of %headers yourself.
  317.  
  318. $subject    The Subject: line.
  319.  
  320. $precedence    The Precedence: line.
  321.  
  322. $friendly    The friendly (human) name of the sender
  323.         (e.g., Martin Streicher)
  324.  
  325. $address    The email address of the sender 
  326.         (e.g., strike@pixel.convex.com)
  327.  
  328. $from        The login name of the sender with all addressing stripped. For
  329.         example, if $address was strike@pixel.convex.com, $from
  330.         is strike.
  331.  
  332. $organization    The name of the sender's organization. This is derived from
  333.         $address; for example strike@pixel.convex.com yields convex;
  334.         wizard!jim@uunet.uu.net yields wizard; jane@mach.site.co.uk
  335.         yields site.
  336.  
  337. @@to        The list of names on the To: line(s). Note that the 
  338.         name listed on the Apparently-To: line also appears in @to.
  339.  
  340. @@cc        The list of names on the Cc: line(s).
  341.  
  342. @@received    The list of received headers in the mail message that
  343.         show the path the message traveled to be delivered.
  344.  
  345.  
  346. Routines that audit.pl provides:
  347. --------------------------------
  348. The package offers some canned routines for handling the incoming
  349. mail message:
  350.  
  351. &deliver()    Deliver the incoming mail message. &deliver() appends
  352.         the incoming mail message to the end of your UNIX mail
  353.         drop /usr/spool/mail/<user>, where <user> is the name
  354.         specified in the .forward file. 
  355.  
  356. &vacation()    Reply automatically to the sender if you have a vacation 
  357.         message in $HOME/.vacation.msg. If you do not have this
  358.         file, this routine does absolutely nothing. If you have
  359.         a .vacation.msg file, &vacation sends the sender of the
  360.         message an automatic reply containing that file.
  361.  
  362.         This routine also records who you sent 
  363.         vacation mail to; it will not send duplicate vacation messages
  364.         to the same person.  If you change your vacation message, the 
  365.         list is zeroed. The list of people you sent vacation mail to
  366.         is kept in $HOME/.vacation.log. 
  367.  
  368.         Some notes about &vacation():
  369.             - It will send you vacation mail. This is useful
  370.               to test your vacation message out.
  371.  
  372.             - It will not send vacation mail to anyone named
  373.               root, mailer-daemon, postmaster, daemon or mailer.
  374.               This are not considered to be real users.
  375.  
  376.             - It will not respond to mail that is labelled
  377.               with precendence bulk or junk.
  378.  
  379. &file_from() or 
  380. &file_from($dir)
  381.         This routine files the incoming mail message
  382.         in a hierarchy of mail folders. The top-level of the
  383.         hierarchy is specified in $dir; by default (if no
  384.         directory is specified) it is $HOME/log. The next level
  385.         of the hierachy is sorted by $organization; below this level
  386.         mail is sorted by the sender's login name.
  387.  
  388.         For example, say you receive a message from 
  389.         strike@pixel.convex.com; if you call &file_from(),
  390.         the corresponsing mail message will be filed into a mail
  391.         folder called $HOME/log/convex/strike. All mail sent to you
  392.         by strike@pixel.convex.com would be filed in this mail folder.
  393.  
  394.         You can &file_from to file all correspondence for future
  395.         reference.
  396.  
  397. &openpipe($command)
  398.         You can also use your own commands (scripts/programs)
  399.         to process an incoming mail message. &openpipe($command)
  400.         opens a PERL pipe to $command and pipes the mail message
  401.         to that command.
  402.  
  403. You can use none, one or all of these routines. You can also repeat
  404. and combine all of these functions to do more than one thing with a piece of 
  405. incoming mail (you probably only want to &deliver() the message once though).
  406.  
  407. For example, say you get a message from strike@pixel.convex.com. You want 
  408. to file the message away for auditing purposes, save the mail message in your 
  409. mail drop and send some vacation mail if you are gone. Use the &file_from(), 
  410. &deliver() and &vacation() functions to do all of these things to one message.
  411.  
  412. WARNING: IF YOU EXIT FROM THE PERL SCRIPT WITHOUT DOING SOMETHING
  413.      WITH THE MAIL MESSAGE, IT IS LOST FOREVER.
  414.  
  415. Actually, exiting the PERL script can be an effective way of dropping
  416. unwanted mail messages. See the example below.
  417.  
  418.  
  419. Other convenience functions for MH users:
  420. -----------------------------------------
  421. If you use MH, other convenience routines are provided to 
  422. pipe the incoming mail message to rcvstore, rcvdist and/or rcvtty.
  423. There is also a special refile routine to file incoming mail messages
  424. in folders according to the sender's organization and login. 
  425.  
  426. To access the MH functions, add the following line to the TOP of your script:
  427.  
  428. require '/gmaster/home/strike/work/perl/deliver/mh.pl' || 
  429.         die "deliver: cannot include mh.pl: $@";
  430.  
  431. This file provides the following functions:
  432.  
  433. &rcvstore($folder)    
  434.         Pipe the incoming mail message to rcvstore; the $folder
  435.         argument is the name of the folder to store the message
  436.         into.    
  437.  
  438. &rcvtty()    Pipe the incoming mail message to rcvtty. rcvtty
  439.         is MH's equivalent to biff and its output can be tailored
  440.         exactly like you can customize scan or inc. 
  441.  
  442. &rcvdist($names)
  443.         Pipe the incoming mail message to rcvdist. $names
  444.         is a blank separated list of names to send the
  445.         message to. You can use the &ali() command (see below)
  446.         to expand MH aliases.
  447.  
  448. &ali($alias)    Expand the MH alias name in $alias to the list
  449.         of addresses it stands for. Unlink all the other routines,
  450.         this routine returns an array of names, where
  451.         each element is an addressee on the alias.
  452.  
  453. &refile_from() or
  454. &refile_from($dir)
  455.         File a copy of the incoming mail message into a hierarchy of
  456.         MH folders. The top-level directory is "log" by default unless
  457.         you specify another folder (all this below you Mailpath folder,
  458.         of course). The next level is sorted by organization name
  459.         and the level below that is sorted by sender's login name.
  460.  
  461.  
  462.  
  463. Writing a PERL mail auditing script:
  464. ====================================
  465. The best way to show what all this can do is with a specific example. Here 
  466. is my script (with comments!):
  467.  
  468. ------ script starts here -------
  469. #! /usr/local/bin/perl
  470.  
  471. require '/gmaster/home/strike/work/perl/deliver/audit.pl' || 
  472.         die "deliver: cannot include audit.pl: $@";
  473.  
  474. require '/gmaster/home/strike/work/perl/deliver/mh.pl' || 
  475.         die "deliver: cannot include mh.pl: $@";
  476.  
  477. &initialize();
  478.  
  479.  
  480. # -----
  481. # My mail processing starts here
  482. #
  483.  
  484. # If this message came from the MAILER, deliver it to me directly
  485. # and do nothing else.
  486. #
  487. ($from =~ /MAILER/) && do { &deliver(); exit; };
  488.  
  489. # If this message is sent to xpixel (either To or Cc, deliver
  490. # the messsage to me and exit.
  491. #
  492. (grep(/^xpixel/, @to, @cc)) && do { &deliver(); exit; };
  493.  
  494. # If the message is from a place called "lupine", this
  495. # is really NCD.
  496. #
  497. $organization = "ncd" if ($organization eq "lupine");
  498.  
  499. # If the sender's name is in the password file, the organization
  500. # is CONVEX.
  501. #
  502. $organization = "convex" if ($logname = (getpwnam($from))[0]);
  503.  
  504. # If I am specifically named on the To or Cc line, do the default.
  505. # The routine &default is below: it delivers the message, refiles
  506. # it in an MH folder, sends vacation mail if I am gone, and
  507. # biffs me if I am logged in somewhere.
  508. #
  509. (grep(/^strike/, @to, @cc)) && do { 
  510.     &default();
  511.     exit;
  512. };
  513.  
  514. # If the mail message went to x<hostname> where hostname
  515. # is in our /etc/hosts, trash the message (JUST EXIT TO DROP
  516. # THE MESSAGE)
  517. #
  518. exit if (grep((/^x(.*)/ && (@n = gethostbyname($1))), @to, @cc));
  519.  
  520. # Throw away anything to anyone or any alias named avs-updates
  521. #
  522. exit if (grep(($_ eq "avs-updates"), @to));
  523.  
  524. # Throw away junk mail from AVS, Inc.
  525. #
  526. if ($organization eq "avs") {
  527.     exit if ($subject =~ /^(Opened|Assigned) to/);
  528.     exit if ($subject =~ /^(Edited|Fixed|Killed) by/);
  529. };
  530.  
  531.  
  532. # If the mail message went to an X Consortium alias,
  533. # deliver it to me if it is advisory board mail. Otherwise,
  534. # refile it into an archive and redistribute it to anyone at CONVEX
  535. # that subscribes to it through me.
  536. #
  537. $xcons = 0;
  538. @@consortium = (
  539.     '/^advisory/',    '/^blend/',        '/^bug-trackers/',
  540.     '/^color/',    '/^fix-trackers/',    '/^fontwork/',
  541.     '/^imagework/',    '/^xlib/',        '/intrinsics/',
  542.     '/^mltalk/',    '/^pex-si/',        '/^pex-spec/',
  543.     '/^protocol/',    '/^security/',        '/^shape/',        
  544.     '/^trackers/',    '/^transport/',        '/^wmtalk/',        
  545.     '/^xbuffer/',    '/^xc/',        '/^xinput/',            
  546.     '/^xtest/',    '/^consortium/',    '/^serialwork/',
  547.     '/^xie_/',    '/^mtserver/'
  548. );
  549.  
  550. foreach $list (@consortium) {
  551.     for (grep(eval $list, @to, @cc)) {
  552.        &deliver() if ($_ =~ "^advisory");
  553.        $xcons++;
  554.        &rcvstore("XConsortium/$_"); 
  555.        @dist = &ali("XConsortium-$_");
  556.        &rcvdist(join(' ', @dist)) if ((@dist)); 
  557.     };
  558. };
  559. exit if $xcons;
  560.  
  561.  
  562. # this mail was not sent to me directly, so dont answer with vacation mail,
  563. #
  564. &deliver();
  565. &rcvtty();
  566.  
  567. # All done!
  568. #
  569. exit;
  570.  
  571.  
  572. # =====
  573. # Subroutine default
  574. #     defaults specifies what to do when I want to accept a piece
  575. #    of mail. It is a convenience.
  576. sub default {
  577.  
  578.     &deliver();
  579.     &vacation();
  580.     &rcvtty();
  581.     &refile_from();
  582. }
  583.  
  584. ------ script ends ----------
  585.  
  586.  
  587. Testing
  588. ========
  589. If you want to test your PERL script, put the following in your .forward file:
  590.  
  591.     <login>, "| <homedir>/<script> <login>
  592.  
  593. where <login> is your UNIX login, <homedir> is the absolute path name
  594. to your home directory and <script> is the name of your PERL mail
  595. auditing script. If you put this in .forward, incoming mail messages
  596. will be directly sent to your mail drop AND will be piped through your
  597. PERL script. You may get duplicates of some mail, but this is the best
  598. way to see what your script is doing.
  599.  
  600. Once you are satisifed that your script works, simply replace your
  601. @.forward file with:
  602.  
  603.     "| <homedir>/<script> <login>
  604.  
  605. Please note that if your script has syntax errors, the mailer will
  606. not drop your incoming mail; instead it will send you a the incoming
  607. mail message and a note indicating that an unknown mailer error occurred.
  608.  
  609. Another way to test your script:
  610. --------------------------------
  611. You can also test your script by piping a UNIX mail folder (like your 
  612. mail drop) directly into your script. For example, say you are having
  613. problems with mail from a certain sender or network alias; to debug your
  614. script, copy your incoming mail box in /usr/spool/mail to a local file
  615. and then pipe it to your script ala:
  616.  
  617.     cat mail | perl -d ~/.audit
  618.  
  619. You can then step through the script and see how the mail message
  620. is being parsed. You can add breakpoints, print statements, etc. and see
  621. the script operate on the mail. If you use &vacation() or &file_from(),
  622. you can watch those routines operate as well. The mail message is processed 
  623. as if it came directly to your script courtesy of the delivery system.
  624. @//E*O*F README//
  625. chmod u=rw,g=,o= README
  626.  
  627. echo x - Suggestions
  628. sed 's/^@//' > "Suggestions" <<'@//E*O*F Suggestions//'
  629. Date: Mon, 30 Mar 92 08:07:45 PST
  630. @From: David Vezie <dv@cc-mac.nbn.com>
  631.  
  632.     That is, that the Received: lines might be useful.  For the person who
  633.     wanted to avoid infinite loops, the problem could be solved by your
  634.     package if you enabled the individual Received: lines to be parsed.
  635.     He could, for example do:
  636.  
  637.     rcvdist("myself@siteB") if ( ! grep (/siteB/, @received));
  638.  
  639.     (If there is no Received: line for siteB, he would forward it to siteB,
  640.     thus preventing infinite loops).  The mirror system would be on siteB for
  641.     siteA.
  642.  
  643.     (Actually, I could do the same thing!  I have the same (or a similar)
  644.     problem).
  645.  
  646. Completed: 3/31/92
  647.  
  648. @//E*O*F Suggestions//
  649. chmod u=rw,g=r,o=r Suggestions
  650.  
  651. echo x - audit.pl
  652. sed 's/^@//' > "audit.pl" <<'@//E*O*F audit.pl//'
  653. #
  654. #
  655. # $Revision: 1.13 $
  656. # $Date: 92/05/12 14:34:18 $
  657. #
  658. #
  659.  
  660. # =====
  661. # Subroutine initialize
  662. #    Set up the environment for the user and parse the incoming
  663. #    mail message. 
  664. #
  665. sub initialize {
  666.     local($passwd, $uid, $gid, $quota, $comment, $gcos);
  667.  
  668.     ($user, $passwd, $uid, $gid, $quota, $comment, $gcos, $home, $shell) = 
  669.     getpwnam($ARGV[0]); shift @ARGV;
  670.  
  671.     $ENV{'USER'} = $user;
  672.     $ENV{'HOME'} = $home;
  673.     $ENV{'SHELL'} = $shell;
  674.     $ENV{'TERM'} = "vt100";
  675.  
  676.     &parse_message(STDIN);
  677. }
  678.  
  679.  
  680. # =====
  681. # Subroutine parse_message
  682. #    Parse a message into headers, body and special variables
  683. #
  684. sub parse_message {
  685.     local(*INFILE) = @_;
  686.  
  687.     $/ = '';        # read input in paragraph mode
  688.     %headers = ( );
  689.     @received = ( );
  690.     undef($body);
  691.  
  692.     $header = <INFILE>;
  693.  
  694.     $* = 1;
  695.     while (<INFILE>) { 
  696.     s/^From />From /g;
  697.     $body = "" if !defined($body);
  698.     $body .= $_; 
  699.     };
  700.     $/ = "\n";        
  701.     $* = 0;
  702.  
  703.  
  704.     ;# -----
  705.     ;# $sender comes from the UNIX-style From line (From strike...)
  706.     ;#
  707.     ($sender) = ($header =~ /^From\s+(\S+)/); 
  708.  
  709.  
  710.     ;# -----
  711.     ;# fill out the headers associative array with fields from the mail
  712.     ;# header.
  713.     ;#
  714.     $_ = $header;
  715.     s/\n\s+//g;
  716.     @lines = split('\n');
  717.     for ( @lines ) {
  718.     /^([\w-]*):\s*(.*)/ && do {
  719.         $mheader = $1;
  720.         $mheader =~ tr/A-Z/a-z/;
  721.         if (($mheader eq "cc" || $mheader eq "to") && $headers{$mheader}) {
  722.         $headers{$mheader} .= ", $2";
  723.         } elsif ($mheader eq "received") {
  724.         push(@received, $2);
  725.         } else {
  726.         $headers{$mheader} = $2;
  727.         };
  728.     };
  729.     }
  730.     @received = reverse(@received);
  731.  
  732.  
  733.     ;# -----
  734.     ;# for convenience, $subject is $headers{'subject'} and $precedence is
  735.     ;# $headers{'precedence'}
  736.     ;#
  737.     $subject = $headers{'subject'};
  738.     $subject = "(No subject)" unless $subject;
  739.     $subject =~ s/\s+$//;
  740.     $precedence = $headers{'precedence'};
  741.  
  742.  
  743.     ;# -----
  744.     ;# create arrays for who was on the To, Cc lines
  745.     ;#
  746.     @cc = &expand($headers{'cc'});
  747.     @to = &expand($headers{'to'}); 
  748.     defined($headers{"apparently-to"}) && do {
  749.     $apparentlyto = $headers{"apparently-to"};
  750.     push(@to, &expand($apparentlyto));
  751.     };
  752.  
  753.     ;# -----
  754.     ;# $from comes from From: line. $address is their email address.
  755.     ;# $organization is their site. for example, strike@pixel.convex.com 
  756.     ;# yields an organization of convex.
  757.     ;#
  758.     $_ = $headers{'from'} ||
  759.          $headers{'resent-from'} ||
  760.          $headers{'sender'} ||
  761.          $headers{'resent-sender'} ||
  762.          $headers{'return-path'} ||
  763.          $headers{'reply-to'};
  764.  
  765.     if ($_ eq "") {
  766.        $friendly = $from = $address = $organization = "unknown";
  767.        return;
  768.     };
  769.  
  770.     ($friendly, $address, $from, $organization) = &parse_email_address($_);
  771. }
  772.  
  773.  
  774. # =====
  775. # Subroutine parse_email_address
  776. #    Parse an email address into address, from, organization
  777. #    address is full Internet address, from is just the login
  778. #    name and organization is Internet hostname (without final domain)
  779. #
  780. sub parse_email_address {
  781.     local($_) = @_;
  782.     local($friendly, $address, $from, $organization);
  783.  
  784.     $organization = "local";
  785.     $friendly = "unknown";
  786.  
  787. # From: Disk Monitor Daemon (/usr/adm/bin/dfbitch) <daemon@hydra.convex.com>?
  788.  
  789.     s/^\s*//;
  790.     s/\s*$//;
  791.     if (/(.*)\s*<[^>]+>$|<[^>]+>\s*(.*)$/) {
  792.     $friendly = $+;
  793.     $friendly =~ s/\"//g;
  794.     } elsif (/\(([^\)]+)\)/) {
  795.     $friendly = $1;
  796.     };
  797.  
  798.     s/.*<([^>]+)>.*/$1/;
  799.     s/\(.*\)//;
  800.     s/\s*$//;
  801.     $address = $_;
  802.  
  803.     s/@.*//;
  804.     s/%.*//;
  805.     s/.*!//;
  806.     s/\s//g;
  807.     $from = $_;
  808.  
  809.     $_ = $address;
  810.     tr/A-Z/a-z/;
  811.     if (/!/ && /@/) {
  812.         s/\s//g;
  813.         s/!.*//;
  814.         $organization = $_;
  815.     } elsif (/!/) {
  816.         s/\s//g;
  817.         s/![A-Za-z0-9_@]*$//;
  818.         s/.*!//;
  819.         s/\..*//;
  820.         $organization = $_;
  821.     } elsif (/@/) {
  822.         s/.*@//;
  823.         s/\s//g;
  824.         if (! /\./) {
  825.             $organization = "unknown";
  826.         } else {
  827.             if (/\.(com|edu)$/) {
  828.                 s/\.[A-Za-z0-9_]*$//;
  829.                 s/.*\.//;
  830.             } else {
  831.                 s/\.[A-Za-z0-9_]*$//;
  832.                 s/\.[A-Za-z0-9_]*$//;
  833.                 s/.*\.//;
  834.             };
  835.             $organization = $_;
  836.         };
  837.     };
  838.  
  839.     return ($friendly, $address, $from, $organization);
  840. };
  841.  
  842.  
  843. # ====
  844. # Subroutine vacation
  845. #    deliver a vacation message to the sender of this mail
  846. #    message.
  847. #
  848. sub vacation {
  849.     local($vacfile) = $ENV{'HOME'} . "/" . ".vacation.msg";
  850.     local($msubject) = "\"Vacation mail for $ENV{'USER'} [Re: $subject]\" ";
  851.     local($vacaudit, $astat, $mstat);
  852.     local(@ignores);
  853.     local(@names);
  854.  
  855.     return if (length($from) <= 0);
  856.     return if ($precedence =~ /(bulk|junk)/i);
  857.     return if ($from =~ /-REQUEST@/i);
  858.  
  859.     @ignores = ('daemon', 'postmaster', 'mailer-daemon', 'mailer', 'root',);
  860.     grep(do {return if ($_ eq $from);}, @ignores);
  861.  
  862.     if (-e $vacfile) {
  863.     ($vacaudit = $vacfile) =~ s/\.msg/\.log/;
  864.  
  865.     $mstat = (stat($vacfile))[9];
  866.     $astat = (stat($vacaudit))[9];
  867.     unlink($vacaudit) if ($mstat > $astat);
  868.  
  869.         if (-f $vacaudit) {
  870.         open(VACAUDIT, "< $vacaudit") && do {
  871.         while (<VACAUDIT>) {
  872.             chop; 
  873.             return if ($_ eq $from);
  874.         };
  875.         close(VACAUDIT);
  876.         };
  877.         };
  878.  
  879.         open(MAIL,"| /usr/ucb/Mail -s $msubject $address") || return;
  880.         open(VACFILE, "< $vacfile") || return;    
  881.         while (<VACFILE>) {
  882.         s/\$SUBJECT/$subject/g;
  883.             print MAIL $_;
  884.         };
  885.         close(VACFILE);
  886.         close(MAIL);
  887.  
  888.         open(VACAUDIT, ">> $vacaudit") || return;
  889.         print VACAUDIT "$from\n";
  890.         close(VACAUDIT);
  891.     };
  892. }
  893.  
  894.  
  895. # =====
  896. # Subroutine expand
  897. #     expand a line (To, Cc, etc.) into a list of addressees.
  898. #
  899. sub expand {
  900.     local($_) = @_;
  901.     local(@fccs) = ( );
  902.  
  903.     return(@fccs) if /^$/;
  904.  
  905.     for (split(/\s*,\s*/)) {
  906.     s/.*<([^>]+)>.*/$1/;
  907.     s/@.*//;
  908.     s/.*!//;
  909.     s/\(.*\)//;
  910.     s/\s//g;
  911.     push(@fccs,$_) unless $seen{$_}++;
  912.     } 
  913.  
  914.     return(@fccs);
  915. } 
  916.  
  917.  
  918. # =====
  919. # Subroutine deliver
  920. #    Deliver the incoming mail message to the user's mail drop
  921. #
  922. sub deliver {
  923.  
  924.     &deposit("/usr/spool/mail/$user");
  925. }
  926.  
  927.  
  928. # =====
  929. #    Put the incoming mail into the specified mail drop (file)
  930. #
  931. sub deposit {
  932.     local($drop) = @_;
  933.     local($LOCK_EX) = 2;
  934.     local($LOCK_UN) = 8;
  935.  
  936.     open(MAIL, ">> $drop") || die "open: $!\n";
  937.     flock(MAIL, $LOCK_EX);
  938.     seek(MAIL, 0, 2);
  939.  
  940.     print MAIL "$header";
  941.     print MAIL "$body\n\n" if defined($body);
  942.  
  943.     flock(MAIL, $LOCK_UN);
  944.     close(MAIL);
  945. }
  946.  
  947.  
  948. # =====
  949. # Subroutine file_from
  950. #    Add the mail message to another mail drop in a log directory.
  951. #    The path of the mail drop is toplevel/organization/user
  952. #
  953. sub file_from {
  954.     local($toplevel) = @_;
  955.     local($dir);
  956.  
  957.     return if (length($from) <= 0);
  958.     return if ($from eq $user);
  959.  
  960.     $toplevel = "log" if ($toplevel eq '');
  961.  
  962.     $dir = "$home/$toplevel";
  963.     (!-d $dir) && mkdir($dir, 0700);
  964.     $dir .= "/$organization";
  965.     (!-d $dir) && mkdir($dir, 0700);
  966.  
  967.     &deposit("$dir/$from");
  968. }
  969.  
  970.  
  971. # =====
  972. # Subroutine openpipe
  973. #    Open a pipe to a command and write the mail message to it.
  974. #
  975. sub openpipe{
  976.     local($command) = @_;
  977.  
  978.     open(CMD, "| $command") || die;
  979.     print CMD "$header\n";
  980.     print CMD "$body\n\n" if defined($body);
  981. }
  982.  
  983. 1;
  984. @//E*O*F audit.pl//
  985. chmod u=rw,g=r,o=r audit.pl
  986.  
  987. echo x - mh.pl
  988. sed 's/^@//' > "mh.pl" <<'@//E*O*F mh.pl//'
  989.  
  990.  
  991. # =====
  992. # Subroutine mh_profile
  993. #    Parse the user's .mh_profile and get arguments and settings
  994. #
  995. sub mh_profile {
  996.     local($PROFILE);
  997.  
  998.     ($PROFILE = $ENV{"MH"}) || ($PROFILE = $ENV{"HOME"} . "/.mh_profile");
  999.  
  1000.     open PROFILE || "$0: can't read mh_profile $PROFILE: $!\n";
  1001.  
  1002.     while (<PROFILE>) {
  1003.     next if /^#/;
  1004.     next unless ($key, $value) = /([^:\s]+):\s*(.+)/;
  1005.     $key =~ tr/A-Z/a-z/;
  1006.     $MH{$key} = $value;
  1007.     } 
  1008.     close PROFILE;
  1009.  
  1010.     $MH{'path'} = $ENV{'HOME'} . '/' . $MH{'path'};
  1011. } 
  1012.  
  1013.  
  1014. # =====
  1015. # Subroutine rcvstore
  1016. #    Convenience routine for MH users. Pipes incoming
  1017. #    mail message to rcvstore. Expects one argument - the 
  1018. #    name of the folder to rcvstore into.
  1019. #
  1020. sub rcvstore {
  1021.     local($folder) = @_;
  1022.  
  1023.     &openpipe("/usr/local/bin/mh/lib/rcvstore +$folder -create");
  1024. }
  1025.  
  1026.  
  1027. # =====
  1028. # Subroutine rcvdist
  1029. #    Convenience routine for MH users. Pipes incoming
  1030. #    mail message to rcvdist. Expects one argument - the 
  1031. #    list of users to distribute the mail message to
  1032. #
  1033. sub rcvdist {
  1034.     local($recips) = @_;
  1035.  
  1036.     &openpipe("/usr/local/bin/mh/lib/rcvdist $recips");
  1037. }
  1038.  
  1039.  
  1040. # =====
  1041. # Subroutine rcvtty
  1042. #    Convenience routine for MH users. Pipes incoming
  1043. #    mail message to rcvtty. This is MH's version of biff.
  1044. #
  1045. sub rcvtty {
  1046.  
  1047.     &openpipe("/usr/local/bin/mh/lib/rcvtty");
  1048. }
  1049.  
  1050.  
  1051. # =====
  1052. # Subroutine ali
  1053. #       Expand an MH alias into a list of names usable by
  1054. #       rcvdist
  1055. #
  1056. sub ali {
  1057.     local($alias) = @_;
  1058.     local($recips); 
  1059.     local(@list) = ();
  1060.  
  1061.     $recips = `/usr/local/bin/mh/ali $alias`;
  1062.     chop $recips;
  1063.     return(@list) if ($alias eq $recips);
  1064.  
  1065.     @list = split(/,/, $recips);
  1066.     return(@list);
  1067. }
  1068.  
  1069.  
  1070. # =====
  1071. # Subroutine refile_from
  1072. #    Refile a message into a folder by organization and 
  1073. #    sender name. The top-level folder is an argument
  1074. #    the user can specify.
  1075. #
  1076. sub refile_from {
  1077.     local($toplevel) = @_;
  1078.  
  1079.     return if (length($from) <= 0);
  1080.     return if ($from eq $user);
  1081.  
  1082.     $toplevel = "log" if ($toplevel eq '');
  1083.     &rcvstore("$toplevel/$organization/$from");
  1084. }
  1085.  
  1086. # =====
  1087. # Subroutine make_mhpath
  1088. #    Make a directory path recursively. 
  1089. #
  1090. sub make_mhpath {
  1091.     local($dir) = @_;
  1092.     local($i);
  1093.     local($mode) = 0755;
  1094.  
  1095.     $mode = oct($MH{'folder-protect'}) if (defined $MH{'folder-protect'});
  1096.  
  1097.     $_ = $dir;
  1098.     s#^/.*#/# || s#^[^/].*#.#;
  1099.     $start = $_;
  1100.     foreach $i (split('/', $dir)) {
  1101.     $start = $start . '/' . $i;
  1102.     next if (-d $start);
  1103.     mkdir($start, $mode) || return(1);
  1104.     };
  1105.  
  1106.     return(0);
  1107. } 
  1108.  
  1109.  
  1110. # =====
  1111. # Subroutine mh_parse
  1112. #    Parse the command line options
  1113. #
  1114. sub mh_parse {
  1115.     local(@argdesc) =  @SW;
  1116.     local($wantarg);
  1117.  
  1118.     while (($#ARGV >= 0) && ($ARGV[0] !~ /^-.+/)) { # must be a message list
  1119.     push(@MSGS, shift @ARGV);
  1120.     };
  1121.  
  1122.     grep(s/(\W)/\\$1/g, @argdesc);
  1123.  
  1124.     @ARGV = (split(' ', $MH{$program}), @ARGV) if defined($MH{$program});
  1125.  
  1126.     return if ($#ARGV < 0);
  1127.  
  1128.     while ($ARGV[0] =~ /^-.+/) {
  1129.  
  1130.         $ARGV = shift @ARGV;
  1131.  
  1132.         unless (@matches = grep(/$ARGV/, @argdesc)) {
  1133.             print "$program: unknown option: $ARGV\n";
  1134.             exit 1;
  1135.             &usage;
  1136.         } 
  1137.  
  1138.         for (@matches) { s/\\(\W)/$1/g; } 
  1139.  
  1140.         if ($#matches > $[) {
  1141.             print "$program: ambiguous switch $ARGV matches:\n";
  1142.             for (@matches) { 
  1143.                 print "\    ", $_, "\n"; 
  1144.             }
  1145.             exit 1;
  1146.         } 
  1147.  
  1148.         ($switch,$wantarg) = $matches[$[] =~ /^-(\S+)\s*(\S*)/;
  1149.  
  1150.         $SW{$switch} = $wantarg ? shift @ARGV : 1;
  1151.         if ($SW{$switch} =~ /^(['"]).*$/ && $SW{$switch} !~ /^(['"]).*\1$/) {
  1152.             do {
  1153.                 $SW{$switch} .= ' ' . (shift @ARGV);
  1154.             } until $#ARGV < 0 || $SW{$switch} =~ /^(['"]).*\1$/;
  1155.             $SW{$switch} =~ s/^(['"])(.*)\1$/$2/;
  1156.         } 
  1157.     }
  1158. }
  1159.  
  1160.  
  1161. # =====
  1162. # Subroutine print_switches
  1163. #    print the valid command line switches
  1164. #
  1165. sub print_switches {
  1166.     local(@argdesc) = @SW;
  1167.  
  1168.     print "   switches are:\n";
  1169.     for (sort @SW) {
  1170.     print "   $_\n";
  1171.     };
  1172.     print "\n";
  1173. }
  1174.  
  1175.  
  1176. 1;
  1177. @//E*O*F mh.pl//
  1178. chmod u=rw,g=r,o=r mh.pl
  1179.  
  1180. echo x - refileto
  1181. sed 's/^@//' > "refileto" <<'@//E*O*F refileto//'
  1182. #!/usr/bin/perl
  1183.  
  1184. $program = $0;
  1185. $program =~ s|.*/||;
  1186. $| = 1;
  1187.  
  1188. unshift(@INC, $ENV{'DELIVERPATH'});
  1189. require 'audit.pl' || die "$program: cannot include audit.pl: $@";
  1190. require 'mh.pl' || die "$program: cannot include mh.pl: $@";
  1191.  
  1192. @@SW = (
  1193.     '-debug',
  1194.     '-draft',
  1195.         '-file file',
  1196.     '-help',
  1197.     '-link',
  1198.     '-log +folder',        # defaults to +log
  1199.     '-nolink',
  1200.     '-nopreserve',
  1201.     '-preserve',
  1202.       '-rmmproc program',
  1203.     '-src +folder',        # defaults to current folder
  1204.     '-verbose',
  1205.       );
  1206.  
  1207.  
  1208. &mh_profile();
  1209. &mh_parse();
  1210.  
  1211.  
  1212. defined($SW{'help'}) && do {
  1213.     print "syntax: $program [msgs] [switches]\n";
  1214.     &print_switches();
  1215.     exit;
  1216. };
  1217.  
  1218.  
  1219. @@args = (defined(@MSGS) ? @MSGS : @ARGV);
  1220.  
  1221.  
  1222. $logdir = $SW{'log'} || $MH{'logdir'} || "+log";
  1223. ($logdir = '+' . $logdir) if ($logdir !~ /\+/);
  1224. $folder = `mhpath cur`; chop $folder; $folder =~ s|/\d+$||;
  1225. $folder = $SW{'src'} if defined($SW{'src'});
  1226. ($folder = '+' . $folder) if ($folder !~ /\+/);
  1227.  
  1228.  
  1229. $SW{'file'} = "$MH{'path'}/draft" if defined($SW{'draft'});
  1230. if (defined($SW{'file'})) {
  1231.     @paths = ($file);
  1232. } else {
  1233.     @paths = `mhpath $folder @args`; chop @paths;
  1234. };
  1235.  
  1236.  
  1237. @@refileargs = ( );
  1238. for ('link', 'nolink', 'preserve', 'nopreserve') {
  1239.     push(@refileargs, "-$_") if defined($SW{$_});
  1240. };
  1241. push(@refileargs, "-rmmproc", $SW{'rmmproc'}) if defined($SW{'rmmproc'});
  1242.  
  1243.  
  1244. foreach $msg (@paths) {
  1245.     open(MESSAGE, "< $msg") || next;
  1246.  
  1247.     &local_parse_message(MESSAGE);
  1248.  
  1249.     # -----
  1250.     # if -from was specified use the From line; if -to is specified use
  1251.     # the To line. 
  1252.     #
  1253.     $header = $headers{'from'} if ($program eq "refilefrom");
  1254.     $header = $headers{'to'} if ($program eq "refileto");
  1255.     $header = $header . ',' . $headers{'cc'} if 
  1256.     (($program eq "refileto") && defined($headers{'cc'}));
  1257.  
  1258.     @nfolders = ( ); 
  1259.     foreach $addr (split(',', $header)) {
  1260.        ($friendly, $address, $name, $org) = &parse_email_address($addr);
  1261.        $org = "local" if ($org eq "unknown");
  1262.        push(@nfolders, "$logdir/$org/$name");
  1263.     };
  1264.  
  1265.     @mfolders = ( );
  1266.     foreach $folder (@nfolders) {
  1267.        $fpath = `mhpath $folder`; chop $fpath;
  1268.        if (-d $fpath || ! &make_mhpath($fpath)) {
  1269.            push(@mfolders, $folder);
  1270.        } else {
  1271.        warn "cannot make directory $fpath: $!\n";
  1272.        };
  1273.     };
  1274.  
  1275.     print "refile @refileargs -file $msg @mfolders\n" if 
  1276.     (@mfolders && defined($SW{'verbose'}));
  1277.     system "refile -file $msg @mfolders" if 
  1278.     (@mfolders && !defined($SW{'debug'}));
  1279.  
  1280.     close(MESSAGE);
  1281. };
  1282.  
  1283.  
  1284. # =====
  1285. # Subroutine local_parse_message
  1286. #    A simplified version of parse_message that does
  1287. #    not care about the body of the message
  1288. #
  1289. sub local_parse_message {
  1290.     local(*INFILE) = @_;
  1291.     local($header, $body, $mheader);
  1292.  
  1293.     $/ = '';        # read input in paragraph mode
  1294.     %headers = ( );
  1295.     @received = ( );
  1296.  
  1297.     $header = <INFILE>;
  1298.     $/ = "\n";        
  1299.     $* = 0;
  1300.  
  1301.     # -----
  1302.     # fill out the headers associative array with fields from the mail
  1303.     # header.
  1304.     #
  1305.     $_ = $header;
  1306.     s/\n\s+//g;
  1307.     @lines = split('\n');
  1308.     for ( @lines ) {
  1309.     /^(\w*):\s*(.*)/ && do {
  1310.         $mheader = $1;
  1311.         $mheader =~ tr/A-Z/a-z/;
  1312.         if (($mheader eq "cc" || $mheader eq "to") && $headers{$mheader}) {
  1313.         $headers{$mheader} .= ", $2";
  1314.         } else {
  1315.         $headers{$mheader} = $2;
  1316.         };
  1317.     };
  1318.     }
  1319.  
  1320.     return;
  1321. }
  1322. @//E*O*F refileto//
  1323. chmod u=rwx,g=,o= refileto
  1324.  
  1325. echo x - rfolder
  1326. sed 's/^@//' > "rfolder" <<'@//E*O*F rfolder//'
  1327. #!/usr/bin/perl
  1328.  
  1329. $program = $0;
  1330. $program =~ s|.*/||;
  1331. $| = 1;
  1332.  
  1333. unshift(@INC, $ENV{'DELIVERPATH'});
  1334. require 'audit.pl' || die "$program: cannot include audit.pl: $@";
  1335. require 'mh.pl' || die "$program: cannot include mh.pl: $@";
  1336.  
  1337.  
  1338. @@SW = (
  1339.     '-exec',
  1340.     '-except "+folder..."',
  1341.     '-all',
  1342.     '-verbose',
  1343.     '-clean',
  1344.     '-debug',
  1345.     '-recurse',
  1346.     '-norecurse',
  1347.     '-help',
  1348.       );
  1349.  
  1350.  
  1351. &mh_profile();
  1352.  
  1353. ($folder = shift @ARGV) if ($ARGV[0] =~ /^\+/);
  1354.  
  1355. &mh_parse();
  1356.  
  1357. defined($SW{'help'}) && do {
  1358.     print "syntax: $program [+folder] [switches] [-exec MH command]\n";
  1359.     &print_switches();
  1360.     exit;
  1361. };
  1362.  
  1363.  
  1364. #if (!defined($folder)) {
  1365. #    $mailpath = $MH{'path'} . '/';
  1366. #    $folder = `mhpath`; chop $folder; 
  1367. #    $folder =~ s|^$mailpath|\+|;
  1368. #};
  1369.  
  1370.  
  1371. @@args = (($program =~ /s$/) ? ("-all") : ( )); 
  1372. for ('all', 'recurse', 'norecurse') {
  1373.     push(@args, "-$_") if defined($SW{$_});
  1374. };
  1375.  
  1376.  
  1377. if (defined($SW{'exec'})) {
  1378.     @command = @ARGV;
  1379. } else {
  1380.     exec "folder $folder @args";
  1381. };
  1382.  
  1383.  
  1384. $path = `mhpath $folder`; chop $path;
  1385. die "$0: unable to change directory to $path: No such file or directory.\n" 
  1386.     if (! -d $path);
  1387.  
  1388.  
  1389. open(FOLDERS, "folder $folder @args -fast -noheader |") || die 
  1390.     "$0: cannot find list of folders: $?";
  1391.  
  1392. @@exceptions = split(' ', $SW{'except'});
  1393.  
  1394. SKIP:
  1395. while (<FOLDERS>) {
  1396.     chop; 
  1397.     for $ef (@exceptions) {
  1398.     ($f = $ef) =~ s/^\+//;
  1399.     next SKIP if ($_ =~ m|$f|);
  1400.     $f = `mhpath +$f`; chop $f;
  1401.     next SKIP if ($_ eq $f);
  1402.     };
  1403.  
  1404.     if (defined($SW{'clean'})) {
  1405.     $contents = `folder +$_ -total`; 
  1406.     if ($contents =~ /\s+0\s+messages/) {
  1407.         print "removing empty folder +$_...\n" if defined($SW{'verbose'});
  1408.         $f = `mhpath +$_`; chop $f;
  1409.         rmdir($f) unless defined($SW{'debug'});
  1410.         next; 
  1411.     };
  1412.     };
  1413.  
  1414.     print "@command +$_ \n" if defined($SW{'verbose'});
  1415.     system "@command +$_" unless (defined($SW{'debug'})); 
  1416.     print "\n";
  1417. };
  1418.  
  1419. close(FOLDERS);
  1420.  
  1421. @//E*O*F rfolder//
  1422. chmod u=rwx,g=,o= rfolder
  1423.  
  1424. echo Inspecting for damage in transit...
  1425. temp=/tmp/shar$$; dtemp=/tmp/.shar$$
  1426. trap "rm -f $temp $dtemp; exit" 0 1 2 3 15
  1427. cat > $temp <<\!!!
  1428.        6      34     237 Bug_fixes
  1429.      132     538    3600 CHANGES
  1430.       71     275    1896 Installation
  1431.      345    1791   11654 README
  1432.       19     103     659 Suggestions
  1433.      331     882    7162 audit.pl
  1434.      188     530    3927 mh.pl
  1435.      140     422    3242 refileto
  1436.       94     247    1855 rfolder
  1437.     1326    4822   34232 total
  1438. !!!
  1439. wc  Bug_fixes CHANGES Installation README Suggestions audit.pl mh.pl refileto rfolder | sed 's=[^ ]*/==' | diff -b $temp - >$dtemp
  1440. if [ -s $dtemp ]
  1441. then echo "Ouch [diff of wc output]:" ; cat $dtemp
  1442. else echo "No problems found."
  1443. fi
  1444. echo "Making links..."
  1445. ln -s rfolder rfolders
  1446. ln -s refile refilefrom
  1447. exit 0
  1448.  
  1449.  
  1450. ---Begin attached file gnusmail.pl---
  1451.  
  1452.  
  1453. # require 'sys/file.ph';
  1454. # i've grabbed the lines i want out of the file... this keeps me from
  1455. # including tons of garbage
  1456. eval 'sub LOCK_SH {1;}';
  1457. eval 'sub LOCK_EX {2;}';
  1458. eval 'sub LOCK_NB {4;}';
  1459. eval 'sub LOCK_UN {8;}';
  1460.  
  1461.  
  1462. sub gnusmail {
  1463.   local($group) = @_;
  1464.  
  1465.   # dir will contain the path, defaults to ~/Mail
  1466.   local($dir) = "Mail";
  1467.   # if NNTPSERVER looks like :directory use that
  1468.   $dir = $1 if ($ENV{"NNTPSERVER"} =~ /^:(\S*)/);
  1469.   $dir = $ENV{"HOME"} . "/" . $dir . "/" . $group;
  1470.  
  1471.   # if the directory doesn't exist and we can't make it deliver the usual way
  1472.   if (! -d $dir) {
  1473.     system("mkdir -p $dir; echo 0 >$dir/.last")    && &gnuserror();
  1474.   }
  1475.  
  1476.   # open .last and use it as a lock file, get the next number out
  1477.   open(LAST, "+< $dir/.last") || &gnuserror();
  1478.   flock(LAST, &LOCK_EX);
  1479.   $file = <LAST> + 1;
  1480.  
  1481.   # create the new file and write the current message out
  1482.   open(MAIL, "> $dir/$file") || &gnuserror();
  1483.   print MAIL "$header";
  1484.   print MAIL "$body" if defined($body);
  1485.   close(MAIL);
  1486.  
  1487.   # write the new last value into .last
  1488.   seek(LAST, 0, 0);
  1489.   print LAST "$file\n";
  1490.   flock(LAST, &LOCK_UN);
  1491.   close(LAST);
  1492.  
  1493.   return 0;
  1494. }
  1495.  
  1496. sub gnuserror {
  1497.   &deliver();
  1498.   exit;
  1499. }
  1500.  
  1501. 1;
  1502.  
  1503. ---End attached file gnusmail.pl---
  1504.  
  1505. and lastly my mail filter for grins:
  1506.  
  1507. ---Begin attached file filter---
  1508.  
  1509. #! /usr/local/bin/perl --        # -*-Perl-*-
  1510.  
  1511. require 'audit.pl'
  1512.   || die "deliver: cannot include audit.pl: $@";
  1513.  
  1514. require 'gnusmail.pl'
  1515.   || die "deliver: cannot include gnusmail.pl: $@";
  1516.  
  1517. &initialize();
  1518.  
  1519.  
  1520. # -----
  1521. # My mail processing starts here
  1522. #
  1523.  
  1524. # lowercase all addresses in-place
  1525. foreach (@to) {
  1526.   tr/A-Z/a-z/;
  1527. }
  1528. foreach (@cc) {
  1529.   tr/A-Z/a-z/;
  1530. }
  1531.  
  1532. # if this message is from one of the mailing lists put into
  1533. # appropriate list directory
  1534. @lists = ("grapevine",
  1535.       "tech-forum",
  1536.       "syseng",
  1537.       "inet-admin");
  1538. $lists = join("|", @lists);
  1539. ($which = (grep(/$lists/, @to, @cc))[$[]) && do {
  1540.   $which =~ /($lists)/;
  1541.   &gnusmail("lists/$1");
  1542.   exit;
  1543. };
  1544.  
  1545. # other parsing, mostly on who it's from
  1546. #
  1547. ($from =~ /^Mailer/i) && do {
  1548.   &gnusmail("mail/daemon");
  1549.   exit;
  1550. };
  1551.  
  1552. %from = ("tadpole|tadusa", "mail/tadpole",
  1553.      "70562.662@CompuServe.COM", "mail/dirtbag",
  1554.      );
  1555. while (($key, $value) = each(%from)) {
  1556.   if ($address =~ /$key/i) {
  1557.     &gnusmail($value);
  1558.     &vacation();
  1559.     exit;
  1560.   }
  1561. }
  1562.  
  1563. ($from =~ /infodist/i) && do {
  1564.   if ($subject =~ /press/i) {
  1565.     &gnusmail("lists/infodist/press");
  1566.   }
  1567.   else {
  1568.     &gnusmail("list/infodist");
  1569.   }
  1570.   exit;
  1571. };
  1572.  
  1573. # If I am specifically named on the To or Cc line, do the default.
  1574. #
  1575. (grep(/^(jkt|jack_thomasson)/, @to, @cc)) && do { 
  1576.   &gnusmail("mail");
  1577.   &vacation();
  1578.   exit;
  1579. };
  1580.  
  1581. # this mail was not sent to me directly, so dont answer with vacation mail,
  1582. #
  1583. &gnusmail("mail/junk");
  1584.  
  1585. # All done!
  1586. #
  1587. exit;
  1588.  
  1589. ---End attached file filter---
  1590. --
  1591. ---------------------------------------------------------------------
  1592. Jack Thomasson                   :{)}               (the bearded one)
  1593. Internet:Jack_Thomasson@SED.Provo.Novell.COM           MHS:JKT@NOVELL
  1594. Novell, Inc. /  MS E-23-2 /  122 East 1700 South /   Provo, UT  84606
  1595. Phone: (800)453-1267x7604 | (801)429-7604          FAX: (801)429-5511
  1596. "WARNING: the comments do not necessarily reflect the implementation"
  1597.