qpsmtpd/plugins/require_resolvable_fromhost
Ask Bjørn Hansen a44957dc86 fix thinko from the log cleanup
git-svn-id: https://svn.perl.org/qpsmtpd/trunk@381 958fd67b-6ff1-0310-b445-bb7760255be9
2005-03-03 17:28:43 +00:00

52 lines
1.2 KiB
Plaintext

use Net::DNS qw(mx);
sub register {
my ($self, $qp) = @_;
$self->register_hook("mail", "mail_handler");
}
sub mail_handler {
my ($self, $transaction, $sender) = @_;
return DECLINED
if ($self->qp->connection->notes('whitelistclient'));
$sender->format ne "<>"
and $self->qp->config("require_resolvable_fromhost")
and !$self->check_dns($sender->host)
and return (DENYSOFT,
($sender->host
? "Could not resolve ". $sender->host
: "FQDN required in the envelope sender"));
return DECLINED;
}
sub check_dns {
my ($self, $host) = @_;
# for stuff where we can't even parse a hostname out of the address
return 0 unless $host;
return 1 if $host =~ m/^\[(\d{1,3}\.){3}\d{1,3}\]$/;
my $res = new Net::DNS::Resolver;
$res->tcp_timeout(30);
$res->udp_timeout(30);
return 1 if mx($res, $host);
my $query = $res->search($host);
if ($query) {
foreach my $rr ($query->answer) {
return 1 if $rr->type eq "A" or $rr->type eq "MX";
}
}
else {
$self->log(LOGWARN, "$$ query for $host failed: ", $res->errorstring)
unless $res->errorstring eq "NXDOMAIN";
}
return 0;
}