90daeb3786
The great plugin renaming in the name of inheritance and standardization commit. 1. new concept of standard hook_ names. 2. Plugin::init 3. renamed many subroutines in plugins (and cleaned up register subs) 4. updated README.plugins git-svn-id: https://svn.perl.org/qpsmtpd/trunk@479 958fd67b-6ff1-0310-b445-bb7760255be9
47 lines
1.1 KiB
Plaintext
47 lines
1.1 KiB
Plaintext
use Net::DNS qw(mx);
|
|
|
|
sub hook_mail {
|
|
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;
|
|
}
|
|
|