qpsmtpd/t/plugin_tests/require_resolvable_fromhost

#!perl -w

use strict;
use warnings;

use Data::Dumper;
use Net::DNS;
use Qpsmtpd::Address;
use Qpsmtpd::Constants;

my $res = new Net::DNS::Resolver(dnsrch => 0);
my $test_email = 'user@example.com';

sub register_tests {
    my $self = shift;

    my %args = ( );
    $self->register( $self->qp, reject => 0 );

    $self->register_test('test_is_immune', 3);
    $self->register_test('test_populate_invalid_networks', 2);
    $self->register_test('test_mx_address_resolves', 2);
    $self->register_test('test_get_host_records', 2);
    $self->register_test('test_get_and_validate_mx', 2);
    $self->register_test('test_check_dns', 2);
    $self->register_test('test_hook_rcpt', 10);
    $self->register_test('test_hook_mail', 4);
}

sub test_hook_mail {
    my $self = shift;

    my $transaction = $self->qp->transaction;
    my $address = Qpsmtpd::Address->new('remote@example.com');
    $transaction->sender($address);

    my $sender = $transaction->sender;
    $sender->host('perl.com');

    ok( $self->hook_mail( $transaction, $sender ) );
    ok( $self->hook_mail( $transaction, $sender ) );

    $sender->host('');
    $self->{_args}{reject} = 1;
    $self->{_args}{reject_type} = 'soft';
    my ($r) = $self->hook_mail( $transaction, $sender );
    ok( $r == DENYSOFT, "($r)");

    $self->{_args}{reject_type} = 'hard';
    ($r) = $self->hook_mail( $transaction, $sender );
    ok( $r == DENY, "($r)");
};

sub test_hook_rcpt {
    my $self = shift;

    my $transaction = $self->qp->transaction;
    my $recipient = 'foo@example.com';

    $transaction->notes('resolvable_fromhost', 'a');
    ok( DECLINED == $self->hook_rcpt( $transaction, $recipient ) );

    $transaction->notes('resolvable_fromhost', 'mx');
    ok( DECLINED == $self->hook_rcpt( $transaction, $recipient ) );

    $transaction->notes('resolvable_fromhost', 'ip');
    ok( DECLINED == $self->hook_rcpt( $transaction, $recipient ) );

    $transaction->notes('resolvable_fromhost', 'whitelist');
    ok( DECLINED == $self->hook_rcpt( $transaction, $recipient ) );

    $transaction->notes('resolvable_fromhost', 'null');
    ok( DECLINED == $self->hook_rcpt( $transaction, $recipient ) );

    $transaction->notes('resolvable_fromhost', 'config');
    ok( DECLINED == $self->hook_rcpt( $transaction, $recipient ) );

    $transaction->notes('resolvable_fromhost', 'oops!');
    ok( DECLINED == $self->hook_rcpt( $transaction, $recipient ) );

    $transaction->notes('resolvable_fromhost', 'oops!');
    ok( DECLINED == $self->hook_rcpt( $transaction, $recipient ) );

    $transaction->notes('resolvable_fromhost', 'oops!');
    $self->{_args}{reject} = 1;
    $self->{_args}{reject_type} = 'soft';
    my ($r) = $self->hook_rcpt( $transaction, $recipient );
    ok( DENYSOFT == $r, "($r)");

    $transaction->notes('resolvable_fromhost', 'failed again');
    $self->{_args}{reject_type} = 'hard';
    ($r) = $self->hook_rcpt( $transaction, $recipient );
    ok( DENY == $r, "($r)");
};

sub test_check_dns {
    my $self = shift;

    my $transaction = $self->qp->transaction;
    ok( ! $self->check_dns( '', $transaction ) );
    ok( $self->check_dns( 'perl.com', $transaction ) );
}

sub test_get_and_validate_mx {
    my $self = shift;
    my $transaction = $self->qp->transaction;

    ok( scalar $self->get_and_validate_mx( $res, 'perl.com', $transaction ) );

    ok( ! scalar $self->get_host_records( $res, 'fake-domain-name-for-test.com', $transaction ) );
};

sub test_get_host_records {
    my $self = shift;
    my $transaction = $self->qp->transaction;

    ok( scalar $self->get_host_records( $res, 'perl.com', $transaction ) );
    ok( ! scalar $self->get_host_records( $res, 'fake-domain-name-for-test.com', $transaction ) );
};

sub test_mx_address_resolves {
    my $self = shift;

    my $fromhost = 'perl.com';

    ok( $self->mx_address_resolves('mail.perl.com', $fromhost) );
    ok( ! $self->mx_address_resolves('no-such-mx.perl.com', $fromhost) );
};

sub test_populate_invalid_networks {
    my $self = shift;

    my $ip = '10.9.8.7';
    ok( $self->ip_is_valid($ip) );

    $self->qp->config('invalid_resolvable_fromhost', $ip);
    $self->populate_invalid_networks();
    ok( ! $self->ip_is_valid($ip) );

    # clean up afterwards
    $self->qp->config('invalid_resolvable_fromhost', undef );
    $self->{invalid} = ();
};

sub test_is_immune {
    my $self = shift;

    my $transaction = $self->qp->transaction;

    # null sender should be immune
    $transaction->sender('<>');
    ok( $self->is_immune( $transaction->sender, $transaction ) );

    # whitelisted host should be immune
    my $connection = $self->qp->connection->notes('whitelisthost', 1);
    ok( $self->is_immune( $transaction->sender, $transaction ) );
    $self->qp->connection->notes('whitelisthost', undef);

    # reject is not defined, so email should not be immune
    my $address = Qpsmtpd::Address->new( "<$test_email>" );
    $transaction->sender($address);
    ok( ! $self->is_immune( $transaction->sender, $transaction ) );
};