qpsmtpd/plugins/async/require_resolvable_fromhost

#!perl -w

use strict;
use warnings;

use Qpsmtpd::Constants;
use Qpsmtpd::DSN;
use Qpsmtpd::TcpServer;

#use ParaDNS;  # moved into register
use Socket;

my %invalid  = ();
my $has_ipv6 = Qpsmtpd::TcpServer::has_ipv6();

sub register {
    my ( $self, $qp ) = @_;
    
    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;
        }
    }

    eval 'use ParaDNS';
    if ( $@ ) {
        warn "could not load ParaDNS, plugin disabled";
        return DECLINED;
    };
    $self->register_hook( mail => 'hook_mail_start' );
    $self->register_hook( mail => 'hook_mail_done' );
}

sub hook_mail_start {
    my ( $self, $transaction, $sender ) = @_;
    
    return DECLINED
      if ($self->connection->notes('whitelisthost'));

    if ( $sender ne '<>' ) {

        unless ( $sender->host ) {
            # 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 if $sender->host =~ m/^\[(\d{1,3}\.){3}\d{1,3}\]$/;

        unless ($self->check_dns( $sender->host )) {
            return Qpsmtpd::DSN->temp_resolver_failed(
                "Could not resolve " . $sender->host );
        }

        return YIELD;
    }

    return DECLINED;
}

sub hook_mail_done {
    my ( $self, $transaction, $sender ) = @_;
    
    return DECLINED
      if ( $self->connection->notes('whitelisthost') );

    if ( $sender ne "<>" && !$transaction->notes('resolvable_fromhost') ) {
        # default of temp_resolver_failed is DENYSOFT
        return Qpsmtpd::DSN->temp_resolver_failed(
            "Could not resolve " . $sender->host );
    }
    return DECLINED;
}

sub check_dns {
    my ( $self, $host ) = @_;
    my @host_answers;

    my $qp = $self->qp;
    $qp->input_sock->pause_read;
    
    my $a_records = [];
    my $num_queries = 1;    # queries in progress
    my $mx_found = 0;

    ParaDNS->new(
        callback  => sub {
            my $mx = shift;
            return if $mx =~ /^[A-Z]+$/; # error

            my $addr = $mx->[0];
            $mx_found = 1;

            $num_queries++;
            ParaDNS->new(
                callback => sub { push @$a_records, $_[0] if $_[0] !~ /^[A-Z]+$/; },
                finished => sub { $num_queries--; $self->finish_up($qp, $a_records, $num_queries) },
                host     => $addr,
                type     => 'A',
            );

            if ($has_ipv6) {
                $num_queries++;
                ParaDNS->new(
                    callback => sub { push @$a_records, $_[0] if $_[0] !~ /^[A-Z]+$/; },
                    finished => sub { $num_queries--; $self->finish_up($qp, $a_records, $num_queries) },
                    host     => $addr,
                    type     => 'AAAA',
                );
            }
        },
        finished  => sub {

            unless ($mx_found) {

                $num_queries++;
                ParaDNS->new(
                    callback  => sub { push @$a_records, $_[0] if $_[0] !~ /^[A-Z]+$/; },
                    finished  => sub { $num_queries--; $self->finish_up($qp, $a_records, $num_queries) },
                    host      => $host,
                    type      => 'A',
                );

                if ($has_ipv6) {
                    $num_queries++;
                    ParaDNS->new(
                        callback  => sub { push @$a_records, $_[0] if $_[0] !~ /^[A-Z]+$/; },
                        finished  => sub { $num_queries--; $self->finish_up($qp, $a_records, $num_queries) },
                        host      => $host,
                        type      => 'AAAA',
                   );
                }

            }

            $num_queries--;
            $self->finish_up($qp, $a_records, $num_queries);
        },
        host      => $host,
        type      => 'MX',
    ) or $qp->input_sock->continue_read, return;

    return 1;
}

sub finish_up {
    my ($self, $qp, $a_records, $num_queries) = @_;

    return if defined $qp->transaction->notes('resolvable_fromhost');

    foreach my $addr (@$a_records) {
        if (is_valid($addr)) {
            $qp->transaction->notes('resolvable_fromhost', 1);
            $qp->input_sock->continue_read;
            $qp->run_continuation;
            return;
        }
    }
    
    unless ($num_queries) {
        # all queries returned no valid response
        $qp->transaction->notes('resolvable_fromhost', 0);
        $qp->input_sock->continue_read;
        $qp->run_continuation;
    }
}

sub is_valid {
    my $ip = shift;
    my ( $net, $mask );
    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;
}