contrib/sendmail/contrib/expn.pl

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