#!/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.
#
#  -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 = 0;				# Whether to read .signature file
	$sigfile = $ENV{'HOME'} . '/.signature';
#
#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
#
#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 = (
	);
#
#  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
	);
#
#  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
	);
	$hostid = '';	# 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
	);
	$fullnm = '';	# 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
	);
#
#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;
#
# Other things that we get from the environment:
	if ($relayhost = $ENV{'EMAIL_RELAY'}) {push @relay, $relayhost}
#
#  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
($P = $0) =~ s".*/"";			# Our program name, minus any directory
&Vinit($ENV{"V_$P"}||2);		# Our verbose level, defaults to 1 or 2

$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";
}

$HTTPtimeout = 15;		# Timeout for connects

$argis = 'msg';			# How to interpret args
$CRLF  = "\r\n";		# RFC 822 line terminator
$hlo   = 'HELO';		# Default greeting
$parsehdrs = 0;			# Whether to read file headers
#proto = getprotobyname('tcp');
$port  = getservbyname('smtp','tcp');
$hdrs  = 1;				# Whether to generate email headers
$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 =~ /^[Tt]/) {
			push @opts, '-t';
			&vsend("$P: opts=(@opts)") if $V>2;
		} elsif ($a =~ /^[Ss](.*)/) {
			if ($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 $!;
	}
	for (<STDIN>) {print TMP}
	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>2;
		&mail($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 SendAlarm {
	my $t = time - $HTTPcontime;
	&vsend("SendAlarm: ALARM after $t sec.") if $V>1;
	$errmsg = 'timeout';
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Send one mail file to one recipient.
sub mail {
	local($file,$rcpt) = @_;
	local($nam,$rly,$sys,$who);
	local($F) = "$P/mail";
	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>2;
	unless (($sys,$who,$nam) = &parsercpt($rcpt)) {
		&vsend("$F: Can't send to recipient \"$rcpt\"\n") if $V>1;
		return undef;
	}
	return undef unless $who && $sys;
	unless (open(MSG,$file)) {
		&vsend("$F: ### Can't read \"$file\"");
		return undef;
	}
	&vsend("$F: <<< \"$file\" to \"$who\" at \"$sys\" ($nam)") if $V>1;
	print LOG "$F: \"$file\" to \"$who\" at \"$sys\" ($nam)\n" if $V>1;
	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;
		print LOG (&isodate() . " Send \"$file\" to \"$who\" at \"$sys\" ($nam) FAILED.\n");
	}
	&vsend("$F: Failed for all hosts. ") if $V>2;
	print LOG (&isodate() . " Send \"$file\" FAILED for all hosts.\n");
	return 0;
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# 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.

sub msgrsp {
	local($msg) = join('',@_);
	local($rsp,$t0,$t);
	$errcode = 0;
	$errmsg = '';
	if ($msg) {
		&msend("$msg");
		&vsend("$F: PUT $msg") if $V==2;
	}
response:
	while (1) {
		$t0 = time;
		$rsp = <SCK>;
		&vsend("$F: --- $t-sec delay.\n") if (($t = time - $t0) > 1);
		$rsp =~ s/[\s\r]+$//;
		&vsend("$F: GOT $rsp") if $V>1;
		if ($rsp =~ /\bESMTP\b/) {
			$hlo = 'EHLO';	# Kludge for servers that speak ESMTP
			&vsend("$F: ==> Switching 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 connects {
	local($thathst, $port) = @_;
	local($tail,$try,$t);
	&vwrite("$F: ==> Connect to $thathst:$port ... ") if $V>1;
	$t = time;
	if (&HTTPcon(*SCK,$try="$thathst:$port")) {$t = time - $t;
		&vwrite("connected in $t sec.\n");
		return $try;
	}
	&vwrite("failed ($!)\n") if $V>1;
	&vwrite("$F: --> connect to mail.$thathst:$port ...") if $V>1;
	$t = time;
	if (&HTTPcon(*SCK,$try="mail.$thathst:$port")) {
		$t = time - $t;
		&vwrite("connected in $t sec.\n");
		return $try;
	}
	&vwrite("failed ($!)\n") if $V>1;
	if ($tryalt) {
		$tail = $thathst;
		while ($tail =~ /^([^.]*)\.(.*)\.(.*)/) {
			$tail = "$2.$3";
			&vwrite("$F: --> connect to $tail:$port ...") if $V>1;
			$t = time;
			if (&HTTPcon(*SCK,$try="$tail:$port")) {
				$t = time - $t;
				&vwrite("connected in $t sec.\n");
				return $try;
			}
			&vwrite("failed ($!)\n") if $V>1;
			&vwrite("$F: --> connect to mail.$tail:$port ...") if $V>1;
			$t = time;
			if (&HTTPcon(*SCK,$try="mail.$tail:$port")) {
				$t = time - $t;
				&vwrite("connected in $t sec.\n");
				return $try;
			}
			&vwrite("failed ($!)\n") if $V>1;
		}
	}
	&vsend("$F: Can't find mail server for \"$thathst\"") if $V>1;
	return undef;	# Failure
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# 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.

sub msg {
	local($thathst,$thatusr,$thatnm) = @_;
	local($thishst,$thisusr,$symnam,$rcpt,$mchars,$mlines,$orighst,$sndr);
	local($hostport,$isots,@mx,$mxcmd,@nslookup,$mxhost,$tralt);
	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 |")) {
			for (<MX>) {
				chomp;	#s/[\r\s]+$//;
				# foo.com mail is handled (pri=1) by mta1.grp.scd.yahoo.com
				if (/ is handled \(*pri=(\d+)\)* by (.*)/) {	# Format on FreeBSD
					&vsend("$F: --> MX $thathst => $2.") if $V>1;
					push @mx, $2;
				} elsif (/ is handled by (\d+) (.*)/) {	# Format on RH 8.0 linux
					&vsend("$F: --> MX $thathst => $2.") if $V>1;
					push @mx, $2;
				}
			}
			close MX;
		}
	}
	if (!@mx && $usenslookupcmd) {
		$mxcmd = "nslookup -querytype=mx $thathst";
		&vsend("$F: cmd: $mxcmd") if $V>1;
		if (open(MX,"$mxcmd |")) {
			for (<MX>) {
				if (/preference = (\d+), mail exchanger = (.*)\s*$/) {
					&vsend("$F: --> MX $thathst => $2.") if $V>1;
					push @mx, $2;
				}
			}
			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;
	$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 = "<$thisusr\@$thishst>";
	if ($thatusr =~ /\@/) {
		$rcpt = "$thatusr";
	} else {
		$rcpt = "$thatusr\@$orighst";
	}
	if ($adrmap{$rcpt}) {
		$sndr = $rpto = $adrmap{$rcpt};
		&vsend("$F: Pretend 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;
	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>");
		&msend("X-Sent-To: <$rcpt>");
		unless($date) {$date = &gmdate()}
		if    ($subj) {&msend("Subject: $subj")}
		unless($from) {&msend("From: $thisnam $sndr"); &msend("X-Sent-From: $thisnam $sndr")}
		if    ($date) {&msend("Date: $date")}
		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;	# 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(".");
	&vsend("$F: PUT . (sent $mlines lines $mchars chars)") if $V==2;
	chomp($rsp = <SCK>);
	&vsend("$F: GOT $rsp") if $V>1;
	print LOG (&isodate() . " Sent \"$file\" to \"$who\" at \"$sys\" ($nam)\n");
	return 1;
}

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

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

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Send one or more messages to the mail output socket, with added newlines. #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
sub msend {
	local($m,$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 (@_) {
		print SCK "$m$CRLF";
		&vsend("$F: PUT $m") if $V>2;
		$mchars += length($m);
		$mlines ++;
	}
	alarm 0;
	$SIG{ALRM} = $savsig;
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# 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.           #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
sub parsehdrs {
	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\" ($!)\n") if $V>0;
			next;
		}
line:	for $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*(.*)<(.*)>$/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) { 
				for $r (split(/\s*,\s*/,$2)) {
					$r =~ s/^\s*(.*?)\s*$/$1/;
					&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;
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# 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.
#
sub parselist {
	local($f) = @_;
	local($r,@r);
	local($F) = "$P/parselist";
	unless (open(LST,"<$f")) {
		print STDERR "Can't read \"$f\"\n";
		next list;
	}
	for $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;
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# 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.
sub parsercpt {
	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>2;
		if (-f ($f = "$homedir/mail/list/$x")) {
			&vsend("$F: Found $f file.") if $V>2;
			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;
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# 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.

sub Vinit {
	local($opt) = @_;
	($V,$Vfil) = ($opt =~ /^(\d*)(.*)/);
	$V = 1 if !$V;
	if ($Vfil) {
		unless (open(V,">$Vfil")) {
			print STDERR "$P: Can't write \"$Vfil\" ($!)\n";
			open(V,">&STDERR");
			$Vfil = 'STDERR';
		}
	} else {
		open(V,">&STDERR");
		$Vfil = 'STDERR';
	}
	select V; $| = 1; select STDOUT;
	&vsend("$P: V=$V \"$Vfil\"") if $V>3;
	&vsend("\n$P " . join(' ',@ARGV)) if $V>1;
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# 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.                                             #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
sub gmdate {
	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 UTC",$Day,$mday,$Mon,1900+$year,$hour,$min,$sec);
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #

sub isodate {
	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 UTC",1900+$year,1+$mon,$mday,$hour,$min,$sec);
}