qpsmtpd/t/plugin_tests/helo

#!perl -w

use strict;
use warnings;

use Qpsmtpd::Constants;

sub register_tests {
    my $self = shift;

    $self->register_test('test_init_resolver', 2);
    $self->register_test('test_is_in_badhelo', 2);
    $self->register_test('test_is_regex_match', 3);
    $self->register_test('test_invalid_localhost', 8);
    $self->register_test('test_is_plain_ip', 3);
    $self->register_test('test_is_address_literal', 3);
    $self->register_test('test_no_forward_dns', 2);
    $self->register_test('test_no_reverse_dns', 3);
    $self->register_test('test_no_matching_dns', 2);
    $self->register_test('test_helo_handler', 1);
    $self->register_test('test_check_ip_match', 6);
    $self->register_test('test_check_name_match', 3);
}

sub test_helo_handler {
    my $self = shift;

    cmp_ok( $self->helo_handler(undef, undef), '==', DECLINED, "empty host");
};

sub test_init_resolver {
    my $self = shift;
    my $net_dns = $self->init_resolver();
    ok( $net_dns, "net::dns" );
    cmp_ok( ref $net_dns, 'eq', 'Net::DNS::Resolver', "ref ok");
};

sub test_is_in_badhelo {
    my $self = shift;

    my ($err, $why) = $self->is_in_badhelo('yahoo.com');
    ok( $err, "yahoo.com, $why");

    ($err, $why) = $self->is_in_badhelo('example.com');
    ok( ! $err, "example.com");
};

sub test_is_regex_match {
    my $self = shift;

    my ($err, $why) = $self->is_regex_match('yahoo.com', 'ya.oo\.com$' );
    ok( $err, "yahoo.com, $why");

    ($err, $why) = $self->is_regex_match('yoda.com', 'ya.oo\.com$' );
    ok( ! $err, "yahoo.com");

    ($err, $why) = $self->is_regex_match('host-only', '!\.' );
    ok( $err, "negated pattern, $why");
};

sub test_invalid_localhost {
    my $self = shift;

    my ($err, $why);
    foreach my $ip ( undef, '', '192.0.99.5' ) {
        $self->qp->connection->remote_ip(undef);
        ($err, $why) = $self->invalid_localhost('localhost' );
        ok(!$err, "host: localhost, invalid remote ip");

        $self->qp->connection->remote_ip(undef);
        ($err, $why) = $self->invalid_localhost('not-localhost');
        ok($err, "host: not-localhost, invalid remote ip");
    };

    foreach my $ip (qw/ ::1 127.0.0.1 / ) {
        $self->qp->connection->remote_ip($ip);
        ($err, $why) = $self->invalid_localhost('not-localhost');
        ok( ! $err, "localhost, correct remote IP ($ip)");
    }
};

sub test_is_plain_ip {
    my $self = shift;

    my ($err, $why) = $self->is_plain_ip('1.0.0.0');
    ok( $err, "plain IP, $why");

    ($err, $why) = $self->is_plain_ip('254.254.254.254');
    ok( $err, "plain IP, $why");

    ($err, $why) = $self->is_plain_ip('[254.254.254.254]');
    ok( ! $err, "address literal");
};

sub test_is_address_literal {
    my $self = shift;

    my ($err, $why) = $self->is_address_literal('[1.0.0.0]');
    ok( $err, "plain IP, $why");

    ($err, $why) = $self->is_address_literal('[254.254.254.254]');
    ok( $err, "plain IP, $why");

    ($err, $why) = $self->is_address_literal('254.254.254.254');
    ok( ! $err, "address literal");
};

sub test_no_forward_dns {
    my $self = shift;

    my ($err, $why) = $self->no_forward_dns('perl.org');
    ok( ! $err, "perl.org");

    # reserved .test TLD: http://tools.ietf.org/html/rfc2606
    ($err, $why) = $self->no_forward_dns('perl.test');
    ok( $err, "perl.test");
};

sub test_no_reverse_dns {
    my $self = shift;

    my ($err, $why) = $self->no_reverse_dns('test-host', '192.0.2.0');
    ok( $err, "192.0.2.0, $why");

    ($err, $why) = $self->no_reverse_dns('test-host', '192.0.2.1');
    ok( $err, "192.0.2.1, $why");

    ($err, $why) = $self->no_reverse_dns('mail.theartfarm.com', '66.128.51.165');
    ok( ! $err, "66.128.51.165");
};

sub test_no_matching_dns {
    my $self = shift;

    $self->qp->connection->notes('helo_forward_match', undef);
    $self->qp->connection->notes('helo_reverse_match', undef);

    my ($err, $why) = $self->no_matching_dns('matt.test');
    ok( $err, "fail, $why");

    $self->qp->connection->notes('helo_forward_match', 1);
    ($err, $why) = $self->no_matching_dns('matt.test');
    ok( ! $err, "pass");
};

sub test_check_ip_match {
    my $self = shift;

    my @good_tests = (
        { ip => '192.0.2.1',   ip2 => '192.0.2.1',   r => 'exact'   },
        { ip => '192.0.2.1',   ip2 => '192.0.2.2',   r => 'network' },
        { ip => '2001:db8::1', ip2 => '2001:db8::1', r => 'exact'   },
        { ip => '2001:db8::1', ip2 => '2001:db8::2', r => 'network' },
    );

    my @bad_tests = (
        { ip => '192.0.2.1',   ip2 => '192.0.1.1',   r => 'miss'   },
        { ip => '2001:db8::1', ip2 => '2001:db7::1', r => 'miss'   },
    );

    foreach my $t ( @good_tests ) {
        $self->qp->connection->remote_ip($t->{ip});
        $self->connection->notes('helo_forward_match', 0);
        $self->check_ip_match($t->{ip2});
        ok( $self->connection->notes('helo_forward_match'), $t->{r});
    };

    foreach my $t ( @bad_tests ) {
        $self->qp->connection->remote_ip($t->{ip});

        $self->connection->notes('helo_forward_match', 0);
        $self->check_ip_match($t->{ip2});
        ok( ! $self->connection->notes('helo_forward_match'), $t->{r});
    };
};

sub test_check_name_match {
    my $self = shift;

    $self->connection->notes('helo_reverse_match', 0);
    $self->check_name_match('mx0.example.com', 'mx0.example.com');
    ok( $self->connection->notes('helo_reverse_match'), "exact");

    $self->connection->notes('helo_reverse_match', 0);
    $self->check_name_match('mx0.example.com', 'mx1.example.com');
    ok( $self->connection->notes('helo_reverse_match'), "domain");

    $self->connection->notes('helo_reverse_match', 0);
    $self->check_name_match('mx0.example.com', 'mx0.example.net');
    ok( ! $self->connection->notes('helo_reverse_match'), "domain");
};