contrib/amd/scripts/expn.1

   1 #!@PERL@
   2 'di ';
   3 'ds 00 \\"';
   4 'ig 00 ';
   5 #
   6 #       THIS PROGRAM IS ITS OWN MANUAL PAGE.  INSTALL IN man & bin.
   7 #
   8
   9 # hardcoded constants, should work fine for BSD-based systems
  10 #require 'sys/socket.ph';       # perl 4
  11 use Socket;                     # perl 5
  12 $AF_INET = &AF_INET;
  13 $SOCK_STREAM = &SOCK_STREAM;
  14 $sockaddr = 'S n a4 x8';
  15
  16 # system requirements:
  17 #       must have 'nslookup' and 'hostname' programs.
  18
  19 # $Header: /src/cvsroot/am-utils-6.0/scripts/expn.1,v 1.1.1.1 1998/11/05 02:04:58 ezk Exp $
  20
  21 # TODO:
  22 #       less magic should apply to command-line addresses
  23 #       less magic should apply to local addresses
  24 #       add magic to deal with cross-domain cnames
  25
  26 # Checklist: (hard addresses)
  27 #       250 Kimmo Suominen <"|/usr/local/mh/lib/slocal -user kim"@grendel.tac.nyc.ny.us>
  28 #       harry@hofmann.cs.Berkeley.EDU -> harry@tenet (.berkeley.edu)  [dead]
  29 #       bks@cs.berkeley.edu -> shiva.CS (.berkeley.edu)               [dead]
  30 #       dan@tc.cornell.edu -> brown@tiberius (.tc.cornell.edu)
  31
  32 #############################################################################
  33 #
  34 #  Copyright (c) 1993 David Muir Sharnoff
  35 #  All rights reserved.
  36 #
  37 #  Redistribution and use in source and binary forms, with or without
  38 #  modification, are permitted provided that the following conditions
  39 #  are met:
  40 #  1. Redistributions of source code must retain the above copyright
  41 #     notice, this list of conditions and the following disclaimer.
  42 #  2. Redistributions in binary form must reproduce the above copyright
  43 #     notice, this list of conditions and the following disclaimer in the
  44 #     documentation and/or other materials provided with the distribution.
  45 #  3. All advertising materials mentioning features or use of this software
  46 #     must display the following acknowledgement:
  47 #       This product includes software developed by the David Muir Sharnoff.
  48 #  4. The name of David Sharnoff may not be used to endorse or promote products
  49 #     derived from this software without specific prior written permission.
  50 #
  51 #  THIS SOFTWARE IS PROVIDED BY THE DAVID MUIR SHARNOFF ``AS IS'' AND
  52 #  ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
  53 #  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  54 #  ARE DISCLAIMED.  IN NO EVENT SHALL DAVID MUIR SHARNOFF BE LIABLE
  55 #  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  56 #  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
  57 #  OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  58 #  HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  59 #  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
  60 #  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
  61 #  SUCH DAMAGE.
  62 #
  63 # This copyright notice derrived from material copyrighted by the Regents
  64 # of the University of California.
  65 #
  66 # Contributions accepted.
  67 #
  68 #############################################################################
  69
  70 # overall structure:
  71 #       in an effort to not trace each address individually, but rather
  72 #       ask each server in turn a whole bunch of questions, addresses to
  73 #       be expanded are queued up.
  74 #
  75 #       This means that all accounting w.r.t. an address must be stored in
  76 #       various arrays.  Generally these arrays are indexed by the
  77 #       string "$addr *** $server" where $addr is the address to be
  78 #       expanded "foo" or maybe "foo@bar" and $server is the hostname
  79 #       of the SMTP server to contact.
  80 #
  81
  82 # important global variables:
  83 #
  84 # @hosts : list of servers still to be contacted
  85 # $server : name of the current we are currently looking at
  86 # @users = $users{@hosts[0]} : addresses to expand at this server
  87 # $u = $users[0] : the current address being expanded
  88 # $names{"$users[0] *** $server"} : the 'name' associated with the address
  89 # $mxbacktrace{"$users[0] *** $server"} : record of mx expansion
  90 # $mx_secondary{$server} : other mx relays at the same priority
  91 # $domainify_fallback{"$users[0] *** $server"} : alternative names to try
  92 #       instead of $server if $server doesn't work
  93 # $temporary_redirect{"$users[0] *** $server"} : when trying alternates,
  94 #       temporarily channel all tries along current path
  95 # $giveup{$server} : do not bother expanding addresses at $server
  96 # $verbose : -v
  97 # $watch : -w
  98 # $vw : -v or -w
  99 # $debug : -d
 100 # $valid : -a
 101 # $levels : -1
 102 # S : the socket connection to $server
 103
 104 $have_nslookup = 1;     # we have the nslookup program
 105 $port = 'smtp';
 106 $av0 = $0;
 107 $ENV{'PATH'} .= ":/usr/etc" unless $ENV{'PATH'} =~ m,/usr/etc,;
 108 $ENV{'PATH'} .= ":/usr/ucb" unless $ENV{'PATH'} =~ m,/usr/ucb,;
 109 select(STDERR);
 110
 111 $0 = "$av0 - running hostname";
 112 chop($name = `hostname || uname -n`);
 113
 114 $0 = "$av0 - lookup host FQDN and IP addr";
 115 ($hostname,$aliases,$type,$len,$thisaddr) = gethostbyname($name);
 116
 117 $0 = "$av0 - parsing args";
 118 $usage = "Usage: $av0 [-1avwd] user[\@host] [user2[host2] ...]";
 119 for $a (@ARGV) {
 120         die $usage if $a eq "-";
 121         while ($a =~ s/^(-.*)([1avwd])/$1/) {
 122                 eval '$'."flag_$2 += 1";
 123         }
 124         next if $a eq "-";
 125         die $usage if $a =~ /^-/;
 126         &expn(&parse($a,$hostname,undef,1));
 127 }
 128 $verbose = $flag_v;
 129 $watch = $flag_w;
 130 $vw = $flag_v + $flag_w;
 131 $debug = $flag_d;
 132 $valid = $flag_a;
 133 $levels = $flag_1;
 134
 135 die $usage unless @hosts;
 136 if ($valid) {
 137         if ($valid == 1) {
 138                 $validRequirement = 0.8;
 139         } elsif ($valid == 2) {
 140                 $validRequirement = 1.0;
 141         } elsif ($valid == 3) {
 142                 $validRequirement = 0.9;
 143         } else {
 144                 $validRequirement = (1 - (1/($valid-3)));
 145                 print "validRequirement = $validRequirement\n" if $debug;
 146         }
 147 }
 148
 149 $0 = "$av0 - building local socket";
 150 ($name,$aliases,$proto) = getprotobyname('tcp');
 151 ($name,$aliases,$port) = getservbyname($port,'tcp')
 152         unless $port =~ /^\d+/;
 153 $this = pack($sockaddr, &AF_INET, 0, $thisaddr);
 154
 155 HOST:
 156 while (@hosts) {
 157         $server = shift(@hosts);
 158         @users = split(' ',$users{$server});
 159         delete $users{$server};
 160
 161         # is this server already known to be bad?
 162         $0 = "$av0 - looking up $server";
 163         if ($giveup{$server}) {
 164                 &giveup('mx domainify',$giveup{$server});
 165                 next;
 166         }
 167
 168         # do we already have an mx record for this host?
 169         next HOST if &mxredirect($server,*users);
 170
 171         # look it up, or try for an mx.
 172         $0 = "$av0 - gethostbyname($server)";
 173
 174         ($name,$aliases,$type,$len,$thataddr) = gethostbyname($server);
 175         # if we can't get an A record, try for an MX record.
 176         unless($thataddr) {
 177                 &mxlookup(1,$server,"$server: could not resolve name",*users);
 178                 next HOST;
 179         }
 180
 181         # get a connection, or look for an mx
 182         $0 = "$av0 - socket to $server";
 183         $that = pack($sockaddr, &AF_INET, $port, $thataddr);
 184         socket(S, &AF_INET, &SOCK_STREAM, $proto)
 185                 || die "socket: $!";
 186         $0 = "$av0 - bind to $server";
 187         bind(S, $this)
 188                 || die "bind $hostname,0: $!";
 189         $0 = "$av0 - connect to $server";
 190         print "debug = $debug server = $server\n" if $debug > 8;
 191         if (! connect(S, $that) || ($debug == 10 && $server =~ /relay\d.UU.NET$/i)) {
 192                 $0 = "$av0 - $server: could not connect: $!\n";
 193                 $emsg = $!;
 194                 unless (&mxlookup(0,$server,"$server: could not connect: $!",*users)) {
 195                         &giveup('mx',"$server: Could not connect: $emsg");
 196                 }
 197                 next HOST;
 198         }
 199         select((select(S),$| = 1)[0]); # don't buffer output to S
 200
 201         # read the greeting
 202         $0 = "$av0 - talking to $server";
 203         &alarm("greeting with $server",'');
 204         while(<S>) {
 205                 alarm(0);
 206                 print if $watch;
 207                 if (/^(\d+)([- ])/) {
 208                         if ($1 != 220) {
 209                                 $0 = "$av0 - bad numeric response from $server";
 210                                 &alarm("giving up after bad response from $server",'');
 211                                 &read_response($2,$watch);
 212                                 alarm(0);
 213                                 print STDERR "$server: NOT 220 greeting: $_"
 214                                         if ($debug || $vw);
 215                                 if (&mxlookup(0,$server,"$server: did not respond with a 220 greeting",*users)) {
 216                                         close(S);
 217                                         next HOST;
 218                                 }
 219                         }
 220                         last if ($2 eq " ");
 221                 } else {
 222                         $0 = "$av0 - bad response from $server";
 223                         print STDERR "$server: NOT 220 greeting: $_"
 224                                 if ($debug || $vw);
 225                         unless (&mxlookup(0,$server,"$server: did not respond with SMTP codes",*users)) {
 226                                 &giveup('',"$server: did not talk SMTP");
 227                         }
 228                         close(S);
 229                         next HOST;
 230                 }
 231                 &alarm("greeting with $server",'');
 232         }
 233         alarm(0);
 234
 235         # if this causes problems, remove it
 236         $0 = "$av0 - sending helo to $server";
 237         &alarm("sending helo to $server","");
 238         &ps("helo $hostname");
 239         while(<S>) {
 240                 print if $watch;
 241                 last if /^\d+ /;
 242         }
 243         alarm(0);
 244
 245         # try the users, one by one
 246         USER:
 247         while(@users) {
 248                 $u = shift(@users);
 249                 $0 = "$av0 - expanding $u [\@$server]";
 250
 251                 # do we already have a name for this user?
 252                 $oldname = $names{"$u *** $server"};
 253
 254                 print &compact($u,$server)." ->\n" if ($verbose && ! $valid);
 255                 if ($valid) {
 256                         #
 257                         # when running with -a, we delay taking any action
 258                         # on the results of our query until we have looked
 259                         # at the complete output.  @toFinal stores expansions
 260                         # that will be final if we take them.  @toExpn stores
 261                         # expnansions that are not final.  @isValid keeps
 262                         # track of our ability to send mail to each of the
 263                         # expansions.
 264                         #
 265                         @isValid = ();
 266                         @toFinal = ();
 267                         @toExpn = ();
 268                 }
 269
 270 #               ($ecode,@expansion) = &expn_vrfy($u,$server);
 271                 (@foo) = &expn_vrfy($u,$server);
 272                 ($ecode,@expansion) = @foo;
 273                 if ($ecode) {
 274                         &giveup('',$ecode,$u);
 275                         last USER;
 276                 }
 277
 278                 for $s (@expansion) {
 279                         $s =~ s/[\n\r]//g;
 280                         $0 = "$av0 - parsing $server: $s";
 281
 282                         $skipwatch = $watch;
 283
 284                         if ($s =~ /^[25]51([- ]).*<(.+)>/) {
 285                                 print "$s" if $watch;
 286                                 print "(pretending 250$1<$2>)" if ($debug && $watch);
 287                                 print "\n" if $watch;
 288                                 $s = "250$1<$2>";
 289                                 $skipwatch = 0;
 290                         }
 291
 292                         if ($s =~ /^250([- ])(.+)/) {
 293                                 print "$s\n" if $skipwatch;
 294                                 ($done,$addr) = ($1,$2);
 295                                 ($newhost, $newaddr, $newname) =  &parse($addr,$server,$oldname, $#expansion == 0);
 296                                 print "($newhost, $newaddr, $newname) = &parse($addr, $server, $oldname)\n" if $debug;
 297                                 if (! $newhost) {
 298                                         # no expansion is possible w/o a new server to call
 299                                         if ($valid) {
 300                                                 push(@isValid, &validAddr($newaddr));
 301                                                 push(@toFinal,$newaddr,$server,$newname);
 302                                         } else {
 303                                                 &verbose(&final($newaddr,$server,$newname));
 304                                         }
 305                                 } else {
 306                                         $newmxhost = &mx($newhost,$newaddr);
 307                                         print "$newmxhost = &mx($newhost)\n"
 308                                                 if ($debug && $newhost ne $newmxhost);
 309                                         $0 = "$av0 - parsing $newaddr [@$newmxhost]";
 310                                         print "levels = $levels, level{$u *** $server} = ".$level{"$u *** $server"}."\n" if ($debug > 1);
 311                                         # If the new server is the current one,
 312                                         # it would have expanded things for us
 313                                         # if it could have.  Mx records must be
 314                                         # followed to compare server names.
 315                                         # We are also done if the recursion
 316                                         # count has been exceeded.
 317                                         if (&trhost($newmxhost) eq &trhost($server) || ($levels && $level{"$u *** $server"} >= $levels)) {
 318                                                 if ($valid) {
 319                                                         push(@isValid, &validAddr($newaddr));
 320                                                         push(@toFinal,$newaddr,$newmxhost,$newname);
 321                                                 } else {
 322                                                         &verbose(&final($newaddr,$newmxhost,$newname));
 323                                                 }
 324                                         } else {
 325                                                 # more work to do...
 326                                                 if ($valid) {
 327                                                         push(@isValid, &validAddr($newaddr));
 328                                                         push(@toExpn,$newmxhost,$newaddr,$newname,$level{"$u *** $server"});
 329                                                 } else {
 330                                                         &verbose(&expn($newmxhost,$newaddr,$newname,$level{"$u *** $server"}));
 331                                                 }
 332                                         }
 333                                 }
 334                                 last if ($done eq " ");
 335                                 next;
 336                         }
 337                         # 550 is a known code...  Should the be
 338                         # included in -a output?  Might be a bug
 339                         # here.  Does it matter?  Can assume that
 340                         # there won't be UNKNOWN USER responses
 341                         # mixed with valid users?
 342                         if ($s =~ /^(550)([- ])/) {
 343                                 if ($valid) {
 344                                         print STDERR "\@$server:$u ($oldname) USER UNKNOWN\n";
 345                                 } else {
 346                                         &verbose(&final($u,$server,$oldname,"USER UNKNOWN"));
 347                                 }
 348                                 last if ($2 eq " ");
 349                                 next;
 350                         }
 351                         # 553 is a known code...
 352                         if ($s =~ /^(553)([- ])/) {
 353                                 if ($valid) {
 354                                         print STDERR "\@$server:$u ($oldname) USER AMBIGUOUS\n";
 355                                 } else {
 356                                         &verbose(&final($u,$server,$oldname,"USER AMBIGUOUS"));
 357                                 }
 358                                 last if ($2 eq " ");
 359                                 next;
 360                         }
 361                         # 252 is a known code...
 362                         if ($s =~ /^(252)([- ])/) {
 363                                 if ($valid) {
 364                                         print STDERR "\@$server:$u ($oldname) REFUSED TO VRFY\n";
 365                                 } else {
 366                                         &verbose(&final($u,$server,$oldname,"REFUSED TO VRFY"));
 367                                 }
 368                                 last if ($2 eq " ");
 369                                 next;
 370                         }
 371                         &giveup('',"$server: did not grok '$s'",$u);
 372                         last USER;
 373                 }
 374
 375                 if ($valid) {
 376                         #
 377                         # now we decide if we are going to take these
 378                         # expansions or roll them back.
 379                         #
 380                         $avgValid = &average(@isValid);
 381                         print "avgValid = $avgValid\n" if $debug;
 382                         if ($avgValid >= $validRequirement) {
 383                                 print &compact($u,$server)." ->\n" if $verbose;
 384                                 while (@toExpn) {
 385                                         &verbose(&expn(splice(@toExpn,0,4)));
 386                                 }
 387                                 while (@toFinal) {
 388                                         &verbose(&final(splice(@toFinal,0,3)));
 389                                 }
 390                         } else {
 391                                 print "Tossing some valid to avoid invalid ".&compact($u,$server)."\n" if ($avgValid > 0.0 && ($vw || $debug));
 392                                 print &compact($u,$server)." ->\n" if $verbose;
 393                                 &verbose(&final($u,$server,$newname));
 394                         }
 395                 }
 396         }
 397
 398         &alarm("sending 'quit' to $server",'');
 399         $0 = "$av0 - sending 'quit' to $server";
 400         &ps("quit");
 401         while(<S>) {
 402                 print if $watch;
 403                 last if /^\d+ /;
 404         }
 405         close(S);
 406         alarm(0);
 407 }
 408
 409 $0 = "$av0 - printing final results";
 410 print "----------\n" if $vw;
 411 select(STDOUT);
 412 for $f (sort @final) {
 413         print "$f\n";
 414 }
 415 unlink("/tmp/expn$$");
 416 exit(0);
 417
 418
 419 # abandon all attempts deliver to $server
 420 # register the current addresses as the final ones
 421 sub giveup
 422 {
 423         local($redirect_okay,$reason,$user) = @_;
 424         local($us,@so,$nh,@remaining_users);
 425         local($pk,$file,$line);
 426         ($pk, $file, $line) = caller;
 427
 428         $0 = "$av0 - giving up on $server: $reason";
 429         #
 430         # add back a user if we gave up in the middle
 431         #
 432         push(@users,$user) if $user;
 433         #
 434         # don't bother with this system anymore
 435         #
 436         unless ($giveup{$server}) {
 437                 $giveup{$server} = $reason;
 438                 print STDERR "$reason\n";
 439         }
 440         print "Giveup at $file:$line!!! redirect okay = $redirect_okay; $reason\n" if $debug;
 441         #
 442         # Wait!
 443         # Before giving up, see if there is a chance that
 444         # there is another host to redirect to!
 445         # (Kids, don't do this at home!  Hacking is a dangerous
 446         # crime and you could end up behind bars.)
 447         #
 448         for $u (@users) {
 449                 if ($redirect_okay =~ /\bmx\b/) {
 450                         next if &try_fallback('mx',$u,*server,
 451                                 *mx_secondary,
 452                                 *already_mx_fellback);
 453                 }
 454                 if ($redirect_okay =~ /\bdomainify\b/) {
 455                         next if &try_fallback('domainify',$u,*server,
 456                                 *domainify_fallback,
 457                                 *already_domainify_fellback);
 458                 }
 459                 push(@remaining_users,$u);
 460         }
 461         @users = @remaining_users;
 462         for $u (@users) {
 463                 print &compact($u,$server)." ->\n" if ($verbose && $valid && $u);
 464                 &verbose(&final($u,$server,$names{"$u *** $server"},$reason));
 465         }
 466 }
 467 #
 468 # This routine is used only within &giveup.  It checks to
 469 # see if we really have to giveup or if there is a second
 470 # chance because we did something before that can be
 471 # backtracked.
 472 #
 473 # %fallback{"$user *** $host"} tracks what is able to fallback
 474 # %fellback{"$user *** $host"} tracks what has fallen back
 475 #
 476 # If there is a valid backtrack, then queue up the new possibility
 477 #
 478 sub try_fallback
 479 {
 480         local($method,$user,*host,*fall_table,*fellback) = @_;
 481         local($us,$fallhost,$oldhost,$ft,$i);
 482
 483         if ($debug > 8) {
 484                 print "Fallback table $method:\n";
 485                 for $i (sort keys %fall_table) {
 486                         print "\t'$i'\t\t'$fall_table{$i}'\n";
 487                 }
 488                 print "Fellback table $method:\n";
 489                 for $i (sort keys %fellback) {
 490                         print "\t'$i'\t\t'$fellback{$i}'\n";
 491                 }
 492                 print "U: $user H: $host\n";
 493         }
 494
 495         $us = "$user *** $host";
 496         if (defined $fellback{$us}) {
 497                 #
 498                 # Undo a previous fallback so that we can try again
 499                 # Nested fallbacks are avoided because they could
 500                 # lead to infinite loops
 501                 #
 502                 $fallhost = $fellback{$us};
 503                 print "Already $method fell back from $us -> \n" if $debug;
 504                 $us = "$user *** $fallhost";
 505                 $oldhost = $fallhost;
 506         } elsif (($method eq 'mx') && (defined $mxbacktrace{$us}) && (defined $mx_secondary{$mxbacktrace{$us}})) {
 507                 print "Fallback an MX expansion $us -> \n" if $debug;
 508                 $oldhost = $mxbacktrace{$us};
 509         } else {
 510                 print "Oldhost($host, $us) = " if $debug;
 511                 $oldhost = $host;
 512         }
 513         print "$oldhost\n" if $debug;
 514         if (((defined $fall_table{$us}) && ($ft = $us)) || ((defined $fall_table{$oldhost}) && ($ft = $oldhost))) {
 515                 print "$method Fallback = ".$fall_table{$ft}."\n" if $debug;
 516                 local(@so,$newhost);
 517                 @so = split(' ',$fall_table{$ft});
 518                 $newhost = shift(@so);
 519                 print "Falling back ($method) $us -> $newhost (from $oldhost)\n" if $debug;
 520                 if ($method eq 'mx') {
 521                         if (! defined ($mxbacktrace{"$user *** $newhost"})) {
 522                                 if (defined $mxbacktrace{"$user *** $oldhost"}) {
 523                                         print "resetting oldhost $oldhost to the original: " if $debug;
 524                                         $oldhost = $mxbacktrace{"$user *** $oldhost"};
 525                                         print "$oldhost\n" if $debug;
 526                                 }
 527                                 $mxbacktrace{"$user *** $newhost"} = $oldhost;
 528                                 print "mxbacktrace $user *** $newhost -> $oldhost\n" if $debug;
 529                         }
 530                         $mx{&trhost($oldhost)} = $newhost;
 531                 } else {
 532                         $temporary_redirect{$us} = $newhost;
 533                 }
 534                 if (@so) {
 535                         print "Can still $method  $us: @so\n" if $debug;
 536                         $fall_table{$ft} = join(' ',@so);
 537                 } else {
 538                         print "No more fallbacks for $us\n" if $debug;
 539                         delete $fall_table{$ft};
 540                 }
 541                 if (defined $create_host_backtrack{$us}) {
 542                         $create_host_backtrack{"$user *** $newhost"}
 543                                 = $create_host_backtrack{$us};
 544                 }
 545                 $fellback{"$user *** $newhost"} = $oldhost;
 546                 &expn($newhost,$user,$names{$us},$level{$us});
 547                 return 1;
 548         }
 549         delete $temporary_redirect{$us};
 550         $host = $oldhost;
 551         return 0;
 552 }
 553 # return 1 if you could send mail to the address as is.
 554 sub validAddr
 555 {
 556         local($addr) = @_;
 557         $res = &do_validAddr($addr);
 558         print "validAddr($addr) = $res\n" if $debug;
 559         $res;
 560 }
 561 sub do_validAddr
 562 {
 563         local($addr) = @_;
 564         local($urx) = "[-A-Za-z_.0-9+]+";
 565
 566         # \u
 567         return 0 if ($addr =~ /^\\/);
 568         # ?@h
 569         return 1 if ($addr =~ /.\@$urx$/);
 570         # @h:?
 571         return 1 if ($addr =~ /^\@$urx\:./);
 572         # h!u
 573         return 1 if ($addr =~ /^$urx!./);
 574         # u
 575         return 1 if ($addr =~ /^$urx$/);
 576         # ?
 577         print "validAddr($addr) = ???\n" if $debug;
 578         return 0;
 579 }
 580 # Some systems use expn and vrfy interchangeably.  Some only
 581 # implement one or the other.  Some check expn against mailing
 582 # lists and vrfy against users.  It doesn't appear to be
 583 # consistent.
 584 #
 585 # So, what do we do?  We try everything!
 586 #
 587 #
 588 # Ranking of result codes: good: 250, 251/551, 252, 550, anything else
 589 #
 590 # Ranking of inputs: best: user@host.domain, okay: user
 591 #
 592 # Return value: $error_string, @responses_from_server
 593 sub expn_vrfy
 594 {
 595         local($u,$server) = @_;
 596         local(@c) = ('expn', 'vrfy');
 597         local(@try_u) = $u;
 598         local(@ret,$code);
 599
 600         if (($u =~ /(.+)@(.+)/) && (&trhost($2) eq &trhost($server))) {
 601                 push(@try_u,$1);
 602         }
 603
 604         TRY:
 605         for $c (@c) {
 606                 for $try_u (@try_u) {
 607                         &alarm("${c}'ing $try_u on $server",'',$u);
 608                         &ps("$c $try_u");
 609                         alarm(0);
 610                         $s = <S>;
 611                         if ($s eq '') {
 612                                 return "$server: lost connection";
 613                         }
 614                         if ($s !~ /^(\d+)([- ])/) {
 615                                 return "$server: garbled reply to '$c $try_u'";
 616                         }
 617                         if ($1 == 250) {
 618                                 $code = 250;
 619                                 @ret = ("",$s);
 620                                 push(@ret,&read_response($2,$debug));
 621                                 return (@ret);
 622                         }
 623                         if ($1 == 551 || $1 == 251) {
 624                                 $code = $1;
 625                                 @ret = ("",$s);
 626                                 push(@ret,&read_response($2,$debug));
 627                                 next;
 628                         }
 629                         if ($1 == 252 && ($code == 0 || $code == 550)) {
 630                                 $code = 252;
 631                                 @ret = ("",$s);
 632                                 push(@ret,&read_response($2,$watch));
 633                                 next;
 634                         }
 635                         if ($1 == 550 && $code == 0) {
 636                                 $code = 550;
 637                                 @ret = ("",$s);
 638                                 push(@ret,&read_response($2,$watch));
 639                                 next;
 640                         }
 641                         &read_response($2,$watch);
 642                 }
 643         }
 644         return "$server: expn/vrfy not implemented" unless @ret;
 645         return @ret;
 646 }
 647 # sometimes the old parse routine (now parse2) didn't
 648 # reject funky addresses.
 649 sub parse
 650 {
 651         local($oldaddr,$server,$oldname,$one_to_one) = @_;
 652         local($newhost, $newaddr, $newname, $um) =  &parse2($oldaddr,$server,$oldname,$one_to_one);
 653         if ($newaddr =~ m,^["/],) {
 654                 return (undef, $oldaddr, $newname) if $valid;
 655                 return (undef, $um, $newname);
 656         }
 657         return ($newhost, $newaddr, $newname);
 658 }
 659
 660 # returns ($new_smtp_server,$new_address,$new_name)
 661 # given a response from a SMTP server ($newaddr), the
 662 # current host ($server), the old "name" and a flag that
 663 # indicates if it is being called during the initial
 664 # command line parsing ($parsing_args)
 665 sub parse2
 666 {
 667         local($newaddr,$context_host,$old_name,$parsing_args) = @_;
 668         local(@names) = $old_name;
 669         local($urx) = "[-A-Za-z_.0-9+]+";
 670         local($unmangle);
 671
 672         #
 673         # first, separate out the address part.
 674         #
 675
 676         #
 677         # [NAME] <ADDR [(NAME)]>
 678         # [NAME] <[(NAME)] ADDR
 679         # ADDR [(NAME)]
 680         # (NAME) ADDR
 681         # [(NAME)] <ADDR>
 682         #
 683         if ($newaddr =~ /^\<(.*)\>$/) {
 684                 print "<A:$1>\n" if $debug;
 685                 ($newaddr) = &trim($1);
 686                 print "na = $newaddr\n" if $debug;
 687         }
 688         if ($newaddr =~ /^([^\<\>]*)\<([^\<\>]*)\>([^\<\>]*)$/) {
 689                 # address has a < > pair in it.
 690                 print "N:$1 <A:$2> N:$3\n" if $debug;
 691                 ($newaddr) = &trim($2);
 692                 unshift(@names, &trim($3,$1));
 693                 print "na = $newaddr\n" if $debug;
 694         }
 695         if ($newaddr =~ /^([^\(\)]*)\(([^\(\)]*)\)([^\(\)]*)$/) {
 696                 # address has a ( ) pair in it.
 697                 print "A:$1 (N:$2) A:$3\n" if $debug;
 698                 unshift(@names,&trim($2));
 699                 local($f,$l) = (&trim($1),&trim($3));
 700                 if (($f && $l) || !($f || $l)) {
 701                         # address looks like:
 702                         # foo (bar) baz  or (bar)
 703                         # not allowed!
 704                         print STDERR "Could not parse $newaddr\n" if $vw;
 705                         return(undef,$newaddr,&firstname(@names));
 706                 }
 707                 $newaddr = $f if $f;
 708                 $newaddr = $l if $l;
 709                 print "newaddr now = $newaddr\n" if $debug;
 710         }
 711         #
 712         # @foo:bar
 713         # j%k@l
 714         # a@b
 715         # b!a
 716         # a
 717         #
 718         $unmangle = $newaddr;
 719         if ($newaddr =~ /^\@($urx)\:(.+)$/) {
 720                 print "(\@:)" if $debug;
 721                 # this is a bit of a cheat, but it seems necessary
 722                 return (&domainify($1,$context_host,$2),$2,&firstname(@names),$unmangle);
 723         }
 724         if ($newaddr =~ /^(.+)\@($urx)$/) {
 725                 print "(\@)" if $debug;
 726                 return (&domainify($2,$context_host,$newaddr),$newaddr,&firstname(@names),$unmangle);
 727         }
 728         if ($parsing_args) {
 729                 if ($newaddr =~ /^($urx)\!(.+)$/) {
 730                         return (&domainify($1,$context_host,$newaddr),$newaddr,&firstname(@names),$unmangle);
 731                 }
 732                 if ($newaddr =~ /^($urx)$/) {
 733                         return ($context_host,$newaddr,&firstname(@names),$unmangle);
 734                 }
 735                 print STDERR "Could not parse $newaddr\n";
 736         }
 737         print "(?)" if $debug;
 738         return(undef,$newaddr,&firstname(@names),$unmangle);
 739 }
 740 # return $u (@$server) unless $u includes reference to $server
 741 sub compact
 742 {
 743         local($u, $server) = @_;
 744         local($se) = $server;
 745         local($sp);
 746         $se =~ s/(\W)/\\$1/g;
 747         $sp = " (\@$server)";
 748         if ($u !~ /$se/i) {
 749                 return "$u$sp";
 750         }
 751         return $u;
 752 }
 753 # remove empty (spaces don't count) members from an array
 754 sub trim
 755 {
 756         local(@v) = @_;
 757         local($v,@r);
 758         for $v (@v) {
 759                 $v =~ s/^\s+//;
 760                 $v =~ s/\s+$//;
 761                 push(@r,$v) if ($v =~ /\S/);
 762         }
 763         return(@r);
 764 }
 765 # using the host part of an address, and the server name, add the
 766 # servers' domain to the address if it doesn't already have a
 767 # domain.  Since this sometimes fails, save a back reference so
 768 # it can be unrolled.
 769 sub domainify
 770 {
 771         local($host,$domain_host,$u) = @_;
 772         local($domain,$newhost);
 773
 774         # cut of trailing dots
 775         $host =~ s/\.$//;
 776         $domain_host =~ s/\.$//;
 777
 778         if ($domain_host !~ /\./) {
 779                 #
 780                 # domain host isn't, keep $host whatever it is
 781                 #
 782                 print "domainify($host,$domain_host) = $host\n" if $debug;
 783                 return $host;
 784         }
 785
 786         #
 787         # There are several weird situtations that need to be
 788         # accounted for.  They have to do with domain relay hosts.
 789         #
 790         # Examples:
 791         #       host            server          "right answer"
 792         #
 793         #       shiva.cs        cs.berkeley.edu shiva.cs.berkeley.edu
 794         #       shiva           cs.berkeley.edu shiva.cs.berekley.edu
 795         #       cumulus         reed.edu        @reed.edu:cumulus.uucp
 796         #       tiberius        tc.cornell.edu  tiberius.tc.cornell.edu
 797         #
 798         # The first try must always be to cut the domain part out of
 799         # the server and tack it onto the host.
 800         #
 801         # A reasonable second try is to tack the whole server part onto
 802         # the host and for each possible repeated element, eliminate
 803         # just that part.
 804         #
 805         # These extra "guesses" get put into the %domainify_fallback
 806         # array.  They will be used to give addresses a second chance
 807         # in the &giveup routine
 808         #
 809
 810         local(%fallback);
 811
 812         local($long);
 813         $long = "$host $domain_host";
 814         $long =~ tr/A-Z/a-z/;
 815         print "long = $long\n" if $debug;
 816         if ($long =~ s/^([^ ]+\.)([^ ]+) \2(\.[^ ]+\.[^ ]+)/$1$2$3/) {
 817                 # matches shiva.cs cs.berkeley.edu and returns shiva.cs.berkeley.edu
 818                 print "condensed fallback $host $domain_host -> $long\n" if $debug;
 819                 $fallback{$long} = 9;
 820         }
 821
 822         local($fh);
 823         $fh = $domain_host;
 824         while ($fh =~ /\./) {
 825                 print "FALLBACK $host.$fh = 1\n" if $debug > 7;
 826                 $fallback{"$host.$fh"} = 1;
 827                 $fh =~ s/^[^\.]+\.//;
 828         }
 829
 830         $fallback{"$host.$domain_host"} = 2;
 831
 832         ($domain = $domain_host) =~ s/^[^\.]+//;
 833         $fallback{"$host$domain"} = 6
 834                 if ($domain =~ /\./);
 835
 836         if ($host =~ /\./) {
 837                 #
 838                 # Host is already okay, but let's look for multiple
 839                 # interpretations
 840                 #
 841                 print "domainify($host,$domain_host) = $host\n" if $debug;
 842                 delete $fallback{$host};
 843                 $domainify_fallback{"$u *** $host"} = join(' ',sort {$fallback{$b} <=> $fallback{$a};} keys %fallback) if %fallback;
 844                 return $host;
 845         }
 846
 847         $domain = ".$domain_host"
 848                 if ($domain !~ /\..*\./);
 849         $newhost = "$host$domain";
 850
 851         $create_host_backtrack{"$u *** $newhost"} = $domain_host;
 852         print "domainify($host,$domain_host) = $newhost\n" if $debug;
 853         delete $fallback{$newhost};
 854         $domainify_fallback{"$u *** $newhost"} = join(' ',sort {$fallback{$b} <=> $fallback{$a};} keys %fallback) if %fallback;
 855         if ($debug) {
 856                 print "fallback = ";
 857                 print $domainify_fallback{"$u *** $newhost"}
 858                         if defined($domainify_fallback{"$u *** $newhost"});
 859                 print "\n";
 860         }
 861         return $newhost;
 862 }
 863 # return the first non-empty element of an array
 864 sub firstname
 865 {
 866         local(@names) = @_;
 867         local($n);
 868         while(@names) {
 869                 $n = shift(@names);
 870                 return $n if $n =~ /\S/;
 871         }
 872         return undef;
 873 }
 874 # queue up more addresses to expand
 875 sub expn
 876 {
 877         local($host,$addr,$name,$level) = @_;
 878         if ($host) {
 879                 $host = &trhost($host);
 880
 881                 if (($debug > 3) || (defined $giveup{$host})) {
 882                         unshift(@hosts,$host) unless $users{$host};
 883                 } else {
 884                         push(@hosts,$host) unless $users{$host};
 885                 }
 886                 $users{$host} .= " $addr";
 887                 $names{"$addr *** $host"} = $name;
 888                 $level{"$addr *** $host"} = $level + 1;
 889                 print "expn($host,$addr,$name)\n" if $debug;
 890                 return "\t$addr\n";
 891         } else {
 892                 return &final($addr,'NONE',$name);
 893         }
 894 }
 895 # compute the numerical average value of an array
 896 sub average
 897 {
 898         local(@e) = @_;
 899         return 0 unless @e;
 900         local($e,$sum);
 901         for $e (@e) {
 902                 $sum += $e;
 903         }
 904         $sum / @e;
 905 }
 906 # print to the server (also to stdout, if -w)
 907 sub ps
 908 {
 909         local($p) = @_;
 910         print ">>> $p\n" if $watch;
 911         print S "$p\n";
 912 }
 913 # return case-adjusted name for a host (for comparison purposes)
 914 sub trhost
 915 {
 916         # treat foo.bar as an alias for Foo.BAR
 917         local($host) = @_;
 918         local($trhost) = $host;
 919         $trhost =~ tr/A-Z/a-z/;
 920         if ($trhost{$trhost}) {
 921                 $host = $trhost{$trhost};
 922         } else {
 923                 $trhost{$trhost} = $host;
 924         }
 925         $trhost{$trhost};
 926 }
 927 # re-queue users if an mx record dictates a redirect
 928 # don't allow a user to be redirected more than once
 929 sub mxredirect
 930 {
 931         local($server,*users) = @_;
 932         local($u,$nserver,@still_there);
 933
 934         $nserver = &mx($server);
 935
 936         if (&trhost($nserver) ne &trhost($server)) {
 937                 $0 = "$av0 - mx redirect $server -> $nserver\n";
 938                 for $u (@users) {
 939                         if (defined $mxbacktrace{"$u *** $nserver"}) {
 940                                 push(@still_there,$u);
 941                         } else {
 942                                 $mxbacktrace{"$u *** $nserver"} = $server;
 943                                 print "mxbacktrace{$u *** $nserver} = $server\n"
 944                                         if ($debug > 1);
 945                                 &expn($nserver,$u,$names{"$u *** $server"});
 946                         }
 947                 }
 948                 @users = @still_there;
 949                 if (! @users) {
 950                         return $nserver;
 951                 } else {
 952                         return undef;
 953                 }
 954         }
 955         return undef;
 956 }
 957 # follow mx records, return a hostname
 958 # also follow temporary redirections comming from &domainify and
 959 # &mxlookup
 960 sub mx
 961 {
 962         local($h,$u) = @_;
 963
 964         for (;;) {
 965                 if (defined $mx{&trhost($h)} && $h ne $mx{&trhost($h)}) {
 966                         $0 = "$av0 - mx expand $h";
 967                         $h = $mx{&trhost($h)};
 968                         return $h;
 969                 }
 970                 if ($u) {
 971                         if (defined $temporary_redirect{"$u *** $h"}) {
 972                                 $0 = "$av0 - internal redirect $h";
 973                                 print "Temporary redirect taken $u *** $h -> " if $debug;
 974                                 $h = $temporary_redirect{"$u *** $h"};
 975                                 print "$h\n" if $debug;
 976                                 next;
 977                         }
 978                         $htr = &trhost($h);
 979                         if (defined $temporary_redirect{"$u *** $htr"}) {
 980                                 $0 = "$av0 - internal redirect $h";
 981                                 print "temporary redirect taken $u *** $h -> " if $debug;
 982                                 $h = $temporary_redirect{"$u *** $htr"};
 983                                 print "$h\n" if $debug;
 984                                 next;
 985                         }
 986                 }
 987                 return $h;
 988         }
 989 }
 990 # look up mx records with the name server.
 991 # re-queue expansion requests if possible
 992 # optionally give up on this host.
 993 sub mxlookup
 994 {
 995         local($lastchance,$server,$giveup,*users) = @_;
 996         local(*T);
 997         local(*NSLOOKUP);
 998         local($nh, $pref,$cpref);
 999         local($o0) = $0;
1000         local($nserver);
1001         local($name,$aliases,$type,$len,$thataddr);
1002         local(%fallback);
1003
1004         return 1 if &mxredirect($server,*users);
1005
1006         if ((defined $mx{$server}) || (! $have_nslookup)) {
1007                 return 0 unless $lastchance;
1008                 &giveup('mx domainify',$giveup);
1009                 return 0;
1010         }
1011
1012         $0 = "$av0 - nslookup of $server";
1013         open(T,">/tmp/expn$$") || die "open > /tmp/expn$$: $!\n";
1014         print T "set querytype=MX\n";
1015         print T "$server\n";
1016         close(T);
1017         $cpref = 1.0E12;
1018         undef $nserver;
1019         open(NSLOOKUP,"nslookup < /tmp/expn$$ 2>&1 |") || die "open nslookup: $!";
1020         while(<NSLOOKUP>) {
1021                 print if ($debug > 2);
1022                 if (/mail exchanger = ([-A-Za-z_.0-9+]+)/) {
1023                         $nh = $1;
1024                         if (/preference = (\d+)/) {
1025                                 $pref = $1;
1026                                 if ($pref < $cpref) {
1027                                         $nserver = $nh;
1028                                         $cpref = $pref;
1029                                 } elsif ($pref) {
1030                                         $fallback{$pref} .= " $nh";
1031                                 }
1032                         }
1033                 }
1034                 if (/Non-existent domain/) {
1035                         #
1036                         # These addresss are hosed.  Kaput!  Dead!
1037                         # However, if we created the address in the
1038                         # first place then there is a chance of
1039                         # salvation.
1040                         #
1041                         1 while(<NSLOOKUP>);
1042                         close(NSLOOKUP);
1043                         return 0 unless $lastchance;
1044                         &giveup('domainify',"$server: Non-existent domain",undef,1);
1045                         return 0;
1046                 }
1047
1048         }
1049         close(NSLOOKUP);
1050         unlink("/tmp/expn$$");
1051         unless ($nserver) {
1052                 $0 = "$o0 - finished mxlookup";
1053                 return 0 unless $lastchance;
1054                 &giveup('mx domainify',"$server: Could not resolve address");
1055                 return 0;
1056         }
1057
1058         # provide fallbacks in case $nserver doesn't work out
1059         if (defined $fallback{$cpref}) {
1060                 $mx_secondary{$server} = $fallback{$cpref};
1061         }
1062
1063         $0 = "$av0 - gethostbyname($nserver)";
1064         ($name,$aliases,$type,$len,$thataddr) = gethostbyname($nserver);
1065
1066         unless ($thataddr) {
1067                 $0 = $o0;
1068                 return 0 unless $lastchance;
1069                 &giveup('mx domainify',"$nserver: could not resolve address");
1070                 return 0;
1071         }
1072         print "MX($server) = $nserver\n" if $debug;
1073         print "$server -> $nserver\n" if $vw && !$debug;
1074         $mx{&trhost($server)} = $nserver;
1075         # redeploy the users
1076         unless (&mxredirect($server,*users)) {
1077                 return 0 unless $lastchance;
1078                 &giveup('mx domainify',"$nserver: only one level of mx redirect allowed");
1079                 return 0;
1080         }
1081         $0 = "$o0 - finished mxlookup";
1082         return 1;
1083 }
1084 # if mx expansion did not help to resolve an address
1085 # (ie: foo@bar became @baz:foo@bar, then undo the
1086 # expansion).
1087 # this is only used by &final
1088 sub mxunroll
1089 {
1090         local(*host,*addr) = @_;
1091         local($r) = 0;
1092         print "looking for mxbacktrace{$addr *** $host}\n"
1093                 if ($debug > 1);
1094         while (defined $mxbacktrace{"$addr *** $host"}) {
1095                 print "Unrolling MX expnasion: \@$host:$addr -> "
1096                         if ($debug || $verbose);
1097                 $host = $mxbacktrace{"$addr *** $host"};
1098                 print "\@$host:$addr\n"
1099                         if ($debug || $verbose);
1100                 $r = 1;
1101         }
1102         return 1 if $r;
1103         $addr = "\@$host:$addr"
1104                 if ($host =~ /\./);
1105         return 0;
1106 }
1107 # register a completed expnasion.  Make the final address as
1108 # simple as possible.
1109 sub final
1110 {
1111         local($addr,$host,$name,$error) = @_;
1112         local($he);
1113         local($hb,$hr);
1114         local($au,$ah);
1115
1116         if ($error =~ /Non-existent domain/) {
1117                 #
1118                 # If we created the domain, then let's undo the
1119                 # damage...
1120                 #
1121                 if (defined $create_host_backtrack{"$addr *** $host"}) {
1122                         while (defined $create_host_backtrack{"$addr *** $host"}) {
1123                                 print "Un&domainifying($host) = " if $debug;
1124                                 $host = $create_host_backtrack{"$addr *** $host"};
1125                                 print "$host\n" if $debug;
1126                         }
1127                         $error = "$host: could not locate";
1128                 } else {
1129                         #
1130                         # If we only want valid addresses, toss out
1131                         # bad host names.
1132                         #
1133                         if ($valid) {
1134                                 print STDERR "\@$host:$addr ($name) Non-existent domain\n";
1135                                 return "";
1136                         }
1137                 }
1138         }
1139
1140         MXUNWIND: {
1141                 $0 = "$av0 - final parsing of \@$host:$addr";
1142                 ($he = $host) =~ s/(\W)/\\$1/g;
1143                 if ($addr !~ /@/) {
1144                         # addr does not contain any host
1145                         $addr = "$addr@$host";
1146                 } elsif ($addr !~ /$he/i) {
1147                         # if host part really something else, use the something
1148                         # else.
1149                         if ($addr =~ m/(.*)\@([^\@]+)$/) {
1150                                 ($au,$ah) = ($1,$2);
1151                                 print "au = $au ah = $ah\n" if $debug;
1152                                 if (defined $temporary_redirect{"$addr *** $ah"}) {
1153                                         $addr = "$au\@".$temporary_redirect{"$addr *** $ah"};
1154                                         print "Rewrite! to $addr\n" if $debug;
1155                                         next MXUNWIND;
1156                                 }
1157                         }
1158                         # addr does not contain full host
1159                         if ($valid) {
1160                                 if ($host =~ /^([^\.]+)(\..+)$/) {
1161                                         # host part has a . in it - foo.bar
1162                                         ($hb, $hr) = ($1, $2);
1163                                         if ($addr =~ /\@([^\.\@]+)$/ && ($1 eq $hb)) {
1164                                                 # addr part has not .
1165                                                 # and matches beginning of
1166                                                 # host part -- tack on a
1167                                                 # domain name.
1168                                                 $addr .= $hr;
1169                                         } else {
1170                                                 &mxunroll(*host,*addr)
1171                                                         && redo MXUNWIND;
1172                                         }
1173                                 } else {
1174                                         &mxunroll(*host,*addr)
1175                                                 && redo MXUNWIND;
1176                                 }
1177                         } else {
1178                                 $addr = "${addr}[\@$host]"
1179                                         if ($host =~ /\./);
1180                         }
1181                 }
1182         }
1183         $name = "$name " if $name;
1184         $error = " $error" if $error;
1185         if ($valid) {
1186                 push(@final,"$name<$addr>");
1187         } else {
1188                 push(@final,"$name<$addr>$error");
1189         }
1190         "\t$name<$addr>$error\n";
1191 }
1192
1193 sub alarm
1194 {
1195         local($alarm_action,$alarm_redirect,$alarm_user) = @_;
1196         alarm(3600);
1197         $SIG{ALRM} = 'handle_alarm';
1198 }
1199 # this involves one great big ugly hack.
1200 # the "next HOST" unwinds the stack!
1201 sub handle_alarm
1202 {
1203         &giveup($alarm_redirect,"Timed out during $alarm_action",$alarm_user);
1204         next HOST;
1205 }
1206
1207 # read the rest of the current smtp daemon's response (and toss it away)
1208 sub read_response
1209 {
1210         local($done,$watch) = @_;
1211         local(@resp);
1212         print $s if $watch;
1213         while(($done eq "-") && ($s = <S>) && ($s =~ /^\d+([- ])/)) {
1214                 print $s if $watch;
1215                 $done = $1;
1216                 push(@resp,$s);
1217         }
1218         return @resp;
1219 }
1220 # print args if verbose.  Return them in any case
1221 sub verbose
1222 {
1223         local(@tp) = @_;
1224         print "@tp" if $verbose;
1225 }
1226 # to pass perl -w:
1227 @tp;
1228 $flag_a;
1229 $flag_d;
1230 $flag_1;
1231 %already_domainify_fellback;
1232 %already_mx_fellback;
1233 &handle_alarm;
1234 ################### BEGIN PERL/TROFF TRANSITION
1235 .00 ;
1236
1237 'di
1238 .nr nl 0-1
1239 .nr % 0
1240 .\\"'; __END__
1241 .\" ############## END PERL/TROFF TRANSITION
1242 .TH EXPN 1 "March 11, 1993"
1243 .AT 3
1244 .SH NAME
1245 expn \- recursively expand mail aliases
1246 .SH SYNOPSIS
1247 .B expn
1248 .RI [ -a ]
1249 .RI [ -v ]
1250 .RI [ -w ]
1251 .RI [ -d ]
1252 .RI [ -1 ]
1253 .IR user [@ hostname ]
1254 .RI [ user [@ hostname ]]...
1255 .SH DESCRIPTION
1256 .B expn
1257 will use the SMTP
1258 .B expn
1259 and
1260 .B vrfy
1261 commands to expand mail aliases.
1262 It will first look up the addresses you provide on the command line.
1263 If those expand into addresses on other systems, it will
1264 connect to the other systems and expand again.  It will keep
1265 doing this until no further expansion is possible.
1266 .SH OPTIONS
1267 The default output of
1268 .B expn
1269 can contain many lines which are not valid
1270 email addresses.  With the
1271 .I -aa
1272 flag, only expansions that result in legal addresses
1273 are used.  Since many mailing lists have an illegal
1274 address or two, the single
1275 .IR -a ,
1276 address, flag specifies that a few illegal addresses can
1277 be mixed into the results.   More
1278 .I -a
1279 flags vary the ratio.  Read the source to track down
1280 the formula.  With the
1281 .I -a
1282 option, you should be able to construct a new mailing
1283 list out of an existing one.
1284 .LP
1285 If you wish to limit the number of levels deep that
1286 .B expn
1287 will recurse as it traces addresses, use the
1288 .I -1
1289 option.  For each
1290 .I -1
1291 another level will be traversed.  So,
1292 .I -111
1293 will traverse no more than three levels deep.
1294 .LP
1295 The normal mode of operation for
1296 .B expn
1297 is to do all of its work silently.
1298 The following options make it more verbose.
1299 It is not necessary to make it verbose to see what it is
1300 doing because as it works, it changes its
1301 .BR argv [0]
1302 variable to reflect its current activity.
1303 To see how it is expanding things, the
1304 .IR -v ,
1305 verbose, flag will cause
1306 .B expn
1307 to show each address before
1308 and after translation as it works.
1309 The
1310 .IR -w ,
1311 watch, flag will cause
1312 .B expn
1313 to show you its conversations with the mail daemons.
1314 Finally, the
1315 .IR -d ,
1316 debug, flag will expose many of the inner workings so that
1317 it is possible to eliminate bugs.
1318 .SH ENVIRONMENT
1319 No enviroment variables are used.
1320 .SH FILES
1321 .PD 0
1322 .B /tmp/expn$$
1323 .B temporary file used as input to
1324 .BR nslookup .
1325 .SH SEE ALSO
1326 .BR aliases (5),
1327 .BR sendmail (8),
1328 .BR nslookup (8),
1329 RFC 823, and RFC 1123.
1330 .SH BUGS
1331 Not all mail daemons will implement
1332 .B expn
1333 or
1334 .BR vrfy .
1335 It is not possible to verify addresses that are served
1336 by such daemons.
1337 .LP
1338 When attempting to connect to a system to verify an address,
1339 .B expn
1340 only tries one IP address.  Most mail daemons
1341 will try harder.
1342 .LP
1343 It is assumed that you are running domain names and that
1344 the
1345 .BR nslookup (8)
1346 program is available.  If not,
1347 .B expn
1348 will not be able to verify many addresses.  It will also pause
1349 for a long time unless you change the code where it says
1350 .I $have_nslookup = 1
1351 to read
1352 .I $have_nslookup =
1353 .IR 0 .
1354 .LP
1355 Lastly,
1356 .B expn
1357 does not handle every valid address.  If you have an example,
1358 please submit a bug report.
1359 .SH CREDITS
1360 In 1986 or so, Jon Broome wrote a program of the same name
1361 that did about the same thing.  It has since suffered bit rot
1362 and Jon Broome has dropped off the face of the earth!
1363 (Jon, if you are out there, drop me a line)
1364 .SH AVAILABILITY
1365 The latest version of
1366 .B expn
1367 is available through anonymous ftp at
1368 .IR ftp://ftp.idiom.com/pub/muir-programs/expn .
1369 .SH AUTHOR
1370 .I David Muir Sharnoff\ \ \ \ <muir@idiom.com>