2014-03-09 Christos Zoulas <christos@zoulas.com>
- * Remove BSD advertising clause. The only advertising clause left
- is in scripts/expn.*, and I am not sure why these are part of
- am-utils.
+ * Remove BSD advertising clause.
+ * Remove expn program which is not used by anything
2013-12-05 Christos Zoulas <christos@zoulas.com>
+*** Notes specific to am-utils version 6.x
+
+ - Removed license advertising clause
+ - Removed expn program
+
*** Notes specific to am-utils version 6.2-rc1
Filesystem Support:
scripts/automount2amd \
scripts/ctl-amd \
scripts/ctl-hlfsd \
- scripts/expn \
scripts/fix-amd-map \
scripts/fixrmtab \
scripts/lostaltmail \
* automount2amd::
* ctl-amd::
* ctl-hlfsd::
-* expn::
* fix-amd-map::
* fixmount::
* fixrmtab::
@xref{Run-time Administration}, for more details.
@c ----------------------------------------------------------------
-@node ctl-hlfsd, expn, ctl-amd, Assorted Tools
+@node ctl-hlfsd, ctl-amd, Assorted Tools
@comment node-name, next, previous, up
@section ctl-hlfsd
@pindex ctl-hlfsd
@xref{Hlfsd}, for more details.
@c ----------------------------------------------------------------
-@node expn, fix-amd-map, ctl-hlfsd, Assorted Tools
-@comment node-name, next, previous, up
-@section expn
-@pindex expn
-
-A script to expand email addresses into their full name. It is
-generally useful when using with the @file{lostaltmail} script, but is a
-useful tools otherwise.
-
-@example
-$ expn -v ezk@@example.com
-ezk@@example.com ->
- ezk@@shekel.example.com
-ezk@@shekel.example.com ->
- Erez Zadok <"| /usr/local/mh/lib/slocal -user ezk || exit 75>
- Erez Zadok <\ezk>
- Erez Zadok </u/zing/ezk/.mailspool/backup>
-@end example
-
-@c ----------------------------------------------------------------
-@node fix-amd-map, fixmount, expn, Assorted Tools
+@node fix-amd-map, fixmount, Assorted Tools
@comment node-name, next, previous, up
@section fix-amd-map
@pindex fix-amd-map
redhat-ctl-amd \
test-attrcache
-bin_SCRIPTS = expn
-
sysconf_DATA = amd.conf-sample lostaltmail.conf-sample
# man pages
-man_MANS = amd.conf.5 automount2amd.8 expn.1
+man_MANS = amd.conf.5 automount2amd.8
EXTRA_DIST = \
am-eject.in \
wait4amd.in \
wait4amd2die.in \
\
- expn.in \
- \
amd.conf-sample \
lostaltmail.conf-sample \
$(man_MANS)
+++ /dev/null
-#!@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'; # perl 4
-use Socket; # perl 5
-$AF_INET = &AF_INET;
-$SOCK_STREAM = &SOCK_STREAM;
-$sockaddr = 'S n a4 x8';
-
-# system requirements:
-# must have 'nslookup' and 'hostname' programs.
-
-# $Header: /home/ezk/proj/amd/GIT/cvs/am-utils/scripts/expn.1,v 1.4 2003/07/18 15:17:37 ezk Exp $
-
-# 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 acknowledgment:
-# 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 derived 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
- # expansions 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 situations 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 coming 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 addresses 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 expansion: \@$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 expansion. 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 environment variables are used.
-.SH FILES
-.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>
+++ /dev/null
-#!@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'; # perl 4
-use Socket; # perl 5
-$AF_INET = &AF_INET;
-$SOCK_STREAM = &SOCK_STREAM;
-
-# system requirements:
-# must have 'nslookup' and 'hostname' programs.
-
-# $Header: /home/ezk/proj/amd/GIT/cvs/am-utils/scripts/expn.in,v 1.5 2002/07/11 14:28:20 ezk Exp $
-
-# 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 derived 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 = sockaddr_in(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 = sockaddr_in($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
- # expansions 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 situations 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 coming 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 addresses 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 expansion: \@$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 expansion. 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 environment 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>
projects / am-utils-6.2.git / commitdiff