1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
|
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.
|
