news.utdallas.edu!tamsun.tamu.edu!cs.utexas.edu!wupost!howland.reston.ans.net!agate!cogsci.Berkeley.EDU!muir Sun Mar  7 12:55:51 CST 1993
Article: 1434 of comp.lang.perl
Xref: feenix.metronet.com comp.lang.perl:1434
Path: feenix.metronet.com!news.utdallas.edu!tamsun.tamu.edu!cs.utexas.edu!wupost!howland.reston.ans.net!agate!cogsci.Berkeley.EDU!muir
From: muir@idiom.berkeley.ca.us (David Muir Sharnoff)
Newsgroups: comp.lang.perl
#Subject: late night doodle -- expn - expand/verify mail addresses
Date: 7 Mar 1993 11:18:50 GMT
Organization: University of California, Berkeley
Lines: 338
Distribution: world
Message-ID: <1nclmq$erj@agate.berkeley.edu>
NNTP-Posting-Host: cogsci.berkeley.edu
Originator: muir@cogsci.Berkeley.EDU

I suppose there are other expn programs floating around.  Probably
even one in perl...   

I wanted to try writing some socket code in perl -- I never had
before.  So I started writing and before I knew it, I had a 
pretty good mailing list exploder.  The total time investment in
this program is about five hours so far.  I tried to cover every
case, but it is possible (read likely) that I missed someting.
Let me know.  

As far as I know, this does a great job.

-Dave

P.S. If there are any updates to this, they will be available 
by ftp from idiom.berkeley.ca.us
P.P.S. I know they style isn't great -- this was a five hour
hack job.

