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   11585 use version; our $VERSION = version->declare("v1.0.9");
  26         68  
  26         163  
4              
5 26     26   2180 use strict;
  26         63  
  26         532  
6 26     26   119 use warnings;
  26         56  
  26         603  
7              
8 26     26   406 use 5.014002;
  26         205  
9              
10 26     26   1450 use Zonemaster::Engine;
  26         71  
  26         564  
11 26     26   135 use Zonemaster::Engine::Util;
  26         47  
  26         1432  
12 26     26   139 use Zonemaster::Engine::Test::Address;
  26         53  
  26         573  
13 26     26   130 use Zonemaster::Engine::Constants qw[:ip];
  26         53  
  26         2810  
14              
15 26     26   190 use List::MoreUtils qw[uniq none];
  26         116  
  26         189  
16              
17             ###
18             ### Entry Points
19             ###
20              
21             sub all {
22 4     4 1 15 my ( $class, $zone ) = @_;
23 4         7 my @results;
24              
25 4 100       17 if ( Zonemaster::Engine->config->should_run( 'nameserver01' ) ) {
26 1         4 push @results, $class->nameserver01( $zone );
27             }
28 4 100       18 if ( Zonemaster::Engine->config->should_run( 'nameserver02' ) ) {
29 1         7 push @results, $class->nameserver02( $zone );
30             }
31 4 100       18 if ( Zonemaster::Engine->config->should_run( 'nameserver03' ) ) {
32 2         16 push @results, $class->nameserver03( $zone );
33             }
34 4 100       13 if ( Zonemaster::Engine->config->should_run( 'nameserver04' ) ) {
35 2         12 push @results, $class->nameserver04( $zone );
36             }
37 4 100       17 if ( Zonemaster::Engine->config->should_run( 'nameserver05' ) ) {
38 2         14 push @results, $class->nameserver05( $zone );
39             }
40 4 100       19 if ( Zonemaster::Engine->config->should_run( 'nameserver06' ) ) {
41 1         6 push @results, $class->nameserver06( $zone );
42             }
43 4 100       18 if ( Zonemaster::Engine->config->should_run( 'nameserver07' ) ) {
44 1         6 push @results, $class->nameserver07( $zone );
45             }
46 4 100       21 if ( Zonemaster::Engine->config->should_run( 'nameserver08' ) ) {
47 1         8 push @results, $class->nameserver08( $zone );
48             }
49 3 50       12 if ( Zonemaster::Engine->config->should_run( 'nameserver09' ) ) {
50 0         0 push @results, $class->nameserver09( $zone );
51             }
52              
53 3         17 return @results;
54             } ## end sub all
55              
56             ###
57             ### Metadata Exposure
58             ###
59              
60             sub metadata {
61 19     19 1 52 my ( $class ) = @_;
62              
63             return {
64 19         330 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 23 '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 259 return "$Zonemaster::Engine::Test::Nameserver::VERSION";
177             }
178              
179             sub nameserver01 {
180 7     7 1 48 my ( $class, $zone ) = @_;
181 7         20 my $nonexistent_name = q{xx--domain-cannot-exist.xx--illegal-syntax-tld};
182 7         20 my $unlikely_label = q{xx--domain-should-not-exist};
183 7         34 my @existing_tld = qw{fr re pm tf yt wf si};
184 7         29 my @results;
185             my %ips;
186 7         0 my %nsnames;
187 7         17 my %is_not_recursor = ();
188              
189 7         17 foreach
190 7         53 my $local_ns ( @{ Zonemaster::Engine::TestMethods->method4( $zone ) }, @{ Zonemaster::Engine::TestMethods->method5( $zone ) } )
  7         49  
191             {
192              
193 172 50 33     10291 next if ( not Zonemaster::Engine->config->ipv6_ok and $local_ns->address->version == $IP_VERSION_6 );
194              
195 172 50 33     378 next if ( not Zonemaster::Engine->config->ipv4_ok and $local_ns->address->version == $IP_VERSION_4 );
196              
197 172 100       5132 next if $ips{ $local_ns->address->short };
198              
199 100         7398 my $p = $local_ns->query( $nonexistent_name, q{SOA}, { recurse => 1 } );
200              
201 100 50       267 if ( $p ) {
202 100 100 33     309 if ( $p->rcode eq q{REFUSED} ) {
    50 33        
    50 33        
    50 33        
    50          
203 26         1054 $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         5187 $nsnames{ $local_ns->name }++;
225 100         2674 $ips{ $local_ns->address->short }++;
226             }
227              
228             } ## end foreach my $local_ns ( @{ Zonemaster::Engine::TestMethods...})
229              
230 7         829 my $ips_string = join '#', sort keys %ips;
231 7         38 my $is_not_recursor_string = join '#', sort keys %is_not_recursor;
232 7 100 66     66 if ( $ips_string and $ips_string eq $is_not_recursor_string ) {
    50          
233 3         26 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         13 foreach my $tld ( @existing_tld ) {
242              
243 16 50       464 next if $tld eq $zone->name;
244 16         49 my $checking_name = $unlikely_label . q{.} . $tld;
245 16         37 %is_not_recursor = ();
246 16         62 %ips = ();
247              
248 16         30 foreach my $local_ns ( @{ Zonemaster::Engine::TestMethods->method4( $zone ) }, @{ Zonemaster::Engine::TestMethods->method5( $zone ) } ) {
  16         84  
  16         57  
249              
250 264 50 33     15338 next if ( not Zonemaster::Engine->config->ipv6_ok and $local_ns->address->version == $IP_VERSION_6 );
251              
252 264 50 33     637 next if ( not Zonemaster::Engine->config->ipv4_ok and $local_ns->address->version == $IP_VERSION_4 );
253              
254 264 100       7640 next if $ips{ $local_ns->address->short };
255              
256 170 50       16028 next if $is_not_recursor{ $local_ns->address->short };
257              
258 170         10301 my $p = $local_ns->query( $checking_name, q{SOA}, { recurse => 1 } );
259              
260 170 50       483 if ( $p ) {
261 170 50 66     511 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         2642 $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         10442 $nsnames{ $local_ns->name }++;
284 170         4562 $ips{ $local_ns->address->short }++;
285             }
286             }
287              
288 16         1728 my $ips_string = join '#', sort keys %ips;
289 16         84 my $is_not_recursor_string = join '#', sort keys %is_not_recursor;
290 16 100 66     94 if ( $ips_string and $ips_string eq $is_not_recursor_string ) {
291 2         32 push @results,
292             info(
293             NO_RECURSOR => {
294             names => join( q{,}, sort keys %nsnames ),
295             }
296             );
297 2         11 last;
298             }
299              
300 14 50       55 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         56  
  2         50  
306 2         13 push @results,
307             info(
308             RECURSIVITY_UNDEF => {}
309             );
310             }
311             }
312              
313 7         119 return @results;
314             } ## end sub nameserver01
315              
316             sub nameserver02 {
317 3     3 1 10 my ( $class, $zone ) = @_;
318 3         8 my @results;
319             my %nsnames_and_ip;
320              
321 3         6 foreach
322 3         18 my $local_ns ( @{ Zonemaster::Engine::TestMethods->method4( $zone ) }, @{ Zonemaster::Engine::TestMethods->method5( $zone ) } )
  3         18  
323             {
324              
325 20 50 33     1348 next if ( not Zonemaster::Engine->config->ipv6_ok and $local_ns->address->version == $IP_VERSION_6 );
326              
327 20 50 33     62 next if ( not Zonemaster::Engine->config->ipv4_ok and $local_ns->address->version == $IP_VERSION_4 );
328              
329 20 100       702 next if $nsnames_and_ip{ $local_ns->name->string . q{/} . $local_ns->address->short };
330              
331 10         934 my $p = $local_ns->query( $zone->name, q{SOA}, { edns_size => 512 } );
332 10 50       36 if ( $p ) {
333 10 50       45 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       208 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         429 $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     242 if ( scalar keys %nsnames_and_ip and not scalar @results ) {
359 2         23 push @results,
360             info(
361             EDNS0_SUPPORT => {
362             names => join( q{,}, keys %nsnames_and_ip ),
363             }
364             );
365             }
366              
367 3         23 return @results;
368             } ## end sub nameserver02
369              
370             sub nameserver03 {
371 4     4 1 14 my ( $class, $zone ) = @_;
372 4         30 my @results;
373             my %nsnames_and_ip;
374              
375 4         10 foreach
376 4         30 my $local_ns ( @{ Zonemaster::Engine::TestMethods->method4( $zone ) }, @{ Zonemaster::Engine::TestMethods->method5( $zone ) } )
  4         43  
377             {
378              
379 32 50 33     1497 next if ( not Zonemaster::Engine->config->ipv6_ok and $local_ns->address->version == $IP_VERSION_6 );
380              
381 32 50 33     72 next if ( not Zonemaster::Engine->config->ipv4_ok and $local_ns->address->version == $IP_VERSION_4 );
382              
383 32 100       933 next if $nsnames_and_ip{ $local_ns->name->string . q{/} . $local_ns->address->short };
384              
385 16         990 my $first_rr;
386             eval {
387 16     0   443 $local_ns->axfr( $zone->name, sub { ( $first_rr ) = @_; return 0; } );
  0         0  
  0         0  
388 0         0 1;
389 16 50       29 } or do {
390 16         1451 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     102 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         474 $nsnames_and_ip{ $local_ns->name->string . q{/} . $local_ns->address->short }++;
410             } ## end foreach my $local_ns ( @{ Zonemaster::Engine::TestMethods...})
411              
412 4         266 return @results;
413             } ## end sub nameserver03
414              
415             sub nameserver04 {
416 3     3 1 12 my ( $class, $zone ) = @_;
417 3         7 my @results;
418             my %nsnames_and_ip;
419              
420 3         7 foreach
421 3         21 my $local_ns ( @{ Zonemaster::Engine::TestMethods->method4( $zone ) }, @{ Zonemaster::Engine::TestMethods->method5( $zone ) } )
  3         17  
422             {
423              
424 36 50 33     1851 next if ( not Zonemaster::Engine->config->ipv6_ok and $local_ns->address->version == $IP_VERSION_6 );
425              
426 36 50 33     90 next if ( not Zonemaster::Engine->config->ipv4_ok and $local_ns->address->version == $IP_VERSION_4 );
427              
428 36 100       1108 next if $nsnames_and_ip{ $local_ns->name->string . q{/} . $local_ns->address->short };
429              
430 18         1648 my $p = $local_ns->query( $zone->name, q{SOA} );
431 18 50       55 if ( $p ) {
432 18 50 33     72 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         1694 $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     306 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 12 my ( $class, $zone ) = @_;
460 3         7 my @results;
461             my %nsnames_and_ip;
462 3         7 my $query_type = q{AAAA};
463              
464 3         7 foreach
465 3         21 my $local_ns ( @{ Zonemaster::Engine::TestMethods->method4( $zone ) }, @{ Zonemaster::Engine::TestMethods->method5( $zone ) } )
  3         20  
466             {
467              
468 36 100       2640 next if $nsnames_and_ip{ $local_ns->name->string . q{/} . $local_ns->address->short };
469              
470 18 50 33     1709 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     65 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         658 $nsnames_and_ip{ $local_ns->name->string . q{/} . $local_ns->address->short }++;
495              
496 18         1906 my $p = $local_ns->query( $zone->name, $query_type );
497              
498 18 50       76 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     95 next if not scalar $p->answer and $p->rcode eq q{NOERROR};
510              
511 18 50 33     359 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   393 if ( scalar keys %nsnames_and_ip and none { $_->tag eq q{ANSWER_BAD_RCODE} } @results ) {
  0         0  
530 3         38 push @results,
531             info(
532             AAAA_WELL_PROCESSED => {
533             names => join( q{,}, keys %nsnames_and_ip ),
534             }
535             );
536             }
537              
538 3         31 return @results;
539             } ## end sub nameserver05
540              
541             sub nameserver06 {
542 4     4 1 12 my ( $class, $zone ) = @_;
543 4         8 my @results;
544 15         44 my @all_nsnames = uniq map { lc( $_->string ) } @{ Zonemaster::Engine::TestMethods->method2( $zone ) },
  4         25  
545 4         10 @{ Zonemaster::Engine::TestMethods->method3( $zone ) };
  4         19  
546 18         442 my @all_nsnames_with_ip = uniq map { lc( $_->name->string ) } @{ Zonemaster::Engine::TestMethods->method4( $zone ) },
  4         17  
547 4         63 @{ Zonemaster::Engine::TestMethods->method5( $zone ) };
  4         21  
548 4         21 my @all_nsnames_without_ip;
549             my %diff;
550              
551 4         18 @diff{@all_nsnames} = undef;
552 4         16 delete @diff{@all_nsnames_with_ip};
553              
554 4         17 @all_nsnames_without_ip = keys %diff;
555 4 100 100     29 if ( scalar @all_nsnames_without_ip and scalar @all_nsnames_with_ip ) {
    100          
556 1         15 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         6 push @results,
565             info(
566             NO_RESOLUTION => {
567             names => join( q{,}, @all_nsnames_without_ip ),
568             }
569             );
570             }
571             else {
572 2         12 push @results, info( CAN_BE_RESOLVED => {} );
573             }
574              
575 4         23 return @results;
576             } ## end sub nameserver06
577              
578             sub nameserver07 {
579 3     3 1 9 my ( $class, $zone ) = @_;
580 3         9 my @results;
581             my %nsnames_and_ip;
582 3         0 my %nsnames;
583              
584 3 100       77 if ( $zone->name eq q{.} ) {
585 2         8 push @results, info( UPWARD_REFERRAL_IRRELEVANT => {} );
586             }
587             else {
588 1         2 foreach my $local_ns ( @{ Zonemaster::Engine::TestMethods->method4( $zone ) },
  1         7  
589 1         5 @{ Zonemaster::Engine::TestMethods->method5( $zone ) } )
590             {
591 12 50 33     776 next if ( not Zonemaster::Engine->config->ipv6_ok and $local_ns->address->version == $IP_VERSION_6 );
592              
593 12 50 33     36 next if ( not Zonemaster::Engine->config->ipv4_ok and $local_ns->address->version == $IP_VERSION_4 );
594              
595 12 100       392 next if $nsnames_and_ip{ $local_ns->name->string . q{/} . $local_ns->address->short };
596              
597 6         573 my $p = $local_ns->query( q{.}, q{NS} );
598 6 50       20 if ( $p ) {
599 6         29 my @ns = $p->get_records( q{NS}, q{authority} );
600              
601 6 50       18 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         167 $nsnames{ $local_ns->name }++;
612 6         180 $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     213 if ( scalar keys %nsnames_and_ip and not scalar @results ) {
616 1         23 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         19 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         33 my $original_name = q{www.} . $zone->name->string;
633 1         3 my $randomized_uc_name;
634              
635 1         8 $original_name =~ s/[.]+\z//smgx;
636              
637 1         3 do {
638 1         8 $randomized_uc_name = scramble_case $original_name;
639             } while ( $randomized_uc_name eq $original_name );
640              
641 1         3 foreach
642 1         7 my $local_ns ( @{ Zonemaster::Engine::TestMethods->method4( $zone ) }, @{ Zonemaster::Engine::TestMethods->method5( $zone ) } )
  1         6  
643             {
644 1 50 33     7 next if ( not Zonemaster::Engine->config->ipv6_ok and $local_ns->address->version == $IP_VERSION_6 );
645              
646 1 50 33     3 next if ( not Zonemaster::Engine->config->ipv4_ok and $local_ns->address->version == $IP_VERSION_4 );
647              
648 1 50       30 next if $nsnames_and_ip{ $local_ns->name->string . q{/} . $local_ns->address->short };
649              
650 1         45 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