#!perl -w

use strict;
use warnings;

use Qpsmtpd::Constants;

sub register_tests {
    my $self = shift;

    $self->register_test('test_is_in_badhelo');
    $self->register_test('test_is_regex_match');
    $self->register_test('test_invalid_localhost');
    $self->register_test('test_is_plain_ip');
    $self->register_test('test_is_address_literal');
    $self->register_test('test_no_forward_dns');
    $self->register_test('test_no_reverse_dns');
    $self->register_test('test_no_matching_dns');
    $self->register_test('test_helo_handler');
    $self->register_test('test_check_ip_match');
    $self->register_test('test_check_name_match');
}

sub test_helo_handler {
    my $self = shift;
    cmp_ok( $self->helo_handler(undef, undef), '==', DECLINED, "empty host");
}

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, remote ip ($ip)");

        $self->qp->connection->remote_ip(undef);
        ($err, $why) = $self->invalid_localhost('not-localhost');
        ok(! $err, "host: not-localhost, remote ip ($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");
}