1227652Sgrehan#!@PERL@ 2227652Sgrehan'di '; 3227652Sgrehan'ds 00 \\"'; 4227652Sgrehan'ig 00 '; 5227652Sgrehan# 6227652Sgrehan# THIS PROGRAM IS ITS OWN MANUAL PAGE. INSTALL IN man & bin. 7227652Sgrehan# 8227652Sgrehan 9227652Sgrehan# hardcoded constants, should work fine for BSD-based systems 10227652Sgrehan#require 'sys/socket.ph'; # perl 4 11227652Sgrehanuse Socket; # perl 5 12227652Sgrehan$AF_INET = &AF_INET; 13227652Sgrehan$SOCK_STREAM = &SOCK_STREAM; 14227652Sgrehan$sockaddr = 'S n a4 x8'; 15227652Sgrehan 16227652Sgrehan# system requirements: 17227652Sgrehan# must have 'nslookup' and 'hostname' programs. 18227652Sgrehan 19227652Sgrehan# $Header: /home/cvsroot/am-utils/scripts/expn.1,v 1.4 2003/07/18 15:17:37 ezk Exp $ 20227652Sgrehan 21227652Sgrehan# TODO: 22227652Sgrehan# less magic should apply to command-line addresses 23227652Sgrehan# less magic should apply to local addresses 24227652Sgrehan# add magic to deal with cross-domain cnames 25227652Sgrehan 26227652Sgrehan# Checklist: (hard addresses) 27227652Sgrehan# 250 Kimmo Suominen <"|/usr/local/mh/lib/slocal -user kim"@grendel.tac.nyc.ny.us> 28227652Sgrehan# harry@hofmann.cs.Berkeley.EDU -> harry@tenet (.berkeley.edu) [dead] 29227652Sgrehan# bks@cs.berkeley.edu -> shiva.CS (.berkeley.edu) [dead] 30227652Sgrehan# dan@tc.cornell.edu -> brown@tiberius (.tc.cornell.edu) 31227652Sgrehan 32227652Sgrehan############################################################################# 33227652Sgrehan# 34227652Sgrehan# Copyright (c) 1993 David Muir Sharnoff 35227652Sgrehan# All rights reserved. 36227652Sgrehan# 37227652Sgrehan# Redistribution and use in source and binary forms, with or without 38227652Sgrehan# modification, are permitted provided that the following conditions 39227652Sgrehan# are met: 40227652Sgrehan# 1. Redistributions of source code must retain the above copyright 41227652Sgrehan# notice, this list of conditions and the following disclaimer. 42227652Sgrehan# 2. Redistributions in binary form must reproduce the above copyright 43227652Sgrehan# notice, this list of conditions and the following disclaimer in the 44227652Sgrehan# documentation and/or other materials provided with the distribution. 45227652Sgrehan# 3. All advertising materials mentioning features or use of this software 46227652Sgrehan# must display the following acknowledgment: 47227652Sgrehan# This product includes software developed by the David Muir Sharnoff. 48227652Sgrehan# 4. The name of David Sharnoff may not be used to endorse or promote products 49227652Sgrehan# derived from this software without specific prior written permission. 50227652Sgrehan# 51227652Sgrehan# THIS SOFTWARE IS PROVIDED BY THE DAVID MUIR SHARNOFF ``AS IS'' AND 52227652Sgrehan# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 53227652Sgrehan# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 54227652Sgrehan# ARE DISCLAIMED. IN NO EVENT SHALL DAVID MUIR SHARNOFF BE LIABLE 55227652Sgrehan# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 56227652Sgrehan# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 57227652Sgrehan# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 58227652Sgrehan# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 59227652Sgrehan# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 60227652Sgrehan# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 61227652Sgrehan# SUCH DAMAGE. 62227652Sgrehan# 63227652Sgrehan# This copyright notice derived from material copyrighted by the Regents 64227652Sgrehan# of the University of California. 65227652Sgrehan# 66227652Sgrehan# Contributions accepted. 67227652Sgrehan# 68227652Sgrehan############################################################################# 69227652Sgrehan 70227652Sgrehan# overall structure: 71227652Sgrehan# in an effort to not trace each address individually, but rather 72227652Sgrehan# ask each server in turn a whole bunch of questions, addresses to 73227652Sgrehan# be expanded are queued up. 74227652Sgrehan# 75227652Sgrehan# This means that all accounting w.r.t. an address must be stored in 76227652Sgrehan# various arrays. Generally these arrays are indexed by the 77227652Sgrehan# string "$addr *** $server" where $addr is the address to be 78227652Sgrehan# expanded "foo" or maybe "foo@bar" and $server is the hostname 79227652Sgrehan# of the SMTP server to contact. 80227652Sgrehan# 81227652Sgrehan 82227652Sgrehan# important global variables: 83227652Sgrehan# 84227652Sgrehan# @hosts : list of servers still to be contacted 85227652Sgrehan# $server : name of the current we are currently looking at 86227652Sgrehan# @users = $users{@hosts[0]} : addresses to expand at this server 87227652Sgrehan# $u = $users[0] : the current address being expanded 88227652Sgrehan# $names{"$users[0] *** $server"} : the 'name' associated with the address 89227652Sgrehan# $mxbacktrace{"$users[0] *** $server"} : record of mx expansion 90227652Sgrehan# $mx_secondary{$server} : other mx relays at the same priority 91227652Sgrehan# $domainify_fallback{"$users[0] *** $server"} : alternative names to try 92227652Sgrehan# instead of $server if $server doesn't work 93227652Sgrehan# $temporary_redirect{"$users[0] *** $server"} : when trying alternates, 94227652Sgrehan# temporarily channel all tries along current path 95227652Sgrehan# $giveup{$server} : do not bother expanding addresses at $server 96227652Sgrehan# $verbose : -v 97227652Sgrehan# $watch : -w 98227652Sgrehan# $vw : -v or -w 99227652Sgrehan# $debug : -d 100227652Sgrehan# $valid : -a 101227652Sgrehan# $levels : -1 102227652Sgrehan# S : the socket connection to $server 103227652Sgrehan 104227652Sgrehan$have_nslookup = 1; # we have the nslookup program 105227652Sgrehan$port = 'smtp'; 106227652Sgrehan$av0 = $0; 107227652Sgrehan$ENV{'PATH'} .= ":/usr/etc" unless $ENV{'PATH'} =~ m,/usr/etc,; 108227652Sgrehan$ENV{'PATH'} .= ":/usr/ucb" unless $ENV{'PATH'} =~ m,/usr/ucb,; 109227652Sgrehanselect(STDERR); 110227652Sgrehan 111227652Sgrehan$0 = "$av0 - running hostname"; 112227652Sgrehanchop($name = `hostname || uname -n`); 113227652Sgrehan 114227652Sgrehan$0 = "$av0 - lookup host FQDN and IP addr"; 115227652Sgrehan($hostname,$aliases,$type,$len,$thisaddr) = gethostbyname($name); 116227652Sgrehan 117227652Sgrehan$0 = "$av0 - parsing args"; 118227652Sgrehan$usage = "Usage: $av0 [-1avwd] user[\@host] [user2[host2] ...]"; 119227652Sgrehanfor $a (@ARGV) { 120227652Sgrehan die $usage if $a eq "-"; 121227652Sgrehan while ($a =~ s/^(-.*)([1avwd])/$1/) { 122227652Sgrehan eval '$'."flag_$2 += 1"; 123227652Sgrehan } 124227652Sgrehan next if $a eq "-"; 125227652Sgrehan die $usage if $a =~ /^-/; 126227652Sgrehan &expn(&parse($a,$hostname,undef,1)); 127227652Sgrehan} 128227652Sgrehan$verbose = $flag_v; 129227652Sgrehan$watch = $flag_w; 130227652Sgrehan$vw = $flag_v + $flag_w; 131227652Sgrehan$debug = $flag_d; 132227652Sgrehan$valid = $flag_a; 133227652Sgrehan$levels = $flag_1; 134227652Sgrehan 135227652Sgrehandie $usage unless @hosts; 136227652Sgrehanif ($valid) { 137227652Sgrehan if ($valid == 1) { 138227652Sgrehan $validRequirement = 0.8; 139227652Sgrehan } elsif ($valid == 2) { 140227652Sgrehan $validRequirement = 1.0; 141227652Sgrehan } elsif ($valid == 3) { 142227652Sgrehan $validRequirement = 0.9; 143227652Sgrehan } else { 144227652Sgrehan $validRequirement = (1 - (1/($valid-3))); 145227652Sgrehan print "validRequirement = $validRequirement\n" if $debug; 146227652Sgrehan } 147227652Sgrehan} 148227652Sgrehan 149227652Sgrehan$0 = "$av0 - building local socket"; 150227652Sgrehan($name,$aliases,$proto) = getprotobyname('tcp'); 151227652Sgrehan($name,$aliases,$port) = getservbyname($port,'tcp') 152227652Sgrehan unless $port =~ /^\d+/; 153227652Sgrehan$this = pack($sockaddr, &AF_INET, 0, $thisaddr); 154227652Sgrehan 155227652SgrehanHOST: 156227652Sgrehanwhile (@hosts) { 157227652Sgrehan $server = shift(@hosts); 158227652Sgrehan @users = split(' ',$users{$server}); 159227652Sgrehan delete $users{$server}; 160227652Sgrehan 161227652Sgrehan # is this server already known to be bad? 162227652Sgrehan $0 = "$av0 - looking up $server"; 163227652Sgrehan if ($giveup{$server}) { 164227652Sgrehan &giveup('mx domainify',$giveup{$server}); 165227652Sgrehan next; 166227652Sgrehan } 167227652Sgrehan 168227652Sgrehan # do we already have an mx record for this host? 169227652Sgrehan next HOST if &mxredirect($server,*users); 170227652Sgrehan 171227652Sgrehan # look it up, or try for an mx. 172227652Sgrehan $0 = "$av0 - gethostbyname($server)"; 173227652Sgrehan 174227652Sgrehan ($name,$aliases,$type,$len,$thataddr) = gethostbyname($server); 175227652Sgrehan # if we can't get an A record, try for an MX record. 176227652Sgrehan unless($thataddr) { 177227652Sgrehan &mxlookup(1,$server,"$server: could not resolve name",*users); 178227652Sgrehan next HOST; 179227652Sgrehan } 180227652Sgrehan 181227652Sgrehan # get a connection, or look for an mx 182227652Sgrehan $0 = "$av0 - socket to $server"; 183227652Sgrehan $that = pack($sockaddr, &AF_INET, $port, $thataddr); 184227652Sgrehan socket(S, &AF_INET, &SOCK_STREAM, $proto) 185227652Sgrehan || die "socket: $!"; 186227652Sgrehan $0 = "$av0 - bind to $server"; 187227652Sgrehan bind(S, $this) 188227652Sgrehan || die "bind $hostname,0: $!"; 189227652Sgrehan $0 = "$av0 - connect to $server"; 190227652Sgrehan print "debug = $debug server = $server\n" if $debug > 8; 191227652Sgrehan if (! connect(S, $that) || ($debug == 10 && $server =~ /relay\d.UU.NET$/i)) { 192227652Sgrehan $0 = "$av0 - $server: could not connect: $!\n"; 193227652Sgrehan $emsg = $!; 194227652Sgrehan unless (&mxlookup(0,$server,"$server: could not connect: $!",*users)) { 195227652Sgrehan &giveup('mx',"$server: Could not connect: $emsg"); 196227652Sgrehan } 197227652Sgrehan next HOST; 198227652Sgrehan } 199227652Sgrehan select((select(S),$| = 1)[0]); # don't buffer output to S 200227652Sgrehan 201227652Sgrehan # read the greeting 202227652Sgrehan $0 = "$av0 - talking to $server"; 203227652Sgrehan &alarm("greeting with $server",''); 204227652Sgrehan while(<S>) { 205227652Sgrehan alarm(0); 206227652Sgrehan print if $watch; 207227652Sgrehan if (/^(\d+)([- ])/) { 208227652Sgrehan if ($1 != 220) { 209227652Sgrehan $0 = "$av0 - bad numeric response from $server"; 210227652Sgrehan &alarm("giving up after bad response from $server",''); 211227652Sgrehan &read_response($2,$watch); 212227652Sgrehan alarm(0); 213227652Sgrehan print STDERR "$server: NOT 220 greeting: $_" 214227652Sgrehan if ($debug || $vw); 215227652Sgrehan if (&mxlookup(0,$server,"$server: did not respond with a 220 greeting",*users)) { 216227652Sgrehan close(S); 217227652Sgrehan next HOST; 218227652Sgrehan } 219227652Sgrehan } 220227652Sgrehan last if ($2 eq " "); 221227652Sgrehan } else { 222227652Sgrehan $0 = "$av0 - bad response from $server"; 223227652Sgrehan print STDERR "$server: NOT 220 greeting: $_" 224227652Sgrehan if ($debug || $vw); 225227652Sgrehan unless (&mxlookup(0,$server,"$server: did not respond with SMTP codes",*users)) { 226227652Sgrehan &giveup('',"$server: did not talk SMTP"); 227227652Sgrehan } 228227652Sgrehan close(S); 229227652Sgrehan next HOST; 230227652Sgrehan } 231227652Sgrehan &alarm("greeting with $server",''); 232227652Sgrehan } 233227652Sgrehan alarm(0); 234227652Sgrehan 235227652Sgrehan # if this causes problems, remove it 236227652Sgrehan $0 = "$av0 - sending helo to $server"; 237227652Sgrehan &alarm("sending helo to $server",""); 238227652Sgrehan &ps("helo $hostname"); 239227652Sgrehan while(<S>) { 240227652Sgrehan print if $watch; 241227652Sgrehan last if /^\d+ /; 242227652Sgrehan } 243227652Sgrehan alarm(0); 244227652Sgrehan 245227652Sgrehan # try the users, one by one 246227652Sgrehan USER: 247227652Sgrehan while(@users) { 248227652Sgrehan $u = shift(@users); 249227652Sgrehan $0 = "$av0 - expanding $u [\@$server]"; 250227652Sgrehan 251227652Sgrehan # do we already have a name for this user? 252227652Sgrehan $oldname = $names{"$u *** $server"}; 253227652Sgrehan 254227652Sgrehan print &compact($u,$server)." ->\n" if ($verbose && ! $valid); 255227652Sgrehan if ($valid) { 256227652Sgrehan # 257227652Sgrehan # when running with -a, we delay taking any action 258227652Sgrehan # on the results of our query until we have looked 259227652Sgrehan # at the complete output. @toFinal stores expansions 260227652Sgrehan # that will be final if we take them. @toExpn stores 261227652Sgrehan # expansions that are not final. @isValid keeps 262227652Sgrehan # track of our ability to send mail to each of the 263227652Sgrehan # expansions. 264227652Sgrehan # 265227652Sgrehan @isValid = (); 266227652Sgrehan @toFinal = (); 267227652Sgrehan @toExpn = (); 268227652Sgrehan } 269227652Sgrehan 270227652Sgrehan# ($ecode,@expansion) = &expn_vrfy($u,$server); 271227652Sgrehan (@foo) = &expn_vrfy($u,$server); 272227652Sgrehan ($ecode,@expansion) = @foo; 273227652Sgrehan if ($ecode) { 274227652Sgrehan &giveup('',$ecode,$u); 275227652Sgrehan last USER; 276227652Sgrehan } 277227652Sgrehan 278227652Sgrehan for $s (@expansion) { 279227652Sgrehan $s =~ s/[\n\r]//g; 280227652Sgrehan $0 = "$av0 - parsing $server: $s"; 281227652Sgrehan 282227652Sgrehan $skipwatch = $watch; 283227652Sgrehan 284 if ($s =~ /^[25]51([- ]).*<(.+)>/) { 285 print "$s" if $watch; 286 print "(pretending 250$1<$2>)" if ($debug && $watch); 287 print "\n" if $watch; 288 $s = "250$1<$2>"; 289 $skipwatch = 0; 290 } 291 292 if ($s =~ /^250([- ])(.+)/) { 293 print "$s\n" if $skipwatch; 294 ($done,$addr) = ($1,$2); 295 ($newhost, $newaddr, $newname) = &parse($addr,$server,$oldname, $#expansion == 0); 296 print "($newhost, $newaddr, $newname) = &parse($addr, $server, $oldname)\n" if $debug; 297 if (! $newhost) { 298 # no expansion is possible w/o a new server to call 299 if ($valid) { 300 push(@isValid, &validAddr($newaddr)); 301 push(@toFinal,$newaddr,$server,$newname); 302 } else { 303 &verbose(&final($newaddr,$server,$newname)); 304 } 305 } else { 306 $newmxhost = &mx($newhost,$newaddr); 307 print "$newmxhost = &mx($newhost)\n" 308 if ($debug && $newhost ne $newmxhost); 309 $0 = "$av0 - parsing $newaddr [@$newmxhost]"; 310 print "levels = $levels, level{$u *** $server} = ".$level{"$u *** $server"}."\n" if ($debug > 1); 311 # If the new server is the current one, 312 # it would have expanded things for us 313 # if it could have. Mx records must be 314 # followed to compare server names. 315 # We are also done if the recursion 316 # count has been exceeded. 317 if (&trhost($newmxhost) eq &trhost($server) || ($levels && $level{"$u *** $server"} >= $levels)) { 318 if ($valid) { 319 push(@isValid, &validAddr($newaddr)); 320 push(@toFinal,$newaddr,$newmxhost,$newname); 321 } else { 322 &verbose(&final($newaddr,$newmxhost,$newname)); 323 } 324 } else { 325 # more work to do... 326 if ($valid) { 327 push(@isValid, &validAddr($newaddr)); 328 push(@toExpn,$newmxhost,$newaddr,$newname,$level{"$u *** $server"}); 329 } else { 330 &verbose(&expn($newmxhost,$newaddr,$newname,$level{"$u *** $server"})); 331 } 332 } 333 } 334 last if ($done eq " "); 335 next; 336 } 337 # 550 is a known code... Should the be 338 # included in -a output? Might be a bug 339 # here. Does it matter? Can assume that 340 # there won't be UNKNOWN USER responses 341 # mixed with valid users? 342 if ($s =~ /^(550)([- ])/) { 343 if ($valid) { 344 print STDERR "\@$server:$u ($oldname) USER UNKNOWN\n"; 345 } else { 346 &verbose(&final($u,$server,$oldname,"USER UNKNOWN")); 347 } 348 last if ($2 eq " "); 349 next; 350 } 351 # 553 is a known code... 352 if ($s =~ /^(553)([- ])/) { 353 if ($valid) { 354 print STDERR "\@$server:$u ($oldname) USER AMBIGUOUS\n"; 355 } else { 356 &verbose(&final($u,$server,$oldname,"USER AMBIGUOUS")); 357 } 358 last if ($2 eq " "); 359 next; 360 } 361 # 252 is a known code... 362 if ($s =~ /^(252)([- ])/) { 363 if ($valid) { 364 print STDERR "\@$server:$u ($oldname) REFUSED TO VRFY\n"; 365 } else { 366 &verbose(&final($u,$server,$oldname,"REFUSED TO VRFY")); 367 } 368 last if ($2 eq " "); 369 next; 370 } 371 &giveup('',"$server: did not grok '$s'",$u); 372 last USER; 373 } 374 375 if ($valid) { 376 # 377 # now we decide if we are going to take these 378 # expansions or roll them back. 379 # 380 $avgValid = &average(@isValid); 381 print "avgValid = $avgValid\n" if $debug; 382 if ($avgValid >= $validRequirement) { 383 print &compact($u,$server)." ->\n" if $verbose; 384 while (@toExpn) { 385 &verbose(&expn(splice(@toExpn,0,4))); 386 } 387 while (@toFinal) { 388 &verbose(&final(splice(@toFinal,0,3))); 389 } 390 } else { 391 print "Tossing some valid to avoid invalid ".&compact($u,$server)."\n" if ($avgValid > 0.0 && ($vw || $debug)); 392 print &compact($u,$server)." ->\n" if $verbose; 393 &verbose(&final($u,$server,$newname)); 394 } 395 } 396 } 397 398 &alarm("sending 'quit' to $server",''); 399 $0 = "$av0 - sending 'quit' to $server"; 400 &ps("quit"); 401 while(<S>) { 402 print if $watch; 403 last if /^\d+ /; 404 } 405 close(S); 406 alarm(0); 407} 408 409$0 = "$av0 - printing final results"; 410print "----------\n" if $vw; 411select(STDOUT); 412for $f (sort @final) { 413 print "$f\n"; 414} 415unlink("/tmp/expn$$"); 416exit(0); 417 418 419# abandon all attempts deliver to $server 420# register the current addresses as the final ones 421sub giveup 422{ 423 local($redirect_okay,$reason,$user) = @_; 424 local($us,@so,$nh,@remaining_users); 425 local($pk,$file,$line); 426 ($pk, $file, $line) = caller; 427 428 $0 = "$av0 - giving up on $server: $reason"; 429 # 430 # add back a user if we gave up in the middle 431 # 432 push(@users,$user) if $user; 433 # 434 # don't bother with this system anymore 435 # 436 unless ($giveup{$server}) { 437 $giveup{$server} = $reason; 438 print STDERR "$reason\n"; 439 } 440 print "Giveup at $file:$line!!! redirect okay = $redirect_okay; $reason\n" if $debug; 441 # 442 # Wait! 443 # Before giving up, see if there is a chance that 444 # there is another host to redirect to! 445 # (Kids, don't do this at home! Hacking is a dangerous 446 # crime and you could end up behind bars.) 447 # 448 for $u (@users) { 449 if ($redirect_okay =~ /\bmx\b/) { 450 next if &try_fallback('mx',$u,*server, 451 *mx_secondary, 452 *already_mx_fellback); 453 } 454 if ($redirect_okay =~ /\bdomainify\b/) { 455 next if &try_fallback('domainify',$u,*server, 456 *domainify_fallback, 457 *already_domainify_fellback); 458 } 459 push(@remaining_users,$u); 460 } 461 @users = @remaining_users; 462 for $u (@users) { 463 print &compact($u,$server)." ->\n" if ($verbose && $valid && $u); 464 &verbose(&final($u,$server,$names{"$u *** $server"},$reason)); 465 } 466} 467# 468# This routine is used only within &giveup. It checks to 469# see if we really have to giveup or if there is a second 470# chance because we did something before that can be 471# backtracked. 472# 473# %fallback{"$user *** $host"} tracks what is able to fallback 474# %fellback{"$user *** $host"} tracks what has fallen back 475# 476# If there is a valid backtrack, then queue up the new possibility 477# 478sub try_fallback 479{ 480 local($method,$user,*host,*fall_table,*fellback) = @_; 481 local($us,$fallhost,$oldhost,$ft,$i); 482 483 if ($debug > 8) { 484 print "Fallback table $method:\n"; 485 for $i (sort keys %fall_table) { 486 print "\t'$i'\t\t'$fall_table{$i}'\n"; 487 } 488 print "Fellback table $method:\n"; 489 for $i (sort keys %fellback) { 490 print "\t'$i'\t\t'$fellback{$i}'\n"; 491 } 492 print "U: $user H: $host\n"; 493 } 494 495 $us = "$user *** $host"; 496 if (defined $fellback{$us}) { 497 # 498 # Undo a previous fallback so that we can try again 499 # Nested fallbacks are avoided because they could 500 # lead to infinite loops 501 # 502 $fallhost = $fellback{$us}; 503 print "Already $method fell back from $us -> \n" if $debug; 504 $us = "$user *** $fallhost"; 505 $oldhost = $fallhost; 506 } elsif (($method eq 'mx') && (defined $mxbacktrace{$us}) && (defined $mx_secondary{$mxbacktrace{$us}})) { 507 print "Fallback an MX expansion $us -> \n" if $debug; 508 $oldhost = $mxbacktrace{$us}; 509 } else { 510 print "Oldhost($host, $us) = " if $debug; 511 $oldhost = $host; 512 } 513 print "$oldhost\n" if $debug; 514 if (((defined $fall_table{$us}) && ($ft = $us)) || ((defined $fall_table{$oldhost}) && ($ft = $oldhost))) { 515 print "$method Fallback = ".$fall_table{$ft}."\n" if $debug; 516 local(@so,$newhost); 517 @so = split(' ',$fall_table{$ft}); 518 $newhost = shift(@so); 519 print "Falling back ($method) $us -> $newhost (from $oldhost)\n" if $debug; 520 if ($method eq 'mx') { 521 if (! defined ($mxbacktrace{"$user *** $newhost"})) { 522 if (defined $mxbacktrace{"$user *** $oldhost"}) { 523 print "resetting oldhost $oldhost to the original: " if $debug; 524 $oldhost = $mxbacktrace{"$user *** $oldhost"}; 525 print "$oldhost\n" if $debug; 526 } 527 $mxbacktrace{"$user *** $newhost"} = $oldhost; 528 print "mxbacktrace $user *** $newhost -> $oldhost\n" if $debug; 529 } 530 $mx{&trhost($oldhost)} = $newhost; 531 } else { 532 $temporary_redirect{$us} = $newhost; 533 } 534 if (@so) { 535 print "Can still $method $us: @so\n" if $debug; 536 $fall_table{$ft} = join(' ',@so); 537 } else { 538 print "No more fallbacks for $us\n" if $debug; 539 delete $fall_table{$ft}; 540 } 541 if (defined $create_host_backtrack{$us}) { 542 $create_host_backtrack{"$user *** $newhost"} 543 = $create_host_backtrack{$us}; 544 } 545 $fellback{"$user *** $newhost"} = $oldhost; 546 &expn($newhost,$user,$names{$us},$level{$us}); 547 return 1; 548 } 549 delete $temporary_redirect{$us}; 550 $host = $oldhost; 551 return 0; 552} 553# return 1 if you could send mail to the address as is. 554sub validAddr 555{ 556 local($addr) = @_; 557 $res = &do_validAddr($addr); 558 print "validAddr($addr) = $res\n" if $debug; 559 $res; 560} 561sub do_validAddr 562{ 563 local($addr) = @_; 564 local($urx) = "[-A-Za-z_.0-9+]+"; 565 566 # \u 567 return 0 if ($addr =~ /^\\/); 568 # ?@h 569 return 1 if ($addr =~ /.\@$urx$/); 570 # @h:? 571 return 1 if ($addr =~ /^\@$urx\:./); 572 # h!u 573 return 1 if ($addr =~ /^$urx!./); 574 # u 575 return 1 if ($addr =~ /^$urx$/); 576 # ? 577 print "validAddr($addr) = ???\n" if $debug; 578 return 0; 579} 580# Some systems use expn and vrfy interchangeably. Some only 581# implement one or the other. Some check expn against mailing 582# lists and vrfy against users. It doesn't appear to be 583# consistent. 584# 585# So, what do we do? We try everything! 586# 587# 588# Ranking of result codes: good: 250, 251/551, 252, 550, anything else 589# 590# Ranking of inputs: best: user@host.domain, okay: user 591# 592# Return value: $error_string, @responses_from_server 593sub expn_vrfy 594{ 595 local($u,$server) = @_; 596 local(@c) = ('expn', 'vrfy'); 597 local(@try_u) = $u; 598 local(@ret,$code); 599 600 if (($u =~ /(.+)@(.+)/) && (&trhost($2) eq &trhost($server))) { 601 push(@try_u,$1); 602 } 603 604 TRY: 605 for $c (@c) { 606 for $try_u (@try_u) { 607 &alarm("${c}'ing $try_u on $server",'',$u); 608 &ps("$c $try_u"); 609 alarm(0); 610 $s = <S>; 611 if ($s eq '') { 612 return "$server: lost connection"; 613 } 614 if ($s !~ /^(\d+)([- ])/) { 615 return "$server: garbled reply to '$c $try_u'"; 616 } 617 if ($1 == 250) { 618 $code = 250; 619 @ret = ("",$s); 620 push(@ret,&read_response($2,$debug)); 621 return (@ret); 622 } 623 if ($1 == 551 || $1 == 251) { 624 $code = $1; 625 @ret = ("",$s); 626 push(@ret,&read_response($2,$debug)); 627 next; 628 } 629 if ($1 == 252 && ($code == 0 || $code == 550)) { 630 $code = 252; 631 @ret = ("",$s); 632 push(@ret,&read_response($2,$watch)); 633 next; 634 } 635 if ($1 == 550 && $code == 0) { 636 $code = 550; 637 @ret = ("",$s); 638 push(@ret,&read_response($2,$watch)); 639 next; 640 } 641 &read_response($2,$watch); 642 } 643 } 644 return "$server: expn/vrfy not implemented" unless @ret; 645 return @ret; 646} 647# sometimes the old parse routine (now parse2) didn't 648# reject funky addresses. 649sub parse 650{ 651 local($oldaddr,$server,$oldname,$one_to_one) = @_; 652 local($newhost, $newaddr, $newname, $um) = &parse2($oldaddr,$server,$oldname,$one_to_one); 653 if ($newaddr =~ m,^["/],) { 654 return (undef, $oldaddr, $newname) if $valid; 655 return (undef, $um, $newname); 656 } 657 return ($newhost, $newaddr, $newname); 658} 659 660# returns ($new_smtp_server,$new_address,$new_name) 661# given a response from a SMTP server ($newaddr), the 662# current host ($server), the old "name" and a flag that 663# indicates if it is being called during the initial 664# command line parsing ($parsing_args) 665sub parse2 666{ 667 local($newaddr,$context_host,$old_name,$parsing_args) = @_; 668 local(@names) = $old_name; 669 local($urx) = "[-A-Za-z_.0-9+]+"; 670 local($unmangle); 671 672 # 673 # first, separate out the address part. 674 # 675 676 # 677 # [NAME] <ADDR [(NAME)]> 678 # [NAME] <[(NAME)] ADDR 679 # ADDR [(NAME)] 680 # (NAME) ADDR 681 # [(NAME)] <ADDR> 682 # 683 if ($newaddr =~ /^\<(.*)\>$/) { 684 print "<A:$1>\n" if $debug; 685 ($newaddr) = &trim($1); 686 print "na = $newaddr\n" if $debug; 687 } 688 if ($newaddr =~ /^([^\<\>]*)\<([^\<\>]*)\>([^\<\>]*)$/) { 689 # address has a < > pair in it. 690 print "N:$1 <A:$2> N:$3\n" if $debug; 691 ($newaddr) = &trim($2); 692 unshift(@names, &trim($3,$1)); 693 print "na = $newaddr\n" if $debug; 694 } 695 if ($newaddr =~ /^([^\(\)]*)\(([^\(\)]*)\)([^\(\)]*)$/) { 696 # address has a ( ) pair in it. 697 print "A:$1 (N:$2) A:$3\n" if $debug; 698 unshift(@names,&trim($2)); 699 local($f,$l) = (&trim($1),&trim($3)); 700 if (($f && $l) || !($f || $l)) { 701 # address looks like: 702 # foo (bar) baz or (bar) 703 # not allowed! 704 print STDERR "Could not parse $newaddr\n" if $vw; 705 return(undef,$newaddr,&firstname(@names)); 706 } 707 $newaddr = $f if $f; 708 $newaddr = $l if $l; 709 print "newaddr now = $newaddr\n" if $debug; 710 } 711 # 712 # @foo:bar 713 # j%k@l 714 # a@b 715 # b!a 716 # a 717 # 718 $unmangle = $newaddr; 719 if ($newaddr =~ /^\@($urx)\:(.+)$/) { 720 print "(\@:)" if $debug; 721 # this is a bit of a cheat, but it seems necessary 722 return (&domainify($1,$context_host,$2),$2,&firstname(@names),$unmangle); 723 } 724 if ($newaddr =~ /^(.+)\@($urx)$/) { 725 print "(\@)" if $debug; 726 return (&domainify($2,$context_host,$newaddr),$newaddr,&firstname(@names),$unmangle); 727 } 728 if ($parsing_args) { 729 if ($newaddr =~ /^($urx)\!(.+)$/) { 730 return (&domainify($1,$context_host,$newaddr),$newaddr,&firstname(@names),$unmangle); 731 } 732 if ($newaddr =~ /^($urx)$/) { 733 return ($context_host,$newaddr,&firstname(@names),$unmangle); 734 } 735 print STDERR "Could not parse $newaddr\n"; 736 } 737 print "(?)" if $debug; 738 return(undef,$newaddr,&firstname(@names),$unmangle); 739} 740# return $u (@$server) unless $u includes reference to $server 741sub compact 742{ 743 local($u, $server) = @_; 744 local($se) = $server; 745 local($sp); 746 $se =~ s/(\W)/\\$1/g; 747 $sp = " (\@$server)"; 748 if ($u !~ /$se/i) { 749 return "$u$sp"; 750 } 751 return $u; 752} 753# remove empty (spaces don't count) members from an array 754sub trim 755{ 756 local(@v) = @_; 757 local($v,@r); 758 for $v (@v) { 759 $v =~ s/^\s+//; 760 $v =~ s/\s+$//; 761 push(@r,$v) if ($v =~ /\S/); 762 } 763 return(@r); 764} 765# using the host part of an address, and the server name, add the 766# servers' domain to the address if it doesn't already have a 767# domain. Since this sometimes fails, save a back reference so 768# it can be unrolled. 769sub domainify 770{ 771 local($host,$domain_host,$u) = @_; 772 local($domain,$newhost); 773 774 # cut of trailing dots 775 $host =~ s/\.$//; 776 $domain_host =~ s/\.$//; 777 778 if ($domain_host !~ /\./) { 779 # 780 # domain host isn't, keep $host whatever it is 781 # 782 print "domainify($host,$domain_host) = $host\n" if $debug; 783 return $host; 784 } 785 786 # 787 # There are several weird situations that need to be 788 # accounted for. They have to do with domain relay hosts. 789 # 790 # Examples: 791 # host server "right answer" 792 # 793 # shiva.cs cs.berkeley.edu shiva.cs.berkeley.edu 794 # shiva cs.berkeley.edu shiva.cs.berekley.edu 795 # cumulus reed.edu @reed.edu:cumulus.uucp 796 # tiberius tc.cornell.edu tiberius.tc.cornell.edu 797 # 798 # The first try must always be to cut the domain part out of 799 # the server and tack it onto the host. 800 # 801 # A reasonable second try is to tack the whole server part onto 802 # the host and for each possible repeated element, eliminate 803 # just that part. 804 # 805 # These extra "guesses" get put into the %domainify_fallback 806 # array. They will be used to give addresses a second chance 807 # in the &giveup routine 808 # 809 810 local(%fallback); 811 812 local($long); 813 $long = "$host $domain_host"; 814 $long =~ tr/A-Z/a-z/; 815 print "long = $long\n" if $debug; 816 if ($long =~ s/^([^ ]+\.)([^ ]+) \2(\.[^ ]+\.[^ ]+)/$1$2$3/) { 817 # matches shiva.cs cs.berkeley.edu and returns shiva.cs.berkeley.edu 818 print "condensed fallback $host $domain_host -> $long\n" if $debug; 819 $fallback{$long} = 9; 820 } 821 822 local($fh); 823 $fh = $domain_host; 824 while ($fh =~ /\./) { 825 print "FALLBACK $host.$fh = 1\n" if $debug > 7; 826 $fallback{"$host.$fh"} = 1; 827 $fh =~ s/^[^\.]+\.//; 828 } 829 830 $fallback{"$host.$domain_host"} = 2; 831 832 ($domain = $domain_host) =~ s/^[^\.]+//; 833 $fallback{"$host$domain"} = 6 834 if ($domain =~ /\./); 835 836 if ($host =~ /\./) { 837 # 838 # Host is already okay, but let's look for multiple 839 # interpretations 840 # 841 print "domainify($host,$domain_host) = $host\n" if $debug; 842 delete $fallback{$host}; 843 $domainify_fallback{"$u *** $host"} = join(' ',sort {$fallback{$b} <=> $fallback{$a};} keys %fallback) if %fallback; 844 return $host; 845 } 846 847 $domain = ".$domain_host" 848 if ($domain !~ /\..*\./); 849 $newhost = "$host$domain"; 850 851 $create_host_backtrack{"$u *** $newhost"} = $domain_host; 852 print "domainify($host,$domain_host) = $newhost\n" if $debug; 853 delete $fallback{$newhost}; 854 $domainify_fallback{"$u *** $newhost"} = join(' ',sort {$fallback{$b} <=> $fallback{$a};} keys %fallback) if %fallback; 855 if ($debug) { 856 print "fallback = "; 857 print $domainify_fallback{"$u *** $newhost"} 858 if defined($domainify_fallback{"$u *** $newhost"}); 859 print "\n"; 860 } 861 return $newhost; 862} 863# return the first non-empty element of an array 864sub firstname 865{ 866 local(@names) = @_; 867 local($n); 868 while(@names) { 869 $n = shift(@names); 870 return $n if $n =~ /\S/; 871 } 872 return undef; 873} 874# queue up more addresses to expand 875sub expn 876{ 877 local($host,$addr,$name,$level) = @_; 878 if ($host) { 879 $host = &trhost($host); 880 881 if (($debug > 3) || (defined $giveup{$host})) { 882 unshift(@hosts,$host) unless $users{$host}; 883 } else { 884 push(@hosts,$host) unless $users{$host}; 885 } 886 $users{$host} .= " $addr"; 887 $names{"$addr *** $host"} = $name; 888 $level{"$addr *** $host"} = $level + 1; 889 print "expn($host,$addr,$name)\n" if $debug; 890 return "\t$addr\n"; 891 } else { 892 return &final($addr,'NONE',$name); 893 } 894} 895# compute the numerical average value of an array 896sub average 897{ 898 local(@e) = @_; 899 return 0 unless @e; 900 local($e,$sum); 901 for $e (@e) { 902 $sum += $e; 903 } 904 $sum / @e; 905} 906# print to the server (also to stdout, if -w) 907sub ps 908{ 909 local($p) = @_; 910 print ">>> $p\n" if $watch; 911 print S "$p\n"; 912} 913# return case-adjusted name for a host (for comparison purposes) 914sub trhost 915{ 916 # treat foo.bar as an alias for Foo.BAR 917 local($host) = @_; 918 local($trhost) = $host; 919 $trhost =~ tr/A-Z/a-z/; 920 if ($trhost{$trhost}) { 921 $host = $trhost{$trhost}; 922 } else { 923 $trhost{$trhost} = $host; 924 } 925 $trhost{$trhost}; 926} 927# re-queue users if an mx record dictates a redirect 928# don't allow a user to be redirected more than once 929sub mxredirect 930{ 931 local($server,*users) = @_; 932 local($u,$nserver,@still_there); 933 934 $nserver = &mx($server); 935 936 if (&trhost($nserver) ne &trhost($server)) { 937 $0 = "$av0 - mx redirect $server -> $nserver\n"; 938 for $u (@users) { 939 if (defined $mxbacktrace{"$u *** $nserver"}) { 940 push(@still_there,$u); 941 } else { 942 $mxbacktrace{"$u *** $nserver"} = $server; 943 print "mxbacktrace{$u *** $nserver} = $server\n" 944 if ($debug > 1); 945 &expn($nserver,$u,$names{"$u *** $server"}); 946 } 947 } 948 @users = @still_there; 949 if (! @users) { 950 return $nserver; 951 } else { 952 return undef; 953 } 954 } 955 return undef; 956} 957# follow mx records, return a hostname 958# also follow temporary redirections coming from &domainify and 959# &mxlookup 960sub mx 961{ 962 local($h,$u) = @_; 963 964 for (;;) { 965 if (defined $mx{&trhost($h)} && $h ne $mx{&trhost($h)}) { 966 $0 = "$av0 - mx expand $h"; 967 $h = $mx{&trhost($h)}; 968 return $h; 969 } 970 if ($u) { 971 if (defined $temporary_redirect{"$u *** $h"}) { 972 $0 = "$av0 - internal redirect $h"; 973 print "Temporary redirect taken $u *** $h -> " if $debug; 974 $h = $temporary_redirect{"$u *** $h"}; 975 print "$h\n" if $debug; 976 next; 977 } 978 $htr = &trhost($h); 979 if (defined $temporary_redirect{"$u *** $htr"}) { 980 $0 = "$av0 - internal redirect $h"; 981 print "temporary redirect taken $u *** $h -> " if $debug; 982 $h = $temporary_redirect{"$u *** $htr"}; 983 print "$h\n" if $debug; 984 next; 985 } 986 } 987 return $h; 988 } 989} 990# look up mx records with the name server. 991# re-queue expansion requests if possible 992# optionally give up on this host. 993sub mxlookup 994{ 995 local($lastchance,$server,$giveup,*users) = @_; 996 local(*T); 997 local(*NSLOOKUP); 998 local($nh, $pref,$cpref); 999 local($o0) = $0; 1000 local($nserver); 1001 local($name,$aliases,$type,$len,$thataddr); 1002 local(%fallback); 1003 1004 return 1 if &mxredirect($server,*users); 1005 1006 if ((defined $mx{$server}) || (! $have_nslookup)) { 1007 return 0 unless $lastchance; 1008 &giveup('mx domainify',$giveup); 1009 return 0; 1010 } 1011 1012 $0 = "$av0 - nslookup of $server"; 1013 open(T,">/tmp/expn$$") || die "open > /tmp/expn$$: $!\n"; 1014 print T "set querytype=MX\n"; 1015 print T "$server\n"; 1016 close(T); 1017 $cpref = 1.0E12; 1018 undef $nserver; 1019 open(NSLOOKUP,"nslookup < /tmp/expn$$ 2>&1 |") || die "open nslookup: $!"; 1020 while(<NSLOOKUP>) { 1021 print if ($debug > 2); 1022 if (/mail exchanger = ([-A-Za-z_.0-9+]+)/) { 1023 $nh = $1; 1024 if (/preference = (\d+)/) { 1025 $pref = $1; 1026 if ($pref < $cpref) { 1027 $nserver = $nh; 1028 $cpref = $pref; 1029 } elsif ($pref) { 1030 $fallback{$pref} .= " $nh"; 1031 } 1032 } 1033 } 1034 if (/Non-existent domain/) { 1035 # 1036 # These addresses are hosed. Kaput! Dead! 1037 # However, if we created the address in the 1038 # first place then there is a chance of 1039 # salvation. 1040 # 1041 1 while(<NSLOOKUP>); 1042 close(NSLOOKUP); 1043 return 0 unless $lastchance; 1044 &giveup('domainify',"$server: Non-existent domain",undef,1); 1045 return 0; 1046 } 1047 1048 } 1049 close(NSLOOKUP); 1050 unlink("/tmp/expn$$"); 1051 unless ($nserver) { 1052 $0 = "$o0 - finished mxlookup"; 1053 return 0 unless $lastchance; 1054 &giveup('mx domainify',"$server: Could not resolve address"); 1055 return 0; 1056 } 1057 1058 # provide fallbacks in case $nserver doesn't work out 1059 if (defined $fallback{$cpref}) { 1060 $mx_secondary{$server} = $fallback{$cpref}; 1061 } 1062 1063 $0 = "$av0 - gethostbyname($nserver)"; 1064 ($name,$aliases,$type,$len,$thataddr) = gethostbyname($nserver); 1065 1066 unless ($thataddr) { 1067 $0 = $o0; 1068 return 0 unless $lastchance; 1069 &giveup('mx domainify',"$nserver: could not resolve address"); 1070 return 0; 1071 } 1072 print "MX($server) = $nserver\n" if $debug; 1073 print "$server -> $nserver\n" if $vw && !$debug; 1074 $mx{&trhost($server)} = $nserver; 1075 # redeploy the users 1076 unless (&mxredirect($server,*users)) { 1077 return 0 unless $lastchance; 1078 &giveup('mx domainify',"$nserver: only one level of mx redirect allowed"); 1079 return 0; 1080 } 1081 $0 = "$o0 - finished mxlookup"; 1082 return 1; 1083} 1084# if mx expansion did not help to resolve an address 1085# (ie: foo@bar became @baz:foo@bar, then undo the 1086# expansion). 1087# this is only used by &final 1088sub mxunroll 1089{ 1090 local(*host,*addr) = @_; 1091 local($r) = 0; 1092 print "looking for mxbacktrace{$addr *** $host}\n" 1093 if ($debug > 1); 1094 while (defined $mxbacktrace{"$addr *** $host"}) { 1095 print "Unrolling MX expansion: \@$host:$addr -> " 1096 if ($debug || $verbose); 1097 $host = $mxbacktrace{"$addr *** $host"}; 1098 print "\@$host:$addr\n" 1099 if ($debug || $verbose); 1100 $r = 1; 1101 } 1102 return 1 if $r; 1103 $addr = "\@$host:$addr" 1104 if ($host =~ /\./); 1105 return 0; 1106} 1107# register a completed expansion. Make the final address as 1108# simple as possible. 1109sub final 1110{ 1111 local($addr,$host,$name,$error) = @_; 1112 local($he); 1113 local($hb,$hr); 1114 local($au,$ah); 1115 1116 if ($error =~ /Non-existent domain/) { 1117 # 1118 # If we created the domain, then let's undo the 1119 # damage... 1120 # 1121 if (defined $create_host_backtrack{"$addr *** $host"}) { 1122 while (defined $create_host_backtrack{"$addr *** $host"}) { 1123 print "Un&domainifying($host) = " if $debug; 1124 $host = $create_host_backtrack{"$addr *** $host"}; 1125 print "$host\n" if $debug; 1126 } 1127 $error = "$host: could not locate"; 1128 } else { 1129 # 1130 # If we only want valid addresses, toss out 1131 # bad host names. 1132 # 1133 if ($valid) { 1134 print STDERR "\@$host:$addr ($name) Non-existent domain\n"; 1135 return ""; 1136 } 1137 } 1138 } 1139 1140 MXUNWIND: { 1141 $0 = "$av0 - final parsing of \@$host:$addr"; 1142 ($he = $host) =~ s/(\W)/\\$1/g; 1143 if ($addr !~ /@/) { 1144 # addr does not contain any host 1145 $addr = "$addr@$host"; 1146 } elsif ($addr !~ /$he/i) { 1147 # if host part really something else, use the something 1148 # else. 1149 if ($addr =~ m/(.*)\@([^\@]+)$/) { 1150 ($au,$ah) = ($1,$2); 1151 print "au = $au ah = $ah\n" if $debug; 1152 if (defined $temporary_redirect{"$addr *** $ah"}) { 1153 $addr = "$au\@".$temporary_redirect{"$addr *** $ah"}; 1154 print "Rewrite! to $addr\n" if $debug; 1155 next MXUNWIND; 1156 } 1157 } 1158 # addr does not contain full host 1159 if ($valid) { 1160 if ($host =~ /^([^\.]+)(\..+)$/) { 1161 # host part has a . in it - foo.bar 1162 ($hb, $hr) = ($1, $2); 1163 if ($addr =~ /\@([^\.\@]+)$/ && ($1 eq $hb)) { 1164 # addr part has not . 1165 # and matches beginning of 1166 # host part -- tack on a 1167 # domain name. 1168 $addr .= $hr; 1169 } else { 1170 &mxunroll(*host,*addr) 1171 && redo MXUNWIND; 1172 } 1173 } else { 1174 &mxunroll(*host,*addr) 1175 && redo MXUNWIND; 1176 } 1177 } else { 1178 $addr = "${addr}[\@$host]" 1179 if ($host =~ /\./); 1180 } 1181 } 1182 } 1183 $name = "$name " if $name; 1184 $error = " $error" if $error; 1185 if ($valid) { 1186 push(@final,"$name<$addr>"); 1187 } else { 1188 push(@final,"$name<$addr>$error"); 1189 } 1190 "\t$name<$addr>$error\n"; 1191} 1192 1193sub alarm 1194{ 1195 local($alarm_action,$alarm_redirect,$alarm_user) = @_; 1196 alarm(3600); 1197 $SIG{ALRM} = 'handle_alarm'; 1198} 1199# this involves one great big ugly hack. 1200# the "next HOST" unwinds the stack! 1201sub handle_alarm 1202{ 1203 &giveup($alarm_redirect,"Timed out during $alarm_action",$alarm_user); 1204 next HOST; 1205} 1206 1207# read the rest of the current smtp daemon's response (and toss it away) 1208sub read_response 1209{ 1210 local($done,$watch) = @_; 1211 local(@resp); 1212 print $s if $watch; 1213 while(($done eq "-") && ($s = <S>) && ($s =~ /^\d+([- ])/)) { 1214 print $s if $watch; 1215 $done = $1; 1216 push(@resp,$s); 1217 } 1218 return @resp; 1219} 1220# print args if verbose. Return them in any case 1221sub verbose 1222{ 1223 local(@tp) = @_; 1224 print "@tp" if $verbose; 1225} 1226# to pass perl -w: 1227@tp; 1228$flag_a; 1229$flag_d; 1230$flag_1; 1231%already_domainify_fellback; 1232%already_mx_fellback; 1233&handle_alarm; 1234################### BEGIN PERL/TROFF TRANSITION 1235.00 ; 1236 1237'di 1238.nr nl 0-1 1239.nr % 0 1240.\\"'; __END__ 1241.\" ############## END PERL/TROFF TRANSITION 1242.TH EXPN 1 "March 11, 1993" 1243.AT 3 1244.SH NAME 1245expn \- recursively expand mail aliases 1246.SH SYNOPSIS 1247.B expn 1248.RI [ -a ] 1249.RI [ -v ] 1250.RI [ -w ] 1251.RI [ -d ] 1252.RI [ -1 ] 1253.IR user [@ hostname ] 1254.RI [ user [@ hostname ]]... 1255.SH DESCRIPTION 1256.B expn 1257will use the SMTP 1258.B expn 1259and 1260.B vrfy 1261commands to expand mail aliases. 1262It will first look up the addresses you provide on the command line. 1263If those expand into addresses on other systems, it will 1264connect to the other systems and expand again. It will keep 1265doing this until no further expansion is possible. 1266.SH OPTIONS 1267The default output of 1268.B expn 1269can contain many lines which are not valid 1270email addresses. With the 1271.I -aa 1272flag, only expansions that result in legal addresses 1273are used. Since many mailing lists have an illegal 1274address or two, the single 1275.IR -a , 1276address, flag specifies that a few illegal addresses can 1277be mixed into the results. More 1278.I -a 1279flags vary the ratio. Read the source to track down 1280the formula. With the 1281.I -a 1282option, you should be able to construct a new mailing 1283list out of an existing one. 1284.LP 1285If you wish to limit the number of levels deep that 1286.B expn 1287will recurse as it traces addresses, use the 1288.I -1 1289option. For each 1290.I -1 1291another level will be traversed. So, 1292.I -111 1293will traverse no more than three levels deep. 1294.LP 1295The normal mode of operation for 1296.B expn 1297is to do all of its work silently. 1298The following options make it more verbose. 1299It is not necessary to make it verbose to see what it is 1300doing because as it works, it changes its 1301.BR argv [0] 1302variable to reflect its current activity. 1303To see how it is expanding things, the 1304.IR -v , 1305verbose, flag will cause 1306.B expn 1307to show each address before 1308and after translation as it works. 1309The 1310.IR -w , 1311watch, flag will cause 1312.B expn 1313to show you its conversations with the mail daemons. 1314Finally, the 1315.IR -d , 1316debug, flag will expose many of the inner workings so that 1317it is possible to eliminate bugs. 1318.SH ENVIRONMENT 1319No environment variables are used. 1320.SH FILES 1321.B /tmp/expn$$ 1322.B temporary file used as input to 1323.BR nslookup . 1324.SH SEE ALSO 1325.BR aliases (5), 1326.BR sendmail (8), 1327.BR nslookup (8), 1328RFC 823, and RFC 1123. 1329.SH BUGS 1330Not all mail daemons will implement 1331.B expn 1332or 1333.BR vrfy . 1334It is not possible to verify addresses that are served 1335by such daemons. 1336.LP 1337When attempting to connect to a system to verify an address, 1338.B expn 1339only tries one IP address. Most mail daemons 1340will try harder. 1341.LP 1342It is assumed that you are running domain names and that 1343the 1344.BR nslookup (8) 1345program is available. If not, 1346.B expn 1347will not be able to verify many addresses. It will also pause 1348for a long time unless you change the code where it says 1349.I $have_nslookup = 1 1350to read 1351.I $have_nslookup = 1352.IR 0 . 1353.LP 1354Lastly, 1355.B expn 1356does not handle every valid address. If you have an example, 1357please submit a bug report. 1358.SH CREDITS 1359In 1986 or so, Jon Broome wrote a program of the same name 1360that did about the same thing. It has since suffered bit rot 1361and Jon Broome has dropped off the face of the earth! 1362(Jon, if you are out there, drop me a line) 1363.SH AVAILABILITY 1364The latest version of 1365.B expn 1366is available through anonymous ftp at 1367.IR ftp://ftp.idiom.com/pub/muir-programs/expn . 1368.SH AUTHOR 1369.I David Muir Sharnoff\ \ \ \ <muir@idiom.com> 1370