File Coverage

blib/lib/Zonemaster/Engine/Test/Nameserver.pm
Criterion Covered Total %
statement 219 300 73.0
branch 96 168 57.1
condition 45 135 33.3
subroutine 21 24 87.5
pod 13 13 100.0
total 394 640 61.5


line stmt bran cond sub pod time code
1             package Zonemaster::Engine::Test::Nameserver;
2              
3 26     26   11325 use version; our $VERSION = version->declare("v1.0.9");
  26         64  
  26         161  
4              
5 26     26   2184 use strict;
  26         58  
  26         515  
6 26     26   127 use warnings;
  26         54  
  26         593  
7              
8 26     26   390 use 5.014002;
  26         206  
9              
10 26     26   1482 use Zonemaster::Engine;
  26         84  
  26         585  
11 26     26   139 use Zonemaster::Engine::Util;
  26         45  
  26         1486  
12 26     26   146 use Zonemaster::Engine::Test::Address;
  26         50  
  26         580  
13 26     26   122 use Zonemaster::Engine::Constants qw[:ip];
  26         50  
  26         2656  
14              
15 26     26   160 use List::MoreUtils qw[uniq none];
  26         117  
  26         200  
16              
17             ###
18             ### Entry Points
19             ###
20              
21             sub all {
22 4     4 1 13 my ( $class, $zone ) = @_;
23 4         8 my @results;
24              
25 4 100       14 if ( Zonemaster::Engine->config->should_run( 'nameserver01' ) ) {
26 1         6 push @results, $class->nameserver01( $zone );
27             }
28 4 100       13 if ( Zonemaster::Engine->config->should_run( 'nameserver02' ) ) {
29 1         6 push @results, $class->nameserver02( $zone );
30             }
31 4 100       18 if ( Zonemaster::Engine->config->should_run( 'nameserver03' ) ) {
32 2         12 push @results, $class->nameserver03( $zone );
33             }
34 4 100       16 if ( Zonemaster::Engine->config->should_run( 'nameserver04' ) ) {
35 2         12 push @results, $class->nameserver04( $zone );
36             }
37 4 100       16 if ( Zonemaster::Engine->config->should_run( 'nameserver05' ) ) {
38 2         13 push @results, $class->nameserver05( $zone );
39             }
40 4 100       17 if ( Zonemaster::Engine->config->should_run( 'nameserver06' ) ) {
41 1         6 push @results, $class->nameserver06( $zone );
42             }
43 4 100       14 if ( Zonemaster::Engine->config->should_run( 'nameserver07' ) ) {
44 1         5 push @results, $class->nameserver07( $zone );
45             }
46 4 100       15 if ( Zonemaster::Engine->config->should_run( 'nameserver08' ) ) {
47 1         5 push @results, $class->nameserver08( $zone );
48             }
49 3 50       10 if ( Zonemaster::Engine->config->should_run( 'nameserver09' ) ) {
50 0         0 push @results, $class->nameserver09( $zone );
51             }
52              
53 3         15 return @results;
54             } ## end sub all
55              
56             ###
57             ### Metadata Exposure
58             ###
59              
60             sub metadata {
61 19     19 1 49 my ( $class ) = @_;
62              
63             return {
64 19         302 nameserver01 => [
65             qw(
66             IS_A_RECURSOR
67             NO_RECURSOR
68             RECURSIVITY_UNDEF
69             )
70             ],
71             nameserver02 => [
72             qw(
73             EDNS0_BAD_QUERY
74             EDNS0_BAD_ANSWER
75             EDNS0_SUPPORT
76             )
77             ],
78             nameserver03 => [
79             qw(
80             AXFR_FAILURE
81             AXFR_AVAILABLE
82             )
83             ],
84             nameserver04 => [
85             qw(
86             DIFFERENT_SOURCE_IP
87             SAME_SOURCE_IP
88             )
89             ],
90             nameserver05 => [
91             qw(
92             QUERY_DROPPED
93             ANSWER_BAD_RCODE
94             IPV4_DISABLED
95             IPV6_DISABLED
96             )
97             ],
98             nameserver06 => [
99             qw(
100             CAN_NOT_BE_RESOLVED
101             CAN_BE_RESOLVED
102             NO_RESOLUTION
103             )
104             ],
105             nameserver07 => [
106             qw(
107             UPWARD_REFERRAL_IRRELEVANT
108             UPWARD_REFERRAL
109             NO_UPWARD_REFERRAL
110             )
111             ],
112             nameserver08 => [
113             qw(
114             QNAME_CASE_INSENSITIVE
115             QNAME_CASE_SENSITIVE
116             )
117             ],
118             nameserver09 => [
119             qw(
120             CASE_QUERY_SAME_ANSWER
121             CASE_QUERY_DIFFERENT_ANSWER
122             CASE_QUERY_SAME_RC
123             CASE_QUERY_DIFFERENT_RC
124             CASE_QUERY_NO_ANSWER
125             CASE_QUERIES_RESULTS_OK
126             CASE_QUERIES_RESULTS_DIFFER
127             )
128             ],
129             };
130             } ## end sub metadata
131              
132             sub translation {
133             return {
134 1     1 1 26 'AAAA_WELL_PROCESSED' => 'The following nameservers answer AAAA queries without problems : {names}.',
135             'EDNS0_BAD_QUERY' => 'Nameserver {ns}/{address} does not support EDNS0 (replies with FORMERR).',
136             'DIFFERENT_SOURCE_IP' =>
137             'Nameserver {ns}/{address} replies on a SOA query with a different source address ({source}).',
138             'SAME_SOURCE_IP' => 'All nameservers reply with same IP used to query them.',
139             'AXFR_AVAILABLE' => 'Nameserver {ns}/{address} allow zone transfer using AXFR.',
140             'AXFR_FAILURE' => 'AXFR not available on nameserver {ns}/{address}.',
141             'QUERY_DROPPED' => 'Nameserver {ns}/{address} dropped AAAA query.',
142             'IS_A_RECURSOR' => 'Nameserver {ns}/{address} is a recursor.',
143             'NO_RECURSOR' => 'None of the following nameservers is a recursor : {names}.',
144             'RECURSIVITY_UNDEF' => 'Can not determine nameservers recursivity.',
145             'ANSWER_BAD_RCODE' => 'Nameserver {ns}/{address} answered AAAA query with an unexpected rcode ({rcode}).',
146             'EDNS0_BAD_ANSWER' => 'Nameserver {ns}/{address} does not support EDNS0 (OPT not set in reply).',
147             'EDNS0_SUPPORT' => 'The following nameservers support EDNS0 : {names}.',
148             'CAN_NOT_BE_RESOLVED' => 'The following nameservers failed to resolve to an IP address : {names}.',
149             'CAN_BE_RESOLVED' => 'All nameservers succeeded to resolve to an IP address.',
150             'NO_RESOLUTION' => 'No nameservers succeeded to resolve to an IP address.',
151             'IPV4_DISABLED' => 'IPv4 is disabled, not sending "{rrtype}" query to {ns}/{address}.',
152             'IPV6_DISABLED' => 'IPv6 is disabled, not sending "{rrtype}" query to {ns}/{address}.',
153             'UPWARD_REFERRAL_IRRELEVANT' => 'Upward referral tests skipped for root zone.',
154             'UPWARD_REFERRAL' => 'Nameserver {ns}/{address} returns an upward referral.',
155             'NO_UPWARD_REFERRAL' => 'None of the following nameservers returns an upward referral : {names}.',
156             'QNAME_CASE_SENSITIVE' => 'Nameserver {ns}/{address} preserves original case of queried names.',
157             'QNAME_CASE_INSENSITIVE' => 'Nameserver {ns}/{address} does not preserve original case of queried names.',
158             'CASE_QUERY_SAME_ANSWER' =>
159             'When asked for {type} records on "{query1}" and "{query2}", nameserver {ns}/{address} returns same answers.',
160             'CASE_QUERY_DIFFERENT_ANSWER' =>
161             'When asked for {type} records on "{query1}" and "{query2}", nameserver {ns}/{address} returns different answers.',
162             'CASE_QUERY_SAME_RC' =>
163             'When asked for {type} records on "{query1}" and "{query2}", nameserver {ns}/{address} returns same RCODE "{rcode}".',
164             'CASE_QUERY_DIFFERENT_RC' =>
165             'When asked for {type} records on "{query1}" and "{query2}", nameserver {ns}/{address} returns different RCODE ("{rcode1}" vs "{rcode2}").',
166             'CASE_QUERY_NO_ANSWER' =>
167             'When asked for {type} records on "{query}", nameserver {ns}/{address} returns nothing.',
168             'CASE_QUERIES_RESULTS_OK' =>
169             'When asked for {type} records on "{query}" with different cases, all servers reply consistently.',
170             'CASE_QUERIES_RESULTS_DIFFER' =>
171             'When asked for {type} records on "{query}" with different cases, all servers do not reply consistently.',
172             };
173             } ## end sub translation
174              
175             sub version {
176 21     21 1 233 return "$Zonemaster::Engine::Test::Nameserver::VERSION";
177             }
178              
179             sub nameserver01 {
180 7     7 1 20 my ( $class, $zone ) = @_;
181 7         18 my $nonexistent_name = q{xx--domain-cannot-exist.xx--illegal-syntax-tld};
182 7         14 my $unlikely_label = q{xx--domain-should-not-exist};
183 7         25 my @existing_tld = qw{fr re pm tf yt wf si};
184 7         27 my @results;
185             my %ips;
186 7         0 my %nsnames;
187 7         14 my %is_not_recursor = ();
188              
189 7         17 foreach
190 7         38 my $local_ns ( @{ Zonemaster::Engine::TestMethods->method4( $zone ) }, @{ Zonemaster::Engine::TestMethods->method5( $zone ) } )
  7         39  
191             {
192              
193 172 50 33     9660 next if ( not Zonemaster::Engine->config->ipv6_ok and $local_ns->address->version == $IP_VERSION_6 );
194              
195 172 50 33     352 next if ( not Zonemaster::Engine->config->ipv4_ok and $local_ns->address->version == $IP_VERSION_4 );
196              
197 172 100       4752 next if $ips{ $local_ns->address->short };
198              
199 100         6797 my $p = $local_ns->query( $nonexistent_name, q{SOA}, { recurse => 1 } );
200              
201 100 50       252 if ( $p ) {
202 100 100 33     292 if ( $p->rcode eq q{REFUSED} ) {
    50 33        
    50 33        
    50 33        
    50          
203 26         944 $is_not_recursor{ $local_ns->address->short }++;
204             }
205             elsif ( $p->rcode eq q{SERVFAIL} ) {
206 0         0 $is_not_recursor{ $local_ns->address->short }++;
207             }
208             elsif ( $p->rcode eq q{NXDOMAIN} and not $p->aa ) {
209 0         0 push @results,
210             info(
211             IS_A_RECURSOR => {
212             ns => $local_ns->name,
213             address => $local_ns->address->short,
214             dname => $nonexistent_name,
215             }
216             );
217             }
218             elsif ( $p->is_redirect and not $p->aa ) {
219 0         0 $is_not_recursor{ $local_ns->address->short }++;
220             }
221             elsif ( not $p->is_redirect and not $p->aa and not $p->answer and $p->rcode eq q{NOERROR} ) {
222 0         0 $is_not_recursor{ $local_ns->address->short }++;
223             }
224 100         4717 $nsnames{ $local_ns->name }++;
225 100         2460 $ips{ $local_ns->address->short }++;
226             }
227              
228             } ## end foreach my $local_ns ( @{ Zonemaster::Engine::TestMethods...})
229              
230 7         757 my $ips_string = join '#', sort keys %ips;
231 7         37 my $is_not_recursor_string = join '#', sort keys %is_not_recursor;
232 7 100 66     62 if ( $ips_string and $ips_string eq $is_not_recursor_string ) {
    50          
233 3         29 push @results,
234             info(
235             NO_RECURSOR => {
236             names => join( q{,}, sort keys %nsnames ),
237             }
238             );
239             }
240 0         0 elsif ( not grep { $_->tag eq q{IS_A_RECURSOR} } @results ) {
241 4         11 foreach my $tld ( @existing_tld ) {
242              
243 16 50       461 next if $tld eq $zone->name;
244 16         44 my $checking_name = $unlikely_label . q{.} . $tld;
245 16         34 %is_not_recursor = ();
246 16         54 %ips = ();
247              
248 16         30 foreach my $local_ns ( @{ Zonemaster::Engine::TestMethods->method4( $zone ) }, @{ Zonemaster::Engine::TestMethods->method5( $zone ) } ) {
  16         74  
  16         60  
249              
250 264 50 33     14341 next if ( not Zonemaster::Engine->config->ipv6_ok and $local_ns->address->version == $IP_VERSION_6 );
251              
252 264 50 33     535 next if ( not Zonemaster::Engine->config->ipv4_ok and $local_ns->address->version == $IP_VERSION_4 );
253              
254 264 100       7190 next if $ips{ $local_ns->address->short };
255              
256 170 50       14638 next if $is_not_recursor{ $local_ns->address->short };
257              
258 170         9430 my $p = $local_ns->query( $checking_name, q{SOA}, { recurse => 1 } );
259              
260 170 50       419 if ( $p ) {
261 170 50 66     506 if ( $p->rcode eq q{REFUSED} ) {
    50 66        
    50 33        
    100 33        
    50          
262 0         0 $is_not_recursor{ $local_ns->address->short }++;
263             }
264             elsif ( $p->rcode eq q{SERVFAIL} ) {
265 0         0 $is_not_recursor{ $local_ns->address->short }++;
266             }
267             elsif ( $p->rcode eq q{NXDOMAIN} and not $p->aa ) {
268 0         0 push @results,
269             info(
270             IS_A_RECURSOR => {
271             ns => $local_ns->name,
272             address => $local_ns->address->short,
273             dname => $checking_name,
274             }
275             );
276             }
277             elsif ( $p->is_redirect and not $p->aa ) {
278 58         2080 $is_not_recursor{ $local_ns->address->short }++;
279             }
280             elsif ( not $p->is_redirect and not $p->aa and not $p->answer and $p->rcode eq q{NOERROR} ) {
281 0         0 $is_not_recursor{ $local_ns->address->short }++;
282             }
283 170         8959 $nsnames{ $local_ns->name }++;
284 170         4224 $ips{ $local_ns->address->short }++;
285             }
286             }
287              
288 16         1668 my $ips_string = join '#', sort keys %ips;
289 16         71 my $is_not_recursor_string = join '#', sort keys %is_not_recursor;
290 16 100 66     81 if ( $ips_string and $ips_string eq $is_not_recursor_string ) {
291 2         29 push @results,
292             info(
293             NO_RECURSOR => {
294             names => join( q{,}, sort keys %nsnames ),
295             }
296             );
297 2         10 last;
298             }
299              
300 14 50       50 if ( grep { $_->tag eq q{IS_A_RECURSOR} } @results ) {
  0         0  
301 0         0 last;
302             }
303             }
304              
305 4 100 66     21 if ( not grep { $_->tag eq q{IS_A_RECURSOR} } @results and not grep { $_->tag eq q{NO_RECURSOR} } @results ) {
  2         57  
  2         52  
306 2         13 push @results,
307             info(
308             RECURSIVITY_UNDEF => {}
309             );
310             }
311             }
312              
313 7         100 return @results;
314             } ## end sub nameserver01
315              
316             sub nameserver02 {
317 3     3 1 9 my ( $class, $zone ) = @_;
318 3         8 my @results;
319             my %nsnames_and_ip;
320              
321 3         9 foreach
322 3         14 my $local_ns ( @{ Zonemaster::Engine::TestMethods->method4( $zone ) }, @{ Zonemaster::Engine::TestMethods->method5( $zone ) } )
  3         19  
323             {
324              
325 20 50 33     812 next if ( not Zonemaster::Engine->config->ipv6_ok and $local_ns->address->version == $IP_VERSION_6 );
326              
327 20 50 33     39 next if ( not Zonemaster::Engine->config->ipv4_ok and $local_ns->address->version == $IP_VERSION_4 );
328              
329 20 100       523 next if $nsnames_and_ip{ $local_ns->name->string . q{/} . $local_ns->address->short };
330              
331 10         693 my $p = $local_ns->query( $zone->name, q{SOA}, { edns_size => 512 } );
332 10 50       29 if ( $p ) {
333 10 50       31 if ( $p->rcode eq q{FORMERR} ) {
334 0         0 push @results,
335             info(
336             EDNS0_BAD_QUERY => {
337             ns => $local_ns->name,
338             address => $local_ns->address->short,
339             }
340             );
341             }
342             else {
343 10 100       144 if ( not $p->has_edns ) {
344 1         38 push @results,
345             info(
346             EDNS0_BAD_ANSWER => {
347             ns => $local_ns->name,
348             address => $local_ns->address->short,
349             }
350             );
351             }
352             }
353             } ## end if ( $p )
354              
355 10         344 $nsnames_and_ip{ $local_ns->name->string . q{/} . $local_ns->address->short }++;
356             } ## end foreach my $local_ns ( @{ Zonemaster::Engine::TestMethods...})
357              
358 3 100 66     161 if ( scalar keys %nsnames_and_ip and not scalar @results ) {
359 2         14 push @results,
360             info(
361             EDNS0_SUPPORT => {
362             names => join( q{,}, keys %nsnames_and_ip ),
363             }
364             );
365             }
366              
367 3         17 return @results;
368             } ## end sub nameserver02
369              
370             sub nameserver03 {
371 4     4 1 13 my ( $class, $zone ) = @_;
372 4         10 my @results;
373             my %nsnames_and_ip;
374              
375 4         10 foreach
376 4         28 my $local_ns ( @{ Zonemaster::Engine::TestMethods->method4( $zone ) }, @{ Zonemaster::Engine::TestMethods->method5( $zone ) } )
  4         22  
377             {
378              
379 32 50 33     1433 next if ( not Zonemaster::Engine->config->ipv6_ok and $local_ns->address->version == $IP_VERSION_6 );
380              
381 32 50 33     74 next if ( not Zonemaster::Engine->config->ipv4_ok and $local_ns->address->version == $IP_VERSION_4 );
382              
383 32 100       903 next if $nsnames_and_ip{ $local_ns->name->string . q{/} . $local_ns->address->short };
384              
385 16         825 my $first_rr;
386             eval {
387 16     0   434 $local_ns->axfr( $zone->name, sub { ( $first_rr ) = @_; return 0; } );
  0         0  
  0         0  
388 0         0 1;
389 16 50       28 } or do {
390 16         1429 push @results,
391             info(
392             AXFR_FAILURE => {
393             ns => $local_ns->name->string,
394             address => $local_ns->address->short,
395             }
396             );
397             };
398              
399 16 50 33     94 if ( $first_rr and $first_rr->type eq q{SOA} ) {
400 0         0 push @results,
401             info(
402             AXFR_AVAILABLE => {
403             ns => $local_ns->name->string,
404             address => $local_ns->address->short,
405             }
406             );
407             }
408              
409 16         399 $nsnames_and_ip{ $local_ns->name->string . q{/} . $local_ns->address->short }++;
410             } ## end foreach my $local_ns ( @{ Zonemaster::Engine::TestMethods...})
411              
412 4         249 return @results;
413             } ## end sub nameserver03
414              
415             sub nameserver04 {
416 3     3 1 10 my ( $class, $zone ) = @_;
417 3         6 my @results;
418             my %nsnames_and_ip;
419              
420 3         7 foreach
421 3         16 my $local_ns ( @{ Zonemaster::Engine::TestMethods->method4( $zone ) }, @{ Zonemaster::Engine::TestMethods->method5( $zone ) } )
  3         21  
422             {
423              
424 36 50 33     1913 next if ( not Zonemaster::Engine->config->ipv6_ok and $local_ns->address->version == $IP_VERSION_6 );
425              
426 36 50 33     82 next if ( not Zonemaster::Engine->config->ipv4_ok and $local_ns->address->version == $IP_VERSION_4 );
427              
428 36 100       1039 next if $nsnames_and_ip{ $local_ns->name->string . q{/} . $local_ns->address->short };
429              
430 18         1561 my $p = $local_ns->query( $zone->name, q{SOA} );
431 18 50       49 if ( $p ) {
432 18 50 33     62 if ( $p->answerfrom and ( $local_ns->address->short ne Zonemaster::Engine::Net::IP->new( $p->answerfrom )->short ) ) {
433 0         0 push @results,
434             info(
435             DIFFERENT_SOURCE_IP => {
436             ns => $local_ns->name->string,
437             address => $local_ns->address->short,
438             source => $p->answerfrom,
439             }
440             );
441             }
442             }
443 18         1658 $nsnames_and_ip{ $local_ns->name->string . q{/} . $local_ns->address->short }++;
444             } ## end foreach my $local_ns ( @{ Zonemaster::Engine::TestMethods...})
445              
446 3 50 33     335 if ( scalar keys %nsnames_and_ip and not scalar @results ) {
447 3         31 push @results,
448             info(
449             SAME_SOURCE_IP => {
450             names => join( q{,}, keys %nsnames_and_ip ),
451             }
452             );
453             }
454              
455 3         19 return @results;
456             } ## end sub nameserver04
457              
458             sub nameserver05 {
459 3     3 1 13 my ( $class, $zone ) = @_;
460 3         7 my @results;
461             my %nsnames_and_ip;
462 3         9 my $query_type = q{AAAA};
463              
464 3         6 foreach
465 3         22 my $local_ns ( @{ Zonemaster::Engine::TestMethods->method4( $zone ) }, @{ Zonemaster::Engine::TestMethods->method5( $zone ) } )
  3         19  
466             {
467              
468 36 100       1916 next if $nsnames_and_ip{ $local_ns->name->string . q{/} . $local_ns->address->short };
469              
470 18 50 33     1146 if ( not Zonemaster::Engine->config->ipv6_ok and $local_ns->address->version == $IP_VERSION_6 ) {
471 0         0 push @results,
472             info(
473             IPV6_DISABLED => {
474             ns => $local_ns->name->string,
475             address => $local_ns->address->short,
476             rrtype => $query_type,
477             }
478             );
479 0         0 next;
480             }
481              
482 18 50 33     45 if ( not Zonemaster::Engine->config->ipv4_ok and $local_ns->address->version == $IP_VERSION_4 ) {
483 0         0 push @results,
484             info(
485             IPV4_DISABLED => {
486             ns => $local_ns->name->string,
487             address => $local_ns->address->short,
488             rrtype => $query_type,
489             }
490             );
491 0         0 next;
492             }
493              
494 18         514 $nsnames_and_ip{ $local_ns->name->string . q{/} . $local_ns->address->short }++;
495              
496 18         1440 my $p = $local_ns->query( $zone->name, $query_type );
497              
498 18 50       58 if ( not $p ) {
499 0         0 push @results,
500             info(
501             QUERY_DROPPED => {
502             ns => $local_ns->name->string,
503             address => $local_ns->address->short,
504             }
505             );
506 0         0 next;
507             }
508              
509 18 50 33     70 next if not scalar $p->answer and $p->rcode eq q{NOERROR};
510              
511 18 50 33     249 if ( $p->rcode eq q{FORMERR}
      33        
      33        
512             or $p->rcode eq q{SERVFAIL}
513             or $p->rcode eq q{NXDOMAIN}
514             or $p->rcode eq q{NOTIMPL} )
515             {
516 0         0 push @results,
517             info(
518             ANSWER_BAD_RCODE => {
519             ns => $local_ns->name->string,
520             address => $local_ns->address->short,
521             rcode => $p->rcode,
522             }
523             );
524 0         0 next;
525             }
526              
527             } ## end foreach my $local_ns ( @{ Zonemaster::Engine::TestMethods...})
528              
529 3 50 33 0   303 if ( scalar keys %nsnames_and_ip and none { $_->tag eq q{ANSWER_BAD_RCODE} } @results ) {
  0         0  
530 3         29 push @results,
531             info(
532             AAAA_WELL_PROCESSED => {
533             names => join( q{,}, keys %nsnames_and_ip ),
534             }
535             );
536             }
537              
538 3         23 return @results;
539             } ## end sub nameserver05
540              
541             sub nameserver06 {
542 4     4 1 16 my ( $class, $zone ) = @_;
543 4         9 my @results;
544 15         47 my @all_nsnames = uniq map { lc( $_->string ) } @{ Zonemaster::Engine::TestMethods->method2( $zone ) },
  4         34  
545 4         10 @{ Zonemaster::Engine::TestMethods->method3( $zone ) };
  4         29  
546 18         413 my @all_nsnames_with_ip = uniq map { lc( $_->name->string ) } @{ Zonemaster::Engine::TestMethods->method4( $zone ) },
  4         23  
547 4         61 @{ Zonemaster::Engine::TestMethods->method5( $zone ) };
  4         25  
548 4         19 my @all_nsnames_without_ip;
549             my %diff;
550              
551 4         20 @diff{@all_nsnames} = undef;
552 4         14 delete @diff{@all_nsnames_with_ip};
553              
554 4         16 @all_nsnames_without_ip = keys %diff;
555 4 100 100     34 if ( scalar @all_nsnames_without_ip and scalar @all_nsnames_with_ip ) {
    100          
556 1         6 push @results,
557             info(
558             CAN_NOT_BE_RESOLVED => {
559             names => join( q{,}, @all_nsnames_without_ip ),
560             }
561             );
562             }
563             elsif ( not scalar @all_nsnames_with_ip ) {
564 1         12 push @results,
565             info(
566             NO_RESOLUTION => {
567             names => join( q{,}, @all_nsnames_without_ip ),
568             }
569             );
570             }
571             else {
572 2         8 push @results, info( CAN_BE_RESOLVED => {} );
573             }
574              
575 4         30 return @results;
576             } ## end sub nameserver06
577              
578             sub nameserver07 {
579 3     3 1 10 my ( $class, $zone ) = @_;
580 3         9 my @results;
581             my %nsnames_and_ip;
582 3         0 my %nsnames;
583              
584 3 100       76 if ( $zone->name eq q{.} ) {
585 2         10 push @results, info( UPWARD_REFERRAL_IRRELEVANT => {} );
586             }
587             else {
588 1         2 foreach my $local_ns ( @{ Zonemaster::Engine::TestMethods->method4( $zone ) },
  1         4  
589 1         4 @{ Zonemaster::Engine::TestMethods->method5( $zone ) } )
590             {
591 12 50 33     621 next if ( not Zonemaster::Engine->config->ipv6_ok and $local_ns->address->version == $IP_VERSION_6 );
592              
593 12 50 33     23 next if ( not Zonemaster::Engine->config->ipv4_ok and $local_ns->address->version == $IP_VERSION_4 );
594              
595 12 100       309 next if $nsnames_and_ip{ $local_ns->name->string . q{/} . $local_ns->address->short };
596              
597 6         365 my $p = $local_ns->query( q{.}, q{NS} );
598 6 50       16 if ( $p ) {
599 6         17 my @ns = $p->get_records( q{NS}, q{authority} );
600              
601 6 50       15 if ( @ns ) {
602 0         0 push @results,
603             info(
604             UPWARD_REFERRAL => {
605             ns => $local_ns->name->string,
606             address => $local_ns->address->short,
607             }
608             );
609             }
610             }
611 6         148 $nsnames{ $local_ns->name }++;
612 6         142 $nsnames_and_ip{ $local_ns->name->string . q{/} . $local_ns->address->short }++;
613             } ## end foreach my $local_ns ( @{ Zonemaster::Engine::TestMethods...})
614              
615 1 50 33     91 if ( scalar keys %nsnames_and_ip and not scalar @results ) {
616 1         10 push @results,
617             info(
618             NO_UPWARD_REFERRAL => {
619             names => join( q{,}, sort keys %nsnames ),
620             }
621             );
622             }
623             } ## end else [ if ( $zone->name eq q{.})]
624              
625 3         13 return @results;
626             } ## end sub nameserver07
627              
628             sub nameserver08 {
629 1     1 1 3 my ( $class, $zone ) = @_;
630 1         3 my @results;
631             my %nsnames_and_ip;
632 1         24 my $original_name = q{www.} . $zone->name->string;
633 1         3 my $randomized_uc_name;
634              
635 1         4 $original_name =~ s/[.]+\z//smgx;
636              
637 1         2 do {
638 1         4 $randomized_uc_name = scramble_case $original_name;
639             } while ( $randomized_uc_name eq $original_name );
640              
641 1         2 foreach
642 1         5 my $local_ns ( @{ Zonemaster::Engine::TestMethods->method4( $zone ) }, @{ Zonemaster::Engine::TestMethods->method5( $zone ) } )
  1         4  
643             {
644 1 50 33     6 next if ( not Zonemaster::Engine->config->ipv6_ok and $local_ns->address->version == $IP_VERSION_6 );
645              
646 1 50 33     4 next if ( not Zonemaster::Engine->config->ipv4_ok and $local_ns->address->version == $IP_VERSION_4 );
647              
648 1 50       27 next if $nsnames_and_ip{ $local_ns->name->string . q{/} . $local_ns->address->short };
649              
650 1         34 my $p = $local_ns->query( $randomized_uc_name, q{SOA} );
651              
652 0 0 0       if ( $p and my ( $qrr ) = $p->question() ) {
653 0           my $qrr_name = $qrr->name();
654 0           $qrr_name =~ s/\.\z//smgx;
655 0 0         if ( $qrr_name eq $randomized_uc_name ) {
656 0           push @results,
657             info(
658             QNAME_CASE_SENSITIVE => {
659             ns => $local_ns->name->string,
660             address => $local_ns->address->short,
661             dname => $randomized_uc_name,
662             }
663             );
664             }
665             else {
666 0           push @results,
667             info(
668             QNAME_CASE_INSENSITIVE => {
669             ns => $local_ns->name->string,
670             address => $local_ns->address->short,
671             dname => $randomized_uc_name,
672             }
673             );
674             }
675             } ## end if ( $p and my ( $qrr ...))
676 0           $nsnames_and_ip{ $local_ns->name->string . q{/} . $local_ns->address->short }++;
677             } ## end foreach my $local_ns ( @{ Zonemaster::Engine::TestMethods...})
678              
679 0           return @results;
680             } ## end sub nameserver08
681              
682             sub nameserver09 {
683 0     0 1   my ( $class, $zone ) = @_;
684 0           my @results;
685             my %nsnames_and_ip;
686 0           my $original_name = q{www.} . $zone->name->string;
687 0           my $record_type = q{SOA};
688 0           my $randomized_uc_name1;
689             my $randomized_uc_name2;
690 0           my $all_results_match = 1;
691              
692 0           $original_name =~ s/[.]+\z//smgx;
693              
694 0           do {
695 0           $randomized_uc_name1 = scramble_case $original_name;
696             } while ( $randomized_uc_name1 eq $original_name );
697              
698 0   0       do {
699 0           $randomized_uc_name2 = scramble_case $original_name;
700             } while ( $randomized_uc_name2 eq $original_name or $randomized_uc_name2 eq $randomized_uc_name1 );
701              
702 0           foreach
703 0           my $local_ns ( @{ Zonemaster::Engine::TestMethods->method4( $zone ) }, @{ Zonemaster::Engine::TestMethods->method5( $zone ) } )
  0            
704             {
705 0 0 0       next if ( not Zonemaster::Engine->config->ipv6_ok and $local_ns->address->version == $IP_VERSION_6 );
706              
707 0 0 0       next if ( not Zonemaster::Engine->config->ipv4_ok and $local_ns->address->version == $IP_VERSION_4 );
708              
709 0 0         next if $nsnames_and_ip{ $local_ns->name->string . q{/} . $local_ns->address->short };
710              
711 0           my $p1 = $local_ns->query( $randomized_uc_name1, $record_type );
712 0           my $p2 = $local_ns->query( $randomized_uc_name2, $record_type );
713              
714 0           my $answer1_string = q{};
715 0           my $answer2_string = q{};
716 0           my $json = JSON::PP->new->canonical->pretty;
717 0 0 0       if ( $p1 and scalar $p1->answer ) {
    0 0        
    0 0        
718              
719 0           my @answer1 = map { lc $_->string } sort $p1->answer;
  0            
720 0           $answer1_string = $json->encode( \@answer1 );
721              
722 0 0 0       if ( $p2 and scalar $p2->answer ) {
723              
724 0           my @answer2 = map { lc $_->string } sort $p2->answer;
  0            
725 0           $answer2_string = $json->encode( \@answer2 );
726             }
727              
728 0 0         if ( $answer1_string eq $answer2_string ) {
729 0           push @results,
730             info(
731             CASE_QUERY_SAME_ANSWER => {
732             ns => $local_ns->name,
733             address => $local_ns->address->short,
734             type => $record_type,
735             query1 => $randomized_uc_name1,
736             query2 => $randomized_uc_name2,
737             }
738             );
739             }
740             else {
741 0           $all_results_match = 0;
742 0           push @results,
743             info(
744             CASE_QUERY_DIFFERENT_ANSWER => {
745             ns => $local_ns->name,
746             address => $local_ns->address->short,
747             type => $record_type,
748             query1 => $randomized_uc_name1,
749             query2 => $randomized_uc_name2,
750             }
751             );
752             }
753              
754             } ## end if ( $p1 and scalar $p1...)
755             elsif ( $p1 and $p2 ) {
756              
757 0 0         if ( $p1->rcode eq $p2->rcode ) {
758 0           push @results,
759             info(
760             CASE_QUERY_SAME_RC => {
761             ns => $local_ns->name,
762             address => $local_ns->address->short,
763             type => $record_type,
764             query1 => $randomized_uc_name1,
765             query2 => $randomized_uc_name2,
766             rcode => $p1->rcode,
767             }
768             );
769             }
770             else {
771 0           $all_results_match = 0;
772 0           push @results,
773             info(
774             CASE_QUERY_DIFFERENT_RC => {
775             ns => $local_ns->name,
776             address => $local_ns->address->short,
777             type => $record_type,
778             query1 => $randomized_uc_name1,
779             query2 => $randomized_uc_name2,
780             rcode1 => $p1->rcode,
781             rcode2 => $p2->rcode,
782             }
783             );
784             }
785              
786             } ## end elsif ( $p1 and $p2 )
787             elsif ( $p1 or $p2 ) {
788 0           $all_results_match = 0;
789 0 0         push @results,
790             info(
791             CASE_QUERY_NO_ANSWER => {
792             ns => $local_ns->name,
793             address => $local_ns->address->short,
794             type => $record_type,
795             query => $p1 ? $randomized_uc_name1 : $randomized_uc_name2,
796             }
797             );
798             }
799              
800 0           $nsnames_and_ip{ $local_ns->name->string . q{/} . $local_ns->address->short }++;
801             } ## end foreach my $local_ns ( @{ Zonemaster::Engine::TestMethods...})
802              
803 0 0         if ( $all_results_match ) {
804 0           push @results,
805             info(
806             CASE_QUERIES_RESULTS_OK => {
807             type => $record_type,
808             query => $original_name,
809             }
810             );
811             }
812             else {
813 0           push @results,
814             info(
815             CASE_QUERIES_RESULTS_DIFFER => {
816             type => $record_type,
817             query => $original_name,
818             }
819             );
820             }
821              
822 0           return @results;
823             } ## end sub nameserver09
824              
825             1;
826              
827             =head1 NAME
828              
829             Zonemaster::Engine::Test::Nameserver - module implementing tests of the properties of a name server
830              
831             =head1 SYNOPSIS
832              
833             my @results = Zonemaster::Engine::Test::Nameserver->all($zone);
834              
835             =head1 METHODS
836              
837             =over
838              
839             =item all($zone)
840              
841             Runs the default set of tests and returns a list of log entries made by the tests
842              
843             =item translation()
844              
845             Returns a refernce to a hash with translation data. Used by the builtin translation system.
846              
847             =item metadata()
848              
849             Returns a reference to a hash, the keys of which are the names of all test methods in the module, and the corresponding values are references to
850             lists with all the tags that the method can use in log entries.
851              
852             =item version()
853              
854             Returns a version string for the module.
855              
856             =back
857              
858             =head1 TESTS
859              
860             =over
861              
862             =item nameserver01($zone)
863              
864             Verify that nameserver is not recursive.
865              
866             =item nameserver02($zone)
867              
868             Verify EDNS0 support.
869              
870             =item nameserver03($zone)
871              
872             Verify that zone transfer (AXFR) is not available.
873              
874             =item nameserver04($zone)
875              
876             Verify that replies from nameserver comes from the expected IP address.
877              
878             =item nameserver05($zone)
879              
880             Verify behaviour against AAAA queries.
881              
882             =item nameserver06($zone)
883              
884             Verify that each nameserver can be resolved to an IP address.
885              
886             =item nameserver07($zone)
887              
888             Check whether authoritative name servers return an upward referral.
889              
890             =item nameserver08($zone)
891              
892             Check whether authoritative name servers responses match the case of every letter in QNAME.
893              
894             =item nameserver09($zone)
895              
896             Check whether authoritative name servers return same results for equivalent names with different cases in the request.
897              
898             =back
899              
900             =cut