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