diplodocus.org Git - nmh/blob - docs/historical/mh-6.8.5/miscellany/audit/audit.pl

   1 #
   2 #
   3 # $Revision: 1.13 $
   4 # $Date: 92/05/12 14:34:18 $
   5 #
   6 #
   7
   8 # =====
   9 # Subroutine initialize
  10 #       Set up the environment for the user and parse the incoming
  11 #       mail message.
  12 #
  13 sub initialize {
  14     local($passwd, $uid, $gid, $quota, $comment, $gcos);
  15
  16     ($user, $passwd, $uid, $gid, $quota, $comment, $gcos, $home, $shell) =
  17         getpwnam($ARGV[0]); shift @ARGV;
  18
  19     $ENV{'USER'} = $user;
  20     $ENV{'HOME'} = $home;
  21     $ENV{'SHELL'} = $shell;
  22     $ENV{'TERM'} = "vt100";
  23
  24     &parse_message(STDIN);
  25 }
  26
  27
  28 # =====
  29 # Subroutine parse_message
  30 #       Parse a message into headers, body and special variables
  31 #
  32 sub parse_message {
  33     local(*INFILE) = @_;
  34
  35     $/ = '';            # read input in paragraph mode
  36     %headers = ( );
  37     @received = ( );
  38     undef($body);
  39
  40     $header = <INFILE>;
  41
  42     $* = 1;
  43     while (<INFILE>) {
  44         s/^From />From /g;
  45         $body = "" if !defined($body);
  46         $body .= $_;
  47     };
  48     $/ = "\n";
  49     $* = 0;
  50
  51
  52     ;# -----
  53     ;# $sender comes from the UNIX-style From line (From strike...)
  54     ;#
  55     ($sender) = ($header =~ /^From\s+(\S+)/);
  56
  57
  58     ;# -----
  59     ;# fill out the headers associative array with fields from the mail
  60     ;# header.
  61     ;#
  62     $_ = $header;
  63     s/\n\s+//g;
  64     @lines = split('\n');
  65     for ( @lines ) {
  66         /^([\w-]*):\s*(.*)/ && do {
  67             $mheader = $1;
  68             $mheader =~ tr/A-Z/a-z/;
  69             if (($mheader eq "cc" || $mheader eq "to") && $headers{$mheader}) {
  70                 $headers{$mheader} .= ", $2";
  71             } elsif ($mheader eq "received") {
  72                 push(@received, $2);
  73             } else {
  74                 $headers{$mheader} = $2;
  75             };
  76         };
  77     }
  78     @received = reverse(@received);
  79
  80
  81     ;# -----
  82     ;# for convenience, $subject is $headers{'subject'} and $precedence is
  83     ;# $headers{'precedence'}
  84     ;#
  85     $subject = $headers{'subject'};
  86     $subject = "(No subject)" unless $subject;
  87     $subject =~ s/\s+$//;
  88     $precedence = $headers{'precedence'};
  89
  90
  91     ;# -----
  92     ;# create arrays for who was on the To, Cc lines
  93     ;#
  94     @cc = &expand($headers{'cc'});
  95     @to = &expand($headers{'to'});
  96     defined($headers{"apparently-to"}) && do {
  97         $apparentlyto = $headers{"apparently-to"};
  98         push(@to, &expand($apparentlyto));
  99     };
 100
 101     ;# -----
 102     ;# $from comes from From: line. $address is their email address.
 103     ;# $organization is their site. for example, strike@pixel.convex.com
 104     ;# yields an organization of convex.
 105     ;#
 106     $_ = $headers{'from'} ||
 107          $headers{'resent-from'} ||
 108          $headers{'sender'} ||
 109          $headers{'resent-sender'} ||
 110          $headers{'return-path'} ||
 111          $headers{'reply-to'};
 112
 113     if ($_ eq "") {
 114        $friendly = $from = $address = $organization = "unknown";
 115        return;
 116     };
 117
 118     ($friendly, $address, $from, $organization) = &parse_email_address($_);
 119 }
 120
 121
 122 # =====
 123 # Subroutine parse_email_address
 124 #       Parse an email address into address, from, organization
 125 #       address is full Internet address, from is just the login
 126 #       name and organization is Internet hostname (without final domain)
 127 #
 128 sub parse_email_address {
 129     local($_) = @_;
 130     local($friendly, $address, $from, $organization);
 131
 132     $organization = "local";
 133     $friendly = "unknown";
 134
 135 # From: Disk Monitor Daemon (/usr/adm/bin/dfbitch) <daemon@hydra.convex.com>?
 136
 137     s/^\s*//;
 138     s/\s*$//;
 139     if (/(.*)\s*<[^>]+>$|<[^>]+>\s*(.*)$/) {
 140         $friendly = $+;
 141         $friendly =~ s/\"//g;
 142     } elsif (/\(([^\)]+)\)/) {
 143         $friendly = $1;
 144     };
 145
 146     s/.*<([^>]+)>.*/$1/;
 147     s/\(.*\)//;
 148     s/\s*$//;
 149     $address = $_;
 150
 151     s/@.*//;
 152     s/%.*//;
 153     s/.*!//;
 154     s/\s//g;
 155     $from = $_;
 156
 157     $_ = $address;
 158     tr/A-Z/a-z/;
 159     if (/!/ && /@/) {
 160         s/\s//g;
 161         s/!.*//;
 162         $organization = $_;
 163     } elsif (/!/) {
 164         s/\s//g;
 165         s/![A-Za-z0-9_@]*$//;
 166         s/.*!//;
 167         s/\..*//;
 168         $organization = $_;
 169     } elsif (/@/) {
 170         s/.*@//;
 171         s/\s//g;
 172         if (! /\./) {
 173             $organization = "unknown";
 174         } else {
 175             if (/\.(com|edu)$/) {
 176                 s/\.[A-Za-z0-9_]*$//;
 177                 s/.*\.//;
 178             } else {
 179                 s/\.[A-Za-z0-9_]*$//;
 180                 s/\.[A-Za-z0-9_]*$//;
 181                 s/.*\.//;
 182             };
 183             $organization = $_;
 184         };
 185     };
 186
 187     return ($friendly, $address, $from, $organization);
 188 };
 189
 190
 191 # ====
 192 # Subroutine vacation
 193 #       deliver a vacation message to the sender of this mail
 194 #       message.
 195 #
 196 sub vacation {
 197     local($vacfile) = $ENV{'HOME'} . "/" . ".vacation.msg";
 198     local($msubject) = "\"Vacation mail for $ENV{'USER'} [Re: $subject]\" ";
 199     local($vacaudit, $astat, $mstat);
 200     local(@ignores);
 201     local(@names);
 202
 203     return if (length($from) <= 0);
 204     return if ($precedence =~ /(bulk|junk)/i);
 205     return if ($from =~ /-REQUEST@/i);
 206
 207     @ignores = ('daemon', 'postmaster', 'mailer-daemon', 'mailer', 'root',);
 208     grep(do {return if ($_ eq $from);}, @ignores);
 209
 210     if (-e $vacfile) {
 211         ($vacaudit = $vacfile) =~ s/\.msg/\.log/;
 212
 213         $mstat = (stat($vacfile))[9];
 214         $astat = (stat($vacaudit))[9];
 215         unlink($vacaudit) if ($mstat > $astat);
 216
 217         if (-f $vacaudit) {
 218             open(VACAUDIT, "< $vacaudit") && do {
 219                 while (<VACAUDIT>) {
 220                     chop;
 221                     return if ($_ eq $from);
 222                 };
 223                 close(VACAUDIT);
 224             };
 225         };
 226
 227         open(MAIL,"| /usr/ucb/Mail -s $msubject $address") || return;
 228         open(VACFILE, "< $vacfile") || return;
 229         while (<VACFILE>) {
 230             s/\$SUBJECT/$subject/g;
 231             print MAIL $_;
 232         };
 233         close(VACFILE);
 234         close(MAIL);
 235
 236         open(VACAUDIT, ">> $vacaudit") || return;
 237         print VACAUDIT "$from\n";
 238         close(VACAUDIT);
 239     };
 240 }
 241
 242
 243 # =====
 244 # Subroutine expand
 245 #       expand a line (To, Cc, etc.) into a list of addressees.
 246 #
 247 sub expand {
 248     local($_) = @_;
 249     local(@fccs) = ( );
 250
 251     return(@fccs) if /^$/;
 252
 253     for (split(/\s*,\s*/)) {
 254         s/.*<([^>]+)>.*/$1/;
 255         s/@.*//;
 256         s/.*!//;
 257         s/\(.*\)//;
 258         s/\s//g;
 259         push(@fccs,$_) unless $seen{$_}++;
 260     }
 261
 262     return(@fccs);
 263 }
 264
 265
 266 # =====
 267 # Subroutine deliver
 268 #       Deliver the incoming mail message to the user's mail drop
 269 #
 270 sub deliver {
 271
 272     &deposit("/usr/spool/mail/$user");
 273 }
 274
 275
 276 # =====
 277 #       Put the incoming mail into the specified mail drop (file)
 278 #
 279 sub deposit {
 280     local($drop) = @_;
 281     local($LOCK_EX) = 2;
 282     local($LOCK_UN) = 8;
 283
 284     open(MAIL, ">> $drop") || die "open: $!\n";
 285     flock(MAIL, $LOCK_EX);
 286     seek(MAIL, 0, 2);
 287
 288     print MAIL "$header";
 289     print MAIL "$body\n\n" if defined($body);
 290
 291     flock(MAIL, $LOCK_UN);
 292     close(MAIL);
 293 }
 294
 295
 296 # =====
 297 # Subroutine file_from
 298 #       Add the mail message to another mail drop in a log directory.
 299 #       The path of the mail drop is toplevel/organization/user
 300 #
 301 sub file_from {
 302     local($toplevel) = @_;
 303     local($dir);
 304
 305     return if (length($from) <= 0);
 306     return if ($from eq $user);
 307
 308     $toplevel = "log" if ($toplevel eq '');
 309
 310     $dir = "$home/$toplevel";
 311     (!-d $dir) && mkdir($dir, 0700);
 312     $dir .= "/$organization";
 313     (!-d $dir) && mkdir($dir, 0700);
 314
 315     &deposit("$dir/$from");
 316 }
 317
 318
 319 # =====
 320 # Subroutine openpipe
 321 #       Open a pipe to a command and write the mail message to it.
 322 #
 323 sub openpipe{
 324     local($command) = @_;
 325
 326     open(CMD, "| $command") || die;
 327     print CMD "$header\n";
 328     print CMD "$body\n\n" if defined($body);
 329 }
 330
 331 1;