Article 10155 of comp.lang.perl:

Article 10155 of comp.lang.perl:
Xref: feenix.metronet.com comp.lang.perl:10155 comp.mail.sendmail:4503 alt.sources:2702 comp.unix.admin:9048
Newsgroups: comp.lang.perl,comp.mail.sendmail,alt.sources,comp.unix.admin
Path: feenix.metronet.com!news.ecn.bgu.edu!usenet.ins.cwru.edu!howland.reston.ans.net!vixen.cso.uiuc.edu!sdd.hp.com!col.hp.com!csn!boulder!wraeththu.cs.colorado.edu!tchrist
From: Tom Christiansen <[email protected]>
Subject: expn program for sendmail
Message-ID: <[email protected]>
Originator: [email protected]
Followup-Top: comp.lang.perl,comp.mail.sendmail,alt.sources.d,comp.unix.admin
Sender: [email protected] (USENET News System)
Reply-To: [email protected] (Tom Christiansen)
Organization: University of Colorado, Boulder
Date: Tue, 25 Jan 1994 20:14:19 GMT
Lines: 101

Archive-name: expn
Submitted-by: [email protected]

Here's a brief program to expand remote aliases using the
smtp daemon on the farside, e.g.:

expn [email protected] local-alias [email protected]

You might want to invoke it as "vrfy" (or something like that) for smtp
servers that actually distinguish between VRFY and EXPN.

This will probably work on relatively archaic versions of Perl. I even
punt on sys/socket.h, although it would be better if you had it.

--tom

# This is a shell archive. Remove anything before this line,
# then unpack it by saving it in a file and typing "sh file".
#
# Wrapped by on Tue Jan 25 13:08:43 MST 1994
# Contents: expn

echo x - expn
sed 's/^@//' > "expn" <<'@//E*O*F expn//'
#!/usr/bin/perl
#
# expn -- convince smtp to divulge an alias expansion
# [email protected] 25-Jan-93
#
# EXAMPLES:
# expn local_alias [email protected]
# expn [email protected]
# vrfy [email protected]
#
# invoked as vrfy, will use VRFY, else use EXPN
#
# NB: you really should have already run h2ph on sys/socket.h
# to create a sys/socket.ph for this to work,

&init();

ADDR: while (defined ($combo = shift)) {
($name, $host) = split(/\@/, $combo);
$host = 'localhost' unless $host;
unless (@hent = gethostbyname($host)) { warn "$0: No host $host\n"; next ADDR; }
($host,$iaddr) = @hent[0,4];
if ($host !~ /\./ && $hent[1] =~ /(\S+\.\S+)/) { $host = $1; }
socket(SOCK, &PF_INET, &SOCK_STREAM, $proto) || die "socket: $!";

print ( ($VERB eq 'VRFY') ? "Verify" : "Expand" );
print "ing $name at $host:";

$paddr = pack($SOCKADDR_IN_T, &AF_INET, $port, $iaddr);
connect(SOCK, $paddr) || die "connect $host: $!";
select((select(SOCK), $| = 1)[0]);;

print "\n";

print SOCK "VRFY $name\r\nquit\r\n";
while ( <SOCK> ) {
/^220\b/ && next;
/^221\b/ && last;
s/250\b[\-\s]+//;
print;
}
close SOCK || die "can't close socket: $!";
print STDOUT "\n" if @ARGV;
}

sub init {
die "usage: $0 address\@host ...\n" unless @ARGV;

$VERB = ($0 =~ /ve?ri?fy$/i) ? 'VRFY' : 'EXPN';

$multi = @ARGV > 1;
$| = 1;
if (!eval "require 'sys/socket.ph'") {
warn $@;
warn "punting on definitions -- good luck";
warn "this probably won't work" unless -e "/vmunix";
eval '
sub AF_INET { 2; }
sub PF_INET { &AF_INET; }
sub SOCK_STREAM { 1; }
1;
' || die "can't even punt";
}
$proto = (getprotobyname('tcp'))[2];
$port = (getservbyname('smtp', 'tcp'))[2];
$SOCKADDR_IN_T = 'S n a4 x8'; # XXX: should check c2ph!!!
}
@//E*O*F expn//
chmod u=rwx,g=rx,o=rx expn
echo ln - vrfy
ln expn vrfy

exit 0
--
Tom Christiansen [email protected]
"Will Hack Perl for Fine Food and Fun"
Boulder Colorado 303-444-3212

Article 10175 of comp.lang.perl:
Xref: feenix.metronet.com comp.lang.perl:10175 comp.mail.sendmail:4515 alt.sources:2710 comp.unix.admin:9076
Path: feenix.metronet.com!news.ecn.bgu.edu!usenet.ins.cwru.edu!howland.reston.ans.net!cs.utexas.edu!swrinde!sgiblab!idiom.berkeley.ca.us!idiom.berkeley.ca.us!not-for-mail
From: [email protected] (David Muir Sharnoff)
Newsgroups: comp.lang.perl,comp.mail.sendmail,alt.sources,comp.unix.admin
Subject: Re: expn program for sendmail
Date: 26 Jan 1994 01:38:12 -0800
Organization: Idiom
Lines: 1321
Distribution: world
Message-ID: <[email protected]>
References: <[email protected]> <[email protected]>
NNTP-Posting-Host: idiom.berkeley.ca.us

Archive-name: expn
Submitted-by: [email protected]

