contrib/amd/scripts/expn.in

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