13299490peter#!/usr/bin/perl
23299490peter'di ';
33299490peter'ds 00 \\"';
43299490peter'ig 00 ';
53299490peter#
63299490peter#       THIS PROGRAM IS ITS OWN MANUAL PAGE.  INSTALL IN man & bin.
73299490peter#
83299490peter
93299490peteruse 5.001;
103299490peteruse IO::Socket;
1196b960fgshapirouse Fcntl;
123299490peter
133299490peter# system requirements:
143299490peter# 	must have 'nslookup' and 'hostname' programs.
153299490peter
164332139gshapiro# $OrigHeader: /home/muir/bin/RCS/expn,v 3.11 1997/09/10 08:14:02 muir Exp muir $
173299490peter
183299490peter# TODO:
193299490peter#	less magic should apply to command-line addresses
203299490peter#	less magic should apply to local addresses
213299490peter#	add magic to deal with cross-domain cnames
223299490peter#	disconnect & reconnect after 25 commands to the same sendmail 8.8.* host
233299490peter
243299490peter# Checklist: (hard addresses)
253299490peter#	250 Kimmo Suominen <"|/usr/local/mh/lib/slocal -user kim"@grendel.tac.nyc.ny.us>
263299490peter#	harry@hofmann.cs.Berkeley.EDU -> harry@tenet (.berkeley.edu)  [dead]
273299490peter#	bks@cs.berkeley.edu -> shiva.CS (.berkeley.edu)		      [dead]
283299490peter#	dan@tc.cornell.edu -> brown@tiberius (.tc.cornell.edu)
293299490peter
303299490peter#############################################################################
313299490peter#
323299490peter#  Copyright (c) 1993 David Muir Sharnoff
333299490peter#  All rights reserved.
343299490peter#
353299490peter#  Redistribution and use in source and binary forms, with or without
363299490peter#  modification, are permitted provided that the following conditions
373299490peter#  are met:
383299490peter#  1. Redistributions of source code must retain the above copyright
393299490peter#     notice, this list of conditions and the following disclaimer.
403299490peter#  2. Redistributions in binary form must reproduce the above copyright
413299490peter#     notice, this list of conditions and the following disclaimer in the
423299490peter#     documentation and/or other materials provided with the distribution.
433299490peter#  3. All advertising materials mentioning features or use of this software
443299490peter#     must display the following acknowledgement:
453299490peter#       This product includes software developed by the David Muir Sharnoff.
463299490peter#  4. The name of David Sharnoff may not be used to endorse or promote products
473299490peter#     derived from this software without specific prior written permission.
483299490peter#
493299490peter#  THIS SOFTWARE IS PROVIDED BY THE DAVID MUIR SHARNOFF ``AS IS'' AND
503299490peter#  ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
513299490peter#  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
523299490peter#  ARE DISCLAIMED.  IN NO EVENT SHALL DAVID MUIR SHARNOFF BE LIABLE
533299490peter#  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
543299490peter#  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
553299490peter#  OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
563299490peter#  HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
573299490peter#  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
583299490peter#  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
593299490peter#  SUCH DAMAGE.
603299490peter#
613299490peter# This copyright notice derrived from material copyrighted by the Regents
623299490peter# of the University of California.
633299490peter#
643299490peter# Contributions accepted.
653299490peter#
663299490peter#############################################################################
673299490peter
683299490peter# overall structure:
693299490peter#	in an effort to not trace each address individually, but rather
703299490peter#	ask each server in turn a whole bunch of questions, addresses to
713299490peter#	be expanded are queued up.
723299490peter#
733299490peter#	This means that all accounting w.r.t. an address must be stored in
743299490peter#	various arrays.  Generally these arrays are indexed by the
753299490peter#	string "$addr *** $server" where $addr is the address to be
763299490peter#	expanded "foo" or maybe "foo@bar" and $server is the hostname
773299490peter#	of the SMTP server to contact.
783299490peter#
793299490peter
803299490peter# important global variables:
813299490peter#
823299490peter# @hosts : list of servers still to be contacted
833299490peter# $server : name of the current we are currently looking at
843299490peter# @users = $users{@hosts[0]} : addresses to expand at this server
853299490peter# $u = $users[0] : the current address being expanded
863299490peter# $names{"$users[0] *** $server"} : the 'name' associated with the address
873299490peter# $mxbacktrace{"$users[0] *** $server"} : record of mx expansion
883299490peter# $mx_secondary{$server} : other mx relays at the same priority
893299490peter# $domainify_fallback{"$users[0] *** $server"} : alternative names to try
903299490peter#	instead of $server if $server doesn't work
913299490peter# $temporary_redirect{"$users[0] *** $server"} : when trying alternates,
923299490peter#	temporarily channel all tries along current path
933299490peter# $giveup{$server} : do not bother expanding addresses at $server
943299490peter# $verbose : -v
953299490peter# $watch : -w
963299490peter# $vw : -v or -w
973299490peter# $debug : -d
983299490peter# $valid : -a
993299490peter# $levels : -1
1003299490peter# $S : the socket connection to $server
1013299490peter
1023299490peter$have_nslookup = 1;	# we have the nslookup program
1033299490peter$port = 'smtp';
1043299490peter$av0 = $0;
1053299490peter$ENV{'PATH'} .= ":/usr/etc" unless $ENV{'PATH'} =~ m,/usr/etc,;
1063299490peter$ENV{'PATH'} .= ":/usr/ucb" unless $ENV{'PATH'} =~ m,/usr/ucb,;
1073299490peterselect(STDERR);
1083299490peter
1093299490peter$0 = "$av0 - running hostname";
1103299490peterchop($name = `hostname || uname -n`);
1113299490peter
1123299490peter$0 = "$av0 - lookup host FQDN and IP addr";
1133299490peter($hostname,$aliases,$type,$len,$thisaddr) = gethostbyname($name);
1143299490peter
1153299490peter$0 = "$av0 - parsing args";
1163299490peter$usage = "Usage: $av0 [-1avwd] user[\@host] [user2[host2] ...]";
1173299490peterfor $a (@ARGV) {
1183299490peter	die $usage if $a eq "-";
1193299490peter	while ($a =~ s/^(-.*)([1avwd])/$1/) {
1203299490peter		eval '$'."flag_$2 += 1";
1213299490peter	}
1223299490peter	next if $a eq "-";
1233299490peter	die $usage if $a =~ /^-/;
1243299490peter	&expn(&parse($a,$hostname,undef,1));
1253299490peter}
1263299490peter$verbose = $flag_v;
1273299490peter$watch = $flag_w;
1283299490peter$vw = $flag_v + $flag_w;
1293299490peter$debug = $flag_d;
1303299490peter$valid = $flag_a;
1313299490peter$levels = $flag_1;
1323299490peter
1333299490peterdie $usage unless @hosts;
1343299490peterif ($valid) {
1353299490peter	if ($valid == 1) {
1363299490peter		$validRequirement = 0.8;
1373299490peter	} elsif ($valid == 2) {
1383299490peter		$validRequirement = 1.0;
1393299490peter	} elsif ($valid == 3) {
1403299490peter		$validRequirement = 0.9;
1413299490peter	} else {
1423299490peter		$validRequirement = (1 - (1/($valid-3)));
1433299490peter		print "validRequirement = $validRequirement\n" if $debug;
1443299490peter	}
1453299490peter}
1463299490peter
1473299490peterHOST:
1483299490peterwhile (@hosts) {
1493299490peter	$server = shift(@hosts);
1503299490peter	@users = split(' ',$users{$server});
1513299490peter	delete $users{$server};
1523299490peter
1533299490peter	# is this server already known to be bad?
1543299490peter	$0 = "$av0 - looking up $server";
1553299490peter	if ($giveup{$server}) {
1563299490peter		&giveup('mx domainify',$giveup{$server});
1573299490peter		next;
1583299490peter	}
1593299490peter
1603299490peter	# do we already have an mx record for this host?
1613299490peter	next HOST if &mxredirect($server,*users);
1623299490peter
1633299490peter	# look it up, or try for an mx.
1643299490peter	$0 = "$av0 - gethostbyname($server)";
1653299490peter
1663299490peter	($name,$aliases,$type,$len,$thataddr) = gethostbyname($server);
1673299490peter	# if we can't get an A record, try for an MX record.
1683299490peter	unless($thataddr) {
1693299490peter		&mxlookup(1,$server,"$server: could not resolve name",*users);
1703299490peter		next HOST;
1713299490peter	}
1723299490peter
1733299490peter	# get a connection, or look for an mx
1743299490peter	$0 = "$av0 - socket to $server";
1753299490peter
1763299490peter	$S = new IO::Socket::INET (
1773299490peter		'PeerAddr' => $server,
1783299490peter		'PeerPort' => $port,
1793299490peter		'Proto' => 'tcp');
1803299490peter
1813299490peter	if (! $S || ($debug == 10 && $server =~ /relay\d.UU.NET$/i)) {
1823299490peter		$0 = "$av0 - $server: could not connect: $!\n";
1833299490peter		$emsg = $!;
1843299490peter		unless (&mxlookup(0,$server,"$server: could not connect: $!",*users)) {
1853299490peter			&giveup('mx',"$server: Could not connect: $emsg");
1863299490peter		}
1873299490peter		next HOST;
1883299490peter	}
1893299490peter	$S->autoflush(1);
1903299490peter
1913299490peter	# read the greeting
1923299490peter	$0 = "$av0 - talking to $server";
1933299490peter	&alarm("greeting with $server",'');
1943299490peter	while(<$S>) {
1953299490peter		alarm(0);
1963299490peter		print if $watch;
1973299490peter		if (/^(\d+)([- ])/) {
1983299490peter			if ($1 != 220) {
1993299490peter				$0 = "$av0 - bad numeric response from $server";
2003299490peter				&alarm("giving up after bad response from $server",'');
2013299490peter				&read_response($2,$watch);
2023299490peter				alarm(0);
2033299490peter				print STDERR "$server: NOT 220 greeting: $_"
2043299490peter					if ($debug || $vw);
2053299490peter				if (&mxlookup(0,$server,"$server: did not respond with a 220 greeting",*users)) {
2063299490peter					close($S);
2073299490peter					next HOST;
2083299490peter				}
2093299490peter			}
2103299490peter			last if ($2 eq " ");
2113299490peter		} else {
2123299490peter			$0 = "$av0 - bad response from $server";
2133299490peter			print STDERR "$server: NOT 220 greeting: $_"
2143299490peter				if ($debug || $vw);
2153299490peter			unless (&mxlookup(0,$server,"$server: did not respond with SMTP codes",*users)) {
2163299490peter				&giveup('',"$server: did not talk SMTP");
2173299490peter			}
2183299490peter			close($S);
2193299490peter			next HOST;
2203299490peter		}
2213299490peter		&alarm("greeting with $server",'');
2223299490peter	}
2233299490peter	alarm(0);
2243299490peter
2253299490peter	# if this causes problems, remove it
2263299490peter	$0 = "$av0 - sending helo to $server";
2273299490peter	&alarm("sending helo to $server","");
2283299490peter	&ps("helo $hostname");
2293299490peter	while(<$S>) {
2303299490peter		print if $watch;
2313299490peter		last if /^\d+ /;
2323299490peter	}
2333299490peter	alarm(0);
2343299490peter
2353299490peter	# try the users, one by one
2363299490peter	USER:
2373299490peter	while(@users) {
2383299490peter		$u = shift(@users);
2393299490peter		$0 = "$av0 - expanding $u [\@$server]";
2403299490peter
2413299490peter		# do we already have a name for this user?
2423299490peter		$oldname = $names{"$u *** $server"};
2433299490peter
2443299490peter		print &compact($u,$server)." ->\n" if ($verbose && ! $valid);
2453299490peter		if ($valid) {
2463299490peter			#
2473299490peter			# when running with -a, we delay taking any action
2483299490peter			# on the results of our query until we have looked
2493299490peter			# at the complete output.  @toFinal stores expansions
2503299490peter			# that will be final if we take them.  @toExpn stores
2513299490peter			# expnansions that are not final.  @isValid keeps
2523299490peter			# track of our ability to send mail to each of the
2533299490peter			# expansions.
2543299490peter			#
2553299490peter			@isValid = ();
2563299490peter			@toFinal = ();
2573299490peter			@toExpn = ();
2583299490peter		}
2593299490peter
2603299490peter#		($ecode,@expansion) = &expn_vrfy($u,$server);
2613299490peter		(@foo) = &expn_vrfy($u,$server);
2623299490peter		($ecode,@expansion) = @foo;
2633299490peter		if ($ecode) {
2643299490peter			&giveup('',$ecode,$u);
2653299490peter			last USER;
2663299490peter		}
2673299490peter
2683299490peter		for $s (@expansion) {
2693299490peter			$s =~ s/[\n\r]//g;
2703299490peter			$0 = "$av0 - parsing $server: $s";
2713299490peter
2723299490peter			$skipwatch = $watch;
2733299490peter
2743299490peter			if ($s =~ /^[25]51([- ]).*<(.+)>/) {
2753299490peter				print "$s" if $watch;
2763299490peter				print "(pretending 250$1<$2>)" if ($debug && $watch);
2773299490peter				print "\n" if $watch;
2783299490peter				$s = "250$1<$2>";
2793299490peter				$skipwatch = 0;
2803299490peter			}
2813299490peter
2823299490peter			if ($s =~ /^250([- ])(.+)/) {
2833299490peter				print "$s\n" if $skipwatch;
2843299490peter				($done,$addr) = ($1,$2);
2853299490peter				($newhost, $newaddr, $newname) =  &parse($addr,$server,$oldname, $#expansion == 0);
2863299490peter				print "($newhost, $newaddr, $newname) = &parse($addr, $server, $oldname)\n" if $debug;
2873299490peter				if (! $newhost) {
2883299490peter					# no expansion is possible w/o a new server to call
2893299490peter					if ($valid) {
2903299490peter						push(@isValid, &validAddr($newaddr));
2913299490peter						push(@toFinal,$newaddr,$server,$newname);
2923299490peter					} else {
2933299490peter						&verbose(&final($newaddr,$server,$newname));
2943299490peter					}
2953299490peter				} else {
2963299490peter					$newmxhost = &mx($newhost,$newaddr);
2973299490peter					print "$newmxhost = &mx($newhost)\n"
2983299490peter						if ($debug && $newhost ne $newmxhost);
2993299490peter					$0 = "$av0 - parsing $newaddr [@$newmxhost]";
3003299490peter					print "levels = $levels, level{$u *** $server} = ".$level{"$u *** $server"}."\n" if ($debug > 1);
3013299490peter					# If the new server is the current one,
3023299490peter					# it would have expanded things for us
3033299490peter					# if it could have.  Mx records must be
3043299490peter					# followed to compare server names.
3053299490peter					# We are also done if the recursion
3063299490peter					# count has been exceeded.
3073299490peter					if (&trhost($newmxhost) eq &trhost($server) || ($levels && $level{"$u *** $server"} >= $levels)) {
3083299490peter						if ($valid) {
3093299490peter							push(@isValid, &validAddr($newaddr));
3103299490peter							push(@toFinal,$newaddr,$newmxhost,$newname);
3113299490peter						} else {
3123299490peter							&verbose(&final($newaddr,$newmxhost,$newname));
3133299490peter						}
3143299490peter					} else {
3153299490peter						# more work to do...
3163299490peter						if ($valid) {
3173299490peter							push(@isValid, &validAddr($newaddr));
3183299490peter							push(@toExpn,$newmxhost,$newaddr,$newname,$level{"$u *** $server"});
3193299490peter						} else {
3203299490peter							&verbose(&expn($newmxhost,$newaddr,$newname,$level{"$u *** $server"}));
3213299490peter						}
3223299490peter					}
3233299490peter				}
3243299490peter				last if ($done eq " ");
3253299490peter				next;
3263299490peter			}
3273299490peter			# 550 is a known code...  Should the be
3283299490peter			# included in -a output?  Might be a bug
3293299490peter			# here.  Does it matter?  Can assume that
3303299490peter			# there won't be UNKNOWN USER responses
3313299490peter			# mixed with valid users?
3323299490peter			if ($s =~ /^(550)([- ])/) {
3333299490peter				if ($valid) {
3343299490peter					print STDERR "\@$server:$u ($oldname) USER UNKNOWN\n";
3353299490peter				} else {
3363299490peter					&verbose(&final($u,$server,$oldname,"USER UNKNOWN"));
3373299490peter				}
3383299490peter				last if ($2 eq " ");
3393299490peter				next;
3403299490peter			}
3413299490peter			# 553 is a known code...
3423299490peter			if ($s =~ /^(553)([- ])/) {
3433299490peter				if ($valid) {
3443299490peter					print STDERR "\@$server:$u ($oldname) USER AMBIGUOUS\n";
3453299490peter				} else {
3463299490peter					&verbose(&final($u,$server,$oldname,"USER AMBIGUOUS"));
3473299490peter				}
3483299490peter				last if ($2 eq " ");
3493299490peter				next;
3503299490peter			}
3513299490peter			# 252 is a known code...
3523299490peter			if ($s =~ /^(252)([- ])/) {
3533299490peter				if ($valid) {
3543299490peter					print STDERR "\@$server:$u ($oldname) REFUSED TO VRFY\n";
3553299490peter				} else {
3563299490peter					&verbose(&final($u,$server,$oldname,"REFUSED TO VRFY"));
3573299490peter				}
3583299490peter				last if ($2 eq " ");
3593299490peter				next;
3603299490peter			}
3613299490peter			&giveup('',"$server: did not grok '$s'",$u);
3623299490peter			last USER;
3633299490peter		}
3643299490peter
3653299490peter		if ($valid) {
3663299490peter			#
3673299490peter			# now we decide if we are going to take these
3683299490peter			# expansions or roll them back.
3693299490peter			#
3703299490peter			$avgValid = &average(@isValid);
3713299490peter			print "avgValid = $avgValid\n" if $debug;
3723299490peter			if ($avgValid >= $validRequirement) {
3733299490peter				print &compact($u,$server)." ->\n" if $verbose;
3743299490peter				while (@toExpn) {
3753299490peter					&verbose(&expn(splice(@toExpn,0,4)));
3763299490peter				}
3773299490peter				while (@toFinal) {
3783299490peter					&verbose(&final(splice(@toFinal,0,3)));
3793299490peter				}
3803299490peter			} else {
3813299490peter				print "Tossing some valid to avoid invalid ".&compact($u,$server)."\n" if ($avgValid > 0.0 && ($vw || $debug));
3823299490peter				print &compact($u,$server)." ->\n" if $verbose;
3833299490peter				&verbose(&final($u,$server,$newname));
3843299490peter			}
3853299490peter		}
3863299490peter	}
3873299490peter
3883299490peter	&alarm("sending 'quit' to $server",'');
3893299490peter	$0 = "$av0 - sending 'quit' to $server";
3903299490peter	&ps("quit");
3913299490peter	while(<$S>) {
3923299490peter		print if $watch;
3933299490peter		last if /^\d+ /;
3943299490peter	}
3953299490peter	close($S);
3963299490peter	alarm(0);
3973299490peter}
3983299490peter
3993299490peter$0 = "$av0 - printing final results";
4003299490peterprint "----------\n" if $vw;
4013299490peterselect(STDOUT);
4023299490peterfor $f (sort @final) {
4033299490peter	print "$f\n";
4043299490peter}
4053299490peterunlink("/tmp/expn$$");
4063299490peterexit(0);
4073299490peter
4083299490peter
4093299490peter# abandon all attempts deliver to $server
4103299490peter# register the current addresses as the final ones
4113299490petersub giveup
4123299490peter{
4133299490peter	local($redirect_okay,$reason,$user) = @_;
4143299490peter	local($us,@so,$nh,@remaining_users);
4153299490peter	local($pk,$file,$line);
4163299490peter	($pk, $file, $line) = caller;
4173299490peter
4183299490peter	$0 = "$av0 - giving up on $server: $reason";
4193299490peter	#
4203299490peter	# add back a user if we gave up in the middle
4213299490peter	#
4223299490peter	push(@users,$user) if $user;
4233299490peter	#
4243299490peter	# don't bother with this system anymore
4253299490peter	#
4263299490peter	unless ($giveup{$server}) {
4273299490peter		$giveup{$server} = $reason;
4283299490peter		print STDERR "$reason\n";
4293299490peter	}
4303299490peter	print "Giveup at $file:$line!!! redirect okay = $redirect_okay; $reason\n" if $debug;
4313299490peter	#
4323299490peter	# Wait!
4333299490peter	# Before giving up, see if there is a chance that
4343299490peter	# there is another host to redirect to!
4353299490peter	# (Kids, don't do this at home!  Hacking is a dangerous
4363299490peter	# crime and you could end up behind bars.)
4373299490peter	#
4383299490peter	for $u (@users) {
4393299490peter		if ($redirect_okay =~ /\bmx\b/) {
4403299490peter			next if &try_fallback('mx',$u,*server,
4413299490peter				*mx_secondary,
4423299490peter				*already_mx_fellback);
4433299490peter		}
4443299490peter		if ($redirect_okay =~ /\bdomainify\b/) {
4453299490peter			next if &try_fallback('domainify',$u,*server,
4463299490peter				*domainify_fallback,
4473299490peter				*already_domainify_fellback);
4483299490peter		}
4493299490peter		push(@remaining_users,$u);
4503299490peter	}
4513299490peter	@users = @remaining_users;
4523299490peter	for $u (@users) {
4533299490peter		print &compact($u,$server)." ->\n" if ($verbose && $valid && $u);
4543299490peter		&verbose(&final($u,$server,$names{"$u *** $server"},$reason));
4553299490peter	}
4563299490peter}
4573299490peter#
4583299490peter# This routine is used only within &giveup.  It checks to
4593299490peter# see if we really have to giveup or if there is a second
4603299490peter# chance because we did something before that can be
4613299490peter# backtracked.
4623299490peter#
4633299490peter# %fallback{"$user *** $host"} tracks what is able to fallback
4643299490peter# %fellback{"$user *** $host"} tracks what has fallen back
4653299490peter#
4663299490peter# If there is a valid backtrack, then queue up the new possibility
4673299490peter#
4683299490petersub try_fallback
4693299490peter{
4703299490peter	local($method,$user,*host,*fall_table,*fellback) = @_;
4713299490peter	local($us,$fallhost,$oldhost,$ft,$i);
4723299490peter
4733299490peter	if ($debug > 8) {
4743299490peter		print "Fallback table $method:\n";
4753299490peter		for $i (sort keys %fall_table) {
4763299490peter			print "\t'$i'\t\t'$fall_table{$i}'\n";
4773299490peter		}
4783299490peter		print "Fellback table $method:\n";
4793299490peter		for $i (sort keys %fellback) {
4803299490peter			print "\t'$i'\t\t'$fellback{$i}'\n";
4813299490peter		}
4823299490peter		print "U: $user H: $host\n";
4833299490peter	}
4843299490peter
4853299490peter	$us = "$user *** $host";
4863299490peter	if (defined $fellback{$us}) {
4873299490peter		#
4883299490peter		# Undo a previous fallback so that we can try again
4893299490peter		# Nested fallbacks are avoided because they could
4903299490peter		# lead to infinite loops
4913299490peter		#
4923299490peter		$fallhost = $fellback{$us};
4933299490peter		print "Already $method fell back from $us -> \n" if $debug;
4943299490peter		$us = "$user *** $fallhost";
4953299490peter		$oldhost = $fallhost;
4963299490peter	} elsif (($method eq 'mx') && (defined $mxbacktrace{$us}) && (defined $mx_secondary{$mxbacktrace{$us}})) {
4973299490peter		print "Fallback an MX expansion $us -> \n" if $debug;
4983299490peter		$oldhost = $mxbacktrace{$us};
4993299490peter	} else {
5003299490peter		print "Oldhost($host, $us) = " if $debug;
5013299490peter		$oldhost = $host;
5023299490peter	}
5033299490peter	print "$oldhost\n" if $debug;
5043299490peter	if (((defined $fall_table{$us}) && ($ft = $us)) || ((defined $fall_table{$oldhost}) && ($ft = $oldhost))) {
5053299490peter		print "$method Fallback = ".$fall_table{$ft}."\n" if $debug;
5063299490peter		local(@so,$newhost);
5073299490peter		@so = split(' ',$fall_table{$ft});
5083299490peter		$newhost = shift(@so);
5093299490peter		print "Falling back ($method) $us -> $newhost (from $oldhost)\n" if $debug;
5103299490peter		if ($method eq 'mx') {
5113299490peter			if (! defined ($mxbacktrace{"$user *** $newhost"})) {
5123299490peter				if (defined $mxbacktrace{"$user *** $oldhost"}) {
5133299490peter					print "resetting oldhost $oldhost to the original: " if $debug;
5143299490peter					$oldhost = $mxbacktrace{"$user *** $oldhost"};
5153299490peter					print "$oldhost\n" if $debug;
5163299490peter				}
5173299490peter				$mxbacktrace{"$user *** $newhost"} = $oldhost;
5183299490peter				print "mxbacktrace $user *** $newhost -> $oldhost\n" if $debug;
5193299490peter			}
5203299490peter			$mx{&trhost($oldhost)} = $newhost;
5213299490peter		} else {
5223299490peter			$temporary_redirect{$us} = $newhost;
5233299490peter		}
5243299490peter		if (@so) {
5253299490peter			print "Can still $method  $us: @so\n" if $debug;
5263299490peter			$fall_table{$ft} = join(' ',@so);
5273299490peter		} else {
5283299490peter			print "No more fallbacks for $us\n" if $debug;
5293299490peter			delete $fall_table{$ft};
5303299490peter		}
5313299490peter		if (defined $create_host_backtrack{$us}) {
5323299490peter			$create_host_backtrack{"$user *** $newhost"}
5333299490peter				= $create_host_backtrack{$us};
5343299490peter		}
5353299490peter		$fellback{"$user *** $newhost"} = $oldhost;
5363299490peter		&expn($newhost,$user,$names{$us},$level{$us});
5373299490peter		return 1;
5383299490peter	}
5393299490peter	delete $temporary_redirect{$us};
5403299490peter	$host = $oldhost;
5413299490peter	return 0;
5423299490peter}
5433299490peter# return 1 if you could send mail to the address as is.
5443299490petersub validAddr
5453299490peter{
5463299490peter	local($addr) = @_;
5473299490peter	$res = &do_validAddr($addr);
5483299490peter	print "validAddr($addr) = $res\n" if $debug;
5493299490peter	$res;
5503299490peter}
5513299490petersub do_validAddr
5523299490peter{
5533299490peter	local($addr) = @_;
5543299490peter	local($urx) = "[-A-Za-z_.0-9+]+";
5553299490peter
5563299490peter	# \u
5573299490peter	return 0 if ($addr =~ /^\\/);
5583299490peter	# ?@h
5593299490peter	return 1 if ($addr =~ /.\@$urx$/);
5603299490peter	# @h:?
5613299490peter	return 1 if ($addr =~ /^\@$urx\:./);
5623299490peter	# h!u
5633299490peter	return 1 if ($addr =~ /^$urx!./);
5643299490peter	# u
5653299490peter	return 1 if ($addr =~ /^$urx$/);
5663299490peter	# ?
5673299490peter	print "validAddr($addr) = ???\n" if $debug;
5683299490peter	return 0;
5693299490peter}
5703299490peter# Some systems use expn and vrfy interchangeably.  Some only
5713299490peter# implement one or the other.  Some check expn against mailing
5723299490peter# lists and vrfy against users.  It doesn't appear to be
5733299490peter# consistent.
5743299490peter#
5753299490peter# So, what do we do?  We try everything!
5763299490peter#
5773299490peter#
5783299490peter# Ranking of result codes: good: 250, 251/551, 252, 550, anything else
5793299490peter#
5803299490peter# Ranking of inputs: best: user@host.domain, okay: user
5813299490peter#
5823299490peter# Return value: $error_string, @responses_from_server
5833299490petersub expn_vrfy
5843299490peter{
5853299490peter	local($u,$server) = @_;
5863299490peter	local(@c) = ('expn', 'vrfy');
5873299490peter	local(@try_u) = $u;
5883299490peter	local(@ret,$code);
5893299490peter
5903299490peter	if (($u =~ /(.+)@(.+)/) && (&trhost($2) eq &trhost($server))) {
5913299490peter		push(@try_u,$1);
5923299490peter	}
5933299490peter
5943299490peter	TRY:
5953299490peter	for $c (@c) {
5963299490peter		for $try_u (@try_u) {
5973299490peter			&alarm("${c}'ing $try_u on $server",'',$u);
5983299490peter			&ps("$c $try_u");
5993299490peter			alarm(0);
6003299490peter			$s = <$S>;
6013299490peter			if ($s eq '') {
6023299490peter				return "$server: lost connection";
6033299490peter			}
6043299490peter			if ($s !~ /^(\d+)([- ])/) {
6053299490peter				return "$server: garbled reply to '$c $try_u'";
6063299490peter			}
6073299490peter			if ($1 == 250) {
6083299490peter				$code = 250;
6093299490peter				@ret = ("",$s);
6103299490peter				push(@ret,&read_response($2,$debug));
6113299490peter				return (@ret);
6123299490peter			}
6133299490peter			if ($1 == 551 || $1 == 251) {
6143299490peter				$code = $1;
6153299490peter				@ret = ("",$s);
6163299490peter				push(@ret,&read_response($2,$debug));
6173299490peter				next;
6183299490peter			}
6193299490peter			if ($1 == 252 && ($code == 0 || $code == 550)) {
6203299490peter				$code = 252;
6213299490peter				@ret = ("",$s);
6223299490peter				push(@ret,&read_response($2,$watch));
6233299490peter				next;
6243299490peter			}
6253299490peter			if ($1 == 550 && $code == 0) {
6263299490peter				$code = 550;
6273299490peter				@ret = ("",$s);
6283299490peter				push(@ret,&read_response($2,$watch));
6293299490peter				next;
6303299490peter			}
6313299490peter			&read_response($2,$watch);
6323299490peter		}
6333299490peter	}
6343299490peter	return "$server: expn/vrfy not implemented" unless @ret;
6353299490peter	return @ret;
6363299490peter}
6373299490peter# sometimes the old parse routine (now parse2) didn't
6383299490peter# reject funky addresses.
6393299490petersub parse
6403299490peter{
6413299490peter	local($oldaddr,$server,$oldname,$one_to_one) = @_;
6423299490peter	local($newhost, $newaddr, $newname, $um) =  &parse2($oldaddr,$server,$oldname,$one_to_one);
6433299490peter	if ($newaddr =~ m,^["/],) {
6443299490peter		return (undef, $oldaddr, $newname) if $valid;
6453299490peter		return (undef, $um, $newname);
6463299490peter	}
6473299490peter	return ($newhost, $newaddr, $newname);
6483299490peter}
6493299490peter
6503299490peter# returns ($new_smtp_server,$new_address,$new_name)
6513299490peter# given a response from a SMTP server ($newaddr), the
6523299490peter# current host ($server), the old "name" and a flag that
6533299490peter# indicates if it is being called during the initial
6543299490peter# command line parsing ($parsing_args)
6553299490petersub parse2
6563299490peter{
6573299490peter	local($newaddr,$context_host,$old_name,$parsing_args) = @_;
6583299490peter	local(@names) = $old_name;
6593299490peter	local($urx) = "[-A-Za-z_.0-9+]+";
6603299490peter	local($unmangle);
6613299490peter
6623299490peter	#
6633299490peter	# first, separate out the address part.
6643299490peter	#
6653299490peter
6663299490peter	#
6673299490peter	# [NAME] <ADDR [(NAME)]>
6683299490peter	# [NAME] <[(NAME)] ADDR
6693299490peter	# ADDR [(NAME)]
6703299490peter	# (NAME) ADDR
6713299490peter	# [(NAME)] <ADDR>
6723299490peter	#
6733299490peter	if ($newaddr =~ /^\<(.*)\>$/) {
6743299490peter		print "<A:$1>\n" if $debug;
6753299490peter		($newaddr) = &trim($1);
6763299490peter		print "na = $newaddr\n" if $debug;
6773299490peter	}
6783299490peter	if ($newaddr =~ /^([^\<\>]*)\<([^\<\>]*)\>([^\<\>]*)$/) {
6793299490peter		# address has a < > pair in it.
6803299490peter		print "N:$1 <A:$2> N:$3\n" if $debug;
6813299490peter		($newaddr) = &trim($2);
6823299490peter		unshift(@names, &trim($3,$1));
6833299490peter		print "na = $newaddr\n" if $debug;
6843299490peter	}
6853299490peter	if ($newaddr =~ /^([^\(\)]*)\(([^\(\)]*)\)([^\(\)]*)$/) {
6863299490peter		# address has a ( ) pair in it.
6873299490peter		print "A:$1 (N:$2) A:$3\n" if $debug;
6883299490peter		unshift(@names,&trim($2));
6893299490peter		local($f,$l) = (&trim($1),&trim($3));
6903299490peter		if (($f && $l) || !($f || $l)) {
6913299490peter			# address looks like:
6923299490peter			# foo (bar) baz  or (bar)
6933299490peter			# not allowed!
6943299490peter			print STDERR "Could not parse $newaddr\n" if $vw;
6953299490peter			return(undef,$newaddr,&firstname(@names));
6963299490peter		}
6973299490peter		$newaddr = $f if $f;
6983299490peter		$newaddr = $l if $l;
6993299490peter		print "newaddr now = $newaddr\n" if $debug;
7003299490peter	}
7013299490peter	#
7023299490peter	# @foo:bar
7033299490peter	# j%k@l
7043299490peter	# a@b
7053299490peter	# b!a
7063299490peter	# a
7073299490peter	#
7083299490peter	$unmangle = $newaddr;
7093299490peter	if ($newaddr =~ /^\@($urx)\:(.+)$/) {
7103299490peter		print "(\@:)" if $debug;
7113299490peter		# this is a bit of a cheat, but it seems necessary
7123299490peter		return (&domainify($1,$context_host,$2),$2,&firstname(@names),$unmangle);
7133299490peter	}
7143299490peter	if ($newaddr =~ /^(.+)\@($urx)$/) {
7153299490peter		print "(\@)" if $debug;
7163299490peter		return (&domainify($2,$context_host,$newaddr),$newaddr,&firstname(@names),$unmangle);
7173299490peter	}
7183299490peter	if ($parsing_args) {
7193299490peter		if ($newaddr =~ /^($urx)\!(.+)$/) {
7203299490peter			return (&domainify($1,$context_host,$newaddr),$newaddr,&firstname(@names),$unmangle);
7213299490peter		}
7223299490peter		if ($newaddr =~ /^($urx)$/) {
7233299490peter			return ($context_host,$newaddr,&firstname(@names),$unmangle);
7243299490peter		}
7253299490peter		print STDERR "Could not parse $newaddr\n";
7263299490peter	}
7273299490peter	print "(?)" if $debug;
7283299490peter	return(undef,$newaddr,&firstname(@names),$unmangle);
7293299490peter}
7303299490peter# return $u (@$server) unless $u includes reference to $server
7313299490petersub compact
7323299490peter{
7333299490peter	local($u, $server) = @_;
7343299490peter	local($se) = $server;
7353299490peter	local($sp);
7363299490peter	$se =~ s/(\W)/\\$1/g;
7373299490peter	$sp = " (\@$server)";
7383299490peter	if ($u !~ /$se/i) {
7393299490peter		return "$u$sp";
7403299490peter	}
7413299490peter	return $u;
7423299490peter}
7433299490peter# remove empty (spaces don't count) members from an array
7443299490petersub trim
7453299490peter{
7463299490peter	local(@v) = @_;
7473299490peter	local($v,@r);
7483299490peter	for $v (@v) {
7493299490peter		$v =~ s/^\s+//;
7503299490peter		$v =~ s/\s+$//;
7513299490peter		push(@r,$v) if ($v =~ /\S/);
7523299490peter	}
7533299490peter	return(@r);
7543299490peter}
7553299490peter# using the host part of an address, and the server name, add the
7563299490peter# servers' domain to the address if it doesn't already have a
7573299490peter# domain.  Since this sometimes fails, save a back reference so
7583299490peter# it can be unrolled.
7593299490petersub domainify
7603299490peter{
7613299490peter	local($host,$domain_host,$u) = @_;
7623299490peter	local($domain,$newhost);
7633299490peter
7643299490peter	# cut of trailing dots
7653299490peter	$host =~ s/\.$//;
7663299490peter	$domain_host =~ s/\.$//;
7673299490peter
7683299490peter	if ($domain_host !~ /\./) {
7693299490peter		#
7703299490peter		# domain host isn't, keep $host whatever it is
7713299490peter		#
7723299490peter		print "domainify($host,$domain_host) = $host\n" if $debug;
7733299490peter		return $host;
7743299490peter	}
7753299490peter
7763299490peter	#
7773299490peter	# There are several weird situtations that need to be
7783299490peter	# accounted for.  They have to do with domain relay hosts.
7793299490peter	#
7803299490peter	# Examples:
7813299490peter	#	host		server		"right answer"
7823299490peter	#
7833299490peter	#	shiva.cs	cs.berkeley.edu	shiva.cs.berkeley.edu
7843299490peter	#	shiva		cs.berkeley.edu	shiva.cs.berekley.edu
7853299490peter	#	cumulus		reed.edu	@reed.edu:cumulus.uucp
7863299490peter	# 	tiberius	tc.cornell.edu	tiberius.tc.cornell.edu
7873299490peter	#
7883299490peter	# The first try must always be to cut the domain part out of
7893299490peter	# the server and tack it onto the host.
7903299490peter	#
7913299490peter	# A reasonable second try is to tack the whole server part onto
7923299490peter	# the host and for each possible repeated element, eliminate
7933299490peter	# just that part.
7943299490peter	#
7953299490peter	# These extra "guesses" get put into the %domainify_fallback
7963299490peter	# array.  They will be used to give addresses a second chance
7973299490peter	# in the &giveup routine
7983299490peter	#
7993299490peter
8003299490peter	local(%fallback);
8013299490peter
8023299490peter	local($long);
8033299490peter	$long = "$host $domain_host";
8043299490peter	$long =~ tr/A-Z/a-z/;
8053299490peter	print "long = $long\n" if $debug;
8063299490peter	if ($long =~ s/^([^ ]+\.)([^ ]+) \2(\.[^ ]+\.[^ ]+)/$1$2$3/) {
8073299490peter		# matches shiva.cs cs.berkeley.edu and returns shiva.cs.berkeley.edu
8083299490peter		print "condensed fallback $host $domain_host -> $long\n" if $debug;
8093299490peter		$fallback{$long} = 9;
8103299490peter	}
8113299490peter
8123299490peter	local($fh);
8133299490peter	$fh = $domain_host;
8143299490peter	while ($fh =~ /\./) {
8153299490peter		print "FALLBACK $host.$fh = 1\n" if $debug > 7;
8163299490peter		$fallback{"$host.$fh"} = 1;
8173299490peter		$fh =~ s/^[^\.]+\.//;
8183299490peter	}
8193299490peter
8203299490peter	$fallback{"$host.$domain_host"} = 2;
8213299490peter
8223299490peter	($domain = $domain_host) =~ s/^[^\.]+//;
8233299490peter	$fallback{"$host$domain"} = 6
8243299490peter		if ($domain =~ /\./);
8253299490peter
8263299490peter	if ($host =~ /\./) {
8273299490peter		#
8283299490peter		# Host is already okay, but let's look for multiple
8293299490peter		# interpretations
8303299490peter		#
8313299490peter		print "domainify($host,$domain_host) = $host\n" if $debug;
8323299490peter		delete $fallback{$host};
8333299490peter		$domainify_fallback{"$u *** $host"} = join(' ',sort {$fallback{$b} <=> $fallback{$a};} keys %fallback) if %fallback;
8343299490peter		return $host;
8353299490peter	}
8363299490peter
8373299490peter	$domain = ".$domain_host"
8383299490peter		if ($domain !~ /\..*\./);
8393299490peter	$newhost = "$host$domain";
8403299490peter
8413299490peter	$create_host_backtrack{"$u *** $newhost"} = $domain_host;
8423299490peter	print "domainify($host,$domain_host) = $newhost\n" if $debug;
8433299490peter	delete $fallback{$newhost};
8443299490peter	$domainify_fallback{"$u *** $newhost"} = join(' ',sort {$fallback{$b} <=> $fallback{$a};} keys %fallback) if %fallback;
8453299490peter	if ($debug) {
8463299490peter		print "fallback = ";
8473299490peter		print $domainify_fallback{"$u *** $newhost"}
8483299490peter			if defined($domainify_fallback{"$u *** $newhost"});
8493299490peter		print "\n";
8503299490peter	}
8513299490peter	return $newhost;
8523299490peter}
8533299490peter# return the first non-empty element of an array
8543299490petersub firstname
8553299490peter{
8563299490peter	local(@names) = @_;
8573299490peter	local($n);
8583299490peter	while(@names) {
8593299490peter		$n = shift(@names);
8603299490peter		return $n if $n =~ /\S/;
8613299490peter	}
8623299490peter	return undef;
8633299490peter}
8643299490peter# queue up more addresses to expand
8653299490petersub expn
8663299490peter{
8673299490peter	local($host,$addr,$name,$level) = @_;
8683299490peter	if ($host) {
8693299490peter		$host = &trhost($host);
8703299490peter
8713299490peter		if (($debug > 3) || (defined $giveup{$host})) {
8723299490peter			unshift(@hosts,$host) unless $users{$host};
8733299490peter		} else {
8743299490peter			push(@hosts,$host) unless $users{$host};
8753299490peter		}
8763299490peter		$users{$host} .= " $addr";
8773299490peter		$names{"$addr *** $host"} = $name;
8783299490peter		$level{"$addr *** $host"} = $level + 1;
8793299490peter		print "expn($host,$addr,$name)\n" if $debug;
8803299490peter		return "\t$addr\n";
8813299490peter	} else {
8823299490peter		return &final($addr,'NONE',$name);
8833299490peter	}
8843299490peter}
8853299490peter# compute the numerical average value of an array
8863299490petersub average
8873299490peter{
8883299490peter	local(@e) = @_;
8893299490peter	return 0 unless @e;
8903299490peter	local($e,$sum);
8913299490peter	for $e (@e) {
8923299490peter		$sum += $e;
8933299490peter	}
8943299490peter	$sum / @e;
8953299490peter}
8963299490peter# print to the server (also to stdout, if -w)
8973299490petersub ps
8983299490peter{
8993299490peter	local($p) = @_;
9003299490peter	print ">>> $p\n" if $watch;
9013299490peter	print $S "$p\n";
9023299490peter}
9033299490peter# return case-adjusted name for a host (for comparison purposes)
9043299490petersub trhost
9053299490peter{
9063299490peter	# treat foo.bar as an alias for Foo.BAR
9073299490peter	local($host) = @_;
9083299490peter	local($trhost) = $host;
9093299490peter	$trhost =~ tr/A-Z/a-z/;
9103299490peter	if ($trhost{$trhost}) {
9113299490peter		$host = $trhost{$trhost};
9123299490peter	} else {
9133299490peter		$trhost{$trhost} = $host;
9143299490peter	}
9153299490peter	$trhost{$trhost};
9163299490peter}
9173299490peter# re-queue users if an mx record dictates a redirect
9183299490peter# don't allow a user to be redirected more than once
9193299490petersub mxredirect
9203299490peter{
9213299490peter	local($server,*users) = @_;
9223299490peter	local($u,$nserver,@still_there);
9233299490peter
9243299490peter	$nserver = &mx($server);
9253299490peter
9263299490peter	if (&trhost($nserver) ne &trhost($server)) {
9273299490peter		$0 = "$av0 - mx redirect $server -> $nserver\n";
9283299490peter		for $u (@users) {
9293299490peter			if (defined $mxbacktrace{"$u *** $nserver"}) {
9303299490peter				push(@still_there,$u);
9313299490peter			} else {
9323299490peter				$mxbacktrace{"$u *** $nserver"} = $server;
9333299490peter				print "mxbacktrace{$u *** $nserver} = $server\n"
9343299490peter					if ($debug > 1);
9353299490peter				&expn($nserver,$u,$names{"$u *** $server"});
9363299490peter			}
9373299490peter		}
9383299490peter		@users = @still_there;
9393299490peter		if (! @users) {
9403299490peter			return $nserver;
9413299490peter		} else {
9423299490peter			return undef;
9433299490peter		}
9443299490peter	}
9453299490peter	return undef;
9463299490peter}
9473299490peter# follow mx records, return a hostname
9483299490peter# also follow temporary redirections comming from &domainify and
9493299490peter# &mxlookup
9503299490petersub mx
9513299490peter{
9523299490peter	local($h,$u) = @_;
9533299490peter
9543299490peter	for (;;) {
9553299490peter		if (defined $mx{&trhost($h)} && $h ne $mx{&trhost($h)}) {
9563299490peter			$0 = "$av0 - mx expand $h";
9573299490peter			$h = $mx{&trhost($h)};
9583299490peter			return $h;
9593299490peter		}
9603299490peter		if ($u) {
9613299490peter			if (defined $temporary_redirect{"$u *** $h"}) {
9623299490peter				$0 = "$av0 - internal redirect $h";
9633299490peter				print "Temporary redirect taken $u *** $h -> " if $debug;
9643299490peter				$h = $temporary_redirect{"$u *** $h"};
9653299490peter				print "$h\n" if $debug;
9663299490peter				next;
9673299490peter			}
9683299490peter			$htr = &trhost($h);
9693299490peter			if (defined $temporary_redirect{"$u *** $htr"}) {
9703299490peter				$0 = "$av0 - internal redirect $h";
9713299490peter				print "temporary redirect taken $u *** $h -> " if $debug;
9723299490peter				$h = $temporary_redirect{"$u *** $htr"};
9733299490peter				print "$h\n" if $debug;
9743299490peter				next;
9753299490peter			}
9763299490peter		}
9773299490peter		return $h;
9783299490peter	}
9793299490peter}
9803299490peter# look up mx records with the name server.
9813299490peter# re-queue expansion requests if possible
9823299490peter# optionally give up on this host.
9833299490petersub mxlookup
9843299490peter{
9853299490peter	local($lastchance,$server,$giveup,*users) = @_;
9863299490peter	local(*T);
9873299490peter	local(*NSLOOKUP);
9883299490peter	local($nh, $pref,$cpref);
9893299490peter	local($o0) = $0;
9903299490peter	local($nserver);
9913299490peter	local($name,$aliases,$type,$len,$thataddr);
9923299490peter	local(%fallback);
9933299490peter
9943299490peter	return 1 if &mxredirect($server,*users);
9953299490peter
9963299490peter	if ((defined $mx{$server}) || (! $have_nslookup)) {
9973299490peter		return 0 unless $lastchance;
9983299490peter		&giveup('mx domainify',$giveup);
9993299490peter		return 0;
10003299490peter	}
10013299490peter
10023299490peter	$0 = "$av0 - nslookup of $server";
100396b960fgshapiro	sysopen(T,"/tmp/expn$$",O_RDWR|O_CREAT|O_EXCL,0600) || die "open > /tmp/expn$$: $!\n";
10043299490peter	print T "set querytype=MX\n";
10053299490peter	print T "$server\n";
10063299490peter	close(T);
10073299490peter	$cpref = 1.0E12;
10083299490peter	undef $nserver;
10093299490peter	open(NSLOOKUP,"nslookup < /tmp/expn$$ 2>&1 |") || die "open nslookup: $!";
10103299490peter	while(<NSLOOKUP>) {
10113299490peter		print if ($debug > 2);
10123299490peter		if (/mail exchanger = ([-A-Za-z_.0-9+]+)/) {
10133299490peter			$nh = $1;
10143299490peter			if (/preference = (\d+)/) {
10153299490peter				$pref = $1;
10163299490peter				if ($pref < $cpref) {
10173299490peter					$nserver = $nh;
10183299490peter					$cpref = $pref;
10193299490peter				} elsif ($pref) {
10203299490peter					$fallback{$pref} .= " $nh";
10213299490peter				}
10223299490peter			}
10233299490peter		}
10243299490peter		if (/Non-existent domain/) {
10253299490peter			#
10263299490peter			# These addresss are hosed.  Kaput!  Dead!
10273299490peter			# However, if we created the address in the
10283299490peter			# first place then there is a chance of
10293299490peter			# salvation.
10303299490peter			#
10313299490peter			1 while(<NSLOOKUP>);
10323299490peter			close(NSLOOKUP);
10333299490peter			return 0 unless $lastchance;
10343299490peter			&giveup('domainify',"$server: Non-existent domain",undef,1);
10353299490peter			return 0;
10363299490peter		}
10373299490peter
10383299490peter	}
10393299490peter	close(NSLOOKUP);
10403299490peter	unlink("/tmp/expn$$");
10413299490peter	unless ($nserver) {
10423299490peter		$0 = "$o0 - finished mxlookup";
10433299490peter		return 0 unless $lastchance;
10443299490peter		&giveup('mx domainify',"$server: Could not resolve address");
10453299490peter		return 0;
10463299490peter	}
10473299490peter
10483299490peter	# provide fallbacks in case $nserver doesn't work out
10493299490peter	if (defined $fallback{$cpref}) {
10503299490peter		$mx_secondary{$server} = $fallback{$cpref};
10513299490peter	}
10523299490peter
10533299490peter	$0 = "$av0 - gethostbyname($nserver)";
10543299490peter	($name,$aliases,$type,$len,$thataddr) = gethostbyname($nserver);
10553299490peter
10563299490peter	unless ($thataddr) {
10573299490peter		$0 = $o0;
10583299490peter		return 0 unless $lastchance;
10593299490peter		&giveup('mx domainify',"$nserver: could not resolve address");
10603299490peter		return 0;
10613299490peter	}
10623299490peter	print "MX($server) = $nserver\n" if $debug;
10633299490peter	print "$server -> $nserver\n" if $vw && !$debug;
10643299490peter	$mx{&trhost($server)} = $nserver;
10653299490peter	# redeploy the users
10663299490peter	unless (&mxredirect($server,*users)) {
10673299490peter		return 0 unless $lastchance;
10683299490peter		&giveup('mx domainify',"$nserver: only one level of mx redirect allowed");
10693299490peter		return 0;
10703299490peter	}
10713299490peter	$0 = "$o0 - finished mxlookup";
10723299490peter	return 1;
10733299490peter}
10743299490peter# if mx expansion did not help to resolve an address
10753299490peter# (ie: foo@bar became @baz:foo@bar, then undo the
10763299490peter# expansion).
10773299490peter# this is only used by &final
10783299490petersub mxunroll
10793299490peter{
10803299490peter	local(*host,*addr) = @_;
10813299490peter	local($r) = 0;
10823299490peter	print "looking for mxbacktrace{$addr *** $host}\n"
10833299490peter		if ($debug > 1);
10843299490peter	while (defined $mxbacktrace{"$addr *** $host"}) {
10853299490peter		print "Unrolling MX expnasion: \@$host:$addr -> "
10863299490peter			if ($debug || $verbose);
10873299490peter		$host = $mxbacktrace{"$addr *** $host"};
10883299490peter		print "\@$host:$addr\n"
10893299490peter			if ($debug || $verbose);
10903299490peter		$r = 1;
10913299490peter	}
10923299490peter	return 1 if $r;
10933299490peter	$addr = "\@$host:$addr"
10943299490peter		if ($host =~ /\./);
10953299490peter	return 0;
10963299490peter}
10973299490peter# register a completed expnasion.  Make the final address as
10983299490peter# simple as possible.
10993299490petersub final
11003299490peter{
11013299490peter	local($addr,$host,$name,$error) = @_;
11023299490peter	local($he);
11033299490peter	local($hb,$hr);
11043299490peter	local($au,$ah);
11053299490peter
11063299490peter	if ($error =~ /Non-existent domain/) {
11073299490peter		#
11083299490peter		# If we created the domain, then let's undo the
11093299490peter		# damage...
11103299490peter		#
11113299490peter		if (defined $create_host_backtrack{"$addr *** $host"}) {
11123299490peter			while (defined $create_host_backtrack{"$addr *** $host"}) {
11133299490peter				print "Un&domainifying($host) = " if $debug;
11143299490peter				$host = $create_host_backtrack{"$addr *** $host"};
11153299490peter				print "$host\n" if $debug;
11163299490peter			}
11173299490peter			$error = "$host: could not locate";
11183299490peter		} else {
11193299490peter			#
11203299490peter			# If we only want valid addresses, toss out
11213299490peter			# bad host names.
11223299490peter			#
11233299490peter			if ($valid) {
11243299490peter				print STDERR "\@$host:$addr ($name) Non-existent domain\n";
11253299490peter				return "";
11263299490peter			}
11273299490peter		}
11283299490peter	}
11293299490peter
11303299490peter	MXUNWIND: {
11313299490peter		$0 = "$av0 - final parsing of \@$host:$addr";
11323299490peter		($he = $host) =~ s/(\W)/\\$1/g;
11333299490peter		if ($addr !~ /@/) {
11343299490peter			# addr does not contain any host
11353299490peter			$addr = "$addr@$host";
11363299490peter		} elsif ($addr !~ /$he/i) {
11373299490peter			# if host part really something else, use the something
11383299490peter			# else.
11393299490peter			if ($addr =~ m/(.*)\@([^\@]+)$/) {
11403299490peter				($au,$ah) = ($1,$2);
11413299490peter				print "au = $au ah = $ah\n" if $debug;
11423299490peter				if (defined $temporary_redirect{"$addr *** $ah"}) {
11433299490peter					$addr = "$au\@".$temporary_redirect{"$addr *** $ah"};
11443299490peter					print "Rewrite! to $addr\n" if $debug;
11453299490peter					next MXUNWIND;
11463299490peter				}
11473299490peter			}
11483299490peter			# addr does not contain full host
11493299490peter			if ($valid) {
11503299490peter				if ($host =~ /^([^\.]+)(\..+)$/) {
11513299490peter					# host part has a . in it - foo.bar
11523299490peter					($hb, $hr) = ($1, $2);
11533299490peter					if ($addr =~ /\@([^\.\@]+)$/ && ($1 eq $hb)) {
11543299490peter						# addr part has not .
11553299490peter						# and matches beginning of
11563299490peter						# host part -- tack on a
11573299490peter						# domain name.
11583299490peter						$addr .= $hr;
11593299490peter					} else {
11603299490peter						&mxunroll(*host,*addr)
11613299490peter							&& redo MXUNWIND;
11623299490peter					}
11633299490peter				} else {
11643299490peter					&mxunroll(*host,*addr)
11653299490peter						&& redo MXUNWIND;
11663299490peter				}
11673299490peter			} else {
11683299490peter				$addr = "${addr}[\@$host]"
11693299490peter					if ($host =~ /\./);
11703299490peter			}
11713299490peter		}
11723299490peter	}
11733299490peter	$name = "$name " if $name;
11743299490peter	$error = " $error" if $error;
11753299490peter	if ($valid) {
11763299490peter		push(@final,"$name<$addr>");
11773299490peter	} else {
11783299490peter		push(@final,"$name<$addr>$error");
11793299490peter	}
11803299490peter	"\t$name<$addr>$error\n";
11813299490peter}
11823299490peter
11833299490petersub alarm
11843299490peter{
11853299490peter	local($alarm_action,$alarm_redirect,$alarm_user) = @_;
11863299490peter	alarm(3600);
11873299490peter	$SIG{ALRM} = 'handle_alarm';
11883299490peter}
11893299490peter# this involves one great big ugly hack.
11903299490peter# the "next HOST" unwinds the stack!
11913299490petersub handle_alarm
11923299490peter{
11933299490peter	&giveup($alarm_redirect,"Timed out during $alarm_action",$alarm_user);
11943299490peter	next HOST;
11953299490peter}
11963299490peter
11973299490peter# read the rest of the current smtp daemon's response (and toss it away)
11983299490petersub read_response
11993299490peter{
12003299490peter	local($done,$watch) = @_;
12013299490peter	local(@resp);
12023299490peter	print $s if $watch;
12033299490peter	while(($done eq "-") && ($s = <$S>) && ($s =~ /^\d+([- ])/)) {
12043299490peter		print $s if $watch;
12053299490peter		$done = $1;
12063299490peter		push(@resp,$s);
12073299490peter	}
12083299490peter	return @resp;
12093299490peter}
12103299490peter# print args if verbose.  Return them in any case
12113299490petersub verbose
12123299490peter{
12133299490peter	local(@tp) = @_;
12143299490peter	print "@tp" if $verbose;
12153299490peter}
12163299490peter# to pass perl -w:
12173299490peter@tp;
12183299490peter$flag_a;
12193299490peter$flag_d;
12203299490peter$flag_1;
12213299490peter%already_domainify_fellback;
12223299490peter%already_mx_fellback;
12233299490peter&handle_alarm;
12243299490peter################### BEGIN PERL/TROFF TRANSITION
12253299490peter.00 ;
12263299490peter
12273299490peter'di
12283299490peter.nr nl 0-1
12293299490peter.nr % 0
12303299490peter.\\"'; __END__
12313299490peter.\" ############## END PERL/TROFF TRANSITION
12323299490peter.TH EXPN 1 "March 11, 1993"
12333299490peter.AT 3
12343299490peter.SH NAME
12353299490peterexpn \- recursively expand mail aliases
12363299490peter.SH SYNOPSIS
12373299490peter.B expn
12383299490peter.RI [ -a ]
12393299490peter.RI [ -v ]
12403299490peter.RI [ -w ]
12413299490peter.RI [ -d ]
12423299490peter.RI [ -1 ]
12433299490peter.IR user [@ hostname ]
12443299490peter.RI [ user [@ hostname ]]...
12453299490peter.SH DESCRIPTION
12463299490peter.B expn
12473299490peterwill use the SMTP
12483299490peter.B expn
12493299490peterand
12503299490peter.B vrfy
12513299490petercommands to expand mail aliases.
12523299490peterIt will first look up the addresses you provide on the command line.
12533299490peterIf those expand into addresses on other systems, it will
12543299490peterconnect to the other systems and expand again.  It will keep
12553299490peterdoing this until no further expansion is possible.
12563299490peter.SH OPTIONS
12573299490peterThe default output of
12583299490peter.B expn
12593299490petercan contain many lines which are not valid
12603299490peteremail addresses.  With the
12613299490peter.I -aa
12623299490peterflag, only expansions that result in legal addresses
12633299490peterare used.  Since many mailing lists have an illegal
12643299490peteraddress or two, the single
12653299490peter.IR -a ,
12663299490peteraddress, flag specifies that a few illegal addresses can
12673299490peterbe mixed into the results.   More
12683299490peter.I -a
12693299490peterflags vary the ratio.  Read the source to track down
12703299490peterthe formula.  With the
12713299490peter.I -a
12723299490peteroption, you should be able to construct a new mailing
12733299490peterlist out of an existing one.
12743299490peter.LP
12753299490peterIf you wish to limit the number of levels deep that
12763299490peter.B expn
12773299490peterwill recurse as it traces addresses, use the
12783299490peter.I -1
12793299490peteroption.  For each
12803299490peter.I -1
12813299490peteranother level will be traversed.  So,
12823299490peter.I -111
12833299490peterwill traverse no more than three levels deep.
12843299490peter.LP
12853299490peterThe normal mode of operation for
12863299490peter.B expn
12873299490peteris to do all of its work silently.
12883299490peterThe following options make it more verbose.
12893299490peterIt is not necessary to make it verbose to see what it is
12903299490peterdoing because as it works, it changes its
12913299490peter.BR argv [0]
12923299490petervariable to reflect its current activity.
12933299490peterTo see how it is expanding things, the
12943299490peter.IR -v ,
12953299490peterverbose, flag will cause
12963299490peter.B expn
12973299490peterto show each address before
12983299490peterand after translation as it works.
12993299490peterThe
13003299490peter.IR -w ,
13013299490peterwatch, flag will cause
13023299490peter.B expn
13033299490peterto show you its conversations with the mail daemons.
13043299490peterFinally, the
13053299490peter.IR -d ,
13063299490peterdebug, flag will expose many of the inner workings so that
13073299490peterit is possible to eliminate bugs.
13083299490peter.SH ENVIRONMENT
130939e311bgshapiroNo environment variables are used.
13103299490peter.SH FILES
13113299490peter.PD 0
13123299490peter.B /tmp/expn$$
13133299490peter.B temporary file used as input to
13143299490peter.BR nslookup .
13153299490peter.SH SEE ALSO
13163299490peter.BR aliases (5),
13173299490peter.BR sendmail (8),
13183299490peter.BR nslookup (8),
13193299490peterRFC 823, and RFC 1123.
13203299490peter.SH BUGS
13213299490peterNot all mail daemons will implement
13223299490peter.B expn
13233299490peteror
13243299490peter.BR vrfy .
13253299490peterIt is not possible to verify addresses that are served
13263299490peterby such daemons.
13273299490peter.LP
13283299490peterWhen attempting to connect to a system to verify an address,
13293299490peter.B expn
13303299490peteronly tries one IP address.  Most mail daemons
13313299490peterwill try harder.
13323299490peter.LP
13333299490peterIt is assumed that you are running domain names and that
13343299490peterthe
13353299490peter.BR nslookup (8)
13363299490peterprogram is available.  If not,
13373299490peter.B expn
13383299490peterwill not be able to verify many addresses.  It will also pause
13393299490peterfor a long time unless you change the code where it says
13403299490peter.I $have_nslookup = 1
13413299490peterto read
13423299490peter.I $have_nslookup =
13433299490peter.IR 0 .
13443299490peter.LP
13453299490peterLastly,
13463299490peter.B expn
13473299490peterdoes not handle every valid address.  If you have an example,
13483299490peterplease submit a bug report.
13493299490peter.SH CREDITS
13503299490peterIn 1986 or so, Jon Broome wrote a program of the same name
13513299490peterthat did about the same thing.  It has since suffered bit rot
13523299490peterand Jon Broome has dropped off the face of the earth!
13533299490peter(Jon, if you are out there, drop me a line)
13543299490peter.SH AVAILABILITY
13553299490peterThe latest version of
13563299490peter.B expn
13573299490peteris available through anonymous ftp at
13583299490peter.IR ftp://ftp.idiom.com/pub/muir-programs/expn .
13593299490peter.SH AUTHOR
13603299490peter.I David Muir Sharnoff\ \ \ \ <muir@idiom.com>
1361