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