#!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', 4); $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', 2); $self->register_test('test_no_matching_dns', 4); $self->register_test('test_helo_handler', 1); } 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; $self->qp->connection->remote_ip(undef); my ($err, $why) = $self->invalid_localhost('localhost' ); ok( $err, "localhost, undefined remote IP: $why"); $self->qp->connection->remote_ip(''); ($err, $why) = $self->invalid_localhost('localhost' ); ok( $err, "localhost, empty remote IP: $why"); $self->qp->connection->remote_ip('192.0.99.5'); ($err, $why) = $self->invalid_localhost('localhost'); ok( $err, "localhost, invalid remote IP: $why"); $self->qp->connection->remote_ip('127.0.0.1'); ($err, $why) = $self->invalid_localhost('localhost'); ok( ! $err, "localhost, correct remote IP"); }; sub test_is_plain_ip { my $self = shift; my ($err, $why) = $self->is_plain_ip('0.0.0.0'); ok( $err, "plain IP, $why"); ($err, $why) = $self->is_plain_ip('255.255.255.255'); ok( $err, "plain IP, $why"); ($err, $why) = $self->is_plain_ip('[255.255.255.255]'); ok( ! $err, "address literal"); }; sub test_is_address_literal { my $self = shift; my ($err, $why) = $self->is_address_literal('[0.0.0.0]'); ok( $err, "plain IP, $why"); ($err, $why) = $self->is_address_literal('[255.255.255.255]'); ok( $err, "plain IP, $why"); ($err, $why) = $self->is_address_literal('255.255.255.255'); 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.org.test'); ok( $err, "test.perl.org.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', '208.75.177.101'); ok( ! $err, "208.75.177.101"); }; 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"); };