Merge from vendor branch LIBSTDC++:
[dragonfly.git] / contrib / sendmail / contrib / expn.pl
1 #!/usr/bin/perl
2 'di ';
3 'ds 00 \\"';
4 'ig 00 ';
5 #
6 #       THIS PROGRAM IS ITS OWN MANUAL PAGE.  INSTALL IN man & bin.
7 #
8
9 use 5.001;
10 use IO::Socket;
11 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>