#!/usr/bin/perl -w

use Qpsmtpd::DSN;
use ParaDNS;
use Socket;

my %invalid  = ();
my $has_ipv6 = Qpsmtpd::Constants::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;
        }
    }

    $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->qp->connection->notes('whitelistclient') );

    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" );
        }
        
        $self->check_dns( $sender->host );
        return YIELD;
    }
    
    return DECLINED;
}

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

    if (!$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;

    return if $host =~ m/^\[(\d{1,3}\.){3}\d{1,3}\]$/;

    my $qp = $self->qp;
    
    my $a_records = [];
    my $num_queries = $has_ipv6 ? 2 : 1;
    ParaDNS->new(
        callback  => sub {
            my $mx = shift;
            return if $mx =~ /^[A-Z]+$/; # error
            my $addr = $mx->[0];
            $num_queries++;
            ParaDNS->new(
                callback => sub { push @$a_records, $_[0] if $_[0] !~ /^[A-Z]+$/; },
                finished => sub { $num_queries--; $self->finish_up($qp, $a_records) unless $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) unless $num_queries; },
                    host     => $addr,
                    type     => 'AAAA',
                );
            }
        },
        host      => $host,
        type      => 'MX',
    );
    ParaDNS->new(
        callback  => sub { push @$a_records, $_[0] if $_[0] !~ /^[A-Z]+$/; },
        finished  => sub { $num_queries--; $self->finish_up($qp, $a_records) unless $num_queries },
        host      => $host,
        type      => 'A',
    );
    ParaDNS->new(
        callback  => sub { push @$a_records, $_[0] if $_[0] !~ /^[A-Z]+$/; },
        finished  => sub { $num_queries--; $self->finish_up($qp, $a_records) unless $num_queries },
        host      => $host,
        type      => 'AAAA',
    ) if $has_ipv6;
}

sub finish_up {
    my ($self, $qp, $a_records) = @_;
    
    foreach my $addr (@$a_records) {
        if (is_valid($addr)) {
            $qp->transaction->notes('resolvable_fromhost', 1);
            last;
        }
    }
    
    $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;
}

# vim: ts=4 sw=4 expandtab syn=perl