138494Sobrien#!@PERL@ 238494Sobrien'di '; 338494Sobrien'ds 00 \\"'; 438494Sobrien'ig 00 '; 538494Sobrien# 638494Sobrien# THIS PROGRAM IS ITS OWN MANUAL PAGE. INSTALL IN man & bin. 738494Sobrien# 838494Sobrien 938494Sobrien# hardcoded constants, should work fine for BSD-based systems 1038494Sobrien#require 'sys/socket.ph'; # perl 4 1138494Sobrienuse Socket; # perl 5 1238494Sobrien$AF_INET = &AF_INET; 1338494Sobrien$SOCK_STREAM = &SOCK_STREAM; 1438494Sobrien 1538494Sobrien# system requirements: 1638494Sobrien# must have 'nslookup' and 'hostname' programs. 1738494Sobrien 18174294Sobrien# $Header: /home/cvsroot/am-utils/scripts/expn.in,v 1.5 2002/07/11 14:28:20 ezk Exp $ 1938494Sobrien 2038494Sobrien# TODO: 2138494Sobrien# less magic should apply to command-line addresses 2238494Sobrien# less magic should apply to local addresses 2338494Sobrien# add magic to deal with cross-domain cnames 2438494Sobrien 2538494Sobrien# Checklist: (hard addresses) 2638494Sobrien# 250 Kimmo Suominen <"|/usr/local/mh/lib/slocal -user kim"@grendel.tac.nyc.ny.us> 2738494Sobrien# harry@hofmann.cs.Berkeley.EDU -> harry@tenet (.berkeley.edu) [dead] 2838494Sobrien# bks@cs.berkeley.edu -> shiva.CS (.berkeley.edu) [dead] 2938494Sobrien# dan@tc.cornell.edu -> brown@tiberius (.tc.cornell.edu) 3038494Sobrien 3138494Sobrien############################################################################# 3238494Sobrien# 3338494Sobrien# Copyright (c) 1993 David Muir Sharnoff 3438494Sobrien# All rights reserved. 3538494Sobrien# 3638494Sobrien# Redistribution and use in source and binary forms, with or without 3738494Sobrien# modification, are permitted provided that the following conditions 3838494Sobrien# are met: 3938494Sobrien# 1. Redistributions of source code must retain the above copyright 4038494Sobrien# notice, this list of conditions and the following disclaimer. 4138494Sobrien# 2. Redistributions in binary form must reproduce the above copyright 4238494Sobrien# notice, this list of conditions and the following disclaimer in the 4338494Sobrien# documentation and/or other materials provided with the distribution. 4438494Sobrien# 3. All advertising materials mentioning features or use of this software 4538494Sobrien# must display the following acknowledgement: 4638494Sobrien# This product includes software developed by the David Muir Sharnoff. 4738494Sobrien# 4. The name of David Sharnoff may not be used to endorse or promote products 4838494Sobrien# derived from this software without specific prior written permission. 4938494Sobrien# 5038494Sobrien# THIS SOFTWARE IS PROVIDED BY THE DAVID MUIR SHARNOFF ``AS IS'' AND 5138494Sobrien# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 5238494Sobrien# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 5338494Sobrien# ARE DISCLAIMED. IN NO EVENT SHALL DAVID MUIR SHARNOFF BE LIABLE 5438494Sobrien# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 5538494Sobrien# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 5638494Sobrien# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 5738494Sobrien# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 5838494Sobrien# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 5938494Sobrien# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 6038494Sobrien# SUCH DAMAGE. 6138494Sobrien# 62119679Smbr# This copyright notice derived from material copyrighted by the Regents 6338494Sobrien# of the University of California. 6438494Sobrien# 6538494Sobrien# Contributions accepted. 6638494Sobrien# 6738494Sobrien############################################################################# 6838494Sobrien 6938494Sobrien# overall structure: 7038494Sobrien# in an effort to not trace each address individually, but rather 7138494Sobrien# ask each server in turn a whole bunch of questions, addresses to 7238494Sobrien# be expanded are queued up. 7338494Sobrien# 7438494Sobrien# This means that all accounting w.r.t. an address must be stored in 7538494Sobrien# various arrays. Generally these arrays are indexed by the 7638494Sobrien# string "$addr *** $server" where $addr is the address to be 7738494Sobrien# expanded "foo" or maybe "foo@bar" and $server is the hostname 7838494Sobrien# of the SMTP server to contact. 7938494Sobrien# 8038494Sobrien 8138494Sobrien# important global variables: 8238494Sobrien# 8338494Sobrien# @hosts : list of servers still to be contacted 8438494Sobrien# $server : name of the current we are currently looking at 8538494Sobrien# @users = $users{@hosts[0]} : addresses to expand at this server 8638494Sobrien# $u = $users[0] : the current address being expanded 8738494Sobrien# $names{"$users[0] *** $server"} : the 'name' associated with the address 8838494Sobrien# $mxbacktrace{"$users[0] *** $server"} : record of mx expansion 8938494Sobrien# $mx_secondary{$server} : other mx relays at the same priority 9051591Sobrien# $domainify_fallback{"$users[0] *** $server"} : alternative names to try 9138494Sobrien# instead of $server if $server doesn't work 9238494Sobrien# $temporary_redirect{"$users[0] *** $server"} : when trying alternates, 9338494Sobrien# temporarily channel all tries along current path 9438494Sobrien# $giveup{$server} : do not bother expanding addresses at $server 9538494Sobrien# $verbose : -v 9638494Sobrien# $watch : -w 9738494Sobrien# $vw : -v or -w 9838494Sobrien# $debug : -d 9938494Sobrien# $valid : -a 10038494Sobrien# $levels : -1 10138494Sobrien# S : the socket connection to $server 10238494Sobrien 10338494Sobrien$have_nslookup = 1; # we have the nslookup program 10438494Sobrien$port = 'smtp'; 10538494Sobrien$av0 = $0; 10638494Sobrien$ENV{'PATH'} .= ":/usr/etc" unless $ENV{'PATH'} =~ m,/usr/etc,; 10738494Sobrien$ENV{'PATH'} .= ":/usr/ucb" unless $ENV{'PATH'} =~ m,/usr/ucb,; 10838494Sobrienselect(STDERR); 10938494Sobrien 11038494Sobrien$0 = "$av0 - running hostname"; 11138494Sobrienchop($name = `hostname || uname -n`); 11238494Sobrien 11338494Sobrien$0 = "$av0 - lookup host FQDN and IP addr"; 11438494Sobrien($hostname,$aliases,$type,$len,$thisaddr) = gethostbyname($name); 11538494Sobrien 11638494Sobrien$0 = "$av0 - parsing args"; 11782794Sobrien$usage = "Usage: $av0 [-1avwd] user[\@host] [user2[\@host2] ...]"; 11838494Sobrienfor $a (@ARGV) { 11938494Sobrien die $usage if $a eq "-"; 12038494Sobrien while ($a =~ s/^(-.*)([1avwd])/$1/) { 12138494Sobrien eval '$'."flag_$2 += 1"; 12238494Sobrien } 12338494Sobrien next if $a eq "-"; 12438494Sobrien die $usage if $a =~ /^-/; 12538494Sobrien &expn(&parse($a,$hostname,undef,1)); 12638494Sobrien} 12738494Sobrien$verbose = $flag_v; 12838494Sobrien$watch = $flag_w; 12938494Sobrien$vw = $flag_v + $flag_w; 13038494Sobrien$debug = $flag_d; 13138494Sobrien$valid = $flag_a; 13238494Sobrien$levels = $flag_1; 13338494Sobrien 13438494Sobriendie $usage unless @hosts; 13538494Sobrienif ($valid) { 13638494Sobrien if ($valid == 1) { 13738494Sobrien $validRequirement = 0.8; 13838494Sobrien } elsif ($valid == 2) { 13938494Sobrien $validRequirement = 1.0; 14038494Sobrien } elsif ($valid == 3) { 14138494Sobrien $validRequirement = 0.9; 14238494Sobrien } else { 14338494Sobrien $validRequirement = (1 - (1/($valid-3))); 14438494Sobrien print "validRequirement = $validRequirement\n" if $debug; 14538494Sobrien } 14638494Sobrien} 14738494Sobrien 14838494Sobrien$0 = "$av0 - building local socket"; 14938494Sobrien($name,$aliases,$proto) = getprotobyname('tcp'); 15038494Sobrien($name,$aliases,$port) = getservbyname($port,'tcp') 15138494Sobrien unless $port =~ /^\d+/; 15251591Sobrien$this = sockaddr_in(0, $thisaddr); 15338494Sobrien 15438494SobrienHOST: 15538494Sobrienwhile (@hosts) { 15638494Sobrien $server = shift(@hosts); 15738494Sobrien @users = split(' ',$users{$server}); 15838494Sobrien delete $users{$server}; 15938494Sobrien 16038494Sobrien # is this server already known to be bad? 16138494Sobrien $0 = "$av0 - looking up $server"; 16238494Sobrien if ($giveup{$server}) { 16338494Sobrien &giveup('mx domainify',$giveup{$server}); 16438494Sobrien next; 16538494Sobrien } 16638494Sobrien 16738494Sobrien # do we already have an mx record for this host? 16838494Sobrien next HOST if &mxredirect($server,*users); 16938494Sobrien 17038494Sobrien # look it up, or try for an mx. 17138494Sobrien $0 = "$av0 - gethostbyname($server)"; 17238494Sobrien 17338494Sobrien ($name,$aliases,$type,$len,$thataddr) = gethostbyname($server); 17438494Sobrien # if we can't get an A record, try for an MX record. 17538494Sobrien unless($thataddr) { 17638494Sobrien &mxlookup(1,$server,"$server: could not resolve name",*users); 17738494Sobrien next HOST; 17838494Sobrien } 17951591Sobrien 18038494Sobrien # get a connection, or look for an mx 18138494Sobrien $0 = "$av0 - socket to $server"; 18251591Sobrien $that = sockaddr_in($port, $thataddr); 18338494Sobrien socket(S, &AF_INET, &SOCK_STREAM, $proto) 18438494Sobrien || die "socket: $!"; 18538494Sobrien $0 = "$av0 - bind to $server"; 18651591Sobrien bind(S, $this) 18738494Sobrien || die "bind $hostname,0: $!"; 18838494Sobrien $0 = "$av0 - connect to $server"; 18938494Sobrien print "debug = $debug server = $server\n" if $debug > 8; 19038494Sobrien if (! connect(S, $that) || ($debug == 10 && $server =~ /relay\d.UU.NET$/i)) { 19138494Sobrien $0 = "$av0 - $server: could not connect: $!\n"; 19238494Sobrien $emsg = $!; 19338494Sobrien unless (&mxlookup(0,$server,"$server: could not connect: $!",*users)) { 19438494Sobrien &giveup('mx',"$server: Could not connect: $emsg"); 19538494Sobrien } 19638494Sobrien next HOST; 19738494Sobrien } 19838494Sobrien select((select(S),$| = 1)[0]); # don't buffer output to S 19938494Sobrien 20038494Sobrien # read the greeting 20138494Sobrien $0 = "$av0 - talking to $server"; 20238494Sobrien &alarm("greeting with $server",''); 20338494Sobrien while(<S>) { 20438494Sobrien alarm(0); 20538494Sobrien print if $watch; 20638494Sobrien if (/^(\d+)([- ])/) { 20738494Sobrien if ($1 != 220) { 20838494Sobrien $0 = "$av0 - bad numeric response from $server"; 20938494Sobrien &alarm("giving up after bad response from $server",''); 21038494Sobrien &read_response($2,$watch); 21138494Sobrien alarm(0); 21238494Sobrien print STDERR "$server: NOT 220 greeting: $_" 21338494Sobrien if ($debug || $vw); 21438494Sobrien if (&mxlookup(0,$server,"$server: did not respond with a 220 greeting",*users)) { 21538494Sobrien close(S); 21638494Sobrien next HOST; 21738494Sobrien } 21838494Sobrien } 21938494Sobrien last if ($2 eq " "); 22038494Sobrien } else { 22138494Sobrien $0 = "$av0 - bad response from $server"; 22238494Sobrien print STDERR "$server: NOT 220 greeting: $_" 22338494Sobrien if ($debug || $vw); 22438494Sobrien unless (&mxlookup(0,$server,"$server: did not respond with SMTP codes",*users)) { 22538494Sobrien &giveup('',"$server: did not talk SMTP"); 22638494Sobrien } 22738494Sobrien close(S); 22838494Sobrien next HOST; 22938494Sobrien } 23038494Sobrien &alarm("greeting with $server",''); 23138494Sobrien } 23238494Sobrien alarm(0); 23351591Sobrien 23438494Sobrien # if this causes problems, remove it 23538494Sobrien $0 = "$av0 - sending helo to $server"; 23638494Sobrien &alarm("sending helo to $server",""); 23738494Sobrien &ps("helo $hostname"); 23838494Sobrien while(<S>) { 23938494Sobrien print if $watch; 24038494Sobrien last if /^\d+ /; 24138494Sobrien } 24238494Sobrien alarm(0); 24338494Sobrien 24438494Sobrien # try the users, one by one 24538494Sobrien USER: 24638494Sobrien while(@users) { 24738494Sobrien $u = shift(@users); 24838494Sobrien $0 = "$av0 - expanding $u [\@$server]"; 24938494Sobrien 25038494Sobrien # do we already have a name for this user? 25138494Sobrien $oldname = $names{"$u *** $server"}; 25238494Sobrien 25338494Sobrien print &compact($u,$server)." ->\n" if ($verbose && ! $valid); 25438494Sobrien if ($valid) { 25538494Sobrien # 25651591Sobrien # when running with -a, we delay taking any action 25738494Sobrien # on the results of our query until we have looked 25838494Sobrien # at the complete output. @toFinal stores expansions 25938494Sobrien # that will be final if we take them. @toExpn stores 260119679Smbr # expansions that are not final. @isValid keeps 26138494Sobrien # track of our ability to send mail to each of the 26238494Sobrien # expansions. 26338494Sobrien # 26438494Sobrien @isValid = (); 26538494Sobrien @toFinal = (); 26638494Sobrien @toExpn = (); 26738494Sobrien } 26838494Sobrien 26938494Sobrien# ($ecode,@expansion) = &expn_vrfy($u,$server); 27038494Sobrien (@foo) = &expn_vrfy($u,$server); 27138494Sobrien ($ecode,@expansion) = @foo; 27238494Sobrien if ($ecode) { 27338494Sobrien &giveup('',$ecode,$u); 27438494Sobrien last USER; 27538494Sobrien } 27638494Sobrien 27738494Sobrien for $s (@expansion) { 27838494Sobrien $s =~ s/[\n\r]//g; 27938494Sobrien $0 = "$av0 - parsing $server: $s"; 28038494Sobrien 28138494Sobrien $skipwatch = $watch; 28238494Sobrien 28338494Sobrien if ($s =~ /^[25]51([- ]).*<(.+)>/) { 28438494Sobrien print "$s" if $watch; 28538494Sobrien print "(pretending 250$1<$2>)" if ($debug && $watch); 28638494Sobrien print "\n" if $watch; 28738494Sobrien $s = "250$1<$2>"; 28838494Sobrien $skipwatch = 0; 28938494Sobrien } 29038494Sobrien 29138494Sobrien if ($s =~ /^250([- ])(.+)/) { 29238494Sobrien print "$s\n" if $skipwatch; 29338494Sobrien ($done,$addr) = ($1,$2); 29438494Sobrien ($newhost, $newaddr, $newname) = &parse($addr,$server,$oldname, $#expansion == 0); 29538494Sobrien print "($newhost, $newaddr, $newname) = &parse($addr, $server, $oldname)\n" if $debug; 29638494Sobrien if (! $newhost) { 29738494Sobrien # no expansion is possible w/o a new server to call 29838494Sobrien if ($valid) { 29938494Sobrien push(@isValid, &validAddr($newaddr)); 30038494Sobrien push(@toFinal,$newaddr,$server,$newname); 30138494Sobrien } else { 30238494Sobrien &verbose(&final($newaddr,$server,$newname)); 30338494Sobrien } 30438494Sobrien } else { 30538494Sobrien $newmxhost = &mx($newhost,$newaddr); 30651591Sobrien print "$newmxhost = &mx($newhost)\n" 30738494Sobrien if ($debug && $newhost ne $newmxhost); 30838494Sobrien $0 = "$av0 - parsing $newaddr [@$newmxhost]"; 30938494Sobrien print "levels = $levels, level{$u *** $server} = ".$level{"$u *** $server"}."\n" if ($debug > 1); 31051591Sobrien # If the new server is the current one, 31138494Sobrien # it would have expanded things for us 31238494Sobrien # if it could have. Mx records must be 31338494Sobrien # followed to compare server names. 31438494Sobrien # We are also done if the recursion 31538494Sobrien # count has been exceeded. 31638494Sobrien if (&trhost($newmxhost) eq &trhost($server) || ($levels && $level{"$u *** $server"} >= $levels)) { 31738494Sobrien if ($valid) { 31838494Sobrien push(@isValid, &validAddr($newaddr)); 31938494Sobrien push(@toFinal,$newaddr,$newmxhost,$newname); 32038494Sobrien } else { 32138494Sobrien &verbose(&final($newaddr,$newmxhost,$newname)); 32238494Sobrien } 32338494Sobrien } else { 32438494Sobrien # more work to do... 32538494Sobrien if ($valid) { 32638494Sobrien push(@isValid, &validAddr($newaddr)); 32738494Sobrien push(@toExpn,$newmxhost,$newaddr,$newname,$level{"$u *** $server"}); 32838494Sobrien } else { 32938494Sobrien &verbose(&expn($newmxhost,$newaddr,$newname,$level{"$u *** $server"})); 33038494Sobrien } 33138494Sobrien } 33238494Sobrien } 33338494Sobrien last if ($done eq " "); 33438494Sobrien next; 33538494Sobrien } 33638494Sobrien # 550 is a known code... Should the be 33738494Sobrien # included in -a output? Might be a bug 33838494Sobrien # here. Does it matter? Can assume that 33951591Sobrien # there won't be UNKNOWN USER responses 34038494Sobrien # mixed with valid users? 34138494Sobrien if ($s =~ /^(550)([- ])/) { 34238494Sobrien if ($valid) { 34338494Sobrien print STDERR "\@$server:$u ($oldname) USER UNKNOWN\n"; 34438494Sobrien } else { 34538494Sobrien &verbose(&final($u,$server,$oldname,"USER UNKNOWN")); 34638494Sobrien } 34738494Sobrien last if ($2 eq " "); 34838494Sobrien next; 34951591Sobrien } 35051591Sobrien # 553 is a known code... 35138494Sobrien if ($s =~ /^(553)([- ])/) { 35238494Sobrien if ($valid) { 35338494Sobrien print STDERR "\@$server:$u ($oldname) USER AMBIGUOUS\n"; 35438494Sobrien } else { 35538494Sobrien &verbose(&final($u,$server,$oldname,"USER AMBIGUOUS")); 35638494Sobrien } 35738494Sobrien last if ($2 eq " "); 35838494Sobrien next; 35951591Sobrien } 36051591Sobrien # 252 is a known code... 36138494Sobrien if ($s =~ /^(252)([- ])/) { 36238494Sobrien if ($valid) { 36338494Sobrien print STDERR "\@$server:$u ($oldname) REFUSED TO VRFY\n"; 36438494Sobrien } else { 36538494Sobrien &verbose(&final($u,$server,$oldname,"REFUSED TO VRFY")); 36638494Sobrien } 36738494Sobrien last if ($2 eq " "); 36838494Sobrien next; 36951591Sobrien } 37038494Sobrien &giveup('',"$server: did not grok '$s'",$u); 37138494Sobrien last USER; 37238494Sobrien } 37338494Sobrien 37438494Sobrien if ($valid) { 37538494Sobrien # 37638494Sobrien # now we decide if we are going to take these 37738494Sobrien # expansions or roll them back. 37838494Sobrien # 37938494Sobrien $avgValid = &average(@isValid); 38038494Sobrien print "avgValid = $avgValid\n" if $debug; 38138494Sobrien if ($avgValid >= $validRequirement) { 38238494Sobrien print &compact($u,$server)." ->\n" if $verbose; 38338494Sobrien while (@toExpn) { 38438494Sobrien &verbose(&expn(splice(@toExpn,0,4))); 38538494Sobrien } 38638494Sobrien while (@toFinal) { 38738494Sobrien &verbose(&final(splice(@toFinal,0,3))); 38838494Sobrien } 38938494Sobrien } else { 39038494Sobrien print "Tossing some valid to avoid invalid ".&compact($u,$server)."\n" if ($avgValid > 0.0 && ($vw || $debug)); 39138494Sobrien print &compact($u,$server)." ->\n" if $verbose; 39238494Sobrien &verbose(&final($u,$server,$newname)); 39338494Sobrien } 39438494Sobrien } 39538494Sobrien } 39638494Sobrien 39738494Sobrien &alarm("sending 'quit' to $server",''); 39838494Sobrien $0 = "$av0 - sending 'quit' to $server"; 39938494Sobrien &ps("quit"); 40038494Sobrien while(<S>) { 40138494Sobrien print if $watch; 40238494Sobrien last if /^\d+ /; 40338494Sobrien } 40438494Sobrien close(S); 40538494Sobrien alarm(0); 40638494Sobrien} 40738494Sobrien 40838494Sobrien$0 = "$av0 - printing final results"; 40938494Sobrienprint "----------\n" if $vw; 41038494Sobrienselect(STDOUT); 41138494Sobrienfor $f (sort @final) { 41238494Sobrien print "$f\n"; 41338494Sobrien} 41438494Sobrienunlink("/tmp/expn$$"); 41538494Sobrienexit(0); 41638494Sobrien 41738494Sobrien 41838494Sobrien# abandon all attempts deliver to $server 41938494Sobrien# register the current addresses as the final ones 42038494Sobriensub giveup 42138494Sobrien{ 42238494Sobrien local($redirect_okay,$reason,$user) = @_; 42338494Sobrien local($us,@so,$nh,@remaining_users); 42438494Sobrien local($pk,$file,$line); 42538494Sobrien ($pk, $file, $line) = caller; 42638494Sobrien 42738494Sobrien $0 = "$av0 - giving up on $server: $reason"; 42838494Sobrien # 42938494Sobrien # add back a user if we gave up in the middle 43038494Sobrien # 43138494Sobrien push(@users,$user) if $user; 43238494Sobrien # 43338494Sobrien # don't bother with this system anymore 43438494Sobrien # 43538494Sobrien unless ($giveup{$server}) { 43638494Sobrien $giveup{$server} = $reason; 43738494Sobrien print STDERR "$reason\n"; 43838494Sobrien } 43938494Sobrien print "Giveup at $file:$line!!! redirect okay = $redirect_okay; $reason\n" if $debug; 44038494Sobrien # 44138494Sobrien # Wait! 44238494Sobrien # Before giving up, see if there is a chance that 44338494Sobrien # there is another host to redirect to! 44438494Sobrien # (Kids, don't do this at home! Hacking is a dangerous 44538494Sobrien # crime and you could end up behind bars.) 44638494Sobrien # 44738494Sobrien for $u (@users) { 44838494Sobrien if ($redirect_okay =~ /\bmx\b/) { 44938494Sobrien next if &try_fallback('mx',$u,*server, 45038494Sobrien *mx_secondary, 45138494Sobrien *already_mx_fellback); 45238494Sobrien } 45338494Sobrien if ($redirect_okay =~ /\bdomainify\b/) { 45438494Sobrien next if &try_fallback('domainify',$u,*server, 45538494Sobrien *domainify_fallback, 45638494Sobrien *already_domainify_fellback); 45738494Sobrien } 45838494Sobrien push(@remaining_users,$u); 45938494Sobrien } 46038494Sobrien @users = @remaining_users; 46138494Sobrien for $u (@users) { 46238494Sobrien print &compact($u,$server)." ->\n" if ($verbose && $valid && $u); 46338494Sobrien &verbose(&final($u,$server,$names{"$u *** $server"},$reason)); 46438494Sobrien } 46538494Sobrien} 46638494Sobrien# 46738494Sobrien# This routine is used only within &giveup. It checks to 46838494Sobrien# see if we really have to giveup or if there is a second 46951591Sobrien# chance because we did something before that can be 47038494Sobrien# backtracked. 47138494Sobrien# 47238494Sobrien# %fallback{"$user *** $host"} tracks what is able to fallback 47338494Sobrien# %fellback{"$user *** $host"} tracks what has fallen back 47438494Sobrien# 47538494Sobrien# If there is a valid backtrack, then queue up the new possibility 47638494Sobrien# 47738494Sobriensub try_fallback 47838494Sobrien{ 47938494Sobrien local($method,$user,*host,*fall_table,*fellback) = @_; 48038494Sobrien local($us,$fallhost,$oldhost,$ft,$i); 48138494Sobrien 48238494Sobrien if ($debug > 8) { 48338494Sobrien print "Fallback table $method:\n"; 48438494Sobrien for $i (sort keys %fall_table) { 48538494Sobrien print "\t'$i'\t\t'$fall_table{$i}'\n"; 48638494Sobrien } 48738494Sobrien print "Fellback table $method:\n"; 48838494Sobrien for $i (sort keys %fellback) { 48938494Sobrien print "\t'$i'\t\t'$fellback{$i}'\n"; 49038494Sobrien } 49138494Sobrien print "U: $user H: $host\n"; 49238494Sobrien } 49351591Sobrien 49438494Sobrien $us = "$user *** $host"; 49538494Sobrien if (defined $fellback{$us}) { 49638494Sobrien # 49738494Sobrien # Undo a previous fallback so that we can try again 49838494Sobrien # Nested fallbacks are avoided because they could 49938494Sobrien # lead to infinite loops 50038494Sobrien # 50138494Sobrien $fallhost = $fellback{$us}; 50238494Sobrien print "Already $method fell back from $us -> \n" if $debug; 50338494Sobrien $us = "$user *** $fallhost"; 50438494Sobrien $oldhost = $fallhost; 50538494Sobrien } elsif (($method eq 'mx') && (defined $mxbacktrace{$us}) && (defined $mx_secondary{$mxbacktrace{$us}})) { 50638494Sobrien print "Fallback an MX expansion $us -> \n" if $debug; 50738494Sobrien $oldhost = $mxbacktrace{$us}; 50838494Sobrien } else { 50938494Sobrien print "Oldhost($host, $us) = " if $debug; 51038494Sobrien $oldhost = $host; 51138494Sobrien } 51238494Sobrien print "$oldhost\n" if $debug; 51338494Sobrien if (((defined $fall_table{$us}) && ($ft = $us)) || ((defined $fall_table{$oldhost}) && ($ft = $oldhost))) { 51438494Sobrien print "$method Fallback = ".$fall_table{$ft}."\n" if $debug; 51538494Sobrien local(@so,$newhost); 51638494Sobrien @so = split(' ',$fall_table{$ft}); 51738494Sobrien $newhost = shift(@so); 51838494Sobrien print "Falling back ($method) $us -> $newhost (from $oldhost)\n" if $debug; 51938494Sobrien if ($method eq 'mx') { 52038494Sobrien if (! defined ($mxbacktrace{"$user *** $newhost"})) { 52138494Sobrien if (defined $mxbacktrace{"$user *** $oldhost"}) { 52238494Sobrien print "resetting oldhost $oldhost to the original: " if $debug; 52338494Sobrien $oldhost = $mxbacktrace{"$user *** $oldhost"}; 52438494Sobrien print "$oldhost\n" if $debug; 52538494Sobrien } 52638494Sobrien $mxbacktrace{"$user *** $newhost"} = $oldhost; 52738494Sobrien print "mxbacktrace $user *** $newhost -> $oldhost\n" if $debug; 52838494Sobrien } 52938494Sobrien $mx{&trhost($oldhost)} = $newhost; 53038494Sobrien } else { 53138494Sobrien $temporary_redirect{$us} = $newhost; 53238494Sobrien } 53338494Sobrien if (@so) { 53438494Sobrien print "Can still $method $us: @so\n" if $debug; 53538494Sobrien $fall_table{$ft} = join(' ',@so); 53638494Sobrien } else { 53738494Sobrien print "No more fallbacks for $us\n" if $debug; 53838494Sobrien delete $fall_table{$ft}; 53938494Sobrien } 54038494Sobrien if (defined $create_host_backtrack{$us}) { 54151591Sobrien $create_host_backtrack{"$user *** $newhost"} 54238494Sobrien = $create_host_backtrack{$us}; 54338494Sobrien } 54438494Sobrien $fellback{"$user *** $newhost"} = $oldhost; 54538494Sobrien &expn($newhost,$user,$names{$us},$level{$us}); 54638494Sobrien return 1; 54738494Sobrien } 54838494Sobrien delete $temporary_redirect{$us}; 54938494Sobrien $host = $oldhost; 55038494Sobrien return 0; 55138494Sobrien} 55238494Sobrien# return 1 if you could send mail to the address as is. 55338494Sobriensub validAddr 55438494Sobrien{ 55538494Sobrien local($addr) = @_; 55638494Sobrien $res = &do_validAddr($addr); 55738494Sobrien print "validAddr($addr) = $res\n" if $debug; 55838494Sobrien $res; 55938494Sobrien} 56038494Sobriensub do_validAddr 56138494Sobrien{ 56238494Sobrien local($addr) = @_; 56338494Sobrien local($urx) = "[-A-Za-z_.0-9+]+"; 56438494Sobrien 56538494Sobrien # \u 56638494Sobrien return 0 if ($addr =~ /^\\/); 56738494Sobrien # ?@h 56838494Sobrien return 1 if ($addr =~ /.\@$urx$/); 56938494Sobrien # @h:? 57038494Sobrien return 1 if ($addr =~ /^\@$urx\:./); 57138494Sobrien # h!u 57238494Sobrien return 1 if ($addr =~ /^$urx!./); 57338494Sobrien # u 57438494Sobrien return 1 if ($addr =~ /^$urx$/); 57538494Sobrien # ? 57638494Sobrien print "validAddr($addr) = ???\n" if $debug; 57738494Sobrien return 0; 57838494Sobrien} 57938494Sobrien# Some systems use expn and vrfy interchangeably. Some only 58038494Sobrien# implement one or the other. Some check expn against mailing 58138494Sobrien# lists and vrfy against users. It doesn't appear to be 58238494Sobrien# consistent. 58338494Sobrien# 58438494Sobrien# So, what do we do? We try everything! 58538494Sobrien# 58638494Sobrien# 58738494Sobrien# Ranking of result codes: good: 250, 251/551, 252, 550, anything else 58838494Sobrien# 58938494Sobrien# Ranking of inputs: best: user@host.domain, okay: user 59038494Sobrien# 59138494Sobrien# Return value: $error_string, @responses_from_server 59238494Sobriensub expn_vrfy 59338494Sobrien{ 59438494Sobrien local($u,$server) = @_; 59538494Sobrien local(@c) = ('expn', 'vrfy'); 59638494Sobrien local(@try_u) = $u; 59738494Sobrien local(@ret,$code); 59838494Sobrien 59938494Sobrien if (($u =~ /(.+)@(.+)/) && (&trhost($2) eq &trhost($server))) { 60038494Sobrien push(@try_u,$1); 60138494Sobrien } 60238494Sobrien 60338494Sobrien TRY: 60438494Sobrien for $c (@c) { 60538494Sobrien for $try_u (@try_u) { 60638494Sobrien &alarm("${c}'ing $try_u on $server",'',$u); 60738494Sobrien &ps("$c $try_u"); 60838494Sobrien alarm(0); 60938494Sobrien $s = <S>; 61038494Sobrien if ($s eq '') { 61138494Sobrien return "$server: lost connection"; 61238494Sobrien } 61338494Sobrien if ($s !~ /^(\d+)([- ])/) { 61438494Sobrien return "$server: garbled reply to '$c $try_u'"; 61538494Sobrien } 61638494Sobrien if ($1 == 250) { 61738494Sobrien $code = 250; 61838494Sobrien @ret = ("",$s); 61938494Sobrien push(@ret,&read_response($2,$debug)); 62038494Sobrien return (@ret); 62151591Sobrien } 62238494Sobrien if ($1 == 551 || $1 == 251) { 62338494Sobrien $code = $1; 62438494Sobrien @ret = ("",$s); 62538494Sobrien push(@ret,&read_response($2,$debug)); 62638494Sobrien next; 62738494Sobrien } 62838494Sobrien if ($1 == 252 && ($code == 0 || $code == 550)) { 62938494Sobrien $code = 252; 63038494Sobrien @ret = ("",$s); 63138494Sobrien push(@ret,&read_response($2,$watch)); 63238494Sobrien next; 63338494Sobrien } 63438494Sobrien if ($1 == 550 && $code == 0) { 63538494Sobrien $code = 550; 63638494Sobrien @ret = ("",$s); 63738494Sobrien push(@ret,&read_response($2,$watch)); 63838494Sobrien next; 63938494Sobrien } 64038494Sobrien &read_response($2,$watch); 64138494Sobrien } 64238494Sobrien } 64338494Sobrien return "$server: expn/vrfy not implemented" unless @ret; 64438494Sobrien return @ret; 64538494Sobrien} 64638494Sobrien# sometimes the old parse routine (now parse2) didn't 64751591Sobrien# reject funky addresses. 64838494Sobriensub parse 64938494Sobrien{ 65038494Sobrien local($oldaddr,$server,$oldname,$one_to_one) = @_; 65138494Sobrien local($newhost, $newaddr, $newname, $um) = &parse2($oldaddr,$server,$oldname,$one_to_one); 65238494Sobrien if ($newaddr =~ m,^["/],) { 65338494Sobrien return (undef, $oldaddr, $newname) if $valid; 65438494Sobrien return (undef, $um, $newname); 65538494Sobrien } 65638494Sobrien return ($newhost, $newaddr, $newname); 65738494Sobrien} 65838494Sobrien 65938494Sobrien# returns ($new_smtp_server,$new_address,$new_name) 66051591Sobrien# given a response from a SMTP server ($newaddr), the 66138494Sobrien# current host ($server), the old "name" and a flag that 66251591Sobrien# indicates if it is being called during the initial 66338494Sobrien# command line parsing ($parsing_args) 66438494Sobriensub parse2 66538494Sobrien{ 66638494Sobrien local($newaddr,$context_host,$old_name,$parsing_args) = @_; 66738494Sobrien local(@names) = $old_name; 66838494Sobrien local($urx) = "[-A-Za-z_.0-9+]+"; 66938494Sobrien local($unmangle); 67038494Sobrien 67138494Sobrien # 67238494Sobrien # first, separate out the address part. 67338494Sobrien # 67438494Sobrien 67538494Sobrien # 67638494Sobrien # [NAME] <ADDR [(NAME)]> 67738494Sobrien # [NAME] <[(NAME)] ADDR 67838494Sobrien # ADDR [(NAME)] 67938494Sobrien # (NAME) ADDR 68038494Sobrien # [(NAME)] <ADDR> 68138494Sobrien # 68238494Sobrien if ($newaddr =~ /^\<(.*)\>$/) { 68338494Sobrien print "<A:$1>\n" if $debug; 68438494Sobrien ($newaddr) = &trim($1); 68538494Sobrien print "na = $newaddr\n" if $debug; 68638494Sobrien } 68738494Sobrien if ($newaddr =~ /^([^\<\>]*)\<([^\<\>]*)\>([^\<\>]*)$/) { 68838494Sobrien # address has a < > pair in it. 68938494Sobrien print "N:$1 <A:$2> N:$3\n" if $debug; 69038494Sobrien ($newaddr) = &trim($2); 69138494Sobrien unshift(@names, &trim($3,$1)); 69238494Sobrien print "na = $newaddr\n" if $debug; 69338494Sobrien } 69438494Sobrien if ($newaddr =~ /^([^\(\)]*)\(([^\(\)]*)\)([^\(\)]*)$/) { 69538494Sobrien # address has a ( ) pair in it. 69638494Sobrien print "A:$1 (N:$2) A:$3\n" if $debug; 69738494Sobrien unshift(@names,&trim($2)); 69838494Sobrien local($f,$l) = (&trim($1),&trim($3)); 69938494Sobrien if (($f && $l) || !($f || $l)) { 70038494Sobrien # address looks like: 70138494Sobrien # foo (bar) baz or (bar) 70238494Sobrien # not allowed! 70338494Sobrien print STDERR "Could not parse $newaddr\n" if $vw; 70438494Sobrien return(undef,$newaddr,&firstname(@names)); 70538494Sobrien } 70638494Sobrien $newaddr = $f if $f; 70738494Sobrien $newaddr = $l if $l; 70838494Sobrien print "newaddr now = $newaddr\n" if $debug; 70938494Sobrien } 71038494Sobrien # 71138494Sobrien # @foo:bar 71238494Sobrien # j%k@l 71338494Sobrien # a@b 71438494Sobrien # b!a 71538494Sobrien # a 71638494Sobrien # 71738494Sobrien $unmangle = $newaddr; 71838494Sobrien if ($newaddr =~ /^\@($urx)\:(.+)$/) { 71938494Sobrien print "(\@:)" if $debug; 72038494Sobrien # this is a bit of a cheat, but it seems necessary 72138494Sobrien return (&domainify($1,$context_host,$2),$2,&firstname(@names),$unmangle); 72238494Sobrien } 72338494Sobrien if ($newaddr =~ /^(.+)\@($urx)$/) { 72438494Sobrien print "(\@)" if $debug; 72538494Sobrien return (&domainify($2,$context_host,$newaddr),$newaddr,&firstname(@names),$unmangle); 72638494Sobrien } 72738494Sobrien if ($parsing_args) { 72838494Sobrien if ($newaddr =~ /^($urx)\!(.+)$/) { 72938494Sobrien return (&domainify($1,$context_host,$newaddr),$newaddr,&firstname(@names),$unmangle); 73038494Sobrien } 73138494Sobrien if ($newaddr =~ /^($urx)$/) { 73238494Sobrien return ($context_host,$newaddr,&firstname(@names),$unmangle); 73338494Sobrien } 73438494Sobrien print STDERR "Could not parse $newaddr\n"; 73538494Sobrien } 73638494Sobrien print "(?)" if $debug; 73738494Sobrien return(undef,$newaddr,&firstname(@names),$unmangle); 73838494Sobrien} 73938494Sobrien# return $u (@$server) unless $u includes reference to $server 74038494Sobriensub compact 74138494Sobrien{ 74238494Sobrien local($u, $server) = @_; 74338494Sobrien local($se) = $server; 74438494Sobrien local($sp); 74538494Sobrien $se =~ s/(\W)/\\$1/g; 74638494Sobrien $sp = " (\@$server)"; 74738494Sobrien if ($u !~ /$se/i) { 74838494Sobrien return "$u$sp"; 74938494Sobrien } 75038494Sobrien return $u; 75138494Sobrien} 75238494Sobrien# remove empty (spaces don't count) members from an array 75338494Sobriensub trim 75438494Sobrien{ 75538494Sobrien local(@v) = @_; 75638494Sobrien local($v,@r); 75738494Sobrien for $v (@v) { 75838494Sobrien $v =~ s/^\s+//; 75938494Sobrien $v =~ s/\s+$//; 76038494Sobrien push(@r,$v) if ($v =~ /\S/); 76138494Sobrien } 76238494Sobrien return(@r); 76338494Sobrien} 76438494Sobrien# using the host part of an address, and the server name, add the 76551591Sobrien# servers' domain to the address if it doesn't already have a 76638494Sobrien# domain. Since this sometimes fails, save a back reference so 76738494Sobrien# it can be unrolled. 76838494Sobriensub domainify 76938494Sobrien{ 77038494Sobrien local($host,$domain_host,$u) = @_; 77138494Sobrien local($domain,$newhost); 77238494Sobrien 77351591Sobrien # cut of trailing dots 77438494Sobrien $host =~ s/\.$//; 77538494Sobrien $domain_host =~ s/\.$//; 77638494Sobrien 77738494Sobrien if ($domain_host !~ /\./) { 77838494Sobrien # 77938494Sobrien # domain host isn't, keep $host whatever it is 78038494Sobrien # 78138494Sobrien print "domainify($host,$domain_host) = $host\n" if $debug; 78238494Sobrien return $host; 78338494Sobrien } 78438494Sobrien 78551591Sobrien # 786119679Smbr # There are several weird situations that need to be 78738494Sobrien # accounted for. They have to do with domain relay hosts. 78838494Sobrien # 78951591Sobrien # Examples: 79038494Sobrien # host server "right answer" 79151591Sobrien # 79238494Sobrien # shiva.cs cs.berkeley.edu shiva.cs.berkeley.edu 79338494Sobrien # shiva cs.berkeley.edu shiva.cs.berekley.edu 79438494Sobrien # cumulus reed.edu @reed.edu:cumulus.uucp 79538494Sobrien # tiberius tc.cornell.edu tiberius.tc.cornell.edu 79638494Sobrien # 79751591Sobrien # The first try must always be to cut the domain part out of 79838494Sobrien # the server and tack it onto the host. 79938494Sobrien # 80038494Sobrien # A reasonable second try is to tack the whole server part onto 80151591Sobrien # the host and for each possible repeated element, eliminate 80238494Sobrien # just that part. 80338494Sobrien # 80438494Sobrien # These extra "guesses" get put into the %domainify_fallback 80538494Sobrien # array. They will be used to give addresses a second chance 80638494Sobrien # in the &giveup routine 80738494Sobrien # 80838494Sobrien 80938494Sobrien local(%fallback); 81038494Sobrien 81151591Sobrien local($long); 81238494Sobrien $long = "$host $domain_host"; 81338494Sobrien $long =~ tr/A-Z/a-z/; 81438494Sobrien print "long = $long\n" if $debug; 81538494Sobrien if ($long =~ s/^([^ ]+\.)([^ ]+) \2(\.[^ ]+\.[^ ]+)/$1$2$3/) { 81638494Sobrien # matches shiva.cs cs.berkeley.edu and returns shiva.cs.berkeley.edu 81738494Sobrien print "condensed fallback $host $domain_host -> $long\n" if $debug; 81838494Sobrien $fallback{$long} = 9; 81938494Sobrien } 82038494Sobrien 82138494Sobrien local($fh); 82238494Sobrien $fh = $domain_host; 82338494Sobrien while ($fh =~ /\./) { 82438494Sobrien print "FALLBACK $host.$fh = 1\n" if $debug > 7; 82538494Sobrien $fallback{"$host.$fh"} = 1; 82638494Sobrien $fh =~ s/^[^\.]+\.//; 82738494Sobrien } 82838494Sobrien 82938494Sobrien $fallback{"$host.$domain_host"} = 2; 83038494Sobrien 83138494Sobrien ($domain = $domain_host) =~ s/^[^\.]+//; 83238494Sobrien $fallback{"$host$domain"} = 6 83338494Sobrien if ($domain =~ /\./); 83438494Sobrien 83538494Sobrien if ($host =~ /\./) { 83638494Sobrien # 83738494Sobrien # Host is already okay, but let's look for multiple 83838494Sobrien # interpretations 83938494Sobrien # 84038494Sobrien print "domainify($host,$domain_host) = $host\n" if $debug; 84138494Sobrien delete $fallback{$host}; 84238494Sobrien $domainify_fallback{"$u *** $host"} = join(' ',sort {$fallback{$b} <=> $fallback{$a};} keys %fallback) if %fallback; 84338494Sobrien return $host; 84438494Sobrien } 84538494Sobrien 84638494Sobrien $domain = ".$domain_host" 84738494Sobrien if ($domain !~ /\..*\./); 84838494Sobrien $newhost = "$host$domain"; 84938494Sobrien 85038494Sobrien $create_host_backtrack{"$u *** $newhost"} = $domain_host; 85138494Sobrien print "domainify($host,$domain_host) = $newhost\n" if $debug; 85238494Sobrien delete $fallback{$newhost}; 85338494Sobrien $domainify_fallback{"$u *** $newhost"} = join(' ',sort {$fallback{$b} <=> $fallback{$a};} keys %fallback) if %fallback; 85438494Sobrien if ($debug) { 85538494Sobrien print "fallback = "; 85651591Sobrien print $domainify_fallback{"$u *** $newhost"} 85738494Sobrien if defined($domainify_fallback{"$u *** $newhost"}); 85838494Sobrien print "\n"; 85938494Sobrien } 86038494Sobrien return $newhost; 86138494Sobrien} 86238494Sobrien# return the first non-empty element of an array 86338494Sobriensub firstname 86438494Sobrien{ 86538494Sobrien local(@names) = @_; 86638494Sobrien local($n); 86738494Sobrien while(@names) { 86838494Sobrien $n = shift(@names); 86938494Sobrien return $n if $n =~ /\S/; 87038494Sobrien } 87138494Sobrien return undef; 87238494Sobrien} 87338494Sobrien# queue up more addresses to expand 87438494Sobriensub expn 87538494Sobrien{ 87638494Sobrien local($host,$addr,$name,$level) = @_; 87738494Sobrien if ($host) { 87838494Sobrien $host = &trhost($host); 87938494Sobrien 88038494Sobrien if (($debug > 3) || (defined $giveup{$host})) { 88138494Sobrien unshift(@hosts,$host) unless $users{$host}; 88238494Sobrien } else { 88338494Sobrien push(@hosts,$host) unless $users{$host}; 88438494Sobrien } 88538494Sobrien $users{$host} .= " $addr"; 88638494Sobrien $names{"$addr *** $host"} = $name; 88738494Sobrien $level{"$addr *** $host"} = $level + 1; 88838494Sobrien print "expn($host,$addr,$name)\n" if $debug; 88938494Sobrien return "\t$addr\n"; 89038494Sobrien } else { 89138494Sobrien return &final($addr,'NONE',$name); 89238494Sobrien } 89338494Sobrien} 89438494Sobrien# compute the numerical average value of an array 89538494Sobriensub average 89638494Sobrien{ 89738494Sobrien local(@e) = @_; 89838494Sobrien return 0 unless @e; 89938494Sobrien local($e,$sum); 90038494Sobrien for $e (@e) { 90138494Sobrien $sum += $e; 90238494Sobrien } 90338494Sobrien $sum / @e; 90438494Sobrien} 90538494Sobrien# print to the server (also to stdout, if -w) 90638494Sobriensub ps 90738494Sobrien{ 90838494Sobrien local($p) = @_; 90938494Sobrien print ">>> $p\n" if $watch; 91038494Sobrien print S "$p\n"; 91138494Sobrien} 91238494Sobrien# return case-adjusted name for a host (for comparison purposes) 91351591Sobriensub trhost 91438494Sobrien{ 91538494Sobrien # treat foo.bar as an alias for Foo.BAR 91638494Sobrien local($host) = @_; 91738494Sobrien local($trhost) = $host; 91838494Sobrien $trhost =~ tr/A-Z/a-z/; 91938494Sobrien if ($trhost{$trhost}) { 92038494Sobrien $host = $trhost{$trhost}; 92138494Sobrien } else { 92238494Sobrien $trhost{$trhost} = $host; 92338494Sobrien } 92438494Sobrien $trhost{$trhost}; 92538494Sobrien} 92638494Sobrien# re-queue users if an mx record dictates a redirect 92738494Sobrien# don't allow a user to be redirected more than once 92838494Sobriensub mxredirect 92938494Sobrien{ 93038494Sobrien local($server,*users) = @_; 93138494Sobrien local($u,$nserver,@still_there); 93238494Sobrien 93338494Sobrien $nserver = &mx($server); 93438494Sobrien 93538494Sobrien if (&trhost($nserver) ne &trhost($server)) { 93638494Sobrien $0 = "$av0 - mx redirect $server -> $nserver\n"; 93738494Sobrien for $u (@users) { 93838494Sobrien if (defined $mxbacktrace{"$u *** $nserver"}) { 93938494Sobrien push(@still_there,$u); 94038494Sobrien } else { 94138494Sobrien $mxbacktrace{"$u *** $nserver"} = $server; 94238494Sobrien print "mxbacktrace{$u *** $nserver} = $server\n" 94338494Sobrien if ($debug > 1); 94438494Sobrien &expn($nserver,$u,$names{"$u *** $server"}); 94538494Sobrien } 94638494Sobrien } 94738494Sobrien @users = @still_there; 94838494Sobrien if (! @users) { 94938494Sobrien return $nserver; 95038494Sobrien } else { 95138494Sobrien return undef; 95238494Sobrien } 95338494Sobrien } 95438494Sobrien return undef; 95538494Sobrien} 95638494Sobrien# follow mx records, return a hostname 957119679Smbr# also follow temporary redirections coming from &domainify and 95838494Sobrien# &mxlookup 95938494Sobriensub mx 96038494Sobrien{ 96138494Sobrien local($h,$u) = @_; 96238494Sobrien 96338494Sobrien for (;;) { 96438494Sobrien if (defined $mx{&trhost($h)} && $h ne $mx{&trhost($h)}) { 96538494Sobrien $0 = "$av0 - mx expand $h"; 96638494Sobrien $h = $mx{&trhost($h)}; 96738494Sobrien return $h; 96838494Sobrien } 96938494Sobrien if ($u) { 97038494Sobrien if (defined $temporary_redirect{"$u *** $h"}) { 97138494Sobrien $0 = "$av0 - internal redirect $h"; 97238494Sobrien print "Temporary redirect taken $u *** $h -> " if $debug; 97338494Sobrien $h = $temporary_redirect{"$u *** $h"}; 97438494Sobrien print "$h\n" if $debug; 97538494Sobrien next; 97638494Sobrien } 97738494Sobrien $htr = &trhost($h); 97838494Sobrien if (defined $temporary_redirect{"$u *** $htr"}) { 97938494Sobrien $0 = "$av0 - internal redirect $h"; 98038494Sobrien print "temporary redirect taken $u *** $h -> " if $debug; 98138494Sobrien $h = $temporary_redirect{"$u *** $htr"}; 98238494Sobrien print "$h\n" if $debug; 98338494Sobrien next; 98438494Sobrien } 98538494Sobrien } 98638494Sobrien return $h; 98738494Sobrien } 98838494Sobrien} 98938494Sobrien# look up mx records with the name server. 99038494Sobrien# re-queue expansion requests if possible 99138494Sobrien# optionally give up on this host. 99251591Sobriensub mxlookup 99338494Sobrien{ 99438494Sobrien local($lastchance,$server,$giveup,*users) = @_; 99538494Sobrien local(*T); 99638494Sobrien local(*NSLOOKUP); 99738494Sobrien local($nh, $pref,$cpref); 99838494Sobrien local($o0) = $0; 99938494Sobrien local($nserver); 100038494Sobrien local($name,$aliases,$type,$len,$thataddr); 100138494Sobrien local(%fallback); 100238494Sobrien 100338494Sobrien return 1 if &mxredirect($server,*users); 100438494Sobrien 100538494Sobrien if ((defined $mx{$server}) || (! $have_nslookup)) { 100638494Sobrien return 0 unless $lastchance; 100738494Sobrien &giveup('mx domainify',$giveup); 100838494Sobrien return 0; 100938494Sobrien } 101038494Sobrien 101138494Sobrien $0 = "$av0 - nslookup of $server"; 101238494Sobrien open(T,">/tmp/expn$$") || die "open > /tmp/expn$$: $!\n"; 101338494Sobrien print T "set querytype=MX\n"; 101438494Sobrien print T "$server\n"; 101538494Sobrien close(T); 101638494Sobrien $cpref = 1.0E12; 101738494Sobrien undef $nserver; 101838494Sobrien open(NSLOOKUP,"nslookup < /tmp/expn$$ 2>&1 |") || die "open nslookup: $!"; 101938494Sobrien while(<NSLOOKUP>) { 102038494Sobrien print if ($debug > 2); 102138494Sobrien if (/mail exchanger = ([-A-Za-z_.0-9+]+)/) { 102238494Sobrien $nh = $1; 102338494Sobrien if (/preference = (\d+)/) { 102438494Sobrien $pref = $1; 102538494Sobrien if ($pref < $cpref) { 102638494Sobrien $nserver = $nh; 102738494Sobrien $cpref = $pref; 102838494Sobrien } elsif ($pref) { 102938494Sobrien $fallback{$pref} .= " $nh"; 103038494Sobrien } 103138494Sobrien } 103238494Sobrien } 103338494Sobrien if (/Non-existent domain/) { 103438494Sobrien # 1035119679Smbr # These addresses are hosed. Kaput! Dead! 103638494Sobrien # However, if we created the address in the 103751591Sobrien # first place then there is a chance of 103838494Sobrien # salvation. 103938494Sobrien # 104051591Sobrien 1 while(<NSLOOKUP>); 104138494Sobrien close(NSLOOKUP); 104238494Sobrien return 0 unless $lastchance; 104338494Sobrien &giveup('domainify',"$server: Non-existent domain",undef,1); 104451591Sobrien return 0; 104538494Sobrien } 104651591Sobrien 104738494Sobrien } 104838494Sobrien close(NSLOOKUP); 104938494Sobrien unlink("/tmp/expn$$"); 105038494Sobrien unless ($nserver) { 105138494Sobrien $0 = "$o0 - finished mxlookup"; 105238494Sobrien return 0 unless $lastchance; 105338494Sobrien &giveup('mx domainify',"$server: Could not resolve address"); 105438494Sobrien return 0; 105538494Sobrien } 105638494Sobrien 105738494Sobrien # provide fallbacks in case $nserver doesn't work out 105838494Sobrien if (defined $fallback{$cpref}) { 105938494Sobrien $mx_secondary{$server} = $fallback{$cpref}; 106038494Sobrien } 106138494Sobrien 106238494Sobrien $0 = "$av0 - gethostbyname($nserver)"; 106338494Sobrien ($name,$aliases,$type,$len,$thataddr) = gethostbyname($nserver); 106438494Sobrien 106538494Sobrien unless ($thataddr) { 106638494Sobrien $0 = $o0; 106738494Sobrien return 0 unless $lastchance; 106838494Sobrien &giveup('mx domainify',"$nserver: could not resolve address"); 106938494Sobrien return 0; 107038494Sobrien } 107138494Sobrien print "MX($server) = $nserver\n" if $debug; 107238494Sobrien print "$server -> $nserver\n" if $vw && !$debug; 107338494Sobrien $mx{&trhost($server)} = $nserver; 107438494Sobrien # redeploy the users 107538494Sobrien unless (&mxredirect($server,*users)) { 107638494Sobrien return 0 unless $lastchance; 107738494Sobrien &giveup('mx domainify',"$nserver: only one level of mx redirect allowed"); 107838494Sobrien return 0; 107938494Sobrien } 108038494Sobrien $0 = "$o0 - finished mxlookup"; 108138494Sobrien return 1; 108238494Sobrien} 108338494Sobrien# if mx expansion did not help to resolve an address 108451591Sobrien# (ie: foo@bar became @baz:foo@bar, then undo the 108538494Sobrien# expansion). 108638494Sobrien# this is only used by &final 108738494Sobriensub mxunroll 108838494Sobrien{ 108938494Sobrien local(*host,*addr) = @_; 109038494Sobrien local($r) = 0; 109138494Sobrien print "looking for mxbacktrace{$addr *** $host}\n" 109238494Sobrien if ($debug > 1); 109338494Sobrien while (defined $mxbacktrace{"$addr *** $host"}) { 1094119679Smbr print "Unrolling MX expansion: \@$host:$addr -> " 109538494Sobrien if ($debug || $verbose); 109638494Sobrien $host = $mxbacktrace{"$addr *** $host"}; 109751591Sobrien print "\@$host:$addr\n" 109838494Sobrien if ($debug || $verbose); 109938494Sobrien $r = 1; 110038494Sobrien } 110138494Sobrien return 1 if $r; 110238494Sobrien $addr = "\@$host:$addr" 110338494Sobrien if ($host =~ /\./); 110438494Sobrien return 0; 110538494Sobrien} 1106119679Smbr# register a completed expansion. Make the final address as 110738494Sobrien# simple as possible. 110838494Sobriensub final 110938494Sobrien{ 111038494Sobrien local($addr,$host,$name,$error) = @_; 111138494Sobrien local($he); 111238494Sobrien local($hb,$hr); 111338494Sobrien local($au,$ah); 111438494Sobrien 111538494Sobrien if ($error =~ /Non-existent domain/) { 111651591Sobrien # 111738494Sobrien # If we created the domain, then let's undo the 111838494Sobrien # damage... 111938494Sobrien # 112038494Sobrien if (defined $create_host_backtrack{"$addr *** $host"}) { 112138494Sobrien while (defined $create_host_backtrack{"$addr *** $host"}) { 112238494Sobrien print "Un&domainifying($host) = " if $debug; 112338494Sobrien $host = $create_host_backtrack{"$addr *** $host"}; 112438494Sobrien print "$host\n" if $debug; 112538494Sobrien } 112638494Sobrien $error = "$host: could not locate"; 112738494Sobrien } else { 112851591Sobrien # 112938494Sobrien # If we only want valid addresses, toss out 113038494Sobrien # bad host names. 113138494Sobrien # 113238494Sobrien if ($valid) { 113338494Sobrien print STDERR "\@$host:$addr ($name) Non-existent domain\n"; 113438494Sobrien return ""; 113538494Sobrien } 113638494Sobrien } 113738494Sobrien } 113838494Sobrien 113938494Sobrien MXUNWIND: { 114038494Sobrien $0 = "$av0 - final parsing of \@$host:$addr"; 114138494Sobrien ($he = $host) =~ s/(\W)/\\$1/g; 114238494Sobrien if ($addr !~ /@/) { 114338494Sobrien # addr does not contain any host 114438494Sobrien $addr = "$addr@$host"; 114538494Sobrien } elsif ($addr !~ /$he/i) { 114638494Sobrien # if host part really something else, use the something 114738494Sobrien # else. 114838494Sobrien if ($addr =~ m/(.*)\@([^\@]+)$/) { 114938494Sobrien ($au,$ah) = ($1,$2); 115038494Sobrien print "au = $au ah = $ah\n" if $debug; 115138494Sobrien if (defined $temporary_redirect{"$addr *** $ah"}) { 115238494Sobrien $addr = "$au\@".$temporary_redirect{"$addr *** $ah"}; 115338494Sobrien print "Rewrite! to $addr\n" if $debug; 115438494Sobrien next MXUNWIND; 115538494Sobrien } 115638494Sobrien } 115738494Sobrien # addr does not contain full host 115838494Sobrien if ($valid) { 115938494Sobrien if ($host =~ /^([^\.]+)(\..+)$/) { 116038494Sobrien # host part has a . in it - foo.bar 116138494Sobrien ($hb, $hr) = ($1, $2); 116238494Sobrien if ($addr =~ /\@([^\.\@]+)$/ && ($1 eq $hb)) { 116351591Sobrien # addr part has not . 116438494Sobrien # and matches beginning of 116551591Sobrien # host part -- tack on a 116638494Sobrien # domain name. 116738494Sobrien $addr .= $hr; 116838494Sobrien } else { 116951591Sobrien &mxunroll(*host,*addr) 117038494Sobrien && redo MXUNWIND; 117138494Sobrien } 117238494Sobrien } else { 117351591Sobrien &mxunroll(*host,*addr) 117438494Sobrien && redo MXUNWIND; 117538494Sobrien } 117638494Sobrien } else { 117738494Sobrien $addr = "${addr}[\@$host]" 117838494Sobrien if ($host =~ /\./); 117938494Sobrien } 118038494Sobrien } 118138494Sobrien } 118238494Sobrien $name = "$name " if $name; 118338494Sobrien $error = " $error" if $error; 118438494Sobrien if ($valid) { 118538494Sobrien push(@final,"$name<$addr>"); 118638494Sobrien } else { 118738494Sobrien push(@final,"$name<$addr>$error"); 118838494Sobrien } 118938494Sobrien "\t$name<$addr>$error\n"; 119038494Sobrien} 119138494Sobrien 119238494Sobriensub alarm 119338494Sobrien{ 119438494Sobrien local($alarm_action,$alarm_redirect,$alarm_user) = @_; 119538494Sobrien alarm(3600); 119638494Sobrien $SIG{ALRM} = 'handle_alarm'; 119738494Sobrien} 119838494Sobrien# this involves one great big ugly hack. 119938494Sobrien# the "next HOST" unwinds the stack! 120038494Sobriensub handle_alarm 120138494Sobrien{ 120238494Sobrien &giveup($alarm_redirect,"Timed out during $alarm_action",$alarm_user); 120338494Sobrien next HOST; 120438494Sobrien} 120538494Sobrien 120638494Sobrien# read the rest of the current smtp daemon's response (and toss it away) 120738494Sobriensub read_response 120838494Sobrien{ 120938494Sobrien local($done,$watch) = @_; 121038494Sobrien local(@resp); 121138494Sobrien print $s if $watch; 121238494Sobrien while(($done eq "-") && ($s = <S>) && ($s =~ /^\d+([- ])/)) { 121338494Sobrien print $s if $watch; 121438494Sobrien $done = $1; 121538494Sobrien push(@resp,$s); 121638494Sobrien } 121738494Sobrien return @resp; 121838494Sobrien} 121938494Sobrien# print args if verbose. Return them in any case 122038494Sobriensub verbose 122138494Sobrien{ 122238494Sobrien local(@tp) = @_; 122338494Sobrien print "@tp" if $verbose; 122438494Sobrien} 122538494Sobrien# to pass perl -w: 122638494Sobrien@tp; 122738494Sobrien$flag_a; 122838494Sobrien$flag_d; 122938494Sobrien$flag_1; 123038494Sobrien%already_domainify_fellback; 123138494Sobrien%already_mx_fellback; 123238494Sobrien&handle_alarm; 123351591Sobrien################### BEGIN PERL/TROFF TRANSITION 123451591Sobrien.00 ; 123538494Sobrien 123638494Sobrien'di 123738494Sobrien.nr nl 0-1 123838494Sobrien.nr % 0 123951591Sobrien.\\"'; __END__ 124038494Sobrien.\" ############## END PERL/TROFF TRANSITION 124138494Sobrien.TH EXPN 1 "March 11, 1993" 124238494Sobrien.AT 3 124338494Sobrien.SH NAME 124438494Sobrienexpn \- recursively expand mail aliases 124538494Sobrien.SH SYNOPSIS 124638494Sobrien.B expn 124738494Sobrien.RI [ -a ] 124838494Sobrien.RI [ -v ] 124938494Sobrien.RI [ -w ] 125038494Sobrien.RI [ -d ] 125138494Sobrien.RI [ -1 ] 125238494Sobrien.IR user [@ hostname ] 125338494Sobrien.RI [ user [@ hostname ]]... 125438494Sobrien.SH DESCRIPTION 125538494Sobrien.B expn 125638494Sobrienwill use the SMTP 125738494Sobrien.B expn 125851591Sobrienand 125938494Sobrien.B vrfy 126051591Sobriencommands to expand mail aliases. 126138494SobrienIt will first look up the addresses you provide on the command line. 126251591SobrienIf those expand into addresses on other systems, it will 126351591Sobrienconnect to the other systems and expand again. It will keep 126438494Sobriendoing this until no further expansion is possible. 126538494Sobrien.SH OPTIONS 126651591SobrienThe default output of 126738494Sobrien.B expn 126838494Sobriencan contain many lines which are not valid 126951591Sobrienemail addresses. With the 127038494Sobrien.I -aa 127138494Sobrienflag, only expansions that result in legal addresses 127238494Sobrienare used. Since many mailing lists have an illegal 127338494Sobrienaddress or two, the single 127438494Sobrien.IR -a , 127538494Sobrienaddress, flag specifies that a few illegal addresses can 127651591Sobrienbe mixed into the results. More 127738494Sobrien.I -a 127838494Sobrienflags vary the ratio. Read the source to track down 127938494Sobrienthe formula. With the 128038494Sobrien.I -a 128138494Sobrienoption, you should be able to construct a new mailing 128238494Sobrienlist out of an existing one. 128338494Sobrien.LP 128451591SobrienIf you wish to limit the number of levels deep that 128538494Sobrien.B expn 128638494Sobrienwill recurse as it traces addresses, use the 128738494Sobrien.I -1 128851591Sobrienoption. For each 128938494Sobrien.I -1 129051591Sobrienanother level will be traversed. So, 129138494Sobrien.I -111 129238494Sobrienwill traverse no more than three levels deep. 129338494Sobrien.LP 129438494SobrienThe normal mode of operation for 129538494Sobrien.B expn 129638494Sobrienis to do all of its work silently. 129738494SobrienThe following options make it more verbose. 129838494SobrienIt is not necessary to make it verbose to see what it is 129951591Sobriendoing because as it works, it changes its 130038494Sobrien.BR argv [0] 130138494Sobrienvariable to reflect its current activity. 130251591SobrienTo see how it is expanding things, the 130338494Sobrien.IR -v , 130451591Sobrienverbose, flag will cause 130551591Sobrien.B expn 130638494Sobriento show each address before 130738494Sobrienand after translation as it works. 130851591SobrienThe 130938494Sobrien.IR -w , 131038494Sobrienwatch, flag will cause 131138494Sobrien.B expn 131238494Sobriento show you its conversations with the mail daemons. 131351591SobrienFinally, the 131438494Sobrien.IR -d , 131538494Sobriendebug, flag will expose many of the inner workings so that 131638494Sobrienit is possible to eliminate bugs. 131738494Sobrien.SH ENVIRONMENT 1318119679SmbrNo environment variables are used. 131938494Sobrien.SH FILES 132038494Sobrien.PD 0 132138494Sobrien.B /tmp/expn$$ 132251591Sobrien.B temporary file used as input to 132338494Sobrien.BR nslookup . 132438494Sobrien.SH SEE ALSO 132551591Sobrien.BR aliases (5), 132638494Sobrien.BR sendmail (8), 132738494Sobrien.BR nslookup (8), 132838494SobrienRFC 823, and RFC 1123. 132938494Sobrien.SH BUGS 133051591SobrienNot all mail daemons will implement 133138494Sobrien.B expn 133238494Sobrienor 133338494Sobrien.BR vrfy . 133438494SobrienIt is not possible to verify addresses that are served 133538494Sobrienby such daemons. 133638494Sobrien.LP 133738494SobrienWhen attempting to connect to a system to verify an address, 133838494Sobrien.B expn 133938494Sobrienonly tries one IP address. Most mail daemons 134038494Sobrienwill try harder. 134138494Sobrien.LP 134251591SobrienIt is assumed that you are running domain names and that 134351591Sobrienthe 134451591Sobrien.BR nslookup (8) 134551591Sobrienprogram is available. If not, 134638494Sobrien.B expn 134738494Sobrienwill not be able to verify many addresses. It will also pause 134838494Sobrienfor a long time unless you change the code where it says 134938494Sobrien.I $have_nslookup = 1 135038494Sobriento read 135151591Sobrien.I $have_nslookup = 135238494Sobrien.IR 0 . 135338494Sobrien.LP 135451591SobrienLastly, 135538494Sobrien.B expn 135638494Sobriendoes not handle every valid address. If you have an example, 135738494Sobrienplease submit a bug report. 135838494Sobrien.SH CREDITS 135938494SobrienIn 1986 or so, Jon Broome wrote a program of the same name 136038494Sobrienthat did about the same thing. It has since suffered bit rot 136138494Sobrienand Jon Broome has dropped off the face of the earth! 136238494Sobrien(Jon, if you are out there, drop me a line) 136338494Sobrien.SH AVAILABILITY 136451591SobrienThe latest version of 136538494Sobrien.B expn 136638494Sobrienis available through anonymous ftp at 136738494Sobrien.IR ftp://ftp.idiom.com/pub/muir-programs/expn . 136838494Sobrien.SH AUTHOR 136938494Sobrien.I David Muir Sharnoff\ \ \ \ <muir@idiom.com> 1370