#!@PERL@ -sw
#
# Package:	am-utils-6.0
# Author:	James Tanis <jtt@cs.columbia.edu>
#

############################################################################
#
# lostaltmail -- remail files files found alt_mail (or -a argument to hlfsd) to
# whomever should receive it. This version is for SMTP varient which
# support VRFY as a non-expanding verifier!!! (sendmail V8 is a an
# example).
#
# Usage: lostaltmail [-debug] [-nomail] [-noverify]
#
# 		GLOBAL VARIABLES (as if you care :-) )
# Probably a very incomplete list.
#
# Everything in the config file for this program *and* ...
#
# $debug: set it from the command line with -debug. Does the obvious
# $nomail: set it from the command line with -nomail. *Not* implied by
#	 $debug
# $currentTO: The addresss we are currently checking on.  Actually this is
#	left over from an earlier version of lostaltmail and will hopefully
#	go away.
# $noverify: set it from the address line. Avoid verification of $currentTO.
#	This should be relatively safe as long as you are willing to
#	endure bounces from mail that cannot be redelivered as opposed to
#	just getting a warning. UNTESTED (but should work).
#
# $logopen: state variable indicating weather the log file (should there be
#	one) is in fact open.
#
# @allentries: Array of all the directory entries in $MAILDIR
# @allnames: Array of all *likely* recipients. It is created from @allentries
#	sans junk files (see $MAILJUNK and $LOCALMAILJUNK)
# @wanderers: Array of all the files associated with a *single* address
#	which might need remailing.  Should lostaltmail die unexpectedly,
#	it might leave a temporary file containing messages it was
#	currently trying to deliver.  These will get picked and resent
#	later.
#
# VRFY: Handle onto SMTP verification channel.  Not to be confused with mail
#	delivery; only verification occurs accross this handle.
#
############################################################################

##############################################################################
#									     #
#				SMTP_SEND				     #
#								     	     #
##############################################################################
#
# Send a message to the smtp channel. Inserts the necessary NEWLINE if it
# does not exist;
# I stole this from myself. It shouldn nott be printing errors to STDERR, but
# this is a quick hack.
#
sub smtp_send {
    local ($msg) = @_;
    local ($length);

    $length=length($msg);

    if ( $msg !~ /^.*\n$/ ) {
	$msg = $msg . "\n";
	$length++;
    }


    if ( ! syswrite (VRFY, $msg, $length)) {
	print STDERR "Failing SMTP write: $msg";
	return 0;
    }

    return 1;
}

##############################################################################
#									     #
#				SMTP_RECV				     #
#								     	     #
##############################################################################
#
# Read in lines from SMTP connection and return the final
# 	Really hideous -- please excuse.
#
sub smtp_recv {
    local ($line,$rin, $win, $ein, $readbuf, $ret);
    $readbuf = "";

    $rin = $win = $ein = '';	# Null fd sets,
    vec ($rin, fileno(VRFY), 1) = 1; # Stolen straight from the example;
    $ein = $rin | $win;		# This is probably useless


LINE_OF_INPUT:
    while (1) {			# Read in all the input

	if ((select ( $rin, $win, $ein, 600.0))[0]  == 0 ) {
	    print "select returned -1" if ($debug);
	    return -1;	# timeout
	}
	sysread (VRFY, $readbuf, 1024);
	chop ($readbuf);

	foreach $line (	split('\n', $readbuf)) {

	    # This loop is actually needed since V8 has a multi-line greet.

	    ( $line =~ /^(\d\d\d).*/ && ($SMTP_retval=$1)) ||
		warn "Badly formed reply from SMTP peer: $line\n";

	    # Space after return code indicates EOT

	    if ($line =~ /^\d\d\d /) {
		$ret = $line;	# Oddly $line is in a different context here;
				# and thus we need to export it out of the
				# while loop via $ret.
		last LINE_OF_INPUT;
	    }
	} # End of read.
    } # End of input.

    return $ret;
}




