1663d5a0obrien#!@PERL@
2663d5a0obrien'di ';
3663d5a0obrien'ds 00 \\"';
4663d5a0obrien'ig 00 ';
5663d5a0obrien#
6663d5a0obrien#       THIS PROGRAM IS ITS OWN MANUAL PAGE.  INSTALL IN man & bin.
7663d5a0obrien#
8663d5a0obrien
9663d5a0obrien# hardcoded constants, should work fine for BSD-based systems
10663d5a0obrien#require 'sys/socket.ph';	# perl 4
11663d5a0obrienuse Socket;			# perl 5
12663d5a0obrien$AF_INET = &AF_INET;
13663d5a0obrien$SOCK_STREAM = &SOCK_STREAM;
14663d5a0obrien
15663d5a0obrien# system requirements:
16663d5a0obrien# 	must have 'nslookup' and 'hostname' programs.
17663d5a0obrien
18ea691ecobrien# $Header: /home/cvsroot/am-utils/scripts/expn.in,v 1.5 2002/07/11 14:28:20 ezk Exp $
19663d5a0obrien
20663d5a0obrien# TODO:
21663d5a0obrien#	less magic should apply to command-line addresses
22663d5a0obrien#	less magic should apply to local addresses
23663d5a0obrien#	add magic to deal with cross-domain cnames
24663d5a0obrien
25663d5a0obrien# Checklist: (hard addresses)
26663d5a0obrien#	250 Kimmo Suominen <"|/usr/local/mh/lib/slocal -user kim"@grendel.tac.nyc.ny.us>
27663d5a0obrien#	harry@hofmann.cs.Berkeley.EDU -> harry@tenet (.berkeley.edu)  [dead]
28663d5a0obrien#	bks@cs.berkeley.edu -> shiva.CS (.berkeley.edu)		      [dead]
29663d5a0obrien#	dan@tc.cornell.edu -> brown@tiberius (.tc.cornell.edu)
30663d5a0obrien
31663d5a0obrien#############################################################################
32663d5a0obrien#
33663d5a0obrien#  Copyright (c) 1993 David Muir Sharnoff
34663d5a0obrien#  All rights reserved.
35663d5a0obrien#
36663d5a0obrien#  Redistribution and use in source and binary forms, with or without
37663d5a0obrien#  modification, are permitted provided that the following conditions
38663d5a0obrien#  are met:
39663d5a0obrien#  1. Redistributions of source code must retain the above copyright
40663d5a0obrien#     notice, this list of conditions and the following disclaimer.
41663d5a0obrien#  2. Redistributions in binary form must reproduce the above copyright
42663d5a0obrien#     notice, this list of conditions and the following disclaimer in the
43663d5a0obrien#     documentation and/or other materials provided with the distribution.
44663d5a0obrien#  3. All advertising materials mentioning features or use of this software
45663d5a0obrien#     must display the following acknowledgement:
46663d5a0obrien#       This product includes software developed by the David Muir Sharnoff.
47663d5a0obrien#  4. The name of David Sharnoff may not be used to endorse or promote products
48663d5a0obrien#     derived from this software without specific prior written permission.
49663d5a0obrien#
50663d5a0obrien#  THIS SOFTWARE IS PROVIDED BY THE DAVID MUIR SHARNOFF ``AS IS'' AND
51663d5a0obrien#  ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
52663d5a0obrien#  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
53663d5a0obrien#  ARE DISCLAIMED.  IN NO EVENT SHALL DAVID MUIR SHARNOFF BE LIABLE
54663d5a0obrien#  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
55663d5a0obrien#  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
56663d5a0obrien#  OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
57663d5a0obrien#  HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
58663d5a0obrien#  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
59663d5a0obrien#  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
60663d5a0obrien#  SUCH DAMAGE.
61663d5a0obrien#
627d0df74mbr# This copyright notice derived from material copyrighted by the Regents
63663d5a0obrien# of the University of California.
64663d5a0obrien#
65663d5a0obrien# Contributions accepted.
66663d5a0obrien#
67663d5a0obrien#############################################################################
68663d5a0obrien
69663d5a0obrien# overall structure:
70663d5a0obrien#	in an effort to not trace each address individually, but rather
71663d5a0obrien#	ask each server in turn a whole bunch of questions, addresses to
72663d5a0obrien#	be expanded are queued up.
73663d5a0obrien#
74663d5a0obrien#	This means that all accounting w.r.t. an address must be stored in
75663d5a0obrien#	various arrays.  Generally these arrays are indexed by the
76663d5a0obrien#	string "$addr *** $server" where $addr is the address to be
77663d5a0obrien#	expanded "foo" or maybe "foo@bar" and $server is the hostname
78663d5a0obrien#	of the SMTP server to contact.
79663d5a0obrien#
80663d5a0obrien
81663d5a0obrien# important global variables:
82663d5a0obrien#
83663d5a0obrien# @hosts : list of servers still to be contacted
84663d5a0obrien# $server : name of the current we are currently looking at
85663d5a0obrien# @users = $users{@hosts[0]} : addresses to expand at this server
86663d5a0obrien# $u = $users[0] : the current address being expanded
87663d5a0obrien# $names{"$users[0] *** $server"} : the 'name' associated with the address
88663d5a0obrien# $mxbacktrace{"$users[0] *** $server"} : record of mx expansion
89663d5a0obrien# $mx_secondary{$server} : other mx relays at the same priority
90525520fobrien# $domainify_fallback{"$users[0] *** $server"} : alternative names to try
91663d5a0obrien#	instead of $server if $server doesn't work
92663d5a0obrien# $temporary_redirect{"$users[0] *** $server"} : when trying alternates,
93663d5a0obrien#	temporarily channel all tries along current path
94663d5a0obrien# $giveup{$server} : do not bother expanding addresses at $server
95663d5a0obrien# $verbose : -v
96663d5a0obrien# $watch : -w
97663d5a0obrien# $vw : -v or -w
98663d5a0obrien# $debug : -d
99663d5a0obrien# $valid : -a
100663d5a0obrien# $levels : -1
101663d5a0obrien# S : the socket connection to $server
102663d5a0obrien
103663d5a0obrien$have_nslookup = 1;	# we have the nslookup program
104663d5a0obrien$port = 'smtp';
105663d5a0obrien$av0 = $0;
106663d5a0obrien$ENV{'PATH'} .= ":/usr/etc" unless $ENV{'PATH'} =~ m,/usr/etc,;
107663d5a0obrien$ENV{'PATH'} .= ":/usr/ucb" unless $ENV{'PATH'} =~ m,/usr/ucb,;
108663d5a0obrienselect(STDERR);
109663d5a0obrien
110663d5a0obrien$0 = "$av0 - running hostname";
111663d5a0obrienchop($name = `hostname || uname -n`);
112663d5a0obrien
113663d5a0obrien$0 = "$av0 - lookup host FQDN and IP addr";
114663d5a0obrien($hostname,$aliases,$type,$len,$thisaddr) = gethostbyname($name);
115663d5a0obrien
116663d5a0obrien$0 = "$av0 - parsing args";
117ac3e3d4obrien$usage = "Usage: $av0 [-1avwd] user[\@host] [user2[\@host2] ...]";
118663d5a0obrienfor $a (@ARGV) {
119663d5a0obrien	die $usage if $a eq "-";
120663d5a0obrien	while ($a =~ s/^(-.*)([1avwd])/$1/) {
121663d5a0obrien		eval '$'."flag_$2 += 1";
122663d5a0obrien	}
123663d5a0obrien	next if $a eq "-";
124663d5a0obrien	die $usage if $a =~ /^-/;
125663d5a0obrien	&expn(&parse($a,$hostname,undef,1));
126663d5a0obrien}
127663d5a0obrien$verbose = $flag_v;
128663d5a0obrien$watch = $flag_w;
129663d5a0obrien$vw = $flag_v + $flag_w;
130663d5a0obrien$debug = $flag_d;
131663d5a0obrien$valid = $flag_a;
132663d5a0obrien$levels = $flag_1;
133663d5a0obrien
134663d5a0obriendie $usage unless @hosts;
135663d5a0obrienif ($valid) {
136663d5a0obrien	if ($valid == 1) {
137663d5a0obrien		$validRequirement = 0.8;
138663d5a0obrien	} elsif ($valid == 2) {
139663d5a0obrien		$validRequirement = 1.0;
140663d5a0obrien	} elsif ($valid == 3) {
141663d5a0obrien		$validRequirement = 0.9;
142663d5a0obrien	} else {
143663d5a0obrien		$validRequirement = (1 - (1/($valid-3)));
144663d5a0obrien		print "validRequirement = $validRequirement\n" if $debug;
145663d5a0obrien	}
146663d5a0obrien}
147663d5a0obrien
148663d5a0obrien$0 = "$av0 - building local socket";
149663d5a0obrien($name,$aliases,$proto) = getprotobyname('tcp');
150663d5a0obrien($name,$aliases,$port) = getservbyname($port,'tcp')
151663d5a0obrien	unless $port =~ /^\d+/;
152525520fobrien$this = sockaddr_in(0, $thisaddr);
153663d5a0obrien
154663d5a0obrienHOST:
155663d5a0obrienwhile (@hosts) {
156663d5a0obrien	$server = shift(@hosts);
157663d5a0obrien	@users = split(' ',$users{$server});
158663d5a0obrien	delete $users{$server};
159663d5a0obrien
160663d5a0obrien	# is this server already known to be bad?
161663d5a0obrien	$0 = "$av0 - looking up $server";
162663d5a0obrien	if ($giveup{$server}) {
163663d5a0obrien		&giveup('mx domainify',$giveup{$server});
164663d5a0obrien		next;
165663d5a0obrien	}
166663d5a0obrien
167663d5a0obrien	# do we already have an mx record for this host?
168663d5a0obrien	next HOST if &mxredirect($server,*users);
169663d5a0obrien
170663d5a0obrien	# look it up, or try for an mx.
171663d5a0obrien	$0 = "$av0 - gethostbyname($server)";
172663d5a0obrien
173663d5a0obrien	($name,$aliases,$type,$len,$thataddr) = gethostbyname($server);
174663d5a0obrien	# if we can't get an A record, try for an MX record.
175663d5a0obrien	unless($thataddr) {
176663d5a0obrien		&mxlookup(1,$server,"$server: could not resolve name",*users);
177663d5a0obrien		next HOST;
178663d5a0obrien	}
179525520fobrien
180663d5a0obrien	# get a connection, or look for an mx
181663d5a0obrien	$0 = "$av0 - socket to $server";
182525520fobrien	$that = sockaddr_in($port, $thataddr);
183663d5a0obrien	socket(S, &AF_INET, &SOCK_STREAM, $proto)
184663d5a0obrien		|| die "socket: $!";
185663d5a0obrien	$0 = "$av0 - bind to $server";
186525520fobrien	bind(S, $this)
187663d5a0obrien		|| die "bind $hostname,0: $!";
188663d5a0obrien	$0 = "$av0 - connect to $server";
189663d5a0obrien	print "debug = $debug server = $server\n" if $debug > 8;
190663d5a0obrien	if (! connect(S, $that) || ($debug == 10 && $server =~ /relay\d.UU.NET$/i)) {
191663d5a0obrien		$0 = "$av0 - $server: could not connect: $!\n";
192663d5a0obrien		$emsg = $!;
193663d5a0obrien		unless (&mxlookup(0,$server,"$server: could not connect: $!",*users)) {
194663d5a0obrien			&giveup('mx',"$server: Could not connect: $emsg");
195663d5a0obrien		}
196663d5a0obrien		next HOST;
197663d5a0obrien	}
198663d5a0obrien	select((select(S),$| = 1)[0]); # don't buffer output to S
199663d5a0obrien
200663d5a0obrien	# read the greeting
201663d5a0obrien	$0 = "$av0 - talking to $server";
202663d5a0obrien	&alarm("greeting with $server",'');
203663d5a0obrien	while(<S>) {
204663d5a0obrien		alarm(0);
205663d5a0obrien		print if $watch;
206663d5a0obrien		if (/^(\d+)([- ])/) {
207663d5a0obrien			if ($1 != 220) {
208663d5a0obrien				$0 = "$av0 - bad numeric response from $server";
209663d5a0obrien				&alarm("giving up after bad response from $server",'');
210663d5a0obrien				&read_response($2,$watch);
211663d5a0obrien				alarm(0);
212663d5a0obrien				print STDERR "$server: NOT 220 greeting: $_"
213663d5a0obrien					if ($debug || $vw);
214663d5a0obrien				if (&mxlookup(0,$server,"$server: did not respond with a 220 greeting",*users)) {
215663d5a0obrien					close(S);
216663d5a0obrien					next HOST;
217663d5a0obrien				}
218663d5a0obrien			}
219663d5a0obrien			last if ($2 eq " ");
220663d5a0obrien		} else {
221663d5a0obrien			$0 = "$av0 - bad response from $server";
222663d5a0obrien			print STDERR "$server: NOT 220 greeting: $_"
223663d5a0obrien				if ($debug || $vw);
224663d5a0obrien			unless (&mxlookup(0,$server,"$server: did not respond with SMTP codes",*users)) {
225663d5a0obrien				&giveup('',"$server: did not talk SMTP");
226663d5a0obrien			}
227663d5a0obrien			close(S);
228663d5a0obrien			next HOST;
229663d5a0obrien		}
230663d5a0obrien		&alarm("greeting with $server",'');
231663d5a0obrien	}
232663d5a0obrien	alarm(0);
233525520fobrien
234663d5a0obrien	# if this causes problems, remove it
235663d5a0obrien	$0 = "$av0 - sending helo to $server";
236663d5a0obrien	&alarm("sending helo to $server","");
237663d5a0obrien	&ps("helo $hostname");
238663d5a0obrien	while(<S>) {
239663d5a0obrien		print if $watch;
240663d5a0obrien		last if /^\d+ /;
241663d5a0obrien	}
242663d5a0obrien	alarm(0);
243663d5a0obrien
244663d5a0obrien	# try the users, one by one
245663d5a0obrien	USER:
246663d5a0obrien	while(@users) {
247663d5a0obrien		$u = shift(@users);
248663d5a0obrien		$0 = "$av0 - expanding $u [\@$server]";
249663d5a0obrien
250663d5a0obrien		# do we already have a name for this user?
251663d5a0obrien		$oldname = $names{"$u *** $server"};
252663d5a0obrien
253663d5a0obrien		print &compact($u,$server)." ->\n" if ($verbose && ! $valid);
254663d5a0obrien		if ($valid) {
255663d5a0obrien			#
256525520fobrien			# when running with -a, we delay taking any action
257663d5a0obrien			# on the results of our query until we have looked
258663d5a0obrien			# at the complete output.  @toFinal stores expansions
259663d5a0obrien			# that will be final if we take them.  @toExpn stores
2607d0df74mbr			# expansions that are not final.  @isValid keeps
261663d5a0obrien			# track of our ability to send mail to each of the
262663d5a0obrien			# expansions.
263663d5a0obrien			#
264663d5a0obrien			@isValid = ();
265663d5a0obrien			@toFinal = ();
266663d5a0obrien			@toExpn = ();
267663d5a0obrien		}
268663d5a0obrien
269663d5a0obrien#		($ecode,@expansion) = &expn_vrfy($u,$server);
270663d5a0obrien		(@foo) = &expn_vrfy($u,$server);
271663d5a0obrien		($ecode,@expansion) = @foo;
272663d5a0obrien		if ($ecode) {
273663d5a0obrien			&giveup('',$ecode,$u);
274663d5a0obrien			last USER;
275663d5a0obrien		}
276663d5a0obrien
277663d5a0obrien		for $s (@expansion) {
278663d5a0obrien			$s =~ s/[\n\r]//g;
279663d5a0obrien			$0 = "$av0 - parsing $server: $s";
280663d5a0obrien
281663d5a0obrien			$skipwatch = $watch;
282663d5a0obrien
283663d5a0obrien			if ($s =~ /^[25]51([- ]).*<(.+)>/) {
284663d5a0obrien				print "$s" if $watch;
285663d5a0obrien				print "(pretending 250$1<$2>)" if ($debug && $watch);
286663d5a0obrien				print "\n" if $watch;
287663d5a0obrien				$s = "250$1<$2>";
288663d5a0obrien				$skipwatch = 0;
289663d5a0obrien			}
290663d5a0obrien
291663d5a0obrien			if ($s =~ /^250([- ])(.+)/) {
292663d5a0obrien				print "$s\n" if $skipwatch;
293663d5a0obrien				($done,$addr) = ($1,$2);
294663d5a0obrien				($newhost, $newaddr, $newname) =  &parse($addr,$server,$oldname, $#expansion == 0);
295663d5a0obrien				print "($newhost, $newaddr, $newname) = &parse($addr, $server, $oldname)\n" if $debug;
296663d5a0obrien				if (! $newhost) {
297663d5a0obrien					# no expansion is possible w/o a new server to call
298663d5a0obrien					if ($valid) {
299663d5a0obrien						push(@isValid, &validAddr($newaddr));
300663d5a0obrien						push(@toFinal,$newaddr,$server,$newname);
301663d5a0obrien					} else {
302663d5a0obrien						&verbose(&final($newaddr,$server,$newname));
303663d5a0obrien					}
304663d5a0obrien				} else {
305663d5a0obrien					$newmxhost = &mx($newhost,$newaddr);
306525520fobrien					print "$newmxhost = &mx($newhost)\n"
307663d5a0obrien						if ($debug && $newhost ne $newmxhost);
308663d5a0obrien					$0 = "$av0 - parsing $newaddr [@$newmxhost]";
309663d5a0obrien					print "levels = $levels, level{$u *** $server} = ".$level{"$u *** $server"}."\n" if ($debug > 1);
310525520fobrien					# If the new server is the current one,
311663d5a0obrien					# it would have expanded things for us
312663d5a0obrien					# if it could have.  Mx records must be
313663d5a0obrien					# followed to compare server names.
314663d5a0obrien					# We are also done if the recursion
315663d5a0obrien					# count has been exceeded.
316663d5a0obrien					if (&trhost($newmxhost) eq &trhost($server) || ($levels && $level{"$u *** $server"} >= $levels)) {
317663d5a0obrien						if ($valid) {
318663d5a0obrien							push(@isValid, &validAddr($newaddr));
319663d5a0obrien							push(@toFinal,$newaddr,$newmxhost,$newname);
320663d5a0obrien						} else {
321663d5a0obrien							&verbose(&final($newaddr,$newmxhost,$newname));
322663d5a0obrien						}
323663d5a0obrien					} else {
324663d5a0obrien						# more work to do...
325663d5a0obrien						if ($valid) {
326663d5a0obrien							push(@isValid, &validAddr($newaddr));
327663d5a0obrien							push(@toExpn,$newmxhost,$newaddr,$newname,$level{"$u *** $server"});
328663d5a0obrien						} else {
329663d5a0obrien							&verbose(&expn($newmxhost,$newaddr,$newname,$level{"$u *** $server"}));
330663d5a0obrien						}
331663d5a0obrien					}
332663d5a0obrien				}
333663d5a0obrien				last if ($done eq " ");
334663d5a0obrien				next;
335663d5a0obrien			}
336663d5a0obrien			# 550 is a known code...  Should the be
337663d5a0obrien			# included in -a output?  Might be a bug
338663d5a0obrien			# here.  Does it matter?  Can assume that
339525520fobrien			# there won't be UNKNOWN USER responses
340663d5a0obrien			# mixed with valid users?
341663d5a0obrien			if ($s =~ /^(550)([- ])/) {
342663d5a0obrien				if ($valid) {
343663d5a0obrien					print STDERR "\@$server:$u ($oldname) USER UNKNOWN\n";
344663d5a0obrien				} else {
345663d5a0obrien					&verbose(&final($u,$server,$oldname,"USER UNKNOWN"));
346663d5a0obrien				}
347663d5a0obrien				last if ($2 eq " ");
348663d5a0obrien				next;
349525520fobrien			}
350525520fobrien			# 553 is a known code...
351663d5a0obrien			if ($s =~ /^(553)([- ])/) {
352663d5a0obrien				if ($valid) {
353663d5a0obrien					print STDERR "\@$server:$u ($oldname) USER AMBIGUOUS\n";
354663d5a0obrien				} else {
355663d5a0obrien					&verbose(&final($u,$server,$oldname,"USER AMBIGUOUS"));
356663d5a0obrien				}
357663d5a0obrien				last if ($2 eq " ");
358663d5a0obrien				next;
359525520fobrien			}
360525520fobrien			# 252 is a known code...
361663d5a0obrien			if ($s =~ /^(252)([- ])/) {
362663d5a0obrien				if ($valid) {
363663d5a0obrien					print STDERR "\@$server:$u ($oldname) REFUSED TO VRFY\n";
364663d5a0obrien				} else {
365663d5a0obrien					&verbose(&final($u,$server,$oldname,"REFUSED TO VRFY"));
366663d5a0obrien				}
367663d5a0obrien				last if ($2 eq " ");
368663d5a0obrien				next;
369525520fobrien			}
370663d5a0obrien			&giveup('',"$server: did not grok '$s'",$u);
371663d5a0obrien			last USER;
372663d5a0obrien		}
373663d5a0obrien
374663d5a0obrien		if ($valid) {
375663d5a0obrien			#
376663d5a0obrien			# now we decide if we are going to take these
377663d5a0obrien			# expansions or roll them back.
378663d5a0obrien			#
379663d5a0obrien			$avgValid = &average(@isValid);
380663d5a0obrien			print "avgValid = $avgValid\n" if $debug;
381663d5a0obrien			if ($avgValid >= $validRequirement) {
382663d5a0obrien				print &compact($u,$server)." ->\n" if $verbose;
383663d5a0obrien				while (@toExpn) {
384663d5a0obrien					&verbose(&expn(splice(@toExpn,0,4)));
385663d5a0obrien				}
386663d5a0obrien				while (@toFinal) {
387663d5a0obrien					&verbose(&final(splice(@toFinal,0,3)));
388663d5a0obrien				}
389663d5a0obrien			} else {
390663d5a0obrien				print "Tossing some valid to avoid invalid ".&compact($u,$server)."\n" if ($avgValid > 0.0 && ($vw || $debug));
391663d5a0obrien				print &compact($u,$server)." ->\n" if $verbose;
392663d5a0obrien				&verbose(&final($u,$server,$newname));
393663d5a0obrien			}
394663d5a0obrien		}
395663d5a0obrien	}
396663d5a0obrien
397663d5a0obrien	&alarm("sending 'quit' to $server",'');
398663d5a0obrien	$0 = "$av0 - sending 'quit' to $server";
399663d5a0obrien	&ps("quit");
400663d5a0obrien	while(<S>) {
401663d5a0obrien		print if $watch;
402663d5a0obrien		last if /^\d+ /;
403663d5a0obrien	}
404663d5a0obrien	close(S);
405663d5a0obrien	alarm(0);
406663d5a0obrien}
407663d5a0obrien
408663d5a0obrien$0 = "$av0 - printing final results";
409663d5a0obrienprint "----------\n" if $vw;
410663d5a0obrienselect(STDOUT);
411663d5a0obrienfor $f (sort @final) {
412663d5a0obrien	print "$f\n";
413663d5a0obrien}
414663d5a0obrienunlink("/tmp/expn$$");
415663d5a0obrienexit(0);
416663d5a0obrien
417663d5a0obrien
418663d5a0obrien# abandon all attempts deliver to $server
419663d5a0obrien# register the current addresses as the final ones
420663d5a0obriensub giveup
421663d5a0obrien{
422663d5a0obrien	local($redirect_okay,$reason,$user) = @_;
423663d5a0obrien	local($us,@so,$nh,@remaining_users);
424663d5a0obrien	local($pk,$file,$line);
425663d5a0obrien	($pk, $file, $line) = caller;
426663d5a0obrien
427663d5a0obrien	$0 = "$av0 - giving up on $server: $reason";
428663d5a0obrien	#
429663d5a0obrien	# add back a user if we gave up in the middle
430663d5a0obrien	#
431663d5a0obrien	push(@users,$user) if $user;
432663d5a0obrien	#
433663d5a0obrien	# don't bother with this system anymore
434663d5a0obrien	#
435663d5a0obrien	unless ($giveup{$server}) {
436663d5a0obrien		$giveup{$server} = $reason;
437663d5a0obrien		print STDERR "$reason\n";
438663d5a0obrien	}
439663d5a0obrien	print "Giveup at $file:$line!!! redirect okay = $redirect_okay; $reason\n" if $debug;
440663d5a0obrien	#
441663d5a0obrien	# Wait!
442663d5a0obrien	# Before giving up, see if there is a chance that
443663d5a0obrien	# there is another host to redirect to!
444663d5a0obrien	# (Kids, don't do this at home!  Hacking is a dangerous
445663d5a0obrien	# crime and you could end up behind bars.)
446663d5a0obrien	#
447663d5a0obrien	for $u (@users) {
448663d5a0obrien		if ($redirect_okay =~ /\bmx\b/) {
449663d5a0obrien			next if &try_fallback('mx',$u,*server,
450663d5a0obrien				*mx_secondary,
451663d5a0obrien				*already_mx_fellback);
452663d5a0obrien		}
453663d5a0obrien		if ($redirect_okay =~ /\bdomainify\b/) {
454663d5a0obrien			next if &try_fallback('domainify',$u,*server,
455663d5a0obrien				*domainify_fallback,
456663d5a0obrien				*already_domainify_fellback);
457663d5a0obrien		}
458663d5a0obrien		push(@remaining_users,$u);
459663d5a0obrien	}
460663d5a0obrien	@users = @remaining_users;
461663d5a0obrien	for $u (@users) {
462663d5a0obrien		print &compact($u,$server)." ->\n" if ($verbose && $valid && $u);
463663d5a0obrien		&verbose(&final($u,$server,$names{"$u *** $server"},$reason));
464663d5a0obrien	}
465663d5a0obrien}
466663d5a0obrien#
467663d5a0obrien# This routine is used only within &giveup.  It checks to
468663d5a0obrien# see if we really have to giveup or if there is a second
469525520fobrien# chance because we did something before that can be
470663d5a0obrien# backtracked.
471663d5a0obrien#
472663d5a0obrien# %fallback{"$user *** $host"} tracks what is able to fallback
473663d5a0obrien# %fellback{"$user *** $host"} tracks what has fallen back
474663d5a0obrien#
475663d5a0obrien# If there is a valid backtrack, then queue up the new possibility
476663d5a0obrien#
477663d5a0obriensub try_fallback
478663d5a0obrien{
479663d5a0obrien	local($method,$user,*host,*fall_table,*fellback) = @_;
480663d5a0obrien	local($us,$fallhost,$oldhost,$ft,$i);
481663d5a0obrien
482663d5a0obrien	if ($debug > 8) {
483663d5a0obrien		print "Fallback table $method:\n";
484663d5a0obrien		for $i (sort keys %fall_table) {
485663d5a0obrien			print "\t'$i'\t\t'$fall_table{$i}'\n";
486663d5a0obrien		}
487663d5a0obrien		print "Fellback table $method:\n";
488663d5a0obrien		for $i (sort keys %fellback) {
489663d5a0obrien			print "\t'$i'\t\t'$fellback{$i}'\n";
490663d5a0obrien		}
491663d5a0obrien		print "U: $user H: $host\n";
492663d5a0obrien	}
493525520fobrien
494663d5a0obrien	$us = "$user *** $host";
495663d5a0obrien	if (defined $fellback{$us}) {
496663d5a0obrien		#
497663d5a0obrien		# Undo a previous fallback so that we can try again
498663d5a0obrien		# Nested fallbacks are avoided because they could
499663d5a0obrien		# lead to infinite loops
500663d5a0obrien		#
501663d5a0obrien		$fallhost = $fellback{$us};
502663d5a0obrien		print "Already $method fell back from $us -> \n" if $debug;
503663d5a0obrien		$us = "$user *** $fallhost";
504663d5a0obrien		$oldhost = $fallhost;
505663d5a0obrien	} elsif (($method eq 'mx') && (defined $mxbacktrace{$us}) && (defined $mx_secondary{$mxbacktrace{$us}})) {
506663d5a0obrien		print "Fallback an MX expansion $us -> \n" if $debug;
507663d5a0obrien		$oldhost = $mxbacktrace{$us};
508663d5a0obrien	} else {
509663d5a0obrien		print "Oldhost($host, $us) = " if $debug;
510663d5a0obrien		$oldhost = $host;
511663d5a0obrien	}
512663d5a0obrien	print "$oldhost\n" if $debug;
513663d5a0obrien	if (((defined $fall_table{$us}) && ($ft = $us)) || ((defined $fall_table{$oldhost}) && ($ft = $oldhost))) {
514663d5a0obrien		print "$method Fallback = ".$fall_table{$ft}."\n" if $debug;
515663d5a0obrien		local(@so,$newhost);
516663d5a0obrien		@so = split(' ',$fall_table{$ft});
517663d5a0obrien		$newhost = shift(@so);
518663d5a0obrien		print "Falling back ($method) $us -> $newhost (from $oldhost)\n" if $debug;
519663d5a0obrien		if ($method eq 'mx') {
520663d5a0obrien			if (! defined ($mxbacktrace{"$user *** $newhost"})) {
521663d5a0obrien				if (defined $mxbacktrace{"$user *** $oldhost"}) {
522663d5a0obrien					print "resetting oldhost $oldhost to the original: " if $debug;
523663d5a0obrien					$oldhost = $mxbacktrace{"$user *** $oldhost"};
524663d5a0obrien					print "$oldhost\n" if $debug;
525663d5a0obrien				}
526663d5a0obrien				$mxbacktrace{"$user *** $newhost"} = $oldhost;
527663d5a0obrien				print "mxbacktrace $user *** $newhost -> $oldhost\n" if $debug;
528663d5a0obrien			}
529663d5a0obrien			$mx{&trhost($oldhost)} = $newhost;
530663d5a0obrien		} else {
531663d5a0obrien			$temporary_redirect{$us} = $newhost;
532663d5a0obrien		}
533663d5a0obrien		if (@so) {
534663d5a0obrien			print "Can still $method  $us: @so\n" if $debug;
535663d5a0obrien			$fall_table{$ft} = join(' ',@so);
536663d5a0obrien		} else {
537663d5a0obrien			print "No more fallbacks for $us\n" if $debug;
538663d5a0obrien			delete $fall_table{$ft};
539663d5a0obrien		}
540663d5a0obrien		if (defined $create_host_backtrack{$us}) {
541525520fobrien			$create_host_backtrack{"$user *** $newhost"}
542663d5a0obrien				= $create_host_backtrack{$us};
543663d5a0obrien		}
544663d5a0obrien		$fellback{"$user *** $newhost"} = $oldhost;
545663d5a0obrien		&expn($newhost,$user,$names{$us},$level{$us});
546663d5a0obrien		return 1;
547663d5a0obrien	}
548663d5a0obrien	delete $temporary_redirect{$us};
549663d5a0obrien	$host = $oldhost;
550663d5a0obrien	return 0;
551663d5a0obrien}
552663d5a0obrien# return 1 if you could send mail to the address as is.
553663d5a0obriensub validAddr
554663d5a0obrien{
555663d5a0obrien	local($addr) = @_;
556663d5a0obrien	$res = &do_validAddr($addr);
557663d5a0obrien	print "validAddr($addr) = $res\n" if $debug;
558663d5a0obrien	$res;
559663d5a0obrien}
560663d5a0obriensub do_validAddr
561663d5a0obrien{
562663d5a0obrien	local($addr) = @_;
563663d5a0obrien	local($urx) = "[-A-Za-z_.0-9+]+";
564663d5a0obrien
565663d5a0obrien	# \u
566663d5a0obrien	return 0 if ($addr =~ /^\\/);
567663d5a0obrien	# ?@h
568663d5a0obrien	return 1 if ($addr =~ /.\@$urx$/);
569663d5a0obrien	# @h:?
570663d5a0obrien	return 1 if ($addr =~ /^\@$urx\:./);
571663d5a0obrien	# h!u
572663d5a0obrien	return 1 if ($addr =~ /^$urx!./);
573663d5a0obrien	# u
574663d5a0obrien	return 1 if ($addr =~ /^$urx$/);
575663d5a0obrien	# ?
576663d5a0obrien	print "validAddr($addr) = ???\n" if $debug;
577663d5a0obrien	return 0;
578663d5a0obrien}
579663d5a0obrien# Some systems use expn and vrfy interchangeably.  Some only
580663d5a0obrien# implement one or the other.  Some check expn against mailing
581663d5a0obrien# lists and vrfy against users.  It doesn't appear to be
582663d5a0obrien# consistent.
583663d5a0obrien#
584663d5a0obrien# So, what do we do?  We try everything!
585663d5a0obrien#
586663d5a0obrien#
587663d5a0obrien# Ranking of result codes: good: 250, 251/551, 252, 550, anything else
588663d5a0obrien#
589663d5a0obrien# Ranking of inputs: best: user@host.domain, okay: user
590663d5a0obrien#
591663d5a0obrien# Return value: $error_string, @responses_from_server
592663d5a0obriensub expn_vrfy
593663d5a0obrien{
594663d5a0obrien	local($u,$server) = @_;
595663d5a0obrien	local(@c) = ('expn', 'vrfy');
596663d5a0obrien	local(@try_u) = $u;
597663d5a0obrien	local(@ret,$code);
598663d5a0obrien
599663d5a0obrien	if (($u =~ /(.+)@(.+)/) && (&trhost($2) eq &trhost($server))) {
600663d5a0obrien		push(@try_u,$1);
601663d5a0obrien	}
602663d5a0obrien
603663d5a0obrien	TRY:
604663d5a0obrien	for $c (@c) {
605663d5a0obrien		for $try_u (@try_u) {
606663d5a0obrien			&alarm("${c}'ing $try_u on $server",'',$u);
607663d5a0obrien			&ps("$c $try_u");
608663d5a0obrien			alarm(0);
609663d5a0obrien			$s = <S>;
610663d5a0obrien			if ($s eq '') {
611663d5a0obrien				return "$server: lost connection";
612663d5a0obrien			}
613663d5a0obrien			if ($s !~ /^(\d+)([- ])/) {
614663d5a0obrien				return "$server: garbled reply to '$c $try_u'";
615663d5a0obrien			}
616663d5a0obrien			if ($1 == 250) {
617663d5a0obrien				$code = 250;
618663d5a0obrien				@ret = ("",$s);
619663d5a0obrien				push(@ret,&read_response($2,$debug));
620663d5a0obrien				return (@ret);
621525520fobrien			}
622663d5a0obrien			if ($1 == 551 || $1 == 251) {
623663d5a0obrien				$code = $1;
624663d5a0obrien				@ret = ("",$s);
625663d5a0obrien				push(@ret,&read_response($2,$debug));
626663d5a0obrien				next;
627663d5a0obrien			}
628663d5a0obrien			if ($1 == 252 && ($code == 0 || $code == 550)) {
629663d5a0obrien				$code = 252;
630663d5a0obrien				@ret = ("",$s);
631663d5a0obrien				push(@ret,&read_response($2,$watch));
632663d5a0obrien				next;
633663d5a0obrien			}
634663d5a0obrien			if ($1 == 550 && $code == 0) {
635663d5a0obrien				$code = 550;
636663d5a0obrien				@ret = ("",$s);
637663d5a0obrien				push(@ret,&read_response($2,$watch));
638663d5a0obrien				next;
639663d5a0obrien			}
640663d5a0obrien			&read_response($2,$watch);
641663d5a0obrien		}
642663d5a0obrien	}
643663d5a0obrien	return "$server: expn/vrfy not implemented" unless @ret;
644663d5a0obrien	return @ret;
645663d5a0obrien}
646663d5a0obrien# sometimes the old parse routine (now parse2) didn't
647525520fobrien# reject funky addresses.
648663d5a0obriensub parse
649663d5a0obrien{
650663d5a0obrien	local($oldaddr,$server,$oldname,$one_to_one) = @_;
651663d5a0obrien	local($newhost, $newaddr, $newname, $um) =  &parse2($oldaddr,$server,$oldname,$one_to_one);
652663d5a0obrien	if ($newaddr =~ m,^["/],) {
653663d5a0obrien		return (undef, $oldaddr, $newname) if $valid;
654663d5a0obrien		return (undef, $um, $newname);
655663d5a0obrien	}
656663d5a0obrien	return ($newhost, $newaddr, $newname);
657663d5a0obrien}
658663d5a0obrien
659663d5a0obrien# returns ($new_smtp_server,$new_address,$new_name)
660525520fobrien# given a response from a SMTP server ($newaddr), the
661663d5a0obrien# current host ($server), the old "name" and a flag that
662525520fobrien# indicates if it is being called during the initial
663663d5a0obrien# command line parsing ($parsing_args)
664663d5a0obriensub parse2
665663d5a0obrien{
666663d5a0obrien	local($newaddr,$context_host,$old_name,$parsing_args) = @_;
667663d5a0obrien	local(@names) = $old_name;
668663d5a0obrien	local($urx) = "[-A-Za-z_.0-9+]+";
669663d5a0obrien	local($unmangle);
670663d5a0obrien
671663d5a0obrien	#
672663d5a0obrien	# first, separate out the address part.
673663d5a0obrien	#
674663d5a0obrien
675663d5a0obrien	#
676663d5a0obrien	# [NAME] <ADDR [(NAME)]>
677663d5a0obrien	# [NAME] <[(NAME)] ADDR
678663d5a0obrien	# ADDR [(NAME)]
679663d5a0obrien	# (NAME) ADDR
680663d5a0obrien	# [(NAME)] <ADDR>
681663d5a0obrien	#
682663d5a0obrien	if ($newaddr =~ /^\<(.*)\>$/) {
683663d5a0obrien		print "<A:$1>\n" if $debug;
684663d5a0obrien		($newaddr) = &trim($1);
685663d5a0obrien		print "na = $newaddr\n" if $debug;
686663d5a0obrien	}
687663d5a0obrien	if ($newaddr =~ /^([^\<\>]*)\<([^\<\>]*)\>([^\<\>]*)$/) {
688663d5a0obrien		# address has a < > pair in it.
689663d5a0obrien		print "N:$1 <A:$2> N:$3\n" if $debug;
690663d5a0obrien		($newaddr) = &trim($2);
691663d5a0obrien		unshift(@names, &trim($3,$1));
692663d5a0obrien		print "na = $newaddr\n" if $debug;
693663d5a0obrien	}
694663d5a0obrien	if ($newaddr =~ /^([^\(\)]*)\(([^\(\)]*)\)([^\(\)]*)$/) {
695663d5a0obrien		# address has a ( ) pair in it.
696663d5a0obrien		print "A:$1 (N:$2) A:$3\n" if $debug;
697663d5a0obrien		unshift(@names,&trim($2));
698663d5a0obrien		local($f,$l) = (&trim($1),&trim($3));
699663d5a0obrien		if (($f && $l) || !($f || $l)) {
700663d5a0obrien			# address looks like:
701663d5a0obrien			# foo (bar) baz  or (bar)
702663d5a0obrien			# not allowed!
703663d5a0obrien			print STDERR "Could not parse $newaddr\n" if $vw;
704663d5a0obrien			return(undef,$newaddr,&firstname(@names));
705663d5a0obrien		}
706663d5a0obrien		$newaddr = $f if $f;
707663d5a0obrien		$newaddr = $l if $l;
708663d5a0obrien		print "newaddr now = $newaddr\n" if $debug;
709663d5a0obrien	}
710663d5a0obrien	#
711663d5a0obrien	# @foo:bar
712663d5a0obrien	# j%k@l
713663d5a0obrien	# a@b
714663d5a0obrien	# b!a
715663d5a0obrien	# a
716663d5a0obrien	#
717663d5a0obrien	$unmangle = $newaddr;
718663d5a0obrien	if ($newaddr =~ /^\@($urx)\:(.+)$/) {
719663d5a0obrien		print "(\@:)" if $debug;
720663d5a0obrien		# this is a bit of a cheat, but it seems necessary
721663d5a0obrien		return (&domainify($1,$context_host,$2),$2,&firstname(@names),$unmangle);
722663d5a0obrien	}
723663d5a0obrien	if ($newaddr =~ /^(.+)\@($urx)$/) {
724663d5a0obrien		print "(\@)" if $debug;
725663d5a0obrien		return (&domainify($2,$context_host,$newaddr),$newaddr,&firstname(@names),$unmangle);
726663d5a0obrien	}
727663d5a0obrien	if ($parsing_args) {
728663d5a0obrien		if ($newaddr =~ /^($urx)\!(.+)$/) {
729663d5a0obrien			return (&domainify($1,$context_host,$newaddr),$newaddr,&firstname(@names),$unmangle);
730663d5a0obrien		}
731663d5a0obrien		if ($newaddr =~ /^($urx)$/) {
732663d5a0obrien			return ($context_host,$newaddr,&firstname(@names),$unmangle);
733663d5a0obrien		}
734663d5a0obrien		print STDERR "Could not parse $newaddr\n";
735663d5a0obrien	}
736663d5a0obrien	print "(?)" if $debug;
737663d5a0obrien	return(undef,$newaddr,&firstname(@names),$unmangle);
738663d5a0obrien}
739663d5a0obrien# return $u (@$server) unless $u includes reference to $server
740663d5a0obriensub compact
741663d5a0obrien{
742663d5a0obrien	local($u, $server) = @_;
743663d5a0obrien	local($se) = $server;
744663d5a0obrien	local($sp);
745663d5a0obrien	$se =~ s/(\W)/\\$1/g;
746663d5a0obrien	$sp = " (\@$server)";
747663d5a0obrien	if ($u !~ /$se/i) {
748663d5a0obrien		return "$u$sp";
749663d5a0obrien	}
750663d5a0obrien	return $u;
751663d5a0obrien}
752663d5a0obrien# remove empty (spaces don't count) members from an array
753663d5a0obriensub trim
754663d5a0obrien{
755663d5a0obrien	local(@v) = @_;
756663d5a0obrien	local($v,@r);
757663d5a0obrien	for $v (@v) {
758663d5a0obrien		$v =~ s/^\s+//;
759663d5a0obrien		$v =~ s/\s+$//;
760663d5a0obrien		push(@r,$v) if ($v =~ /\S/);
761663d5a0obrien	}
762663d5a0obrien	return(@r);
763663d5a0obrien}
764663d5a0obrien# using the host part of an address, and the server name, add the
765525520fobrien# servers' domain to the address if it doesn't already have a
766663d5a0obrien# domain.  Since this sometimes fails, save a back reference so
767663d5a0obrien# it can be unrolled.
768663d5a0obriensub domainify
769663d5a0obrien{
770663d5a0obrien	local($host,$domain_host,$u) = @_;
771663d5a0obrien	local($domain,$newhost);
772663d5a0obrien
773525520fobrien	# cut of trailing dots
774663d5a0obrien	$host =~ s/\.$//;
775663d5a0obrien	$domain_host =~ s/\.$//;
776663d5a0obrien
777663d5a0obrien	if ($domain_host !~ /\./) {
778663d5a0obrien		#
779663d5a0obrien		# domain host isn't, keep $host whatever it is
780663d5a0obrien		#
781663d5a0obrien		print "domainify($host,$domain_host) = $host\n" if $debug;
782663d5a0obrien		return $host;
783663d5a0obrien	}
784663d5a0obrien
785525520fobrien	#
7867d0df74mbr	# There are several weird situations that need to be
787663d5a0obrien	# accounted for.  They have to do with domain relay hosts.
788663d5a0obrien	#
789525520fobrien	# Examples:
790663d5a0obrien	#	host		server		"right answer"
791525520fobrien	#
792663d5a0obrien	#	shiva.cs	cs.berkeley.edu	shiva.cs.berkeley.edu
793663d5a0obrien	#	shiva		cs.berkeley.edu	shiva.cs.berekley.edu
794663d5a0obrien	#	cumulus		reed.edu	@reed.edu:cumulus.uucp
795663d5a0obrien	# 	tiberius	tc.cornell.edu	tiberius.tc.cornell.edu
796663d5a0obrien	#
797525520fobrien	# The first try must always be to cut the domain part out of
798663d5a0obrien	# the server and tack it onto the host.
799663d5a0obrien	#
800663d5a0obrien	# A reasonable second try is to tack the whole server part onto
801525520fobrien	# the host and for each possible repeated element, eliminate
802663d5a0obrien	# just that part.
803663d5a0obrien	#
804663d5a0obrien	# These extra "guesses" get put into the %domainify_fallback
805663d5a0obrien	# array.  They will be used to give addresses a second chance
806663d5a0obrien	# in the &giveup routine
807663d5a0obrien	#
808663d5a0obrien
809663d5a0obrien	local(%fallback);
810663d5a0obrien
811525520fobrien	local($long);
812663d5a0obrien	$long = "$host $domain_host";
813663d5a0obrien	$long =~ tr/A-Z/a-z/;
814663d5a0obrien	print "long = $long\n" if $debug;
815663d5a0obrien	if ($long =~ s/^([^ ]+\.)([^ ]+) \2(\.[^ ]+\.[^ ]+)/$1$2$3/) {
816663d5a0obrien		# matches shiva.cs cs.berkeley.edu and returns shiva.cs.berkeley.edu
817663d5a0obrien		print "condensed fallback $host $domain_host -> $long\n" if $debug;
818663d5a0obrien		$fallback{$long} = 9;
819663d5a0obrien	}
820663d5a0obrien
821663d5a0obrien	local($fh);
822663d5a0obrien	$fh = $domain_host;
823663d5a0obrien	while ($fh =~ /\./) {
824663d5a0obrien		print "FALLBACK $host.$fh = 1\n" if $debug > 7;
825663d5a0obrien		$fallback{"$host.$fh"} = 1;
826663d5a0obrien		$fh =~ s/^[^\.]+\.//;
827663d5a0obrien	}
828663d5a0obrien
829663d5a0obrien	$fallback{"$host.$domain_host"} = 2;
830663d5a0obrien
831663d5a0obrien	($domain = $domain_host) =~ s/^[^\.]+//;
832663d5a0obrien	$fallback{"$host$domain"} = 6
833663d5a0obrien		if ($domain =~ /\./);
834663d5a0obrien
835663d5a0obrien	if ($host =~ /\./) {
836663d5a0obrien		#
837663d5a0obrien		# Host is already okay, but let's look for multiple
838663d5a0obrien		# interpretations
839663d5a0obrien		#
840663d5a0obrien		print "domainify($host,$domain_host) = $host\n" if $debug;
841663d5a0obrien		delete $fallback{$host};
842663d5a0obrien		$domainify_fallback{"$u *** $host"} = join(' ',sort {$fallback{$b} <=> $fallback{$a};} keys %fallback) if %fallback;
843663d5a0obrien		return $host;
844663d5a0obrien	}
845663d5a0obrien
846663d5a0obrien	$domain = ".$domain_host"
847663d5a0obrien		if ($domain !~ /\..*\./);
848663d5a0obrien	$newhost = "$host$domain";
849663d5a0obrien
850663d5a0obrien	$create_host_backtrack{"$u *** $newhost"} = $domain_host;
851663d5a0obrien	print "domainify($host,$domain_host) = $newhost\n" if $debug;
852663d5a0obrien	delete $fallback{$newhost};
853663d5a0obrien	$domainify_fallback{"$u *** $newhost"} = join(' ',sort {$fallback{$b} <=> $fallback{$a};} keys %fallback) if %fallback;
854663d5a0obrien	if ($debug) {
855663d5a0obrien		print "fallback = ";
856525520fobrien		print $domainify_fallback{"$u *** $newhost"}
857663d5a0obrien			if defined($domainify_fallback{"$u *** $newhost"});
858663d5a0obrien		print "\n";
859663d5a0obrien	}
860663d5a0obrien	return $newhost;
861663d5a0obrien}
862663d5a0obrien# return the first non-empty element of an array
863663d5a0obriensub firstname
864663d5a0obrien{
865663d5a0obrien	local(@names) = @_;
866663d5a0obrien	local($n);
867663d5a0obrien	while(@names) {
868663d5a0obrien		$n = shift(@names);
869663d5a0obrien		return $n if $n =~ /\S/;
870663d5a0obrien	}
871663d5a0obrien	return undef;
872663d5a0obrien}
873663d5a0obrien# queue up more addresses to expand
874663d5a0obriensub expn
875663d5a0obrien{
876663d5a0obrien	local($host,$addr,$name,$level) = @_;
877663d5a0obrien	if ($host) {
878663d5a0obrien		$host = &trhost($host);
879663d5a0obrien
880663d5a0obrien		if (($debug > 3) || (defined $giveup{$host})) {
881663d5a0obrien			unshift(@hosts,$host) unless $users{$host};
882663d5a0obrien		} else {
883663d5a0obrien			push(@hosts,$host) unless $users{$host};
884663d5a0obrien		}
885663d5a0obrien		$users{$host} .= " $addr";
886663d5a0obrien		$names{"$addr *** $host"} = $name;
887663d5a0obrien		$level{"$addr *** $host"} = $level + 1;
888663d5a0obrien		print "expn($host,$addr,$name)\n" if $debug;
889663d5a0obrien		return "\t$addr\n";
890663d5a0obrien	} else {
891663d5a0obrien		return &final($addr,'NONE',$name);
892663d5a0obrien	}
893663d5a0obrien}
894663d5a0obrien# compute the numerical average value of an array
895663d5a0obriensub average
896663d5a0obrien{
897663d5a0obrien	local(@e) = @_;
898663d5a0obrien	return 0 unless @e;
899663d5a0obrien	local($e,$sum);
900663d5a0obrien	for $e (@e) {
901663d5a0obrien		$sum += $e;
902663d5a0obrien	}
903663d5a0obrien	$sum / @e;
904663d5a0obrien}
905663d5a0obrien# print to the server (also to stdout, if -w)
906663d5a0obriensub ps
907663d5a0obrien{
908663d5a0obrien	local($p) = @_;
909663d5a0obrien	print ">>> $p\n" if $watch;
910663d5a0obrien	print S "$p\n";
911663d5a0obrien}
912663d5a0obrien# return case-adjusted name for a host (for comparison purposes)
913525520fobriensub trhost
914663d5a0obrien{
915663d5a0obrien	# treat foo.bar as an alias for Foo.BAR
916663d5a0obrien	local($host) = @_;
917663d5a0obrien	local($trhost) = $host;
918663d5a0obrien	$trhost =~ tr/A-Z/a-z/;
919663d5a0obrien	if ($trhost{$trhost}) {
920663d5a0obrien		$host = $trhost{$trhost};
921663d5a0obrien	} else {
922663d5a0obrien		$trhost{$trhost} = $host;
923663d5a0obrien	}
924663d5a0obrien	$trhost{$trhost};
925663d5a0obrien}
926663d5a0obrien# re-queue users if an mx record dictates a redirect
927663d5a0obrien# don't allow a user to be redirected more than once
928663d5a0obriensub mxredirect
929663d5a0obrien{
930663d5a0obrien	local($server,*users) = @_;
931663d5a0obrien	local($u,$nserver,@still_there);
932663d5a0obrien
933663d5a0obrien	$nserver = &mx($server);
934663d5a0obrien
935663d5a0obrien	if (&trhost($nserver) ne &trhost($server)) {
936663d5a0obrien		$0 = "$av0 - mx redirect $server -> $nserver\n";
937663d5a0obrien		for $u (@users) {
938663d5a0obrien			if (defined $mxbacktrace{"$u *** $nserver"}) {
939663d5a0obrien				push(@still_there,$u);
940663d5a0obrien			} else {
941663d5a0obrien				$mxbacktrace{"$u *** $nserver"} = $server;
942663d5a0obrien				print "mxbacktrace{$u *** $nserver} = $server\n"
943663d5a0obrien					if ($debug > 1);
944663d5a0obrien				&expn($nserver,$u,$names{"$u *** $server"});
945663d5a0obrien			}
946663d5a0obrien		}
947663d5a0obrien		@users = @still_there;
948663d5a0obrien		if (! @users) {
949663d5a0obrien			return $nserver;
950663d5a0obrien		} else {
951663d5a0obrien			return undef;
952663d5a0obrien		}
953663d5a0obrien	}
954663d5a0obrien	return undef;
955663d5a0obrien}
956663d5a0obrien# follow mx records, return a hostname
9577d0df74mbr# also follow temporary redirections coming from &domainify and
958663d5a0obrien# &mxlookup
959663d5a0obriensub mx
960663d5a0obrien{
961663d5a0obrien	local($h,$u) = @_;
962663d5a0obrien
963663d5a0obrien	for (;;) {
964663d5a0obrien		if (defined $mx{&trhost($h)} && $h ne $mx{&trhost($h)}) {
965663d5a0obrien			$0 = "$av0 - mx expand $h";
966663d5a0obrien			$h = $mx{&trhost($h)};
967663d5a0obrien			return $h;
968663d5a0obrien		}
969663d5a0obrien		if ($u) {
970663d5a0obrien			if (defined $temporary_redirect{"$u *** $h"}) {
971663d5a0obrien				$0 = "$av0 - internal redirect $h";
972663d5a0obrien				print "Temporary redirect taken $u *** $h -> " if $debug;
973663d5a0obrien				$h = $temporary_redirect{"$u *** $h"};
974663d5a0obrien				print "$h\n" if $debug;
975663d5a0obrien				next;
976663d5a0obrien			}
977663d5a0obrien			$htr = &trhost($h);
978663d5a0obrien			if (defined $temporary_redirect{"$u *** $htr"}) {
979663d5a0obrien				$0 = "$av0 - internal redirect $h";
980663d5a0obrien				print "temporary redirect taken $u *** $h -> " if $debug;
981663d5a0obrien				$h = $temporary_redirect{"$u *** $htr"};
982663d5a0obrien				print "$h\n" if $debug;
983663d5a0obrien				next;
984663d5a0obrien			}
985663d5a0obrien		}
986663d5a0obrien		return $h;
987663d5a0obrien	}
988663d5a0obrien}
989663d5a0obrien# look up mx records with the name server.
990663d5a0obrien# re-queue expansion requests if possible
991663d5a0obrien# optionally give up on this host.
992525520fobriensub mxlookup
993663d5a0obrien{
994663d5a0obrien	local($lastchance,$server,$giveup,*users) = @_;
995663d5a0obrien	local(*T);
996663d5a0obrien	local(*NSLOOKUP);
997663d5a0obrien	local($nh, $pref,$cpref);
998663d5a0obrien	local($o0) = $0;
999663d5a0obrien	local($nserver);
1000663d5a0obrien	local($name,$aliases,$type,$len,$thataddr);
1001663d5a0obrien	local(%fallback);
1002663d5a0obrien
1003663d5a0obrien	return 1 if &mxredirect($server,*users);
1004663d5a0obrien
1005663d5a0obrien	if ((defined $mx{$server}) || (! $have_nslookup)) {
1006663d5a0obrien		return 0 unless $lastchance;
1007663d5a0obrien		&giveup('mx domainify',$giveup);
1008663d5a0obrien		return 0;
1009663d5a0obrien	}
1010663d5a0obrien
1011663d5a0obrien	$0 = "$av0 - nslookup of $server";
1012663d5a0obrien	open(T,">/tmp/expn$$") || die "open > /tmp/expn$$: $!\n";
1013663d5a0obrien	print T "set querytype=MX\n";
1014663d5a0obrien	print T "$server\n";
1015663d5a0obrien	close(T);
1016663d5a0obrien	$cpref = 1.0E12;
1017663d5a0obrien	undef $nserver;
1018663d5a0obrien	open(NSLOOKUP,"nslookup < /tmp/expn$$ 2>&1 |") || die "open nslookup: $!";
1019663d5a0obrien	while(<NSLOOKUP>) {
1020663d5a0obrien		print if ($debug > 2);
1021663d5a0obrien		if (/mail exchanger = ([-A-Za-z_.0-9+]+)/) {
1022663d5a0obrien			$nh = $1;
1023663d5a0obrien			if (/preference = (\d+)/) {
1024663d5a0obrien				$pref = $1;
1025663d5a0obrien				if ($pref < $cpref) {
1026663d5a0obrien					$nserver = $nh;
1027663d5a0obrien					$cpref = $pref;
1028663d5a0obrien				} elsif ($pref) {
1029663d5a0obrien					$fallback{$pref} .= " $nh";
1030663d5a0obrien				}
1031663d5a0obrien			}
1032663d5a0obrien		}
1033663d5a0obrien		if (/Non-existent domain/) {
1034663d5a0obrien			#
10357d0df74mbr			# These addresses are hosed.  Kaput!  Dead!
1036663d5a0obrien			# However, if we created the address in the
1037525520fobrien			# first place then there is a chance of
1038663d5a0obrien			# salvation.
1039663d5a0obrien			#
1040525520fobrien			1 while(<NSLOOKUP>);
1041663d5a0obrien			close(NSLOOKUP);
1042663d5a0obrien			return 0 unless $lastchance;
1043663d5a0obrien			&giveup('domainify',"$server: Non-existent domain",undef,1);
1044525520fobrien			return 0;
1045663d5a0obrien		}
1046525520fobrien
1047663d5a0obrien	}
1048663d5a0obrien	close(NSLOOKUP);
1049663d5a0obrien	unlink("/tmp/expn$$");
1050663d5a0obrien	unless ($nserver) {
1051663d5a0obrien		$0 = "$o0 - finished mxlookup";
1052663d5a0obrien		return 0 unless $lastchance;
1053663d5a0obrien		&giveup('mx domainify',"$server: Could not resolve address");
1054663d5a0obrien		return 0;
1055663d5a0obrien	}
1056663d5a0obrien
1057663d5a0obrien	# provide fallbacks in case $nserver doesn't work out
1058663d5a0obrien	if (defined $fallback{$cpref}) {
1059663d5a0obrien		$mx_secondary{$server} = $fallback{$cpref};
1060663d5a0obrien	}
1061663d5a0obrien
1062663d5a0obrien	$0 = "$av0 - gethostbyname($nserver)";
1063663d5a0obrien	($name,$aliases,$type,$len,$thataddr) = gethostbyname($nserver);
1064663d5a0obrien
1065663d5a0obrien	unless ($thataddr) {
1066663d5a0obrien		$0 = $o0;
1067663d5a0obrien		return 0 unless $lastchance;
1068663d5a0obrien		&giveup('mx domainify',"$nserver: could not resolve address");
1069663d5a0obrien		return 0;
1070663d5a0obrien	}
1071663d5a0obrien	print "MX($server) = $nserver\n" if $debug;
1072663d5a0obrien	print "$server -> $nserver\n" if $vw && !$debug;
1073663d5a0obrien	$mx{&trhost($server)} = $nserver;
1074663d5a0obrien	# redeploy the users
1075663d5a0obrien	unless (&mxredirect($server,*users)) {
1076663d5a0obrien		return 0 unless $lastchance;
1077663d5a0obrien		&giveup('mx domainify',"$nserver: only one level of mx redirect allowed");
1078663d5a0obrien		return 0;
1079663d5a0obrien	}
1080663d5a0obrien	$0 = "$o0 - finished mxlookup";
1081663d5a0obrien	return 1;
1082663d5a0obrien}
1083663d5a0obrien# if mx expansion did not help to resolve an address
1084525520fobrien# (ie: foo@bar became @baz:foo@bar, then undo the
1085663d5a0obrien# expansion).
1086663d5a0obrien# this is only used by &final
1087663d5a0obriensub mxunroll
1088663d5a0obrien{
1089663d5a0obrien	local(*host,*addr) = @_;
1090663d5a0obrien	local($r) = 0;
1091663d5a0obrien	print "looking for mxbacktrace{$addr *** $host}\n"
1092663d5a0obrien		if ($debug > 1);
1093663d5a0obrien	while (defined $mxbacktrace{"$addr *** $host"}) {
10947d0df74mbr		print "Unrolling MX expansion: \@$host:$addr -> "
1095663d5a0obrien			if ($debug || $verbose);
1096663d5a0obrien		$host = $mxbacktrace{"$addr *** $host"};
1097525520fobrien		print "\@$host:$addr\n"
1098663d5a0obrien			if ($debug || $verbose);
1099663d5a0obrien		$r = 1;
1100663d5a0obrien	}
1101663d5a0obrien	return 1 if $r;
1102663d5a0obrien	$addr = "\@$host:$addr"
1103663d5a0obrien		if ($host =~ /\./);
1104663d5a0obrien	return 0;
1105663d5a0obrien}
11067d0df74mbr# register a completed expansion.  Make the final address as
1107663d5a0obrien# simple as possible.
1108663d5a0obriensub final
1109663d5a0obrien{
1110663d5a0obrien	local($addr,$host,$name,$error) = @_;
1111663d5a0obrien	local($he);
1112663d5a0obrien	local($hb,$hr);
1113663d5a0obrien	local($au,$ah);
1114663d5a0obrien
1115663d5a0obrien	if ($error =~ /Non-existent domain/) {
1116525520fobrien		#
1117663d5a0obrien		# If we created the domain, then let's undo the
1118663d5a0obrien		# damage...
1119663d5a0obrien		#
1120663d5a0obrien		if (defined $create_host_backtrack{"$addr *** $host"}) {
1121663d5a0obrien			while (defined $create_host_backtrack{"$addr *** $host"}) {
1122663d5a0obrien				print "Un&domainifying($host) = " if $debug;
1123663d5a0obrien				$host = $create_host_backtrack{"$addr *** $host"};
1124663d5a0obrien				print "$host\n" if $debug;
1125663d5a0obrien			}
1126663d5a0obrien			$error = "$host: could not locate";
1127663d5a0obrien		} else {
1128525520fobrien			#
1129663d5a0obrien			# If we only want valid addresses, toss out
1130663d5a0obrien			# bad host names.
1131663d5a0obrien			#
1132663d5a0obrien			if ($valid) {
1133663d5a0obrien				print STDERR "\@$host:$addr ($name) Non-existent domain\n";
1134663d5a0obrien				return "";
1135663d5a0obrien			}
1136663d5a0obrien		}
1137663d5a0obrien	}
1138663d5a0obrien
1139663d5a0obrien	MXUNWIND: {
1140663d5a0obrien		$0 = "$av0 - final parsing of \@$host:$addr";
1141663d5a0obrien		($he = $host) =~ s/(\W)/\\$1/g;
1142663d5a0obrien		if ($addr !~ /@/) {
1143663d5a0obrien			# addr does not contain any host
1144663d5a0obrien			$addr = "$addr@$host";
1145663d5a0obrien		} elsif ($addr !~ /$he/i) {
1146663d5a0obrien			# if host part really something else, use the something
1147663d5a0obrien			# else.
1148663d5a0obrien			if ($addr =~ m/(.*)\@([^\@]+)$/) {
1149663d5a0obrien				($au,$ah) = ($1,$2);
1150663d5a0obrien				print "au = $au ah = $ah\n" if $debug;
1151663d5a0obrien				if (defined $temporary_redirect{"$addr *** $ah"}) {
1152663d5a0obrien					$addr = "$au\@".$temporary_redirect{"$addr *** $ah"};
1153663d5a0obrien					print "Rewrite! to $addr\n" if $debug;
1154663d5a0obrien					next MXUNWIND;
1155663d5a0obrien				}
1156663d5a0obrien			}
1157663d5a0obrien			# addr does not contain full host
1158663d5a0obrien			if ($valid) {
1159663d5a0obrien				if ($host =~ /^([^\.]+)(\..+)$/) {
1160663d5a0obrien					# host part has a . in it - foo.bar
1161663d5a0obrien					($hb, $hr) = ($1, $2);
1162663d5a0obrien					if ($addr =~ /\@([^\.\@]+)$/ && ($1 eq $hb)) {
1163525520fobrien						# addr part has not .
1164663d5a0obrien						# and matches beginning of
1165525520fobrien						# host part -- tack on a
1166663d5a0obrien						# domain name.
1167663d5a0obrien						$addr .= $hr;
1168663d5a0obrien					} else {
1169525520fobrien						&mxunroll(*host,*addr)
1170663d5a0obrien							&& redo MXUNWIND;
1171663d5a0obrien					}
1172663d5a0obrien				} else {
1173525520fobrien					&mxunroll(*host,*addr)
1174663d5a0obrien						&& redo MXUNWIND;
1175663d5a0obrien				}
1176663d5a0obrien			} else {
1177663d5a0obrien				$addr = "${addr}[\@$host]"
1178663d5a0obrien					if ($host =~ /\./);
1179663d5a0obrien			}
1180663d5a0obrien		}
1181663d5a0obrien	}
1182663d5a0obrien	$name = "$name " if $name;
1183663d5a0obrien	$error = " $error" if $error;
1184663d5a0obrien	if ($valid) {
1185663d5a0obrien		push(@final,"$name<$addr>");
1186663d5a0obrien	} else {
1187663d5a0obrien		push(@final,"$name<$addr>$error");
1188663d5a0obrien	}
1189663d5a0obrien	"\t$name<$addr>$error\n";
1190663d5a0obrien}
1191663d5a0obrien
1192663d5a0obriensub alarm
1193663d5a0obrien{
1194663d5a0obrien	local($alarm_action,$alarm_redirect,$alarm_user) = @_;
1195663d5a0obrien	alarm(3600);
1196663d5a0obrien	$SIG{ALRM} = 'handle_alarm';
1197663d5a0obrien}
1198663d5a0obrien# this involves one great big ugly hack.
1199663d5a0obrien# the "next HOST" unwinds the stack!
1200663d5a0obriensub handle_alarm
1201663d5a0obrien{
1202663d5a0obrien	&giveup($alarm_redirect,"Timed out during $alarm_action",$alarm_user);
1203663d5a0obrien	next HOST;
1204663d5a0obrien}
1205663d5a0obrien
1206663d5a0obrien# read the rest of the current smtp daemon's response (and toss it away)
1207663d5a0obriensub read_response
1208663d5a0obrien{
1209663d5a0obrien	local($done,$watch) = @_;
1210663d5a0obrien	local(@resp);
1211663d5a0obrien	print $s if $watch;
1212663d5a0obrien	while(($done eq "-") && ($s = <S>) && ($s =~ /^\d+([- ])/)) {
1213663d5a0obrien		print $s if $watch;
1214663d5a0obrien		$done = $1;
1215663d5a0obrien		push(@resp,$s);
1216663d5a0obrien	}
1217663d5a0obrien	return @resp;
1218663d5a0obrien}
1219663d5a0obrien# print args if verbose.  Return them in any case
1220663d5a0obriensub verbose
1221663d5a0obrien{
1222663d5a0obrien	local(@tp) = @_;
1223663d5a0obrien	print "@tp" if $verbose;
1224663d5a0obrien}
1225663d5a0obrien# to pass perl -w:
1226663d5a0obrien@tp;
1227663d5a0obrien$flag_a;
1228663d5a0obrien$flag_d;
1229663d5a0obrien$flag_1;
1230663d5a0obrien%already_domainify_fellback;
1231663d5a0obrien%already_mx_fellback;
1232663d5a0obrien&handle_alarm;
1233525520fobrien################### BEGIN PERL/TROFF TRANSITION
1234525520fobrien.00 ;
1235663d5a0obrien
1236663d5a0obrien'di
1237663d5a0obrien.nr nl 0-1
1238663d5a0obrien.nr % 0
1239525520fobrien.\\"'; __END__
1240663d5a0obrien.\" ############## END PERL/TROFF TRANSITION
1241663d5a0obrien.TH EXPN 1 "March 11, 1993"
1242663d5a0obrien.AT 3
1243663d5a0obrien.SH NAME
1244663d5a0obrienexpn \- recursively expand mail aliases
1245663d5a0obrien.SH SYNOPSIS
1246663d5a0obrien.B expn
1247663d5a0obrien.RI [ -a ]
1248663d5a0obrien.RI [ -v ]
1249663d5a0obrien.RI [ -w ]
1250663d5a0obrien.RI [ -d ]
1251663d5a0obrien.RI [ -1 ]
1252663d5a0obrien.IR user [@ hostname ]
1253663d5a0obrien.RI [ user [@ hostname ]]...
1254663d5a0obrien.SH DESCRIPTION
1255663d5a0obrien.B expn
1256663d5a0obrienwill use the SMTP
1257663d5a0obrien.B expn
1258525520fobrienand
1259663d5a0obrien.B vrfy
1260525520fobriencommands to expand mail aliases.
1261663d5a0obrienIt will first look up the addresses you provide on the command line.
1262525520fobrienIf those expand into addresses on other systems, it will
1263525520fobrienconnect to the other systems and expand again.  It will keep
1264663d5a0obriendoing this until no further expansion is possible.
1265663d5a0obrien.SH OPTIONS
1266525520fobrienThe default output of
1267663d5a0obrien.B expn
1268663d5a0obriencan contain many lines which are not valid
1269525520fobrienemail addresses.  With the
1270663d5a0obrien.I -aa
1271663d5a0obrienflag, only expansions that result in legal addresses
1272663d5a0obrienare used.  Since many mailing lists have an illegal
1273663d5a0obrienaddress or two, the single
1274663d5a0obrien.IR -a ,
1275663d5a0obrienaddress, flag specifies that a few illegal addresses can
1276525520fobrienbe mixed into the results.   More
1277663d5a0obrien.I -a
1278663d5a0obrienflags vary the ratio.  Read the source to track down
1279663d5a0obrienthe formula.  With the
1280663d5a0obrien.I -a
1281663d5a0obrienoption, you should be able to construct a new mailing
1282663d5a0obrienlist out of an existing one.
1283663d5a0obrien.LP
1284525520fobrienIf you wish to limit the number of levels deep that
1285663d5a0obrien.B expn
1286663d5a0obrienwill recurse as it traces addresses, use the
1287663d5a0obrien.I -1
1288525520fobrienoption.  For each
1289663d5a0obrien.I -1
1290525520fobrienanother level will be traversed.  So,
1291663d5a0obrien.I -111
1292663d5a0obrienwill traverse no more than three levels deep.
1293663d5a0obrien.LP
1294663d5a0obrienThe normal mode of operation for
1295663d5a0obrien.B expn
1296663d5a0obrienis to do all of its work silently.
1297663d5a0obrienThe following options make it more verbose.
1298663d5a0obrienIt is not necessary to make it verbose to see what it is
1299525520fobriendoing because as it works, it changes its
1300663d5a0obrien.BR argv [0]
1301663d5a0obrienvariable to reflect its current activity.
1302525520fobrienTo see how it is expanding things, the
1303663d5a0obrien.IR -v ,
1304525520fobrienverbose, flag will cause
1305525520fobrien.B expn
1306663d5a0obriento show each address before
1307663d5a0obrienand after translation as it works.
1308525520fobrienThe
1309663d5a0obrien.IR -w ,
1310663d5a0obrienwatch, flag will cause
1311663d5a0obrien.B expn
1312663d5a0obriento show you its conversations with the mail daemons.
1313525520fobrienFinally, the
1314663d5a0obrien.IR -d ,
1315663d5a0obriendebug, flag will expose many of the inner workings so that
1316663d5a0obrienit is possible to eliminate bugs.
1317663d5a0obrien.SH ENVIRONMENT
13187d0df74mbrNo environment variables are used.
1319663d5a0obrien.SH FILES
1320663d5a0obrien.PD 0
1321663d5a0obrien.B /tmp/expn$$
1322525520fobrien.B temporary file used as input to
1323663d5a0obrien.BR nslookup .
1324663d5a0obrien.SH SEE ALSO
1325525520fobrien.BR aliases (5),
1326663d5a0obrien.BR sendmail (8),
1327663d5a0obrien.BR nslookup (8),
1328663d5a0obrienRFC 823, and RFC 1123.
1329663d5a0obrien.SH BUGS
1330525520fobrienNot all mail daemons will implement
1331663d5a0obrien.B expn
1332663d5a0obrienor
1333663d5a0obrien.BR vrfy .
1334663d5a0obrienIt is not possible to verify addresses that are served
1335663d5a0obrienby such daemons.
1336663d5a0obrien.LP
1337663d5a0obrienWhen attempting to connect to a system to verify an address,
1338663d5a0obrien.B expn
1339663d5a0obrienonly tries one IP address.  Most mail daemons
1340663d5a0obrienwill try harder.
1341663d5a0obrien.LP
1342525520fobrienIt is assumed that you are running domain names and that
1343525520fobrienthe
1344525520fobrien.BR nslookup (8)
1345525520fobrienprogram is available.  If not,
1346663d5a0obrien.B expn
1347663d5a0obrienwill not be able to verify many addresses.  It will also pause
1348663d5a0obrienfor a long time unless you change the code where it says
1349663d5a0obrien.I $have_nslookup = 1
1350663d5a0obriento read
1351525520fobrien.I $have_nslookup =
1352663d5a0obrien.IR 0 .
1353663d5a0obrien.LP
1354525520fobrienLastly,
1355663d5a0obrien.B expn
1356663d5a0obriendoes not handle every valid address.  If you have an example,
1357663d5a0obrienplease submit a bug report.
1358663d5a0obrien.SH CREDITS
1359663d5a0obrienIn 1986 or so, Jon Broome wrote a program of the same name
1360663d5a0obrienthat did about the same thing.  It has since suffered bit rot
1361663d5a0obrienand Jon Broome has dropped off the face of the earth!
1362663d5a0obrien(Jon, if you are out there, drop me a line)
1363663d5a0obrien.SH AVAILABILITY
1364525520fobrienThe latest version of
1365663d5a0obrien.B expn
1366663d5a0obrienis available through anonymous ftp at
1367663d5a0obrien.IR ftp://ftp.idiom.com/pub/muir-programs/expn .
1368663d5a0obrien.SH AUTHOR
1369663d5a0obrien.I David Muir Sharnoff\ \ \ \ <muir@idiom.com>
1370