use strict;
use warnings;
use blib;
use Error ':try';
use Net::DNS::Resolver::Programmable;
use Net::DNS::RR;
use Test::More tests => 23;
my $test_resolver_empty = Net::DNS::Resolver::Programmable->new(
records => {}
);
my $test_resolver_1 = Net::DNS::Resolver::Programmable->new(
records => {
'example.com' => [
Net::DNS::RR->new('example.com. A 192.168.0.1')
]
}
);
my $test_resolver_nxdomain = Net::DNS::Resolver::Programmable->new(
resolver_code => sub { return ('NXDOMAIN', undef) }
);
my $test_resolver_servfail = Net::DNS::Resolver::Programmable->new(
resolver_code => sub { return ('SERVFAIL', undef) }
);
#### Class Compilation ####
BEGIN { use_ok('Mail::SPF::Server') }
#### Basic Instantiation ####
{
my $server = eval { Mail::SPF::Server->new(
dns_resolver => $test_resolver_empty,
max_dns_interactive_terms => 1,
max_name_lookups_per_term => 2,
max_name_lookups_per_mx_mech => 3
) };
$@ eq '' and isa_ok($server, 'Mail::SPF::Server', 'Basic server object')
or BAIL_OUT("Basic server instantiation failed: $@");
# Have options been interpreted correctly?
isa_ok($server->dns_resolver, 'Net::DNS::Resolver::Programmable', 'Basic server dns_resolver()');
is($server->max_dns_interactive_terms, 1, 'Basic server max_dns_interactive_terms()');
is($server->max_name_lookups_per_term, 2, 'Basic server max_name_lookups_per_term()');
is($server->max_name_lookups_per_mx_mech, 3, 'Basic server max_name_lookups_per_mx_mech()');
is($server->max_name_lookups_per_ptr_mech, 2, 'Basic server fallback max_name_lookups_per_ptr_mech()');
}
#### Minimally Parameterized Server ####
{
my $server = eval { Mail::SPF::Server->new() };
$@ eq '' and isa_ok($server, 'Mail::SPF::Server', 'Minimal server object')
or BAIL_OUT("Minimal server instantiation failed: $@");
# Have omitted options been defaulted correctly?
isa_ok($server->dns_resolver, 'Net::DNS::Resolver', 'Minimal server default dns_resolver()');
is($server->max_dns_interactive_terms, 10, 'Minimal server default max_dns_interactive_terms()');
is($server->max_name_lookups_per_term, 10, 'Minimal server default max_name_lookups_per_term()');
is($server->max_name_lookups_per_mx_mech, 10, 'Minimal server default max_name_lookups_per_mx_mech()');
is($server->max_name_lookups_per_ptr_mech, 10, 'Minimal server default max_name_lookups_per_ptr_mech()');
}
#### dns_lookup() ####
# No-records lookup:
{
my $server = Mail::SPF::Server->new(
dns_resolver => $test_resolver_empty
);
my $packet = $server->dns_lookup('example.com', 'A');
isa_ok($packet, 'Net::DNS::Packet', 'Server no-records dns_lookup() packet object');
is($packet->header->rcode, 'NOERROR', 'Server no-records dns_lookup() rcode');
is($packet->answer, 0, 'Server no-records dns_lookup() answer RR count');
}
# 'A' record lookup:
{
my $server = Mail::SPF::Server->new(
dns_resolver => $test_resolver_1
);
my $packet = $server->dns_lookup('example.com', 'A');
isa_ok($packet, 'Net::DNS::Packet', 'Server "A" dns_lookup() packet object');
my @rrs = $packet->answer;
is($rrs[0]->name, 'example.com', 'Server "A" dns_lookup() answer domain name');
is($rrs[0]->type, 'A', 'Server "A" dns_lookup() answer RR type');
}
# NXDOMAIN lookup:
{
my $server = Mail::SPF::Server->new(
dns_resolver => $test_resolver_nxdomain
);
my $packet = $server->dns_lookup('example.com', 'A');
isa_ok($packet, 'Net::DNS::Packet', 'Server NXDOMAIN dns_lookup() packet object');
is($packet->header->rcode, 'NXDOMAIN', 'Server NXDOMAIN dns_lookup() rcode');
is($packet->answer, 0, 'Server NXDOMAIN dns_lookup() answer RR count');
}
# SERVFAIL lookup:
{
my $server = Mail::SPF::Server->new(
dns_resolver => $test_resolver_servfail
);
my $packet = eval { $server->dns_lookup('example.com', 'A') };
isa_ok($@, 'Mail::SPF::EDNSError', 'Server SERVFAIL dns_lookup()');
}
#### SPF Record Selection / select_record(), get_acceptable_records_from_packet() ####
# This gets checked by the RFC 4408 test suite.