Zonemaster-Engine
view release on metacpan or search on metacpan
t/TestUtil.pm view on Meta::CPAN
an array of strings (mandatory message tags), which could be empty, or undef
=item *
an array of strings (forbidden message tags), which could be empty, or undef
=item *
an array of name server expressions for undelegated name servers
=item *
an array of DS expressions for "undelegated" DS
=back
If the array of mandatory message tags is C<undef>, it means that any message tag
in "alltags" not explicitly forbidden must be emitted.
If the array of forbidden message tags is C<undef>, it means that any message tag
in "alltags" not explicitly allowed must not be emitted.
Both of the above arrayrefs cannot be simultaneously C<undef>.
The arrays of mandatory message tags and forbidden message tags, respectively, can be empty, but not
both. At least one of the arrays must be non-empty.
The name server expression has the format "name-server-name/IP" or only "name-server-name". The DS expression
has the format "keytag,algorithm,type,digest". Those two expressions have the same format as the data for the
--ns and --ds options, respectively, in I<zonemaster-cli>.
=back
=head1 INTERNAL METHODS
=over
=item _check_ns_expressions()
_check_ns_expressions( $scenario_name, @ns_expressions );
Helper method that checks if the given nameserver expression(s) are valid.
Takes a string (scenario name) and a reference to an array of strings (nameserver expressions).
=item _check_ds_expressions()
_check_ds_expressions( $scenario_name, @ds_expressions );
Helper method that checks if the given delegation signer (DS) expression(s) are valid.
Takes a string (scenario name) and a reference to an array of strings (delegation signer expressions).
=back
=cut
sub _check_ns_expressions {
my ( $scenario, $ns_expressions ) = @_;
return if ! defined $ns_expressions;
foreach my $nsexp ( @{ $ns_expressions } ) {
my ( $ns, $ip ) = split m(/), $nsexp;
croak "Scenario $scenario: Name server name '$ns' in '$nsexp' is not valid" if $ns !~ /^[0-9A-Za-z-.]+$/;
if ( $ip ) {
croak "Scenario $scenario: IP address '$ip' in '$nsexp' is not valid"
unless validate_ipv4( $ip ) or validate_ipv6( $ip );
}
}
}
sub _check_ds_expressions {
my ( $scenario, $ds_expressions ) = @_;
return if ! defined $ds_expressions;
foreach my $str ( @{ $ds_expressions } ) {
my ( $tag, $algo, $type, $digest ) = split( /,/, $str );
croak "Scenario $scenario: DS expression '$str' is not valid" if
$tag !~ /^[0-9]+$/ or $algo !~ /^[0-9]+$/ or $type !~ /^[0-9]+$/ or $digest !~ /^[0-9a-fA-F]{4,}/;
}
}
sub perform_methodsv2_testing {
my ( $href_subtests, $selected_scenarios, $disabled_scenarios ) = @_;
my %subtests = %$href_subtests;
my @selected_scenarios = map {uc} split(/, */, $selected_scenarios) if $selected_scenarios;
my @disabled_scenarios = map {uc} split(/, */, $disabled_scenarios) if $disabled_scenarios;
my @untested_scenarios = ();
if ( $selected_scenarios ) {
foreach my $scen (@selected_scenarios) {
unless ( exists $subtests{$scen} ) {
croak "Scenario $scen does not exist";
}
}
}
for my $scenario ( sort ( keys %subtests ) ) {
next if $selected_scenarios and not grep /^$scenario$/, @selected_scenarios;
if ( @disabled_scenarios and grep /^$scenario$/, @disabled_scenarios ) {
push @untested_scenarios, $scenario;
next;
}
if ( ref( $scenario ) ne '' or $scenario ne uc($scenario) ) {
croak "Scenario $scenario: Key must (i) not be a reference and (ii) be in all uppercase";
}
if ( scalar @{ $subtests{$scenario} } != 6 ) {
croak "Scenario $scenario: Incorrect number of values. " .
"Correct format is: { SCENARIO_NAME => [" .
"testable " .
"zone_name, " .
"[ EXPECTED_PARENT_NS ], " .
"[ EXPECTED_DEL_NS ], " .
"[ EXPECTED_ZONE_NS ], " .
"[ UNDELEGATED_NS ], " .
" ] }";
}
my ( $testable,
$zone_name,
$expected_parent_ns,
$expected_del_ns,
$expected_zone_ns,
$undelegated_ns,
) = @{ $subtests{$scenario} };
if ( ref( $testable ) ne '' ) {
croak "Scenario $scenario: Type of testable must not be a reference";
}
if ( $testable != 1 and $testable != 0 ) {
croak "Scenario $scenario: Value of testable must be 0 or 1";
}
$testable = 1 if $selected_scenarios and grep /^$scenario$/, @selected_scenarios;
if ( ref( $zone_name ) ne '' ) {
croak "Scenario $scenario: Type of zone name must not be a reference";
}
if ( $zone_name !~ m(^[A-Za-z0-9/_.-]+$) ) {
croak "Scenario $scenario: Zone name '$zone_name' is not valid";
}
if ( defined( $expected_parent_ns ) and ref( $expected_parent_ns ) ne 'ARRAY' ) {
croak "Scenario $scenario: Incorrect reference type of expected parent IPs. Expected: ARRAY";
}
if ( defined( $expected_del_ns ) and ref( $expected_del_ns ) ne 'ARRAY' ) {
croak "Scenario $scenario: Incorrect reference type of expected delegation name servers. Expected: ARRAY";
}
if ( defined( $expected_zone_ns ) and ref( $expected_zone_ns ) ne 'ARRAY' ) {
croak "Scenario $scenario: Incorrect reference type of expected zone name servers. Expected: ARRAY";
}
if ( ref( $undelegated_ns ) ne 'ARRAY' ) {
croak "Scenario $scenario: Incorrect reference type of undelegated name servers expressions. Expected: ARRAY";
}
_check_ns_expressions( $scenario, $expected_parent_ns );
_check_ns_expressions( $scenario, $expected_del_ns );
_check_ns_expressions( $scenario, $expected_zone_ns );
_check_ns_expressions( $scenario, $undelegated_ns );
if ( not $testable ) {
push @untested_scenarios, $scenario;
next;
}
subtest $scenario => sub {
if ( @$undelegated_ns ) {
my %undel_ns;
foreach my $nsexp ( @$undelegated_ns ) {
my ( $ns, $ip ) = split m(/), $nsexp;
$undel_ns{$ns} //= [];
push @{ $undel_ns{$ns} }, $ip if $ip;
}
# Use default value of "fill_in_empty_oob_glue".
Zonemaster::Engine->add_fake_delegation( $zone_name => \%undel_ns, fill_in_empty_oob_glue => 1 );
}
# Method: get_parent_ns_names_and_ips()
my $method = 'get_parent_ns_names_and_ips';
subtest $method => sub {
my $res = Zonemaster::Engine::TestMethodsV2->$method( Zonemaster::Engine->zone( $zone_name ) );
if ( defined $expected_parent_ns ) {
ok( defined $res, "Result is defined" ) or diag "Unexpected undefined result";
foreach my $expected_ns ( @{ $expected_parent_ns } ) {
ok( grep( /^$expected_ns$/, @{ $res } ), "Name server '$expected_ns' is present" )
or diag "Expected but missing: $expected_ns";
}
ok( scalar @{ $res } == scalar @{ $expected_parent_ns }, "Number of name servers in both arrays match" )
or diag "Number of name servers in both arrays does not match (found ". scalar @{ $res } . ", expected " . @{ $expected_parent_ns } . ")"
or diag "Got:", explain [ map { "$_" } @$res ];
}
else {
ok( ! defined $res, "Result is undefined" ) or diag "Unexpected defined result";
}
};
# Methods: get_del_ns_names_and_ips() and get_zone_ns_names_and_ips()
my @method_names = qw( get_del_ns_names_and_ips get_zone_ns_names_and_ips );
my @expected_all_ns = ( $expected_del_ns, $expected_zone_ns );
foreach my $i ( 0..$#method_names ) {
my $method = $method_names[$i];
subtest $method => sub {
my $expected_res = $expected_all_ns[$i];
my $res = Zonemaster::Engine::TestMethodsV2->$method( Zonemaster::Engine->zone( $zone_name ) );
if ( defined $expected_res ) {
ok( defined $res, "Result is defined" ) or diag "Unexpected undefined result";
foreach my $expected_ns ( @{ $expected_res } ) {
ok( grep( /^$expected_ns$/, @{ $res } ), "Name server '$expected_ns' is present" )
or diag "Expected but missing: $expected_ns";
}
foreach my $ns ( @{ $res } ) {
ok( grep( /^$ns$/, @{ $expected_res } ), "Name server '$ns' is expected" )
or diag "Present but not expected: $ns";
}
ok( scalar @{ $res } == scalar @{ $expected_res }, "Number of name server in both arrays match" )
or diag "Number of name servers in both arrays does not match (found " . scalar @{ $res } . ", expected " . scalar @{ $expected_res }.")";
}
else {
ok( ! defined $res, "Result is undefined" ) or diag "Unexpected defined result";
}
};
}
# Methods: get_del_ns_names() and get_zone_ns_names()
@method_names = qw( get_del_ns_names get_zone_ns_names );
my $expected_del_ns_names = defined $expected_del_ns ?
[ uniq map { (split( m(/), $_ ))[0] } @{ $expected_del_ns } ] : undef;
my $expected_zone_ns_names = defined $expected_zone_ns ?
[ uniq map { (split( m(/), $_ ))[0] } @{ $expected_zone_ns } ] : undef;
t/TestUtil.pm view on Meta::CPAN
croak "Scenario $scenario: Incorrect reference type of forbidden message tags. Expected: ARRAY";
}
if ( ! defined( $mandatory_message_tags ) ) {
my @tags;
foreach my $t ( @$aref_alltags ) {
push @tags, $t unless grep( /^$t$/, @$forbidden_message_tags );
}
$mandatory_message_tags = \@tags;
}
if ( ! defined( $forbidden_message_tags ) ) {
my @tags;
foreach my $t ( @$aref_alltags ) {
push @tags, $t unless grep( /^$t$/, @$mandatory_message_tags );
}
$forbidden_message_tags = \@tags;
}
foreach my $tag ( @$mandatory_message_tags ) {
croak "Scenario $scenario: Invalid message tag in 'mandatory_message_tags': '$tag'" unless $tag =~ /^[A-Z]+[A-Z0-9_]*[A-Z0-9]$/;
}
foreach my $tag ( @$mandatory_message_tags ) {
unless ( grep( /^$tag$/, @$aref_alltags ) ) {
croak "Scenario $scenario: Message tag '$tag' in 'mandatory_message_tags' is missing in 'all_tags'";
}
}
foreach my $tag ( @$forbidden_message_tags ) {
croak "Scenario $scenario: Invalid message tag in 'forbidden_message_tags': '$tag'" unless $tag =~ /^[A-Z]+[A-Z0-9_]*[A-Z0-9]$/;
}
foreach my $tag ( @$forbidden_message_tags ) {
unless ( grep( /^$tag$/, @$aref_alltags ) ) {
croak "Scenario $scenario: Message tag '$tag' in 'forbidden_message_tags' is missing in 'all_tags'";
}
}
if ( ref( $undelegated_ns ) ne 'ARRAY' ) {
croak "Scenario $scenario: Incorrect reference type of undelegated name servers expressions. Expected: ARRAY";
}
if ( ref( $undelegated_ds ) ne 'ARRAY' ) {
croak "Scenario $scenario: Incorrect reference type of undelegated DS expressions. Expected: ARRAY";
}
_check_ns_expressions( $scenario, $undelegated_ns );
_check_ds_expressions( $scenario, $undelegated_ds );
if ( not $testable ) {
push @untested_scenarios, $scenario;
next;
}
subtest $scenario => sub {
if ( @$undelegated_ns ) {
my %undel_ns;
foreach my $nsexp ( @$undelegated_ns ) {
my ($ns, $ip) = split m(/), $nsexp;
$undel_ns{$ns} //= [];
push @{ $undel_ns{$ns} }, $ip if $ip;
}
# Use default value of "fill_in_empty_oob_glue".
Zonemaster::Engine->add_fake_delegation( $zone_name => \%undel_ns, fill_in_empty_oob_glue => 1 );
}
if ( @$undelegated_ds ) {
my @data;
foreach my $str ( @$undelegated_ds ) {
my ( $tag, $algo, $type, $digest ) = split( /,/, $str );
push @data, { keytag => $tag, algorithm => $algo, type => $type, digest => $digest };
}
Zonemaster::Engine->add_fake_ds( $zone_name => \@data );
}
my @messages = Zonemaster::Engine->test_method( $test_module, $test_case, Zonemaster::Engine->zone( $zone_name ) );
my %res = map { $_->tag => 1 } @messages;
if ( my ( $error ) = grep { $_->tag eq 'MODULE_ERROR' } @messages ) {
diag("Module died with error: " . $error->args->{"msg"});
fail("Test case executes properly");
}
else {
for my $tag ( @{ $mandatory_message_tags } ) {
ok( exists $res{$tag}, "Tag $tag is outputted" )
or diag "Tag '$tag' should have been outputted, but wasn't";
}
for my $tag ( @{ $forbidden_message_tags } ) {
ok( !exists $res{$tag}, "Tag $tag is not outputted" )
or diag "Tag '$tag' was not supposed to be outputted, but it was";
}
}
};
}
if ( @untested_scenarios ) {
warn "Untested scenarios:\n";
warn "\tScenario $_ cannot be tested.\n" for @untested_scenarios;
}
}
1;
( run in 1.157 second using v1.01-cache-2.11-cpan-71847e10f99 )