use Test::More;
use Error ':try';
use Mail::SPF;
use Net::DNS::Resolver::Programmable;
use constant TRUE => (0 == 0);
use constant FALSE => not TRUE;
sub run_spf_test_suite_file {
my ($file_name, $test_case_overrides) = @_;
$test_case_overrides ||= {};
#### Load Test Suite Data and Plan Tests ####
my $test_suite = Mail::SPF::Test->new_from_yaml_file($file_name);
defined($test_suite)
or BAIL_OUT("Unable to load test-suite data from file '$file_name'");
my $total_test_cases_count = 0;
$total_test_cases_count += scalar($_->test_cases) foreach $test_suite->scenarios;
plan(tests => $total_test_cases_count * 2);
#### Perform Tests ####
foreach my $scenario ($test_suite->scenarios) {
my $server = Mail::SPF::Server->new(
dns_resolver => Net::DNS::Resolver::Programmable->new(
resolver_code => sub {
my ($domain, $rr_type) = @_;
my $rcode = 'NOERROR';
my @rrs;
push(@rrs, $scenario->records_for_domain($domain, $rr_type));
push(@rrs, $scenario->records_for_domain($domain, 'CNAME'))
if not @rrs and $rr_type ne 'CNAME';
if (@rrs == 0) {
$rcode = 'NXDOMAIN';
}
elsif ($rrs[0] eq 'TIMEOUT') {
return 'query timed out';
}
return ($rcode, undef, @rrs);
}
),
default_authority_explanation => 'DEFAULT'
);
foreach my $test_case ($scenario->test_cases) { SKIP: {
my $test_base_name = sprintf("Test case '%s'", $test_case->name);
if (defined(my $test_case_override = $test_case_overrides->{$test_case->name})) {
if ($test_case_override =~ /^SKIP(?:: (.*))/) {
skip(
"Skipping test '" . $test_case->name . "' due to override" .
(defined($1) ? " ($1)" : ""),
2
);
}
}
my $request = Mail::SPF::Request->new(
scope => $test_case->scope,
identity => $test_case->identity,
ip_address => $test_case->ip_address,
helo_identity => $test_case->helo_identity
);
my $result;
try {
$result = $server->process($request);
}
catch Error with {
BAIL_OUT("Uncaught error: ", shift->stacktrace);
};
my $overall_ok = TRUE;
# Test result code:
my $result_is_ok = $test_case->is_expected_result($result->code);
diag(
"$test_base_name result:\n" .
"Expected: " . join(' or ', map("'$_'", $test_case->expected_results)) . "\n" .
" Got: " . "'" . $result->code . "'"
)
if not $result_is_ok;
$overall_ok &&= ok($result_is_ok, "$test_base_name result");
# Test explanation:
if (not $result->is_code('fail')) {
pass("$test_base_name explanation not applicable");
}
elsif (not defined($test_case->expected_explanation)) {
pass("$test_base_name explanation not relevant");
}
else {
$overall_ok &&= is(
lc($result->authority_explanation),
lc($test_case->expected_explanation),
"$test_base_name explanation"
);
}
diag("Test case description: " . $test_case->description)
if not $overall_ok and defined($test_case->description);
} }
}
return;
}
TRUE;
syntax highlighted by Code2HTML, v. 0.9.1