##############################################################################
#									     #
#				LOG_INFO				     #
#								     	     #
##############################################################################
#
#
# Opens appropriate logging file -- STDOUT (cron) or temp file (mail).
#
sub Log_info {
    local($message) = @_;

    if ( !$logopened )  {
	if ( $MAILGRUNT eq "" || $debug) {
	    open (LOGFILE, ">-") || die  "Unable to open stdout";
	}
	else {
	    # Snarf the log into a tmp file for final mailing to MAILGRUNT
	    $logfile = $LOGFILE . ".$$";
	    open (LOGFILE, (">". "$logfile")) || die "Unable to create log file";
	}
    }

    $logopened=1;		# Note that the log is now open

    # Heart of the function.
    print LOGFILE "$message";

    print LOGFILE "\n" if ( index($message,"\n") == -1 );
}

##############################################################################
#									     #
#				LOCK_FILE				     #
#									     #
##############################################################################

#
# Tries to grab a lock on the supplied file name.
# Spins for a bit if it can't on the assumption that the lock will be released
#	quickly.  If it times out and it's allowed to requeue, it will defer
#	until later, other wise write a message to loginfo.

# If a recurring error or really unexpected situation arrises, return
# 	ABORT_RESEND
#
#  PARAMETERS
# mailfile: path to the file to resend.
# should_requeue: BOOLEAN - TRUE if the mailfile should be put on the
# queue for a later retry if we can not finish
# now.

sub Lock_file {

    local($mailfile,$should_requeue,$i,$new_lost_file) = @_;

# We need to rename the current mailbox so that mail can loop back into it if
# the resent mail just gets looped right back to us.
    $new_lost_file = $mailfile . ".$$";

#  make a tmpfile name based on mailfile;
    $lostlockfile = "$mailfile" . "$LOCKEXT";

    if ( ! open(LOCKFILE, (">" . $lostlockfile)) ) {
	printf(STDERR "Could not create lostlockfile for %s: %s\n", $mailfile,$!);
	return $ABORT_RESEND;
    }
    close(LOCKFILE);

    $maillockfile = "$mailfile" . "$LOCAL_LOCK_EXT";

    for ($i=0; $i < $LOCK_RETRIES && ! link ($lostlockfile, $maillockfile);
	 $i++) {
	sleep(1);
    }

    unlink($lostlockfile);	# No matter what eliminate our cruft

    if ( $i == $LOCK_RETRIES ) {
	&Log_info("Could not grab lock on: " . "$mailfile" . " :timed out");
	if ( $should_requeue ) {
	    &Log_info("Requeing " . "$mailfile" . " for later retry");
	    $retry_list .= " $mailfile";
	}
	else {
	    &Log_info("Giving up on: " . "$mailfile");
	}

	return $ABORT_RESEND;
    }

    # We created the link and therefore have the lock

    if (rename ($mailfile, $new_lost_file) == 0 ){
	# Failed to rename file -- this is serious.
	unlink($maillockfile);
	return $ABORT_RESEND;
    }

    unlink($maillockfile);
    return $new_lost_file;

}

##############################################################################
#									     #
#			PARSE NEXT MAIL MESSAGE				     #
#									     #
##############################################################################
#
# Parameters:
#  mailfile: handle of mailfile to use.
#
# Parses the next message in the mail file and inserts it in $current_msg
#
sub Get_next_msg {
    local($mailfile,$found_body_delimiter) = @_;

    # If this is the first message in the spool file, read the first line
    # otherwise use the MESSAGE_DELIM line from the previous message (which we
    # were forced to overread).

    $done=$FALSE;
    $found_body_delimiter=$FALSE;

    # This if eats the very first "From " line and should never fire again.
    if ( ! defined $current_msg ) {<$mailfile>};
    undef ($current_msg);	# Erase the old message.


    # Read the mailfile and pass through all the lines up until the next
    # message delimiter. Kill any previous resend headers.
    while ( <$mailfile> ) {
	last if (/$MESSAGE_DELIM/);
	next if ( !$found_body_delimiter && /[Rr][Ee][Ss][Ee][Nn][Tt]-.+:/);
	if (  !$found_body_delimiter && /^$HEADER_BODY_DELIM/) {
	    &Splice_in_resent_headers();
	    $found_body_delimiter=$TRUE;
	}
	if (defined($current_msg)) {
	    $current_msg .= $_;
	} else {
	    $current_msg = $_;
	}
    }

    # Return TRUE when we have hit the end of the file.
    if (!defined($_) || $_ eq "" ) {
	return $TRUE;
    } else {
	return $FALSE;
    }
}

