#!perl -w use strict; use Data::Dumper; use POSIX qw(strftime); use Qpsmtpd::Address; use Qpsmtpd::Constants; my $test_email = 'matt@tnpi.net'; sub register_tests { my $self = shift; $self->register_test('test_get_organizational_domain', 2); $self->register_test("test_fetch_dmarc_record", 3); $self->register_test("test_discover_policy", 3); } sub setup_test_headers { my $self = shift; my $transaction = $self->qp->transaction; my $address = Qpsmtpd::Address->new( "<$test_email>" ); my $header = Mail::Header->new(Modify => 0, MailFrom => "COERCE"); my $now = strftime "%a %b %e %H:%M:%S %Y", localtime time; $transaction->sender($address); $transaction->header($header); $transaction->header->add('From', "<$test_email>"); $transaction->header->add('Date', $now ); $transaction->body_write( "test message body " ); $self->qp->connection->relay_client(0); }; sub test_fetch_dmarc_record { my $self = shift; foreach ( qw/ tnpi.net nictool.com / ) { my @matches = $self->fetch_dmarc_record($_); #warn Data::Dumper::Dumper(\@matches); cmp_ok( scalar @matches, '==', 1, 'fetch_dmarc_record'); }; foreach ( qw/ example.com / ) { my @matches = $self->fetch_dmarc_record($_); cmp_ok( scalar @matches, '==', 0, 'fetch_dmarc_record'); }; }; sub test_get_organizational_domain { my $self = shift; $self->setup_test_headers(); my $transaction = $self->qp->transaction; cmp_ok( $self->get_organizational_domain('test.www.tnpi.net'), 'eq', 'tnpi.net' ); cmp_ok( $self->get_organizational_domain('www.example.co.uk'), 'eq', 'example.co.uk' ) }; sub test_discover_policy { my $self = shift; $self->setup_test_headers(); my $transaction = $self->qp->transaction; ok( $self->discover_policy( $transaction ), 'discover_policy' ); };