home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / perl / scripts-convex / audit / tchrist.audit_mail.pl < prev    next >
Encoding:
Perl Script  |  1993-07-14  |  2.0 KB  |  103 lines
  1. #!/usr/local/bin/perl
  2.  
  3. unshift(@INC, "/mnt/tchrist/scripts/deliverlib");
  4.  
  5. @pw = getpwuid($<);
  6.  
  7. require 'audit.pl';
  8. require 'mh.pl';
  9.  
  10. &initialize();
  11.  
  12. $HOME = $ENV{HOME}
  13.      || $ENV{LOGDIR}
  14.      || $pw[7]
  15.      || die "No home directory";
  16.  
  17. $USER = $ENV{USER}
  18.      || $ENV{LOGNAME}
  19.      || $pw[0]
  20.      || die "Cannot determine user for id $>";
  21.  
  22.  
  23. &mh_profile();
  24.  
  25. $maildrops = $MH{'path'} . '/in.coming';
  26.  
  27.  
  28. if ($subject =~ /\b(fuck|shit|damn)\b/) {
  29.     require 'sysexits.ph';
  30.     print STDERR <<EOF;
  31.  
  32. I'm sorry, $friendly, but I simply refuse to tolerate 
  33. such language as $1.  When you can send me nice mail, 
  34. my inbox will then accept your mail again.
  35.  
  36. --tom
  37. EOF
  38.     exit &EX_UNAVAILABLE;
  39. } 
  40.  
  41. # avoid duplicate messages, which are defined as 
  42. # having the same subject, body length, body checksum,
  43. # and received with 10 minutes of each other.
  44. local($db) = "$MH{'path'}/.dupmsgdb";
  45. if (dbmopen(Msgs, $db, 0644)) {
  46.     local($sum) = unpack("%31C*", $body);
  47.     local($len) = length($body);
  48.     if ($Msgs{$subject, $len, $sum} + 10*60 > time) {
  49.     warn "duplicate message discarded";
  50.     exit; # duplicate
  51.     } else {
  52.     $Msgs{$subject, $len, $sum} = time;
  53.     } 
  54.     dbmclose(%Msgs);
  55. } 
  56.  
  57.  
  58. #if ($from =~ /MAILER/ || ($from eq $USER  && $subject =~  /send failed on enclosed draft/) ) { 
  59.     #warn "mailer daemon message";
  60.     #&deliver(); 
  61.     #exit; 
  62. #};
  63.  
  64. # kill any mail to 'x' aliases 
  65. if (grep(/^x(.*)/ && (gethostbyname($1))[0], @to, @cc)) {
  66.     # &rcvstore( "junk" );
  67.     warn "disarding xhost message";
  68.     exit;
  69. }
  70.  
  71. $organization = "convex" if 
  72.     $organization eq "local" && (getpwnam($from))[0];
  73.  
  74.  
  75. if (grep(/\bbod/,@to,@cc)) {
  76.     &rcvstore("usenix/bod");
  77. } 
  78.  
  79. for (@to, @cc) {
  80.     if (/sage-([^,\s]+)/) {
  81.     warn "sage message";
  82.     &rcvstore("sage/$1");
  83.     last;
  84.     } 
  85. } 
  86.  
  87. # default handling for mail addressed directly to me
  88. if (grep(/^$USER\b/o, @to, @cc)) { 
  89.     warn "message for ME";
  90.     # &vacation();
  91.     &deposit("$maildrops/personal");
  92.     exit;
  93. }
  94.  
  95.  
  96. # this mail was not sent to me directly, so don't answer with vacation mail,
  97. # but do everything else.
  98. #
  99.  
  100. &deposit("$maildrops/lists");
  101.  
  102. exit;
  103.