##############################################################################
#									     #
#			SPLICE IN RESENT_HEADERS			     #
#									     #
##############################################################################
#
# Insert the Resent- headers at the *current location* of the message stream
# (In Engish, print out a few Resent-X: lines and return :-) )
# In addition splice in the X-resent-info: header.

#
# Paremters: None.
# Return: None
#
sub Splice_in_resent_headers {
    local($date,$utctime,$weekday,$time,$month,$hostname);

    $current_msg .= "$RESENT_TO" . "$currentTO" . "\n";
    $current_msg .= "$RESENT_FROM" . "$SYSTEM_FROM_ADDRESS" . "\n";

    # Calculate date and time.  It is a bit of a shame to do this each time
    # the time needs to be acurate.

    @utctime=gmtime(time);

    $weekday=(Sun,Mon,Tue,Wed,Thu,Fri,Sat)[$utctime[6]];


    # If the minutes or second do not take two columns each, patch em up.
    if ( $utctime[1] < 10 ) {
	if ( $utctime[0] < 10 ) {
	    $time=sprintf("%d:0%d:0%d",$utctime[2],$utctime[1],$utctime[0]);
	}
	else {
	    $time=sprintf("%d:0%d:%d",$utctime[2],$utctime[1],$utctime[0]);
	}
    }
    else {
	if ( $utctime[0] < 10 ) {
	    $time=sprintf("%d:%d:0%d",$utctime[2],$utctime[1],$utctime[0]);
	}
        else {
	    $time=sprintf("%d:%2d:%2d",$utctime[2],$utctime[1],$utctime[0]);
	}
    }

    $month=(Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec)[$utctime[4]];

    # Ensure Y2K format
    $date=sprintf("%s, %d %s %d %s UTC", $weekday, $utctime[3], $month, $utctime[5]+1900, $time);

    $current_msg .= "$RESENT_DATE" . $date . "\n";

    if ( defined $RESENT_INFO && $RESENT_INFO ne "") {
	$hostname=`uname -n`;
	$current_msg .= "$RESENT_INFO" . "Lost mail resent from ". $hostname;
    }

    return;
}

##############################################################################
#									     #
#				DO_REMAIL				     #
#									     #
##############################################################################
#
# Actually resends the mail.   Talks to the process configured as $MAILER
# We need better handling.
#
sub Do_remail {
    open (MAILER, "| $MAILER $currentTO") || return $ABORT_RESEND;
    print MAILER $current_msg;
    close (MAILER);
}

##############################################################################
#									     #
#				CLEAN_UP				     #
#									     #
##############################################################################
#
# Clean up my messes.
#
sub Clean_up {
    local ($hostname);

    # Ugly local hack that you should never have seen, but I forgot to
    # remove.  Hopefully it did not kill you (I tried as you see), but you
    # should eiter remove or update it for yourself.  I find the message
    # subject needs to have the hostname to be useful.
    #
    chop ($hostname=`uname -n`);
    $LOG_SUBJECT="$LOG_SUBJECT from $hostname" if ( $hostname =~ /.*\.cs\.columbia\.edu/ );
    #
    # End of ugly local hack

    # Mail any log info to MAILGRUNT.
    if (defined($logfile) && $logfile ne "" ) {
	close (LOGFILE);	# Flush logfile output.
	if ( -s $logfile ) {
	    open (MAILER, "| $MAILER $MAILGRUNT");

	    print MAILER "To: $MAILGRUNT\n";
	    print MAILER "Subject: $LOG_SUBJECT\n";
	    print MAILER "$HEADER_BODY_DELIM";

	    open (LOGFILE, "< $logfile");

	    while (<LOGFILE>) {
		print MAILER $_;
	    }
	    close (MAILER);
	    close (LOGFILE);
	}

	unlink($logfile);
    }
    exit(0);
}


