expn.pl

早期freebsd实现

#!/usr/local/bin/perl
'di ';
'ds 00 \\"';
'ig00 ';
#
#       THIS PROGRAM IS ITS OWN MANUAL PAGE.  INSTALL IN man & bin.
#

# hardcoded constants, should work fine for BSD-based systems
$AF_INET = 2;
$SOCK_STREAM = 1;
$sockaddr = 'S n a4 x8';

# system requirements:
# 	must have 'nslookup' and 'hostname' programs.

# $Header: /home/muir/bin/RCS/expn,v 3.6 1994/02/23 22:26:19 muir Exp muir $

# TODO:
#	less magic should apply to command-line addresses
#	less magic should apply to local addresses
#	add magic to deal with cross-domain cnames

# Checklist: (hard addresses)
#	250 Kimmo Suominen <"|/usr/local/mh/lib/slocal -user kim"@grendel.tac.nyc.ny.us>
#	[e-mail] -> harry@tenet (.berkeley.edu)  [dead]
#	[e-mail] -> shiva.CS (.berkeley.edu)		      [dead]
#	[e-mail] -> brown@tiberius (.tc.cornell.edu)

#############################################################################
#
#  Copyright (c) 1993 David Muir Sharnoff
#  All rights reserved.
#
#  Redistribution and use in source and binary forms, with or without
#  modification, are permitted provided that the following conditions
#  are met:
#  1. Redistributions of source code must retain the above copyright
#     notice, this list of conditions and the following disclaimer.
#  2. Redistributions in binary form must reproduce the above copyright
#     notice, this list of conditions and the following disclaimer in the
#     documentation and/or other materials provided with the distribution.
#  3. All advertising materials mentioning features or use of this software
#     must display the following acknowledgement:
#       This product includes software developed by the David Muir Sharnoff.
#  4. The name of David Sharnoff may not be used to endorse or promote products
#     derived from this software without specific prior written permission.
#
#  THIS SOFTWARE IS PROVIDED BY THE DAVID MUIR SHARNOFF ``AS IS'' AND
#  ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
#  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
#  ARE DISCLAIMED.  IN NO EVENT SHALL DAVID MUIR SHARNOFF BE LIABLE
#  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
#  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
#  OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
#  HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
#  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
#  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
#  SUCH DAMAGE.
#
# This copyright notice derrived from material copyrighted by the Regents
# of the University of California.
#
# Contributions accepted.
#
#############################################################################

# overall structure:
#	in an effort to not trace each address individually, but rather
#	ask each server in turn a whole bunch of questions, addresses to
#	be expanded are queued up.
#
#	This means that all account w.r.t. an address must be stored in
#	various arrays.  Generally these arrays are indexed by the
#	string "$addr *** $server" where $addr is the address to be
#	expanded "foo" or maybe "foo@bar" and $server is the hostname
#	of the SMTP server to contact.
#

# important global variables:
#
# @hosts : list of servers still to be contacted
# $server : name of the current we are currently looking at
# @users = $users{@hosts[0]} : addresses to expand at this server
# $u = $users[0] : the current address being expanded
# $names{"$users[0] *** $server"} : the 'name' associated with the address
# $mxbacktrace{"$users[0] *** $server"} : record of mx expansion
# $mx_secondary{$server} : other mx relays at the same priority
# $domainify_fallback{"$users[0] *** $server"} : alternative names to try 
#	instead of $server if $server doesn't work
# $temporary_redirect{"$users[0] *** $server"} : when trying alternates,
#	temporarily channel all tries along current path
# $giveup{$server} : do not bother expanding addresses at $server
# $verbose : -v
# $watch : -w
# $vw : -v or -w
# $debug : -d
# $valid : -a
# $levels : -1
# S : the socket connection to $server

$have_nslookup = 1;	# we have the nslookup program
$port = 'smtp';
$av0 = $0;
$0 = "$av0 - running hostname";
$ENV{'PATH'} .= ":/usr/etc" unless $ENV{'PATH'} =~ m,/usr/etc,;
chop($hostname = `hostname`);
select(STDERR);