#!/bin/sh
# shar:	Shell Archiver  (v1.22)
#
#	Run the following text with /bin/sh to create:
#	  expn
#
sed 's/^X//' << 'SHAR_EOF' > expn &&
X#!/usr/local/bin/perl
X
X# hardcoded constants
X$AF_INET = 2;
X$SOCK_STREAM = 1;
X$sockaddr = 'S n a4 x8';
X
X#
X# This program traces mailing lists.  For each address under
X# consideration, it opens a SMTP connection to the system and
X# executes the EXPN command.  
X#
X# It will not always work because many SMTP daemons do not 
X# implement EXPN.  Also, since many systems do not receive mail
X# themselves, but rather us MX records to forward it, there
X# isn't any easy way to verify the address.
X#
X# You get what you pay for -- this is free software.  NO
X# WARRENTEE.
X#
X# This program expects to be able to fork off 'nslookup' to
X# resolve MX records.
X#
X# David Muir Sharnoff <muir@idiom.berkeley.ca.us>, 3/7/93
X#
X
X$port = 'smtp';
Xchop($hostname = `hostname`);
X# regex for usernames
X$u = "([-A-Za-z_.0-9+]+)";
X# regex for hostname
X$h = $u;
X# regex for user@hostname
X$uah = "$u\@$h";
X# remember argv[0]
X$av0 = $0;
X
X$0 = "$av0 - parsing args";
Xfor $a (@ARGV) {
X	if ($a =~ /^$uah$/) {	
X		&expn($1,$2);
X		next;
X	}
X	if ($a =~ /^$u$/) {
X		&expn($1,$hostname);
X		next;
X	}
X	die "could not parse '$a'";
X}
X
X$0 = "$av0 - building local socket";
X($name,$aliases,$proto) = getprotobyname('tcp');
X($name,$aliases,$port) = getservbyname($port,'tcp')
X	unless $port =~ /^\d+/;
X($name,$aliases,$type,$len,$thisaddr) = gethostbyname($hostname);
X$this = pack($sockaddr, $AF_INET, 0, $thisaddr);
X
X
XHOST:
Xwhile (@hosts) {
X	$them = shift(@hosts);
X	@users = split(' ',$users{$them});
X	delete $users{$them};
X	($curdom = $them) =~ s/^[^\.]+//;
X
X	$0 = "$av0 - looking up $them";
X
X	if ($giveup{$them}) {
X		&giveup();
X		next;
X	}
X	if ($mx{$them}) {
X		$0 = "$av0 - MX redirecting $them to ".$mx{$them};
X		die "internal error: $them = ".$mx{$them}."\n"
X			if $them eq $mx{$them};
X		for $u (@users) {
X			&expn("$u\@$them",$mx{$them});
X		}
X		next HOST;
X	} else {
X		$0 = "$av0 - gethostbyname($them)";
X		($name,$aliases,$type,$len,$thataddr) = gethostbyname($them);
X		# if we can't get an A record, try for an MX record.
X		unless($thataddr) {
X			$0 = "$av0 - nslookup of $them";
X			open(T,">/tmp/expn$$") || die "open > /tmp/expn$$: $!\n";
X			print T "set querytype=MX\n";
X			print T "$them\n";
X			close(T);
X			$cpref = 1.0E12;
X			undef $nthem;
X			open(NSLOOKUP,"nslookup < /tmp/expn$$|") || die "open nslookup: $!";
X			while(<NSLOOKUP>) {
X				if (/mail exchanger = $h/) {
X					$nh = $1;
X					if (/preference = (\d+)/) {
X						$pref = $1;
X						if ($pref < $cpref) {
X							$nthem = $nh;
X						}
X					}
X				}
X			}
X			close(NSLOOKUP);
X			unlink("/tmp/expn$$");
X			unless ($nthem) {
X				&giveup();
X				next HOST;
X			}
X			($name,$aliases,$type,$len,$thataddr) = gethostbyname($nthem);
X			unless ($thataddr) {
X				&giveup();
X				next HOST;
X			}
X			print "MX($them) = $nthem\n";
X			$mx{$them} = $nthem;
X			# redeploy the users
X			for $u (@users) {
X				&expn("$u\@$them",$nthem);
X			}
X			next HOST;
X		}
X	}
X				
X	$0 = "$av0 - socket to $them";
X	$that = pack($sockaddr, $AF_INET, $port, $thataddr);
X	socket(S, $AF_INET, $SOCK_STREAM, $proto)
X		|| die "socket: $!";
X	$0 = "$av0 - bind to $them";
X	bind(S, $this) 
X		|| die "bind $hostname,0: $!";
X	$0 = "$av0 - connect to $them";
X	unless (connect(S, $that)) {
X		print STDERR "Could not connect to $them: $!\n";
X		&giveup();
X		next HOST;
X	}
X	select(S);
X	$| = 1;
X	select(STDOUT);
X
X	$0 = "$av0 - talking to $them";
X	while(<S>) {
X		print;
X		last if /^\d+ /;
X	}
X	# it seems that saying helo can confuse things, so don't
X#	&ps("helo EXPN:$hostname");
X#	while(<S>) {
X#		print;
X#		last if /^\d+ /;
X#	}
X
X	# $localh is the domainless version of $them when
X	# $them was originally referred to w/o the domain
X	# this should be on a per-user basis...
X	# or does it matter at all?
X	$localh = $them;
X	$localh = $oldhost{$them} if $oldhost{$them};
X
X	USER:
X	while(@users) {
X		$u = shift(@users);
X
X		if ($u =~ /(.*)\@(.*)/) {
X			($u, $chost) = ($1, $2);
X			$0 = "$av0 - expanding $u\@$chost at $them";
X			&ps("expn $u\@$chost");
X		} else {
X			$chost = $them;
X			$0 = "$av0 - expanding $u\@$localh at $them";
X			&ps("expn $u\@$localh");
X		}
X		$gotit = 0;
X		while($s = <S>) {
X			if ($s =~ /^(\d+)/) {
X				if ($1 != 250 && $1 != 550) {
X					&giveup($u);
X					last USER;
X				}
X			}
X			$s =~ s/[\n\r]//g;
X			$0 = "$av0 - parsing $them: $s";
X			print "$s\n";
X#print __LINE__."name = $name, name{$u\@$chost} = ".$name{"$u\@$chost"}."\n";
X			$name = $name{"$u\@$chost"}
X				if (! $name && $name{"$u\@$chost"});
X			if ($s =~ /^(\d+([- ]))(.*)\<(.*)\>$/) {
X				($done,$name,$newaddr) = ($2,$3,$4);
X				&understand($name,$newaddr);
X				last if $done eq " ";
X			} elsif ($s =~ /^250([ -])($uah)$/) {
X				($done,$newaddr) = ($1,$2,$3);
X				&understand("",$newaddr);
X				last if $done eq " ";
X			} elsif ($s =~ /^500/) {
X				&giveup($u);
X				last USER;
X			} elsif ($s =~ /^550/) {
X				push(@final,"$name <$u\@$chost> (USER UNKNOWN)");
X				$gotit = 1;
X			} else {
X				warn "did not understand: '$s'\n";
X				&giveup($u);
X				last USER;
X			}
X			last if $s =~ /^\d+ /;
X		}
X		unless($gotit) {
X			&giveup($u);
X			last USER;
X		}
X	}
X	$0 = "$av0 - sending 'quit' to $them";
X	&ps("quit");
X	while(<S>) {
X		print;
X		last if /^\d+ /;
X	}
X	close(S);
X}
X$0 = "$av0 - printing final results";
X#print "----------\n";
Xfor $f (sort @final) {
X	print "$f\n";
X}
Xexit(0);
Xsub giveup
X{
X	local($user) = @_;
X	# add back a user if we gave up in the middle
X	push(@users,$user) if $user;
X	# don't bother with this system anymore
X	unless ($giveup{$them}) {
X		$giveup{$them} = 1;
X		print STDERR "Will not be able to verify at $them\n";
X	}
X	for $u (@users) {
X		$name = $name{"$u\@$them"};
X		push(@final,"$name <$u\@$them> (UNVERIFIED)");
X	}
X}
Xsub expn
X{
X	local($user,$host) = @_;
X	$host = &trhost($host);
X
X	push(@hosts,$host) unless $users{$host};
X	$users{$host} .= " $user";
X}
Xsub trhost 
X{
X	# treat foo.bar as an alias for Foo.BAR
X	local($host) = @_;
X	local($trhost) = $host;
X	$trhost =~ tr/A-Z/a-z/;
X	if ($trhost{$trhost}) {
X		$host = $trhost{$trhost};
X	} else {
X		$trhost{$trhost} = $host;
X	}
X	$trhost{$trhost};
X}
Xsub ps
X{
X	local($p) = @_;
X	print "$p\n";
X	print S "$p\n";
X}
Xsub understand
X{
X	local($name,$newaddr) = @_;
X
X	# to deal with Fred <fj@foobar (Fred J.)>
X	if ($newaddr =~ /^(\S+)\s*\(.*\)$/) {
X		($name,$newaddr) = ($2,$1);
X	}
X#print __LINE__."name = $name, name{$u\@$chost} = ".$name{"$u\@$chost"}."\n";
X	$name{"$u\@$chost"} = $name
X		if $name;
X	$name = $name{"$u\@$chost"}
X		unless $name;
X	if ($newaddr =~ /^$uah$/) {
X		($user, $host) = ($1, $2);
X		$oldhost = $host;
X		$host =~ s/^([^\.]+)$/$1$curdom/;
X		if ($host ne $oldhost) {
X			$oldhost{$host} = $oldhost;
X#print __LINE__."name = $name, name{$u\@$chost} = ".$name{"$u\@$chost"}."\n";
X			$name{"$u\@$host"} = $name 
X				if $name;
X		}
X		if ($user eq $u && 
X				(&trhost($host) eq &trhost($chost) 
X				|| &trhost($host) eq &trhost($localh))) {
X			push(@final,"$name <$u\@$host>");
X		} else {
X			&expn($user,$host);
X		}
X#print __LINE__."name{$user\@$host} = $name\n";
X		$name{"$user\@$host"} = $name
X			if $name;
X#print __LINE__."name{$user\@$host} = $name\n";
X	} else {
X#print __LINE__."name{$u\@$chost} = ".$name{"$u\@$chost"}."\n";
X		push(@final,"$name <$newaddr\@$chost>");
X	}
X	$gotit = 1;
X}
SHAR_EOF
chmod 0755 expn || echo "restore of expn fails"
exit 0