##############################################################################
#									     #
#				COLLECT_WANDERERS			     #
#									     #
##############################################################################

#
# Collects other files that appear to be mail file for the $currentTO
# but were not remailed successfully.
#
# Parameters: none (but uses $currentTO)
# Return:  True if a old mail directory is found. False otherwise.
# Side effects: $wanderers set.
#
sub Collect_wanderers {

    undef (@wanderers);

    # Slurp in the directory and close.

    return ($found);
}

#############################################################################
#									    #
#				REMAIL ALL				    #
#									    #
#############################################################################

#
# Takes an array of files that all seem to share a common repcipient and
# remails them if possible.
#
# Parameters: None (uses @wanderers).
#
sub Remail_all {
    local($file,$i);

    $i=0;
    foreach $file (@wanderers) {
	if ( !open (LOSTFILE, "< $file"))  {
	    &Log_info("Could not open " . "$file" . " for remailing");
	    next;
	}

	do {			# Power loop!
	    $done = &Get_next_msg(LOSTFILE); # Retrieve the next message...
	    &Do_remail;		# and remail it.
	} until $done;
	undef ($current_msg);	# Erase the final remailed message.

	close(LOSTFILE);	# Tidy up.

	unlink ($file);		# Remove the remailed file
	$i++;
    }

}

#############################################################################
#									    #
#				CHECK_USER				    #
#									    #
#############################################################################

#
# Checks the password tables for the uid of $currentTO. If the user is
# uid 0 (ie *supposed* to get mail in altmail) or unknown the resend is
# aborted.
#
#
sub Check_user {
    local (@passwdinfo);
    undef (@passwdinfo);

    if (!$noverify && !&vrfy_user($currentTO) ) {
    	&Log_info("Possible non user mail file: $currentTO");
	return $ABORT_RESEND;
    }

    @passwdinfo = getpwnam($currentTO);

    print "Non user mailable mail: Name: $currentTO\n"
	if ( $debug && ! defined @passwdinfo );

    return !$ABORT_RESEND if ( ! defined @passwdinfo ); # A non user but evidently mailable

    print "Check User(): Name: $currentTO  -- UID: $passwdinfo[2]\n" if ($debug);

    return $ABORT_RESEND if ( $passwdinfo[2] == 0 );


    return !$ABORT_RESEND;
}

#############################################################################
#									    #
#				VRFY USER				    #
#									    #
#############################################################################
#
# Use SMTP VRFY to insure that argument is in fact a legal mail id.
#  Boolean: TRUE if mailable account, FALSE if not.

sub vrfy_user {

	local ($mailname,$repl) = @_;

	if ( !&smtp_send("vrfy $mailname") ) {
	    &Log_info("Failed sending to vrfy smtp command for: $mailname");
	    return 0;
	}

	$repl = &smtp_recv;

	print "VRFY REPLY: $repl\n" if ($debug);

	return ( $repl =~ /^2\d\d/ );


}


#############################################################################
#									    #
#				MAIN PROC				    #
#									    #
#############################################################################

# dummy code to shut up perl -w
$debug = 0 if !defined($debug);
print $nomail if $debug > 1;
print $RESENT_FROM if $debug > 1;
print $logopen if $debug > 1;
print $LOCAL_LOCK_EXT if $debug > 1;
print $RESENT_TO if $debug > 1;
print $LOCKEXT if $debug > 1;
print $RESENT_DATE if $debug > 1;
print $MESSAGE_DELIM if $debug > 1;
print $SMTP_retval if $debug > 1;
print $found if $debug > 1;
print $retry_list if $debug > 1;
print $MAILJUNK if $debug > 1;
print $noverify if $debug > 1;
print $SYSTEM_FROM_ADDRESS if $debug > 1;

