6 # THIS PROGRAM IS ITS OWN MANUAL PAGE. INSTALL IN man & bin.
13 # system requirements:
14 # must have 'nslookup' and 'hostname' programs.
16 # $OrigHeader: /home/muir/bin/RCS/expn,v 3.11 1997/09/10 08:14:02 muir Exp muir $
19 # less magic should apply to command-line addresses
20 # less magic should apply to local addresses
21 # add magic to deal with cross-domain cnames
22 # disconnect & reconnect after 25 commands to the same sendmail 8.8.* host
24 # Checklist: (hard addresses)
25 # 250 Kimmo Suominen <"|/usr/local/mh/lib/slocal -user kim"@grendel.tac.nyc.ny.us>
26 # harry@hofmann.cs.Berkeley.EDU -> harry@tenet (.berkeley.edu) [dead]
27 # bks@cs.berkeley.edu -> shiva.CS (.berkeley.edu) [dead]
28 # dan@tc.cornell.edu -> brown@tiberius (.tc.cornell.edu)
30 #############################################################################
32 # Copyright (c) 1993 David Muir Sharnoff
33 # All rights reserved.
35 # Redistribution and use in source and binary forms, with or without
36 # modification, are permitted provided that the following conditions
38 # 1. Redistributions of source code must retain the above copyright
39 # notice, this list of conditions and the following disclaimer.
40 # 2. Redistributions in binary form must reproduce the above copyright
41 # notice, this list of conditions and the following disclaimer in the
42 # documentation and/or other materials provided with the distribution.
43 # 3. All advertising materials mentioning features or use of this software
44 # must display the following acknowledgement:
45 # This product includes software developed by the David Muir Sharnoff.
46 # 4. The name of David Sharnoff may not be used to endorse or promote products
47 # derived from this software without specific prior written permission.
49 # THIS SOFTWARE IS PROVIDED BY THE DAVID MUIR SHARNOFF ``AS IS'' AND
50 # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
51 # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
52 # ARE DISCLAIMED. IN NO EVENT SHALL DAVID MUIR SHARNOFF BE LIABLE
53 # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
54 # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
55 # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
56 # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
57 # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
58 # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
61 # This copyright notice derrived from material copyrighted by the Regents
62 # of the University of California.
64 # Contributions accepted.
66 #############################################################################
69 # in an effort to not trace each address individually, but rather
70 # ask each server in turn a whole bunch of questions, addresses to
71 # be expanded are queued up.
73 # This means that all accounting w.r.t. an address must be stored in
74 # various arrays. Generally these arrays are indexed by the
75 # string "$addr *** $server" where $addr is the address to be
76 # expanded "foo" or maybe "foo@bar" and $server is the hostname
77 # of the SMTP server to contact.
80 # important global variables:
82 # @hosts : list of servers still to be contacted
83 # $server : name of the current we are currently looking at
84 # @users = $users{@hosts[0]} : addresses to expand at this server
85 # $u = $users[0] : the current address being expanded
86 # $names{"$users[0] *** $server"} : the 'name' associated with the address
87 # $mxbacktrace{"$users[0] *** $server"} : record of mx expansion
88 # $mx_secondary{$server} : other mx relays at the same priority
89 # $domainify_fallback{"$users[0] *** $server"} : alternative names to try
90 # instead of $server if $server doesn't work
91 # $temporary_redirect{"$users[0] *** $server"} : when trying alternates,
92 # temporarily channel all tries along current path
93 # $giveup{$server} : do not bother expanding addresses at $server
100 # $S : the socket connection to $server
102 $have_nslookup = 1; # we have the nslookup program
105 $ENV{'PATH'} .= ":/usr/etc" unless $ENV{'PATH'} =~ m,/usr/etc,;
106 $ENV{'PATH'} .= ":/usr/ucb" unless $ENV{'PATH'} =~ m,/usr/ucb,;
109 $0 = "$av0 - running hostname";
110 chop($name = `hostname || uname -n`);
112 $0 = "$av0 - lookup host FQDN and IP addr";
113 ($hostname,$aliases,$type,$len,$thisaddr) = gethostbyname($name);
115 $0 = "$av0 - parsing args";
116 $usage = "Usage: $av0 [-1avwd] user[\@host] [user2[host2] ...]";
118 die $usage if $a eq "-";
119 while ($a =~ s/^(-.*)([1avwd])/$1/) {
120 eval '$'."flag_$2 += 1";
123 die $usage if $a =~ /^-/;
124 &expn(&parse($a,$hostname,undef,1));
128 $vw = $flag_v + $flag_w;
133 die $usage unless @hosts;
136 $validRequirement = 0.8;
137 } elsif ($valid == 2) {
138 $validRequirement = 1.0;
139 } elsif ($valid == 3) {
140 $validRequirement = 0.9;
142 $validRequirement = (1 - (1/($valid-3)));
143 print "validRequirement = $validRequirement\n" if $debug;
149 $server = shift(@hosts);
150 @users = split(' ',$users{$server});
151 delete $users{$server};
153 # is this server already known to be bad?
154 $0 = "$av0 - looking up $server";
155 if ($giveup{$server}) {
156 &giveup('mx domainify',$giveup{$server});
160 # do we already have an mx record for this host?
161 next HOST if &mxredirect($server,*users);
163 # look it up, or try for an mx.
164 $0 = "$av0 - gethostbyname($server)";
166 ($name,$aliases,$type,$len,$thataddr) = gethostbyname($server);
167 # if we can't get an A record, try for an MX record.
169 &mxlookup(1,$server,"$server: could not resolve name",*users);
173 # get a connection, or look for an mx
174 $0 = "$av0 - socket to $server";
176 $S = new IO::Socket::INET (
177 'PeerAddr' => $server,
181 if (! $S || ($debug == 10 && $server =~ /relay\d.UU.NET$/i)) {
182 $0 = "$av0 - $server: could not connect: $!\n";
184 unless (&mxlookup(0,$server,"$server: could not connect: $!",*users)) {
185 &giveup('mx',"$server: Could not connect: $emsg");
192 $0 = "$av0 - talking to $server";
193 &alarm("greeting with $server",'');
197 if (/^(\d+)([- ])/) {
199 $0 = "$av0 - bad numeric response from $server";
200 &alarm("giving up after bad response from $server",'');
201 &read_response($2,$watch);
203 print STDERR "$server: NOT 220 greeting: $_"
205 if (&mxlookup(0,$server,"$server: did not respond with a 220 greeting",*users)) {
212 $0 = "$av0 - bad response from $server";
213 print STDERR "$server: NOT 220 greeting: $_"
215 unless (&mxlookup(0,$server,"$server: did not respond with SMTP codes",*users)) {
216 &giveup('',"$server: did not talk SMTP");
221 &alarm("greeting with $server",'');
225 # if this causes problems, remove it
226 $0 = "$av0 - sending helo to $server";
227 &alarm("sending helo to $server","");
228 &ps("helo $hostname");
235 # try the users, one by one
239 $0 = "$av0 - expanding $u [\@$server]";
241 # do we already have a name for this user?
242 $oldname = $names{"$u *** $server"};
244 print &compact($u,$server)." ->\n" if ($verbose && ! $valid);
247 # when running with -a, we delay taking any action
248 # on the results of our query until we have looked
249 # at the complete output. @toFinal stores expansions
250 # that will be final if we take them. @toExpn stores
251 # expnansions that are not final. @isValid keeps
252 # track of our ability to send mail to each of the
260 # ($ecode,@expansion) = &expn_vrfy($u,$server);
261 (@foo) = &expn_vrfy($u,$server);
262 ($ecode,@expansion) = @foo;
264 &giveup('',$ecode,$u);
268 for $s (@expansion) {
270 $0 = "$av0 - parsing $server: $s";
274 if ($s =~ /^[25]51([- ]).*<(.+)>/) {
275 print "$s" if $watch;
276 print "(pretending 250$1<$2>)" if ($debug && $watch);
277 print "\n" if $watch;
282 if ($s =~ /^250([- ])(.+)/) {
283 print "$s\n" if $skipwatch;
284 ($done,$addr) = ($1,$2);
285 ($newhost, $newaddr, $newname) = &parse($addr,$server,$oldname, $#expansion == 0);
286 print "($newhost, $newaddr, $newname) = &parse($addr, $server, $oldname)\n" if $debug;
288 # no expansion is possible w/o a new server to call
290 push(@isValid, &validAddr($newaddr));
291 push(@toFinal,$newaddr,$server,$newname);
293 &verbose(&final($newaddr,$server,$newname));
296 $newmxhost = &mx($newhost,$newaddr);
297 print "$newmxhost = &mx($newhost)\n"
298 if ($debug && $newhost ne $newmxhost);
299 $0 = "$av0 - parsing $newaddr [@$newmxhost]";
300 print "levels = $levels, level{$u *** $server} = ".$level{"$u *** $server"}."\n" if ($debug > 1);
301 # If the new server is the current one,
302 # it would have expanded things for us
303 # if it could have. Mx records must be
304 # followed to compare server names.
305 # We are also done if the recursion
306 # count has been exceeded.
307 if (&trhost($newmxhost) eq &trhost($server) || ($levels && $level{"$u *** $server"} >= $levels)) {
309 push(@isValid, &validAddr($newaddr));
310 push(@toFinal,$newaddr,$newmxhost,$newname);
312 &verbose(&final($newaddr,$newmxhost,$newname));
317 push(@isValid, &validAddr($newaddr));
318 push(@toExpn,$newmxhost,$newaddr,$newname,$level{"$u *** $server"});
320 &verbose(&expn($newmxhost,$newaddr,$newname,$level{"$u *** $server"}));
324 last if ($done eq " ");
327 # 550 is a known code... Should the be
328 # included in -a output? Might be a bug
329 # here. Does it matter? Can assume that
330 # there won't be UNKNOWN USER responses
331 # mixed with valid users?
332 if ($s =~ /^(550)([- ])/) {
334 print STDERR "\@$server:$u ($oldname) USER UNKNOWN\n";
336 &verbose(&final($u,$server,$oldname,"USER UNKNOWN"));
341 # 553 is a known code...
342 if ($s =~ /^(553)([- ])/) {
344 print STDERR "\@$server:$u ($oldname) USER AMBIGUOUS\n";
346 &verbose(&final($u,$server,$oldname,"USER AMBIGUOUS"));
351 # 252 is a known code...
352 if ($s =~ /^(252)([- ])/) {
354 print STDERR "\@$server:$u ($oldname) REFUSED TO VRFY\n";
356 &verbose(&final($u,$server,$oldname,"REFUSED TO VRFY"));
361 &giveup('',"$server: did not grok '$s'",$u);
367 # now we decide if we are going to take these
368 # expansions or roll them back.
370 $avgValid = &average(@isValid);
371 print "avgValid = $avgValid\n" if $debug;
372 if ($avgValid >= $validRequirement) {
373 print &compact($u,$server)." ->\n" if $verbose;
375 &verbose(&expn(splice(@toExpn,0,4)));
378 &verbose(&final(splice(@toFinal,0,3)));
381 print "Tossing some valid to avoid invalid ".&compact($u,$server)."\n" if ($avgValid > 0.0 && ($vw || $debug));
382 print &compact($u,$server)." ->\n" if $verbose;
383 &verbose(&final($u,$server,$newname));
388 &alarm("sending 'quit' to $server",'');
389 $0 = "$av0 - sending 'quit' to $server";
399 $0 = "$av0 - printing final results";
400 print "----------\n" if $vw;
402 for $f (sort @final) {
405 unlink("/tmp/expn$$");
409 # abandon all attempts deliver to $server
410 # register the current addresses as the final ones
413 local($redirect_okay,$reason,$user) = @_;
414 local($us,@so,$nh,@remaining_users);
415 local($pk,$file,$line);
416 ($pk, $file, $line) = caller;
418 $0 = "$av0 - giving up on $server: $reason";
420 # add back a user if we gave up in the middle
422 push(@users,$user) if $user;
424 # don't bother with this system anymore
426 unless ($giveup{$server}) {
427 $giveup{$server} = $reason;
428 print STDERR "$reason\n";
430 print "Giveup at $file:$line!!! redirect okay = $redirect_okay; $reason\n" if $debug;
433 # Before giving up, see if there is a chance that
434 # there is another host to redirect to!
435 # (Kids, don't do this at home! Hacking is a dangerous
436 # crime and you could end up behind bars.)
439 if ($redirect_okay =~ /\bmx\b/) {
440 next if &try_fallback('mx',$u,*server,
442 *already_mx_fellback);
444 if ($redirect_okay =~ /\bdomainify\b/) {
445 next if &try_fallback('domainify',$u,*server,
447 *already_domainify_fellback);
449 push(@remaining_users,$u);
451 @users = @remaining_users;
453 print &compact($u,$server)." ->\n" if ($verbose && $valid && $u);
454 &verbose(&final($u,$server,$names{"$u *** $server"},$reason));
458 # This routine is used only within &giveup. It checks to
459 # see if we really have to giveup or if there is a second
460 # chance because we did something before that can be
463 # %fallback{"$user *** $host"} tracks what is able to fallback
464 # %fellback{"$user *** $host"} tracks what has fallen back
466 # If there is a valid backtrack, then queue up the new possibility
470 local($method,$user,*host,*fall_table,*fellback) = @_;
471 local($us,$fallhost,$oldhost,$ft,$i);
474 print "Fallback table $method:\n";
475 for $i (sort keys %fall_table) {
476 print "\t'$i'\t\t'$fall_table{$i}'\n";
478 print "Fellback table $method:\n";
479 for $i (sort keys %fellback) {
480 print "\t'$i'\t\t'$fellback{$i}'\n";
482 print "U: $user H: $host\n";
485 $us = "$user *** $host";
486 if (defined $fellback{$us}) {
488 # Undo a previous fallback so that we can try again
489 # Nested fallbacks are avoided because they could
490 # lead to infinite loops
492 $fallhost = $fellback{$us};
493 print "Already $method fell back from $us -> \n" if $debug;
494 $us = "$user *** $fallhost";
495 $oldhost = $fallhost;
496 } elsif (($method eq 'mx') && (defined $mxbacktrace{$us}) && (defined $mx_secondary{$mxbacktrace{$us}})) {
497 print "Fallback an MX expansion $us -> \n" if $debug;
498 $oldhost = $mxbacktrace{$us};
500 print "Oldhost($host, $us) = " if $debug;
503 print "$oldhost\n" if $debug;
504 if (((defined $fall_table{$us}) && ($ft = $us)) || ((defined $fall_table{$oldhost}) && ($ft = $oldhost))) {
505 print "$method Fallback = ".$fall_table{$ft}."\n" if $debug;
507 @so = split(' ',$fall_table{$ft});
508 $newhost = shift(@so);
509 print "Falling back ($method) $us -> $newhost (from $oldhost)\n" if $debug;
510 if ($method eq 'mx') {
511 if (! defined ($mxbacktrace{"$user *** $newhost"})) {
512 if (defined $mxbacktrace{"$user *** $oldhost"}) {
513 print "resetting oldhost $oldhost to the original: " if $debug;
514 $oldhost = $mxbacktrace{"$user *** $oldhost"};
515 print "$oldhost\n" if $debug;
517 $mxbacktrace{"$user *** $newhost"} = $oldhost;
518 print "mxbacktrace $user *** $newhost -> $oldhost\n" if $debug;
520 $mx{&trhost($oldhost)} = $newhost;
522 $temporary_redirect{$us} = $newhost;
525 print "Can still $method $us: @so\n" if $debug;
526 $fall_table{$ft} = join(' ',@so);
528 print "No more fallbacks for $us\n" if $debug;
529 delete $fall_table{$ft};
531 if (defined $create_host_backtrack{$us}) {
532 $create_host_backtrack{"$user *** $newhost"}
533 = $create_host_backtrack{$us};
535 $fellback{"$user *** $newhost"} = $oldhost;
536 &expn($newhost,$user,$names{$us},$level{$us});
539 delete $temporary_redirect{$us};
543 # return 1 if you could send mail to the address as is.
547 $res = &do_validAddr($addr);
548 print "validAddr($addr) = $res\n" if $debug;
554 local($urx) = "[-A-Za-z_.0-9+]+";
557 return 0 if ($addr =~ /^\\/);
559 return 1 if ($addr =~ /.\@$urx$/);
561 return 1 if ($addr =~ /^\@$urx\:./);
563 return 1 if ($addr =~ /^$urx!./);
565 return 1 if ($addr =~ /^$urx$/);
567 print "validAddr($addr) = ???\n" if $debug;
570 # Some systems use expn and vrfy interchangeably. Some only
571 # implement one or the other. Some check expn against mailing
572 # lists and vrfy against users. It doesn't appear to be
575 # So, what do we do? We try everything!
578 # Ranking of result codes: good: 250, 251/551, 252, 550, anything else
580 # Ranking of inputs: best: user@host.domain, okay: user
582 # Return value: $error_string, @responses_from_server
585 local($u,$server) = @_;
586 local(@c) = ('expn', 'vrfy');
590 if (($u =~ /(.+)@(.+)/) && (&trhost($2) eq &trhost($server))) {
596 for $try_u (@try_u) {
597 &alarm("${c}'ing $try_u on $server",'',$u);
602 return "$server: lost connection";
604 if ($s !~ /^(\d+)([- ])/) {
605 return "$server: garbled reply to '$c $try_u'";
610 push(@ret,&read_response($2,$debug));
613 if ($1 == 551 || $1 == 251) {
616 push(@ret,&read_response($2,$debug));
619 if ($1 == 252 && ($code == 0 || $code == 550)) {
622 push(@ret,&read_response($2,$watch));
625 if ($1 == 550 && $code == 0) {
628 push(@ret,&read_response($2,$watch));
631 &read_response($2,$watch);
634 return "$server: expn/vrfy not implemented" unless @ret;
637 # sometimes the old parse routine (now parse2) didn't
638 # reject funky addresses.
641 local($oldaddr,$server,$oldname,$one_to_one) = @_;
642 local($newhost, $newaddr, $newname, $um) = &parse2($oldaddr,$server,$oldname,$one_to_one);
643 if ($newaddr =~ m,^["/],) {
644 return (undef, $oldaddr, $newname) if $valid;
645 return (undef, $um, $newname);
647 return ($newhost, $newaddr, $newname);
650 # returns ($new_smtp_server,$new_address,$new_name)
651 # given a response from a SMTP server ($newaddr), the
652 # current host ($server), the old "name" and a flag that
653 # indicates if it is being called during the initial
654 # command line parsing ($parsing_args)
657 local($newaddr,$context_host,$old_name,$parsing_args) = @_;
658 local(@names) = $old_name;
659 local($urx) = "[-A-Za-z_.0-9+]+";
663 # first, separate out the address part.
667 # [NAME] <ADDR [(NAME)]>
668 # [NAME] <[(NAME)] ADDR
673 if ($newaddr =~ /^\<(.*)\>$/) {
674 print "<A:$1>\n" if $debug;
675 ($newaddr) = &trim($1);
676 print "na = $newaddr\n" if $debug;
678 if ($newaddr =~ /^([^\<\>]*)\<([^\<\>]*)\>([^\<\>]*)$/) {
679 # address has a < > pair in it.
680 print "N:$1 <A:$2> N:$3\n" if $debug;
681 ($newaddr) = &trim($2);
682 unshift(@names, &trim($3,$1));
683 print "na = $newaddr\n" if $debug;
685 if ($newaddr =~ /^([^\(\)]*)\(([^\(\)]*)\)([^\(\)]*)$/) {
686 # address has a ( ) pair in it.
687 print "A:$1 (N:$2) A:$3\n" if $debug;
688 unshift(@names,&trim($2));
689 local($f,$l) = (&trim($1),&trim($3));
690 if (($f && $l) || !($f || $l)) {
691 # address looks like:
692 # foo (bar) baz or (bar)
694 print STDERR "Could not parse $newaddr\n" if $vw;
695 return(undef,$newaddr,&firstname(@names));
699 print "newaddr now = $newaddr\n" if $debug;
708 $unmangle = $newaddr;
709 if ($newaddr =~ /^\@($urx)\:(.+)$/) {
710 print "(\@:)" if $debug;
711 # this is a bit of a cheat, but it seems necessary
712 return (&domainify($1,$context_host,$2),$2,&firstname(@names),$unmangle);
714 if ($newaddr =~ /^(.+)\@($urx)$/) {
715 print "(\@)" if $debug;
716 return (&domainify($2,$context_host,$newaddr),$newaddr,&firstname(@names),$unmangle);
719 if ($newaddr =~ /^($urx)\!(.+)$/) {
720 return (&domainify($1,$context_host,$newaddr),$newaddr,&firstname(@names),$unmangle);
722 if ($newaddr =~ /^($urx)$/) {
723 return ($context_host,$newaddr,&firstname(@names),$unmangle);
725 print STDERR "Could not parse $newaddr\n";
727 print "(?)" if $debug;
728 return(undef,$newaddr,&firstname(@names),$unmangle);
730 # return $u (@$server) unless $u includes reference to $server
733 local($u, $server) = @_;
734 local($se) = $server;
736 $se =~ s/(\W)/\\$1/g;
737 $sp = " (\@$server)";
743 # remove empty (spaces don't count) members from an array
751 push(@r,$v) if ($v =~ /\S/);
755 # using the host part of an address, and the server name, add the
756 # servers' domain to the address if it doesn't already have a
757 # domain. Since this sometimes fails, save a back reference so
758 # it can be unrolled.
761 local($host,$domain_host,$u) = @_;
762 local($domain,$newhost);
764 # cut of trailing dots
766 $domain_host =~ s/\.$//;
768 if ($domain_host !~ /\./) {
770 # domain host isn't, keep $host whatever it is
772 print "domainify($host,$domain_host) = $host\n" if $debug;
777 # There are several weird situtations that need to be
778 # accounted for. They have to do with domain relay hosts.
781 # host server "right answer"
783 # shiva.cs cs.berkeley.edu shiva.cs.berkeley.edu
784 # shiva cs.berkeley.edu shiva.cs.berekley.edu
785 # cumulus reed.edu @reed.edu:cumulus.uucp
786 # tiberius tc.cornell.edu tiberius.tc.cornell.edu
788 # The first try must always be to cut the domain part out of
789 # the server and tack it onto the host.
791 # A reasonable second try is to tack the whole server part onto
792 # the host and for each possible repeated element, eliminate
795 # These extra "guesses" get put into the %domainify_fallback
796 # array. They will be used to give addresses a second chance
797 # in the &giveup routine
803 $long = "$host $domain_host";
804 $long =~ tr/A-Z/a-z/;
805 print "long = $long\n" if $debug;
806 if ($long =~ s/^([^ ]+\.)([^ ]+) \2(\.[^ ]+\.[^ ]+)/$1$2$3/) {
807 # matches shiva.cs cs.berkeley.edu and returns shiva.cs.berkeley.edu
808 print "condensed fallback $host $domain_host -> $long\n" if $debug;
809 $fallback{$long} = 9;
814 while ($fh =~ /\./) {
815 print "FALLBACK $host.$fh = 1\n" if $debug > 7;
816 $fallback{"$host.$fh"} = 1;
817 $fh =~ s/^[^\.]+\.//;
820 $fallback{"$host.$domain_host"} = 2;
822 ($domain = $domain_host) =~ s/^[^\.]+//;
823 $fallback{"$host$domain"} = 6
824 if ($domain =~ /\./);
828 # Host is already okay, but let's look for multiple
831 print "domainify($host,$domain_host) = $host\n" if $debug;
832 delete $fallback{$host};
833 $domainify_fallback{"$u *** $host"} = join(' ',sort {$fallback{$b} <=> $fallback{$a};} keys %fallback) if %fallback;
837 $domain = ".$domain_host"
838 if ($domain !~ /\..*\./);
839 $newhost = "$host$domain";
841 $create_host_backtrack{"$u *** $newhost"} = $domain_host;
842 print "domainify($host,$domain_host) = $newhost\n" if $debug;
843 delete $fallback{$newhost};
844 $domainify_fallback{"$u *** $newhost"} = join(' ',sort {$fallback{$b} <=> $fallback{$a};} keys %fallback) if %fallback;
847 print $domainify_fallback{"$u *** $newhost"}
848 if defined($domainify_fallback{"$u *** $newhost"});
853 # return the first non-empty element of an array
860 return $n if $n =~ /\S/;
864 # queue up more addresses to expand
867 local($host,$addr,$name,$level) = @_;
869 $host = &trhost($host);
871 if (($debug > 3) || (defined $giveup{$host})) {
872 unshift(@hosts,$host) unless $users{$host};
874 push(@hosts,$host) unless $users{$host};
876 $users{$host} .= " $addr";
877 $names{"$addr *** $host"} = $name;
878 $level{"$addr *** $host"} = $level + 1;
879 print "expn($host,$addr,$name)\n" if $debug;
882 return &final($addr,'NONE',$name);
885 # compute the numerical average value of an array
896 # print to the server (also to stdout, if -w)
900 print ">>> $p\n" if $watch;
903 # return case-adjusted name for a host (for comparison purposes)
906 # treat foo.bar as an alias for Foo.BAR
908 local($trhost) = $host;
909 $trhost =~ tr/A-Z/a-z/;
910 if ($trhost{$trhost}) {
911 $host = $trhost{$trhost};
913 $trhost{$trhost} = $host;
917 # re-queue users if an mx record dictates a redirect
918 # don't allow a user to be redirected more than once
921 local($server,*users) = @_;
922 local($u,$nserver,@still_there);
924 $nserver = &mx($server);
926 if (&trhost($nserver) ne &trhost($server)) {
927 $0 = "$av0 - mx redirect $server -> $nserver\n";
929 if (defined $mxbacktrace{"$u *** $nserver"}) {
930 push(@still_there,$u);
932 $mxbacktrace{"$u *** $nserver"} = $server;
933 print "mxbacktrace{$u *** $nserver} = $server\n"
935 &expn($nserver,$u,$names{"$u *** $server"});
938 @users = @still_there;
947 # follow mx records, return a hostname
948 # also follow temporary redirections comming from &domainify and
955 if (defined $mx{&trhost($h)} && $h ne $mx{&trhost($h)}) {
956 $0 = "$av0 - mx expand $h";
957 $h = $mx{&trhost($h)};
961 if (defined $temporary_redirect{"$u *** $h"}) {
962 $0 = "$av0 - internal redirect $h";
963 print "Temporary redirect taken $u *** $h -> " if $debug;
964 $h = $temporary_redirect{"$u *** $h"};
965 print "$h\n" if $debug;
969 if (defined $temporary_redirect{"$u *** $htr"}) {
970 $0 = "$av0 - internal redirect $h";
971 print "temporary redirect taken $u *** $h -> " if $debug;
972 $h = $temporary_redirect{"$u *** $htr"};
973 print "$h\n" if $debug;
980 # look up mx records with the name server.
981 # re-queue expansion requests if possible
982 # optionally give up on this host.
985 local($lastchance,$server,$giveup,*users) = @_;
988 local($nh, $pref,$cpref);
991 local($name,$aliases,$type,$len,$thataddr);
994 return 1 if &mxredirect($server,*users);
996 if ((defined $mx{$server}) || (! $have_nslookup)) {
997 return 0 unless $lastchance;
998 &giveup('mx domainify',$giveup);
1002 $0 = "$av0 - nslookup of $server";
1003 sysopen(T,"/tmp/expn$$",O_RDWR|O_CREAT|O_EXCL,0600) || die "open > /tmp/expn$$: $!\n";
1004 print T "set querytype=MX\n";
1005 print T "$server\n";
1009 open(NSLOOKUP,"nslookup < /tmp/expn$$ 2>&1 |") || die "open nslookup: $!";
1011 print if ($debug > 2);
1012 if (/mail exchanger = ([-A-Za-z_.0-9+]+)/) {
1014 if (/preference = (\d+)/) {
1016 if ($pref < $cpref) {
1020 $fallback{$pref} .= " $nh";
1024 if (/Non-existent domain/) {
1026 # These addresss are hosed. Kaput! Dead!
1027 # However, if we created the address in the
1028 # first place then there is a chance of
1031 1 while(<NSLOOKUP>);
1033 return 0 unless $lastchance;
1034 &giveup('domainify',"$server: Non-existent domain",undef,1);
1040 unlink("/tmp/expn$$");
1042 $0 = "$o0 - finished mxlookup";
1043 return 0 unless $lastchance;
1044 &giveup('mx domainify',"$server: Could not resolve address");
1048 # provide fallbacks in case $nserver doesn't work out
1049 if (defined $fallback{$cpref}) {
1050 $mx_secondary{$server} = $fallback{$cpref};
1053 $0 = "$av0 - gethostbyname($nserver)";
1054 ($name,$aliases,$type,$len,$thataddr) = gethostbyname($nserver);
1056 unless ($thataddr) {
1058 return 0 unless $lastchance;
1059 &giveup('mx domainify',"$nserver: could not resolve address");
1062 print "MX($server) = $nserver\n" if $debug;
1063 print "$server -> $nserver\n" if $vw && !$debug;
1064 $mx{&trhost($server)} = $nserver;
1065 # redeploy the users
1066 unless (&mxredirect($server,*users)) {
1067 return 0 unless $lastchance;
1068 &giveup('mx domainify',"$nserver: only one level of mx redirect allowed");
1071 $0 = "$o0 - finished mxlookup";
1074 # if mx expansion did not help to resolve an address
1075 # (ie: foo@bar became @baz:foo@bar, then undo the
1077 # this is only used by &final
1080 local(*host,*addr) = @_;
1082 print "looking for mxbacktrace{$addr *** $host}\n"
1084 while (defined $mxbacktrace{"$addr *** $host"}) {
1085 print "Unrolling MX expnasion: \@$host:$addr -> "
1086 if ($debug || $verbose);
1087 $host = $mxbacktrace{"$addr *** $host"};
1088 print "\@$host:$addr\n"
1089 if ($debug || $verbose);
1093 $addr = "\@$host:$addr"
1097 # register a completed expnasion. Make the final address as
1098 # simple as possible.
1101 local($addr,$host,$name,$error) = @_;
1106 if ($error =~ /Non-existent domain/) {
1108 # If we created the domain, then let's undo the
1111 if (defined $create_host_backtrack{"$addr *** $host"}) {
1112 while (defined $create_host_backtrack{"$addr *** $host"}) {
1113 print "Un&domainifying($host) = " if $debug;
1114 $host = $create_host_backtrack{"$addr *** $host"};
1115 print "$host\n" if $debug;
1117 $error = "$host: could not locate";
1120 # If we only want valid addresses, toss out
1124 print STDERR "\@$host:$addr ($name) Non-existent domain\n";
1131 $0 = "$av0 - final parsing of \@$host:$addr";
1132 ($he = $host) =~ s/(\W)/\\$1/g;
1134 # addr does not contain any host
1135 $addr = "$addr@$host";
1136 } elsif ($addr !~ /$he/i) {
1137 # if host part really something else, use the something
1139 if ($addr =~ m/(.*)\@([^\@]+)$/) {
1140 ($au,$ah) = ($1,$2);
1141 print "au = $au ah = $ah\n" if $debug;
1142 if (defined $temporary_redirect{"$addr *** $ah"}) {
1143 $addr = "$au\@".$temporary_redirect{"$addr *** $ah"};
1144 print "Rewrite! to $addr\n" if $debug;
1148 # addr does not contain full host
1150 if ($host =~ /^([^\.]+)(\..+)$/) {
1151 # host part has a . in it - foo.bar
1152 ($hb, $hr) = ($1, $2);
1153 if ($addr =~ /\@([^\.\@]+)$/ && ($1 eq $hb)) {
1154 # addr part has not .
1155 # and matches beginning of
1156 # host part -- tack on a
1160 &mxunroll(*host,*addr)
1164 &mxunroll(*host,*addr)
1168 $addr = "${addr}[\@$host]"
1173 $name = "$name " if $name;
1174 $error = " $error" if $error;
1176 push(@final,"$name<$addr>");
1178 push(@final,"$name<$addr>$error");
1180 "\t$name<$addr>$error\n";
1185 local($alarm_action,$alarm_redirect,$alarm_user) = @_;
1187 $SIG{ALRM} = 'handle_alarm';
1189 # this involves one great big ugly hack.
1190 # the "next HOST" unwinds the stack!
1193 &giveup($alarm_redirect,"Timed out during $alarm_action",$alarm_user);
1197 # read the rest of the current smtp daemon's response (and toss it away)
1200 local($done,$watch) = @_;
1203 while(($done eq "-") && ($s = <$S>) && ($s =~ /^\d+([- ])/)) {
1210 # print args if verbose. Return them in any case
1214 print "@tp" if $verbose;
1221 %already_domainify_fellback;
1222 %already_mx_fellback;
1224 ################### BEGIN PERL/TROFF TRANSITION
1231 .\" ############## END PERL/TROFF TRANSITION
1232 .TH EXPN 1 "March 11, 1993"
1235 expn \- recursively expand mail aliases
1243 .IR user [@ hostname ]
1244 .RI [ user [@ hostname ]]...
1251 commands to expand mail aliases.
1252 It will first look up the addresses you provide on the command line.
1253 If those expand into addresses on other systems, it will
1254 connect to the other systems and expand again. It will keep
1255 doing this until no further expansion is possible.
1257 The default output of
1259 can contain many lines which are not valid
1260 email addresses. With the
1262 flag, only expansions that result in legal addresses
1263 are used. Since many mailing lists have an illegal
1264 address or two, the single
1266 address, flag specifies that a few illegal addresses can
1267 be mixed into the results. More
1269 flags vary the ratio. Read the source to track down
1270 the formula. With the
1272 option, you should be able to construct a new mailing
1273 list out of an existing one.
1275 If you wish to limit the number of levels deep that
1277 will recurse as it traces addresses, use the
1281 another level will be traversed. So,
1283 will traverse no more than three levels deep.
1285 The normal mode of operation for
1287 is to do all of its work silently.
1288 The following options make it more verbose.
1289 It is not necessary to make it verbose to see what it is
1290 doing because as it works, it changes its
1292 variable to reflect its current activity.
1293 To see how it is expanding things, the
1295 verbose, flag will cause
1297 to show each address before
1298 and after translation as it works.
1301 watch, flag will cause
1303 to show you its conversations with the mail daemons.
1306 debug, flag will expose many of the inner workings so that
1307 it is possible to eliminate bugs.
1309 No environment variables are used.
1313 .B temporary file used as input to
1319 RFC 823, and RFC 1123.
1321 Not all mail daemons will implement
1325 It is not possible to verify addresses that are served
1328 When attempting to connect to a system to verify an address,
1330 only tries one IP address. Most mail daemons
1333 It is assumed that you are running domain names and that
1336 program is available. If not,
1338 will not be able to verify many addresses. It will also pause
1339 for a long time unless you change the code where it says
1340 .I $have_nslookup = 1
1347 does not handle every valid address. If you have an example,
1348 please submit a bug report.
1350 In 1986 or so, Jon Broome wrote a program of the same name
1351 that did about the same thing. It has since suffered bit rot
1352 and Jon Broome has dropped off the face of the earth!
1353 (Jon, if you are out there, drop me a line)
1355 The latest version of
1357 is available through anonymous ftp at
1358 .IR ftp://ftp.idiom.com/pub/muir-programs/expn .
1360 .I David Muir Sharnoff\ \ \ \ <muir@idiom.com>