2535e77293
Too many individual changes to document. Trust me... ;-) Lightly tested (i.e. it accepts and delivers mail with minimal plugins). NOTES/LIMITATIONS: logging/adaptive currently eats some log messages. auth_vpopmail_sql is currently broken (needs continuations?). 'make test' fails in dnsbl (no Test::Qpsmtpd::input_sock() method). git-svn-id: https://svn.perl.org/qpsmtpd/trunk@588 958fd67b-6ff1-0310-b445-bb7760255be9
90 lines
2.3 KiB
Perl
90 lines
2.3 KiB
Perl
#!/usr/bin/perl
|
|
use Danga::DNS;
|
|
|
|
my %invalid = ();
|
|
|
|
sub init {
|
|
my ($self, $qp) = @_;
|
|
foreach my $i ($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;
|
|
}
|
|
}
|
|
}
|
|
|
|
sub hook_mail {
|
|
my ($self, $transaction, $sender) = @_;
|
|
return DECLINED
|
|
if ($self->qp->connection->notes('whitelistclient'));
|
|
|
|
$self->transaction->notes('resolvable', 1);
|
|
return DECLINED if $sender->format eq "<>";
|
|
return $self->check_dns($sender->host);
|
|
}
|
|
|
|
sub check_dns {
|
|
my ($self, $host) = @_;
|
|
|
|
# for stuff where we can't even parse a hostname out of the address
|
|
return DECLINED unless $host;
|
|
|
|
if( $host =~ m/^\[(\d{1,3}\.){3}\d{1,3}\]$/ ) {
|
|
$self->transaction->notes('resolvable', 1);
|
|
return DECLINED;
|
|
}
|
|
|
|
my $total_queries = 2;
|
|
my $qp = $self->qp;
|
|
$self->log(LOGDEBUG, "Checking $host for MX record in the background");
|
|
Danga::DNS->new(
|
|
callback => sub { dns_result($qp, @_) },
|
|
finished => sub { $total_queries--; finished($qp, $total_queries) },
|
|
host => $host,
|
|
type => "MX",
|
|
client => $qp->input_sock,
|
|
);
|
|
$self->log(LOGDEBUG, "Checking $host for A record in the background");
|
|
Danga::DNS->new(
|
|
callback => sub { dns_result($qp, @_) },
|
|
finished => sub { $total_queries--; finished($qp, $total_queries) },
|
|
host => $host,
|
|
client => $qp->input_sock,
|
|
);
|
|
return CONTINUATION;
|
|
}
|
|
|
|
sub finished {
|
|
my ($qp, $total_zones) = @_;
|
|
$qp->finish_continuation unless $total_zones;
|
|
}
|
|
|
|
sub dns_result {
|
|
my ($qp, $result, $query) = @_;
|
|
|
|
if ($result =~ /^[A-Z]+$/) {
|
|
# probably an error
|
|
$qp->log(LOGDEBUG, "DNS error: $result looking up $query");
|
|
} else {
|
|
$qp->transaction->notes('resolvable', 1);
|
|
$qp->log(LOGDEBUG, "DNS lookup $query returned: $result");
|
|
}
|
|
}
|
|
|
|
|
|
sub hook_rcpt {
|
|
my ($self, $transaction) = @_;
|
|
|
|
if (!$transaction->notes('resolvable')) {
|
|
my $sender = $transaction->sender;
|
|
$self->log(LOGDEBUG, "Could not resolve " .$sender->host) if $sender->host;
|
|
return (DENYSOFT,
|
|
($sender->host
|
|
? "Could not resolve ". $sender->host
|
|
: "FQDN required in the envelope sender"));
|
|
}
|
|
|
|
return DECLINED;
|
|
}
|