# BEGIN: stuff
$prefix="@prefix@";
$CONFIGDIR="@sysconfdir@";	# Directory where global config lives
require "$CONFIGDIR/lostaltmail.conf" if (-f "$CONFIGDIR/lostaltmail.conf");
require "/etc/global/lostaltmail.conf" if (-f "/etc/global/lostaltmail.conf");
require "/etc/os/lostaltmail.conf" if (-f "/etc/os/lostaltmail.conf");
require "/etc/local/lostaltmail.conf" if (-f "/etc/local/lostaltmail.conf");


require "ctime.pl";
use Socket;
#require "sys/socket.ph";

# SET some initial state variales
$logopen = 0;

#
# Change to alt_dir
#
# Important!! This directory should be local.  Folks will be responsible
# for finding this out for themselves.
#
if (!defined($MAILDIR) || $MAILDIR eq "") {
    die "MAILDIR must be defined\n";
}
chdir ( $MAILDIR ) || die "Cannot change to $MAILDIR (`x' bit not set?)";

#
# slurp in directory
#
opendir (MAIL, ".") || die "Cannot open $MAILDIR (`r' bit not set?)";
@allentries= readdir (MAIL);
closedir (MAIL);
@allnames = grep (!/$LOCALMAILJUNK|$MAILJUNK/, @allentries);

# Open chanel to SMTP for verification -- unless this option is
# configured off.

if ( ! $noverify ) {
    local($addr, $port,$sockaddr);

    socket (VRFY, &AF_INET, &SOCK_STREAM, 0) ||
	die "Could not create TCP socket (SMTP channel)";

    $addr = (gethostbyname($SMTPHOST))[4]; # Just use the first addr

    die "Could not obtain STMP host ($SMTPHOST) address"
	if ( $addr eq "" );

    $port = (getservbyname('smtp','tcp'))[2]; # Get smtp port.
    die "Could not obtain SMTP port number" if (!defined($port));

    printf("SMTP: address: %s   port: $port\n",
	   join ('.',unpack('C4',$addr))) if ($debug);

    $sockaddr = sockaddr_in($port, $addr);

    printf("Sockaddr: %s\n", join (' ',unpack('C14',$sockaddr))) if ($debug);

    connect (VRFY, $sockaddr) ||
	die "Could not connect to SMTP daemon on $SMTPHOST";

    print "Establshed SMTP channel\n" if ($debug);

    &smtp_recv;	# Greet wait
    &smtp_send("helo $SMTPHOST"); # Helo message for picky SMTPs
    &smtp_recv;		# Helo reply

    # Connection is up and ready to VRFY
}

# main stuff starts here
foreach $currentTO (@allnames) {
    next if ( &Check_user == $ABORT_RESEND);

    # just delete the file if too small to be real mail
    if ((stat($currentTO))[7] < 5) {
	print "Too small to be real mail, unlinking $currentTO" if $debug;
	unlink $currentTO;
    }

    undef (@wanderers);	# Just reset this at each pass.
    @wanderers=grep (/$currentTO\.\d+/, @allentries);

    $remail_file = &Lock_file($currentTO,$FALSE); # Need to lock the spool.

    next if ( $remail_file eq $ABORT_RESEND); # Could not get that lock

    push (@wanderers, $remail_file); # Try to resend "old" files.
    print "List to remail: @wanderers\n" if ($debug);
    # check if  there is something to remail
    &Remail_all if ( defined @wanderers && !$nomail);
}

# this stuff should run at the end
foreach $file (grep (/$LOCALMAILJUNK/,@allentries)) {

    if ($debug) {
	print "Would unlink $file\n" if ($debug);
    } else {
	unlink $file  if (-f $file);
    }

}
&Clean_up;			# Do a clean exit.