#!/usr/bin/perl
#
#NAME
# Send - Heuristic Direct Mail Delivery 
#
#SYNOPSIS
# Send [-options] [[file] <file>].. [to <rcpt>..] [list <list>..]
#
#DESCRIPTION
# This program sends its stdin or a list of files.  If  the  keywords
# "to"  or  "list"  are  present, then an explicit list of recipients
# will be used, and the files' headers will be  ignored.   Otherwise,
# the  file(s) will be examined for "To:" lines.  Also, if the "list"
# keyword is present, the  names  after  it  are  looked  up  in  the
# $HOME/mail/list/  directory,  where you can keep mailing lists, one
# per file.
#
# No other mailer is invoked by this program; the  mail  is  sent  by
# making  a  direct TCP connection to port 25 and talking the (E)SMTP
# protocol.   At  verbose  level  2  or  greater,  the  entire   SMTP
# conversation  will  be  written  to stdout, so you can see what the
# other end really said.  This can help  tremendously  in  trying  to
# figure out why things didn't work.
#
# If "list" is used, this program looks in $HOME/mail/list/  for  the
# list  names.  So to create a "foo" list, create $HOME/mail/list/foo
# and fill it with email addresses.  They should be one per line,  in
# any  of the common To: line formats.  As usual, lines starting with
# '#' are ignored.  All other lines are treated as recipients.
#
# As a special kludge, if the keyword "file" is used before a list of
# file  names,  the  files' headers will not be scanned.  This may be
# used to override the program's  tendency  to  scan  headers  if  no
# recipients  can be found on the command line or in any mailing list
# files.
#
#OPTIONS
# We have a few options, flagged by '-' or '+'. For some options, '-'
# means "disable" and '+' means "enable"; for others there is no such
# concept and you may use either.  If a parameter is used, it  should
# immediately follow the option letter without a space.
#
# -F<eaddr>
#   From <eaddr>.  This is the source address to report to the  other
#   end's mailer. This is useful when forwarding messages, as well as
#   for spoofing someone else's email.  The most useful  use  is  for
#   mailing lists that restrict your email to your list address. This
#   lets you send messages  from  that  address  even  if  you're  on
#   another machine.
#
# -addto
#  Don't generate to: lines.
# +addto
#   Generate To: lines and add them to the headers.
#
# -send  No sends; just testing
# +send  Send messages (default)
#
# -S<subject>
#   Add the <subject> string to each message as a Subject: line.  The
#   default  is  to  send the Subject: line that's in the file.  This
#   option adds a Subject: line to each file.
#
# -sig  No .signature file
# +sig  Append $HOME/.signature (default)
#
	$sigfl = 1;				# Whether to read .signature file
	$sigfile = $ENV{'HOME'} . '/.signature';
#
# -T<timeout>
# +T<timeout>
#   Timeout interval (seconds).  Default is 30 sec.
#
#REQUIRES
# The following modules are needed.  Any *.pm file listed here should
# be  in the same directory where you found this program.  You should
# make sure that @INC includes whatever directory you install  things
# into.
#
	push @INC, "$ENV{HOME}/bin", "$ENV{HOME}/sh", ".", "sh";
	use Socket;				# Perl's TCP socket stuff
#	require "HTTPcon.pm";	# JC's HTTP connection routine [now included here]
#
#CONFIGURATION
# We need a home directory and a place to put a few log messages:
	$home = $ENV{'HOME'} || '/u/guests/jc';
	$logdir = "$home/log";
#
# If you want this program to identify itself, this  string  will  be
# sent as the User-Agent:
	$myid = "~jc/sh/Send.pl";	# Will anyone notice this?
#
# This program has the ability to lie judiciously to the  other  end,
# in  order to satisfy some of the bizarre misimplementations of SMTP
# that have been seen.  This can be done by configuring any or all of
# the following:
#
# Some hosts don't respond to SMTP connections, but another  hostname
# will work.  Enter such hosts in this table, in lower case, to speed
# up the job:
	%rehost = (
#		'hotmail.com' => 'mail.hotmail.com',	# Are they fixed now?
		'listserv.heanet.ie' => 'mail.heanet.ie',
		'usa.net' => 'mxpool01.netaddress.usa.net',
	);
#
# If we can't connect directly to a machine,  we  use  this  list  of
# hosts to use as relays. We connect to each in turn, and try to hand
# off the message.
	@relay = (				# Mail relay hosts
#		'ecf-guest.mit.edu',
	);
#
# For each of the relay machines, we may need to send  its  mailer  a
# string  to  identify our machine.  The default is our hostname, but
# you can use this to specify other strings:
	%hostid = (			# Host names to send to specific hosts
		'trillian.mit.edu' => 'ecf-guest.mit.edu',
		'bigfoot.com'      => 'eddie.mit.edu',
		'yahoo.com'        => 'ecf-guest.mit.edu',
#		'yahoogroups.com'  => 'trillian.mit.edu',
		'mindspring.com'   => 'ecf-guest.mit.edu',
	);
	$hostid = 'trillian.mit.edu';	# For all other hosts
#
# You may also need to specify your  user  id  differently  for  some
# remote hosts.
	%userid = (			# User identification to send to hosts
	);
	$userid = 'jc';		# For all other hosts
#
# You can also specify a full name to give in the From: lines:
	%fullnm = (			# Per-host names to send
		'trillian.mit.edu' => 'John Chambers',
		'bigfoot.com'      => 'Jean Chambres',
		'yahoo.com'        => 'Jean Chambres',
		'yahoogroups.com'  => 'Jean Chambres',
		'mindspring.com'   => 'Jean Chambres',
	);
	$fullnm = "John Chambers";	# For all other hosts
