Blob Blame History Raw
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.