$usage = "Usage: $av0 [-1avwd] user[@host] [user2[host2] ...]";
$0 = "$av0 - parsing args";
for $a (@ARGV) {
	die $usage if $a eq "-";
	while ($a =~ s/^(-.*)([1avwd])/$1/) {
		eval '$'."flag_$2 += 1";
	}
	next if $a eq "-";
	die $usage if $a =~ /^-/;
	&expn(&parse($a,$hostname,undef,1));
}
$verbose = $flag_v;
$watch = $flag_w;
$vw = $flag_v + $flag_w;
$debug = $flag_d;
$valid = $flag_a;
$levels = $flag_1;

die $usage unless @hosts;
if ($valid) {
	if ($valid == 1) {
		$validRequirement = 0.8;
	} elsif ($valid == 2) {
		$validRequirement = 1.0;
	} elsif ($valid == 3) {
		$validRequirement = 0.9;
	} else {
		$validRequirement = (1 - (1/($valid-3)));
		print "validRequirement = $validRequirement\n" if $debug;
	}
}

$0 = "$av0 - building local socket";
($name,$aliases,$proto) = getprotobyname('tcp');
($name,$aliases,$port) = getservbyname($port,'tcp')
	unless $port =~ /^\d+/;
($name,$aliases,$type,$len,$thisaddr) = gethostbyname($hostname);
$this = pack($sockaddr, $AF_INET, 0, $thisaddr);