#
# Some sites can't be handled this way, and you to  use  a  different
# email address depending on which recipient you are sending to.  The
# most common reason for this is mailing lists that only accept  mail
# from list members.
	%adrmap = (			# rcpt => sender mapping
#		'tradtunes@yahoogroups.com' => 'John Chambers <jc@trillian.mit.edu>',
#		'scand@yahoogroups.com'     => 'John Chambers <jc@trillian.mit.edu>',
		'rjelly@yahoogroups.com'    => 'Jean Chambres <jc@ecf-guest.mit.edu>',
		'gaybladesrapper@yahoogroups.com' => 'Jean Chambres <jc@trillian.mit.edu>',
#		'QueTrad@yahoogroups.com'   => 'Jean Chambres <jc@ecf-guest.mit.edu>',
	);
#
#ENVIRONMENT
# We get our verbose level from the environment.  If this program  is
# called "Send", then you might set V_Send to the verbose level.  The
# default is 1, which produces only serious messages.  Higher numbers
# will produce more output.
#
# We need to know about a couple of directories:
	$maildir = '/usr/mail';
	$homedir = $ENV{HOME} || $maildir;
# We will look for a 'list' subdirectory to  either  of  these  as  a
# place to find mailing-list files.
#
#EXAMPLES
#
#FILES
#
#BUGS
#
#KLUDGES
#
# We suppress Bcc: lines, after extracting the recipient info.   This
# was  the easiest way of hiding these lines.  We also hide any extra
# To: header lines. The reason is that some mailers choke if they get
# more  than  one  To: line.  We handle them properly, of course, but
# strip them out so as not to offend sensitive email software.  Maybe
# they should be changed to Cc: lines?
#
#SEE ALSO
#
#AUTHOR
# Copyright 1995, 1999, 2003 by John Chambers  <jc@trillian.mit.edu>.
# You  are  free to use this program as you wish, as long as you give
# me credit (and take credit for your changes).  If you come up  with
# any cool new features, please send me a copy.
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #

$| = 1;
$" = ',';
$exitstat = 0;					# Set to nonzero for failures

use Socket;

($P = $0) =~ s".*/"";			# Our program name, minus any directory
&Vinit($ENV{"V_$P"}||2);		# Our verbose level, defaults to 1 or 2

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Initialization:
$HTTPalrm    = 0;		# Alarm needs to be handled
$HTTPcons    = 0;		# Count of connections
$HTTPcontime = time;	# When the connection happens
$HTTPtimeout = 30;	# Timeout for connects

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Create our logfile:

$logfile = "$logdir/$P.log";	# Where to write log messages
mkdir($logdir,0755) unless -d $logdir;
if (open(LOG,">>$logfile")) {
	++$logopen;			# Note that we have a log file
} else {
	print STDERR "$P: Can't write \"$logfile\" ($!)\n";
}

$addto = 0;				# Whether to generate to: lines for lists
$argis = 'msg';		# How to interpret args
$CRLF  = "\r\n";		# RFC 822 line terminator
$hlo   = 'HELO';		# Default greeting
$initCRLF = 0;			# Whether to send initial blank line after connect
$parsehdrs = 0;		# Whether to read file headers
#proto = getprotobyname('tcp');
$port  = getservbyname('smtp','tcp');
$hdrs  = 1;				# Whether to generate email headers
$senddt = 0;			# Whether to send Date: lines
$sendfl = 1;			# Send messages only if true
$tryalt = 1;			# Whether to try variants on host name
$usehostcmd = 1;		# Use host command to find mail hosts
$usenslookupcmd = 1;	# Use nslookup to file mail hosts

chomp($hostid = `hostname`) unless $hostid;
&vsend("$P: Our hostid=\"$hostid\"") if $V>2;
chomp($userid = $ENV{LOGNAME} || $ENV{USER}) unless $userid;
&vsend("$P: Our userid=\"$userid\"") if $V>2;
chomp($fullnm = $ENV{FULLNAME}) unless $fullnm;
&vsend("$P: Our fullnm=\"$fullnm\"") if $V>2;

# Sort the command-line args into bins
arg:
for $arg (@ARGV) {
	if (($flg,$a) = ($arg =~ /^([-+])(.*)/)) {
		&vsend("$P: Option \"$a\"") if $V>3;
		if ($a =~ /^[DdVv]/) {
			push @opts, '-v';
			&vsend("$P: opts=(@opts)") if $V>2;
		} elsif ($a =~ /^(addto|to)$/i) {
			$addto = ($flg eq '+');
			&vsend("$P: addto=$addto.") if $V>1;
		} elsif ($a =~ /^[Ff](.*)/) {
			$From = $1;
			&vsend("$P: From='$From'") if $V>2;
		} elsif ($a =~ /^[Tt](\d+)$/) {
			$HTTPtimeout = int($1);
			&vsend("$P: Timeout='$HTTPtimeout'") if $V>2;
		} elsif ($a =~ /^[Tt]/) {
			push @opts, '-t';
			&vsend("$P: opts=(@opts)") if $V>2;
		} elsif ($a =~ /^[Ss](.*)/) {
			if ($a =~ /^send/i) {
				$sendfl = ($flg eq '+');
				&vsend("$P: sendfl=\"$sendfl\"") if $V>2;
			} elsif ($a =~ /^sig/i) {
				$sigfl = ($flg eq '+');
				&vsend("$P: sigfl=\"$sigfl\"") if $V>2;
			} else {
				$subj = $1;
				&vsend("$P: subj=\"$subj\"") if $V>2;
			}
		} else {
			&vsend("$P: Option \"$a\" not recognized, ignored.") if $V>2;
		}
		next arg;
	}
	&vsend("$P: Arg \"$arg\"") if $V>3;
	if ($arg eq 'to'  ) {$argis = 'rcpt'; next arg}
	if ($arg eq 'list') {$argis = 'list'; next arg}
	if ($arg eq 'rcpt') {$argis = 'rcpt'; next arg}
	if ($arg eq 'file') {$argis = 'file'; $hdrs = 0; next arg}
	if ($argis eq 'rcpt') {			# Recipients
		push @rcpts, $arg;
		&vsend("$P: rcpts: @rcpts") if $V>2;
		$parsehdrs = 0;
		next arg;
	} elsif ($argis eq 'list') {	# Mailing lists
		push @lists, $arg;
		&vsend("$P: lists: @lists") if $V>2;
		$parsehdrs = 0;
		next arg;
	} else {		# Anything else is file name
		push @files, $arg;
		&vsend("$P: files: @files") if $V>2;
		next arg;
	}
}

