The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/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";
        }
    }
}