HOST:
while (@hosts) {
	$server = shift(@hosts);
	@users = split(' ',$users{$server});
	delete $users{$server};

	# is this server already known to be bad?
	$0 = "$av0 - looking up $server";
	if ($giveup{$server}) {
		&giveup('mx domainify',$giveup{$server});
		next;
	}

	# do we already have an mx record for this host?
	next HOST if &mxredirect($server,*users);

	# look it up, or try for an mx.
	$0 = "$av0 - gethostbyname($server)";

	($name,$aliases,$type,$len,$thataddr) = gethostbyname($server);
	# if we can't get an A record, try for an MX record.
	unless($thataddr) {
		&mxlookup(1,$server,"$server: could not resolve name",*users);
		next HOST;
	}
				
	# get a connection, or look for an mx
	$0 = "$av0 - socket to $server";
	$that = pack($sockaddr, $AF_INET, $port, $thataddr);
	socket(S, $AF_INET, $SOCK_STREAM, $proto)
		|| die "socket: $!";
	$0 = "$av0 - bind to $server";
	bind(S, $this) 
		|| die "bind $hostname,0: $!";
	$0 = "$av0 - connect to $server";
	print "debug = $debug server = $server\n" if $debug > 8;
	if (! connect(S, $that) || ($debug == 10 && $server =~ /relay\d.UU.NET$/i)) {
		$0 = "$av0 - $server: could not connect: $!\n";
		$emsg = $!;
		unless (&mxlookup(0,$server,"$server: could not connect: $!",*users)) {
			&giveup('mx',"$server: Could not connect: $emsg");
		}
		next HOST;
	}
	select((select(S),$| = 1)[0]); # don't buffer output to S

	# read the greeting
	$0 = "$av0 - talking to $server";
	&alarm("greeting with $server",'');
	while(<S>) {
		alarm(0);
		print if $watch;
		if (/^(\d+)([- ])/) {
			if ($1 != 220) {
				$0 = "$av0 - bad numeric responce from $server";
				&alarm("giving up after bet responce from $server",'');
				&read_response($2,$watch);
				alarm(0);
				print STDERR "$server: NOT 220 greeting: $_"
					if ($debug || $vw);
				if (&mxlookup(0,$server,"$server: did not respond with a 220 greeting",*users)) {
					close(S);
					next HOST;
				}
			}
			last if ($2 eq " ");
		} else {
			$0 = "$av0 - bad responce from $server";
			print STDERR "$server: NOT 220 greeting: $_"
				if ($debug || $vw);
			unless (&mxlookup(0,$server,"$server: did not respond with SMTP codes",*users)) {
				&giveup('',"$server: did not talk SMTP");
			}
			close(S);
			next HOST;
		}
		&alarm("greeting with $server",'');
	}
	alarm(0);
	
	# if this causes problems, remove it
	$0 = "$av0 - sending helo to $server";
	&alarm("sending helo to $server","");
	&ps("helo $hostname");
	while(<S>) {
		print if $watch;
		last if /^\d+ /;
	}
	alarm(0);

	# try the users, one by one
	USER:
	while(@users) {
		$u = shift(@users);
		$0 = "$av0 - expanding $u [\@$server]";

		# do we already have a name for this user?
		$oldname = $names{"$u *** $server"};

		print &compact($u,$server)." ->\n" if ($verbose && ! $valid);
		if ($valid) {
			#
			# when running with -a, we delay taking any action 
			# on the results of our query until we have looked
			# at the complete output.  @toFinal stores expansions
			# that will be final if we take them.  @toExpn stores
			# expnansions that are not final.  @isValid keeps
			# track of our ability to send mail to each of the
			# expansions.
			#
			@isValid = ();
			@toFinal = ();
			@toExpn = ();
		}

		($ecode,@expansion) = &expn_vrfy($u,$server);
		if ($ecode) {
			&giveup('',$ecode,$u);
			last USER;
		}

		for $s (@expansion) {
			$s =~ s/[\n\r]//g;
			$0 = "$av0 - parsing $server: $s";

			$skipwatch = $watch;

			if ($s =~ /^[25]51([- ]).*<(.+)>/) {
				print "$s" if $watch;
				print "(pretending 250$1<$2>)" if ($debug && $watch);
				print "\n" if $watch;
				$s = "250$1<$2>";
				$skipwatch = 0;
			}

			if ($s =~ /^250([- ])(.+)/) {
				print "$s\n" if $skipwatch;
				($done,$addr) = ($1,$2);
				($newhost, $newaddr, $newname) =  &parse($addr,$server,$oldname, $#expansion == 0);
				print "($newhost, $newaddr, $newname) = &parse($addr, $server, $oldname)\n" if $debug;
				if (! $newhost) {
					# no expansion is possible w/o a new server to call
					if ($valid) {
						push(@isValid, &validAddr($newaddr));
						push(@toFinal,$newaddr,$server,$newname);
					} else {
						&verbose(&final($newaddr,$server,$newname));
					}
				} else {
					$newmxhost = &mx($newhost,$newaddr);
					print "$newmxhost = &mx($newhost)\n" 
						if ($debug && $newhost ne $newmxhost);
					$0 = "$av0 - parsing $newaddr [@$newmxhost]";
					print "levels = $levels, level{$u *** $server} = ".$level{"$u *** $server"}."\n" if ($debug > 1);
					# If the new server is the current one, 
					# it would have expanded things for us
					# if it could have.  Mx records must be
					# followed to compare server names.
					# We are also done if the recursion
					# count has been exceeded.
					if (&trhost($newmxhost) eq &trhost($server) || ($levels && $level{"$u *** $server"} >= $levels)) {
						if ($valid) {
							push(@isValid, &validAddr($newaddr));
							push(@toFinal,$newaddr,$newmxhost,$newname);
						} else {
							&verbose(&final($newaddr,$newmxhost,$newname));
						}
					} else {
						# more work to do...
						if ($valid) {
							push(@isValid, &validAddr($newaddr));
							push(@toExpn,$newmxhost,$newaddr,$newname,$level{"$u *** $server"});
						} else {
							&verbose(&expn($newmxhost,$newaddr,$newname,$level{"$u *** $server"}));
						}
					}
				}
				last if ($done eq " ");
				next;
			}
			# 550 is a known code...  Should the be
			# included in -a output?  Might be a bug
			# here.  Does it matter?  Can assume that
			# there won't be UNKNOWN USER responces 
			# mixed with valid users?
			if ($s =~ /^(550)([- ])/) {
				if ($valid) {
					print STDERR "\@$server:$u ($oldname) USER UNKNOWN\n";
				} else {
					&verbose(&final($u,$server,$oldname,"USER UNKNOWN"));
				}
				last if ($2 eq " ");
				next;
			} 
			# 553 is a known code...  
			if ($s =~ /^(553)([- ])/) {
				if ($valid) {
					print STDERR "\@$server:$u ($oldname) USER AMBIGUOUS\n";
				} else {
					&verbose(&final($u,$server,$oldname,"USER AMBIGUOUS"));
				}
				last if ($2 eq " ");
				next;
			} 
			# 252 is a known code...  
			if ($s =~ /^(252)([- ])/) {
				if ($valid) {
					print STDERR "\@$server:$u ($oldname) REFUSED TO VRFY\n";
				} else {
					&verbose(&final($u,$server,$oldname,"REFUSED TO VRFY"));
				}
				last if ($2 eq " ");
				next;
			} 
			&giveup('',"$server: did not grok '$s'",$u);
			last USER;
		}

		if ($valid) {
			#
			# now we decide if we are going to take these
			# expansions or roll them back.
			#
			$avgValid = &average(@isValid);
			print "avgValid = $avgValid\n" if $debug;
			if ($avgValid >= $validRequirement) {
				print &compact($u,$server)." ->\n" if $verbose;
				while (@toExpn) {
					&verbose(&expn(splice(@toExpn,0,4)));
				}
				while (@toFinal) {
					&verbose(&final(splice(@toFinal,0,3)));
				}
			} else {
				print "Tossing some valid to avoid invalid ".&compact($u,$server)."\n" if ($avgValid > 0.0 && ($vw || $debug));
				print &compact($u,$server)." ->\n" if $verbose;
				&verbose(&final($u,$server,$newname));
			}
		}
	}

	&alarm("sending 'quit' to $server",'');
	$0 = "$av0 - sending 'quit' to $server";
	&ps("quit");
	while(<S>) {
		print if $watch;
		last if /^\d+ /;
	}
	close(S);
	alarm(0);
}

$0 = "$av0 - printing final results";
print "----------\n" if $vw;
select(STDOUT);
for $f (sort @final) {
	print "$f\n";
}
unlink("/tmp/expn$$");
exit(0);


# abandon all attempts deliver to $server
# register the current addresses as the final ones
sub giveup
{
	local($redirect_okay,$reason,$user) = @_;
	local($us,@so,$nh,@remaining_users);

	$0 = "$av0 - giving up on $server: $reason";
	#
	# add back a user if we gave up in the middle
	#
	push(@users,$user) if $user;
	#
	# don't bother with this system anymore
	#
	unless ($giveup{$server}) {
		$giveup{$server} = $reason;
		print STDERR "$reason\n";
	}
	print "Giveup!!! redirect okay = $redirect_okay; $reason\n" if $debug;
	#
	# Wait!
	# Before giving up, see if there is a chance that
	# there is another host to redirect to!
	# (Kids, don't do this at home!  Hacking is a dangerous
	# crime and you could end up behind bars.)
	#
	for $u (@users) {
		if ($redirect_okay =~ /\bmx\b/) {
			next if &try_fallback('mx',$u,*server,
				*mx_secondary,
				*already_mx_fellback);
		}
		if ($redirect_okay =~ /\bdomainify\b/) {
			next if &try_fallback('domainify',$u,*server,
				*domainify_fallback,
				*already_domainify_fellback);
		}
		push(@remaining_users,$u);
	}
	@users = @remaining_users;
	for $u (@users) {
		print &compact($u,$server)." ->\n" if ($verbose && $valid && $u);
		&verbose(&final($u,$server,$names{"$u *** $server"},$reason));
	}
}