news.utdallas.edu!wupost!howland.reston.ans.net!agate!cogsci.Berkeley.EDU!muir Wed Mar 10 11:06:21 CST 1993
Article: 1493 of comp.lang.perl
Xref: feenix.metronet.com comp.lang.perl:1493
Path: feenix.metronet.com!news.utdallas.edu!wupost!howland.reston.ans.net!agate!cogsci.Berkeley.EDU!muir
From: David Muir Sharnoff <muir@idiom.berkeley.ca.us>
Newsgroups: comp.lang.perl
#Subject: Re: late night doodle -- expn - expand/verify mail addresses
Date: 10 Mar 1993 10:57:11 GMT
Organization: University of California, Berkeley
Lines: 487
Message-ID: <1nkhi7$sp4@agate.berkeley.edu>
References: <1nclmq$erj@agate.berkeley.edu> <MERLYN.93Mar9160324@kandinsky.intel.com>
NNTP-Posting-Host: cogsci.berkeley.edu
Originator: muir@cogsci.Berkeley.EDU

In article <MERLYN.93Mar9160324@kandinsky.intel.com> merlyn@ora.com (Randal L. Schwartz) writes:
>David> As far as I know, this does a great job.
>
>As far as I know, this does a fine job in fewer steps. :-)

I hate to disagree, but your program doesn't do anything.
So, while I admit it has fewer steps...