In article <[email protected]> [email protected] (Trent A. Fisher) writes:
>
>In article <[email protected]> Tom Christiansen writes:
>> Here's a brief program to expand remote aliases using the
>> smtp daemon on the farside, e.g.: [...]
>
>Well, here's my program to do something similar, except mine will
>recursively resolve each address until it hits non-forwarding login or
>an error. For example, running it on [email protected] will give
>you (indentation shows recursion level):

Ummm, in the sendmail 8.* distribution, you can find a copy of my expn
program that does recursion. It also backtracks when it doesn't guess
right.

For example, there was a time when the address "[email protected]" would
expand to "[email protected]". This was very bad because the correct address
is really "[email protected]". Only my expn program can handle
these truely bizzare and twisted situtations.

It also optimizes by doing a breadth-first-search rather than a depth-first.

Use the "-a" option to get back address that can be used to send mail.
Use the "-w" and "-v" options to watch it do its work.
Use the "-1" option to limit the depth of the search

That all said, there are some remaining bugs. If you can give me a
test case, I'll fix 'em. Actually, most of my old test cases no longer
work. If you find examples where expn has to back-track, I would like
to know.

-Dave

#!/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'di';
X'ig00';
X# THIS PROGRAM IS ITS OWN MANUAL PAGE. INSTALL IN man & bin.
X# groff cannot handle the wrapman constructs, so if you use
X# groff, you must cut the manual part out and install it
X# separately.
X
X# hardcoded constants, should work fine for BSD-based systems
X$AF_INET = 2;
X$SOCK_STREAM = 1;
X$sockaddr = 'S n a4 x8';
X
X# system requirements:
X# must have 'nslookup' and 'hostname' programs.
X
X# version 3.3, 10/12/93
X
X# TODO:
X# CERNVM.CERN.CH needs simple logins for the expn command.
X# less magic should apply to command-line addresses
X# less magic should apply to local addresses
X# add magic to deal with cross-domain cnames
X
X# Checklist: (hard addresses)
X# [email protected] -> harry@tenet (.berkeley.edu)
X# [email protected] -> shiva.CS (.berkeley.edu)
X# [email protected] -> brown@tiberius (.tc.cornell.edu)
X
X#############################################################################
X#
X# Copyright (c) 1993 David Muir Sharnoff
X# All rights reserved.
X#
X# Redistribution and use in source and binary forms, with or without
X# modification, are permitted provided that the following conditions
X# are met:
X# 1. Redistributions of source code must retain the above copyright
X# notice, this list of conditions and the following disclaimer.
X# 2. Redistributions in binary form must reproduce the above copyright
X# notice, this list of conditions and the following disclaimer in the
X# documentation and/or other materials provided with the distribution.
X# 3. All advertising materials mentioning features or use of this software
X# must display the following acknowledgement:
X# This product includes software developed by the David Muir Sharnoff.
X# 4. The name of David Sharnoff may not be used to endorse or promote products
X# derived from this software without specific prior written permission.
X#
X# THIS SOFTWARE IS PROVIDED BY THE DAVID MUIR SHARNOFF ``AS IS'' AND
X# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
X# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
X# ARE DISCLAIMED. IN NO EVENT SHALL DAVID MUIR SHARNOFF BE LIABLE
X# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
X# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
X# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
X# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
X# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
X# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
X# SUCH DAMAGE.
X#
X# This copyright notice derrived from material copyrighted by the Regents
X# of the University of California.
X#
X# Contributions accepted.
X#
X#############################################################################
X
X# overall structure:
X# in an effort to not trace each address individually, but rather
X# ask each server in turn a whole bunch of questions, addresses to
X# be expanded are queued up.
X#
X# This means that all account w.r.t. an address must be stored in
X# various arrays. Generally these arrays are indexed by the
X# string "$addr *** $server" where $addr is the address to be
X# expanded "foo" or maybe "foo@bar" and $server is the hostname
X# of the SMTP server to contact.
X#
X
X# important global variables:
X#
X# @hosts : list of servers still to be contacted
X# $server : name of the current we are currently looking at
X# @users = $users{@hosts[0]} : addresses to expand at this server
X# $u = $users[0] : the current address being expanded
X# $names{"$users[0] *** $server"} : the 'name' associated with the address
X# $mxbacktrace{"$users[0] *** $server"} : record of mx expansion
X# $mx_secondary{$server} : other mx relays at the same priority
X# $domainify_fallback{"$users[0] *** $server"} : alternative names to try
X# instead of $server if $server doesn't work
X# $temporary_redirect{"$users[0] *** $server"} : when trying alternates,
X# temporarily channel all tries along current path
X# $giveup{$server} : do not bother expanding addresses at $server
X# $verbose : -v
X# $watch : -w
X# $vw : -v or -w
X# $debug : -d
X# $valid : -a
X# $levels : -1
X# S : the socket connection to $server
X
X$have_nslookup = 1; # we have the nslookup program
X$port = 'smtp';
X$av0 = $0;
X$0 = "$av0 - running hostname";
X$ENV{'PATH'} .= ":/usr/etc" unless $ENV{'PATH'} =~ m,/usr/etc,;
Xchop($hostname = `hostname`);
Xselect(STDERR);
X
X$usage = "Usage: $av0 [-1avwd] user[@host] [user2[host2] ...]";
X$0 = "$av0 - parsing args";
Xfor $a (@ARGV) {
X die $usage if $a eq "-";
X while ($a =~ s/^(-.*)([1avwd])/$1/) {
X eval '$'."flag_$2 += 1";
X }
X next if $a eq "-";
X die $usage if $a =~ /^-/;
X &expn(&parse($a,$hostname,undef,1,1));
X}
X$verbose = $flag_v;
X$watch = $flag_w;
X$vw = $flag_v + $flag_w;
X$debug = $flag_d;
X$valid = $flag_a;
X$levels = $flag_1;
X
Xdie $usage unless @hosts;
Xif ($valid) {
X if ($valid == 1) {
X $validRequirement = 0.8;
X } elsif ($valid == 2) {
X $validRequirement = 1.0;
X } elsif ($valid == 3) {
X $validRequirement = 0.9;
X } else {
X $validRequirement = (1 - (1/($valid-3)));
X print "validRequirement = $validRequirement\n" if $debug;
X }
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
XHOST:
Xwhile (@hosts) {
X $server = shift(@hosts);
X @users = split(' ',$users{$server});
X delete $users{$server};
X
X # is this server already known to be bad?
X $0 = "$av0 - looking up $server";
X if ($giveup{$server}) {
X &giveup('mx domainify',$giveup{$server});
X next;
X }
X
X # do we already have an mx record for this host?
X next HOST if &mxredirect($server,*users);
X
X # look it up, or try for an mx.
X $0 = "$av0 - gethostbyname($server)";
X
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 &mxlookup(1,$server,"$server: could not resolve name",*users);
X next HOST;
X }
X
X # get a connection, or look for an mx
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 print "debug = $debug server = $server\n" if $debug > 8;
X if (! connect(S, $that) || ($debug == 10 && $server =~ /relay\d.UU.NET$/i)) {
X $0 = "$av0 - $server: could not connect: $!\n";
X $emsg = $!;
X unless (&mxlookup(0,$server,"$server: could not connect: $!",*users)) {
X &giveup('mx',"$server: Could not connect: $emsg");
X }
X next HOST;
X }
X select((select(S),$| = 1)[0]); # don't buffer output to S
X
X # read the greeting
X $0 = "$av0 - talking to $server";
X &alarm("greeting with $server",'');
X while(<S>) {
X alarm(0);
X print if $watch;
X if (/^(\d+)([- ])/) {
X if ($1 != 220) {
X $0 = "$av0 - bad numeric responce from $server";
X &alarm("giving up after bet responce from $server",'');
X &toss($2);
X alarm(0);
X print STDERR "$server: NOT 220 greeting: $_"
X if ($debug || $vw);
X if (&mxlookup(0,$server,"$server: did not respond with a 220 greeting",*users)) {
X close(S);
X next HOST;
X }
X }
X last if ($2 eq " ");
X } else {
X $0 = "$av0 - bad responce from $server";
X print STDERR "$server: NOT 220 greeting: $_"
X if ($debug || $vw);
X unless (&mxlookup(0,$server,"$server: did not respond with SMTP codes",*users)) {
X &giveup('',"$server: did not talk SMTP");
X }
X close(S);
X next HOST;
X }
X &alarm("greeting with $server",'');
X }
X alarm(0);
X
X # if this causes problems, remove it
X $0 = "$av0 - sending helo to $server";
X &alarm("sending helo to $server","");
X &ps("helo $hostname");
X while(<S>) {
X print if $watch;
X last if /^\d+ /;
X }
X alarm(0);
X
X # try the users, one by one
X USER:
X while(@users) {
X $u = shift(@users);
X $0 = "$av0 - expanding $u [\@$server]";
X
X # do we already have a name for this user?
X $oldname = $names{"$u *** $server"};
X
X print &compact($u,$server)." ->\n" if ($verbose && ! $valid);
X if ($valid) {
X #
X # when running with -a, we delay taking any action
X # on the results of our query until we have looked
X # at the complete output. @toFinal stores expansions
X # that will be final if we take them. @toExpn stores
X # expnansions that are not final. @isValid keeps
X # track of our ability to send mail to each of the
X # expansions.
X #
X @isValid = ();
X @toFinal = ();
X @toExpn = ();
X }
X &alarm("expanding $u on $server",'',$u);
X &ps("expn $u");
X $said_something = 0;
X while($s = <S>) {
X alarm(0);
X $said_something = 1;
X
X # make sure the server is talking the right language
X if ($s =~ /^(\d+)([- ])/) {
X if ($1 != 250 && $1 != 550) {
X &alarm("vrfy'ing $u on $server",'',$u);
X &toss($2);
X &ps("vrfy $u");
X $s = <S>;
X alarm(0);
X if ($s =~ /^(\d+)/) {
X if ($1 != 250 && $1 != 550) {
X &alarm("giving up on expanding $u on $server",'',$u);
X &toss($2);
X alarm(0);
X &giveup('',"$server: expn/vrfy not implemented",$u);
X last USER;
X }
X }
X }
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 # no expansion is possible w/o a new server to call
X if ($valid) {
X push(@isValid, &validAddr($newaddr));
X push(@toFinal,$newaddr,$server,$newname);
X } else {
X &verbose(&final($newaddr,$server,$newname));
X }
X } else {
X $newmxhost = &mx($newhost,$newaddr);
X print "$newmxhost = &mx($newhost)\n"
X if ($debug && $newhost ne $newmxhost);
X $0 = "$av0 - parsing $newaddr [@$newmxhost]";
X print "levels = $levels, level{$u *** $server} = ".$level{"$u *** $server"}."\n" if ($debug > 1);
X # If the new server is the current one,
X # it would have expanded things for us
X # if it could have. Mx records must be
X # followed to compare server names.
X # We are also done if the recursion
X # count has been exceeded.
X if (&trhost($newmxhost) eq &trhost($server) || ($levels && $level{"$u *** $server"} >= $levels)) {
X if ($valid) {
X push(@isValid, &validAddr($newaddr));
X push(@toFinal,$newaddr,$newmxhost,$newname);
X } else {
X &verbose(&final($newaddr,$newmxhost,$newname));
X }
X } else {
X # more work to do...
X if ($valid) {
X push(@isValid, &validAddr($newaddr));
X push(@toExpn,$newmxhost,$newaddr,$newname,$level{"$u *** $server"});
X } else {
X &verbose(&expn($newmxhost,$newaddr,$newname,$level{"$u *** $server"}));
X }
X }
X }
X last if ($done eq " ");
X &alarm("expanding $u on $server",'',$u);
X next;
X }
X # 550 is a known code... Should the be
X # included in -a output? Might be a bug
X # here. Does it matter? Can assume that
X # there won't be UNKNOWN USER responces
X # mixed with valid users?
X if ($s =~ /^(550)([- ])/) {
X if ($valid) {
X print STDERR "\@$server:$u ($oldname) USER UNKNOWN\n";
X } else {
X &verbose(&final($u,$server,$oldname,"USER UNKNOWN"));
X }
X last if ($2 eq " ");
X &alarm("expanding $u on $server",'',$u);
X next;
X }
X &giveup('',"$server: did not grok '$s'",$u);
X last USER;
X }
X alarm(0);
X
X if (! $said_something) {
X &giveup('',"$server: lost connection",$u);
X last USER;
X }
X if ($valid) {
X #
X # now we decide if we are going to take these
X # expansions or roll them back.
X #
X $avgValid = &average(@isValid);
X print "avgValid = $avgValid\n" if $debug;
X if ($avgValid >= $validRequirement) {
X print &compact($u,$server)." ->\n" if $verbose;
X while (@toExpn) {
X &verbose(&expn(splice(@toExpn,0,4)));
X }
X while (@toFinal) {
X &verbose(&final(splice(@toFinal,0,3)));
X }
X } else {
X print "Tossing some valid to avoid invalid ".&compact($u,$server)."\n" if ($avgValid > 0.0 && ($vw || $debug));
X print &compact($u,$server)." ->\n" if $verbose;
X &verbose(&final($u,$server,$newname));
X }
X }
X }
X
X &alarm("sending 'quit' to $server",'');
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 alarm(0);
X}
X
X$0 = "$av0 - printing final results";
Xprint "----------\n" if $vw;
Xselect(STDOUT);
Xfor $f (sort @final) {
X print "$f\n";
X}
Xunlink("/tmp/expn$$");
Xexit(0);
X
X
X# abandon all attempts deliver to $server
X# register the current addresses as the final ones
Xsub giveup
X{
X local($redirect_okay,$reason,$user) = @_;
X local($us,@so,$nh,@remaining_users);
X
X $0 = "$av0 - giving up on $server: $reason";
X #
X # add back a user if we gave up in the middle
X #
X push(@users,$user) if $user;
X #
X # don't bother with this system anymore
X #
X unless ($giveup{$server}) {
X $giveup{$server} = $reason;
X print STDERR "$reason\n";
X }
X print "Giveup!!! redirect okay = $redirect_okay; $reason\n" if $debug;
X #
X # Wait!
X # Before giving up, see if there is a chance that
X # there is another host to redirect to!
X # (Kids, don't do this at home! Hacking is a dangerous
X # crime and you could end up behind bars.)
X #
X for $u (@users) {
X if ($redirect_okay =~ /\bmx\b/) {
X next if &try_fallback('mx',$u,*server,
X *mx_secondary,
X *already_mx_fellback);
X }
X if ($redirect_okay =~ /\bdomainify\b/) {
X next if &try_fallback('domainify',$u,*server,
X *domainify_fallback,
X *already_domainify_fellback);
X }
X push(@remaining_users,$u);
X }
X @users = @remaining_users;
X for $u (@users) {
X print &compact($u,$server)." ->\n" if ($verbose && $valid && $u);
X &verbose(&final($u,$server,$names{"$u *** $server"},$reason));
X }
X}
X#
X# This routine is used only within &giveup. It checks to
X# see if we really have to giveup or if there is a second
X# chance because we did something before that can be
X# backtracked.
X#
X# %fallback{"$user *** $host"} tracks what is able to fallback
X# %fellback{"$user *** $host"} tracks what has fallen back
X#
X# If there is a valid backtrack, then queue up the new possibility
X#
Xsub try_fallback
X{
X local($method,$user,*host,*fall_table,*fellback) = @_;
X local($us,$fallhost,$oldhost,$ft,$i);
X
X if ($debug > 8) {
X print "Fallback table $method:\n";
X for $i (sort keys %fall_table) {
X print "\t'$i'\t\t'$fall_table{$i}'\n";
X }
X print "Fellback table $method:\n";
X for $i (sort keys %fellback) {
X print "\t'$i'\t\t'$fellback{$i}'\n";
X }
X print "U: $user H: $host\n";
X }
X
X $us = "$user *** $host";
X if (defined $fellback{$us}) {
X #
X # Undo a previous fallback so that we can try again
X # Nest fallbacks are avoided because they could
X # lead to infinite loops
X #
X $fallhost = $fellback{$us};
X print "Already $method fell back from $us -> \n" if $debug;
X $us = "$user *** $fallhost";
X $oldhost = $fallhost;
X } elsif (($method eq 'mx') && (defined $mxbacktrace{$us}) && (defined $mx_secondary{$mxbacktrace{$us}})) {
X print "Fallback an MX expansion $us -> \n" if $debug;
X $oldhost = $mxbacktrace{$us};
X } else {
X print "Oldhost($host, $us) = " if $debug;
X $oldhost = $host;
X }
X print "$oldhost\n" if $debug;
X if (((defined $fall_table{$us}) && ($ft = $us)) || ((defined $fall_table{$oldhost}) && ($ft = $oldhost))) {
X print "$method Fallback = ".$fall_table{$ft}."\n" if $debug;
X local(@so,$newhost);
X @so = split(' ',$fall_table{$ft});
X $newhost = shift(@so);
X print "Falling back ($method) $us -> $newhost (from $oldhost)\n" if $debug;
X if ($method eq 'mx') {
X if (! defined ($mxbacktrace{"$user *** $newhost"})) {
X if (defined $mxbacktrace{"$user *** $oldhost"}) {
X print "resetting oldhost $oldhost to the original: " if $debug;
X $oldhost = $mxbacktrace{"$user *** $oldhost"};
X print "$oldhost\n" if $debug;
X }
X $mxbacktrace{"$user *** $newhost"} = $oldhost;
X print "mxbacktrace $user *** $newhost -> $oldhost\n" if $debug;
X }
X $mx{&trhost($oldhost)} = $newhost;
X } else {
X $temporary_redirect{$us} = $newhost;
X }
X if (@so) {
X print "Can still $method $us: @so\n" if $debug;
X $fall_table{$ft} = join(' ',@so);
X } else {
X print "No more fallbacks for $us\n" if $debug;
X delete $fall_table{$ft};
X }
X if (defined $create_host_backtrack{$us}) {
X $create_host_backtrack{"$user *** $newhost"}
X = $create_host_backtrack{$us};
X }
X $fellback{"$user *** $newhost"} = $oldhost;
X &expn($newhost,$user,$names{$us},$level{$us});
X return 1;
X }
X delete $temporary_redirect{$us};
X $host = $oldhost;
X return 0;
X}
X# return 1 if you could send mail to the address as is.
Xsub validAddr
X{
X local($addr) = @_;
X $res = &do_validAddr($addr);
X print "validAddr($addr) = $res\n" if $debug;
X $res;
X}
Xsub do_validAddr
X{
X local($addr) = @_;
X local($urx) = "[-A-Za-z_.0-9+]+";
X
X # \u
X return 0 if ($addr =~ /^\\/);
X # ?@h
X return 1 if ($addr =~ /.\@$urx$/);
X # @h:?
X return 1 if ($addr =~ /^\@$urx\:./);
X # h!u
X return 1 if ($addr =~ /^$urx!./);
X # u
X return 1 if ($addr =~ /^$urx$/);
X # ?
X print "validAddr($addr) = ???\n" if $debug;
X return 0;
X}
X# returns ($new_smtp_server,$new_address,$new_name)
X# given a responce from a SMTP server ($newaddr), the
X# current host ($server), the old "name" and a flag that
X# indicates if it is being called during the initial
X# command line parsing ($parsing_args)
Xsub parse
X{
X local($newaddr,$context_host,$old_name,$parsing_args) = @_;
X local(@names) = $old_name;
X local($urx) = "[-A-Za-z_.0-9+]+";
X
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 unshift(@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 unshift(@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 $vw;
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 # this is a bit of a cheat, but it seems necessary
X return (&domainify($1,$context_host,$2),$2,&firstname(@names));
X }
X if ($newaddr =~ /^(.+)\@($urx)$/) {
X print "(\@)" if $debug;
X return (&domainify($2,$context_host,$newaddr),$newaddr,&firstname(@names));
X }
X if ($parsing_args) {
X if ($newaddr =~ /^($urx)\!(.+)$/) {
X return (&domainify($1,$context_host,$newaddr),$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}
X# return $u (@$server) unless $u includes reference to $server
Xsub compact
X{
X local($u, $server) = @_;
X local($se) = $server;
X local($sp);
X $se =~ s/(\W)/\\$1/g;
X $sp = " (\@$server)";
X if ($u !~ /$se/i) {
X return "$u$sp";
X }
X return $u;
X}
X# remove empty (spaces don't count) members from an array
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}
X# using the host part of an address, and the server name, add the
X# servers' domain to the address if it doesn't already have a
X# domain. Since this sometimes failes, save a back reference so
X# it can be unrolled.
Xsub domainify
X{
X local($host,$domain_host,$u) = @_;
X local($domain,$newhost);
X
X # cut of trailing dots
X $host =~ s/\.$//;
X $domain_host =~ s/\.$//;
X
X if ($domain_host !~ /\./) {
X #
X # domain host isn't, keep $host whatever it is
X #
X print "domainify($host,$domain_host) = $host\n" if $debug;
X return $host;
X }
X
X #
X # There are several weird situtations that need to be
X # accounted for. They have to do with domain relay hosts.
X #
X # Examples:
X # host server "right answer"
X #
X # shiva.cs cs.berkeley.edu shiva.cs.berkeley.edu
X # shiva cs.berkeley.edu shiva.cs.berekley.edu
X # cumulus reed.edu @reed.edu:cumulus.uucp
X # tiberius tc.cornell.edu tiberius.tc.cornell.edu
X #
X # The first try must always be to cut the domain part out of
X # the server and tack it onto the host.
X #
X # A reasonable second try is to tack the whole server part onto
X # the host and for each possible repeated element, eliminate
X # just that part.
X #
X # These extra "guesses" get put into the %domainify_fallback
X # array. They will be used to give addresses a second chance
X # in the &giveup routine
X #
X
X local(%fallback);
X
X local($long);
X $long = "$host $domain_host";
X $long =~ tr/A-Z/a-z/;
X print "long = $long\n" if $debug;
X if ($long =~ s/^([^ ]+\.)([^ ]+) \2(\.[^ ]+\.[^ ]+)/$1$2$3/) {
X # matches shiva.cs cs.berkeley.edu and returns shiva.cs.berkeley.edu
X print "condensed fallback $host $domain_host -> $long\n" if $debug;
X $fallback{$long} = 9;
X }
X
X local($fh);
X $fh = $domain_host;
X while ($fh =~ /\./) {
X print "FALLBACK $host.$fh = 1\n" if $debug > 7;
X $fallback{"$host.$fh"} = 1;
X $fh =~ s/^[^\.]+\.//;
X }
X
X $fallback{"$host.$domain_host"} = 2;
X
X ($domain = $domain_host) =~ s/^[^\.]+//;
X $fallback{"$host$domain"} = 6
X if ($domain =~ /\./);
X
X if ($host =~ /\./) {
X #
X # Host is already okay, but let's look for multiple
X # interpretations
X #
X print "domainify($host,$domain_host) = $host\n" if $debug;
X delete $fallback{$host};
X $domainify_fallback{"$u *** $host"} = join(' ',sort {$fallback{$b} <=> $fallback{$a};} keys %fallback) if %fallback;
X return $host;
X }
X
X $domain = ".$domain_host"
X if ($domain !~ /\..*\./);
X $newhost = "$host$domain";
X
X $create_host_backtrack{"$u *** $newhost"} = $domain_host;
X print "domainify($host,$domain_host) = $newhost\n" if $debug;
X delete $fallback{$newhost};
X $domainify_fallback{"$u *** $newhost"} = join(' ',sort {$fallback{$b} <=> $fallback{$a};} keys %fallback) if %fallback;
X if ($debug) {
X print "fallback = ";
X print $domainify_fallback{"$u *** $newhost"}
X if defined($domainify_fallback{"$u *** $newhost"});
X print "\n";
X }
X return $newhost;
X}
X# return the first non-empty element of an array
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}
X# queue up more addresses to expand
Xsub expn
X{
X local($host,$addr,$name,$level) = @_;
X if ($host) {
X $host = &trhost($host);
X
X if (($debug > 3) || (defined $giveup{$host})) {
X unshift(@hosts,$host) unless $users{$host};
X } else {
X push(@hosts,$host) unless $users{$host};
X }
X $users{$host} .= " $addr";
X $names{"$addr *** $host"} = $name;
X $level{"$addr *** $host"} = $level + 1;
X print "expn($host,$addr,$name)\n" if $debug;
X return "\t$addr\n";
X } else {
X return &final($addr,'NONE',$name);
X }
X}
X# compute the numerical average value of an array
Xsub average
X{
X local(@e) = @_;
X return 0 unless @e;
X local($e,$sum);
X for $e (@e) {
X $sum += $e;
X }
X $sum / @e;
X}
X# print to the server (also to stdout, if -w)
Xsub ps
X{
X local($p) = @_;
X print ">>> $p\n" if $watch;
X print S "$p\n";
X}
X# return case-adjusted name for a host (for comparison purposes)
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}
X# re-queue users if an mx record dictates a redirect
X# don't allow a user to be redirected more than once
Xsub mxredirect
X{
X local($server,*users) = @_;
X local($u,$nserver,@still_there);
X
X $nserver = &mx($server);
X
X if (&trhost($nserver) ne &trhost($server)) {
X $0 = "$av0 - mx redirect $server -> $nserver\n";
X for $u (@users) {
X if (defined $mxbacktrace{"$u *** $nserver"}) {
X push(@still_there,$u);
X } else {
X $mxbacktrace{"$u *** $nserver"} = $server;
X print "mxbacktrace{$u *** $nserver} = $server\n"
X if ($debug > 1);
X &expn($nserver,$u,$names{"$u *** $server"});
X }
X }
X @users = @still_there;
X if (! @users) {
X return $nserver;
X } else {
X return undef;
X }
X }
X return undef;
X}
X# follow mx records, return a hostname
X# also follow temporary redirections comming from &domainify and
X# &mxlookup
Xsub mx
X{
X local($h,$u) = @_;
X
X for (;;) {
X if (defined $mx{&trhost($h)} && $h ne $mx{&trhost($h)}) {
X $0 = "$av0 - mx expand $h";
X $h = $mx{&trhost($h)};
X return $h;
X }
X if ($u) {
X if (defined $temporary_redirect{"$u *** $h"}) {
X $0 = "$av0 - internal redirect $h";
X print "Temporary redirect taken $u *** $h -> " if $debug;
X $h = $temporary_redirect{"$u *** $h"};
X print "$h\n" if $debug;
X next;
X }
X $htr = &trhost($h);
X if (defined $temporary_redirect{"$u *** $htr"}) {
X $0 = "$av0 - internal redirect $h";
X print "temporary redirect taken $u *** $h -> " if $debug;
X $h = $temporary_redirect{"$u *** $htr"};
X print "$h\n" if $debug;
X next;
X }
X }
X return $h;
X }
X}
X# look up mx records with the name server.
X# re-queue expansion requests if possible
X# optionally give up on this host.
Xsub mxlookup
X{
X local($lastchance,$server,$giveup,*users) = @_;
X local(*T);
X local(*NSLOOKUP);
X local($nh, $pref,$cpref);
X local($o0) = $0;
X local($nserver);
X local($name,$aliases,$type,$len,$thataddr);
X local(%fallback);
X
X return 1 if &mxredirect($server,*users);
X
X if ((defined $mx{$server}) || (! $have_nslookup)) {
X return 0 unless $lastchance;
X &giveup('mx domainify',$giveup);
X return 0;
X }
X
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>&1 |") || die "open nslookup: $!";
X while(<NSLOOKUP>) {
X print if ($debug > 2);
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 $cpref = $pref;
X } elsif ($pref) {
X $fallback{$pref} .= " $nh";
X }
X }
X }
X if (/Non-existent domain/) {
X #
X # These addresss are hosed. Kaput! Dead!
X # However, if we created the address in the
X # first place then there is a chance of
X # salvation.
X #
X 1 while(<NSLOOKUP>);
X close(NSLOOKUP);
X return 0 unless $lastchance;
X &giveup('domainify',"$server: Non-existent domain",undef,1);
X return 0;
X }
X
X }
X close(NSLOOKUP);
X unlink("/tmp/expn$$");
X unless ($nserver) {
X $0 = "$o0 - finished mxlookup";
X return 0 unless $lastchance;
X &giveup('mx domainify',"$server: Could not resolve address");
X return 0;
X }
X
X # provide fallbacks in case $nserver doesn't work out
X if (defined $fallback{$cpref}) {
X# for $u (@users) {
X# print "mx_secondary{$u *** $nserver} = ".$fallback{$cpref}."\n"
X# if $debug;
X# $mx_secondary{"$u *** $nserver"} = $fallback{$cpref};
X# }
X $mx_secondary{$server} = $fallback{$cpref};
X }
X
X $0 = "$av0 - gethostbyname($nserver)";
X ($name,$aliases,$type,$len,$thataddr) = gethostbyname($nserver);
X
X unless ($thataddr) {
X $0 = $o0;
X return 0 unless $lastchance;
X &giveup('mx domainify',"$nserver: could not resolve address");
X return 0;
X }
X print "MX($server) = $nserver\n" if $debug;
X print "$server -> $nserver\n" if $vw && !$debug;
X $mx{&trhost($server)} = $nserver;
X # redeploy the users
X unless (&mxredirect($server,*users)) {
X return 0 unless $lastchance;
X &giveup('mx domainify',"$nserver: only one level of mx redirect allowed");
X return 0;
X }
X $0 = "$o0 - finished mxlookup";
X return 1;
X}
X# if mx expansion did not help to resolve an address
X# (ie: foo@bar became @baz:foo@bar, then undo the
X# expansion).
X# this is only used by &final
Xsub mxunroll
X{
X local(*host,*addr) = @_;
X local($r) = 0;
X print "looking for mxbacktrace{$addr *** $host}\n"
X if ($debug > 1);
X while (defined $mxbacktrace{"$addr *** $host"}) {
X print "Unrolling MX expnasion: \@$host:$addr -> "
X if ($debug || $verbose);
X $host = $mxbacktrace{"$addr *** $host"};
X print "\@$host:$addr\n"
X if ($debug || $verbose);
X $r = 1;
X }
X return 1 if $r;
X $addr = "\@$host:$addr"
X if ($host =~ /\./);
X return 0;
X}
X# register a completed expnasion. Make the final address as
X# simple as possible.
Xsub final
X{
X local($addr,$host,$name,$error) = @_;
X local($he);
X local($hb,$hr);
X local($au,$ah);
X
X if ($error =~ /Non-existent domain/) {
X #
X # If we created the domain, then let's undo the
X # damage...
X #
X if (defined $create_host_backtrack{"$addr *** $host"}) {
X while (defined $create_host_backtrack{"$addr *** $host"}) {
X print "Un&domainifying($host) = " if $debug;
X $host = $create_host_backtrack{"$addr *** $host"};
X print "$host\n" if $debug;
X }
X $error = "$host: could not locate";
X } else {
X #
X # If we only want valid addresses, toss out
X # bad host names.
X #
X if ($valid) {
X print STDERR "\@$host:$addr ($name) Non-existent domain\n";
X return "";
X }
X }
X }
X
X MXUNWIND: {
X $0 = "$av0 - final parsing of \@$host:$addr";
X ($he = $host) =~ s/(\W)/\\$1/g;
X if ($addr !~ /@/) {
X # addr does not contain any host
X $addr = "$addr@$host";
X } elsif ($addr !~ /$he/i) {
X # if host part really something else, use the something
X # else.
X if ($addr =~ m/(.*)\@([^\@]+)$/) {
X ($au,$ah) = ($1,$2);
X print "au = $au ah = $ah\n" if $debug;
X if (defined $temporary_redirect{"$addr *** $ah"}) {
X $addr = "$au\@".$temporary_redirect{"$addr *** $ah"};
X print "Rewrite! to $addr\n" if $debug;
X next MXUNWIND;
X }
X }
X # addr does not contain full host
X if ($valid) {
X if ($host =~ /^([^\.]+)(\..+)$/) {
X # host part has a . in it - foo.bar
X ($hb, $hr) = ($1, $2);
X if ($addr =~ /\@([^\.\@]+)$/ && ($1 eq $hb)) {
X # addr part has not .
X # and matches beginning of
X # host part -- tack on a
X # domain name.
X $addr .= $hr;
X } else {
X &mxunroll(*host,*addr)
X && redo MXUNWIND;
X }
X } else {
X &mxunroll(*host,*addr)
X && redo MXUNWIND;
X }
X } else {
X $addr = "${addr}[\@$host]"
X if ($host =~ /\./);
X }
X }
X }
X $name = "$name " if $name;
X $error = " $error" if $error;
X if ($valid) {
X push(@final,"$name<$addr>");
X } else {
X push(@final,"$name<$addr>$error");
X }
X "\t$name<$addr>$error\n";
X}
X
Xsub alarm
X{
X local($alarm_action,$alarm_redirect,$alarm_user) = @_;
X alarm(3600);
X $SIG{ALRM} = 'handle_alarm';
X}
X# this involves one GREAT hack.
X# the "next HOST" has to unwind the stack!
Xsub handle_alarm
X{
X &giveup($alarm_redirect,"Timed out during $alarm_action",$alarm_user);
X next HOST;
X}
X
X# read the rest of the current smtp daemon's responce (and toss it away)
Xsub toss
X{
X local($done) = @_;
X print $s if $watch;
X while(($done eq "-") && ($s = <S>) && ($s =~ /^\d+([- ])/)) {
X print $s if $watch;
X $done = $1;
X }
X}
X# print args if verbose. Return them in any case
Xsub verbose
X{
X local(@tp) = @_;
X print "@tp" if $verbose;
X}
X# to pass perl -w:
X@tp;
X$flag_a;
X$flag_d;
X$flag_1;
X%already_domainify_fellback;
X%already_mx_fellback;
X&handle_alarm;
X################### BEGIN PERL/TROFF TRANSITION
X.00;
X
X'di \\ " finish diversion--previous line must be blank
X.nr nl 0-1 \\ " fake up transition to first page again
X.nr % 0 \\ " start at page 1
X'; __END__
X.\" ############### END PERL/TROFF TRANSITION
X.TH EXPN 1 "March 11, 1993"
X.AT 3
X.SH NAME
Xexpn \- recursively expand mail aliases
X.SH SYNOPSIS
X.B expn
X.RI [ -a ]
X.RI [ -v ]
X.RI [ -w ]
X.RI [ -d ]
X.RI [ -1 ]
X.IR user [@ hostname ]
X.RI [ user [@ hostname ]]...
X.SH DESCRIPTION
X.B expn
Xwill use the SMTP
X.B expn
Xand
X.B vrfy
Xcommands to expand mail aliases.
XIt will first look up the addresses you provide on the command line.
XIf those expand into addresses on other systems, it will
Xconnect to the other systems and expand again. It will keep
Xdoing this until no further expansion is possible.
X.SH OPTIONS
XThe default output of
X.B expn
Xcan contain many lines which are not valid
Xemail addresses. With the
X.I -aa
Xflag, only expansions that result in legal addresses
Xare used. Since many mailing lists have an illegal
Xaddress or two, the single
X.IR -a ,
Xaddress, flag specifies that a few illegal addresses can
Xbe mixed into the results. More
X.I -a
Xflags vary the ratio. Read the source to track down
Xthe formula. With the
X.I -a
Xoption, you should be able to construct a new mailing
Xlist out of an existing one.
X.LP
XIf you wish to limit the number of levels deep that
X.B expn
Xwill recurse as it traces addresses, use the
X.I -1
Xoption. For each
X.I -1
Xanother level will be traversed. So,
X.I -111
Xwill traverse no more than three levels deep.
X.LP
XThe normal mode of operation for
X.B expn
Xis to do all of its work silently.
XThe following options make it more verbose.
XIt is not necessary to make it verbose to see what it is
Xdoing because as it works, it changes its
X.BR argv [0]
Xvariable to reflect its current activity.
XTo see how it is expanding things, the
X.IR -v ,
Xverbose, flag will cause
X.B expn
Xto show each address before
Xand after translation as it works.
XThe
X.IR -w ,
Xwatch, flag will cause
X.B expn
Xto show you its conversations with the mail daemons.
XFinally, the
X.IR -d ,
Xdebug, flag will expose many of the inner workings so that
Xit is possible to eliminate bugs.
X.SH ENVIRONMENT
XNo enviroment variables are used.
X.SH FILES
X.PD 0
X.B /tmp/expn$$
X.B temporary file used as input to
X.BR nslookup .
X.SH SEE ALSO
X.BR aliases (5),
X.BR sendmail (8),
X.BR nslookup (8),
XRFC 823, and RFC 1123.
X.SH BUGS
XNot all mail daemons will implement
X.B expn
Xor
X.BR vrfy .
XIt is not possible to verify addresses that are served
Xby such daemons.
X.LP
XWhen attempting to connect to a system to verify an address,
X.B expn
Xonly tries one IP address. Most mail daemons
Xwill try harder.
X.LP
XIt is assumed that you are running domain names and that
Xthe
X.BR nslookup (8)
Xprogram is available. If not,
X.B expn
Xwill not be able to verify many addresses. It will also pause
Xfor a long time unless you change the code where it says
X.I $have_nslookup = 1
Xto read
X.I $have_nslookup =
X.IR 0 .
X.LP
XLastly,
X.B expn
Xdoes not handle every valid address. If you have an example,
Xplease submit a bug report.
X.SH CREDITS
XIn 1986 or so, Jon Broome wrote a program of the same name
Xthat did about the same thing. It has since suffered bit rot
Xand Jon Broome has dropped off the face of the earth!
X(Jon, if you are out there, drop me a line)
X.SH AVAILABILITY
XThe latest version of
X.B expn
Xis available through anonymous ftp to
X.IR idiom.berkeley.ca.us .
X.SH AUTHOR
X.I David Muir Sharnoff\ \ \ \ <[email protected]>
SHAR_EOF
chmod 0755 expn || echo "restore of expn fails"
exit 0