#!/usr/bin/perl -I../blib/lib use strict; use warnings; use Test::More tests => 19; use Mail::DKIM::DkPolicy; use Mail::DKIM::DkimPolicy; use Mail::DKIM::AuthorDomainPolicy; 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 => "messiah.edu"); 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"); $policy = Mail::DKIM::DkPolicy->fetch( Protocol => "dns", Sender => 'alfred@nobody.messiah.edu', ); 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.messiah.edu", ); 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 "these tests fail when run on the other side of my firewall", 3 unless ($ENV{DNS_TESTS} && $ENV{DNS_TESTS} > 1); $policy = eval { Mail::DKIM::AuthorDomainPolicy->fetch( Protocol => "dns", Domain => "blackhole.messiah.edu", ) }; my $E = $@; print "# got error: $E" if $E; ok(!$policy && $E && $E =~ /(timeout|timed? out)/, "timeout error fetching policy"); $policy = eval { Mail::DKIM::AuthorDomainPolicy->fetch( Protocol => "dns", Domain => "blackhole2.messiah.edu", ) }; $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 $policy = eval { Mail::DKIM::AuthorDomainPolicy->fetch( Protocol => "dns", Domain => "blackhole3.messiah.edu", ) }; $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"; } } }