93e0025aae
git-svn-id: https://svn.perl.org/qpsmtpd/branches/high_perf@391 958fd67b-6ff1-0310-b445-bb7760255be9
68 lines
1.5 KiB
Perl
68 lines
1.5 KiB
Perl
#!/usr/bin/perl
|
|
|
|
use Danga::DNS;
|
|
|
|
sub register {
|
|
my ($self) = @_;
|
|
$self->register_hook("mail", "mail_handler");
|
|
$self->register_hook("rcpt", "rcpt_handler");
|
|
}
|
|
|
|
sub mail_handler {
|
|
my ($self, $transaction, $sender) = @_;
|
|
|
|
$sender->format ne "<>" and $self->check_dns($sender->host);
|
|
|
|
return DECLINED;
|
|
}
|
|
|
|
|
|
sub check_dns {
|
|
my ($self, $host) = @_;
|
|
|
|
# for stuff where we can't even parse a hostname out of the address
|
|
return unless $host;
|
|
|
|
return $self->transaction->notes('resolvable', 1)
|
|
if $host =~ m/^\[(\d{1,3}\.){3}\d{1,3}\]$/;
|
|
|
|
Danga::DNS->new(
|
|
callback => sub { $self->dns_result(@_) },
|
|
host => $host,
|
|
type => "MX",
|
|
client => $self->qp->input_sock,
|
|
);
|
|
Danga::DNS->new(
|
|
callback => sub { $self->dns_result(@_) },
|
|
host => $host,
|
|
client => $self->qp->input_sock,
|
|
);
|
|
}
|
|
|
|
sub dns_result {
|
|
my ($self, $result, $query) = @_;
|
|
|
|
if ($result =~ /^[A-Z]+$/) {
|
|
# probably an error
|
|
$self->log(LOGDEBUG, "DNS error: $result looking up $query");
|
|
return;
|
|
}
|
|
|
|
$self->log(LOGDEBUG, "DNS lookup $query returned: $result");
|
|
$self->transaction->notes('resolvable', 1);
|
|
}
|
|
|
|
sub rcpt_handler {
|
|
my ($self, $transaction) = @_;
|
|
|
|
if (!$transaction->notes('resolvable')) {
|
|
my $sender = $transaction->sender;
|
|
return (DENYSOFT,
|
|
($sender->host
|
|
? "Could not resolve ". $sender->host
|
|
: "FQDN required in the envelope sender"));
|
|
}
|
|
|
|
return DECLINED;
|
|
}
|