Added -clobber switch to mhstore(1) [Bug #11160].
[mmh] / 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;