1#!@PERL@ -sw
2#
3# Package:	am-utils-6.x
4# Author:	James Tanis <jtt@cs.columbia.edu>
5#
6
7############################################################################
8#
9# lostaltmail -- remail files files found alt_mail (or -a argument to hlfsd) to
10# whomever should receive it. This version is for SMTP varient which
11# support VRFY as a non-expanding verifier!!! (sendmail V8 is a an
12# example).
13#
14# Usage: lostaltmail [-debug] [-nomail] [-noverify]
15#
16# 		GLOBAL VARIABLES (as if you care :-) )
17# Probably a very incomplete list.
18#
19# Everything in the config file for this program *and* ...
20#
21# $debug: set it from the command line with -debug. Does the obvious
22# $nomail: set it from the command line with -nomail. *Not* implied by
23#	 $debug
24# $currentTO: The addresss we are currently checking on.  Actually this is
25#	left over from an earlier version of lostaltmail and will hopefully
26#	go away.
27# $noverify: set it from the address line. Avoid verification of $currentTO.
28#	This should be relatively safe as long as you are willing to
29#	endure bounces from mail that cannot be redelivered as opposed to
30#	just getting a warning. UNTESTED (but should work).
31#
32# $logopen: state variable indicating weather the log file (should there be
33#	one) is in fact open.
34#
35# @allentries: Array of all the directory entries in $MAILDIR
36# @allnames: Array of all *likely* recipients. It is created from @allentries
37#	sans junk files (see $MAILJUNK and $LOCALMAILJUNK)
38# @wanderers: Array of all the files associated with a *single* address
39#	which might need remailing.  Should lostaltmail die unexpectedly,
40#	it might leave a temporary file containing messages it was
41#	currently trying to deliver.  These will get picked and resent
42#	later.
43#
44# VRFY: Handle onto SMTP verification channel.  Not to be confused with mail
45#	delivery; only verification occurs accross this handle.
46#
47############################################################################
48
49##############################################################################
50#									     #
51#				SMTP_SEND				     #
52#								     	     #
53##############################################################################
54#
55# Send a message to the smtp channel. Inserts the necessary NEWLINE if it
56# does not exist;
57# I stole this from myself. It shouldn nott be printing errors to STDERR, but
58# this is a quick hack.
59#
60sub smtp_send {
61    local ($msg) = @_;
62    local ($length);
63
64    $length=length($msg);
65
66    if ( $msg !~ /^.*\n$/ ) {
67	$msg = $msg . "\n";
68	$length++;
69    }
70
71
72    if ( ! syswrite (VRFY, $msg, $length)) {
73	print STDERR "Failing SMTP write: $msg";
74	return 0;
75    }
76
77    return 1;
78}
79
80##############################################################################
81#									     #
82#				SMTP_RECV				     #
83#								     	     #
84##############################################################################
85#
86# Read in lines from SMTP connection and return the final
87# 	Really hideous -- please excuse.
88#
89sub smtp_recv {
90    local ($line,$rin, $win, $ein, $readbuf, $ret);
91    $readbuf = "";
92
93    $rin = $win = $ein = '';	# Null fd sets,
94    vec ($rin, fileno(VRFY), 1) = 1; # Stolen straight from the example;
95    $ein = $rin | $win;		# This is probably useless
96
97
98LINE_OF_INPUT:
99    while (1) {			# Read in all the input
100
101	if ((select ( $rin, $win, $ein, 600.0))[0]  == 0 ) {
102	    print "select returned -1" if ($debug);
103	    return -1;	# timeout
104	}
105	sysread (VRFY, $readbuf, 1024);
106	chop ($readbuf);
107
108	foreach $line (	split('\n', $readbuf)) {
109
110	    # This loop is actually needed since V8 has a multi-line greet.
111
112	    ( $line =~ /^(\d\d\d).*/ && ($SMTP_retval=$1)) ||
113		warn "Badly formed reply from SMTP peer: $line\n";
114
115	    # Space after return code indicates EOT
116
117	    if ($line =~ /^\d\d\d /) {
118		$ret = $line;	# Oddly $line is in a different context here;
119				# and thus we need to export it out of the
120				# while loop via $ret.
121		last LINE_OF_INPUT;
122	    }
123	} # End of read.
124    } # End of input.
125
126    return $ret;
127}
128
129
130
131
132##############################################################################
133#									     #
134#				LOG_INFO				     #
135#								     	     #
136##############################################################################
137#
138#
139# Opens appropriate logging file -- STDOUT (cron) or temp file (mail).
140#
141sub Log_info {
142    local($message) = @_;
143
144    if ( !$logopened )  {
145	if ( $MAILGRUNT eq "" || $debug) {
146	    open (LOGFILE, ">-") || die  "Unable to open stdout";
147	}
148	else {
149	    # Snarf the log into a tmp file for final mailing to MAILGRUNT
150	    $logfile = $LOGFILE . ".$$";
151	    open (LOGFILE, (">". "$logfile")) || die "Unable to create log file";
152	}
153    }
154
155    $logopened=1;		# Note that the log is now open
156
157    # Heart of the function.
158    print LOGFILE "$message";
159
160    print LOGFILE "\n" if ( index($message,"\n") == -1 );
161}
162
163##############################################################################
164#									     #
165#				LOCK_FILE				     #
166#									     #
167##############################################################################
168
169#
170# Tries to grab a lock on the supplied file name.
171# Spins for a bit if it can't on the assumption that the lock will be released
172#	quickly.  If it times out and it's allowed to requeue, it will defer
173#	until later, other wise write a message to loginfo.
174
175# If a recurring error or really unexpected situation arrises, return
176# 	ABORT_RESEND
177#
178#  PARAMETERS
179# mailfile: path to the file to resend.
180# should_requeue: BOOLEAN - TRUE if the mailfile should be put on the
181# queue for a later retry if we can not finish
182# now.
183
184sub Lock_file {
185
186    local($mailfile,$should_requeue,$i,$new_lost_file) = @_;
187
188# We need to rename the current mailbox so that mail can loop back into it if
189# the resent mail just gets looped right back to us.
190    $new_lost_file = $mailfile . ".$$";
191
192#  make a tmpfile name based on mailfile;
193    $lostlockfile = "$mailfile" . "$LOCKEXT";
194
195    if ( ! open(LOCKFILE, (">" . $lostlockfile)) ) {
196	printf(STDERR "Could not create lostlockfile for %s: %s\n", $mailfile,$!);
197	return $ABORT_RESEND;
198    }
199    close(LOCKFILE);
200
201    $maillockfile = "$mailfile" . "$LOCAL_LOCK_EXT";
202
203    for ($i=0; $i < $LOCK_RETRIES && ! link ($lostlockfile, $maillockfile);
204	 $i++) {
205	sleep(1);
206    }
207
208    unlink($lostlockfile);	# No matter what eliminate our cruft
209
210    if ( $i == $LOCK_RETRIES ) {
211	&Log_info("Could not grab lock on: " . "$mailfile" . " :timed out");
212	if ( $should_requeue ) {
213	    &Log_info("Requeing " . "$mailfile" . " for later retry");
214	    $retry_list .= " $mailfile";
215	}
216	else {
217	    &Log_info("Giving up on: " . "$mailfile");
218	}
219
220	return $ABORT_RESEND;
221    }
222
223    # We created the link and therefore have the lock
224
225    if (rename ($mailfile, $new_lost_file) == 0 ){
226	# Failed to rename file -- this is serious.
227	unlink($maillockfile);
228	return $ABORT_RESEND;
229    }
230
231    unlink($maillockfile);
232    return $new_lost_file;
233
234}
235
236##############################################################################
237#									     #
238#			PARSE NEXT MAIL MESSAGE				     #
239#									     #
240##############################################################################
241#
242# Parameters:
243#  mailfile: handle of mailfile to use.
244#
245# Parses the next message in the mail file and inserts it in $current_msg
246#
247sub Get_next_msg {
248    local($mailfile,$found_body_delimiter) = @_;
249
250    # If this is the first message in the spool file, read the first line
251    # otherwise use the MESSAGE_DELIM line from the previous message (which we
252    # were forced to overread).
253
254    $done=$FALSE;
255    $found_body_delimiter=$FALSE;
256
257    # This if eats the very first "From " line and should never fire again.
258    if ( ! defined $current_msg ) {<$mailfile>};
259    undef ($current_msg);	# Erase the old message.
260
261
262    # Read the mailfile and pass through all the lines up until the next
263    # message delimiter. Kill any previous resend headers.
264    while ( <$mailfile> ) {
265	last if (/$MESSAGE_DELIM/);
266	next if ( !$found_body_delimiter && /[Rr][Ee][Ss][Ee][Nn][Tt]-.+:/);
267	if (  !$found_body_delimiter && /^$HEADER_BODY_DELIM/) {
268	    &Splice_in_resent_headers();
269	    $found_body_delimiter=$TRUE;
270	}
271	if (defined($current_msg)) {
272	    $current_msg .= $_;
273	} else {
274	    $current_msg = $_;
275	}
276    }
277
278    # Return TRUE when we have hit the end of the file.
279    if (!defined($_) || $_ eq "" ) {
280	return $TRUE;
281    } else {
282	return $FALSE;
283    }
284}
285
286##############################################################################
287#									     #
288#			SPLICE IN RESENT_HEADERS			     #
289#									     #
290##############################################################################
291#
292# Insert the Resent- headers at the *current location* of the message stream
293# (In Engish, print out a few Resent-X: lines and return :-) )
294# In addition splice in the X-resent-info: header.
295
296#
297# Paremters: None.
298# Return: None
299#
300sub Splice_in_resent_headers {
301    local($date,$utctime,$weekday,$time,$month,$hostname);
302
303    $current_msg .= "$RESENT_TO" . "$currentTO" . "\n";
304    $current_msg .= "$RESENT_FROM" . "$SYSTEM_FROM_ADDRESS" . "\n";
305
306    # Calculate date and time.  It is a bit of a shame to do this each time
307    # the time needs to be acurate.
308
309    @utctime=gmtime(time);
310
311    $weekday=(Sun,Mon,Tue,Wed,Thu,Fri,Sat)[$utctime[6]];
312
313
314    # If the minutes or second do not take two columns each, patch em up.
315    if ( $utctime[1] < 10 ) {
316	if ( $utctime[0] < 10 ) {
317	    $time=sprintf("%d:0%d:0%d",$utctime[2],$utctime[1],$utctime[0]);
318	}
319	else {
320	    $time=sprintf("%d:0%d:%d",$utctime[2],$utctime[1],$utctime[0]);
321	}
322    }
323    else {
324	if ( $utctime[0] < 10 ) {
325	    $time=sprintf("%d:%d:0%d",$utctime[2],$utctime[1],$utctime[0]);
326	}
327        else {
328	    $time=sprintf("%d:%2d:%2d",$utctime[2],$utctime[1],$utctime[0]);
329	}
330    }
331
332    $month=(Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec)[$utctime[4]];
333
334    # Ensure Y2K format
335    $date=sprintf("%s, %d %s %d %s UTC", $weekday, $utctime[3], $month, $utctime[5]+1900, $time);
336
337    $current_msg .= "$RESENT_DATE" . $date . "\n";
338
339    if ( defined $RESENT_INFO && $RESENT_INFO ne "") {
340	$hostname=`uname -n`;
341	$current_msg .= "$RESENT_INFO" . "Lost mail resent from ". $hostname;
342    }
343
344    return;
345}
346
347##############################################################################
348#									     #
349#				DO_REMAIL				     #
350#									     #
351##############################################################################
352#
353# Actually resends the mail.   Talks to the process configured as $MAILER
354# We need better handling.
355#
356sub Do_remail {
357    open (MAILER, "| $MAILER $currentTO") || return $ABORT_RESEND;
358    print MAILER $current_msg;
359    close (MAILER);
360}
361
362##############################################################################
363#									     #
364#				CLEAN_UP				     #
365#									     #
366##############################################################################
367#
368# Clean up my messes.
369#
370sub Clean_up {
371    local ($hostname);
372
373    # Ugly local hack that you should never have seen, but I forgot to
374    # remove.  Hopefully it did not kill you (I tried as you see), but you
375    # should eiter remove or update it for yourself.  I find the message
376    # subject needs to have the hostname to be useful.
377    #
378    chop ($hostname=`uname -n`);
379    $LOG_SUBJECT="$LOG_SUBJECT from $hostname" if ( $hostname =~ /.*\.cs\.columbia\.edu/ );
380    #
381    # End of ugly local hack
382
383    # Mail any log info to MAILGRUNT.
384    if (defined($logfile) && $logfile ne "" ) {
385	close (LOGFILE);	# Flush logfile output.
386	if ( -s $logfile ) {
387	    open (MAILER, "| $MAILER $MAILGRUNT");
388
389	    print MAILER "To: $MAILGRUNT\n";
390	    print MAILER "Subject: $LOG_SUBJECT\n";
391	    print MAILER "$HEADER_BODY_DELIM";
392
393	    open (LOGFILE, "< $logfile");
394
395	    while (<LOGFILE>) {
396		print MAILER $_;
397	    }
398	    close (MAILER);
399	    close (LOGFILE);
400	}
401
402	unlink($logfile);
403    }
404    exit(0);
405}
406
407
408##############################################################################
409#									     #
410#				COLLECT_WANDERERS			     #
411#									     #
412##############################################################################
413
414#
415# Collects other files that appear to be mail file for the $currentTO
416# but were not remailed successfully.
417#
418# Parameters: none (but uses $currentTO)
419# Return:  True if a old mail directory is found. False otherwise.
420# Side effects: $wanderers set.
421#
422sub Collect_wanderers {
423
424    undef (@wanderers);
425
426    # Slurp in the directory and close.
427
428    return ($found);
429}
430
431#############################################################################
432#									    #
433#				REMAIL ALL				    #
434#									    #
435#############################################################################
436
437#
438# Takes an array of files that all seem to share a common repcipient and
439# remails them if possible.
440#
441# Parameters: None (uses @wanderers).
442#
443sub Remail_all {
444    local($file,$i);
445
446    $i=0;
447    foreach $file (@wanderers) {
448	if ( !open (LOSTFILE, "< $file"))  {
449	    &Log_info("Could not open " . "$file" . " for remailing");
450	    next;
451	}
452
453	do {			# Power loop!
454	    $done = &Get_next_msg(LOSTFILE); # Retrieve the next message...
455	    &Do_remail;		# and remail it.
456	} until $done;
457	undef ($current_msg);	# Erase the final remailed message.
458
459	close(LOSTFILE);	# Tidy up.
460
461	unlink ($file);		# Remove the remailed file
462	$i++;
463    }
464
465}
466
467#############################################################################
468#									    #
469#				CHECK_USER				    #
470#									    #
471#############################################################################
472
473#
474# Checks the password tables for the uid of $currentTO. If the user is
475# uid 0 (ie *supposed* to get mail in altmail) or unknown the resend is
476# aborted.
477#
478#
479sub Check_user {
480    local (@passwdinfo);
481    undef (@passwdinfo);
482
483    if (!$noverify && !&vrfy_user($currentTO) ) {
484    	&Log_info("Possible non user mail file: $currentTO");
485	return $ABORT_RESEND;
486    }
487
488    @passwdinfo = getpwnam($currentTO);
489
490    print "Non user mailable mail: Name: $currentTO\n"
491	if ( $debug && ! defined @passwdinfo );
492
493    return !$ABORT_RESEND if ( ! defined @passwdinfo ); # A non user but evidently mailable
494
495    print "Check User(): Name: $currentTO  -- UID: $passwdinfo[2]\n" if ($debug);
496
497    return $ABORT_RESEND if ( $passwdinfo[2] == 0 );
498
499
500    return !$ABORT_RESEND;
501}
502
503#############################################################################
504#									    #
505#				VRFY USER				    #
506#									    #
507#############################################################################
508#
509# Use SMTP VRFY to insure that argument is in fact a legal mail id.
510#  Boolean: TRUE if mailable account, FALSE if not.
511
512sub vrfy_user {
513
514	local ($mailname,$repl) = @_;
515
516	if ( !&smtp_send("vrfy $mailname") ) {
517	    &Log_info("Failed sending to vrfy smtp command for: $mailname");
518	    return 0;
519	}
520
521	$repl = &smtp_recv;
522
523	print "VRFY REPLY: $repl\n" if ($debug);
524
525	return ( $repl =~ /^2\d\d/ );
526
527
528}
529
530
531#############################################################################
532#									    #
533#				MAIN PROC				    #
534#									    #
535#############################################################################
536
537# dummy code to shut up perl -w
538$debug = 0 if !defined($debug);
539print $nomail if $debug > 1;
540print $RESENT_FROM if $debug > 1;
541print $logopen if $debug > 1;
542print $LOCAL_LOCK_EXT if $debug > 1;
543print $RESENT_TO if $debug > 1;
544print $LOCKEXT if $debug > 1;
545print $RESENT_DATE if $debug > 1;
546print $MESSAGE_DELIM if $debug > 1;
547print $SMTP_retval if $debug > 1;
548print $found if $debug > 1;
549print $retry_list if $debug > 1;
550print $MAILJUNK if $debug > 1;
551print $noverify if $debug > 1;
552print $SYSTEM_FROM_ADDRESS if $debug > 1;
553
554# BEGIN: stuff
555$prefix="@prefix@";
556$CONFIGDIR="@sysconfdir@";	# Directory where global config lives
557require "$CONFIGDIR/lostaltmail.conf" if (-f "$CONFIGDIR/lostaltmail.conf");
558require "/etc/global/lostaltmail.conf" if (-f "/etc/global/lostaltmail.conf");
559require "/etc/os/lostaltmail.conf" if (-f "/etc/os/lostaltmail.conf");
560require "/etc/local/lostaltmail.conf" if (-f "/etc/local/lostaltmail.conf");
561
562
563require "ctime.pl";
564use Socket;
565#require "sys/socket.ph";
566
567# SET some initial state variales
568$logopen = 0;
569
570#
571# Change to alt_dir
572#
573# Important!! This directory should be local.  Folks will be responsible
574# for finding this out for themselves.
575#
576if (!defined($MAILDIR) || $MAILDIR eq "") {
577    die "MAILDIR must be defined\n";
578}
579chdir ( $MAILDIR ) || die "Cannot change to $MAILDIR (`x' bit not set?)";
580
581#
582# slurp in directory
583#
584opendir (MAIL, ".") || die "Cannot open $MAILDIR (`r' bit not set?)";
585@allentries= readdir (MAIL);
586closedir (MAIL);
587@allnames = grep (!/$LOCALMAILJUNK|$MAILJUNK/, @allentries);
588
589# Open chanel to SMTP for verification -- unless this option is
590# configured off.
591
592if ( ! $noverify ) {
593    local($addr, $port,$sockaddr);
594
595    socket (VRFY, &AF_INET, &SOCK_STREAM, 0) ||
596	die "Could not create TCP socket (SMTP channel)";
597
598    $addr = (gethostbyname($SMTPHOST))[4]; # Just use the first addr
599
600    die "Could not obtain STMP host ($SMTPHOST) address"
601	if ( $addr eq "" );
602
603    $port = (getservbyname('smtp','tcp'))[2]; # Get smtp port.
604    die "Could not obtain SMTP port number" if (!defined($port));
605
606    printf("SMTP: address: %s   port: $port\n",
607	   join ('.',unpack('C4',$addr))) if ($debug);
608
609    $sockaddr = sockaddr_in($port, $addr);
610
611    printf("Sockaddr: %s\n", join (' ',unpack('C14',$sockaddr))) if ($debug);
612
613    connect (VRFY, $sockaddr) ||
614	die "Could not connect to SMTP daemon on $SMTPHOST";
615
616    print "Establshed SMTP channel\n" if ($debug);
617
618    &smtp_recv;	# Greet wait
619    &smtp_send("helo $SMTPHOST"); # Helo message for picky SMTPs
620    &smtp_recv;		# Helo reply
621
622    # Connection is up and ready to VRFY
623}
624
625# main stuff starts here
626foreach $currentTO (@allnames) {
627    next if ( &Check_user == $ABORT_RESEND);
628
629    # just delete the file if too small to be real mail
630    if ((stat($currentTO))[7] < 5) {
631	print "Too small to be real mail, unlinking $currentTO" if $debug;
632	unlink $currentTO;
633    }
634
635    undef (@wanderers);	# Just reset this at each pass.
636    @wanderers=grep (/$currentTO\.\d+/, @allentries);
637
638    $remail_file = &Lock_file($currentTO,$FALSE); # Need to lock the spool.
639
640    next if ( $remail_file eq $ABORT_RESEND); # Could not get that lock
641
642    push (@wanderers, $remail_file); # Try to resend "old" files.
643    print "List to remail: @wanderers\n" if ($debug);
644    # check if  there is something to remail
645    &Remail_all if ( defined @wanderers && !$nomail);
646}
647
648# this stuff should run at the end
649foreach $file (grep (/$LOCALMAILJUNK/,@allentries)) {
650
651    if ($debug) {
652	print "Would unlink $file\n" if ($debug);
653    } else {
654	unlink $file  if (-f $file);
655    }
656
657}
658&Clean_up;			# Do a clean exit.
659