home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1992 March / Source_Code_CD-ROM_Walnut_Creek_March_1992.iso / usenet / altsrcs / 1 / 1334 / del-archive
Encoding:
Text File  |  1990-12-28  |  2.2 KB  |  102 lines
  1. #!/bin/perl
  2. # Archive mail and log archived messages.
  3.  
  4. ## CONFIGURATION: Target sites that require archiving.
  5.  
  6. @ARCHSITES = ("sitea", "siteb", "uunet");   ## a joke, son
  7.  
  8. ## CONFIGURATION: Where will I archive mail if required?
  9.  
  10. $ARCHFILE = "/usr/tmp/mail-$$";        ## you need to fix this
  11.  
  12. ## Collect important environment variables.
  13.  
  14. $SENDER   = $ENV{'SENDER'};
  15. $HEADER   = $ENV{'HEADER'};
  16. $BODY     = $ENV{'BODY'};
  17. $HOSTNAME = $ENV{'HOSTNAME'};
  18.  
  19. ## Collect important header fields.
  20.  
  21. $H_From       = `header -nf From       $HEADER`;
  22. $H_To         = `header -nf To         $HEADER`;
  23. $H_Subject    = `header -nf Subject    $HEADER`;
  24. $H_X_Archived = `header -nf X-Archived $HEADER`;
  25.  
  26. ## Check to see if archiving is required.
  27.  
  28. $archive = 0;
  29. foreach (@ARGV) {
  30.     @B = split(/!/);
  31.     next unless @B > 1;
  32.     $dest = $B[$#B - 1];
  33.     ++$archive if grep($_ eq $dest, @ARCHSITES);
  34. }
  35.  
  36. ## If this message is already archived elsewhere,
  37. ## or if we're about to archive it, log it.
  38.  
  39. if ($archive || $H_X_Archived) {
  40.     &DEL("-r", $SENDER, "-b", "/usr/adm/del-arch.log");
  41.     print DEL $H_From, $H_To, $H_Subject, $H_X_Archived;
  42.     print DEL "\n";
  43.     print DEL "Archived locally as $ARCHFILE" if $archive;
  44.     close(DEL);
  45. }
  46.  
  47. ## If no archiving requested, deliver normally.
  48.  
  49. unless ($archive) {
  50.     foreach (@ARGV) {
  51.         print $_, "\n";
  52.     }
  53.     exit;
  54. }
  55.  
  56. ## Send the message with an X-Archived header line added.
  57. ## Note the "-n" flag -- don't execute this recursively!
  58.  
  59. &DEL("-n", @ARGV);
  60. ©MSG;
  61. close(DEL);
  62.  
  63. ## Have Deliver write the archive copy like a mailbox.
  64. ## Do this last, in case the script aborts early.
  65.  
  66. &DEL("-b", $ARCHFILE);
  67. ©MSG;
  68. close(DEL);
  69.  
  70. ## We are outahere!
  71.  
  72. exit;
  73.  
  74. ## Subroutine to spawn a child Deliver process.
  75.  
  76. sub DEL {
  77.     local($pid);
  78.     $pid = open(DEL, "|-");
  79.     warn "Can't open child deliver: $!" unless defined($pid);
  80.     exec "deliver", @_ if defined($pid) && $pid == 0;
  81. }
  82.  
  83. ## Subroutine to send a copy of the message to a child Deliver.
  84. ## The copy includes an X-Archived header.
  85.  
  86. sub COPYMSG {
  87.     open(HEADER) || warn "Can't open $HEADER: $!";
  88.     while (<HEADER>) {
  89.         print DEL $_ unless /^$/;
  90.     }
  91.     close(HEADER);
  92.  
  93.     print DEL "X-Archived: host $HOSTNAME, file $ARCHFILE\n";
  94.     print DEL "\n";
  95.  
  96.     open(BODY) || warn "Can't open $BODY: $!";
  97.     while (<BODY>) {
  98.         print DEL $_;
  99.     }
  100.     close(BODY);
  101. }
  102.