# If we got no file names, we read from standard input into a scratch
# file, and send that message to all our recipients.
unless (@files) {
	$tmpfil = "/tmp/Mail$$";
	&vsend("$P: <=  STDIN") if $V>1;
# Needed if there are relic /tmp/Mail* files:
#	system 'rm /tmp/Mail*';
	unless (open(TMP,">$tmpfil")) {
		&vsend("$P: Can't write \"$tmpfil\" ($!)") if $V>0;
		exit $!;
	}
	while ($l = <STDIN>) {print TMP $l;}
	close TMP;
	push @files, $tmpfil;
	$parsehdrs = 0;
}

# If we got mailing list name(s), we look for the list files and
# extract all the email addresses, adding them to @rcpts.
list:
for $l (@lists) {
	$listfil = '';
	if      ( -f ($listfil = "$homedir/mail/list/$l")) {
	} elsif ( -f ($listfil = "$maildir/list/$l")) {
	} else { next list }
	push @rcpts, &parselist($listfil);
}

unless (@rcpts) {
	$parsehdrs = 1;			# Look for To: lines in files
	$opts[$#opts+1] = '-t';	# Sendmail flag with same meaning
}

file:
for $f (@files) {
	&vsend("$P: Reading mail from $f ...") if $V>2;
	$from = '';				# May be set in headers
	unless (@rcpts) {		# No global recipients
		&vsend("$P: Scan file \"$f\" for recipients ...") if $V>2;
		@rcpts = &parsehdrs($f);
		&vsend("$P: rcpts=(@rcpts)") if $V>2;
		$fromhdrs = 1;		# Note recipients are from file
	}
	unless (@rcpts) {		# Do we have any recipients?
		&vsend("$P: No recipients found in file \"$f\".") if $V>2;
		next file;
	}
	&vsend("$P: Send file \"$f\" to all recipients ...") if $V>2;
	for $r (@rcpts) {		# Send out one file to all recipients
		&vsend("$P: Send file \"$f\" to \"$r\" ...") if $V>1;
		&fil($f,$r);
	}
	if ($fromhdrs) {		# Did recipients come from file?
		@rcpts = ();		# If so, forget about them
		$fromhdrs = 0;		# No known recipients now
	}
}


if ($tmpfil) {
	unlink $tmpfil      if $V<3;
}
exit $exitstat;

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #

sub HTTPalarm {
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
	my $t = time - $HTTPcontime;
	print "<!--HTTPcon: ALARM after $t sec -->\n" if $W3trace;
#	exit -1;
	$errmsg = 'timeout';
}

sub HTTPcon {my $F='HTTPcon';
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# NAME                                                                #
#   HTTPcon - make HTTP connection.                                   #
#                                                                     #
# SYNOPSIS                                                            #
#   $stat = &HTTPcon(*F,'fubar.com:1234');                            #
#                                                                     #
# DESCRIIPTION                                                        #
#   This  accepts a URL's host:port portion, and attempts to make the #
#   connection.  If successful, we return 1 with F open  to  the  TCP #
#   socket.   If  we fail, we return 0, and F may or may not be open. #
#   (Maybe we should close it.)                                       #
#                                                                     #
# TIMEOUTS                                                            #
#   I've added a timeout kludge:  If $HTTPtimeout is nonzero, we will #
#   exit after that many seconds. This is drastic, but it seems to be #
#   the only solution to the hung-connect problem.   This  is  mostly #
#   used  in webcat, which is used as a subprocess by other programs. #
#   If you call "webcat -T15 ...", it will exit after 15  seconds  if #
#   the connection can't be made, and you can go about your business. #
#                                                                     #
# AUTHOR                                                              #
#   <a href="mailto:jc@trillian.mit.edu">John Chambers</a>            #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
	local(*HTTPsock,$hp) = @_;
	local($a,$b,$c,$d);
	local(@addrs,$host,$port,$savsig,$t,$this,$that,$This,$That);
	$HTTPtimeout = 30 unless defined $HTTPtimeout;
	$W3trace     =  0 unless defined $W3trace;
	if (($host,$port) = ($hp =~ m"^(.*):(\d+)$")) {
		print V "HTTPcon: host=\"$host\" port=\"$port\"\n" if $V>5;
	} else {
		$host = $hp;
		$port = 80;
		print V "HTTPcon: host=\"$host\" port=$port.\n" if $V>5;
	}
	$AF_INET = 2;
	$SOCK_STREAM = 1;
	$sockaddr = 'S n a4 x8';
	($name,$aliases,$proto) = getprotobyname('tcp');
	($name,$aliases,$port) = getservbyname($port,'tcp')
		unless $port =~ /^\d+$/;
	$thisaddr = "\0\0\0\0";
	print "<!--HTTPcon: Get address for \"$host\" -->\n" if $W3trace;
	($name,$aliases,$type,$len,@addrs) = gethostbyname($host);
	if (!@addrs) {
		$errmsg = "No address for \"$host\"";
		return 0;
	}
	$thataddr = $addrs[0];
	$this = pack($sockaddr, $AF_INET, 0, $thisaddr);
	$that = pack($sockaddr, $AF_INET, $port, $thataddr);
	($a,$b,$c,$d) = unpack('C4',$thisaddr);
	$This = "$a.$b.$c.$d:0";
	($a,$b,$c,$d) = unpack('C4',$thataddr);
	$That = "$a.$b.$c.$d:$port";
	if (socket(HTTPsock,$AF_INET,$SOCK_STREAM,$proto)) {
		print V "Got socket ... " if $V>1;
	} else {
		print V "[HTTPcon: Can't get socket ($!)]\n" if $V>0;
		$exitstat = $!;
		return 0;
	}
	if (bind(HTTPsock,$this)) {
		$t = time - $HTTPcontime;
		print V "HTTPcon: Bind to \"$This\" succeeded in $t sec.\n" if $V>5;
	} else {
		$t = time - $HTTPcontime;
		print V "HTTPcon: Bind to \"$This\" failed in $t sec ($!)\n" if $V>2;
		$exitstat = $!;
		return 0;
	}
	++$HTTPcons;
	$HTTPcontime = time;
	if ($HTTPtimeout > 0) {
		alarm $HTTPtimeout;
		$savsig = $SIG{ALRM};
		$SIG{ALRM} = 'HTTPalarm';
		print V "HTTPcon: Set alarm after $HTTPtimeout sec.\n" if $V>3;
	}
	print V "HTTPcon: Connecting to \"$That\" ...\n" if $W3trace || $V>2;
	if ($that = sockaddr_in($port,$thataddr)) {
		print V "<!--$F: sockaddr_in() succeeed -->\n" if $V>2;
	} else {
		print V "<!--$F: ### sockaddr_in() failed for port='$port' thataddr='$thataddr' ###-->\n" if $V>1;
	}
	if (connect(HTTPsock,$that)) {
		$t = time - $HTTPcontime;
		print V "HTTPcon: Connect $HTTPcons to \"$That\" succeeded in $t sec.\n" if $V>5;
		print "<!--HTTPcon: Connected to \"$That\" -->\n" if $W3trace;
		if ($HTTPtimeout > 0) {
			alarm 0;
			$SIG{ALRM} = $savsig;
			print V "HTTPcon: Set alarm 0.\n" if $V>5;
		}
	} else {
		$t = time - $HTTPcontime;
		print "<!--HTTPcon: Can't connect to \"$That\" in $t sec. ($!)" if $W3trace;
		print V "HTTPcon: Connect $HTTPcons to \"$That\" failed ($!) after $t sec.\n" if $V>2;
		$exitstat = $!;
		if ($HTTPtimeout > 0) {
			alarm 0;
			$SIG{ALRM} = $savsig;
			print V "HTTPcon: Set alarm 0.\n" if $V>5;
		}
		return 0;
	}
	if ($HTTPalrm) {
		close HTTPsock;
		alarm 0;
		$SIG{ALRM} = $savsig;
		print V "HTTPcon: Set alarm 0.\n" if $V>5;
	} else {
		select(HTTPsock); $| = 1; select(STDOUT);
	}
	return 1;
}

sub SendAlarm {
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
	my $t = time - $HTTPcontime;
	&vsend("SendAlarm: ALARM after $t sec.") if $V>1;
	$errmsg = 'timeout';
}

sub Vinit {
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Verbose initialization. We make sure that $V is set to a number and
# the V file handle is open as a place to write messages.
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
	local($opt) = @_;
	($V,$Vfil) = ($opt =~ /^(\d*)(.*)/);
	$V = 2 unless $V;
	if ($Vfil) {
		unless (open(V,">$Vfil")) {
			print STDERR "$P:Vinit: Can't write \"$Vfil\" ($!)\n";
			open(V,">&STDERR");
			$Vfil = 'STDERR';
		}
	} else {
		open(V,">&STDERR");
		$Vfil = 'STDERR';
	}
	select V; $| = 1; select STDOUT;
	&vsend("$P:Vinit: V=$V \"$Vfil\"") if $V>3;
	&vsend("\n$P " . join(' ',@ARGV)) if $V>1;
}

sub connects {
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
	local($thathst, $port) = @_;
	local($tail,$try,$t0,$t1,$ti);
	&vwrite("$F: === Connect to $thathst:$port ... ") if $V>1;
	$t0 = time;
	if (&HTTPcon(*SCK,$try="$thathst:$port")) {
		$ti = time - $t0;
		&vwrite("[1] connected in $ti sec.\n");
		return $try;
	}
	$ti = time - $t0;
	&vwrite("failed in $ti sec ($!)\n") if $V>1;
	&vwrite("$F: === Connect to mail.$thathst:$port ... ") if $V>1;
	$t1 = time;
	if (&HTTPcon(*SCK,$try="mail.$thathst:$port")) {
		$ti = time - $t1;
		&vwrite("[2] connected in $ti sec.\n");
		return $try;
	}
	$ti = time - $t1;
	&vwrite("failed in $ti sec ($!)\n") if $V>1;
	if ($tryalt) {
		$tail = $thathst;
		while ($tail =~ /^([^.]*)\.(.*)\.(.*)/) {
			$tail = "$2.$3";
			&vwrite("$F: === connect to $tail:$port ... ") if $V>1;
			$t1 = time;
			if (&HTTPcon(*SCK,$try="$tail:$port")) {
				$ti = time - $t1;
				&vwrite("[3] connected in $ti sec.\n");
				return $try;
			}
			$ti = time - $t1;
			&vwrite("failed in $ti sec ($!)\n") if $V>1;
			&vwrite("$F: === connect to mail.$tail:$port ...") if $V>1;
			$t1 = time;
			if (&HTTPcon(*SCK,$try="mail.$tail:$port")) {
				$ti = time - $t1;
				&vwrite("[4] connected in $ti sec.\n");
				return $try;
			}
			$ti = time - $t1;
			&vwrite("failed in $ti sec ($!)\n") if $V>1;
		}
	}
	&vsend("$F: Can't find mail server for \"$thathst\"") if $V>1;
	return undef;	# Failure
}

sub fil {
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Send one mail file to one recipient.
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
	local($file,$rcpt) = @_;
	local($nam,$rly,$sys,$who);
	local($F) = "$P:fil";
	&vsend("$F: file='$file' rcpt='$rcpt' V=$V.") if $V>1;
	if ($listnames{$rcpt}) {	# Break possible recursive loops
		&vsend("$F: Rcpt \"$rcpt\" is a list.") if $V>1;
		return 0;				# List should have been expanded
	}
	&vsend("$F: Send \"$file\" to \"$rcpt\" ===========================") if $V>0;
	unless (($sys,$who,$nam) = &parsercpt($rcpt)) {
		&vsend("$F: Can't send to recipient \"$rcpt\"") if $V>0;
		return undef;
	}
	$sys =~ s"\.+$"";		# Some mailers can't handle trailing dots on hostname
	return undef unless $who && $sys;
	unless (open(MSG,$file)) {
		print STDERR "$F: ### Can't read \"$file\" ($!)\n";
		&vsend("$F: ### Can't read \"$file\" ($!)");
		return undef;
	}
	&vsend("$F: *** \"$file\" to \"$who\" at \"$sys\" ($nam)") if $V>1;
	&lsend("$F:	\"$file\" to \"$who\" at \"$sys\" ($nam)") if $V>2;
	if (&msg($sys,$who,$nam)) {
		&vsend("$F: Sent to \"$who\" ($nam) at \"$sys\"") if $V>2;
		close MSG;
		return 1;
	}
	&vsend("$F: Mail to \"$who\" at \"$sys\" FAILED because \"$errmsg\".") if $V>2;
	for $rly (@relay) {
		&vsend("$F: <=  \"$file\" to \"$rcpt\" via \"$rly\" ...") if $V>1;
		unless (open(MSG,$file)) {
			print STDERR "Can't read \"$file\" ($!)\n";
			return undef;
		}
		if (&msg($rly,$rcpt,$nam)) {
			&vsend("$F: Sent \"$file\" to \"$rcpt\" via \"$rly\".") if $V>2;
			close MSG;
			return 1;
		}
		&vsend("$F: Send \"$file\" to \"$rcpt\" via \"$rly\" FAILED.") if $V>2;
		&lsend(&isodt() . " Send \"$file\" to \"$who\" at \"$sys\" ($nam) FAILED.");
	}
	&vsend("$F: FAILED for file '$file' rcpt '$rcpt' ('$who' at '$sys')") if $V>0;
	&lsend(&isodt() . " Send '$file' FAILED for '$rcpt' ('$who' at '$sys')");
	return 0;
}

sub gmdate {
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Get the date and time, in the  UTC/GMT  time  zone.   We  return  a #
# human-readable date, and also leave the date and time behind in the #
# global $isodt variable.                                             #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
	local($sec,$min,$hour,$mday,$mon,$year,$wday) = gmtime(time);
	@wkday = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat','Sun');
	@month = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
	$Mon = $month[$mon];
	$Day = $wkday[$wday];
	$isodt = sprintf("%04d%02d%02d%02d%02d%02d",1900+$year,$mon,$mday,$hour,$min,$sec);
	return sprintf("%s, %02d %s %04d %02d:%02d:%02d",$Day,$mday,$Mon,1900+$year,$hour,$min,$sec);
}

sub isodt {
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
	local($sec,$min,$hour,$mday,$mon,$year,$wday) = gmtime(time);
	@wkday = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat','Sun');
	@month = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
	$Mon = $month[$mon];
	$Day = $wkday[$wday];
	return sprintf("%04d-%02d-%02d %02d:%02d:%02d +0000",1900+$year,1+$mon,$mday,$hour,$min,$sec);
}

sub lsend {
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -#
# Send a message to the log output stream, adding a newline. #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -#
	for (@_) {print LOG $_ . "\n"}
}

sub msend {
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Send one or more messages to the mail output socket, with added newlines. #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
	local($m,$s,$savsig);
	if ($HTTPtimeout > 0) {
		alarm $HTTPtimeout;
		$savsig = $SIG{ALRM};
		$SIG{ALRM} = 'SendAlarm';
		print V "HTTPcon: Set alarm after $HTTPtimeout sec.\n" if $V>4;
	}
	for $m (@_) {
		($s = $m) =~ s"[\r\s]*$"$CRLF";
		print SCK $s;
		&vsend("$F:  => $s") if $V>2;
		$mchars += length($s);
		$mlines ++;
	}
	alarm 0;
	$SIG{ALRM} = $savsig;
}

sub msg {
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Here's the routine that handles sending the current $file to one  recipient #
# on one host.  Note that the caller has opened the message file, and we just #
# read from the MSG file handle.   We  connect  to  the  host,  and  if  that #
# succeeds, we do a simple SMTP handshake.  If any of this fails, we return 0 #
# for failure.  If it succeeds, we send the MSG file's contents, a "."  line, #
# and a QUIT, and then return 1 to indicate success.                          #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
	local($thathst,$thatusr,$thatnm) = @_;
	local($thishst,$thisusr,$symnam,$rcpt,$mchars,$mlines,$orighst,$sndr);
	local($hostport,$isots,$l,@mx,$mxcmd,@nslookup,$mxhost,$tralt,$ToCnt);
	local($F) = "$P:msg";
	$mchars = $mlines = 0;
	$symnam = " ($thatnm)" if $thatnm;
	$orighst = $thathst;
	&vsend("$F: Send \"$file\" to host \"$thathst\" user \"$thatusr\" name \"$symnam\"...") if $V>2;
	if ($substhost = $rehost{lc($thathst)}) {
		&vsend("$F: === rehost $thathst to $substhost.") if $V>1;
		$thathst = $substhost;
		push @mx, $substhost;
	}
	&vsend("$F: MX lookup for $thathst ...") if $V>2;
#
# host formats:
# lycos.com mail is handled (pri=20) by mx1.mail.lycos.com
# lycos.com mail is handled by 10 mx.mail.lycos.com.
#
	if ($usehostcmd) {
		$mxcmd = "host -t mx $thathst";
		&vsend("$F: cmd \"$mxcmd\"") if $V>1;
		if (open(MX,"$mxcmd |")) {
			while ($l = <MX>) {
				$l =~ s/[\s\r]+$//;
				# foo.com mail is handled (pri=1) by mta1.grp.scd.yahoo.com
				if ($l =~ / is handled \(*pri=(\d+)\)* by (.*)/) {	# Format on FreeBSD
					&vsend("$F: === MX \"$thathst\" => \"$2\".") if $V>1;
					push @mx, $2;
				} elsif ($l =~ / is handled by (\d+) (.*)/) {	# Format on RH 8.0 linux
					&vsend("$F: === MX \"$thathst\" => \"$2\".") if $V>1;
					push @mx, $2;
				} elsif ($l =~ / is a nickname for (.*)/) {	# Format on FreeBSD
					&vsend("$F: === MX \"$thathst\" => \"$1\".") if $V>1;
					push @mx, $1;
				}
			}
			close MX;
		}
	}
	if (!@mx && $usenslookupcmd) {
	#	$mxcmd = "nslookup -sil -querytype=mx $thathst";
		$mxcmd = "nslookup -querytype=mx $thathst";
		&vsend("$F: cmd \"$mxcmd\"") if $V>1;
		if (open(MX,"$mxcmd |")) {
			while ($l = <MX>) {
				$l =~ s/[\s\r]+$//;
				if ($l =~ /preference = (\d+), mail exchanger = (.*)$/) {
					&vsend("$F: === MX \"$thathst\" => \"$2\".") if $V>1;
					push @mx, $2;
				} elsif ($l =~ /canonical name = *(.*)/) {
					&vsend("$F: === MX \"$thathst\" => \"$1\".") if $V>1;
					push @mx, $1;
				}
			}
			close MX;
		}
	}
	unless (@mx) {
		&vsend("$F: Lookups failed; using host \"$thathst\"") if $V>2;
		push @mx, $thathst;
	}
MX:	for $mxhost (@mx) {
		&vsend("$F: Try MX host \"$mxhost\" ...") if $V>2;
		$tralt = $tryalt;	# Disable tryalt mode for mx hosts
		$tryalt = 0;
		if ($hostport = &connects($mxhost, $port)) {
			last MX;
		}
		$tryalt = $tralt;	# Restory tryalt mode
	}
	unless ($hostport) {
		&vsend("$F: Giving up on $thathst.") if $V>0;
		return undef;
	}
	&vsend("$F: === Connected to $hostport.") if $V>5;
	&msend("") if $initCRLF;
	$thishst = $hostid{$thathst} || $hostid; &vsend("$F: thishst=\"$thishst\"") if $V>3;
	$thisusr = $userid{$thathst} || $userid; &vsend("$F: thisusr=\"$thisusr\"") if $V>3;
	$thisnam = $fullnm{$thathst} || $fullnm; &vsend("$F: thisnam=\"$thisnam\"") if $V>3;
	$sndr = $From || "<$thisusr\@$thishst>";
	if ($thatusr =~ /\@/) {
		$rcpt = "$thatusr";
	} else {
		$rcpt = "$thatusr\@$orighst";
	}
	if ($adrmap{$rcpt}) {
		$sndr = $rpto = $adrmap{$rcpt};
		&vsend("$F: Claim to be '$sndr' for '$rcpt'") if $V>1;
	} else {
		$rpto = $ENV{'REPLYTO'} || "$thisnam $sndr";
	}
	$hlo = 'HELO';		# Use RFC 821 greeting first
	return 0 if &msgrsp("")                 >= 400;
	if ($sendfl) {
		return 0 if &msgrsp("$hlo $thishst")    >= 400;
		return 0 if &msgrsp("MAIL From: $sndr") >= 400;
		return 0 if &msgrsp("RCPT To: <$rcpt>") >= 400;
		return 0 if &msgrsp("DATA")             >= 400;
		unless ($msid) {	# Generate a message ID string
			&gmdate();
			$msid = "<$isodt.$$.$userid\@$hostid>";
		}
		if ($hdrs) {
			print  V  "To: <$rcpt>\n" if $V>2;
			print  V  "Subject: $subj\n" if $V>2;
			&msend("To: <$rcpt>"); ++$ToCnt;
			&msend("X-Sent-To: <$rcpt>");
			unless($date) {$date = &gmdate()}
			if    ($subj) {&msend("Subject: $subj")}
			unless($from) {&msend("From: $sndr"); &msend("X-Sent-From: $sndr")}
			if    ($date) {&msend("Date: $date +0000")}
			if    ($rpto) {&msend("Reply-to: $rpto")}
			if    ($myid) {&msend("User-Agent: $myid")}
			if    ($msid) {&msend("Message-ID: $msid")}
			if  ($inrpto) {&msend("In-Reply-To: $inrpto")}
#			&msend("");			# Blank line to terminate our headers
			print V "$F: MSG " if $V==2;
		}
		while ($l = <MSG>) {
			if ($hdrs) {			# Suppress Bcc lines
				next if ($l =~ /^Bcc:/i);
			#	$l =~ s/^To:/Cc:/i if $ToCnt>1;	# Convert extra To lines to Cc
			}
			$l =~ s"[\s\r]+$"";		# Trim trailing whitespace
			$l =~ s"^\."..";		# RFC 821 transparency
			&msend($l);
			print V '+' if $V==2;	# One + per line
#			sleep 1 if $V==2;		# Slow it down to verify output
		}
		print V "\n" if $V==2;
		if ($sigfl) {
			if (open(SIG,$sigfile)) {
				print V "$F: SIG " if $V==2;
				&msend("$CRLF--");	# We need the \r for 822bis/2822 compliance
				while ($l = <SIG>) {
					$l =~ s"[\s\r]+$"";		# Trim trailing whitespace
					$l =~ s"^\."..";		# RFC 821 transparency
					&msend($l);
					print V '+' if $V==2;	# One + per line
				}
				close SIG;
				print V "\n" if $V==2;
			} else {
				&vsend("$F: Can't read \"$sigfile\" ($!)") if $V>0;
				$sigfl = 0;
			}
		}
		&msend("\r\n.\r\n");    # Some mailers want the \r chars in the signoff
		&vsend("$F:  => . (sent $mlines lines $mchars chars)") if $V==2;
		chomp($rsp = <SCK>);
		&vsend("$F: <=  $rsp") if $V>1;
		&lsend(&isodt() . " Sent \"$file\" to \"$who\" at \"$sys\" ($nam)");
	} else {
		&lsend(&isodt() . " Drop \"$file\" to \"$who\" at \"$sys\" ($nam)");
		&vsend("$F: ### \"$file\" to \"$who\" at \"$sys\" ($nam) DROPPED ###") if $V>1;
	}
	return 1;
}

sub msgrsp {
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Send one message and wait for one response.  We expect the response
# to start with a status code, which we return. SMTP status codes are
# errors if they are 400 or greater.
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
	local($msg) = join('',@_);
	local($rsp,$t0,$t);
	$errcode = 0;
	$errmsg = '';
	if ($msg) {
		&msend("$msg");
		&vsend("$F:  => $msg") if $V==2;
	}
response:
	while (1) {
		$t0 = time;
		$rsp = <SCK>;
		&vsend("$F: ### $t-sec delay.") if (($t = time - $t0) > 1);
		$rsp =~ s/[\s\r]+$//;
		&vsend("$F: <=  $rsp") if $V>1;
		if ($rsp =~ /\bESMTP\b/) {
			$hlo = 'EHLO';	# Kludge for servers that speak ESMTP
			&vsend("$F: === Switch to ESMTP.") if $V>1;
		}
		if (($errcode,$errmsg) = ($rsp =~ /^(\d+)-(.*)\s*$/)) {
			&vsend("$F: Rsp $errcode-$errmsg") if $V>5;
			next response;
		}
		if (($errcode,$errmsg) = ($rsp =~ /^(\d+)\s+(.*)\s*$/)) {
			&vsend("$F: ERR $errcode $errmsg\n$F: ERR from \"$sys\"") if $V>0 && $errcode >= 400;
		}
		return $errcode;
	}
}

sub parsehdrs {
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Read a file and extract recipient info from its headers. Return the #
# list of recipients. We also note and Date: line and save its value. #
# A complication here is that SMTP header lines may be continued by a #
# line  that starts with whitespace.  This means we have to read them #
# into a buffer (@h),  appending  continuation  lines  until  we  hit #
# another  header  or null line.  When we run out of headers, we then #
# read thru @h and extract the headers we find interesting.           #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
	local($file);	# File(s) to scan
	local($F) = "$P:parsehdrs";
	local(@h,$n,$r,@r);
	for $file (@_) {
		unless (open(FIL,$file)) {
			&vsend("$F: Can't read \"$file\" ($!)") if $V>0;
			next;
		}
line:	while ($line = <FIL>) {
			$line =~ s/[\s\r]+$//;
			$line =~ s/\(([^)]+)\s*[;,]\s*([^)]+)\)/($1 $2)/g;
			if ($line eq '') {
				&vsend("$F: NULL line ends headers.") if $V>2;
				last line;
			} elsif ($line =~ /^-----/) {
				&vsend("$F: Dashed line ends headers.") if $V>2;
				last line;
			} elsif ($line =~ /^(Date|From|To|Cc|Bcc):/i) {	# Wanted
				push @h, $line;
			} elsif ($line =~ /^\s+(.*)/) {		# Continuation
				$h[$#h] .= ", $line";	# Comma to get rcpt lists right
			} else {
				push @h, $line;	# Unused, but may have continuation
			}
		}
		for $line (@h) {
			if ($line =~ /^(From):\s*"*(.*)"*\s*<(.*)>$/i) { 
				&vsend("$F: From \"$1\" <$2>") if $V>2;
				$from = "$2 <$3>";
				push @r, $3;
		#	} elsif ($line =~ /^(To):\s*(.*)<(.*)>$/i) { 
		#		&vsend("$F: RCPT 1 ($3)") if $V>2;
		#		push @r, $3;
			} elsif ($line =~ /^(To|Cc|Bcc):\s*(.*)$/i) { 
				# Problem:  This splits a "Fname, Gname" name into two "recipients"
				for $r (split(/\s*[;,]\s*/,$2)) {	# We look for ';' and ',' - both happen
					$r =~ s/^\s*(.*?)\s*$/$1/;		# Trim the address
					&vsend("$F: RCPT 2 \"$r\"") if $V>2;
					push @r, $r if $r;
				}
			} elsif ($line =~ /^(Date):\s*(.*)\s*$/i) { 
				&vsend("$F: Date \"$2\"") if $V>2;
				$date = $2;
			} elsif ($line =~ /^(Message-ID):\s*(.*)\s*$/i) { 
				$inrpto = $2;
				&vsend("$F: Message-ID \"$inrpto\"") if $V>2;
			} else {
				&vsend("$F: Drop \"$line\"") if $V>4;
			}
		}
	}
	$n = int(@r);
	&vsend("$F: Found $n recipients in $f file.") if $V>2;
	return @r;
}

