diff options
author | peter <peter@FreeBSD.org> | 1998-08-04 16:35:57 +0000 |
---|---|---|
committer | peter <peter@FreeBSD.org> | 1998-08-04 16:35:57 +0000 |
commit | 9f74da92d2d9619b4a0543b7c6c819cb4eb4959e (patch) | |
tree | 97e0c5ab8cb2ff07b5c3ab6c04738a62c19fbe5c /usr.sbin/sendmail/contrib/expn.pl | |
parent | d0cf6313bab68523e1ff8a7cf65c7f6c26c8dad0 (diff) | |
download | FreeBSD-src-9f74da92d2d9619b4a0543b7c6c819cb4eb4959e.zip FreeBSD-src-9f74da92d2d9619b4a0543b7c6c819cb4eb4959e.tar.gz |
Remove old sendmail (to the Attic)
Diffstat (limited to 'usr.sbin/sendmail/contrib/expn.pl')
-rwxr-xr-x | usr.sbin/sendmail/contrib/expn.pl | 1359 |
1 files changed, 0 insertions, 1359 deletions
diff --git a/usr.sbin/sendmail/contrib/expn.pl b/usr.sbin/sendmail/contrib/expn.pl deleted file mode 100755 index 57f8515..0000000 --- a/usr.sbin/sendmail/contrib/expn.pl +++ /dev/null @@ -1,1359 +0,0 @@ -#!/usr/bin/perl -'di '; -'ds 00 \\"'; -'ig 00 '; -# -# THIS PROGRAM IS ITS OWN MANUAL PAGE. INSTALL IN man & bin. -# - -use 5.001; -use IO::Socket; - -# system requirements: -# must have 'nslookup' and 'hostname' programs. - -# $Header: /home/muir/bin/RCS/expn,v 3.11 1997/09/10 08:14:02 muir Exp muir $ - -# TODO: -# less magic should apply to command-line addresses -# less magic should apply to local addresses -# add magic to deal with cross-domain cnames -# disconnect & reconnect after 25 commands to the same sendmail 8.8.* host - -# Checklist: (hard addresses) -# 250 Kimmo Suominen <"|/usr/local/mh/lib/slocal -user kim"@grendel.tac.nyc.ny.us> -# harry@hofmann.cs.Berkeley.EDU -> harry@tenet (.berkeley.edu) [dead] -# bks@cs.berkeley.edu -> shiva.CS (.berkeley.edu) [dead] -# dan@tc.cornell.edu -> brown@tiberius (.tc.cornell.edu) - -############################################################################# -# -# Copyright (c) 1993 David Muir Sharnoff -# All rights reserved. -# -# Redistribution and use in source and binary forms, with or without -# modification, are permitted provided that the following conditions -# are met: -# 1. Redistributions of source code must retain the above copyright -# notice, this list of conditions and the following disclaimer. -# 2. Redistributions in binary form must reproduce the above copyright -# notice, this list of conditions and the following disclaimer in the -# documentation and/or other materials provided with the distribution. -# 3. All advertising materials mentioning features or use of this software -# must display the following acknowledgement: -# This product includes software developed by the David Muir Sharnoff. -# 4. The name of David Sharnoff may not be used to endorse or promote products -# derived from this software without specific prior written permission. -# -# THIS SOFTWARE IS PROVIDED BY THE DAVID MUIR SHARNOFF ``AS IS'' AND -# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE -# ARE DISCLAIMED. IN NO EVENT SHALL DAVID MUIR SHARNOFF BE LIABLE -# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS -# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) -# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT -# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY -# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF -# SUCH DAMAGE. -# -# This copyright notice derrived from material copyrighted by the Regents -# of the University of California. -# -# Contributions accepted. -# -############################################################################# - -# overall structure: -# in an effort to not trace each address individually, but rather -# ask each server in turn a whole bunch of questions, addresses to -# be expanded are queued up. -# -# This means that all accounting w.r.t. an address must be stored in -# various arrays. Generally these arrays are indexed by the -# string "$addr *** $server" where $addr is the address to be -# expanded "foo" or maybe "foo@bar" and $server is the hostname -# of the SMTP server to contact. -# - -# important global variables: -# -# @hosts : list of servers still to be contacted -# $server : name of the current we are currently looking at -# @users = $users{@hosts[0]} : addresses to expand at this server -# $u = $users[0] : the current address being expanded -# $names{"$users[0] *** $server"} : the 'name' associated with the address -# $mxbacktrace{"$users[0] *** $server"} : record of mx expansion -# $mx_secondary{$server} : other mx relays at the same priority -# $domainify_fallback{"$users[0] *** $server"} : alternative names to try -# instead of $server if $server doesn't work -# $temporary_redirect{"$users[0] *** $server"} : when trying alternates, -# temporarily channel all tries along current path -# $giveup{$server} : do not bother expanding addresses at $server -# $verbose : -v -# $watch : -w -# $vw : -v or -w -# $debug : -d -# $valid : -a -# $levels : -1 -# $S : the socket connection to $server - -$have_nslookup = 1; # we have the nslookup program -$port = 'smtp'; -$av0 = $0; -$ENV{'PATH'} .= ":/usr/etc" unless $ENV{'PATH'} =~ m,/usr/etc,; -$ENV{'PATH'} .= ":/usr/ucb" unless $ENV{'PATH'} =~ m,/usr/ucb,; -select(STDERR); - -$0 = "$av0 - running hostname"; -chop($name = `hostname || uname -n`); - -$0 = "$av0 - lookup host FQDN and IP addr"; -($hostname,$aliases,$type,$len,$thisaddr) = gethostbyname($name); - -$0 = "$av0 - parsing args"; -$usage = "Usage: $av0 [-1avwd] user[\@host] [user2[host2] ...]"; -for $a (@ARGV) { - die $usage if $a eq "-"; - while ($a =~ s/^(-.*)([1avwd])/$1/) { - eval '$'."flag_$2 += 1"; - } - next if $a eq "-"; - die $usage if $a =~ /^-/; - &expn(&parse($a,$hostname,undef,1)); -} -$verbose = $flag_v; -$watch = $flag_w; -$vw = $flag_v + $flag_w; -$debug = $flag_d; -$valid = $flag_a; -$levels = $flag_1; - -die $usage unless @hosts; -if ($valid) { - if ($valid == 1) { - $validRequirement = 0.8; - } elsif ($valid == 2) { - $validRequirement = 1.0; - } elsif ($valid == 3) { - $validRequirement = 0.9; - } else { - $validRequirement = (1 - (1/($valid-3))); - print "validRequirement = $validRequirement\n" if $debug; - } -} - -HOST: -while (@hosts) { - $server = shift(@hosts); - @users = split(' ',$users{$server}); - delete $users{$server}; - - # is this server already known to be bad? - $0 = "$av0 - looking up $server"; - if ($giveup{$server}) { - &giveup('mx domainify',$giveup{$server}); - next; - } - - # do we already have an mx record for this host? - next HOST if &mxredirect($server,*users); - - # look it up, or try for an mx. - $0 = "$av0 - gethostbyname($server)"; - - ($name,$aliases,$type,$len,$thataddr) = gethostbyname($server); - # if we can't get an A record, try for an MX record. - unless($thataddr) { - &mxlookup(1,$server,"$server: could not resolve name",*users); - next HOST; - } - - # get a connection, or look for an mx - $0 = "$av0 - socket to $server"; - - $S = new IO::Socket::INET ( - 'PeerAddr' => $server, - 'PeerPort' => $port, - 'Proto' => 'tcp'); - - if (! $S || ($debug == 10 && $server =~ /relay\d.UU.NET$/i)) { - $0 = "$av0 - $server: could not connect: $!\n"; - $emsg = $!; - unless (&mxlookup(0,$server,"$server: could not connect: $!",*users)) { - &giveup('mx',"$server: Could not connect: $emsg"); - } - next HOST; - } - $S->autoflush(1); - - # read the greeting - $0 = "$av0 - talking to $server"; - &alarm("greeting with $server",''); - while(<$S>) { - alarm(0); - print if $watch; - if (/^(\d+)([- ])/) { - if ($1 != 220) { - $0 = "$av0 - bad numeric response from $server"; - &alarm("giving up after bad response from $server",''); - &read_response($2,$watch); - alarm(0); - print STDERR "$server: NOT 220 greeting: $_" - if ($debug || $vw); - if (&mxlookup(0,$server,"$server: did not respond with a 220 greeting",*users)) { - close($S); - next HOST; - } - } - last if ($2 eq " "); - } else { - $0 = "$av0 - bad response from $server"; - print STDERR "$server: NOT 220 greeting: $_" - if ($debug || $vw); - unless (&mxlookup(0,$server,"$server: did not respond with SMTP codes",*users)) { - &giveup('',"$server: did not talk SMTP"); - } - close($S); - next HOST; - } - &alarm("greeting with $server",''); - } - alarm(0); - - # if this causes problems, remove it - $0 = "$av0 - sending helo to $server"; - &alarm("sending helo to $server",""); - &ps("helo $hostname"); - while(<$S>) { - print if $watch; - last if /^\d+ /; - } - alarm(0); - - # try the users, one by one - USER: - while(@users) { - $u = shift(@users); - $0 = "$av0 - expanding $u [\@$server]"; - - # do we already have a name for this user? - $oldname = $names{"$u *** $server"}; - - print &compact($u,$server)." ->\n" if ($verbose && ! $valid); - if ($valid) { - # - # when running with -a, we delay taking any action - # on the results of our query until we have looked - # at the complete output. @toFinal stores expansions - # that will be final if we take them. @toExpn stores - # expnansions that are not final. @isValid keeps - # track of our ability to send mail to each of the - # expansions. - # - @isValid = (); - @toFinal = (); - @toExpn = (); - } - -# ($ecode,@expansion) = &expn_vrfy($u,$server); - (@foo) = &expn_vrfy($u,$server); - ($ecode,@expansion) = @foo; - if ($ecode) { - &giveup('',$ecode,$u); - last USER; - } - - for $s (@expansion) { - $s =~ s/[\n\r]//g; - $0 = "$av0 - parsing $server: $s"; - - $skipwatch = $watch; - - if ($s =~ /^[25]51([- ]).*<(.+)>/) { - print "$s" if $watch; - print "(pretending 250$1<$2>)" if ($debug && $watch); - print "\n" if $watch; - $s = "250$1<$2>"; - $skipwatch = 0; - } - - if ($s =~ /^250([- ])(.+)/) { - print "$s\n" if $skipwatch; - ($done,$addr) = ($1,$2); - ($newhost, $newaddr, $newname) = &parse($addr,$server,$oldname, $#expansion == 0); - print "($newhost, $newaddr, $newname) = &parse($addr, $server, $oldname)\n" if $debug; - if (! $newhost) { - # no expansion is possible w/o a new server to call - if ($valid) { - push(@isValid, &validAddr($newaddr)); - push(@toFinal,$newaddr,$server,$newname); - } else { - &verbose(&final($newaddr,$server,$newname)); - } - } else { - $newmxhost = &mx($newhost,$newaddr); - print "$newmxhost = &mx($newhost)\n" - if ($debug && $newhost ne $newmxhost); - $0 = "$av0 - parsing $newaddr [@$newmxhost]"; - print "levels = $levels, level{$u *** $server} = ".$level{"$u *** $server"}."\n" if ($debug > 1); - # If the new server is the current one, - # it would have expanded things for us - # if it could have. Mx records must be - # followed to compare server names. - # We are also done if the recursion - # count has been exceeded. - if (&trhost($newmxhost) eq &trhost($server) || ($levels && $level{"$u *** $server"} >= $levels)) { - if ($valid) { - push(@isValid, &validAddr($newaddr)); - push(@toFinal,$newaddr,$newmxhost,$newname); - } else { - &verbose(&final($newaddr,$newmxhost,$newname)); - } - } else { - # more work to do... - if ($valid) { - push(@isValid, &validAddr($newaddr)); - push(@toExpn,$newmxhost,$newaddr,$newname,$level{"$u *** $server"}); - } else { - &verbose(&expn($newmxhost,$newaddr,$newname,$level{"$u *** $server"})); - } - } - } - last if ($done eq " "); - next; - } - # 550 is a known code... Should the be - # included in -a output? Might be a bug - # here. Does it matter? Can assume that - # there won't be UNKNOWN USER responses - # mixed with valid users? - if ($s =~ /^(550)([- ])/) { - if ($valid) { - print STDERR "\@$server:$u ($oldname) USER UNKNOWN\n"; - } else { - &verbose(&final($u,$server,$oldname,"USER UNKNOWN")); - } - last if ($2 eq " "); - next; - } - # 553 is a known code... - if ($s =~ /^(553)([- ])/) { - if ($valid) { - print STDERR "\@$server:$u ($oldname) USER AMBIGUOUS\n"; - } else { - &verbose(&final($u,$server,$oldname,"USER AMBIGUOUS")); - } - last if ($2 eq " "); - next; - } - # 252 is a known code... - if ($s =~ /^(252)([- ])/) { - if ($valid) { - print STDERR "\@$server:$u ($oldname) REFUSED TO VRFY\n"; - } else { - &verbose(&final($u,$server,$oldname,"REFUSED TO VRFY")); - } - last if ($2 eq " "); - next; - } - &giveup('',"$server: did not grok '$s'",$u); - last USER; - } - - if ($valid) { - # - # now we decide if we are going to take these - # expansions or roll them back. - # - $avgValid = &average(@isValid); - print "avgValid = $avgValid\n" if $debug; - if ($avgValid >= $validRequirement) { - print &compact($u,$server)." ->\n" if $verbose; - while (@toExpn) { - &verbose(&expn(splice(@toExpn,0,4))); - } - while (@toFinal) { - &verbose(&final(splice(@toFinal,0,3))); - } - } else { - print "Tossing some valid to avoid invalid ".&compact($u,$server)."\n" if ($avgValid > 0.0 && ($vw || $debug)); - print &compact($u,$server)." ->\n" if $verbose; - &verbose(&final($u,$server,$newname)); - } - } - } - - &alarm("sending 'quit' to $server",''); - $0 = "$av0 - sending 'quit' to $server"; - &ps("quit"); - while(<$S>) { - print if $watch; - last if /^\d+ /; - } - close($S); - alarm(0); -} - -$0 = "$av0 - printing final results"; -print "----------\n" if $vw; -select(STDOUT); -for $f (sort @final) { - print "$f\n"; -} -unlink("/tmp/expn$$"); -exit(0); - - -# abandon all attempts deliver to $server -# register the current addresses as the final ones -sub giveup -{ - local($redirect_okay,$reason,$user) = @_; - local($us,@so,$nh,@remaining_users); - local($pk,$file,$line); - ($pk, $file, $line) = caller; - - $0 = "$av0 - giving up on $server: $reason"; - # - # add back a user if we gave up in the middle - # - push(@users,$user) if $user; - # - # don't bother with this system anymore - # - unless ($giveup{$server}) { - $giveup{$server} = $reason; - print STDERR "$reason\n"; - } - print "Giveup at $file:$line!!! redirect okay = $redirect_okay; $reason\n" if $debug; - # - # Wait! - # Before giving up, see if there is a chance that - # there is another host to redirect to! - # (Kids, don't do this at home! Hacking is a dangerous - # crime and you could end up behind bars.) - # - for $u (@users) { - if ($redirect_okay =~ /\bmx\b/) { - next if &try_fallback('mx',$u,*server, - *mx_secondary, - *already_mx_fellback); - } - if ($redirect_okay =~ /\bdomainify\b/) { - next if &try_fallback('domainify',$u,*server, - *domainify_fallback, - *already_domainify_fellback); - } - push(@remaining_users,$u); - } - @users = @remaining_users; - for $u (@users) { - print &compact($u,$server)." ->\n" if ($verbose && $valid && $u); - &verbose(&final($u,$server,$names{"$u *** $server"},$reason)); - } -} -# -# This routine is used only within &giveup. It checks to -# see if we really have to giveup or if there is a second -# chance because we did something before that can be -# backtracked. -# -# %fallback{"$user *** $host"} tracks what is able to fallback -# %fellback{"$user *** $host"} tracks what has fallen back -# -# If there is a valid backtrack, then queue up the new possibility -# -sub try_fallback -{ - local($method,$user,*host,*fall_table,*fellback) = @_; - local($us,$fallhost,$oldhost,$ft,$i); - - if ($debug > 8) { - print "Fallback table $method:\n"; - for $i (sort keys %fall_table) { - print "\t'$i'\t\t'$fall_table{$i}'\n"; - } - print "Fellback table $method:\n"; - for $i (sort keys %fellback) { - print "\t'$i'\t\t'$fellback{$i}'\n"; - } - print "U: $user H: $host\n"; - } - - $us = "$user *** $host"; - if (defined $fellback{$us}) { - # - # Undo a previous fallback so that we can try again - # Nested fallbacks are avoided because they could - # lead to infinite loops - # - $fallhost = $fellback{$us}; - print "Already $method fell back from $us -> \n" if $debug; - $us = "$user *** $fallhost"; - $oldhost = $fallhost; - } elsif (($method eq 'mx') && (defined $mxbacktrace{$us}) && (defined $mx_secondary{$mxbacktrace{$us}})) { - print "Fallback an MX expansion $us -> \n" if $debug; - $oldhost = $mxbacktrace{$us}; - } else { - print "Oldhost($host, $us) = " if $debug; - $oldhost = $host; - } - print "$oldhost\n" if $debug; - if (((defined $fall_table{$us}) && ($ft = $us)) || ((defined $fall_table{$oldhost}) && ($ft = $oldhost))) { - print "$method Fallback = ".$fall_table{$ft}."\n" if $debug; - local(@so,$newhost); - @so = split(' ',$fall_table{$ft}); - $newhost = shift(@so); - print "Falling back ($method) $us -> $newhost (from $oldhost)\n" if $debug; - if ($method eq 'mx') { - if (! defined ($mxbacktrace{"$user *** $newhost"})) { - if (defined $mxbacktrace{"$user *** $oldhost"}) { - print "resetting oldhost $oldhost to the original: " if $debug; - $oldhost = $mxbacktrace{"$user *** $oldhost"}; - print "$oldhost\n" if $debug; - } - $mxbacktrace{"$user *** $newhost"} = $oldhost; - print "mxbacktrace $user *** $newhost -> $oldhost\n" if $debug; - } - $mx{&trhost($oldhost)} = $newhost; - } else { - $temporary_redirect{$us} = $newhost; - } - if (@so) { - print "Can still $method $us: @so\n" if $debug; - $fall_table{$ft} = join(' ',@so); - } else { - print "No more fallbacks for $us\n" if $debug; - delete $fall_table{$ft}; - } - if (defined $create_host_backtrack{$us}) { - $create_host_backtrack{"$user *** $newhost"} - = $create_host_backtrack{$us}; - } - $fellback{"$user *** $newhost"} = $oldhost; - &expn($newhost,$user,$names{$us},$level{$us}); - return 1; - } - delete $temporary_redirect{$us}; - $host = $oldhost; - return 0; -} -# return 1 if you could send mail to the address as is. -sub validAddr -{ - local($addr) = @_; - $res = &do_validAddr($addr); - print "validAddr($addr) = $res\n" if $debug; - $res; -} -sub do_validAddr -{ - local($addr) = @_; - local($urx) = "[-A-Za-z_.0-9+]+"; - - # \u - return 0 if ($addr =~ /^\\/); - # ?@h - return 1 if ($addr =~ /.\@$urx$/); - # @h:? - return 1 if ($addr =~ /^\@$urx\:./); - # h!u - return 1 if ($addr =~ /^$urx!./); - # u - return 1 if ($addr =~ /^$urx$/); - # ? - print "validAddr($addr) = ???\n" if $debug; - return 0; -} -# Some systems use expn and vrfy interchangeably. Some only -# implement one or the other. Some check expn against mailing -# lists and vrfy against users. It doesn't appear to be -# consistent. -# -# So, what do we do? We try everything! -# -# -# Ranking of result codes: good: 250, 251/551, 252, 550, anything else -# -# Ranking of inputs: best: user@host.domain, okay: user -# -# Return value: $error_string, @responses_from_server -sub expn_vrfy -{ - local($u,$server) = @_; - local(@c) = ('expn', 'vrfy'); - local(@try_u) = $u; - local(@ret,$code); - - if (($u =~ /(.+)@(.+)/) && (&trhost($2) eq &trhost($server))) { - push(@try_u,$1); - } - - TRY: - for $c (@c) { - for $try_u (@try_u) { - &alarm("${c}'ing $try_u on $server",'',$u); - &ps("$c $try_u"); - alarm(0); - $s = <$S>; - if ($s eq '') { - return "$server: lost connection"; - } - if ($s !~ /^(\d+)([- ])/) { - return "$server: garbled reply to '$c $try_u'"; - } - if ($1 == 250) { - $code = 250; - @ret = ("",$s); - push(@ret,&read_response($2,$debug)); - return (@ret); - } - if ($1 == 551 || $1 == 251) { - $code = $1; - @ret = ("",$s); - push(@ret,&read_response($2,$debug)); - next; - } - if ($1 == 252 && ($code == 0 || $code == 550)) { - $code = 252; - @ret = ("",$s); - push(@ret,&read_response($2,$watch)); - next; - } - if ($1 == 550 && $code == 0) { - $code = 550; - @ret = ("",$s); - push(@ret,&read_response($2,$watch)); - next; - } - &read_response($2,$watch); - } - } - return "$server: expn/vrfy not implemented" unless @ret; - return @ret; -} -# sometimes the old parse routine (now parse2) didn't -# reject funky addresses. -sub parse -{ - local($oldaddr,$server,$oldname,$one_to_one) = @_; - local($newhost, $newaddr, $newname, $um) = &parse2($oldaddr,$server,$oldname,$one_to_one); - if ($newaddr =~ m,^["/],) { - return (undef, $oldaddr, $newname) if $valid; - return (undef, $um, $newname); - } - return ($newhost, $newaddr, $newname); -} - -# returns ($new_smtp_server,$new_address,$new_name) -# given a response from a SMTP server ($newaddr), the -# current host ($server), the old "name" and a flag that -# indicates if it is being called during the initial -# command line parsing ($parsing_args) -sub parse2 -{ - local($newaddr,$context_host,$old_name,$parsing_args) = @_; - local(@names) = $old_name; - local($urx) = "[-A-Za-z_.0-9+]+"; - local($unmangle); - - # - # first, separate out the address part. - # - - # - # [NAME] <ADDR [(NAME)]> - # [NAME] <[(NAME)] ADDR - # ADDR [(NAME)] - # (NAME) ADDR - # [(NAME)] <ADDR> - # - if ($newaddr =~ /^\<(.*)\>$/) { - print "<A:$1>\n" if $debug; - ($newaddr) = &trim($1); - print "na = $newaddr\n" if $debug; - } - if ($newaddr =~ /^([^\<\>]*)\<([^\<\>]*)\>([^\<\>]*)$/) { - # address has a < > pair in it. - print "N:$1 <A:$2> N:$3\n" if $debug; - ($newaddr) = &trim($2); - unshift(@names, &trim($3,$1)); - print "na = $newaddr\n" if $debug; - } - if ($newaddr =~ /^([^\(\)]*)\(([^\(\)]*)\)([^\(\)]*)$/) { - # address has a ( ) pair in it. - print "A:$1 (N:$2) A:$3\n" if $debug; - unshift(@names,&trim($2)); - local($f,$l) = (&trim($1),&trim($3)); - if (($f && $l) || !($f || $l)) { - # address looks like: - # foo (bar) baz or (bar) - # not allowed! - print STDERR "Could not parse $newaddr\n" if $vw; - return(undef,$newaddr,&firstname(@names)); - } - $newaddr = $f if $f; - $newaddr = $l if $l; - print "newaddr now = $newaddr\n" if $debug; - } - # - # @foo:bar - # j%k@l - # a@b - # b!a - # a - # - $unmangle = $newaddr; - if ($newaddr =~ /^\@($urx)\:(.+)$/) { - print "(\@:)" if $debug; - # this is a bit of a cheat, but it seems necessary - return (&domainify($1,$context_host,$2),$2,&firstname(@names),$unmangle); - } - if ($newaddr =~ /^(.+)\@($urx)$/) { - print "(\@)" if $debug; - return (&domainify($2,$context_host,$newaddr),$newaddr,&firstname(@names),$unmangle); - } - if ($parsing_args) { - if ($newaddr =~ /^($urx)\!(.+)$/) { - return (&domainify($1,$context_host,$newaddr),$newaddr,&firstname(@names),$unmangle); - } - if ($newaddr =~ /^($urx)$/) { - return ($context_host,$newaddr,&firstname(@names),$unmangle); - } - print STDERR "Could not parse $newaddr\n"; - } - print "(?)" if $debug; - return(undef,$newaddr,&firstname(@names),$unmangle); -} -# return $u (@$server) unless $u includes reference to $server -sub compact -{ - local($u, $server) = @_; - local($se) = $server; - local($sp); - $se =~ s/(\W)/\\$1/g; - $sp = " (\@$server)"; - if ($u !~ /$se/i) { - return "$u$sp"; - } - return $u; -} -# remove empty (spaces don't count) members from an array -sub trim -{ - local(@v) = @_; - local($v,@r); - for $v (@v) { - $v =~ s/^\s+//; - $v =~ s/\s+$//; - push(@r,$v) if ($v =~ /\S/); - } - return(@r); -} -# using the host part of an address, and the server name, add the -# servers' domain to the address if it doesn't already have a -# domain. Since this sometimes fails, save a back reference so -# it can be unrolled. -sub domainify -{ - local($host,$domain_host,$u) = @_; - local($domain,$newhost); - - # cut of trailing dots - $host =~ s/\.$//; - $domain_host =~ s/\.$//; - - if ($domain_host !~ /\./) { - # - # domain host isn't, keep $host whatever it is - # - print "domainify($host,$domain_host) = $host\n" if $debug; - return $host; - } - - # - # There are several weird situtations that need to be - # accounted for. They have to do with domain relay hosts. - # - # Examples: - # host server "right answer" - # - # shiva.cs cs.berkeley.edu shiva.cs.berkeley.edu - # shiva cs.berkeley.edu shiva.cs.berekley.edu - # cumulus reed.edu @reed.edu:cumulus.uucp - # tiberius tc.cornell.edu tiberius.tc.cornell.edu - # - # The first try must always be to cut the domain part out of - # the server and tack it onto the host. - # - # A reasonable second try is to tack the whole server part onto - # the host and for each possible repeated element, eliminate - # just that part. - # - # These extra "guesses" get put into the %domainify_fallback - # array. They will be used to give addresses a second chance - # in the &giveup routine - # - - local(%fallback); - - local($long); - $long = "$host $domain_host"; - $long =~ tr/A-Z/a-z/; - print "long = $long\n" if $debug; - if ($long =~ s/^([^ ]+\.)([^ ]+) \2(\.[^ ]+\.[^ ]+)/$1$2$3/) { - # matches shiva.cs cs.berkeley.edu and returns shiva.cs.berkeley.edu - print "condensed fallback $host $domain_host -> $long\n" if $debug; - $fallback{$long} = 9; - } - - local($fh); - $fh = $domain_host; - while ($fh =~ /\./) { - print "FALLBACK $host.$fh = 1\n" if $debug > 7; - $fallback{"$host.$fh"} = 1; - $fh =~ s/^[^\.]+\.//; - } - - $fallback{"$host.$domain_host"} = 2; - - ($domain = $domain_host) =~ s/^[^\.]+//; - $fallback{"$host$domain"} = 6 - if ($domain =~ /\./); - - if ($host =~ /\./) { - # - # Host is already okay, but let's look for multiple - # interpretations - # - print "domainify($host,$domain_host) = $host\n" if $debug; - delete $fallback{$host}; - $domainify_fallback{"$u *** $host"} = join(' ',sort {$fallback{$b} <=> $fallback{$a};} keys %fallback) if %fallback; - return $host; - } - - $domain = ".$domain_host" - if ($domain !~ /\..*\./); - $newhost = "$host$domain"; - - $create_host_backtrack{"$u *** $newhost"} = $domain_host; - print "domainify($host,$domain_host) = $newhost\n" if $debug; - delete $fallback{$newhost}; - $domainify_fallback{"$u *** $newhost"} = join(' ',sort {$fallback{$b} <=> $fallback{$a};} keys %fallback) if %fallback; - if ($debug) { - print "fallback = "; - print $domainify_fallback{"$u *** $newhost"} - if defined($domainify_fallback{"$u *** $newhost"}); - print "\n"; - } - return $newhost; -} -# return the first non-empty element of an array -sub firstname -{ - local(@names) = @_; - local($n); - while(@names) { - $n = shift(@names); - return $n if $n =~ /\S/; - } - return undef; -} -# queue up more addresses to expand -sub expn -{ - local($host,$addr,$name,$level) = @_; - if ($host) { - $host = &trhost($host); - - if (($debug > 3) || (defined $giveup{$host})) { - unshift(@hosts,$host) unless $users{$host}; - } else { - push(@hosts,$host) unless $users{$host}; - } - $users{$host} .= " $addr"; - $names{"$addr *** $host"} = $name; - $level{"$addr *** $host"} = $level + 1; - print "expn($host,$addr,$name)\n" if $debug; - return "\t$addr\n"; - } else { - return &final($addr,'NONE',$name); - } -} -# compute the numerical average value of an array -sub average -{ - local(@e) = @_; - return 0 unless @e; - local($e,$sum); - for $e (@e) { - $sum += $e; - } - $sum / @e; -} -# print to the server (also to stdout, if -w) -sub ps -{ - local($p) = @_; - print ">>> $p\n" if $watch; - print $S "$p\n"; -} -# return case-adjusted name for a host (for comparison purposes) -sub trhost -{ - # treat foo.bar as an alias for Foo.BAR - local($host) = @_; - local($trhost) = $host; - $trhost =~ tr/A-Z/a-z/; - if ($trhost{$trhost}) { - $host = $trhost{$trhost}; - } else { - $trhost{$trhost} = $host; - } - $trhost{$trhost}; -} -# re-queue users if an mx record dictates a redirect -# don't allow a user to be redirected more than once -sub mxredirect -{ - local($server,*users) = @_; - local($u,$nserver,@still_there); - - $nserver = &mx($server); - - if (&trhost($nserver) ne &trhost($server)) { - $0 = "$av0 - mx redirect $server -> $nserver\n"; - for $u (@users) { - if (defined $mxbacktrace{"$u *** $nserver"}) { - push(@still_there,$u); - } else { - $mxbacktrace{"$u *** $nserver"} = $server; - print "mxbacktrace{$u *** $nserver} = $server\n" - if ($debug > 1); - &expn($nserver,$u,$names{"$u *** $server"}); - } - } - @users = @still_there; - if (! @users) { - return $nserver; - } else { - return undef; - } - } - return undef; -} -# follow mx records, return a hostname -# also follow temporary redirections comming from &domainify and -# &mxlookup -sub mx -{ - local($h,$u) = @_; - - for (;;) { - if (defined $mx{&trhost($h)} && $h ne $mx{&trhost($h)}) { - $0 = "$av0 - mx expand $h"; - $h = $mx{&trhost($h)}; - return $h; - } - if ($u) { - if (defined $temporary_redirect{"$u *** $h"}) { - $0 = "$av0 - internal redirect $h"; - print "Temporary redirect taken $u *** $h -> " if $debug; - $h = $temporary_redirect{"$u *** $h"}; - print "$h\n" if $debug; - next; - } - $htr = &trhost($h); - if (defined $temporary_redirect{"$u *** $htr"}) { - $0 = "$av0 - internal redirect $h"; - print "temporary redirect taken $u *** $h -> " if $debug; - $h = $temporary_redirect{"$u *** $htr"}; - print "$h\n" if $debug; - next; - } - } - return $h; - } -} -# look up mx records with the name server. -# re-queue expansion requests if possible -# optionally give up on this host. -sub mxlookup -{ - local($lastchance,$server,$giveup,*users) = @_; - local(*T); - local(*NSLOOKUP); - local($nh, $pref,$cpref); - local($o0) = $0; - local($nserver); - local($name,$aliases,$type,$len,$thataddr); - local(%fallback); - - return 1 if &mxredirect($server,*users); - - if ((defined $mx{$server}) || (! $have_nslookup)) { - return 0 unless $lastchance; - &giveup('mx domainify',$giveup); - return 0; - } - - $0 = "$av0 - nslookup of $server"; - open(T,">/tmp/expn$$") || die "open > /tmp/expn$$: $!\n"; - print T "set querytype=MX\n"; - print T "$server\n"; - close(T); - $cpref = 1.0E12; - undef $nserver; - open(NSLOOKUP,"nslookup < /tmp/expn$$ 2>&1 |") || die "open nslookup: $!"; - while(<NSLOOKUP>) { - print if ($debug > 2); - if (/mail exchanger = ([-A-Za-z_.0-9+]+)/) { - $nh = $1; - if (/preference = (\d+)/) { - $pref = $1; - if ($pref < $cpref) { - $nserver = $nh; - $cpref = $pref; - } elsif ($pref) { - $fallback{$pref} .= " $nh"; - } - } - } - if (/Non-existent domain/) { - # - # These addresss are hosed. Kaput! Dead! - # However, if we created the address in the - # first place then there is a chance of - # salvation. - # - 1 while(<NSLOOKUP>); - close(NSLOOKUP); - return 0 unless $lastchance; - &giveup('domainify',"$server: Non-existent domain",undef,1); - return 0; - } - - } - close(NSLOOKUP); - unlink("/tmp/expn$$"); - unless ($nserver) { - $0 = "$o0 - finished mxlookup"; - return 0 unless $lastchance; - &giveup('mx domainify',"$server: Could not resolve address"); - return 0; - } - - # provide fallbacks in case $nserver doesn't work out - if (defined $fallback{$cpref}) { - $mx_secondary{$server} = $fallback{$cpref}; - } - - $0 = "$av0 - gethostbyname($nserver)"; - ($name,$aliases,$type,$len,$thataddr) = gethostbyname($nserver); - - unless ($thataddr) { - $0 = $o0; - return 0 unless $lastchance; - &giveup('mx domainify',"$nserver: could not resolve address"); - return 0; - } - print "MX($server) = $nserver\n" if $debug; - print "$server -> $nserver\n" if $vw && !$debug; - $mx{&trhost($server)} = $nserver; - # redeploy the users - unless (&mxredirect($server,*users)) { - return 0 unless $lastchance; - &giveup('mx domainify',"$nserver: only one level of mx redirect allowed"); - return 0; - } - $0 = "$o0 - finished mxlookup"; - return 1; -} -# if mx expansion did not help to resolve an address -# (ie: foo@bar became @baz:foo@bar, then undo the -# expansion). -# this is only used by &final -sub mxunroll -{ - local(*host,*addr) = @_; - local($r) = 0; - print "looking for mxbacktrace{$addr *** $host}\n" - if ($debug > 1); - while (defined $mxbacktrace{"$addr *** $host"}) { - print "Unrolling MX expnasion: \@$host:$addr -> " - if ($debug || $verbose); - $host = $mxbacktrace{"$addr *** $host"}; - print "\@$host:$addr\n" - if ($debug || $verbose); - $r = 1; - } - return 1 if $r; - $addr = "\@$host:$addr" - if ($host =~ /\./); - return 0; -} -# register a completed expnasion. Make the final address as -# simple as possible. -sub final -{ - local($addr,$host,$name,$error) = @_; - local($he); - local($hb,$hr); - local($au,$ah); - - if ($error =~ /Non-existent domain/) { - # - # If we created the domain, then let's undo the - # damage... - # - if (defined $create_host_backtrack{"$addr *** $host"}) { - while (defined $create_host_backtrack{"$addr *** $host"}) { - print "Un&domainifying($host) = " if $debug; - $host = $create_host_backtrack{"$addr *** $host"}; - print "$host\n" if $debug; - } - $error = "$host: could not locate"; - } else { - # - # If we only want valid addresses, toss out - # bad host names. - # - if ($valid) { - print STDERR "\@$host:$addr ($name) Non-existent domain\n"; - return ""; - } - } - } - - MXUNWIND: { - $0 = "$av0 - final parsing of \@$host:$addr"; - ($he = $host) =~ s/(\W)/\\$1/g; - if ($addr !~ /@/) { - # addr does not contain any host - $addr = "$addr@$host"; - } elsif ($addr !~ /$he/i) { - # if host part really something else, use the something - # else. - if ($addr =~ m/(.*)\@([^\@]+)$/) { - ($au,$ah) = ($1,$2); - print "au = $au ah = $ah\n" if $debug; - if (defined $temporary_redirect{"$addr *** $ah"}) { - $addr = "$au\@".$temporary_redirect{"$addr *** $ah"}; - print "Rewrite! to $addr\n" if $debug; - next MXUNWIND; - } - } - # addr does not contain full host - if ($valid) { - if ($host =~ /^([^\.]+)(\..+)$/) { - # host part has a . in it - foo.bar - ($hb, $hr) = ($1, $2); - if ($addr =~ /\@([^\.\@]+)$/ && ($1 eq $hb)) { - # addr part has not . - # and matches beginning of - # host part -- tack on a - # domain name. - $addr .= $hr; - } else { - &mxunroll(*host,*addr) - && redo MXUNWIND; - } - } else { - &mxunroll(*host,*addr) - && redo MXUNWIND; - } - } else { - $addr = "${addr}[\@$host]" - if ($host =~ /\./); - } - } - } - $name = "$name " if $name; - $error = " $error" if $error; - if ($valid) { - push(@final,"$name<$addr>"); - } else { - push(@final,"$name<$addr>$error"); - } - "\t$name<$addr>$error\n"; -} - -sub alarm -{ - local($alarm_action,$alarm_redirect,$alarm_user) = @_; - alarm(3600); - $SIG{ALRM} = 'handle_alarm'; -} -# this involves one great big ugly hack. -# the "next HOST" unwinds the stack! -sub handle_alarm -{ - &giveup($alarm_redirect,"Timed out during $alarm_action",$alarm_user); - next HOST; -} - -# read the rest of the current smtp daemon's response (and toss it away) -sub read_response -{ - local($done,$watch) = @_; - local(@resp); - print $s if $watch; - while(($done eq "-") && ($s = <$S>) && ($s =~ /^\d+([- ])/)) { - print $s if $watch; - $done = $1; - push(@resp,$s); - } - return @resp; -} -# print args if verbose. Return them in any case -sub verbose -{ - local(@tp) = @_; - print "@tp" if $verbose; -} -# to pass perl -w: -@tp; -$flag_a; -$flag_d; -$flag_1; -%already_domainify_fellback; -%already_mx_fellback; -&handle_alarm; -################### BEGIN PERL/TROFF TRANSITION -.00 ; - -'di -.nr nl 0-1 -.nr % 0 -.\\"'; __END__ -.\" ############## END PERL/TROFF TRANSITION -.TH EXPN 1 "March 11, 1993" -.AT 3 -.SH NAME -expn \- recursively expand mail aliases -.SH SYNOPSIS -.B expn -.RI [ -a ] -.RI [ -v ] -.RI [ -w ] -.RI [ -d ] -.RI [ -1 ] -.IR user [@ hostname ] -.RI [ user [@ hostname ]]... -.SH DESCRIPTION -.B expn -will use the SMTP -.B expn -and -.B vrfy -commands to expand mail aliases. -It will first look up the addresses you provide on the command line. -If those expand into addresses on other systems, it will -connect to the other systems and expand again. It will keep -doing this until no further expansion is possible. -.SH OPTIONS -The default output of -.B expn -can contain many lines which are not valid -email addresses. With the -.I -aa -flag, only expansions that result in legal addresses -are used. Since many mailing lists have an illegal -address or two, the single -.IR -a , -address, flag specifies that a few illegal addresses can -be mixed into the results. More -.I -a -flags vary the ratio. Read the source to track down -the formula. With the -.I -a -option, you should be able to construct a new mailing -list out of an existing one. -.LP -If you wish to limit the number of levels deep that -.B expn -will recurse as it traces addresses, use the -.I -1 -option. For each -.I -1 -another level will be traversed. So, -.I -111 -will traverse no more than three levels deep. -.LP -The normal mode of operation for -.B expn -is to do all of its work silently. -The following options make it more verbose. -It is not necessary to make it verbose to see what it is -doing because as it works, it changes its -.BR argv [0] -variable to reflect its current activity. -To see how it is expanding things, the -.IR -v , -verbose, flag will cause -.B expn -to show each address before -and after translation as it works. -The -.IR -w , -watch, flag will cause -.B expn -to show you its conversations with the mail daemons. -Finally, the -.IR -d , -debug, flag will expose many of the inner workings so that -it is possible to eliminate bugs. -.SH ENVIRONMENT -No enviroment variables are used. -.SH FILES -.PD 0 -.B /tmp/expn$$ -.B temporary file used as input to -.BR nslookup . -.SH SEE ALSO -.BR aliases (5), -.BR sendmail (8), -.BR nslookup (8), -RFC 823, and RFC 1123. -.SH BUGS -Not all mail daemons will implement -.B expn -or -.BR vrfy . -It is not possible to verify addresses that are served -by such daemons. -.LP -When attempting to connect to a system to verify an address, -.B expn -only tries one IP address. Most mail daemons -will try harder. -.LP -It is assumed that you are running domain names and that -the -.BR nslookup (8) -program is available. If not, -.B expn -will not be able to verify many addresses. It will also pause -for a long time unless you change the code where it says -.I $have_nslookup = 1 -to read -.I $have_nslookup = -.IR 0 . -.LP -Lastly, -.B expn -does not handle every valid address. If you have an example, -please submit a bug report. -.SH CREDITS -In 1986 or so, Jon Broome wrote a program of the same name -that did about the same thing. It has since suffered bit rot -and Jon Broome has dropped off the face of the earth! -(Jon, if you are out there, drop me a line) -.SH AVAILABILITY -The latest version of -.B expn -is available through anonymous ftp at -.IR ftp://ftp.idiom.com/pub/muir-programs/expn . -.SH AUTHOR -.I David Muir Sharnoff\ \ \ \ <muir@idiom.com> |