>
>##################################################
>#!/usr/bin/perl
>
>require 'chat2.pl';
>
>($who,$where) = @ARGV;
>
>&chat'open_port($where,25);
>
>&chat'expect(10,'^220.*\n',1) || die "No header";
>&chat'print("expn $who\n");
>1 while &chat'expect(10,
>	'^250-(.*[^\r])\r?\n','print "$1\n "; 1',
>	'^250 (.*[^\r])\r?\n','print "$1\n"; 0',
>	'^550.*\n','print "no such user\n"; 0',
>	TIMEOUT,'0'
>);
>
>&chat'close();
>
>##################################################


Perhaps I should have been more clear about the mission
of my program: it is to follow mail aliases.  It follows
them as far as it can.  It starts with the system you 
initially point it at and keeps going until there are no
address it can further expand.

It can take a very long time to expand a large mailing
list.  

Actually, Randal, I worte it in part to see if I needed to use
chat2.pl to talk to SMTP or NNTP style daemons.  Not 
needed at all :-)  It would only save a dozen or so lines.  

Anyway, the one person who actaully bothered to figure out
what it did, didn't like the volume of output...   So, I cleaned
it up a bit.  There's now a very pretty -v (verbose) option
and the default only prints the final list.  

It still hasn't had much testing, so let me know if it 
bombs.  Thanks,

-Dave


P.S.  Further updates (?) available from ftp@idiom.berkeley.ca.us 

