#!/usr/bin/perl -I../blib/lib
use strict;
use warnings;
use Test::RequiresInternet;
use Test::More tests => 19;
use Mail::DKIM::DkPolicy;
use Mail::DKIM::DkimPolicy;
use Mail::DKIM::AuthorDomainPolicy;
use Net::DNS::Resolver;
my $Resolver = Net::DNS::Resolver->new(
nameservers => [ '1.1.1.1', '8.8.8.8' ],
);
Mail::DKIM::DNS::resolver( $Resolver );
my $policy;
$policy = Mail::DKIM::DkPolicy->new();
ok( $policy, "new() works" );
$policy = Mail::DKIM::DkPolicy->parse( String => "o=~; t=y" );
ok( $policy, "parse() works" );
$policy = Mail::DKIM::DkPolicy->fetch(
Protocol => "dns",
Domain => "policy.test.authmilter.org"
);
ok( $policy, "fetch() works (requires DNS)" );
ok( !$policy->is_implied_default_policy, "not the default policy" );
$policy = Mail::DKIM::DkPolicy->parse( String => "" );
ok( $policy, "parse() works (no tags)" );
ok( !defined( $policy->note ), "note tag has default value" );
$policy->note("hi there");
ok( $policy->note eq "hi there", "note tag has been changed" );
ok( $policy->policy eq "~", "policy tag has default value" );
$policy->policy("-");
ok( $policy->policy eq "-", "policy tag has been changed" );
ok( !$policy->testing, "testing flag has default value" );
#$policy->testing(1);
#ok($policy->testing, "testing flag has been changed");
ok( $policy->as_string, "as_string() method is implemented" );
SKIP:
{
skip "these tests depend on local resolver behaviour and may fail unnecessarily", 5
unless ( $ENV{DNS_TESTS_NXDOMAIN} );
# Tests dependent on local DNS behaviour
$policy = Mail::DKIM::DkPolicy->fetch(
Protocol => "dns",
Sender => 'alfred@doesnotexist.test.authmilter.org.invalid',
);
ok( $policy, "fetch() returns policy for nonexistent domain" );
ok( $policy->is_implied_default_policy, "yep, it's the default policy" );
$policy = Mail::DKIM::AuthorDomainPolicy->fetch(
Protocol => "dns",
Domain => "nonexistent-subdomain.test.authmilter.org.invalid",
);
ok( $policy, "fetch() returns policy for nonexistent domain" );
ok( !$policy->is_implied_default_policy, "shouldn't be the default policy" );
ok( $policy->policy eq "NXDOMAIN", "got policy of NXDOMAIN" );
}
SKIP:
{
skip "test depends on specific DNS setup at test site", 1
unless ( $ENV{DNS_TESTS_BLACKHOLE_TIMEOUT} );
# Tests dependent on local DNS behaviour
$policy = eval {
Mail::DKIM::AuthorDomainPolicy->fetch(
Protocol => "dns",
Domain => "blackhole.authmilter.org",
);
};
my $E = $@;
print "# got error: $E" if $E;
ok( !$policy && $E && $E =~ /(timeout|timed? out)/,
"timeout error fetching policy" );
}
SKIP:
{
skip "test depends on specific DNS setup at test site", 1
unless ( $ENV{DNS_TESTS_BLACKHOLE_SERVFAIL} );
$policy = eval {
Mail::DKIM::AuthorDomainPolicy->fetch(
Protocol => "dns",
Domain => "blackhole.authmilter.org",
);
};
my $E = $@;
print "# got error: $E" if $E;
ok(
!$policy && $E && $E =~ /SERVFAIL/,
"SERVFAIL dns error fetching policy"
);
}
# test a policy record where _domainkey.DOMAIN gives a
# DNS error, but DOMAIN itself is valid
SKIP: {
skip "this test is currently failing", 1;
$policy = eval {
Mail::DKIM::AuthorDomainPolicy->fetch(
Protocol => "dns",
Domain => "blackhole2.authmilter.org",
);
};
my $E = $@;
print "# got error: $E" if $E;
ok(
!$policy && $E && $E =~ /SERVFAIL/,
"SERVFAIL dns error fetching policy"
);
}
#debug_policies(qw(yahoo.com hotmail.com gmail.com));
#debug_policies(qw(paypal.com ebay.com));
#debug_policies(qw(cisco.com sendmail.com));
sub debug_policies {
foreach my $domain (@_) {
print "# $domain:\n";
print "# DomainKeys: ";
my $policy = Mail::DKIM::DkPolicy->fetch(
Protocol => "dns",
Domain => $domain
);
if ( $policy->is_implied_default_policy ) {
print "no policy\n";
}
else {
print $policy->policy . " (";
print $policy->as_string . ")\n";
}
print "# DKIM: ";
$policy = Mail::DKIM::DkimPolicy->fetch(
Protocol => "dns",
Domain => $domain
);
if ( $policy->is_implied_default_policy ) {
print "no policy\n";
}
else {
print $policy->policy . " (";
print $policy->as_string . ")\n";
}
}
}