use
version ;
our
$VERSION
= version->declare(
"v1.0.3"
);
use
5.014002;
sub
all {
my
(
$class
,
$zone
) =
@_
;
my
@results
;
push
@results
,
$class
->zone01(
$zone
)
if
Zonemaster::Engine->config->should_run(
'zone01'
);
if
( none {
$_
->tag eq
q{NO_RESPONSE_SOA_QUERY}
}
@results
) {
push
@results
,
$class
->zone02(
$zone
)
if
Zonemaster::Engine->config->should_run(
'zone02'
);
push
@results
,
$class
->zone03(
$zone
)
if
Zonemaster::Engine->config->should_run(
'zone03'
);
push
@results
,
$class
->zone04(
$zone
)
if
Zonemaster::Engine->config->should_run(
'zone04'
);
push
@results
,
$class
->zone05(
$zone
)
if
Zonemaster::Engine->config->should_run(
'zone05'
);
push
@results
,
$class
->zone06(
$zone
)
if
Zonemaster::Engine->config->should_run(
'zone06'
);
if
( none {
$_
->tag eq
q{MNAME_RECORD_DOES_NOT_EXIST}
}
@results
) {
push
@results
,
$class
->zone07(
$zone
)
if
Zonemaster::Engine->config->should_run(
'zone07'
);
}
}
if
( none {
$_
->tag eq
q{MNAME_RECORD_DOES_NOT_EXIST}
}
@results
) {
push
@results
,
$class
->zone08(
$zone
)
if
Zonemaster::Engine->config->should_run(
'zone08'
);
if
( none {
$_
->tag eq
q{NO_RESPONSE_MX_QUERY}
}
@results
) {
push
@results
,
$class
->zone09(
$zone
)
if
Zonemaster::Engine->config->should_run(
'zone09'
);
}
}
return
@results
;
}
sub
metadata {
my
(
$class
) =
@_
;
return
{
zone01
=> [
qw(
MNAME_RECORD_DOES_NOT_EXIST
MNAME_NOT_AUTHORITATIVE
MNAME_NO_RESPONSE
MNAME_NOT_IN_GLUE
MNAME_IS_AUTHORITATIVE
NO_RESPONSE_SOA_QUERY
)
],
zone02
=> [
qw(
REFRESH_MINIMUM_VALUE_LOWER
REFRESH_MINIMUM_VALUE_OK
NO_RESPONSE_SOA_QUERY
)
],
zone03
=> [
qw(
REFRESH_LOWER_THAN_RETRY
REFRESH_HIGHER_THAN_RETRY
NO_RESPONSE_SOA_QUERY
)
],
zone04
=> [
qw(
RETRY_MINIMUM_VALUE_LOWER
RETRY_MINIMUM_VALUE_OK
NO_RESPONSE_SOA_QUERY
)
],
zone05
=> [
qw(
EXPIRE_MINIMUM_VALUE_LOWER
EXPIRE_LOWER_THAN_REFRESH
EXPIRE_MINIMUM_VALUE_OK
NO_RESPONSE_SOA_QUERY
)
],
zone06
=> [
qw(
SOA_DEFAULT_TTL_MAXIMUM_VALUE_HIGHER
SOA_DEFAULT_TTL_MAXIMUM_VALUE_LOWER
SOA_DEFAULT_TTL_MAXIMUM_VALUE_OK
NO_RESPONSE_SOA_QUERY
)
],
zone07
=> [
qw(
MNAME_IS_CNAME
MNAME_IS_NOT_CNAME
NO_RESPONSE_SOA_QUERY
MNAME_HAS_NO_ADDRESS
)
],
zone08
=> [
qw(
MX_RECORD_IS_CNAME
MX_RECORD_IS_NOT_CNAME
NO_RESPONSE_MX_QUERY
)
],
zone09
=> [
qw(
NO_MX_RECORD
MX_RECORD_EXISTS
NO_RESPONSE_MX_QUERY
)
],
};
}
sub
translation {
return
{
'RETRY_MINIMUM_VALUE_LOWER'
=>
'SOA \'retry\' value ({retry}) is less than the recommended one ({required_retry}).'
,
'RETRY_MINIMUM_VALUE_OK'
=>
'SOA \'retry\' value ({retry}) is more than the minimum recommended value ({required_retry}).'
,
'MNAME_NO_RESPONSE'
=>
'SOA \'mname\' nameserver {ns}/{address} does not respond.'
,
'MNAME_IS_CNAME'
=>
'SOA \'mname\' value ({mname}) refers to a NS which is an alias (CNAME).'
,
'MNAME_IS_NOT_CNAME'
=>
'SOA \'mname\' value ({mname}) refers to a NS which is not an alias (CNAME).'
,
'NO_MX_RECORD'
=>
'No target (MX, A or AAAA record) to deliver e-mail for the domain name.'
,
'MX_RECORD_EXISTS'
=>
'Target ({info}) found to deliver e-mail for the domain name.'
,
'REFRESH_MINIMUM_VALUE_LOWER'
=>
'SOA \'refresh\' value ({refresh}) is less than the recommended one ({required_refresh}).'
,
'REFRESH_MINIMUM_VALUE_OK'
=>
'SOA \'refresh\' value ({refresh}) is higher than the minimum recommended value ({required_refresh}).'
,
'EXPIRE_LOWER_THAN_REFRESH'
=>
'SOA \'expire\' value ({expire}) is lower than the SOA \'refresh\' value ({refresh}).'
,
'SOA_DEFAULT_TTL_MAXIMUM_VALUE_HIGHER'
=>
'SOA \'minimum\' value ({minimum}) is higher than the recommended one ({highest_minimum}).'
,
'SOA_DEFAULT_TTL_MAXIMUM_VALUE_LOWER'
=>
'SOA \'minimum\' value ({minimum}) is less than the recommended one ({lowest_minimum}).'
,
'SOA_DEFAULT_TTL_MAXIMUM_VALUE_OK'
=>
'SOA \'minimum\' value ({minimum}) is between the recommended ones ({lowest_minimum}/{highest_minimum}).'
,
'MNAME_NOT_AUTHORITATIVE'
=>
'SOA \'mname\' nameserver {ns}/{address} is not authoritative for \'{zone}\' zone.'
,
'MNAME_RECORD_DOES_NOT_EXIST'
=>
'SOA \'mname\' field does not exist'
,
'EXPIRE_MINIMUM_VALUE_LOWER'
=>
'SOA \'expire\' value ({expire}) is less than the recommended one ({required_expire}).'
,
'MNAME_NOT_IN_GLUE'
=>
'SOA \'mname\' nameserver ({mname}) is not listed in "parent" NS records for tested zone ({ns}).'
,
'REFRESH_LOWER_THAN_RETRY'
=>
'SOA \'refresh\' value ({refresh}) is lower than the SOA \'retry\' value ({retry}).'
,
'REFRESH_HIGHER_THAN_RETRY'
=>
'SOA \'refresh\' value ({refresh}) is higher than the SOA \'retry\' value ({retry}).'
,
'MX_RECORD_IS_CNAME'
=>
'MX record for the domain is pointing to a CNAME.'
,
'MX_RECORD_IS_NOT_CNAME'
=>
'MX record for the domain is not pointing to a CNAME.'
,
'MNAME_IS_AUTHORITATIVE'
=>
'SOA \'mname\' nameserver ({mname}) is authoritative for \'{zone}\' zone.'
,
'NO_RESPONSE_SOA_QUERY'
=>
'No response from nameserver(s) on SOA queries.'
,
'NO_RESPONSE_MX_QUERY'
=>
'No response from nameserver(s) on MX queries.'
,
'MNAME_HAS_NO_ADDRESS'
=>
'No IP address found for SOA \'mname\' nameserver ({mname}).'
,
'EXPIRE_MINIMUM_VALUE_OK'
=>
'SOA \'expire\' value ({expire}) is higher than the minimum recommended value ({required_expire}) and not lower than the \'refresh\' value ({refresh}).'
,
};
}
sub
version {
return
"$Zonemaster::Engine::Test::Zone::VERSION"
;
}
sub
zone01 {
my
(
$class
,
$zone
) =
@_
;
my
@results
;
my
$p
= _retrieve_record_from_zone(
$zone
,
$zone
->name,
q{SOA}
);
if
(
$p
and
my
(
$soa
) =
$p
->get_records(
q{SOA}
,
q{answer}
) ) {
my
$soa_mname
=
$soa
->mname;
$soa_mname
=~ s/[.]\z//smx;
if
( not
$soa_mname
) {
push
@results
, info(
MNAME_RECORD_DOES_NOT_EXIST
=> {} );
}
else
{
foreach
my
$ip_address
( Zonemaster::Engine::Recursor->get_addresses_for(
$soa_mname
) ) {
my
$ns
= Zonemaster::Engine::Nameserver->new( {
name
=>
$soa_mname
,
address
=>
$ip_address
->short } );
if
( _is_ip_version_disabled(
$ns
) ) {
next
;
}
my
$p_soa
=
$ns
->query(
$zone
->name,
q{SOA}
);
if
(
$p_soa
and
$p_soa
->rcode eq
q{NOERROR}
) {
if
( not
$p_soa
->aa ) {
push
@results
,
info(
MNAME_NOT_AUTHORITATIVE
=> {
ns
=>
$soa_mname
,
address
=>
$ip_address
->short,
zone
=>
$zone
->name,
}
);
}
}
else
{
push
@results
,
info(
MNAME_NO_RESPONSE
=> {
ns
=>
$soa_mname
,
address
=>
$ip_address
->short,
}
);
}
}
if
( none {
$_
eq
$soa_mname
} @{ Zonemaster::Engine::TestMethods->method2(
$zone
) } ) {
push
@results
,
info(
MNAME_NOT_IN_GLUE
=> {
mname
=>
$soa_mname
,
ns
=>
join
(
q{;}
, @{ Zonemaster::Engine::TestMethods->method2(
$zone
) } ),
}
);
}
}
if
( not
scalar
@results
) {
push
@results
,
info(
MNAME_IS_AUTHORITATIVE
=> {
mname
=>
$soa_mname
,
zone
=>
$zone
->name,
}
);
}
}
else
{
push
@results
, info(
NO_RESPONSE_SOA_QUERY
=> {} );
}
return
@results
;
}
sub
zone02 {
my
(
$class
,
$zone
) =
@_
;
my
@results
;
my
$p
= _retrieve_record_from_zone(
$zone
,
$zone
->name,
q{SOA}
);
if
(
$p
and
my
(
$soa
) =
$p
->get_records(
q{SOA}
,
q{answer}
) ) {
my
$soa_refresh
=
$soa
->refresh;
if
(
$soa_refresh
<
$SOA_REFRESH_MINIMUM_VALUE
) {
push
@results
,
info(
REFRESH_MINIMUM_VALUE_LOWER
=> {
refresh
=>
$soa_refresh
,
required_refresh
=>
$SOA_REFRESH_MINIMUM_VALUE
,
}
);
}
else
{
push
@results
,
info(
REFRESH_MINIMUM_VALUE_OK
=> {
refresh
=>
$soa_refresh
,
required_refresh
=>
$SOA_REFRESH_MINIMUM_VALUE
,
}
);
}
}
else
{
push
@results
, info(
NO_RESPONSE_SOA_QUERY
=> {} );
}
return
@results
;
}
sub
zone03 {
my
(
$class
,
$zone
) =
@_
;
my
@results
;
my
$p
= _retrieve_record_from_zone(
$zone
,
$zone
->name,
q{SOA}
);
if
(
$p
and
my
(
$soa
) =
$p
->get_records(
q{SOA}
,
q{answer}
) ) {
my
$soa_retry
=
$soa
->retry;
my
$soa_refresh
=
$soa
->refresh;
if
(
$soa_retry
>=
$soa_refresh
) {
push
@results
,
info(
REFRESH_LOWER_THAN_RETRY
=> {
retry
=>
$soa_retry
,
refresh
=>
$soa_refresh
,
}
);
}
else
{
push
@results
,
info(
REFRESH_HIGHER_THAN_RETRY
=> {
retry
=>
$soa_retry
,
refresh
=>
$soa_refresh
,
}
);
}
}
else
{
push
@results
, info(
NO_RESPONSE_SOA_QUERY
=> {} );
}
return
@results
;
}
sub
zone04 {
my
(
$class
,
$zone
) =
@_
;
my
@results
;
my
$p
= _retrieve_record_from_zone(
$zone
,
$zone
->name,
q{SOA}
);
if
(
$p
and
my
(
$soa
) =
$p
->get_records(
q{SOA}
,
q{answer}
) ) {
my
$soa_retry
=
$soa
->retry;
if
(
$soa_retry
<
$SOA_RETRY_MINIMUM_VALUE
) {
push
@results
,
info(
RETRY_MINIMUM_VALUE_LOWER
=> {
retry
=>
$soa_retry
,
required_retry
=>
$SOA_RETRY_MINIMUM_VALUE
,
}
);
}
else
{
push
@results
,
info(
RETRY_MINIMUM_VALUE_OK
=> {
retry
=>
$soa_retry
,
required_retry
=>
$SOA_RETRY_MINIMUM_VALUE
,
}
);
}
}
else
{
push
@results
, info(
NO_RESPONSE_SOA_QUERY
=> {} );
}
return
@results
;
}
sub
zone05 {
my
(
$class
,
$zone
) =
@_
;
my
@results
;
my
$p
= _retrieve_record_from_zone(
$zone
,
$zone
->name,
q{SOA}
);
if
(
$p
and
my
(
$soa
) =
$p
->get_records(
q{SOA}
,
q{answer}
) ) {
my
$soa_expire
=
$soa
->expire;
my
$soa_refresh
=
$soa
->refresh;
if
(
$soa_expire
<
$SOA_EXPIRE_MINIMUM_VALUE
) {
push
@results
,
info(
EXPIRE_MINIMUM_VALUE_LOWER
=> {
expire
=>
$soa_expire
,
required_expire
=>
$SOA_EXPIRE_MINIMUM_VALUE
,
}
);
}
if
(
$soa_expire
<
$soa_refresh
) {
push
@results
,
info(
EXPIRE_LOWER_THAN_REFRESH
=> {
expire
=>
$soa_expire
,
refresh
=>
$soa_refresh
,
}
);
}
if
( not
scalar
@results
) {
push
@results
,
info(
EXPIRE_MINIMUM_VALUE_OK
=> {
expire
=>
$soa_expire
,
refresh
=>
$soa_refresh
,
required_expire
=>
$SOA_EXPIRE_MINIMUM_VALUE
,
}
);
}
}
else
{
push
@results
, info(
NO_RESPONSE_SOA_QUERY
=> {} );
}
return
@results
;
}
sub
zone06 {
my
(
$class
,
$zone
) =
@_
;
my
@results
;
my
$p
= _retrieve_record_from_zone(
$zone
,
$zone
->name,
q{SOA}
);
if
(
$p
and
my
(
$soa
) =
$p
->get_records(
q{SOA}
,
q{answer}
) ) {
my
$soa_minimum
=
$soa
->minimum;
if
(
$soa_minimum
>
$SOA_DEFAULT_TTL_MAXIMUM_VALUE
) {
push
@results
,
info(
SOA_DEFAULT_TTL_MAXIMUM_VALUE_HIGHER
=> {
minimum
=>
$soa_minimum
,
highest_minimum
=>
$SOA_DEFAULT_TTL_MAXIMUM_VALUE
,
}
);
}
elsif
(
$soa_minimum
<
$SOA_DEFAULT_TTL_MINIMUM_VALUE
) {
push
@results
,
info(
SOA_DEFAULT_TTL_MAXIMUM_VALUE_LOWER
=> {
minimum
=>
$soa_minimum
,
lowest_minimum
=>
$SOA_DEFAULT_TTL_MINIMUM_VALUE
,
}
);
}
else
{
push
@results
,
info(
SOA_DEFAULT_TTL_MAXIMUM_VALUE_OK
=> {
minimum
=>
$soa_minimum
,
highest_minimum
=>
$SOA_DEFAULT_TTL_MAXIMUM_VALUE
,
lowest_minimum
=>
$SOA_DEFAULT_TTL_MINIMUM_VALUE
,
}
);
}
}
else
{
push
@results
, info(
NO_RESPONSE_SOA_QUERY
=> {} );
}
return
@results
;
}
sub
zone07 {
my
(
$class
,
$zone
) =
@_
;
my
@results
;
my
$p
= _retrieve_record_from_zone(
$zone
,
$zone
->name,
q{SOA}
);
if
(
$p
and
my
(
$soa
) =
$p
->get_records(
q{SOA}
,
q{answer}
) ) {
my
$soa_mname
=
$soa
->mname;
$soa_mname
=~ s/[.]\z//smx;
my
$addresses_nb
= 0;
foreach
my
$address_type
(
q{A}
,
q{AAAA}
) {
my
$p_mname
= Zonemaster::Engine::Recursor->recurse(
$soa_mname
,
$address_type
);
if
(
$p_mname
) {
if
(
$p_mname
->has_rrs_of_type_for_name(
$address_type
,
$soa_mname
) ) {
$addresses_nb
++;
}
if
(
$p_mname
->has_rrs_of_type_for_name(
q{CNAME}
,
$soa_mname
) ) {
push
@results
,
info(
MNAME_IS_CNAME
=> {
mname
=>
$soa_mname
,
}
);
}
else
{
push
@results
,
info(
MNAME_IS_NOT_CNAME
=> {
mname
=>
$soa_mname
,
}
);
}
}
}
if
( not
$addresses_nb
) {
push
@results
,
info(
MNAME_HAS_NO_ADDRESS
=> {
mname
=>
$soa_mname
,
}
);
}
}
else
{
push
@results
, info(
NO_RESPONSE_SOA_QUERY
=> {} );
}
return
@results
;
}
sub
zone08 {
my
(
$class
,
$zone
) =
@_
;
my
@results
;
my
$p
=
$zone
->query_auth(
$zone
->name,
q{MX}
);
if
(
$p
) {
if
(
$p
->has_rrs_of_type_for_name(
q{CNAME}
,
$zone
->name ) ) {
push
@results
, info(
MX_RECORD_IS_CNAME
=> {} );
}
else
{
push
@results
, info(
MX_RECORD_IS_NOT_CNAME
=> {} );
}
}
else
{
push
@results
, info(
NO_RESPONSE_MX_QUERY
=> {} );
}
return
@results
;
}
sub
zone09 {
my
(
$class
,
$zone
) =
@_
;
my
@results
;
my
$info
;
my
$p
=
$zone
->query_auth(
$zone
->name,
q{MX}
);
if
(
$p
) {
if
( not
$p
->has_rrs_of_type_for_name(
q{MX}
,
$zone
->name ) ) {
my
$p_a
= _retrieve_record_from_zone(
$zone
,
$zone
->name,
q{A}
);
my
$p_aaaa
= _retrieve_record_from_zone(
$zone
,
$zone
->name,
q{AAAA}
);
if
(
( not
defined
$p_a
and not
defined
$p_aaaa
)
or ( ( not
defined
$p_a
or not
$p_a
->has_rrs_of_type_for_name(
q{A}
,
$zone
->name ) )
and ( not
defined
$p_aaaa
or not
$p_aaaa
->has_rrs_of_type_for_name(
q{AAAA}
,
$zone
->name ) ) )
)
{
push
@results
, info(
NO_MX_RECORD
=> {} );
}
else
{
my
@as
=
defined
$p_a
?
$p_a
->get_records_for_name(
q{A}
,
$zone
->name ) : ();
my
@aaas
=
defined
$p_aaaa
?
$p_aaaa
->get_records_for_name(
q{AAAA}
,
$zone
->name ) : ();
$info
=
join
q{/}
,
map
{
$_
=~ /:/smx ?
q{AAAA=}
.
$_
->address :
q{A=}
.
$_
->address } (
@as
,
@aaas
);
}
}
else
{
my
@mx
=
$p
->get_records_for_name(
q{MX}
,
$zone
->name );
for
my
$mx
(
@mx
) {
my
$tmp
=
q{MX=}
;
$tmp
.=
$mx
->exchange;
$tmp
=~ s/[.]\z//smx;
$info
.=
$tmp
.
q{/}
;
}
chop
$info
;
}
if
( not
scalar
@results
) {
push
@results
, info(
MX_RECORD_EXISTS
=> {
info
=>
$info
} );
}
}
else
{
push
@results
, info(
NO_RESPONSE_MX_QUERY
=> {} );
}
return
@results
;
}
sub
_retrieve_record_from_zone {
my
(
$zone
,
$name
,
$type
) =
@_
;
foreach
my
$ns
( @{ Zonemaster::Engine::TestMethods->method5(
$zone
) } ) {
if
( _is_ip_version_disabled(
$ns
) ) {
next
;
}
my
$p
=
$ns
->query(
$name
,
$type
);
if
(
defined
$p
and
scalar
$p
->get_records(
$type
,
q{answer}
) > 0 ) {
return
$p
if
$p
->aa;
}
}
return
;
}
sub
_is_ip_version_disabled {
my
$ns
=
shift
;
if
( not Zonemaster::Engine->config->ipv4_ok and
$ns
->address->version ==
$IP_VERSION_4
) {
Zonemaster::Engine->logger->add(
SKIP_IPV4_DISABLED
=> {
ns
=>
"$ns"
} );
return
1;
}
if
( not Zonemaster::Engine->config->ipv6_ok and
$ns
->address->version ==
$IP_VERSION_6
) {
Zonemaster::Engine->logger->add(
SKIP_IPV6_DISABLED
=> {
ns
=>
"$ns"
} );
return
1;
}
return
;
}
1;
Hide Show 75 lines of Pod