+#!/usr/local/bin/perl
+'di ';
+'ds 00 \\"';
+'ig00 ';
+#
+# THIS PROGRAM IS ITS OWN MANUAL PAGE. INSTALL IN man & bin.
+#
+
+# hardcoded constants, should work fine for BSD-based systems
+$AF_INET = 2;
+$SOCK_STREAM = 1;
+$sockaddr = 'S n a4 x8';
+
+# system requirements:
+# must have 'nslookup' and 'hostname' programs.
+
+# $Header: /home/muir/bin/RCS/expn,v 3.6 1994/02/23 22:26:19 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
+
+# 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 account 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;
+$0 = "$av0 - running hostname";
+$ENV{'PATH'} .= ":/usr/etc" unless $ENV{'PATH'} =~ m,/usr/etc,;
+chop($hostname = `hostname`);
+select(STDERR);
+
+$usage = "Usage: $av0 [-1avwd] user[@host] [user2[host2] ...]";
+$0 = "$av0 - parsing args";
+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;
+ }
+}
+
+$0 = "$av0 - building local socket";
+($name,$aliases,$proto) = getprotobyname('tcp');
+($name,$aliases,$port) = getservbyname($port,'tcp')
+ unless $port =~ /^\d+/;
+($name,$aliases,$type,$len,$thisaddr) = gethostbyname($hostname);
+$this = pack($sockaddr, $AF_INET, 0, $thisaddr);
+
+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";
+ $that = pack($sockaddr, $AF_INET, $port, $thataddr);
+ socket(S, $AF_INET, $SOCK_STREAM, $proto)
+ || die "socket: $!";
+ $0 = "$av0 - bind to $server";
+ bind(S, $this)
+ || die "bind $hostname,0: $!";
+ $0 = "$av0 - connect to $server";
+ print "debug = $debug server = $server\n" if $debug > 8;
+ if (! connect(S, $that) || ($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;
+ }
+ select((select(S),$| = 1)[0]); # don't buffer output to S
+
+ # 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 responce from $server";
+ &alarm("giving up after bet responce 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 responce 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);
+ 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 responces
+ # 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);
+
+ $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!!! 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
+ # Nest 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, @responces_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 responce 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 failes, 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}) {
+# for $u (@users) {
+# print "mx_secondary{$u *** $nserver} = ".$fallback{$cpref}."\n"
+# if $debug;
+# $mx_secondary{"$u *** $nserver"} = $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 hack.
+# the "next HOST" has to unwind 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 responce (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 \\ " finish diversion--previous line must be blank
+.nr nl 0-1 \\ " fake up transition to first page again
+.nr % 0 \\ " start at page 1
+.\\"'; __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 to
+.IR idiom.berkeley.ca.us .
+.SH AUTHOR
+.I David Muir Sharnoff\ \ \ \ <muir@idiom.berkeley.ca.us>
projects / unix-history / commitdiff