#!/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) = @_; $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; } $self->transaction->notes('pending_dns_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, @_) }, 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, @_) }, host => $host, client => $qp->input_sock, ); return CONTINUATION; } sub dns_result { my ($qp, $result, $query) = @_; my $pending = $qp->transaction->notes('pending_dns_queries'); $qp->transaction->notes('pending_dns_queries', --$pending); 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"); } $qp->finish_continuation unless $pending; } sub rcpt_handler { 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; }