sub parselist {
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Mailing-list files should have one recipient per line. We trim away
# initial  and  trailing whitespace, and anything after a # or comma.
# The remaining strings are added to the list that we return.
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
	local($f) = @_;
	local($r,@r);
	local($F) = "$P:parselist";
	unless (open(LST,"<$f")) {
		print STDERR "Can't read \"$f\"\n";
		next list;
	}
	while ($r = <LST>) {
		$r =~ s/^\s*(.*)[\s\r]*$/$1/;	# Trim white space
		$r =~ s/\s*[#;,].*$/$1/;		# Trim comments
		next if !$r;				# Ignore empty lines
		&vsend("$F: Rcpt: \"$r\"") if $V>2;
		push @r, $r;
	}
	close LST;
	return @r;
}

sub parsercpt {
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Parse a recipient's email address into a host and remainder string.
# The  return value is a list of three values:  system, user, and any
# symbolic user name that is found.
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
	local($x) = @_;
	local($f,$h,$n,$r,@r);
	local($F) = "$P:parsercpt";
	if ($x =~ /^\s*<*([^@%]+)[@%]([-.\w]+)>*\s*\((.*)\)\s*$/) {
		&vsend("$F: Matched @%-style address with rcpt \"$1\" host \"$2\" name ($3).") if $V>2;
		return ($2,$1,$3);
	}
	if (($n,$r,$h) = ($x =~ /^(.*)<([^@%]+)[@%]([-.\w]+)>$/)) {
		$n =~ s/^[\s"]+//;
		$n =~ s/[\s"]+$//;
		&vsend("$F: Matched @%-style address with rcpt \"$r\" host \"$h\" name \"$n\".") if $V>2;
		return ($h,$r,$n);
	}
	if ($x =~ /^([^@%]+)[@%]([-.\w]+)$/) {
		&vsend("$F: Matched @%-style address with rcpt \"$1\" host \"$2\" (no name).") if $V>2;
		return ($2,$1,'');
	}
	if ($x =~ /^([-.\w]+)[!:]+([^@%]+)$/) {
		&vsend("$F: Matched !:-style address with rcpt \"$2\" host \"$1\" (no name).") if $V>2;
		return ($2,$1);
	}
	if ($x =~ /^[-+._\w]+$/) {
		&vsend("$F: Matched user name \"$x\" alone.") if $V>0;
		if (-f ($f = "$homedir/mail/list/$x")) {
			&vsend("$F: Found $f file.") if $V>0;
			if (@r = &parselist($f)) {
				$n = int(@r);
				if ($n > 0) {
					&vsend("$F: Found $n recipients in $f file, to be handled later.") if $V>2;
					push @rcpts, @r;
					$listnames{$x} = $f;	# Note that this is a list
				} else {
					&vsend("$F: Found no recipients in $f file.") if $V>2;
				}
				return undef;
			}
		}
		return ('localhost',$x);
	}
	&vsend("$F: Can't make sense of email address \"$x\".") if $V>1;
	return undef;
}

sub vsend {
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -#
# Send a message to the log/verbose output stream, adding a newline. #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -#
	for (@_) {print V $_ . "\n"}
}

sub vwrite {
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Send a message to the log/verbose output stream, with no newline. #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
	local($m);
	for $m (@_) {syswrite V,$m,length($m)}
}