#!/bin/sh
# shar:	Shell Archiver  (v1.22)
#
#	Run the following text with /bin/sh to create:
#	  expn
#
sed 's/^X//' << 'SHAR_EOF' > expn &&
X#!/usr/local/bin/perl
X
X# Bugs...
X#
X#	sometimes gives inappropriate names to addresses 
X
X# hardcoded constants
X$AF_INET = 2;
X$SOCK_STREAM = 1;
X$sockaddr = 'S n a4 x8';
X
X#
X# This program traces mailing lists.  For each address under
X# consideration, it opens a SMTP connection to the system and
X# executes the EXPN command.  
X#
X# It will not always work because many SMTP daemons do not 
X# implement EXPN.  Also, since many systems do not receive mail
X# themselves, but rather us MX records to forward it, there
X# isn't any easy way to verify the address.
X#
X# You get what you pay for -- this is free software.  NO
X# WARRENTEE.
X#
X# This program expects to be able to fork off 'nslookup' to
X# resolve MX records.  It also uses 'hostname'...
X#
X# David Muir Sharnoff <muir@idiom.berkeley.ca.us>, 3/10/93
X#
X# 	Options:
X#
X#	-v		verbose output, nice and pretty
X#	-w		watch the conversations with the daemons
X#	-d		lots of ugly debugging output
X#
X
X
X$port = 'smtp';
Xchop($hostname = `hostname`);
X# remember argv[0]
X$av0 = $0;
Xselect(STDERR);
X
X$0 = "$av0 - parsing args";
Xfor $a (@ARGV) {
X	if ($a eq '-v') {
X		$verbose += 1;
X		$vd += 1;
X		next;
X	}
X	if ($a eq '-w') {
X		$watch += 1;
X		$vd += 1;
X		next;
X	}
X	if ($a eq '-d') {
X		$debug += 1;
X		next;
X	}
X	if ($a =~ /^-/) {
X		die "Usage: $0: [-v] [-w] [-d] user[@host] [user2[host2] ...]";
X	}
X	&expn(&parse($a,$hostname,undef,1));
X}
X
X$0 = "$av0 - building local socket";
X($name,$aliases,$proto) = getprotobyname('tcp');
X($name,$aliases,$port) = getservbyname($port,'tcp')
X	unless $port =~ /^\d+/;
X($name,$aliases,$type,$len,$thisaddr) = gethostbyname($hostname);
X$this = pack($sockaddr, $AF_INET, 0, $thisaddr);
X
X
XHOST:
Xwhile (@hosts) {
X	$server = shift(@hosts);
X	@users = split(' ',$users{$server});
X	delete $users{$server};
X
X	$0 = "$av0 - looking up $server";
X
X	if ($giveup{$server}) {
X		&giveup();
X		next;
X	}
X	if (defined $mx{$server}) {
X		$0 = "$av0 - MX redirecting $server to ".$mx{$server};
X		die "internal error: $server = ".$mx{$server}."\n"
X			if $server eq $mx{$server};
X		for $u (@users) {
X			&expn($mx{$server},$u,$name{"$u *** $server"});
X		}
X		next HOST;
X	} else {
X		$0 = "$av0 - gethostbyname($server)";
X		($name,$aliases,$type,$len,$thataddr) = gethostbyname($server);
X		# if we can't get an A record, try for an MX record.
X		unless($thataddr) {
X			$0 = "$av0 - nslookup of $server";
X			open(T,">/tmp/expn$$") || die "open > /tmp/expn$$: $!\n";
X			print T "set querytype=MX\n";
X			print T "$server\n";
X			close(T);
X			$cpref = 1.0E12;
X			undef $nserver;
X			open(NSLOOKUP,"nslookup < /tmp/expn$$ 2> /dev/null|") || die "open nslookup: $!";
X			while(<NSLOOKUP>) {
X				if (/mail exchanger = ([-A-Za-z_.0-9+]+)/) {
X					$nh = $1;
X					if (/preference = (\d+)/) {
X						$pref = $1;
X						if ($pref < $cpref) {
X							$nserver = $nh;
X						}
X					}
X				}
X			}
X			close(NSLOOKUP);
X			unlink("/tmp/expn$$");
X			unless ($nserver) {
X				&giveup();
X				next HOST;
X			}
X			($name,$aliases,$type,$len,$thataddr) = gethostbyname($nserver);
X			unless ($thataddr) {
X				&giveup();
X				next HOST;
X			}
X			print "MX($server) = $nserver\n" if $debug;
X			print "$server -> $nserver\n" if $vd && !$debug;
X			$mx{$server} = $nserver;
X			# redeploy the users
X			for $u (@users) {
X				&expn($nserver,$u,$name{"$u *** $server"});
X			}
X			next HOST;
X		}
X	}
X				
X	$0 = "$av0 - socket to $server";
X	$that = pack($sockaddr, $AF_INET, $port, $thataddr);
X	socket(S, $AF_INET, $SOCK_STREAM, $proto)
X		|| die "socket: $!";
X	$0 = "$av0 - bind to $server";
X	bind(S, $this) 
X		|| die "bind $hostname,0: $!";
X	$0 = "$av0 - connect to $server";
X	unless (connect(S, $that)) {
X		print STDERR "Could not connect to $server: $!\n";
X		&giveup();
X		next HOST;
X	}
X	select((select(S),$| = 1)[0]);
X
X	$0 = "$av0 - talking to $server";
X	while(<S>) {
X		print if $watch;
X		last if /^\d+ /;
X	}
X	# it seems that saying helo can confuse things, so don't
X#	&ps("helo EXPN:$hostname");
X#	while(<S>) {
X#		print;
X#		last if /^\d+ /;
X#	}
X
X	USER:
X	while(@users) {
X		$u = shift(@users);
X		$oldname = $names{"$u *** $server"};
X
X		$0 = "$av0 - expanding $u [@$server]";
X
X		if ($verbose) {
X			local($se) = $server;
X			local($sp);
X			$se =~ s/(\W)/\\$1/g;
X			$sp = " (\@$server)"
X				if ($u !~ /$se/);
X			print "$u$sp ->\n";
X		}
X		&ps("expn $u");
X		while($s = <S>) {
X			if ($s =~ /^(\d+)/) {
X				if ($1 != 250 && $1 != 550) {
X					&giveup($u);
X					last USER;
X				}
X			}
X			$s =~ s/[\n\r]//g;
X			$0 = "$av0 - parsing $server: $s";
X			print "$s\n" if $watch;
X			if ($s =~ /^250([ -])(.+)/) {
X				($done,$addr) = ($1,$2);
X				($newhost, $newaddr, $newname) =  &parse($addr,$server,$oldname);
X				print "($newhost, $newaddr, $newname) = &parse($addr, $server, $oldname)\n" if $debug;
X				if (! $newhost) {
X					&verbose(&final($newaddr,$server,$newname));
X				} else {
X					$newmxhost = &mx($newhost);
X					print "$newmxhost = &mx($newhost)\n" if $debug;
X
X					$0 = "$av0 - parsing $newaddr [@$newmxhost]";
X					if (&trhost($newmxhost) eq &trhost($server)) {
X						&verbose(&final($newaddr,$newmxhost,$newname));
X					} else {
X						print "\t$newaddr\n" if $verbose;
X						&expn($newmxhost,$newaddr,$newname);
X					}
X				}
X				next USER if ($done eq " ");
X				next;
X			}
X			if ($s =~ /^550/) {
X				print &final($u,$server,$oldname,"USER UNKNOWN");
X			next;
X		} 
X			if ($s =~ /^500/) {
X				&giveup($u);
X				last USER;
X			} 
X			warn "$u@$chost: did not understand: '$s'\n";
X			&giveup($u);
X		}
X	}
X	$0 = "$av0 - sending 'quit' to $server";
X	&ps("quit");
X	while(<S>) {
X		print if $watch;
X		last if /^\d+ /;
X	}
X	close(S);
X}
X$0 = "$av0 - printing final results";
Xprint "----------\n" if $vd;
Xselect(STDOUT);
Xfor $f (sort @final) {
X	print "$f\n";
X}
Xexit(0);
Xsub giveup
X{
X	local($user) = @_;
X	# add back a user if we gave up in the middle
X	push(@users,$user) if $user;
X	# don't bother with this system anymore
X	unless ($giveup{$server}) {
X		$giveup{$server} = 1;
X		print STDERR "Giving up on $server\n";
X	}
X	for $u (@users) {
X		$name = $name{"$u\@$server"};
X		&final($u,$server,$name{"$u *** $server"},'UNVERIFIED');
X	}
X}
Xsub parse
X{
X	local($newaddr,$context_host,$old_name,$parsing_args) = @_;
X	local(@names) = $old_name;
X
X	local($urx) = "([-A-Za-z_.0-9+]+)";
X	#
X	# first, separate out the address part.
X	#
X
X	#
X	# [NAME] <ADDR [(NAME)]>
X	# [NAME] <[(NAME)] ADDR
X	# ADDR [(NAME)]
X	# (NAME) ADDR
X	# [(NAME)] <ADDR>
X	#
X	if ($newaddr =~ /^\<(.*)\>$/) {
X		print "<A:$1>\n" if $debug;
X		$newaddr = &trim($1);
X		print "na = $newaddr\n" if $debug;
X	}
X	if ($newaddr =~ /^([^\<\>]*)\<([^\<\>]*)\>([^\<\>]*)$/) {
X		# address has a < > pair in it.
X		print "N:$1 <A:$2> N:$3\n" if $debug;
X		$newaddr = &trim($2);
X		push(@names, &trim($3,$1));
X		print "na = $newaddr\n" if $debug;
X	}
X	if ($newaddr =~ /^([^\(\)]*)\(([^\(\)]*)\)([^\(\)]*)$/) {
X		# address has a ( ) pair in it.
X		print "A:$1 (N:$2) A:$3\n" if $debug;
X		push(@names,&trim($2));
X		local($f,$l) = (&trim($1),&trim($3));
X		if (($f && $l) || !($f || $l)) {
X			# address looks like:
X			# foo (bar) baz  or (bar)
X			# not allowed!
X			print STDERR "Could not parse $newaddr\n" if $vd;
X			return(undef,$newaddr,&firstname(@names));
X		}
X		$newaddr = $f if $f;
X		$newaddr = $l if $l;
X		print "newaddr now = $newaddr\n" if $debug;
X	}
X	#
X	# @foo:bar
X	# j%k@l
X	# a@b
X	# b!a
X	# a
X	#
X	if ($newaddr =~ /^\@$urx\:(.+)$/) {
X		print "(@:)" if $debug;
X		return (&domainify($1,$current_host),$newaddr,&firstname(@names));
X	}
X	if ($newaddr =~ /^(.+)\@$urx$/) {
X		print "(@)" if $debug;
X		return (&domainify($2,$current_host),$newaddr,&firstname(@names));
X	}
X	if ($parsing_args) {
X		if ($newaddr =~ /^$urx\!(.+)$/) {
X			return (&domainify($1,$current_host),$newaddr,&firstname(@names));
X		}
X		if ($newaddr =~ /^$urx$/) {
X			return ($context_host,$newaddr,&firstname(@names));
X		}
X		print STDERR "Could not parse $newaddr\n";
X	}
X	print "(?)" if $debug;
X	return(undef,$newaddr,&firstname(@names));
X}
Xsub trim
X{
X	local(@v) = @_;
X	local($v,@r);
X	for $v (@v) {
X		$v =~ s/^\s+//;
X		$v =~ s/\s+$//;
X		push(@r,$v) if ($v =~ /\S/);
X	}
X	return(@r);
X}
Xsub domainify
X{
X	local($h,$hd) = @_;
X	return $h if ($h =~ /\./);
X	$hd =~ s/^[^\.]+//;
X	$h =~ s/^([^\.]+)$/$1$hd/;
X	$h;
X}
Xsub firstname
X{
X	local(@names) = @_;
X	local($n);
X	while(@names) {
X		$n = shift(@names);
X		return $n if $n =~ /\S/;
X	}
X	return undef;
X}
Xsub expn
X{
X	local($host,$addr,$name) = @_;
X	if ($host) {
X		$host = &trhost($host);
X
X		push(@hosts,$host) unless $users{$host};
X		$users{$host} .= " $addr";
X		$names{"$addr *** $host"} = $name;
X	} else {
X		&final($addr,'NONE',$name);
X	}
X}
Xsub trhost 
X{
X	# treat foo.bar as an alias for Foo.BAR
X	local($host) = @_;
X	local($trhost) = $host;
X	$trhost =~ tr/A-Z/a-z/;
X	if ($trhost{$trhost}) {
X		$host = $trhost{$trhost};
X	} else {
X		$trhost{$trhost} = $host;
X	}
X	$trhost{$trhost};
X}
Xsub ps
X{
X	local($p) = @_;
X	print "$p\n" if $watch;
X	print S "$p\n";
X}
Xsub mx
X{
X	local($h) = @_;
X	while (defined $mx{&trhost($h)}) {
X		$0 = "$av0 - mx expand $h";
X		$h = $mx{&trhost($h)};
X	}
X	$h;
X}
Xsub final
X{
X	local($addr,$host,$name,$error) = @_;
X	local($he) = $host;
X	$he =~ s/(\W)/\\$1/g;
X
X
X	if ($addr !~ /@/) {
X		$addr = "$addr@$host";
X	} elsif ($addr !~ /$he/) {
X		$addr = "$addr[@$host]";
X	}
X	$name = "$name " if $name;
X	$error = " $error" if $error;
X	push(@final,"$name<$addr>$error");
X	"\t$name<$addr>$error\n";
X}
Xsub verbose
X{
X	local(@tp) = @_;
X	print "@tp" if $verbose;
X}
SHAR_EOF
chmod 0755 expn || echo "restore of expn fails"
exit 0



.