#!/usr/bin/perl
#
#NAME
#  Send - Heuristic Direct Mail Delivery 
#
#SYNOPSIS
#  Send [-options] [file]... [to recipient...] [list mlist...]
#
#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 fields after  it  are  looked  up  in  the
#  /usr/mail/list/  and  $HOME/mail/list/  directories, and if found,
#  they are taken  as  mailing  lists.   Each  line  is  taken  as  a
#  recipient, and each file is mailed to each recipient.
#
#  No other mailer is invoked by this program; the mail  is  sent  by
#  making  a  direct  TCP  connection to port 25 and talking the 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.
#
#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.
#
#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}, "$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 = 'send.pl';		# Will anyone notice?
#
#  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',
		'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'  => 'ecf-guest.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'        => 'John Chambers',
		'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>',
		'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
#
#SEE ALSO
#
#AUTHOR
#  Copyright 1995, 1999, 2000 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).
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #

$| = 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
$hlo   = 'HELO';		# Default greeting
$parsehdrs = 0;			# Whether to read file headers
#proto = getprotobyname('tcp');
$port  = getservbyname('smtp','tcp');
$hdrs  = 0;				# 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
for $a (@ARGV) {
	if ($a =~ s/^[-+]//) {
		&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](.*)/) {
			$subj = $1;
			&vsend("$P: subj=\"$subj\"") if $V>2;
		} else {
			&vsend("$P: Option \"$a\" not recognized, ignored.") if $V>2;
		}
		next;
	}
	&vsend("$P: Arg \"$a\"") if $V>3;
	if ($a eq 'to'  ) {$argis = 'rcpt'; next}
	if ($a eq 'list') {$argis = 'list'; next}
	if ($a eq 'rcpt') {$argis = 'rcpt'; next}
	if ($a eq 'file') {$argis = 'file'; $hdrs = 0; next}
	if ($argis eq 'rcpt') {			# Recipients
		push @rcpts, $a;
		&vsend("$P: rcpts: @rcpts") if $V>2;
		next;
	} elsif ($argis eq 'list') {	# Mailing lists
		push @lists, $a;
		&vsend("$P: lists: @lists") if $V>2;
		next;
	} else {		# Anything else is file name
		push @files, $a;
		&vsend("$P: files: @files") if $V>2;
		next;		# Default to 'file'
	}
}

# 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;
	unless (open(TMP,">$tmpfil")) {
		&vsend("$P: Can't write \"$tmpfil\" ($!)") if $V>0;
		exit $!;
	}
	for (<STDIN>) {print TMP}
	close TMP;
	push @files, $tmpfil;
}

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

unlink $tmpfil if ($tmpfil && $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);
	$errcode = 0;
	$errmsg = '';
	if ($msg) {
		&msend("$msg");
		&vsend("$F: PUT $msg") if $V==2;
	}
response:
	while (1) {
		$rsp = <SCK>;
		$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]+$//;
				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;

	if ($hdrs) {
		print  V  "To: <$rcpt>\n" if $V>2;
		print  V  "Subject: $subj\n" if $V>2;
		&msend("To: <$rcpt>");
		unless ($date) {$date = &gmdate()}
		if     ($subj) {&msend("Subject: $subj")}
		unless ($from) {&msend("From: $thisnam $sndr")}
		if     ($date) {&msend("Date: $date")}
		if     ($rpto) {&msend("Reply-to: $rpto")}
		if     ($myid) {&msend("User-Agent: $myid")}
		print V "$F: MSG " if $V==2;
	}
	while ($l = <MSG>) {
		next if $hdrs && ($l =~ /^Bcc:/i);
		$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;
	&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\r\n";
		&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]+$//;
			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 \"$1\"") if $V>2;
				$date = "$2 <$3>";
			} 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;
}

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

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];
	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);
}