qpsmtpd/plugins/require_resolvable_fromhost
Robert Spier 3341a5b4ab emacsisms, more timeouts
git-svn-id: https://svn.perl.org/qpsmtpd/trunk@350 958fd67b-6ff1-0310-b445-bb7760255be9
2004-11-27 07:08:46 +00:00

49 lines
1.0 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) = @_;
$sender->format ne "<>"
and $self->qp->config("require_resolvable_fromhost")
and !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 $host = shift;
# 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 {
warn "$$ query for $host failed: ", $res->errorstring, "\n"
unless $res->errorstring eq "NXDOMAIN";
}
return 0;
}