On Wed, Oct 25, 2006 at 02:07:51PM -0700, Marc Perkel wrote:
> I was thinking it would be handy to have some perl scripts to do custom
> sender/recipient verification. Basically I want to connect, wait for the
> greeting, send a HELO, interact using the script, and return the final
> response string.
>
> Anyone have a sample of how to do this?
Relevant perl excerpt follows. Actually this has some
deficiencies (doesn't handle CNAMEs correctly; the check
for postmaster@ causes it to generate bad results for
people who don't support that alias) but it should provide
a useful starting-point. I haven't fixed the problems I
describe since, as discussed previously, sender
verification isn't a whole lot of good; I suppose if I
wanted to do recipient verification it would be worth
improving, but at the moment that's done by a downstream
server in our configuration.
# verify_address_on_host ADDRESS HOST
# Test whether ADDRESS is deliverable on HOST. Returns an array giving a status
# and an explanation; status is '+' when a positive response to the RCPT
# command is received, '-' when a permanent failure response is received, and
# '?' otherwise; the explanation is a human-readable account of the condition.
sub verify_address_on_host ($$) {
my ($email, $host) = @_;
my $S = new Net::SMTP($host, Timeout => 15, Hello => 'your.hostname.here');
if (!$S) {
Exim::log_write("verify_address_on_host: unable to connect to $host; system error: $!");
return ('?', "unable to connect to $host: $!");
}
$S->mail('')
|| return ('?', "response to MAIL FROM: <> was '" . $S->code() . " " . ch($S->message()) . "'");
if ($S->recipient($email)) {
return ('+', "host $host accepted RCPT TO with '" . $S->code() . " " . ch($S->message()) . "'");
} else {
my $code = $S->code();
if (!defined($code)) {
return ('?', "unknown response to RCPT TO; system error $!");
} elsif ($code =~ /^4\d\d$/) {
return ('?', "temporary failure response to RCPT TO '" . $S->code() . " " . ch($S->message()) . "'");
} elsif ($code =~ /^5\d\d$/) {
return ('-', "permanent failure response to RCPT TO '" . $S->code() . " " . ch($S->message()) . "'");
} else {
return ('?', "unknown response to RCPT TO; code = $code");
}
}
$S->quit();
}
# verify_address ADDRESS [NOCACHE]
# Test whether ADDRESS is deliverable, by consulting the appropriate servers
# for email addressed to that domain. If NOCACHE is true the cache of tested
# addresses is not consulted.
sub verify_address ($;$) {
my ($email, $nocache) = @_;
if ($email eq '') {
return ('+', "blank return-path always valid");
} elsif ($email !~ /^([^@]+)@(.+)$/) {
return ('-', "not a valid email address");
}
my ($local_part, $domain) = ($1, lc($2));
if ($domain =~ /^\[[^]]+\]$/) {
return ('-', "we regard IP literals as invalid");
}
$email = $local_part . '@' . $domain;
# An irritating new trick is for spammers to point the MX records for
# their domains at those of some other provider, say Yahoo. This would be
# fine, except that some servers use large numbers of failing RCPT calls
# as evidence that a host is a source of spam, and should be blacklisted.
# Therefore, we also check that the postmaster address is deliverable,
# using a cached result even if NOCACHE is true, and if it is definitely
# undeliverable, we return a negative result.
if (lc($local_part) ne 'postmaster') {
my ($result, $expln) = verify_address('postmaster@' . $domain);
return ('-', "postmaster\@$domain is undeliverable, so it is not worth checking for $local_part\@$domain; result for postmaster was: $expln")
if ($result eq '-')
}
if (!$nocache) {
my $x = $T->fetch($email);
if ($x) {
my ($result, $expln, $when) = split(/\0/, $x);
if ($when > time() - $cachetime) {
return ($result, "$expln (cached)");
} else {
$T->delete($email);
}
}
}
our $R;
if (!$R) {
$R = new Net::DNS::Resolver;
$R->tcp_timeout(10);
$R->udp_timeout(10);
}
my @mailhosts = ( );
# First try MX records.
my @mx = mx($R, $domain);
if (@mx) {
# Only try the highest preference MXs. Others are likely just to be
# relays which won't know what is or isn't a valid address.
my $p = $mx[0]->preference();
@mailhosts = map { $_->exchange() } grep { $_->preference() == $p } @mx;
Exim::log_write("verify_address: $email: relevant MX hosts are: " . join(", ", @mailhosts));
} else {
@mailhosts = ($domain);
Exim::log_write("verify_address: $email: no MX records");
}
my ($result, $expln);
my $bad_domain = 0;
my $found_servers = 0;
foreach my $host (@mailhosts) {
my $reply = $R->send($host, 'A');
if (!defined($reply)) {
Exim::log_write("verify_address: $email: DNS error resolving '$host' (timeout?)");
next;
} if ($reply->header()->rcode() eq 'NXDOMAIN') {
$bad_domain = 1;
Exim::log_write("verify_address: $email: no such domain '$domain'");
next;
} else {
$bad_domain = 0;
}
foreach my $r ($reply->answer()) {
next if (ref($r) ne 'Net::DNS::RR::A');
++$found_servers;
my $addr = $r->address();
($result, $expln) = verify_address_on_host($email, $addr);
if ($result ne '?') {
goto done;
}
}
}
if ($bad_domain) {
($result, $expln) = ('-', "no such domain '$domain'");
} else {
$expln ||= 'n/a';
($result, $expln) = ('?', "unable to get a definitive answer; tried $found_servers servers; last result: $expln");
}
done:
Exim::log_write("verify_address: $email: $result $expln");
$T->store($email => "$result\0$expln\0" . time());
if (wantarray()) {
return ($result, $expln);
} else {
return $result;
}
}
--
``As Lord Denning said,
there's no smoke without fire:
Nil Combustibus Profumo.'' (Flanders and Swann)
