#!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 ) ); };