142 lines
3.7 KiB
Plaintext
142 lines
3.7 KiB
Plaintext
use Qpsmtpd::DSN;
|
|
use Net::DNS qw(mx);
|
|
use Socket;
|
|
use Net::IP qw(:PROC);
|
|
use Qpsmtpd::TcpServer;
|
|
|
|
my %invalid = ();
|
|
my $has_ipv6 = Qpsmtpd::TcpServer::has_ipv6();
|
|
|
|
sub hook_mail {
|
|
my ($self, $transaction, $sender, %param) = @_;
|
|
|
|
return DECLINED
|
|
if ($self->qp->connection->notes('whitelisthost'));
|
|
|
|
foreach my $i ($self->qp->config("invalid_resolvable_fromhost")) {
|
|
$i =~ s/^\s*//;
|
|
$i =~ s/\s*$//;
|
|
if ($i =~ m#^((\d{1,3}\.){3}\d{1,3})/(\d\d?)#) {
|
|
$invalid{$1} = $3;
|
|
}
|
|
}
|
|
|
|
if ($sender ne "<>"
|
|
and $self->qp->config("require_resolvable_fromhost")
|
|
and !$self->check_dns($sender->host)) {
|
|
if ($sender->host) {
|
|
# default of temp_resolver_failed is DENYSOFT
|
|
return Qpsmtpd::DSN->temp_resolver_failed("Could not resolve " . $sender->host);
|
|
}
|
|
else {
|
|
# default of addr_bad_from_system is DENY, we use DENYSOFT here to
|
|
# get the same behaviour as without Qpsmtpd::DSN...
|
|
return Qpsmtpd::DSN->addr_bad_from_system(DENYSOFT,
|
|
"FQDN required in the envelope sender");
|
|
}
|
|
}
|
|
return DECLINED;
|
|
|
|
}
|
|
|
|
sub check_dns {
|
|
my ($self, $host) = @_;
|
|
my @host_answers;
|
|
|
|
# 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);
|
|
my @mx = mx($res, $host);
|
|
foreach my $mx (@mx) {
|
|
# if any MX is valid, then we consider the domain
|
|
# resolvable
|
|
return 1 if mx_valid($self, $mx->exchange, $host);
|
|
}
|
|
# if there are MX records, and we got here,
|
|
# then none of them are valid
|
|
return 0 if (@mx > 0);
|
|
|
|
my $query = $res->search($host);
|
|
if ($query) {
|
|
foreach my $rrA ($query->answer) {
|
|
push(@host_answers, $rrA);
|
|
}
|
|
}
|
|
if ($has_ipv6) {
|
|
my $query = $res->search($host, 'AAAA');
|
|
if ($query) {
|
|
foreach my $rrAAAA ($query->answer) {
|
|
push(@host_answers, $rrAAAA);
|
|
}
|
|
}
|
|
}
|
|
if (@host_answers) {
|
|
foreach my $rr (@host_answers) {
|
|
return is_valid($rr->address) if $rr->type eq "A" or $rr->type eq "AAAA";
|
|
return mx_valid($self, $rr->exchange, $host) if $rr->type eq "MX";
|
|
}
|
|
}
|
|
else {
|
|
$self->log(LOGWARN, "$$ query for $host failed: ", $res->errorstring)
|
|
unless $res->errorstring eq "NXDOMAIN";
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
sub is_valid {
|
|
my $ip = shift;
|
|
my ($net,$mask);
|
|
### while (($net,$mask) = each %invalid) {
|
|
### ... does NOT reset to beginning, will start on
|
|
### 2nd invocation after where it denied the first time..., so
|
|
### 2nd time the same "MAIL FROM" would be accepted!
|
|
foreach $net (keys %invalid) {
|
|
$mask = $invalid{$net};
|
|
$mask = pack "B32", "1"x($mask)."0"x(32-$mask);
|
|
return 0
|
|
if join(".", unpack("C4", inet_aton($ip) & $mask)) eq $net;
|
|
}
|
|
return 1;
|
|
}
|
|
|
|
sub mx_valid {
|
|
my ($self, $name, $host) = @_;
|
|
my $res = new Net::DNS::Resolver;
|
|
# IP in MX
|
|
return is_valid($name) if ip_is_ipv4($name) or ip_is_ipv6($name);
|
|
|
|
my @mx_answers;
|
|
my $query = $res->search($name, 'A');
|
|
if ($query) {
|
|
foreach my $rrA ($query->answer) {
|
|
push(@mx_answers, $rrA);
|
|
}
|
|
}
|
|
if ($has_ipv6) {
|
|
my $query = $res->search($name, 'AAAA');
|
|
if ($query) {
|
|
foreach my $rrAAAA ($query->answer) {
|
|
push(@mx_answers, $rrAAAA);
|
|
}
|
|
}
|
|
}
|
|
if (@mx_answers) {
|
|
foreach my $rr (@mx_answers) {
|
|
next unless $rr->type eq "A" or $rr->type eq "AAAA";
|
|
return is_valid($rr->address);
|
|
}
|
|
}
|
|
else {
|
|
$self->log(LOGWARN, "$$ query for $host failed: ", $res->errorstring)
|
|
unless $res->errorstring eq "NXDOMAIN";
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
# vim: ts=2 sw=2 expandtab syn=perl
|