659 lines
18 KiB
Plaintext
Executable File
659 lines
18 KiB
Plaintext
Executable File
#!@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.
|