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