qpsmtpd/plugins/async/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;
}