1107 lines
36 KiB
Perl
1107 lines
36 KiB
Perl
|
package Zonemaster::Engine::Test::Delegation;
|
||
|
|
|
||
|
|
use v5.16.0;
|
||
|
|
use warnings;
|
||
|
|
|
||
|
|
use version; our $VERSION = version->declare("v1.0.20");
|
||
|
|
|
||
|
|
use List::MoreUtils qw[uniq];
|
||
|
|
use Locale::TextDomain qw[Zonemaster-Engine];
|
||
|
|
use Readonly;
|
||
|
|
|
||
|
|
use Zonemaster::Engine::Profile;
|
||
|
|
use Zonemaster::Engine::Recursor;
|
||
|
|
use Zonemaster::Engine::Constants ':all';
|
||
|
|
use Zonemaster::Engine::Test::Address;
|
||
|
|
use Zonemaster::Engine::Test::Syntax;
|
||
|
|
use Zonemaster::Engine::TestMethods;
|
||
|
|
use Zonemaster::Engine::Util;
|
||
|
|
use Zonemaster::LDNS::Packet;
|
||
|
|
use Zonemaster::LDNS::RR;
|
||
|
|
|
||
|
|
=head1 NAME
|
||
|
|
|
||
|
|
Zonemaster::Engine::Test::Delegation - Module implementing tests focused on zone delegation
|
||
|
|
|
||
|
|
=head1 SYNOPSIS
|
||
|
|
|
||
|
|
my @results = Zonemaster::Engine::Test::Delegation->all( $zone );
|
||
|
|
|
||
|
|
=head1 METHODS
|
||
|
|
|
||
|
|
=over
|
||
|
|
|
||
|
|
=item all()
|
||
|
|
|
||
|
|
my @logentry_array = all( $zone );
|
||
|
|
|
||
|
|
Runs the default set of tests for that module, i.e. L<seven tests|/TESTS>.
|
||
|
|
|
||
|
|
Takes a L<Zonemaster::Engine::Zone> object.
|
||
|
|
|
||
|
|
Returns a list of L<Zonemaster::Engine::Logger::Entry> objects.
|
||
|
|
|
||
|
|
=back
|
||
|
|
|
||
|
|
=cut
|
||
|
|
|
||
|
|
sub all {
|
||
|
|
my ( $class, $zone ) = @_;
|
||
|
|
my @results;
|
||
|
|
|
||
|
|
push @results, $class->delegation01( $zone ) if Zonemaster::Engine::Util::should_run_test( q{delegation01} );
|
||
|
|
push @results, $class->delegation02( $zone ) if Zonemaster::Engine::Util::should_run_test( q{delegation02} );
|
||
|
|
push @results, $class->delegation03( $zone ) if Zonemaster::Engine::Util::should_run_test( q{delegation03} );
|
||
|
|
push @results, $class->delegation04( $zone ) if Zonemaster::Engine::Util::should_run_test( q{delegation04} );
|
||
|
|
push @results, $class->delegation05( $zone ) if Zonemaster::Engine::Util::should_run_test( q{delegation05} );
|
||
|
|
push @results, $class->delegation06( $zone ) if Zonemaster::Engine::Util::should_run_test( q{delegation06} );
|
||
|
|
push @results, $class->delegation07( $zone ) if Zonemaster::Engine::Util::should_run_test( q{delegation07} );
|
||
|
|
|
||
|
|
return @results;
|
||
|
|
}
|
||
|
|
|
||
|
|
=over
|
||
|
|
|
||
|
|
=item metadata()
|
||
|
|
|
||
|
|
my $hash_ref = metadata();
|
||
|
|
|
||
|
|
Returns a reference to a hash, the keys of which are the names of all Test Cases in the module, and the corresponding values are references to
|
||
|
|
an array containing all the message tags that the Test Case can use in L<log entries|Zonemaster::Engine::Logger::Entry>.
|
||
|
|
|
||
|
|
=back
|
||
|
|
|
||
|
|
=cut
|
||
|
|
|
||
|
|
sub metadata {
|
||
|
|
my ( $class ) = @_;
|
||
|
|
|
||
|
|
return {
|
||
|
|
delegation01 => [
|
||
|
|
qw(
|
||
|
|
ENOUGH_NS_CHILD
|
||
|
|
ENOUGH_NS_DEL
|
||
|
|
NOT_ENOUGH_NS_DEL
|
||
|
|
NOT_ENOUGH_NS_CHILD
|
||
|
|
ENOUGH_IPV4_NS_CHILD
|
||
|
|
ENOUGH_IPV4_NS_DEL
|
||
|
|
ENOUGH_IPV6_NS_CHILD
|
||
|
|
ENOUGH_IPV6_NS_DEL
|
||
|
|
NOT_ENOUGH_IPV4_NS_CHILD
|
||
|
|
NOT_ENOUGH_IPV4_NS_DEL
|
||
|
|
NOT_ENOUGH_IPV6_NS_CHILD
|
||
|
|
NOT_ENOUGH_IPV6_NS_DEL
|
||
|
|
NO_IPV4_NS_CHILD
|
||
|
|
NO_IPV4_NS_DEL
|
||
|
|
NO_IPV6_NS_CHILD
|
||
|
|
NO_IPV6_NS_DEL
|
||
|
|
TEST_CASE_END
|
||
|
|
TEST_CASE_START
|
||
|
|
)
|
||
|
|
],
|
||
|
|
delegation02 => [
|
||
|
|
qw(
|
||
|
|
CHILD_DISTINCT_NS_IP
|
||
|
|
CHILD_NS_SAME_IP
|
||
|
|
DEL_DISTINCT_NS_IP
|
||
|
|
DEL_NS_SAME_IP
|
||
|
|
SAME_IP_ADDRESS
|
||
|
|
DISTINCT_IP_ADDRESS
|
||
|
|
TEST_CASE_END
|
||
|
|
TEST_CASE_START
|
||
|
|
)
|
||
|
|
],
|
||
|
|
delegation03 => [
|
||
|
|
qw(
|
||
|
|
REFERRAL_SIZE_TOO_LARGE
|
||
|
|
REFERRAL_SIZE_OK
|
||
|
|
TEST_CASE_END
|
||
|
|
TEST_CASE_START
|
||
|
|
)
|
||
|
|
],
|
||
|
|
delegation04 => [
|
||
|
|
qw(
|
||
|
|
IS_NOT_AUTHORITATIVE
|
||
|
|
IPV4_DISABLED
|
||
|
|
IPV6_DISABLED
|
||
|
|
ARE_AUTHORITATIVE
|
||
|
|
TEST_CASE_END
|
||
|
|
TEST_CASE_START
|
||
|
|
)
|
||
|
|
],
|
||
|
|
delegation05 => [
|
||
|
|
qw(
|
||
|
|
NO_NS_CNAME
|
||
|
|
NO_RESPONSE
|
||
|
|
NS_IS_CNAME
|
||
|
|
UNEXPECTED_RCODE
|
||
|
|
TEST_CASE_END
|
||
|
|
TEST_CASE_START
|
||
|
|
)
|
||
|
|
],
|
||
|
|
delegation06 => [
|
||
|
|
qw(
|
||
|
|
SOA_NOT_EXISTS
|
||
|
|
SOA_EXISTS
|
||
|
|
IPV4_DISABLED
|
||
|
|
IPV6_DISABLED
|
||
|
|
TEST_CASE_END
|
||
|
|
TEST_CASE_START
|
||
|
|
)
|
||
|
|
],
|
||
|
|
delegation07 => [
|
||
|
|
qw(
|
||
|
|
EXTRA_NAME_PARENT
|
||
|
|
EXTRA_NAME_CHILD
|
||
|
|
TOTAL_NAME_MISMATCH
|
||
|
|
NAMES_MATCH
|
||
|
|
TEST_CASE_END
|
||
|
|
TEST_CASE_START
|
||
|
|
)
|
||
|
|
],
|
||
|
|
};
|
||
|
|
} ## end sub metadata
|
||
|
|
|
||
|
|
Readonly my %TAG_DESCRIPTIONS => (
|
||
|
|
DELEGATION01 => sub {
|
||
|
|
__x # DELEGATION:DELEGATION01
|
||
|
|
"Minimum number of name servers";
|
||
|
|
},
|
||
|
|
DELEGATION02 => sub {
|
||
|
|
__x # DELEGATION:DELEGATION02
|
||
|
|
"Name servers must have distinct IP addresses";
|
||
|
|
},
|
||
|
|
DELEGATION03 => sub {
|
||
|
|
__x # DELEGATION:DELEGATION03
|
||
|
|
"No truncation of referrals";
|
||
|
|
},
|
||
|
|
DELEGATION04 => sub {
|
||
|
|
__x # DELEGATION:DELEGATION04
|
||
|
|
"Name server is authoritative";
|
||
|
|
},
|
||
|
|
DELEGATION05 => sub {
|
||
|
|
__x # DELEGATION:DELEGATION05
|
||
|
|
"Name server must not point at CNAME alias";
|
||
|
|
},
|
||
|
|
DELEGATION06 => sub {
|
||
|
|
__x # DELEGATION:DELEGATION06
|
||
|
|
"Existence of SOA";
|
||
|
|
},
|
||
|
|
DELEGATION07 => sub {
|
||
|
|
__x # DELEGATION:DELEGATION07
|
||
|
|
"Parent glue name records present in child";
|
||
|
|
},
|
||
|
|
ARE_AUTHORITATIVE => sub {
|
||
|
|
__x # DELEGATION:ARE_AUTHORITATIVE
|
||
|
|
"All these nameservers are confirmed to be authoritative : {nsname_list}.", @_;
|
||
|
|
},
|
||
|
|
CHILD_DISTINCT_NS_IP => sub {
|
||
|
|
__x # DELEGATION:CHILD_DISTINCT_NS_IP
|
||
|
|
"All the IP addresses used by the nameservers in child are unique.", @_;
|
||
|
|
},
|
||
|
|
CHILD_NS_SAME_IP => sub {
|
||
|
|
__x # DELEGATION:CHILD_NS_SAME_IP
|
||
|
|
"IP {ns_ip} in child refers to multiple nameservers ({nsname_list}).", @_;
|
||
|
|
},
|
||
|
|
DEL_DISTINCT_NS_IP => sub {
|
||
|
|
__x # DELEGATION:DEL_DISTINCT_NS_IP
|
||
|
|
"All the IP addresses used by the nameservers in parent are unique.", @_;
|
||
|
|
},
|
||
|
|
DEL_NS_SAME_IP => sub {
|
||
|
|
__x # DELEGATION:DEL_NS_SAME_IP
|
||
|
|
"IP {ns_ip} in parent refers to multiple nameservers ({nsname_list}).", @_;
|
||
|
|
},
|
||
|
|
DISTINCT_IP_ADDRESS => sub {
|
||
|
|
__x # DELEGATION:DISTINCT_IP_ADDRESS
|
||
|
|
"All the IP addresses used by the nameservers are unique.", @_;
|
||
|
|
},
|
||
|
|
ENOUGH_IPV4_NS_CHILD => sub {
|
||
|
|
__x # DELEGATION:ENOUGH_IPV4_NS_CHILD
|
||
|
|
"Child lists enough ({count}) nameservers that resolve to IPv4 "
|
||
|
|
. "addresses. Lower limit set to {minimum}. Name servers: {ns_list}",
|
||
|
|
@_;
|
||
|
|
},
|
||
|
|
ENOUGH_IPV4_NS_DEL => sub {
|
||
|
|
__x # DELEGATION:ENOUGH_IPV4_NS_DEL
|
||
|
|
"Delegation lists enough ({count}) nameservers that resolve to IPv4 "
|
||
|
|
. "addresses. Lower limit set to {minimum}. Name servers: {ns_list}",
|
||
|
|
@_;
|
||
|
|
},
|
||
|
|
ENOUGH_IPV6_NS_CHILD => sub {
|
||
|
|
__x # DELEGATION:ENOUGH_IPV6_NS_CHILD
|
||
|
|
"Child lists enough ({count}) nameservers that resolve to IPv6 "
|
||
|
|
. "addresses. Lower limit set to {minimum}. Name servers: {ns_list}",
|
||
|
|
@_;
|
||
|
|
},
|
||
|
|
ENOUGH_IPV6_NS_DEL => sub {
|
||
|
|
__x # DELEGATION:ENOUGH_IPV6_NS_DEL
|
||
|
|
"Delegation lists enough ({count}) nameservers that resolve to IPv6 "
|
||
|
|
. "addresses. Lower limit set to {minimum}. Name servers: {ns_list}",
|
||
|
|
@_;
|
||
|
|
},
|
||
|
|
ENOUGH_NS_CHILD => sub {
|
||
|
|
__x # DELEGATION:ENOUGH_NS_CHILD
|
||
|
|
"Child lists enough ({count}) nameservers. Lower limit set to {minimum}. Name servers: {nsname_list}", @_;
|
||
|
|
},
|
||
|
|
ENOUGH_NS_DEL => sub {
|
||
|
|
__x # DELEGATION:ENOUGH_NS_DEL
|
||
|
|
"Delegation lists enough ({count}) nameservers. Lower limit set to {minimum}. Name servers: {nsname_list}", @_;
|
||
|
|
},
|
||
|
|
EXTRA_NAME_CHILD => sub {
|
||
|
|
__x # DELEGATION:EXTRA_NAME_CHILD
|
||
|
|
"Child has nameserver(s) not listed at parent ({extra}).", @_;
|
||
|
|
},
|
||
|
|
EXTRA_NAME_PARENT => sub {
|
||
|
|
__x # DELEGATION:EXTRA_NAME_PARENT
|
||
|
|
"Parent has nameserver(s) not listed at the child ({extra}).", @_;
|
||
|
|
},
|
||
|
|
IPV4_DISABLED => sub {
|
||
|
|
__x # DELEGATION:IPV4_DISABLED
|
||
|
|
'IPv4 is disabled, not sending "{rrtype}" query to {ns}.', @_;
|
||
|
|
},
|
||
|
|
IPV6_DISABLED => sub {
|
||
|
|
__x # DELEGATION:IPV6_DISABLED
|
||
|
|
'IPv6 is disabled, not sending "{rrtype}" query to {ns}.', @_;
|
||
|
|
},
|
||
|
|
IS_NOT_AUTHORITATIVE => sub {
|
||
|
|
__x # DELEGATION:IS_NOT_AUTHORITATIVE
|
||
|
|
"Nameserver {ns} response is not authoritative on {proto} port 53.", @_;
|
||
|
|
},
|
||
|
|
NAMES_MATCH => sub {
|
||
|
|
__x # DELEGATION:NAMES_MATCH
|
||
|
|
"All of the nameserver names are listed both at parent and child.", @_;
|
||
|
|
},
|
||
|
|
NO_RESPONSE => sub {
|
||
|
|
__x # DELEGATION:NO_RESPONSE
|
||
|
|
'Nameserver {ns} did not respond to a query for name {query_name} and type {rrtype}.', @_;
|
||
|
|
},
|
||
|
|
NOT_ENOUGH_IPV4_NS_CHILD => sub {
|
||
|
|
__x # DELEGATION:NOT_ENOUGH_IPV4_NS_CHILD
|
||
|
|
"Child does not list enough ({count}) nameservers that resolve to IPv4 "
|
||
|
|
. "addresses. Lower limit set to {minimum}. Name servers: {ns_list}",
|
||
|
|
@_;
|
||
|
|
},
|
||
|
|
NOT_ENOUGH_IPV4_NS_DEL => sub {
|
||
|
|
__x # DELEGATION:NOT_ENOUGH_IPV4_NS_DEL
|
||
|
|
"Delegation does not list enough ({count}) nameservers that resolve to IPv4 "
|
||
|
|
. "addresses. Lower limit set to {minimum}. Name servers: {ns_list}",
|
||
|
|
@_;
|
||
|
|
},
|
||
|
|
NOT_ENOUGH_IPV6_NS_CHILD => sub {
|
||
|
|
__x # DELEGATION:NOT_ENOUGH_IPV6_NS_CHILD
|
||
|
|
"Child does not list enough ({count}) nameservers that resolve to IPv6 "
|
||
|
|
. "addresses. Lower limit set to {minimum}. Name servers: {ns_list}",
|
||
|
|
@_;
|
||
|
|
},
|
||
|
|
NOT_ENOUGH_IPV6_NS_DEL => sub {
|
||
|
|
__x # DELEGATION:NOT_ENOUGH_IPV6_NS_DEL
|
||
|
|
"Delegation does not list enough ({count}) nameservers that resolve to IPv6 "
|
||
|
|
. "addresses. Lower limit set to {minimum}. Name servers: {ns_list}",
|
||
|
|
@_;
|
||
|
|
},
|
||
|
|
NOT_ENOUGH_NS_CHILD => sub {
|
||
|
|
__x # DELEGATION:NOT_ENOUGH_NS_CHILD
|
||
|
|
"Child does not list enough ({count}) nameservers. Lower limit set to {minimum}. Name servers: {nsname_list}", @_;
|
||
|
|
},
|
||
|
|
NOT_ENOUGH_NS_DEL => sub {
|
||
|
|
__x # DELEGATION:NOT_ENOUGH_NS_DEL
|
||
|
|
"Delegation does not list enough ({count}) nameservers. Lower limit set to {minimum}. Name servers: {nsname_list}", @_;
|
||
|
|
},
|
||
|
|
NO_IPV4_NS_CHILD => sub {
|
||
|
|
__x # DELEGATION:NO_IPV4_NS_CHILD
|
||
|
|
"Child lists no nameserver that resolves to an IPv4 address. "
|
||
|
|
. "If any were present, the minimum allowed would be {minimum}.",
|
||
|
|
@_;
|
||
|
|
},
|
||
|
|
NO_IPV4_NS_DEL => sub {
|
||
|
|
__x # DELEGATION:NO_IPV4_NS_DEL
|
||
|
|
"Delegation lists no nameserver that resolves to an IPv4 address. "
|
||
|
|
. "If any were present, the minimum allowed would be {minimum}.",
|
||
|
|
@_;
|
||
|
|
},
|
||
|
|
NO_IPV6_NS_CHILD => sub {
|
||
|
|
__x # DELEGATION:NO_IPV6_NS_CHILD
|
||
|
|
"Child lists no nameserver that resolves to an IPv6 address. "
|
||
|
|
. "If any were present, the minimum allowed would be {minimum}.",
|
||
|
|
@_;
|
||
|
|
},
|
||
|
|
NO_IPV6_NS_DEL => sub {
|
||
|
|
__x # DELEGATION:NO_IPV6_NS_DEL
|
||
|
|
"Delegation lists no nameserver that resolves to an IPv6 address. "
|
||
|
|
. "If any were present, the minimum allowed would be {minimum}.",
|
||
|
|
@_;
|
||
|
|
},
|
||
|
|
NS_IS_CNAME => sub {
|
||
|
|
__x # DELEGATION:NS_IS_CNAME
|
||
|
|
"Nameserver {nsname} RR points to CNAME.", @_;
|
||
|
|
},
|
||
|
|
NO_NS_CNAME => sub {
|
||
|
|
__x # DELEGATION:NO_NS_CNAME
|
||
|
|
"No nameserver points to CNAME alias.", @_;
|
||
|
|
},
|
||
|
|
REFERRAL_SIZE_TOO_LARGE => sub {
|
||
|
|
__x # DELEGATION:REFERRAL_SIZE_TOO_LARGE
|
||
|
|
"The smallest possible legal referral packet is larger than 512 octets (it is {size}).", @_;
|
||
|
|
},
|
||
|
|
REFERRAL_SIZE_OK => sub {
|
||
|
|
__x # DELEGATION:REFERRAL_SIZE_OK
|
||
|
|
"The smallest possible legal referral packet is smaller than 513 octets (it is {size}).", @_;
|
||
|
|
},
|
||
|
|
SAME_IP_ADDRESS => sub {
|
||
|
|
__x # DELEGATION:SAME_IP_ADDRESS
|
||
|
|
"IP {ns_ip} refers to multiple nameservers ({nsname_list}).", @_;
|
||
|
|
},
|
||
|
|
SOA_EXISTS => sub {
|
||
|
|
__x # DELEGATION:SOA_EXISTS
|
||
|
|
"All the nameservers have SOA record.", @_;
|
||
|
|
},
|
||
|
|
SOA_NOT_EXISTS => sub {
|
||
|
|
__x # DELEGATION:SOA_NOT_EXISTS
|
||
|
|
"Empty NOERROR response to SOA query was received from {ns}.", @_;
|
||
|
|
},
|
||
|
|
TEST_CASE_END => sub {
|
||
|
|
__x # DELEGATION:TEST_CASE_END
|
||
|
|
'TEST_CASE_END {testcase}.', @_;
|
||
|
|
},
|
||
|
|
TEST_CASE_START => sub {
|
||
|
|
__x # DELEGATION:TEST_CASE_START
|
||
|
|
'TEST_CASE_START {testcase}.', @_;
|
||
|
|
},
|
||
|
|
TOTAL_NAME_MISMATCH => sub {
|
||
|
|
__x # DELEGATION:TOTAL_NAME_MISMATCH
|
||
|
|
"None of the nameservers listed at the parent are listed at the child.", @_;
|
||
|
|
},
|
||
|
|
UNEXPECTED_RCODE => sub {
|
||
|
|
__x # DELEGATION:UNEXPECTED_RCODE
|
||
|
|
'Nameserver {ns} answered query for name {query_name} and type {rrtype} with RCODE {rcode}.', @_;
|
||
|
|
},
|
||
|
|
|
||
|
|
);
|
||
|
|
|
||
|
|
=over
|
||
|
|
|
||
|
|
=item tag_descriptions()
|
||
|
|
|
||
|
|
my $hash_ref = tag_descriptions();
|
||
|
|
|
||
|
|
Used by the L<built-in translation system|Zonemaster::Engine::Translator>.
|
||
|
|
|
||
|
|
Returns a reference to a hash, the keys of which are the message tags and the corresponding values are strings (message IDs).
|
||
|
|
|
||
|
|
=back
|
||
|
|
|
||
|
|
=cut
|
||
|
|
|
||
|
|
sub tag_descriptions {
|
||
|
|
return \%TAG_DESCRIPTIONS;
|
||
|
|
}
|
||
|
|
|
||
|
|
=over
|
||
|
|
|
||
|
|
=item version()
|
||
|
|
|
||
|
|
my $version_string = version();
|
||
|
|
|
||
|
|
Returns a string containing the version of the current module.
|
||
|
|
|
||
|
|
=back
|
||
|
|
|
||
|
|
=cut
|
||
|
|
|
||
|
|
sub version {
|
||
|
|
return "$Zonemaster::Engine::Test::Delegation::VERSION";
|
||
|
|
}
|
||
|
|
|
||
|
|
=head1 INTERNAL METHODS
|
||
|
|
|
||
|
|
=over
|
||
|
|
|
||
|
|
=item _emit_log()
|
||
|
|
|
||
|
|
my $log_entry = _emit_log( $message_tag_string, $hash_ref );
|
||
|
|
|
||
|
|
Adds a message to the L<logger|Zonemaster::Engine::Logger> for this module.
|
||
|
|
See L<Zonemaster::Engine::Logger::Entry/add($tag, $argref, $module, $testcase)> for more details.
|
||
|
|
|
||
|
|
Takes a string (message tag) and a reference to a hash (arguments).
|
||
|
|
|
||
|
|
Returns a L<Zonemaster::Engine::Logger::Entry> object.
|
||
|
|
|
||
|
|
=back
|
||
|
|
|
||
|
|
=cut
|
||
|
|
|
||
|
|
sub _emit_log { my ( $tag, $argref ) = @_; return Zonemaster::Engine->logger->add( $tag, $argref, 'Delegation' ); }
|
||
|
|
|
||
|
|
=over
|
||
|
|
|
||
|
|
=item _ip_disabled_message()
|
||
|
|
|
||
|
|
my $bool = _ip_disabled_message( $logentry_array_ref, $ns, @query_type_array );
|
||
|
|
|
||
|
|
Checks if the IP version of a given name server is allowed to be queried. If not, it adds a logging message and returns true. Else, it returns false.
|
||
|
|
|
||
|
|
Takes a reference to an array of L<Zonemaster::Engine::Logger::Entry> objects, a L<Zonemaster::Engine::Nameserver> object and an array of strings (query type).
|
||
|
|
|
||
|
|
Returns a boolean.
|
||
|
|
|
||
|
|
=back
|
||
|
|
|
||
|
|
=cut
|
||
|
|
|
||
|
|
sub _ip_disabled_message {
|
||
|
|
my ( $results_array, $ns, @rrtypes ) = @_;
|
||
|
|
|
||
|
|
if ( not Zonemaster::Engine::Profile->effective->get(q{net.ipv6}) and $ns->address->version == $IP_VERSION_6 ) {
|
||
|
|
push @$results_array, map {
|
||
|
|
_emit_log(
|
||
|
|
IPV6_DISABLED => {
|
||
|
|
ns => $ns->string,
|
||
|
|
rrtype => $_
|
||
|
|
}
|
||
|
|
)
|
||
|
|
} @rrtypes;
|
||
|
|
return 1;
|
||
|
|
}
|
||
|
|
|
||
|
|
if ( not Zonemaster::Engine::Profile->effective->get(q{net.ipv4}) and $ns->address->version == $IP_VERSION_4 ) {
|
||
|
|
push @$results_array, map {
|
||
|
|
_emit_log(
|
||
|
|
IPV4_DISABLED => {
|
||
|
|
ns => $ns->string,
|
||
|
|
rrtype => $_,
|
||
|
|
}
|
||
|
|
)
|
||
|
|
} @rrtypes;
|
||
|
|
return 1;
|
||
|
|
}
|
||
|
|
return 0;
|
||
|
|
}
|
||
|
|
|
||
|
|
=over
|
||
|
|
|
||
|
|
=item _max_length_name_for()
|
||
|
|
|
||
|
|
my $name_string = _max_length_name_for( $name );
|
||
|
|
|
||
|
|
Makes up a name of maximum length in the given domain name. Used as an helper function for Test Case L<Delegation03|/delegation03()>.
|
||
|
|
|
||
|
|
Takes a L<Zonemaster::Engine::DNSName> object.
|
||
|
|
|
||
|
|
Returns a string.
|
||
|
|
|
||
|
|
=back
|
||
|
|
|
||
|
|
=cut
|
||
|
|
|
||
|
|
sub _max_length_name_for {
|
||
|
|
my ( $top ) = @_;
|
||
|
|
my @chars = q{A} .. q{Z};
|
||
|
|
|
||
|
|
my $name = name( $top )->fqdn;
|
||
|
|
$name = q{} if $name eq q{.}; # Special case for root zone
|
||
|
|
|
||
|
|
while ( length( $name ) < $FQDN_MAX_LENGTH - 1 ) {
|
||
|
|
my $len = $FQDN_MAX_LENGTH - length( $name ) - 1;
|
||
|
|
$len = $LABEL_MAX_LENGTH if $len > $LABEL_MAX_LENGTH;
|
||
|
|
$name = join( q{}, map { $chars[ rand @chars ] } 1 .. $len ) . q{.} . $name;
|
||
|
|
}
|
||
|
|
|
||
|
|
return $name;
|
||
|
|
}
|
||
|
|
|
||
|
|
=over
|
||
|
|
|
||
|
|
=item _find_dup_ns()
|
||
|
|
|
||
|
|
my @logentry_array = _find_dup_ns( %hash );
|
||
|
|
|
||
|
|
Checks if given name servers have distinct IP addresses. Used as an helper function for Test Case L<Delegation02|/delegation02()>.
|
||
|
|
|
||
|
|
Takes a hash - the keys of which are C<duplicate_tag>, C<distinct_tag> and C<ns_list>, and their corresponding values are a string,
|
||
|
|
a string and a reference to an array of L<Zonemaster::Engine::Nameserver> objects, respectively.
|
||
|
|
|
||
|
|
Returns a list of L<Zonemaster::Engine::Logger::Entry> objects.
|
||
|
|
|
||
|
|
=back
|
||
|
|
|
||
|
|
=cut
|
||
|
|
|
||
|
|
sub _find_dup_ns {
|
||
|
|
my %args = @_;
|
||
|
|
my $duplicate_tag = $args{duplicate_tag};
|
||
|
|
my $distinct_tag = $args{distinct_tag};
|
||
|
|
my @nss = @{ $args{ns_list} };
|
||
|
|
|
||
|
|
my %nsnames_and_ip;
|
||
|
|
my %ips;
|
||
|
|
foreach my $local_ns ( @nss ) {
|
||
|
|
|
||
|
|
next if $nsnames_and_ip{ $local_ns->name->string . q{/} . $local_ns->address->short };
|
||
|
|
|
||
|
|
push @{ $ips{ $local_ns->address->short } }, $local_ns->name->string;
|
||
|
|
|
||
|
|
$nsnames_and_ip{ $local_ns->name->string . q{/} . $local_ns->address->short }++;
|
||
|
|
|
||
|
|
}
|
||
|
|
|
||
|
|
my @results;
|
||
|
|
foreach my $local_ip ( sort keys %ips ) {
|
||
|
|
if ( scalar @{ $ips{$local_ip} } > 1 ) {
|
||
|
|
push @results,
|
||
|
|
_emit_log(
|
||
|
|
$duplicate_tag => {
|
||
|
|
nsname_list => join( q{;}, @{ $ips{$local_ip} } ),
|
||
|
|
ns_ip => $local_ip,
|
||
|
|
}
|
||
|
|
);
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
if ( @nss && !@results ) {
|
||
|
|
push @results, _emit_log( $distinct_tag => {} );
|
||
|
|
}
|
||
|
|
|
||
|
|
return @results;
|
||
|
|
}
|
||
|
|
|
||
|
|
=head1 TESTS
|
||
|
|
|
||
|
|
=over
|
||
|
|
|
||
|
|
=item delegation01()
|
||
|
|
|
||
|
|
my @logentry_array = delegation01( $zone );
|
||
|
|
|
||
|
|
Runs the L<Delegation01 Test Case|https://github.com/zonemaster/zonemaster/blob/master/docs/public/specifications/tests/Delegation-TP/delegation01.md>.
|
||
|
|
|
||
|
|
Takes a L<Zonemaster::Engine::Zone> object.
|
||
|
|
|
||
|
|
Returns a list of L<Zonemaster::Engine::Logger::Entry> objects.
|
||
|
|
|
||
|
|
=back
|
||
|
|
|
||
|
|
=cut
|
||
|
|
|
||
|
|
sub delegation01 {
|
||
|
|
my ( $class, $zone ) = @_;
|
||
|
|
|
||
|
|
local $Zonemaster::Engine::Logger::TEST_CASE_NAME = 'Delegation01';
|
||
|
|
push my @results, _emit_log( TEST_CASE_START => { testcase => $Zonemaster::Engine::Logger::TEST_CASE_NAME } );
|
||
|
|
|
||
|
|
# Determine delegation NS names
|
||
|
|
my @del_nsnames = map { $_->string } @{ Zonemaster::Engine::TestMethods->method2( $zone ) };
|
||
|
|
my $del_nsnames_args = {
|
||
|
|
count => scalar( @del_nsnames ),
|
||
|
|
minimum => $MINIMUM_NUMBER_OF_NAMESERVERS,
|
||
|
|
nsname_list => join( q{;}, sort @del_nsnames ),
|
||
|
|
};
|
||
|
|
|
||
|
|
# Check delegation NS names
|
||
|
|
if ( scalar( @del_nsnames ) >= $MINIMUM_NUMBER_OF_NAMESERVERS ) {
|
||
|
|
push @results, _emit_log( ENOUGH_NS_DEL => $del_nsnames_args );
|
||
|
|
}
|
||
|
|
else {
|
||
|
|
push @results, _emit_log( NOT_ENOUGH_NS_DEL => $del_nsnames_args );
|
||
|
|
}
|
||
|
|
|
||
|
|
# Determine child NS names
|
||
|
|
my @child_nsnames = map { $_->string } @{ Zonemaster::Engine::TestMethods->method3( $zone ) };
|
||
|
|
my $child_nsnames_args = {
|
||
|
|
count => scalar( @child_nsnames ),
|
||
|
|
minimum => $MINIMUM_NUMBER_OF_NAMESERVERS,
|
||
|
|
nsname_list => join( q{;}, sort @child_nsnames ),
|
||
|
|
};
|
||
|
|
|
||
|
|
# Check child NS names
|
||
|
|
if ( scalar( @child_nsnames ) >= $MINIMUM_NUMBER_OF_NAMESERVERS ) {
|
||
|
|
push @results, _emit_log( ENOUGH_NS_CHILD => $child_nsnames_args );
|
||
|
|
}
|
||
|
|
else {
|
||
|
|
push @results, _emit_log( NOT_ENOUGH_NS_CHILD => $child_nsnames_args );
|
||
|
|
}
|
||
|
|
|
||
|
|
# Determine child NS names with addresses
|
||
|
|
my @child_ns = @{ Zonemaster::Engine::TestMethods->method5( $zone ) };
|
||
|
|
my @child_ns_ipv4 = map { $_ } grep { $_->address->version == 4 } @child_ns;
|
||
|
|
my @child_ns_ipv6 = map { $_ } grep { $_->address->version == 6 } @child_ns;
|
||
|
|
|
||
|
|
my $child_ns_ipv4_args = {
|
||
|
|
count => scalar( uniq map { $_->name->string } @child_ns_ipv4 ),
|
||
|
|
minimum => $MINIMUM_NUMBER_OF_NAMESERVERS,
|
||
|
|
ns_list => join( q{;}, sort map { $_->string } @child_ns_ipv4 ),
|
||
|
|
};
|
||
|
|
my $child_ns_ipv6_args = {
|
||
|
|
count => scalar( uniq map { $_->name->string } @child_ns_ipv6 ),
|
||
|
|
minimum => $MINIMUM_NUMBER_OF_NAMESERVERS,
|
||
|
|
ns_list => join( q{;}, sort map { $_->string } @child_ns_ipv6 ),
|
||
|
|
};
|
||
|
|
|
||
|
|
if ( scalar( uniq map { $_->name->string } @child_ns_ipv4 ) >= $MINIMUM_NUMBER_OF_NAMESERVERS ) {
|
||
|
|
push @results, _emit_log( ENOUGH_IPV4_NS_CHILD => $child_ns_ipv4_args );
|
||
|
|
}
|
||
|
|
elsif ( scalar( uniq map { $_->name->string } @child_ns_ipv4 ) > 0 ) {
|
||
|
|
push @results, _emit_log( NOT_ENOUGH_IPV4_NS_CHILD => $child_ns_ipv4_args );
|
||
|
|
}
|
||
|
|
else {
|
||
|
|
push @results, _emit_log( NO_IPV4_NS_CHILD => $child_ns_ipv4_args );
|
||
|
|
}
|
||
|
|
|
||
|
|
if ( scalar( uniq map { $_->name->string } @child_ns_ipv6 ) >= $MINIMUM_NUMBER_OF_NAMESERVERS ) {
|
||
|
|
push @results, _emit_log( ENOUGH_IPV6_NS_CHILD => $child_ns_ipv6_args );
|
||
|
|
}
|
||
|
|
elsif ( scalar( uniq map { $_->name->string } @child_ns_ipv6 ) > 0 ) {
|
||
|
|
push @results, _emit_log( NOT_ENOUGH_IPV6_NS_CHILD => $child_ns_ipv6_args );
|
||
|
|
}
|
||
|
|
else {
|
||
|
|
push @results, _emit_log( NO_IPV6_NS_CHILD => $child_ns_ipv6_args );
|
||
|
|
}
|
||
|
|
|
||
|
|
# Determine delegation NS names with addresses
|
||
|
|
my @del_ns = @{ Zonemaster::Engine::TestMethods->method4( $zone ) };
|
||
|
|
my @del_ns_ipv4 = map { $_ } grep { $_->address->version == 4 } @del_ns;
|
||
|
|
my @del_ns_ipv6 = map { $_ } grep { $_->address->version == 6 } @del_ns;
|
||
|
|
|
||
|
|
my $del_ns_ipv4_args = {
|
||
|
|
count => scalar( uniq map { $_->name->string } @del_ns_ipv4 ),
|
||
|
|
minimum => $MINIMUM_NUMBER_OF_NAMESERVERS,
|
||
|
|
ns_list => join( q{;}, sort map { $_->string } @del_ns_ipv4 ),
|
||
|
|
};
|
||
|
|
my $del_ns_ipv6_args = {
|
||
|
|
count => scalar( uniq map { $_->name->string } @del_ns_ipv6 ),
|
||
|
|
minimum => $MINIMUM_NUMBER_OF_NAMESERVERS,
|
||
|
|
ns_list => join( q{;}, sort map { $_->string } @del_ns_ipv6 ),
|
||
|
|
};
|
||
|
|
|
||
|
|
if ( scalar( uniq map { $_->name->string } @del_ns_ipv4 ) >= $MINIMUM_NUMBER_OF_NAMESERVERS ) {
|
||
|
|
push @results, _emit_log( ENOUGH_IPV4_NS_DEL => $del_ns_ipv4_args );
|
||
|
|
}
|
||
|
|
elsif ( scalar( uniq map { $_->name->string } @del_ns_ipv4 ) > 0 ) {
|
||
|
|
push @results, _emit_log( NOT_ENOUGH_IPV4_NS_DEL => $del_ns_ipv4_args );
|
||
|
|
}
|
||
|
|
else {
|
||
|
|
push @results, _emit_log( NO_IPV4_NS_DEL => $del_ns_ipv4_args );
|
||
|
|
}
|
||
|
|
|
||
|
|
if ( scalar( uniq map { $_->name->string } @del_ns_ipv6 ) >= $MINIMUM_NUMBER_OF_NAMESERVERS ) {
|
||
|
|
push @results, _emit_log( ENOUGH_IPV6_NS_DEL => $del_ns_ipv6_args );
|
||
|
|
}
|
||
|
|
elsif ( scalar( uniq map { $_->name->string } @del_ns_ipv6 ) > 0 ) {
|
||
|
|
push @results, _emit_log( NOT_ENOUGH_IPV6_NS_DEL => $del_ns_ipv6_args );
|
||
|
|
}
|
||
|
|
else {
|
||
|
|
push @results, _emit_log( NO_IPV6_NS_DEL => $del_ns_ipv6_args );
|
||
|
|
}
|
||
|
|
|
||
|
|
return ( @results, _emit_log( TEST_CASE_END => { testcase => $Zonemaster::Engine::Logger::TEST_CASE_NAME } ) );
|
||
|
|
} ## end sub delegation01
|
||
|
|
|
||
|
|
=over
|
||
|
|
|
||
|
|
=item delegation02()
|
||
|
|
|
||
|
|
my @logentry_array = delegation02( $zone );
|
||
|
|
|
||
|
|
Runs the L<Delegation02 Test Case|https://github.com/zonemaster/zonemaster/blob/master/docs/public/specifications/tests/Delegation-TP/delegation02.md>.
|
||
|
|
|
||
|
|
Takes a L<Zonemaster::Engine::Zone> object.
|
||
|
|
|
||
|
|
Returns a list of L<Zonemaster::Engine::Logger::Entry> objects.
|
||
|
|
|
||
|
|
=back
|
||
|
|
|
||
|
|
=cut
|
||
|
|
|
||
|
|
sub delegation02 {
|
||
|
|
my ( $class, $zone ) = @_;
|
||
|
|
|
||
|
|
local $Zonemaster::Engine::Logger::TEST_CASE_NAME = 'Delegation02';
|
||
|
|
push my @results, _emit_log( TEST_CASE_START => { testcase => $Zonemaster::Engine::Logger::TEST_CASE_NAME } );
|
||
|
|
|
||
|
|
my @nss_del = @{ Zonemaster::Engine::TestMethods->method4( $zone ) };
|
||
|
|
my @nss_child = @{ Zonemaster::Engine::TestMethods->method5( $zone ) };
|
||
|
|
|
||
|
|
push @results,
|
||
|
|
_find_dup_ns(
|
||
|
|
duplicate_tag => 'DEL_NS_SAME_IP',
|
||
|
|
distinct_tag => 'DEL_DISTINCT_NS_IP',
|
||
|
|
ns_list => [@nss_del],
|
||
|
|
);
|
||
|
|
|
||
|
|
push @results,
|
||
|
|
_find_dup_ns(
|
||
|
|
duplicate_tag => 'CHILD_NS_SAME_IP',
|
||
|
|
distinct_tag => 'CHILD_DISTINCT_NS_IP',
|
||
|
|
ns_list => [@nss_child],
|
||
|
|
);
|
||
|
|
|
||
|
|
push @results,
|
||
|
|
_find_dup_ns(
|
||
|
|
duplicate_tag => 'SAME_IP_ADDRESS',
|
||
|
|
distinct_tag => 'DISTINCT_IP_ADDRESS',
|
||
|
|
ns_list => [ @nss_del, @nss_child ],
|
||
|
|
);
|
||
|
|
|
||
|
|
return ( @results, _emit_log( TEST_CASE_END => { testcase => $Zonemaster::Engine::Logger::TEST_CASE_NAME } ) );
|
||
|
|
} ## end sub delegation02
|
||
|
|
|
||
|
|
=over
|
||
|
|
|
||
|
|
=item delegation03()
|
||
|
|
|
||
|
|
my @logentry_array = delegation03( $zone );
|
||
|
|
|
||
|
|
Runs the L<Delegation03 Test Case|https://github.com/zonemaster/zonemaster/blob/master/docs/public/specifications/tests/Delegation-TP/delegation03.md>.
|
||
|
|
|
||
|
|
Takes a L<Zonemaster::Engine::Zone> object.
|
||
|
|
|
||
|
|
Returns a list of L<Zonemaster::Engine::Logger::Entry> objects.
|
||
|
|
|
||
|
|
=back
|
||
|
|
|
||
|
|
=cut
|
||
|
|
|
||
|
|
sub delegation03 {
|
||
|
|
my ( $class, $zone ) = @_;
|
||
|
|
|
||
|
|
local $Zonemaster::Engine::Logger::TEST_CASE_NAME = 'Delegation03';
|
||
|
|
push my @results, _emit_log( TEST_CASE_START => { testcase => $Zonemaster::Engine::Logger::TEST_CASE_NAME } );
|
||
|
|
|
||
|
|
my $long_name = _max_length_name_for( $zone->name );
|
||
|
|
my @nsnames = map { $_->string } @{ Zonemaster::Engine::TestMethods->method2( $zone ) };
|
||
|
|
my @nss = @{ Zonemaster::Engine::TestMethods->method4( $zone ) };
|
||
|
|
my @nss_v4 = grep { $_->address->version == $IP_VERSION_4 } @nss;
|
||
|
|
my @nss_v6 = grep { $_->address->version == $IP_VERSION_6 } @nss;
|
||
|
|
my $parent = $zone->parent();
|
||
|
|
|
||
|
|
my $p = Zonemaster::LDNS::Packet->new( $long_name, q{NS}, q{IN} );
|
||
|
|
for my $nsname ( @nsnames ) {
|
||
|
|
my $rr = Zonemaster::LDNS::RR->new( sprintf( q{%s IN NS %s}, $zone->name, $nsname ) );
|
||
|
|
$p->unique_push( q{authority}, $rr );
|
||
|
|
}
|
||
|
|
|
||
|
|
# If @nss_v4 is non-empty and all of its elements are in bailiwick of parent
|
||
|
|
if ( @nss_v4 and not grep { not $parent->name->is_in_bailiwick( $_->name ) } @nss_v4 ) {
|
||
|
|
my $ns = $nss_v4[0];
|
||
|
|
my $rr = Zonemaster::LDNS::RR->new( sprintf( q{%s IN A %s}, $ns->name, $ns->address->short ) );
|
||
|
|
$p->unique_push( q{additional}, $rr );
|
||
|
|
}
|
||
|
|
|
||
|
|
# If @nss_v6 is non-empty and all of its elements are in bailiwick of parent
|
||
|
|
if ( @nss_v6 and not grep { not $parent->name->is_in_bailiwick( $_->name ) } @nss_v6 ) {
|
||
|
|
my $ns = $nss_v6[0];
|
||
|
|
my $rr = Zonemaster::LDNS::RR->new( sprintf( q{%s IN AAAA %s}, $ns->name, $ns->address->short ) );
|
||
|
|
$p->unique_push( q{additional}, $rr );
|
||
|
|
}
|
||
|
|
|
||
|
|
my $size = length( $p->data );
|
||
|
|
if ( $size > $UDP_PAYLOAD_LIMIT ) {
|
||
|
|
push @results,
|
||
|
|
_emit_log(
|
||
|
|
REFERRAL_SIZE_TOO_LARGE => {
|
||
|
|
size => $size,
|
||
|
|
}
|
||
|
|
);
|
||
|
|
}
|
||
|
|
else {
|
||
|
|
push @results,
|
||
|
|
_emit_log(
|
||
|
|
REFERRAL_SIZE_OK => {
|
||
|
|
size => $size,
|
||
|
|
}
|
||
|
|
);
|
||
|
|
}
|
||
|
|
|
||
|
|
return ( @results, _emit_log( TEST_CASE_END => { testcase => $Zonemaster::Engine::Logger::TEST_CASE_NAME } ) );
|
||
|
|
} ## end sub delegation03
|
||
|
|
|
||
|
|
=over
|
||
|
|
|
||
|
|
=item delegation04()
|
||
|
|
|
||
|
|
my @logentry_array = delegation04( $zone );
|
||
|
|
|
||
|
|
Runs the L<Delegation04 Test Case|https://github.com/zonemaster/zonemaster/blob/master/docs/public/specifications/tests/Delegation-TP/delegation04.md>.
|
||
|
|
|
||
|
|
Takes a L<Zonemaster::Engine::Zone> object.
|
||
|
|
|
||
|
|
Returns a list of L<Zonemaster::Engine::Logger::Entry> objects.
|
||
|
|
|
||
|
|
=back
|
||
|
|
|
||
|
|
=cut
|
||
|
|
|
||
|
|
sub delegation04 {
|
||
|
|
my ( $class, $zone ) = @_;
|
||
|
|
|
||
|
|
local $Zonemaster::Engine::Logger::TEST_CASE_NAME = 'Delegation04';
|
||
|
|
push my @results, _emit_log( TEST_CASE_START => { testcase => $Zonemaster::Engine::Logger::TEST_CASE_NAME } );
|
||
|
|
my %nsnames;
|
||
|
|
my @authoritatives;
|
||
|
|
my $query_type = q{SOA};
|
||
|
|
|
||
|
|
foreach
|
||
|
|
my $local_ns ( @{ Zonemaster::Engine::TestMethods->method4( $zone ) }, @{ Zonemaster::Engine::TestMethods->method5( $zone ) } )
|
||
|
|
{
|
||
|
|
|
||
|
|
if ( _ip_disabled_message( \@results, $local_ns, $query_type ) ) {
|
||
|
|
next;
|
||
|
|
}
|
||
|
|
|
||
|
|
next if $nsnames{ $local_ns->name->string };
|
||
|
|
|
||
|
|
foreach my $usevc ( 0, 1 ) {
|
||
|
|
my $p = $local_ns->query( $zone->name, $query_type, { usevc => $usevc } );
|
||
|
|
if ( $p ) {
|
||
|
|
if ( not $p->aa ) {
|
||
|
|
push @results,
|
||
|
|
_emit_log(
|
||
|
|
IS_NOT_AUTHORITATIVE => {
|
||
|
|
ns => $local_ns->string,
|
||
|
|
proto => $usevc ? q{TCP} : q{UDP},
|
||
|
|
}
|
||
|
|
);
|
||
|
|
}
|
||
|
|
else {
|
||
|
|
push @authoritatives, $local_ns->name->string;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
$nsnames{ $local_ns->name }++;
|
||
|
|
} ## end foreach my $local_ns ( @{ Zonemaster::Engine::TestMethods...})
|
||
|
|
|
||
|
|
if (
|
||
|
|
(
|
||
|
|
scalar @{ Zonemaster::Engine::TestMethods->method4( $zone ) }
|
||
|
|
or scalar @{ Zonemaster::Engine::TestMethods->method5( $zone ) }
|
||
|
|
)
|
||
|
|
and not grep { $_->tag ne q{TEST_CASE_START} } @results
|
||
|
|
and scalar @authoritatives
|
||
|
|
)
|
||
|
|
{
|
||
|
|
push @results,
|
||
|
|
_emit_log(
|
||
|
|
ARE_AUTHORITATIVE => {
|
||
|
|
nsname_list => join( q{;}, uniq sort @authoritatives ),
|
||
|
|
}
|
||
|
|
);
|
||
|
|
}
|
||
|
|
|
||
|
|
return ( @results, _emit_log( TEST_CASE_END => { testcase => $Zonemaster::Engine::Logger::TEST_CASE_NAME } ) );
|
||
|
|
} ## end sub delegation04
|
||
|
|
|
||
|
|
=over
|
||
|
|
|
||
|
|
=item delegation05()
|
||
|
|
|
||
|
|
my @logentry_array = delegation05( $zone );
|
||
|
|
|
||
|
|
Runs the L<Delegation05 Test Case|https://github.com/zonemaster/zonemaster/blob/master/docs/public/specifications/tests/Delegation-TP/delegation05.md>.
|
||
|
|
|
||
|
|
Takes a L<Zonemaster::Engine::Zone> object.
|
||
|
|
|
||
|
|
Returns a list of L<Zonemaster::Engine::Logger::Entry> objects.
|
||
|
|
|
||
|
|
=back
|
||
|
|
|
||
|
|
=cut
|
||
|
|
|
||
|
|
sub delegation05 {
|
||
|
|
my ( $class, $zone ) = @_;
|
||
|
|
|
||
|
|
local $Zonemaster::Engine::Logger::TEST_CASE_NAME = 'Delegation05';
|
||
|
|
push my @results, _emit_log( TEST_CASE_START => { testcase => $Zonemaster::Engine::Logger::TEST_CASE_NAME } );
|
||
|
|
|
||
|
|
my @nsnames = @{ Zonemaster::Engine::TestMethods->method2and3( $zone ) };
|
||
|
|
|
||
|
|
foreach my $local_nsname ( @nsnames ) {
|
||
|
|
|
||
|
|
if ( $zone->name->is_in_bailiwick( $local_nsname ) ) {
|
||
|
|
my @nss_del = @{ Zonemaster::Engine::TestMethods->method4( $zone ) };
|
||
|
|
my @nss_child = @{ Zonemaster::Engine::TestMethods->method5( $zone ) };
|
||
|
|
my %nss = map { $_->name->string . '/' . $_->address->short => $_ } @nss_del, @nss_child;
|
||
|
|
|
||
|
|
for my $key ( sort keys %nss ) {
|
||
|
|
my $ns = $nss{$key};
|
||
|
|
my $ns_args = {
|
||
|
|
ns => $ns->string,
|
||
|
|
query_name => $local_nsname,
|
||
|
|
rrtype => q{A},
|
||
|
|
};
|
||
|
|
|
||
|
|
if ( _ip_disabled_message( \@results, $ns, q{A} ) ) {
|
||
|
|
next;
|
||
|
|
}
|
||
|
|
|
||
|
|
my $p = $ns->query( $local_nsname, q{A}, { recurse => 0 } );
|
||
|
|
if ( not $p ) {
|
||
|
|
push @results, _emit_log( NO_RESPONSE => $ns_args );
|
||
|
|
next;
|
||
|
|
}
|
||
|
|
elsif ($p->rcode ne q{NOERROR} ) {
|
||
|
|
$ns_args->{rcode} = $p->rcode;
|
||
|
|
push @results, _emit_log( UNEXPECTED_RCODE => $ns_args );
|
||
|
|
next;
|
||
|
|
}
|
||
|
|
elsif ( scalar $p->get_records( q{CNAME}, q{answer} ) > 0 ) {
|
||
|
|
push @results, _emit_log( NS_IS_CNAME => { nsname => $local_nsname } );
|
||
|
|
next;
|
||
|
|
}
|
||
|
|
elsif ($p->is_redirect) {
|
||
|
|
my $p = $ns->query( $local_nsname, q{A}, { recurse => 1 } );
|
||
|
|
if ( defined $p and scalar $p->get_records( q{CNAME}, q{answer} ) > 0 ) {
|
||
|
|
push @results, _emit_log( NS_IS_CNAME => { nsname => $local_nsname } );
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
else {
|
||
|
|
my $p = Zonemaster::Engine::Recursor->recurse( $local_nsname, q{A} );
|
||
|
|
if ( defined $p and scalar $p->get_records( q{CNAME}, q{answer} ) > 0 ) {
|
||
|
|
push @results, _emit_log( NS_IS_CNAME => { nsname => $local_nsname } );
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
if ( not grep { $_->tag eq q{NS_IS_CNAME} } @results ) {
|
||
|
|
push @results, _emit_log( NO_NS_CNAME => {} );
|
||
|
|
}
|
||
|
|
|
||
|
|
return ( @results, _emit_log( TEST_CASE_END => { testcase => $Zonemaster::Engine::Logger::TEST_CASE_NAME } ) );
|
||
|
|
} ## end sub delegation05
|
||
|
|
|
||
|
|
=over
|
||
|
|
|
||
|
|
=item delegation06()
|
||
|
|
|
||
|
|
my @logentry_array = delegation06( $zone );
|
||
|
|
|
||
|
|
Runs the L<Delegation06 Test Case|https://github.com/zonemaster/zonemaster/blob/master/docs/public/specifications/tests/Delegation-TP/delegation06.md>.
|
||
|
|
|
||
|
|
Takes a L<Zonemaster::Engine::Zone> object.
|
||
|
|
|
||
|
|
Returns a list of L<Zonemaster::Engine::Logger::Entry> objects.
|
||
|
|
|
||
|
|
=back
|
||
|
|
|
||
|
|
=cut
|
||
|
|
|
||
|
|
sub delegation06 {
|
||
|
|
my ( $class, $zone ) = @_;
|
||
|
|
|
||
|
|
local $Zonemaster::Engine::Logger::TEST_CASE_NAME = 'Delegation06';
|
||
|
|
push my @results, _emit_log( TEST_CASE_START => { testcase => $Zonemaster::Engine::Logger::TEST_CASE_NAME } );
|
||
|
|
my %nsnames;
|
||
|
|
my $query_type = q{SOA};
|
||
|
|
|
||
|
|
foreach
|
||
|
|
my $local_ns ( @{ Zonemaster::Engine::TestMethods->method4( $zone ) }, @{ Zonemaster::Engine::TestMethods->method5( $zone ) } )
|
||
|
|
{
|
||
|
|
|
||
|
|
if ( _ip_disabled_message( \@results, $local_ns, $query_type ) ) {
|
||
|
|
next;
|
||
|
|
}
|
||
|
|
|
||
|
|
next if $nsnames{ $local_ns->name->string };
|
||
|
|
|
||
|
|
my $p = $local_ns->query( $zone->name, $query_type );
|
||
|
|
if ( $p and $p->rcode eq q{NOERROR} ) {
|
||
|
|
if ( not $p->get_records( $query_type, q{answer} ) ) {
|
||
|
|
push @results, _emit_log( SOA_NOT_EXISTS => { ns => $local_ns->string } );
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
$nsnames{ $local_ns->name->string }++;
|
||
|
|
} ## end foreach my $local_ns ( @{ Zonemaster::Engine::TestMethods...})
|
||
|
|
|
||
|
|
if (
|
||
|
|
(
|
||
|
|
scalar @{ Zonemaster::Engine::TestMethods->method4( $zone ) }
|
||
|
|
or scalar @{ Zonemaster::Engine::TestMethods->method5( $zone ) }
|
||
|
|
)
|
||
|
|
and not grep { $_->tag ne q{TEST_CASE_START} } @results
|
||
|
|
)
|
||
|
|
{
|
||
|
|
push @results, _emit_log( SOA_EXISTS => {} );
|
||
|
|
}
|
||
|
|
|
||
|
|
return ( @results, _emit_log( TEST_CASE_END => { testcase => $Zonemaster::Engine::Logger::TEST_CASE_NAME } ) );
|
||
|
|
} ## end sub delegation06
|
||
|
|
|
||
|
|
=over
|
||
|
|
|
||
|
|
=item delegation07()
|
||
|
|
|
||
|
|
my @logentry_array = delegation07( $zone );
|
||
|
|
|
||
|
|
Runs the L<Delegation07 Test Case|https://github.com/zonemaster/zonemaster/blob/master/docs/public/specifications/tests/Delegation-TP/delegation07.md>.
|
||
|
|
|
||
|
|
Takes a L<Zonemaster::Engine::Zone> object.
|
||
|
|
|
||
|
|
Returns a list of L<Zonemaster::Engine::Logger::Entry> objects.
|
||
|
|
|
||
|
|
=back
|
||
|
|
|
||
|
|
=cut
|
||
|
|
|
||
|
|
sub delegation07 {
|
||
|
|
my ( $class, $zone ) = @_;
|
||
|
|
|
||
|
|
local $Zonemaster::Engine::Logger::TEST_CASE_NAME = 'Delegation07';
|
||
|
|
push my @results, _emit_log( TEST_CASE_START => { testcase => $Zonemaster::Engine::Logger::TEST_CASE_NAME } );
|
||
|
|
|
||
|
|
my %names;
|
||
|
|
foreach my $name ( @{ Zonemaster::Engine::TestMethods->method2( $zone ) } ) {
|
||
|
|
$names{$name} += 1;
|
||
|
|
}
|
||
|
|
foreach my $name ( @{ Zonemaster::Engine::TestMethods->method3( $zone ) } ) {
|
||
|
|
$names{$name} -= 1;
|
||
|
|
}
|
||
|
|
|
||
|
|
my @same_name = sort grep { $names{$_} == 0 } keys %names;
|
||
|
|
my @extra_name_parent = sort grep { $names{$_} > 0 } keys %names;
|
||
|
|
my @extra_name_child = sort grep { $names{$_} < 0 } keys %names;
|
||
|
|
|
||
|
|
if ( @extra_name_parent ) {
|
||
|
|
push @results,
|
||
|
|
_emit_log(
|
||
|
|
EXTRA_NAME_PARENT => {
|
||
|
|
extra => join( q{;}, sort @extra_name_parent ),
|
||
|
|
}
|
||
|
|
);
|
||
|
|
}
|
||
|
|
|
||
|
|
if ( @extra_name_child ) {
|
||
|
|
push @results,
|
||
|
|
_emit_log(
|
||
|
|
EXTRA_NAME_CHILD => {
|
||
|
|
extra => join( q{;}, sort @extra_name_child ),
|
||
|
|
}
|
||
|
|
);
|
||
|
|
}
|
||
|
|
|
||
|
|
if ( @extra_name_parent == 0 and @extra_name_child == 0 ) {
|
||
|
|
push @results,
|
||
|
|
_emit_log(
|
||
|
|
NAMES_MATCH => {
|
||
|
|
names => join( q{;}, sort @same_name ),
|
||
|
|
}
|
||
|
|
);
|
||
|
|
}
|
||
|
|
|
||
|
|
if ( scalar( @same_name ) == 0 ) {
|
||
|
|
push @results,
|
||
|
|
_emit_log(
|
||
|
|
TOTAL_NAME_MISMATCH => {
|
||
|
|
glue => join( q{;}, sort @extra_name_parent ),
|
||
|
|
child => join( q{;}, sort @extra_name_child ),
|
||
|
|
}
|
||
|
|
);
|
||
|
|
}
|
||
|
|
|
||
|
|
return ( @results, _emit_log( TEST_CASE_END => { testcase => $Zonemaster::Engine::Logger::TEST_CASE_NAME } ) );
|
||
|
|
} ## end sub delegation07
|
||
|
|
|
||
|
|
1;
|