expn.pl revision 102528
138032Speter#!/usr/bin/perl 238032Speter'di '; 338032Speter'ds 00 \\"'; 438032Speter'ig 00 '; 538032Speter# 638032Speter# THIS PROGRAM IS ITS OWN MANUAL PAGE. INSTALL IN man & bin. 738032Speter# 838032Speter 938032Speteruse 5.001; 1038032Speteruse IO::Socket; 1138032Speter 1238032Speter# system requirements: 1338032Speter# must have 'nslookup' and 'hostname' programs. 1438032Speter 1564562Sgshapiro# $OrigHeader: /home/muir/bin/RCS/expn,v 3.11 1997/09/10 08:14:02 muir Exp muir $ 1638032Speter 1738032Speter# TODO: 1838032Speter# less magic should apply to command-line addresses 1938032Speter# less magic should apply to local addresses 2038032Speter# add magic to deal with cross-domain cnames 2138032Speter# disconnect & reconnect after 25 commands to the same sendmail 8.8.* host 2238032Speter 2338032Speter# Checklist: (hard addresses) 2438032Speter# 250 Kimmo Suominen <"|/usr/local/mh/lib/slocal -user kim"@grendel.tac.nyc.ny.us> 2538032Speter# harry@hofmann.cs.Berkeley.EDU -> harry@tenet (.berkeley.edu) [dead] 2638032Speter# bks@cs.berkeley.edu -> shiva.CS (.berkeley.edu) [dead] 2738032Speter# dan@tc.cornell.edu -> brown@tiberius (.tc.cornell.edu) 2838032Speter 2938032Speter############################################################################# 3038032Speter# 3138032Speter# Copyright (c) 1993 David Muir Sharnoff 3238032Speter# All rights reserved. 3338032Speter# 3438032Speter# Redistribution and use in source and binary forms, with or without 3538032Speter# modification, are permitted provided that the following conditions 3638032Speter# are met: 3738032Speter# 1. Redistributions of source code must retain the above copyright 3838032Speter# notice, this list of conditions and the following disclaimer. 3938032Speter# 2. Redistributions in binary form must reproduce the above copyright 4038032Speter# notice, this list of conditions and the following disclaimer in the 4138032Speter# documentation and/or other materials provided with the distribution. 4238032Speter# 3. All advertising materials mentioning features or use of this software 4338032Speter# must display the following acknowledgement: 4438032Speter# This product includes software developed by the David Muir Sharnoff. 4538032Speter# 4. The name of David Sharnoff may not be used to endorse or promote products 4638032Speter# derived from this software without specific prior written permission. 4738032Speter# 4838032Speter# THIS SOFTWARE IS PROVIDED BY THE DAVID MUIR SHARNOFF ``AS IS'' AND 4938032Speter# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 5038032Speter# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 5138032Speter# ARE DISCLAIMED. IN NO EVENT SHALL DAVID MUIR SHARNOFF BE LIABLE 5238032Speter# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 5338032Speter# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 5438032Speter# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 5538032Speter# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 5638032Speter# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 5738032Speter# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 5838032Speter# SUCH DAMAGE. 5938032Speter# 6038032Speter# This copyright notice derrived from material copyrighted by the Regents 6138032Speter# of the University of California. 6238032Speter# 6338032Speter# Contributions accepted. 6438032Speter# 6538032Speter############################################################################# 6638032Speter 6738032Speter# overall structure: 6838032Speter# in an effort to not trace each address individually, but rather 6938032Speter# ask each server in turn a whole bunch of questions, addresses to 7038032Speter# be expanded are queued up. 7138032Speter# 7238032Speter# This means that all accounting w.r.t. an address must be stored in 7338032Speter# various arrays. Generally these arrays are indexed by the 7438032Speter# string "$addr *** $server" where $addr is the address to be 7538032Speter# expanded "foo" or maybe "foo@bar" and $server is the hostname 7638032Speter# of the SMTP server to contact. 7738032Speter# 7838032Speter 7938032Speter# important global variables: 8038032Speter# 8138032Speter# @hosts : list of servers still to be contacted 8238032Speter# $server : name of the current we are currently looking at 8338032Speter# @users = $users{@hosts[0]} : addresses to expand at this server 8438032Speter# $u = $users[0] : the current address being expanded 8538032Speter# $names{"$users[0] *** $server"} : the 'name' associated with the address 8638032Speter# $mxbacktrace{"$users[0] *** $server"} : record of mx expansion 8738032Speter# $mx_secondary{$server} : other mx relays at the same priority 8838032Speter# $domainify_fallback{"$users[0] *** $server"} : alternative names to try 8938032Speter# instead of $server if $server doesn't work 9038032Speter# $temporary_redirect{"$users[0] *** $server"} : when trying alternates, 9138032Speter# temporarily channel all tries along current path 9238032Speter# $giveup{$server} : do not bother expanding addresses at $server 9338032Speter# $verbose : -v 9438032Speter# $watch : -w 9538032Speter# $vw : -v or -w 9638032Speter# $debug : -d 9738032Speter# $valid : -a 9838032Speter# $levels : -1 9938032Speter# $S : the socket connection to $server 10038032Speter 10138032Speter$have_nslookup = 1; # we have the nslookup program 10238032Speter$port = 'smtp'; 10338032Speter$av0 = $0; 10438032Speter$ENV{'PATH'} .= ":/usr/etc" unless $ENV{'PATH'} =~ m,/usr/etc,; 10538032Speter$ENV{'PATH'} .= ":/usr/ucb" unless $ENV{'PATH'} =~ m,/usr/ucb,; 10638032Speterselect(STDERR); 10738032Speter 10838032Speter$0 = "$av0 - running hostname"; 10938032Speterchop($name = `hostname || uname -n`); 11038032Speter 11138032Speter$0 = "$av0 - lookup host FQDN and IP addr"; 11238032Speter($hostname,$aliases,$type,$len,$thisaddr) = gethostbyname($name); 11338032Speter 11438032Speter$0 = "$av0 - parsing args"; 11538032Speter$usage = "Usage: $av0 [-1avwd] user[\@host] [user2[host2] ...]"; 11638032Speterfor $a (@ARGV) { 11738032Speter die $usage if $a eq "-"; 11838032Speter while ($a =~ s/^(-.*)([1avwd])/$1/) { 11938032Speter eval '$'."flag_$2 += 1"; 12038032Speter } 12138032Speter next if $a eq "-"; 12238032Speter die $usage if $a =~ /^-/; 12338032Speter &expn(&parse($a,$hostname,undef,1)); 12438032Speter} 12538032Speter$verbose = $flag_v; 12638032Speter$watch = $flag_w; 12738032Speter$vw = $flag_v + $flag_w; 12838032Speter$debug = $flag_d; 12938032Speter$valid = $flag_a; 13038032Speter$levels = $flag_1; 13138032Speter 13238032Speterdie $usage unless @hosts; 13338032Speterif ($valid) { 13438032Speter if ($valid == 1) { 13538032Speter $validRequirement = 0.8; 13638032Speter } elsif ($valid == 2) { 13738032Speter $validRequirement = 1.0; 13838032Speter } elsif ($valid == 3) { 13938032Speter $validRequirement = 0.9; 14038032Speter } else { 14138032Speter $validRequirement = (1 - (1/($valid-3))); 14238032Speter print "validRequirement = $validRequirement\n" if $debug; 14338032Speter } 14438032Speter} 14538032Speter 14638032SpeterHOST: 14738032Speterwhile (@hosts) { 14838032Speter $server = shift(@hosts); 14938032Speter @users = split(' ',$users{$server}); 15038032Speter delete $users{$server}; 15138032Speter 15238032Speter # is this server already known to be bad? 15338032Speter $0 = "$av0 - looking up $server"; 15438032Speter if ($giveup{$server}) { 15538032Speter &giveup('mx domainify',$giveup{$server}); 15638032Speter next; 15738032Speter } 15838032Speter 15938032Speter # do we already have an mx record for this host? 16038032Speter next HOST if &mxredirect($server,*users); 16138032Speter 16238032Speter # look it up, or try for an mx. 16338032Speter $0 = "$av0 - gethostbyname($server)"; 16438032Speter 16538032Speter ($name,$aliases,$type,$len,$thataddr) = gethostbyname($server); 16638032Speter # if we can't get an A record, try for an MX record. 16738032Speter unless($thataddr) { 16838032Speter &mxlookup(1,$server,"$server: could not resolve name",*users); 16938032Speter next HOST; 17038032Speter } 17138032Speter 17238032Speter # get a connection, or look for an mx 17338032Speter $0 = "$av0 - socket to $server"; 17438032Speter 17538032Speter $S = new IO::Socket::INET ( 17638032Speter 'PeerAddr' => $server, 17738032Speter 'PeerPort' => $port, 17838032Speter 'Proto' => 'tcp'); 17938032Speter 18038032Speter if (! $S || ($debug == 10 && $server =~ /relay\d.UU.NET$/i)) { 18138032Speter $0 = "$av0 - $server: could not connect: $!\n"; 18238032Speter $emsg = $!; 18338032Speter unless (&mxlookup(0,$server,"$server: could not connect: $!",*users)) { 18438032Speter &giveup('mx',"$server: Could not connect: $emsg"); 18538032Speter } 18638032Speter next HOST; 18738032Speter } 18838032Speter $S->autoflush(1); 18938032Speter 19038032Speter # read the greeting 19138032Speter $0 = "$av0 - talking to $server"; 19238032Speter &alarm("greeting with $server",''); 19338032Speter while(<$S>) { 19438032Speter alarm(0); 19538032Speter print if $watch; 19638032Speter if (/^(\d+)([- ])/) { 19738032Speter if ($1 != 220) { 19838032Speter $0 = "$av0 - bad numeric response from $server"; 19938032Speter &alarm("giving up after bad response from $server",''); 20038032Speter &read_response($2,$watch); 20138032Speter alarm(0); 20238032Speter print STDERR "$server: NOT 220 greeting: $_" 20338032Speter if ($debug || $vw); 20438032Speter if (&mxlookup(0,$server,"$server: did not respond with a 220 greeting",*users)) { 20538032Speter close($S); 20638032Speter next HOST; 20738032Speter } 20838032Speter } 20938032Speter last if ($2 eq " "); 21038032Speter } else { 21138032Speter $0 = "$av0 - bad response from $server"; 21238032Speter print STDERR "$server: NOT 220 greeting: $_" 21338032Speter if ($debug || $vw); 21438032Speter unless (&mxlookup(0,$server,"$server: did not respond with SMTP codes",*users)) { 21538032Speter &giveup('',"$server: did not talk SMTP"); 21638032Speter } 21738032Speter close($S); 21838032Speter next HOST; 21938032Speter } 22038032Speter &alarm("greeting with $server",''); 22138032Speter } 22238032Speter alarm(0); 22338032Speter 22438032Speter # if this causes problems, remove it 22538032Speter $0 = "$av0 - sending helo to $server"; 22638032Speter &alarm("sending helo to $server",""); 22738032Speter &ps("helo $hostname"); 22838032Speter while(<$S>) { 22938032Speter print if $watch; 23038032Speter last if /^\d+ /; 23138032Speter } 23238032Speter alarm(0); 23338032Speter 23438032Speter # try the users, one by one 23538032Speter USER: 23638032Speter while(@users) { 23738032Speter $u = shift(@users); 23838032Speter $0 = "$av0 - expanding $u [\@$server]"; 23938032Speter 24038032Speter # do we already have a name for this user? 24138032Speter $oldname = $names{"$u *** $server"}; 24238032Speter 24338032Speter print &compact($u,$server)." ->\n" if ($verbose && ! $valid); 24438032Speter if ($valid) { 24538032Speter # 24638032Speter # when running with -a, we delay taking any action 24738032Speter # on the results of our query until we have looked 24838032Speter # at the complete output. @toFinal stores expansions 24938032Speter # that will be final if we take them. @toExpn stores 25038032Speter # expnansions that are not final. @isValid keeps 25138032Speter # track of our ability to send mail to each of the 25238032Speter # expansions. 25338032Speter # 25438032Speter @isValid = (); 25538032Speter @toFinal = (); 25638032Speter @toExpn = (); 25738032Speter } 25838032Speter 25938032Speter# ($ecode,@expansion) = &expn_vrfy($u,$server); 26038032Speter (@foo) = &expn_vrfy($u,$server); 26138032Speter ($ecode,@expansion) = @foo; 26238032Speter if ($ecode) { 26338032Speter &giveup('',$ecode,$u); 26438032Speter last USER; 26538032Speter } 26638032Speter 26738032Speter for $s (@expansion) { 26838032Speter $s =~ s/[\n\r]//g; 26938032Speter $0 = "$av0 - parsing $server: $s"; 27038032Speter 27138032Speter $skipwatch = $watch; 27238032Speter 27338032Speter if ($s =~ /^[25]51([- ]).*<(.+)>/) { 27438032Speter print "$s" if $watch; 27538032Speter print "(pretending 250$1<$2>)" if ($debug && $watch); 27638032Speter print "\n" if $watch; 27738032Speter $s = "250$1<$2>"; 27838032Speter $skipwatch = 0; 27938032Speter } 28038032Speter 28138032Speter if ($s =~ /^250([- ])(.+)/) { 28238032Speter print "$s\n" if $skipwatch; 28338032Speter ($done,$addr) = ($1,$2); 28438032Speter ($newhost, $newaddr, $newname) = &parse($addr,$server,$oldname, $#expansion == 0); 28538032Speter print "($newhost, $newaddr, $newname) = &parse($addr, $server, $oldname)\n" if $debug; 28638032Speter if (! $newhost) { 28738032Speter # no expansion is possible w/o a new server to call 28838032Speter if ($valid) { 28938032Speter push(@isValid, &validAddr($newaddr)); 29038032Speter push(@toFinal,$newaddr,$server,$newname); 29138032Speter } else { 29238032Speter &verbose(&final($newaddr,$server,$newname)); 29338032Speter } 29438032Speter } else { 29538032Speter $newmxhost = &mx($newhost,$newaddr); 29638032Speter print "$newmxhost = &mx($newhost)\n" 29738032Speter if ($debug && $newhost ne $newmxhost); 29838032Speter $0 = "$av0 - parsing $newaddr [@$newmxhost]"; 29938032Speter print "levels = $levels, level{$u *** $server} = ".$level{"$u *** $server"}."\n" if ($debug > 1); 30038032Speter # If the new server is the current one, 30138032Speter # it would have expanded things for us 30238032Speter # if it could have. Mx records must be 30338032Speter # followed to compare server names. 30438032Speter # We are also done if the recursion 30538032Speter # count has been exceeded. 30638032Speter if (&trhost($newmxhost) eq &trhost($server) || ($levels && $level{"$u *** $server"} >= $levels)) { 30738032Speter if ($valid) { 30838032Speter push(@isValid, &validAddr($newaddr)); 30938032Speter push(@toFinal,$newaddr,$newmxhost,$newname); 31038032Speter } else { 31138032Speter &verbose(&final($newaddr,$newmxhost,$newname)); 31238032Speter } 31338032Speter } else { 31438032Speter # more work to do... 31538032Speter if ($valid) { 31638032Speter push(@isValid, &validAddr($newaddr)); 31738032Speter push(@toExpn,$newmxhost,$newaddr,$newname,$level{"$u *** $server"}); 31838032Speter } else { 31938032Speter &verbose(&expn($newmxhost,$newaddr,$newname,$level{"$u *** $server"})); 32038032Speter } 32138032Speter } 32238032Speter } 32338032Speter last if ($done eq " "); 32438032Speter next; 32538032Speter } 32638032Speter # 550 is a known code... Should the be 32738032Speter # included in -a output? Might be a bug 32838032Speter # here. Does it matter? Can assume that 32938032Speter # there won't be UNKNOWN USER responses 33038032Speter # mixed with valid users? 33138032Speter if ($s =~ /^(550)([- ])/) { 33238032Speter if ($valid) { 33338032Speter print STDERR "\@$server:$u ($oldname) USER UNKNOWN\n"; 33438032Speter } else { 33538032Speter &verbose(&final($u,$server,$oldname,"USER UNKNOWN")); 33638032Speter } 33738032Speter last if ($2 eq " "); 33838032Speter next; 33938032Speter } 34038032Speter # 553 is a known code... 34138032Speter if ($s =~ /^(553)([- ])/) { 34238032Speter if ($valid) { 34338032Speter print STDERR "\@$server:$u ($oldname) USER AMBIGUOUS\n"; 34438032Speter } else { 34538032Speter &verbose(&final($u,$server,$oldname,"USER AMBIGUOUS")); 34638032Speter } 34738032Speter last if ($2 eq " "); 34838032Speter next; 34938032Speter } 35038032Speter # 252 is a known code... 35138032Speter if ($s =~ /^(252)([- ])/) { 35238032Speter if ($valid) { 35338032Speter print STDERR "\@$server:$u ($oldname) REFUSED TO VRFY\n"; 35438032Speter } else { 35538032Speter &verbose(&final($u,$server,$oldname,"REFUSED TO VRFY")); 35638032Speter } 35738032Speter last if ($2 eq " "); 35838032Speter next; 35938032Speter } 36038032Speter &giveup('',"$server: did not grok '$s'",$u); 36138032Speter last USER; 36238032Speter } 36338032Speter 36438032Speter if ($valid) { 36538032Speter # 36638032Speter # now we decide if we are going to take these 36738032Speter # expansions or roll them back. 36838032Speter # 36938032Speter $avgValid = &average(@isValid); 37038032Speter print "avgValid = $avgValid\n" if $debug; 37138032Speter if ($avgValid >= $validRequirement) { 37238032Speter print &compact($u,$server)." ->\n" if $verbose; 37338032Speter while (@toExpn) { 37438032Speter &verbose(&expn(splice(@toExpn,0,4))); 37538032Speter } 37638032Speter while (@toFinal) { 37738032Speter &verbose(&final(splice(@toFinal,0,3))); 37838032Speter } 37938032Speter } else { 38038032Speter print "Tossing some valid to avoid invalid ".&compact($u,$server)."\n" if ($avgValid > 0.0 && ($vw || $debug)); 38138032Speter print &compact($u,$server)." ->\n" if $verbose; 38238032Speter &verbose(&final($u,$server,$newname)); 38338032Speter } 38438032Speter } 38538032Speter } 38638032Speter 38738032Speter &alarm("sending 'quit' to $server",''); 38838032Speter $0 = "$av0 - sending 'quit' to $server"; 38938032Speter &ps("quit"); 39038032Speter while(<$S>) { 39138032Speter print if $watch; 39238032Speter last if /^\d+ /; 39338032Speter } 39438032Speter close($S); 39538032Speter alarm(0); 39638032Speter} 39738032Speter 39838032Speter$0 = "$av0 - printing final results"; 39938032Speterprint "----------\n" if $vw; 40038032Speterselect(STDOUT); 40138032Speterfor $f (sort @final) { 40238032Speter print "$f\n"; 40338032Speter} 40438032Speterunlink("/tmp/expn$$"); 40538032Speterexit(0); 40638032Speter 40738032Speter 40838032Speter# abandon all attempts deliver to $server 40938032Speter# register the current addresses as the final ones 41038032Spetersub giveup 41138032Speter{ 41238032Speter local($redirect_okay,$reason,$user) = @_; 41338032Speter local($us,@so,$nh,@remaining_users); 41438032Speter local($pk,$file,$line); 41538032Speter ($pk, $file, $line) = caller; 41638032Speter 41738032Speter $0 = "$av0 - giving up on $server: $reason"; 41838032Speter # 41938032Speter # add back a user if we gave up in the middle 42038032Speter # 42138032Speter push(@users,$user) if $user; 42238032Speter # 42338032Speter # don't bother with this system anymore 42438032Speter # 42538032Speter unless ($giveup{$server}) { 42638032Speter $giveup{$server} = $reason; 42738032Speter print STDERR "$reason\n"; 42838032Speter } 42938032Speter print "Giveup at $file:$line!!! redirect okay = $redirect_okay; $reason\n" if $debug; 43038032Speter # 43138032Speter # Wait! 43238032Speter # Before giving up, see if there is a chance that 43338032Speter # there is another host to redirect to! 43438032Speter # (Kids, don't do this at home! Hacking is a dangerous 43538032Speter # crime and you could end up behind bars.) 43638032Speter # 43738032Speter for $u (@users) { 43838032Speter if ($redirect_okay =~ /\bmx\b/) { 43938032Speter next if &try_fallback('mx',$u,*server, 44038032Speter *mx_secondary, 44138032Speter *already_mx_fellback); 44238032Speter } 44338032Speter if ($redirect_okay =~ /\bdomainify\b/) { 44438032Speter next if &try_fallback('domainify',$u,*server, 44538032Speter *domainify_fallback, 44638032Speter *already_domainify_fellback); 44738032Speter } 44838032Speter push(@remaining_users,$u); 44938032Speter } 45038032Speter @users = @remaining_users; 45138032Speter for $u (@users) { 45238032Speter print &compact($u,$server)." ->\n" if ($verbose && $valid && $u); 45338032Speter &verbose(&final($u,$server,$names{"$u *** $server"},$reason)); 45438032Speter } 45538032Speter} 45638032Speter# 45738032Speter# This routine is used only within &giveup. It checks to 45838032Speter# see if we really have to giveup or if there is a second 45938032Speter# chance because we did something before that can be 46038032Speter# backtracked. 46138032Speter# 46238032Speter# %fallback{"$user *** $host"} tracks what is able to fallback 46338032Speter# %fellback{"$user *** $host"} tracks what has fallen back 46438032Speter# 46538032Speter# If there is a valid backtrack, then queue up the new possibility 46638032Speter# 46738032Spetersub try_fallback 46838032Speter{ 46938032Speter local($method,$user,*host,*fall_table,*fellback) = @_; 47038032Speter local($us,$fallhost,$oldhost,$ft,$i); 47138032Speter 47238032Speter if ($debug > 8) { 47338032Speter print "Fallback table $method:\n"; 47438032Speter for $i (sort keys %fall_table) { 47538032Speter print "\t'$i'\t\t'$fall_table{$i}'\n"; 47638032Speter } 47738032Speter print "Fellback table $method:\n"; 47838032Speter for $i (sort keys %fellback) { 47938032Speter print "\t'$i'\t\t'$fellback{$i}'\n"; 48038032Speter } 48138032Speter print "U: $user H: $host\n"; 48238032Speter } 48338032Speter 48438032Speter $us = "$user *** $host"; 48538032Speter if (defined $fellback{$us}) { 48638032Speter # 48738032Speter # Undo a previous fallback so that we can try again 48838032Speter # Nested fallbacks are avoided because they could 48938032Speter # lead to infinite loops 49038032Speter # 49138032Speter $fallhost = $fellback{$us}; 49238032Speter print "Already $method fell back from $us -> \n" if $debug; 49338032Speter $us = "$user *** $fallhost"; 49438032Speter $oldhost = $fallhost; 49538032Speter } elsif (($method eq 'mx') && (defined $mxbacktrace{$us}) && (defined $mx_secondary{$mxbacktrace{$us}})) { 49638032Speter print "Fallback an MX expansion $us -> \n" if $debug; 49738032Speter $oldhost = $mxbacktrace{$us}; 49838032Speter } else { 49938032Speter print "Oldhost($host, $us) = " if $debug; 50038032Speter $oldhost = $host; 50138032Speter } 50238032Speter print "$oldhost\n" if $debug; 50338032Speter if (((defined $fall_table{$us}) && ($ft = $us)) || ((defined $fall_table{$oldhost}) && ($ft = $oldhost))) { 50438032Speter print "$method Fallback = ".$fall_table{$ft}."\n" if $debug; 50538032Speter local(@so,$newhost); 50638032Speter @so = split(' ',$fall_table{$ft}); 50738032Speter $newhost = shift(@so); 50838032Speter print "Falling back ($method) $us -> $newhost (from $oldhost)\n" if $debug; 50938032Speter if ($method eq 'mx') { 51038032Speter if (! defined ($mxbacktrace{"$user *** $newhost"})) { 51138032Speter if (defined $mxbacktrace{"$user *** $oldhost"}) { 51238032Speter print "resetting oldhost $oldhost to the original: " if $debug; 51338032Speter $oldhost = $mxbacktrace{"$user *** $oldhost"}; 51438032Speter print "$oldhost\n" if $debug; 51538032Speter } 51638032Speter $mxbacktrace{"$user *** $newhost"} = $oldhost; 51738032Speter print "mxbacktrace $user *** $newhost -> $oldhost\n" if $debug; 51838032Speter } 51938032Speter $mx{&trhost($oldhost)} = $newhost; 52038032Speter } else { 52138032Speter $temporary_redirect{$us} = $newhost; 52238032Speter } 52338032Speter if (@so) { 52438032Speter print "Can still $method $us: @so\n" if $debug; 52538032Speter $fall_table{$ft} = join(' ',@so); 52638032Speter } else { 52738032Speter print "No more fallbacks for $us\n" if $debug; 52838032Speter delete $fall_table{$ft}; 52938032Speter } 53038032Speter if (defined $create_host_backtrack{$us}) { 53138032Speter $create_host_backtrack{"$user *** $newhost"} 53238032Speter = $create_host_backtrack{$us}; 53338032Speter } 53438032Speter $fellback{"$user *** $newhost"} = $oldhost; 53538032Speter &expn($newhost,$user,$names{$us},$level{$us}); 53638032Speter return 1; 53738032Speter } 53838032Speter delete $temporary_redirect{$us}; 53938032Speter $host = $oldhost; 54038032Speter return 0; 54138032Speter} 54238032Speter# return 1 if you could send mail to the address as is. 54338032Spetersub validAddr 54438032Speter{ 54538032Speter local($addr) = @_; 54638032Speter $res = &do_validAddr($addr); 54738032Speter print "validAddr($addr) = $res\n" if $debug; 54838032Speter $res; 54938032Speter} 55038032Spetersub do_validAddr 55138032Speter{ 55238032Speter local($addr) = @_; 55338032Speter local($urx) = "[-A-Za-z_.0-9+]+"; 55438032Speter 55538032Speter # \u 55638032Speter return 0 if ($addr =~ /^\\/); 55738032Speter # ?@h 55838032Speter return 1 if ($addr =~ /.\@$urx$/); 55938032Speter # @h:? 56038032Speter return 1 if ($addr =~ /^\@$urx\:./); 56138032Speter # h!u 56238032Speter return 1 if ($addr =~ /^$urx!./); 56338032Speter # u 56438032Speter return 1 if ($addr =~ /^$urx$/); 56538032Speter # ? 56638032Speter print "validAddr($addr) = ???\n" if $debug; 56738032Speter return 0; 56838032Speter} 56938032Speter# Some systems use expn and vrfy interchangeably. Some only 57038032Speter# implement one or the other. Some check expn against mailing 57138032Speter# lists and vrfy against users. It doesn't appear to be 57238032Speter# consistent. 57338032Speter# 57438032Speter# So, what do we do? We try everything! 57538032Speter# 57638032Speter# 57738032Speter# Ranking of result codes: good: 250, 251/551, 252, 550, anything else 57838032Speter# 57938032Speter# Ranking of inputs: best: user@host.domain, okay: user 58038032Speter# 58138032Speter# Return value: $error_string, @responses_from_server 58238032Spetersub expn_vrfy 58338032Speter{ 58438032Speter local($u,$server) = @_; 58538032Speter local(@c) = ('expn', 'vrfy'); 58638032Speter local(@try_u) = $u; 58738032Speter local(@ret,$code); 58838032Speter 58938032Speter if (($u =~ /(.+)@(.+)/) && (&trhost($2) eq &trhost($server))) { 59038032Speter push(@try_u,$1); 59138032Speter } 59238032Speter 59338032Speter TRY: 59438032Speter for $c (@c) { 59538032Speter for $try_u (@try_u) { 59638032Speter &alarm("${c}'ing $try_u on $server",'',$u); 59738032Speter &ps("$c $try_u"); 59838032Speter alarm(0); 59938032Speter $s = <$S>; 60038032Speter if ($s eq '') { 60138032Speter return "$server: lost connection"; 60238032Speter } 60338032Speter if ($s !~ /^(\d+)([- ])/) { 60438032Speter return "$server: garbled reply to '$c $try_u'"; 60538032Speter } 60638032Speter if ($1 == 250) { 60738032Speter $code = 250; 60838032Speter @ret = ("",$s); 60938032Speter push(@ret,&read_response($2,$debug)); 61038032Speter return (@ret); 61138032Speter } 61238032Speter if ($1 == 551 || $1 == 251) { 61338032Speter $code = $1; 61438032Speter @ret = ("",$s); 61538032Speter push(@ret,&read_response($2,$debug)); 61638032Speter next; 61738032Speter } 61838032Speter if ($1 == 252 && ($code == 0 || $code == 550)) { 61938032Speter $code = 252; 62038032Speter @ret = ("",$s); 62138032Speter push(@ret,&read_response($2,$watch)); 62238032Speter next; 62338032Speter } 62438032Speter if ($1 == 550 && $code == 0) { 62538032Speter $code = 550; 62638032Speter @ret = ("",$s); 62738032Speter push(@ret,&read_response($2,$watch)); 62838032Speter next; 62938032Speter } 63038032Speter &read_response($2,$watch); 63138032Speter } 63238032Speter } 63338032Speter return "$server: expn/vrfy not implemented" unless @ret; 63438032Speter return @ret; 63538032Speter} 63638032Speter# sometimes the old parse routine (now parse2) didn't 63738032Speter# reject funky addresses. 63838032Spetersub parse 63938032Speter{ 64038032Speter local($oldaddr,$server,$oldname,$one_to_one) = @_; 64138032Speter local($newhost, $newaddr, $newname, $um) = &parse2($oldaddr,$server,$oldname,$one_to_one); 64238032Speter if ($newaddr =~ m,^["/],) { 64338032Speter return (undef, $oldaddr, $newname) if $valid; 64438032Speter return (undef, $um, $newname); 64538032Speter } 64638032Speter return ($newhost, $newaddr, $newname); 64738032Speter} 64838032Speter 64938032Speter# returns ($new_smtp_server,$new_address,$new_name) 65038032Speter# given a response from a SMTP server ($newaddr), the 65138032Speter# current host ($server), the old "name" and a flag that 65238032Speter# indicates if it is being called during the initial 65338032Speter# command line parsing ($parsing_args) 65438032Spetersub parse2 65538032Speter{ 65638032Speter local($newaddr,$context_host,$old_name,$parsing_args) = @_; 65738032Speter local(@names) = $old_name; 65838032Speter local($urx) = "[-A-Za-z_.0-9+]+"; 65938032Speter local($unmangle); 66038032Speter 66138032Speter # 66238032Speter # first, separate out the address part. 66338032Speter # 66438032Speter 66538032Speter # 66638032Speter # [NAME] <ADDR [(NAME)]> 66738032Speter # [NAME] <[(NAME)] ADDR 66838032Speter # ADDR [(NAME)] 66938032Speter # (NAME) ADDR 67038032Speter # [(NAME)] <ADDR> 67138032Speter # 67238032Speter if ($newaddr =~ /^\<(.*)\>$/) { 67338032Speter print "<A:$1>\n" if $debug; 67438032Speter ($newaddr) = &trim($1); 67538032Speter print "na = $newaddr\n" if $debug; 67638032Speter } 67738032Speter if ($newaddr =~ /^([^\<\>]*)\<([^\<\>]*)\>([^\<\>]*)$/) { 67838032Speter # address has a < > pair in it. 67938032Speter print "N:$1 <A:$2> N:$3\n" if $debug; 68038032Speter ($newaddr) = &trim($2); 68138032Speter unshift(@names, &trim($3,$1)); 68238032Speter print "na = $newaddr\n" if $debug; 68338032Speter } 68438032Speter if ($newaddr =~ /^([^\(\)]*)\(([^\(\)]*)\)([^\(\)]*)$/) { 68538032Speter # address has a ( ) pair in it. 68638032Speter print "A:$1 (N:$2) A:$3\n" if $debug; 68738032Speter unshift(@names,&trim($2)); 68838032Speter local($f,$l) = (&trim($1),&trim($3)); 68938032Speter if (($f && $l) || !($f || $l)) { 69038032Speter # address looks like: 69138032Speter # foo (bar) baz or (bar) 69238032Speter # not allowed! 69338032Speter print STDERR "Could not parse $newaddr\n" if $vw; 69438032Speter return(undef,$newaddr,&firstname(@names)); 69538032Speter } 69638032Speter $newaddr = $f if $f; 69738032Speter $newaddr = $l if $l; 69838032Speter print "newaddr now = $newaddr\n" if $debug; 69938032Speter } 70038032Speter # 70138032Speter # @foo:bar 70238032Speter # j%k@l 70338032Speter # a@b 70438032Speter # b!a 70538032Speter # a 70638032Speter # 70738032Speter $unmangle = $newaddr; 70838032Speter if ($newaddr =~ /^\@($urx)\:(.+)$/) { 70938032Speter print "(\@:)" if $debug; 71038032Speter # this is a bit of a cheat, but it seems necessary 71138032Speter return (&domainify($1,$context_host,$2),$2,&firstname(@names),$unmangle); 71238032Speter } 71338032Speter if ($newaddr =~ /^(.+)\@($urx)$/) { 71438032Speter print "(\@)" if $debug; 71538032Speter return (&domainify($2,$context_host,$newaddr),$newaddr,&firstname(@names),$unmangle); 71638032Speter } 71738032Speter if ($parsing_args) { 71838032Speter if ($newaddr =~ /^($urx)\!(.+)$/) { 71938032Speter return (&domainify($1,$context_host,$newaddr),$newaddr,&firstname(@names),$unmangle); 72038032Speter } 72138032Speter if ($newaddr =~ /^($urx)$/) { 72238032Speter return ($context_host,$newaddr,&firstname(@names),$unmangle); 72338032Speter } 72438032Speter print STDERR "Could not parse $newaddr\n"; 72538032Speter } 72638032Speter print "(?)" if $debug; 72738032Speter return(undef,$newaddr,&firstname(@names),$unmangle); 72838032Speter} 72938032Speter# return $u (@$server) unless $u includes reference to $server 73038032Spetersub compact 73138032Speter{ 73238032Speter local($u, $server) = @_; 73338032Speter local($se) = $server; 73438032Speter local($sp); 73538032Speter $se =~ s/(\W)/\\$1/g; 73638032Speter $sp = " (\@$server)"; 73738032Speter if ($u !~ /$se/i) { 73838032Speter return "$u$sp"; 73938032Speter } 74038032Speter return $u; 74138032Speter} 74238032Speter# remove empty (spaces don't count) members from an array 74338032Spetersub trim 74438032Speter{ 74538032Speter local(@v) = @_; 74638032Speter local($v,@r); 74738032Speter for $v (@v) { 74838032Speter $v =~ s/^\s+//; 74938032Speter $v =~ s/\s+$//; 75038032Speter push(@r,$v) if ($v =~ /\S/); 75138032Speter } 75238032Speter return(@r); 75338032Speter} 75438032Speter# using the host part of an address, and the server name, add the 75538032Speter# servers' domain to the address if it doesn't already have a 75638032Speter# domain. Since this sometimes fails, save a back reference so 75738032Speter# it can be unrolled. 75838032Spetersub domainify 75938032Speter{ 76038032Speter local($host,$domain_host,$u) = @_; 76138032Speter local($domain,$newhost); 76238032Speter 76338032Speter # cut of trailing dots 76438032Speter $host =~ s/\.$//; 76538032Speter $domain_host =~ s/\.$//; 76638032Speter 76738032Speter if ($domain_host !~ /\./) { 76838032Speter # 76938032Speter # domain host isn't, keep $host whatever it is 77038032Speter # 77138032Speter print "domainify($host,$domain_host) = $host\n" if $debug; 77238032Speter return $host; 77338032Speter } 77438032Speter 77538032Speter # 77638032Speter # There are several weird situtations that need to be 77738032Speter # accounted for. They have to do with domain relay hosts. 77838032Speter # 77938032Speter # Examples: 78038032Speter # host server "right answer" 78138032Speter # 78238032Speter # shiva.cs cs.berkeley.edu shiva.cs.berkeley.edu 78338032Speter # shiva cs.berkeley.edu shiva.cs.berekley.edu 78438032Speter # cumulus reed.edu @reed.edu:cumulus.uucp 78538032Speter # tiberius tc.cornell.edu tiberius.tc.cornell.edu 78638032Speter # 78738032Speter # The first try must always be to cut the domain part out of 78838032Speter # the server and tack it onto the host. 78938032Speter # 79038032Speter # A reasonable second try is to tack the whole server part onto 79138032Speter # the host and for each possible repeated element, eliminate 79238032Speter # just that part. 79338032Speter # 79438032Speter # These extra "guesses" get put into the %domainify_fallback 79538032Speter # array. They will be used to give addresses a second chance 79638032Speter # in the &giveup routine 79738032Speter # 79838032Speter 79938032Speter local(%fallback); 80038032Speter 80138032Speter local($long); 80238032Speter $long = "$host $domain_host"; 80338032Speter $long =~ tr/A-Z/a-z/; 80438032Speter print "long = $long\n" if $debug; 80538032Speter if ($long =~ s/^([^ ]+\.)([^ ]+) \2(\.[^ ]+\.[^ ]+)/$1$2$3/) { 80638032Speter # matches shiva.cs cs.berkeley.edu and returns shiva.cs.berkeley.edu 80738032Speter print "condensed fallback $host $domain_host -> $long\n" if $debug; 80838032Speter $fallback{$long} = 9; 80938032Speter } 81038032Speter 81138032Speter local($fh); 81238032Speter $fh = $domain_host; 81338032Speter while ($fh =~ /\./) { 81438032Speter print "FALLBACK $host.$fh = 1\n" if $debug > 7; 81538032Speter $fallback{"$host.$fh"} = 1; 81638032Speter $fh =~ s/^[^\.]+\.//; 81738032Speter } 81838032Speter 81938032Speter $fallback{"$host.$domain_host"} = 2; 82038032Speter 82138032Speter ($domain = $domain_host) =~ s/^[^\.]+//; 82238032Speter $fallback{"$host$domain"} = 6 82338032Speter if ($domain =~ /\./); 82438032Speter 82538032Speter if ($host =~ /\./) { 82638032Speter # 82738032Speter # Host is already okay, but let's look for multiple 82838032Speter # interpretations 82938032Speter # 83038032Speter print "domainify($host,$domain_host) = $host\n" if $debug; 83138032Speter delete $fallback{$host}; 83238032Speter $domainify_fallback{"$u *** $host"} = join(' ',sort {$fallback{$b} <=> $fallback{$a};} keys %fallback) if %fallback; 83338032Speter return $host; 83438032Speter } 83538032Speter 83638032Speter $domain = ".$domain_host" 83738032Speter if ($domain !~ /\..*\./); 83838032Speter $newhost = "$host$domain"; 83938032Speter 84038032Speter $create_host_backtrack{"$u *** $newhost"} = $domain_host; 84138032Speter print "domainify($host,$domain_host) = $newhost\n" if $debug; 84238032Speter delete $fallback{$newhost}; 84338032Speter $domainify_fallback{"$u *** $newhost"} = join(' ',sort {$fallback{$b} <=> $fallback{$a};} keys %fallback) if %fallback; 84438032Speter if ($debug) { 84538032Speter print "fallback = "; 84638032Speter print $domainify_fallback{"$u *** $newhost"} 84738032Speter if defined($domainify_fallback{"$u *** $newhost"}); 84838032Speter print "\n"; 84938032Speter } 85038032Speter return $newhost; 85138032Speter} 85238032Speter# return the first non-empty element of an array 85338032Spetersub firstname 85438032Speter{ 85538032Speter local(@names) = @_; 85638032Speter local($n); 85738032Speter while(@names) { 85838032Speter $n = shift(@names); 85938032Speter return $n if $n =~ /\S/; 86038032Speter } 86138032Speter return undef; 86238032Speter} 86338032Speter# queue up more addresses to expand 86438032Spetersub expn 86538032Speter{ 86638032Speter local($host,$addr,$name,$level) = @_; 86738032Speter if ($host) { 86838032Speter $host = &trhost($host); 86938032Speter 87038032Speter if (($debug > 3) || (defined $giveup{$host})) { 87138032Speter unshift(@hosts,$host) unless $users{$host}; 87238032Speter } else { 87338032Speter push(@hosts,$host) unless $users{$host}; 87438032Speter } 87538032Speter $users{$host} .= " $addr"; 87638032Speter $names{"$addr *** $host"} = $name; 87738032Speter $level{"$addr *** $host"} = $level + 1; 87838032Speter print "expn($host,$addr,$name)\n" if $debug; 87938032Speter return "\t$addr\n"; 88038032Speter } else { 88138032Speter return &final($addr,'NONE',$name); 88238032Speter } 88338032Speter} 88438032Speter# compute the numerical average value of an array 88538032Spetersub average 88638032Speter{ 88738032Speter local(@e) = @_; 88838032Speter return 0 unless @e; 88938032Speter local($e,$sum); 89038032Speter for $e (@e) { 89138032Speter $sum += $e; 89238032Speter } 89338032Speter $sum / @e; 89438032Speter} 89538032Speter# print to the server (also to stdout, if -w) 89638032Spetersub ps 89738032Speter{ 89838032Speter local($p) = @_; 89938032Speter print ">>> $p\n" if $watch; 90038032Speter print $S "$p\n"; 90138032Speter} 90238032Speter# return case-adjusted name for a host (for comparison purposes) 90338032Spetersub trhost 90438032Speter{ 90538032Speter # treat foo.bar as an alias for Foo.BAR 90638032Speter local($host) = @_; 90738032Speter local($trhost) = $host; 90838032Speter $trhost =~ tr/A-Z/a-z/; 90938032Speter if ($trhost{$trhost}) { 91038032Speter $host = $trhost{$trhost}; 91138032Speter } else { 91238032Speter $trhost{$trhost} = $host; 91338032Speter } 91438032Speter $trhost{$trhost}; 91538032Speter} 91638032Speter# re-queue users if an mx record dictates a redirect 91738032Speter# don't allow a user to be redirected more than once 91838032Spetersub mxredirect 91938032Speter{ 92038032Speter local($server,*users) = @_; 92138032Speter local($u,$nserver,@still_there); 92238032Speter 92338032Speter $nserver = &mx($server); 92438032Speter 92538032Speter if (&trhost($nserver) ne &trhost($server)) { 92638032Speter $0 = "$av0 - mx redirect $server -> $nserver\n"; 92738032Speter for $u (@users) { 92838032Speter if (defined $mxbacktrace{"$u *** $nserver"}) { 92938032Speter push(@still_there,$u); 93038032Speter } else { 93138032Speter $mxbacktrace{"$u *** $nserver"} = $server; 93238032Speter print "mxbacktrace{$u *** $nserver} = $server\n" 93338032Speter if ($debug > 1); 93438032Speter &expn($nserver,$u,$names{"$u *** $server"}); 93538032Speter } 93638032Speter } 93738032Speter @users = @still_there; 93838032Speter if (! @users) { 93938032Speter return $nserver; 94038032Speter } else { 94138032Speter return undef; 94238032Speter } 94338032Speter } 94438032Speter return undef; 94538032Speter} 94638032Speter# follow mx records, return a hostname 94738032Speter# also follow temporary redirections comming from &domainify and 94838032Speter# &mxlookup 94938032Spetersub mx 95038032Speter{ 95138032Speter local($h,$u) = @_; 95238032Speter 95338032Speter for (;;) { 95438032Speter if (defined $mx{&trhost($h)} && $h ne $mx{&trhost($h)}) { 95538032Speter $0 = "$av0 - mx expand $h"; 95638032Speter $h = $mx{&trhost($h)}; 95738032Speter return $h; 95838032Speter } 95938032Speter if ($u) { 96038032Speter if (defined $temporary_redirect{"$u *** $h"}) { 96138032Speter $0 = "$av0 - internal redirect $h"; 96238032Speter print "Temporary redirect taken $u *** $h -> " if $debug; 96338032Speter $h = $temporary_redirect{"$u *** $h"}; 96438032Speter print "$h\n" if $debug; 96538032Speter next; 96638032Speter } 96738032Speter $htr = &trhost($h); 96838032Speter if (defined $temporary_redirect{"$u *** $htr"}) { 96938032Speter $0 = "$av0 - internal redirect $h"; 97038032Speter print "temporary redirect taken $u *** $h -> " if $debug; 97138032Speter $h = $temporary_redirect{"$u *** $htr"}; 97238032Speter print "$h\n" if $debug; 97338032Speter next; 97438032Speter } 97538032Speter } 97638032Speter return $h; 97738032Speter } 97838032Speter} 97938032Speter# look up mx records with the name server. 98038032Speter# re-queue expansion requests if possible 98138032Speter# optionally give up on this host. 98238032Spetersub mxlookup 98338032Speter{ 98438032Speter local($lastchance,$server,$giveup,*users) = @_; 98538032Speter local(*T); 98638032Speter local(*NSLOOKUP); 98738032Speter local($nh, $pref,$cpref); 98838032Speter local($o0) = $0; 98938032Speter local($nserver); 99038032Speter local($name,$aliases,$type,$len,$thataddr); 99138032Speter local(%fallback); 99238032Speter 99338032Speter return 1 if &mxredirect($server,*users); 99438032Speter 99538032Speter if ((defined $mx{$server}) || (! $have_nslookup)) { 99638032Speter return 0 unless $lastchance; 99738032Speter &giveup('mx domainify',$giveup); 99838032Speter return 0; 99938032Speter } 100038032Speter 100138032Speter $0 = "$av0 - nslookup of $server"; 100238032Speter open(T,">/tmp/expn$$") || die "open > /tmp/expn$$: $!\n"; 100338032Speter print T "set querytype=MX\n"; 100438032Speter print T "$server\n"; 100538032Speter close(T); 100638032Speter $cpref = 1.0E12; 100738032Speter undef $nserver; 100838032Speter open(NSLOOKUP,"nslookup < /tmp/expn$$ 2>&1 |") || die "open nslookup: $!"; 100938032Speter while(<NSLOOKUP>) { 101038032Speter print if ($debug > 2); 101138032Speter if (/mail exchanger = ([-A-Za-z_.0-9+]+)/) { 101238032Speter $nh = $1; 101338032Speter if (/preference = (\d+)/) { 101438032Speter $pref = $1; 101538032Speter if ($pref < $cpref) { 101638032Speter $nserver = $nh; 101738032Speter $cpref = $pref; 101838032Speter } elsif ($pref) { 101938032Speter $fallback{$pref} .= " $nh"; 102038032Speter } 102138032Speter } 102238032Speter } 102338032Speter if (/Non-existent domain/) { 102438032Speter # 102538032Speter # These addresss are hosed. Kaput! Dead! 102638032Speter # However, if we created the address in the 102738032Speter # first place then there is a chance of 102838032Speter # salvation. 102938032Speter # 103038032Speter 1 while(<NSLOOKUP>); 103138032Speter close(NSLOOKUP); 103238032Speter return 0 unless $lastchance; 103338032Speter &giveup('domainify',"$server: Non-existent domain",undef,1); 103438032Speter return 0; 103538032Speter } 103638032Speter 103738032Speter } 103838032Speter close(NSLOOKUP); 103938032Speter unlink("/tmp/expn$$"); 104038032Speter unless ($nserver) { 104138032Speter $0 = "$o0 - finished mxlookup"; 104238032Speter return 0 unless $lastchance; 104338032Speter &giveup('mx domainify',"$server: Could not resolve address"); 104438032Speter return 0; 104538032Speter } 104638032Speter 104738032Speter # provide fallbacks in case $nserver doesn't work out 104838032Speter if (defined $fallback{$cpref}) { 104938032Speter $mx_secondary{$server} = $fallback{$cpref}; 105038032Speter } 105138032Speter 105238032Speter $0 = "$av0 - gethostbyname($nserver)"; 105338032Speter ($name,$aliases,$type,$len,$thataddr) = gethostbyname($nserver); 105438032Speter 105538032Speter unless ($thataddr) { 105638032Speter $0 = $o0; 105738032Speter return 0 unless $lastchance; 105838032Speter &giveup('mx domainify',"$nserver: could not resolve address"); 105938032Speter return 0; 106038032Speter } 106138032Speter print "MX($server) = $nserver\n" if $debug; 106238032Speter print "$server -> $nserver\n" if $vw && !$debug; 106338032Speter $mx{&trhost($server)} = $nserver; 106438032Speter # redeploy the users 106538032Speter unless (&mxredirect($server,*users)) { 106638032Speter return 0 unless $lastchance; 106738032Speter &giveup('mx domainify',"$nserver: only one level of mx redirect allowed"); 106838032Speter return 0; 106938032Speter } 107038032Speter $0 = "$o0 - finished mxlookup"; 107138032Speter return 1; 107238032Speter} 107338032Speter# if mx expansion did not help to resolve an address 107438032Speter# (ie: foo@bar became @baz:foo@bar, then undo the 107538032Speter# expansion). 107638032Speter# this is only used by &final 107738032Spetersub mxunroll 107838032Speter{ 107938032Speter local(*host,*addr) = @_; 108038032Speter local($r) = 0; 108138032Speter print "looking for mxbacktrace{$addr *** $host}\n" 108238032Speter if ($debug > 1); 108338032Speter while (defined $mxbacktrace{"$addr *** $host"}) { 108438032Speter print "Unrolling MX expnasion: \@$host:$addr -> " 108538032Speter if ($debug || $verbose); 108638032Speter $host = $mxbacktrace{"$addr *** $host"}; 108738032Speter print "\@$host:$addr\n" 108838032Speter if ($debug || $verbose); 108938032Speter $r = 1; 109038032Speter } 109138032Speter return 1 if $r; 109238032Speter $addr = "\@$host:$addr" 109338032Speter if ($host =~ /\./); 109438032Speter return 0; 109538032Speter} 109638032Speter# register a completed expnasion. Make the final address as 109738032Speter# simple as possible. 109838032Spetersub final 109938032Speter{ 110038032Speter local($addr,$host,$name,$error) = @_; 110138032Speter local($he); 110238032Speter local($hb,$hr); 110338032Speter local($au,$ah); 110438032Speter 110538032Speter if ($error =~ /Non-existent domain/) { 110638032Speter # 110738032Speter # If we created the domain, then let's undo the 110838032Speter # damage... 110938032Speter # 111038032Speter if (defined $create_host_backtrack{"$addr *** $host"}) { 111138032Speter while (defined $create_host_backtrack{"$addr *** $host"}) { 111238032Speter print "Un&domainifying($host) = " if $debug; 111338032Speter $host = $create_host_backtrack{"$addr *** $host"}; 111438032Speter print "$host\n" if $debug; 111538032Speter } 111638032Speter $error = "$host: could not locate"; 111738032Speter } else { 111838032Speter # 111938032Speter # If we only want valid addresses, toss out 112038032Speter # bad host names. 112138032Speter # 112238032Speter if ($valid) { 112338032Speter print STDERR "\@$host:$addr ($name) Non-existent domain\n"; 112438032Speter return ""; 112538032Speter } 112638032Speter } 112738032Speter } 112838032Speter 112938032Speter MXUNWIND: { 113038032Speter $0 = "$av0 - final parsing of \@$host:$addr"; 113138032Speter ($he = $host) =~ s/(\W)/\\$1/g; 113238032Speter if ($addr !~ /@/) { 113338032Speter # addr does not contain any host 113438032Speter $addr = "$addr@$host"; 113538032Speter } elsif ($addr !~ /$he/i) { 113638032Speter # if host part really something else, use the something 113738032Speter # else. 113838032Speter if ($addr =~ m/(.*)\@([^\@]+)$/) { 113938032Speter ($au,$ah) = ($1,$2); 114038032Speter print "au = $au ah = $ah\n" if $debug; 114138032Speter if (defined $temporary_redirect{"$addr *** $ah"}) { 114238032Speter $addr = "$au\@".$temporary_redirect{"$addr *** $ah"}; 114338032Speter print "Rewrite! to $addr\n" if $debug; 114438032Speter next MXUNWIND; 114538032Speter } 114638032Speter } 114738032Speter # addr does not contain full host 114838032Speter if ($valid) { 114938032Speter if ($host =~ /^([^\.]+)(\..+)$/) { 115038032Speter # host part has a . in it - foo.bar 115138032Speter ($hb, $hr) = ($1, $2); 115238032Speter if ($addr =~ /\@([^\.\@]+)$/ && ($1 eq $hb)) { 115338032Speter # addr part has not . 115438032Speter # and matches beginning of 115538032Speter # host part -- tack on a 115638032Speter # domain name. 115738032Speter $addr .= $hr; 115838032Speter } else { 115938032Speter &mxunroll(*host,*addr) 116038032Speter && redo MXUNWIND; 116138032Speter } 116238032Speter } else { 116338032Speter &mxunroll(*host,*addr) 116438032Speter && redo MXUNWIND; 116538032Speter } 116638032Speter } else { 116738032Speter $addr = "${addr}[\@$host]" 116838032Speter if ($host =~ /\./); 116938032Speter } 117038032Speter } 117138032Speter } 117238032Speter $name = "$name " if $name; 117338032Speter $error = " $error" if $error; 117438032Speter if ($valid) { 117538032Speter push(@final,"$name<$addr>"); 117638032Speter } else { 117738032Speter push(@final,"$name<$addr>$error"); 117838032Speter } 117938032Speter "\t$name<$addr>$error\n"; 118038032Speter} 118138032Speter 118238032Spetersub alarm 118338032Speter{ 118438032Speter local($alarm_action,$alarm_redirect,$alarm_user) = @_; 118538032Speter alarm(3600); 118638032Speter $SIG{ALRM} = 'handle_alarm'; 118738032Speter} 118838032Speter# this involves one great big ugly hack. 118938032Speter# the "next HOST" unwinds the stack! 119038032Spetersub handle_alarm 119138032Speter{ 119238032Speter &giveup($alarm_redirect,"Timed out during $alarm_action",$alarm_user); 119338032Speter next HOST; 119438032Speter} 119538032Speter 119638032Speter# read the rest of the current smtp daemon's response (and toss it away) 119738032Spetersub read_response 119838032Speter{ 119938032Speter local($done,$watch) = @_; 120038032Speter local(@resp); 120138032Speter print $s if $watch; 120238032Speter while(($done eq "-") && ($s = <$S>) && ($s =~ /^\d+([- ])/)) { 120338032Speter print $s if $watch; 120438032Speter $done = $1; 120538032Speter push(@resp,$s); 120638032Speter } 120738032Speter return @resp; 120838032Speter} 120938032Speter# print args if verbose. Return them in any case 121038032Spetersub verbose 121138032Speter{ 121238032Speter local(@tp) = @_; 121338032Speter print "@tp" if $verbose; 121438032Speter} 121538032Speter# to pass perl -w: 121638032Speter@tp; 121738032Speter$flag_a; 121838032Speter$flag_d; 121938032Speter$flag_1; 122038032Speter%already_domainify_fellback; 122138032Speter%already_mx_fellback; 122238032Speter&handle_alarm; 122338032Speter################### BEGIN PERL/TROFF TRANSITION 122438032Speter.00 ; 122538032Speter 122638032Speter'di 122738032Speter.nr nl 0-1 122838032Speter.nr % 0 122938032Speter.\\"'; __END__ 123038032Speter.\" ############## END PERL/TROFF TRANSITION 123138032Speter.TH EXPN 1 "March 11, 1993" 123238032Speter.AT 3 123338032Speter.SH NAME 123438032Speterexpn \- recursively expand mail aliases 123538032Speter.SH SYNOPSIS 123638032Speter.B expn 123738032Speter.RI [ -a ] 123838032Speter.RI [ -v ] 123938032Speter.RI [ -w ] 124038032Speter.RI [ -d ] 124138032Speter.RI [ -1 ] 124238032Speter.IR user [@ hostname ] 124338032Speter.RI [ user [@ hostname ]]... 124438032Speter.SH DESCRIPTION 124538032Speter.B expn 124638032Speterwill use the SMTP 124738032Speter.B expn 124838032Speterand 124938032Speter.B vrfy 125038032Spetercommands to expand mail aliases. 125138032SpeterIt will first look up the addresses you provide on the command line. 125238032SpeterIf those expand into addresses on other systems, it will 125338032Speterconnect to the other systems and expand again. It will keep 125438032Speterdoing this until no further expansion is possible. 125538032Speter.SH OPTIONS 125638032SpeterThe default output of 125738032Speter.B expn 125838032Spetercan contain many lines which are not valid 125938032Speteremail addresses. With the 126038032Speter.I -aa 126138032Speterflag, only expansions that result in legal addresses 126238032Speterare used. Since many mailing lists have an illegal 126338032Speteraddress or two, the single 126438032Speter.IR -a , 126538032Speteraddress, flag specifies that a few illegal addresses can 126638032Speterbe mixed into the results. More 126738032Speter.I -a 126838032Speterflags vary the ratio. Read the source to track down 126938032Speterthe formula. With the 127038032Speter.I -a 127138032Speteroption, you should be able to construct a new mailing 127238032Speterlist out of an existing one. 127338032Speter.LP 127438032SpeterIf you wish to limit the number of levels deep that 127538032Speter.B expn 127638032Speterwill recurse as it traces addresses, use the 127738032Speter.I -1 127838032Speteroption. For each 127938032Speter.I -1 128038032Speteranother level will be traversed. So, 128138032Speter.I -111 128238032Speterwill traverse no more than three levels deep. 128338032Speter.LP 128438032SpeterThe normal mode of operation for 128538032Speter.B expn 128638032Speteris to do all of its work silently. 128738032SpeterThe following options make it more verbose. 128838032SpeterIt is not necessary to make it verbose to see what it is 128938032Speterdoing because as it works, it changes its 129038032Speter.BR argv [0] 129138032Spetervariable to reflect its current activity. 129238032SpeterTo see how it is expanding things, the 129338032Speter.IR -v , 129438032Speterverbose, flag will cause 129538032Speter.B expn 129638032Speterto show each address before 129738032Speterand after translation as it works. 129838032SpeterThe 129938032Speter.IR -w , 130038032Speterwatch, flag will cause 130138032Speter.B expn 130238032Speterto show you its conversations with the mail daemons. 130338032SpeterFinally, the 130438032Speter.IR -d , 130538032Speterdebug, flag will expose many of the inner workings so that 130638032Speterit is possible to eliminate bugs. 130738032Speter.SH ENVIRONMENT 1308102528SgshapiroNo environment variables are used. 130938032Speter.SH FILES 131038032Speter.PD 0 131138032Speter.B /tmp/expn$$ 131238032Speter.B temporary file used as input to 131338032Speter.BR nslookup . 131438032Speter.SH SEE ALSO 131538032Speter.BR aliases (5), 131638032Speter.BR sendmail (8), 131738032Speter.BR nslookup (8), 131838032SpeterRFC 823, and RFC 1123. 131938032Speter.SH BUGS 132038032SpeterNot all mail daemons will implement 132138032Speter.B expn 132238032Speteror 132338032Speter.BR vrfy . 132438032SpeterIt is not possible to verify addresses that are served 132538032Speterby such daemons. 132638032Speter.LP 132738032SpeterWhen attempting to connect to a system to verify an address, 132838032Speter.B expn 132938032Speteronly tries one IP address. Most mail daemons 133038032Speterwill try harder. 133138032Speter.LP 133238032SpeterIt is assumed that you are running domain names and that 133338032Speterthe 133438032Speter.BR nslookup (8) 133538032Speterprogram is available. If not, 133638032Speter.B expn 133738032Speterwill not be able to verify many addresses. It will also pause 133838032Speterfor a long time unless you change the code where it says 133938032Speter.I $have_nslookup = 1 134038032Speterto read 134138032Speter.I $have_nslookup = 134238032Speter.IR 0 . 134338032Speter.LP 134438032SpeterLastly, 134538032Speter.B expn 134638032Speterdoes not handle every valid address. If you have an example, 134738032Speterplease submit a bug report. 134838032Speter.SH CREDITS 134938032SpeterIn 1986 or so, Jon Broome wrote a program of the same name 135038032Speterthat did about the same thing. It has since suffered bit rot 135138032Speterand Jon Broome has dropped off the face of the earth! 135238032Speter(Jon, if you are out there, drop me a line) 135338032Speter.SH AVAILABILITY 135438032SpeterThe latest version of 135538032Speter.B expn 135638032Speteris available through anonymous ftp at 135738032Speter.IR ftp://ftp.idiom.com/pub/muir-programs/expn . 135838032Speter.SH AUTHOR 135938032Speter.I David Muir Sharnoff\ \ \ \ <muir@idiom.com> 1360