1#!/usr/local/bin/perl -w 2# $Id: check_zone 1842 2021-07-08 14:25:00Z willem $ 3 4=head1 NAME 5 6check_zone - Check a DNS zone for errors 7 8=head1 SYNOPSIS 9 10C<check_zone> [ C<-r> ][ C<-v> ] I<domain> [ I<class> ] 11 12=head1 DESCRIPTION 13 14Checks a DNS zone for errors. Current checks are: 15 16=over 4 17 18=item * 19 20Checks the domain's SOA from each of the domain's name servers. The SOA serial numbers should match. This program's output cannot be trusted if they do not. 21 22=item * 23 24Tries to perform an AXFR from each of the domain's name servers. This test helps to detect whether the name server is blocking AXFR. 25 26=item * 27 28Checks that all A records have corresponding PTR records. For each A record its PTR's name is match checked. 29 30=item * 31 32Checks that all PTR records match an A record (sometimes they match a CNAME). Check the PTR's name against the A record. 33 34=item * 35 36Checks that hosts listed in NS, MX, and CNAME records have 37A records. Checks for NS and CNAME records not pointing to another CNAME (i.e., they must directly resolve to an A record). That test may be somewhat controversial because, in many cases, a MX to a CNAME or a CNAME to another CNAME will resolve; however, in DNS circles it isn't a recommended practise. 38 39=item * 40 41Check each record processed for being with the class requested. This is an internal integrity check. 42 43=back 44 45=head1 OPTIONS 46 47=over 4 48 49=item C<-r> 50 51Perform a recursive check on subdomains. 52 53=item C<-v> 54 55Verbose. 56 57=item C<-a alternate_domain> 58 59Treat <alternate_domain> as equal to <domain>. This is useful when supporting a change of domain names (eg from myolddomain.example.net to mynewdomain.example.net) where the PTR records can point to only one of the two supported domains (which are otherwise identical). 60 61=item C<-e exception_file> 62 63Ignore exceptions in file <exception_file>. File format can be space-separated domain pairs, one pair per line, or it can be straight output from this program itself (for simple cut-and-paste functionality). 64This allows for skipping entries that are odd or unusual, but not causing problems. Note: this only works with A - PTR checks. 65 66=back 67 68=head1 AUTHORS 69 70Originally developed by Michael Fuhr (mfuhr@dimensional.com) and 71hacked--with furor--by Dennis Glatting 72(dennis.glatting@software-munitions.com). 73 74"-a" and "-e" options added by Paul Archer 75 76=head1 SEE ALSO 77 78L<perl(1)>, L<axfr>, L<check_soa>, L<mx>, L<perldig>, L<Net::DNS> 79 80=head1 BUGS 81 82A query for an A RR against a name that is a CNAME may not follow the CNAME to an A RR. 83 84There isn't a mechanism to insure records are returned from an authoritative source. 85 86There appears to be a bug in the resolver AXFR routine where, if one server cannot be contacted, the routine doesn't try another in its list. 87 88=cut 89 90 91#require 'assert.pl'; 92 93use strict; 94use warnings; 95use Carp; 96use vars qw($opt_r); 97use vars qw($opt_v); 98use vars qw($opt_a); 99use vars qw($opt_e); 100 101use Getopt::Std; 102use File::Basename; 103use IO::Socket; 104use Net::DNS; 105 106getopts("rva:e:"); 107 108die "Usage: ", basename($0), " [ -r -v ] [ -a alternate_domain] [ -e eqivalent_domains_file ] domain [ class ]\n" 109 unless (@ARGV >= 1) && (@ARGV <= 2); 110 111 112our $exit_status = 0; 113local $SIG{__WARN__} = sub {$exit_status=1 ; print STDERR @_ }; 114 115 116 117$opt_r = 1; 118 119our $main_domain=$ARGV[0]; 120our %exceptions = parse_exceptions_file(); 121foreach my $key (sort keys %exceptions) { 122 print "$key:\t"; 123 foreach my $val (@{$exceptions{$key}}) { 124 print "$val "; 125 } 126 print "\n"; 127} 128 129check_domain(@ARGV); 130exit $exit_status; 131 132sub assert { croak 'violated assertion' unless shift; return } 133 134 135sub parse_exceptions_file { 136 my %exceptions; 137 my $file = $opt_e || ""; 138 return %exceptions unless ( -r $file); 139 open( my $fh, '<', $file ); 140 die "Couldn't read $file: $!" unless $fh; 141 while (<$fh>) { 142 chomp; 143 #print " raw line: $_\n"; 144 next if /^$/; 145 next if /^\s*#/; 146 s/#.*$//; 147 s/^\s*//; 148 s/\s*$//; 149 s/'//g; 150 my ($left, $right) = (split /[\s:]+/, $_)[0, -1]; 151 push @{$exceptions{$left}}, $right; 152 #print "processed line: $line\n"; 153 154 } 155 close($fh); 156 return %exceptions; 157} 158 159 160 161sub check_domain { 162 163 my ( $domain, $class ) = @_; 164 my $ns; 165 my @zone; 166 167 $class ||= "IN"; 168 169 print "-" x 70, "\n"; 170 print "$domain (class $class)\n"; 171 print "\n"; 172 173 my $res = Net::DNS::Resolver->new(); 174 $res->defnames( 0 ); 175 $res->retry( 2 ); 176 177 178 my( $nspack, $ns_rr, @nsl ); 179 180 # Get a list of name servers for the domain. 181 # Error-out if the query isn't satisfied. 182 # 183 184 $nspack = $res->query( $domain, 'NS', $class ); 185 unless( defined( $nspack )) { 186 187 warn "Couldn't find nameservers for $domain: ", 188 $res->errorstring, "\n"; 189 return; 190 } 191 192 printf( "List of name servers returned from '%s'\n", $res->answerfrom ); 193 foreach my $ns_rr ( $nspack->answer ) { 194 195 $ns_rr->print if( $opt_v ); 196 197 assert( $class eq $ns_rr->class ); 198 assert( 'NS' eq $ns_rr->type ); 199 200 if( $ns_rr->name eq $domain ) { 201 202 print "\t", $ns_rr->rdatastr, "\n"; 203 push @nsl, $ns_rr->rdatastr; 204 } else { 205 206 warn( "asked for '$domain', got '%s'\n", $ns_rr->rdatastr ); 207 } 208 } 209 print "\n"; 210 211 warn( "\tZone has no NS records\n" ) if( scalar( @nsl ) == 0 ); 212 213 214 # Transfer the zone from each of the name servers. 215 # The zone is transferred for several reasons. 216 # First, so the check routines won't (an efficiency 217 # issue) and second, to see if we can. 218 # 219 220 $res->nameservers( @nsl ); 221 222 foreach my $ns ( @nsl ) { 223 224 $res->nameservers( $ns ); 225 226 my @local_zone = $res->axfr( $domain, $class ); 227 unless( @local_zone ) { 228 229 warn "Zone transfer from '", $ns, "' failed: ", 230 $res->errorstring, "\n"; 231 } 232 @zone = @local_zone if( ! @zone ); 233 } 234 235 # Query each name server for the zone 236 # and check the zone's SOA serial number. 237 # 238 239 print "checking SOA records\n"; 240 check_soa( $domain, $class, \@nsl ); 241 print "\n"; 242 243 244 # Check specific record types. 245 # 246 247 print "checking NS records\n"; 248 check_ns( $domain, $class, \@nsl, \@zone ); 249 print "\n"; 250 251 print "checking A records\n"; 252 check_a( $domain, $class, \@nsl, \@zone ); 253 print "\n"; 254 255 print "checking PTR records\n"; 256 check_ptr( $domain, $class, \@nsl, \@zone ); 257 print "\n"; 258 259 print "checking MX records\n"; 260 check_mx( $domain, $class, \@nsl, \@zone ); 261 print "\n"; 262 263 print "checking CNAME records\n"; 264 check_cname( $domain, $class, \@nsl, \@zone ); 265 print "\n"; 266 267 268 # Recurse? 269 # 270 271 if( $opt_r ) { 272 273 my %subdomains; 274 275 print "checking subdomains\n\n"; 276 277 # Get a list of NS records from the zone that 278 # are not for the zone (i.e., they're subdomains). 279 # 280 281 foreach ( grep { $_->type eq 'NS' and $_->name ne $domain } @zone ) { 282 283 $subdomains{$_->name} = 1; 284 } 285 286 # For each subdomain, check it. 287 # 288 289 foreach ( sort keys %subdomains ) { 290 291 check_domain($_, $class); 292 } 293 } 294 return; 295} 296 297sub check_soa { 298 299 my( $domain, $class, $nsl ) = @_; 300 my( $soa_sn, $soa_diff ) = ( 0, 0 ); 301 my( $ns, $soa_rr ); 302 my $rr_count = 0; 303 304 my $res = Net::DNS::Resolver->new(); 305 306 $res->defnames( 0 ); 307 $res->retry( 2 ); 308 $res->recurse( 0 ); 309 310 # Contact each name server and get the 311 # SOA for the somain. 312 # 313 314 foreach my $ns ( @$nsl ) { 315 316 my $soa = 0; 317 my $nspack; 318 319 # Query the name server and test 320 # for a result. 321 # 322 323 $res->nameservers( $ns ); 324 325 $nspack = $res->query( $domain, "SOA", $class ); 326 unless( defined( $nspack )) { 327 328 warn "Couldn't get SOA from '$ns'\n"; 329 next; 330 } 331 332 # Look at each SOA for the domain from the 333 # name server. Specifically, look to see if 334 # its serial number is different across 335 # the name servers. 336 # 337 338 foreach my $soa_rr ( $nspack->answer ) { 339 340 $soa_rr->print if( $opt_v ); 341 342 assert( $class eq $soa_rr->class ); 343 assert( 'SOA' eq $soa_rr->type ); 344 345 print "\t$ns:\t", $soa_rr->serial, "\n"; 346 347 # If soa_sn is zero then an SOA serial number 348 # hasn't been recorded. In that case record 349 # the serial number. If the serial number 350 # doesn't match a previously recorded one then 351 # indicate they are different. 352 # 353 # If the serial numbers are different then you 354 # cannot really trust the remainder of the test. 355 # 356 357 if( $soa_sn ) { 358 359 $soa_diff = 1 if ( $soa_sn != $soa_rr->serial ); 360 } else { 361 362 $soa_sn = $soa_rr->serial; 363 } 364 } 365 366 ++$rr_count; 367 } 368 369 print "\t*** SOAs are different!\n" if( $soa_diff ); 370 print "$rr_count SOA RRs checked.\n"; 371 return; 372} 373 374sub check_ptr { 375 376 my( $domain, $class, $nsl, $zone ) = @_; 377 378 my $res = Net::DNS::Resolver->new(); 379 my $ptr_rr; 380 my $rr_count = 0; 381 382 $res->defnames( 0 ); 383 $res->retry( 2 ); 384 $res->nameservers( @$nsl ); 385 386 foreach my $ptr_rr ( grep { $_->type eq 'PTR' } @$zone ) { 387 388 my @types; 389 390 $ptr_rr->print if( $opt_v ); 391 392 assert( $class eq $ptr_rr->class ); 393 assert( 'PTR' eq $ptr_rr->type ); 394 395 print "\tchecking PTR rr '$ptr_rr' to PTR\n" if( $opt_v ); 396 397 @types = types4name( $ptr_rr->ptrdname, $domain, $class, $nsl ); 398 if( grep { $_ eq 'A' } @types ) { 399 400 xcheck_ptr2a( $ptr_rr, $domain, $class, $nsl ); 401 } else { 402 403 warn "\t'", $ptr_rr->ptrdname, 404 "' doesn't resolve to an A RR (RRs are '", 405 join( ', ', @types ), "')\n"; 406 407 } 408 409 410 ++$rr_count; 411 } 412 413 print "$rr_count PTR RRs checked.\n"; 414 return; 415} 416 417sub check_ns { 418 419 my( $domain, $class, $nsl, $zone ) = @_; 420 my $res = Net::DNS::Resolver->new(); 421 my $ns_rr; 422 my $rr_count = 0; 423 424 $res->defnames( 0 ); 425 $res->retry( 2 ); 426 $res->nameservers( @$nsl ); 427 428 # Go through the zone data and process 429 # all NS RRs for the zone (delegation 430 # NS RRs are ignored). Specifically, 431 # check to see if the indicate name server 432 # is a CNAME RR and the name resolves to an A 433 # RR. Check to insure the address resolved 434 # against the name has an associated PTR RR. 435 # 436 437 foreach my $ns_rr ( grep { $_->type eq 'NS' } @$zone ) { 438 439 my @types; 440 441 $ns_rr->print if( $opt_v ); 442 443 assert( $class eq $ns_rr->class ); 444 assert( 'NS' eq $ns_rr->type ); 445 446 next if( $ns_rr->name ne $domain ); 447 448 printf( "rr nsdname: %s\n", $ns_rr->nsdname ) if $opt_v; 449 450 @types = types4name( $ns_rr->nsdname, $domain, $class, $nsl ); 451 if( grep { $_ eq 'A' } @types ) { 452 453 xcheck_name( $ns_rr->nsdname, $domain, $class, $nsl ); 454 } else { 455 456 warn "\t'", $ns_rr->nsdname, 457 "' doesn't resolve to an A RR (RRs are '", 458 join( ', ', @types ), "')\n"; 459 } 460 ++$rr_count; 461 } 462 463 print "$rr_count NS RRs checked.\n"; 464 return; 465} 466 467sub check_a { 468 469 my( $domain, $class, $nsl, $zone ) = @_; 470 471 my $res = Net::DNS::Resolver->new(); 472 my $a_rr; 473 my $rr_count = 0; 474 475 $res->defnames( 0 ); 476 $res->retry( 2 ); 477 $res->nameservers( @$nsl ); 478 479 # Go through the zone data and process 480 # all A RRs. Specifically, check to insure 481 # each A RR matches a PTR RR and the PTR RR 482 # matches the A RR. 483 # 484 485 foreach my $a_rr ( grep { $_->type eq 'A' } @$zone ) { 486 487 $a_rr->print if( $opt_v ); 488 489 assert( $class eq $a_rr->class ); 490 assert( 'A' eq $a_rr->type ); 491 492 print "\tchecking A RR '", $a_rr->address, "' to PTR\n" if( $opt_v ); 493 494 xcheck_a2ptr( $a_rr, $domain, $class, $nsl ); 495 496 ++$rr_count; 497 } 498 499 print "$rr_count A RRs checked.\n"; 500 return; 501} 502 503 504sub check_mx { 505 506 my( $domain, $class, $nsl, $zone ) = @_; 507 508 my $res = Net::DNS::Resolver->new(); 509 my $mx_rr; 510 my $rr_count = 0; 511 512 $res->defnames( 0 ); 513 $res->retry( 2 ); 514 $res->nameservers( @$nsl ); 515 516 # Go through the zone data and process 517 # all MX RRs. Specifically, check to insure 518 # each MX RR resolves to an A RR and the 519 # A RR has a matching PTR RR. 520 # 521 522 foreach my $mx_rr ( grep { $_->type eq 'MX' } @$zone ) { 523 524 $mx_rr->print if( $opt_v ); 525 526 assert( $class eq $mx_rr->class ); 527 assert( 'MX' eq $mx_rr->type ); 528 529 print "\tchecking MX RR '", $mx_rr->exchange, "' to A\n" if( $opt_v ); 530 531 xcheck_name( $mx_rr->exchange, $domain, $class, $nsl ); 532 533 ++$rr_count; 534 } 535 536 print "$rr_count MX RRs checked.\n"; 537 return; 538} 539 540sub check_cname { 541 542 my( $domain, $class, $nsl, $zone ) = @_; 543 544 my $res = Net::DNS::Resolver->new(); 545 my $cname_rr; 546 my $rr_count = 0; 547 548 $res->defnames( 0 ); 549 $res->retry( 2 ); 550 $res->nameservers( @$nsl ); 551 552 # Go through the zone data and process 553 # all CNAME RRs. Specifically, check to insure 554 # each CNAME RR resolves to an A RR and the 555 # A RR has a matching PTR RR. 556 # 557 558 foreach my $cname_rr ( grep { $_->type eq 'CNAME' } @$zone ) { 559 560 my @types; 561 562 $cname_rr->print if( $opt_v ); 563 564 assert( $class eq $cname_rr->class ); 565 assert( 'CNAME' eq $cname_rr->type ); 566 567 print "\tchecking CNAME RR '", $cname_rr->cname, "' to A\n" 568 if( $opt_v ); 569 570 @types = types4name( $cname_rr->cname, $domain, $class, $nsl ); 571 if( grep { $_ eq 'A' } @types ) { 572 573 xcheck_name( $cname_rr->cname, $domain, $class, $nsl ); 574 } else { 575 576 warn "\t'", $cname_rr->cname, 577 "' doesn't resolve to an A RR (RRs are '", 578 join( ', ', @types ), "')\n"; 579 } 580 581 ++$rr_count; 582 } 583 584 print "$rr_count CNAME RRs checked.\n"; 585 return; 586} 587 588sub check_w_equivs_and_exceptions { 589 my ($left, $comp, $right) = @_; 590 591 if (defined $exceptions{$left}) { 592 foreach my $rval (@{$exceptions{$left}}) { 593 $left = $right if ($rval eq $right); 594 } 595 } 596 597 if ($opt_a){ 598 $left =~ s/\.?$opt_a$//; 599 $left =~ s/\.?$main_domain$//; 600 $right =~ s/\.?$opt_a$//; 601 $right =~ s/\.?$main_domain$//; 602 } 603 return (eval { "\"$left\" $comp \"$right\"" } ); 604} 605 606sub xcheck_a2ptr { 607 608 my( $a_rr, $domain, $class, $nsl ) = @_; 609 610 my $res = Net::DNS::Resolver->new(); 611 612 $res->defnames( 0 ); 613 $res->retry( 2 ); 614 $res->nameservers( @$nsl ); 615 616 assert( $class eq $a_rr->class ); 617 assert( 'A' eq $a_rr->type ); 618 619 # Request a PTR RR against the A RR. 620 # A missing PTR RR is an error. 621 # 622 623 my $ans = $res->query( $a_rr->address, 'PTR', $class ); 624 if( defined( $ans )) { 625 626 my $ptr_rr; 627 foreach my $ptr_rr ( $ans->answer ) { 628 629 $ptr_rr->print if( $opt_v ); 630 631 assert( $class eq $ptr_rr->class ); 632 assert( 'PTR' eq $ptr_rr->type ); 633 634 warn( "\t'", $a_rr->name, "' has address '", 635 $a_rr->address, "' but PTR is '", 636 $ptr_rr->ptrdname, "'\n" ) 637 if( check_w_equivs_and_exceptions($a_rr->name, "ne", $ptr_rr->ptrdname) ); 638 639 warn( "\t'", $a_rr->name, "' has address '", 640 $a_rr->address, "' but PTR is '", 641 ip_ptr2a_str( $ptr_rr->name ), "'\n" ) 642 if( $a_rr->address ne ip_ptr2a_str( $ptr_rr->name )); 643 } 644 } else { 645 646 warn( "\tNO PTR RR for '", $a_rr->name, 647 "' at address '", $a_rr->address,"'\n" ); 648 } 649 return; 650} 651 652 653sub xcheck_ptr2a { 654 655 my( $ptr_rr, $domain, $class, $nsl ) = @_; 656 657 my $res = Net::DNS::Resolver->new(); 658 659 $res->defnames( 0 ); 660 $res->retry( 2 ); 661 $res->nameservers( @$nsl ); 662 663 assert( $class eq $ptr_rr->class ); 664 assert( 'PTR' eq $ptr_rr->type ); 665 666 # Request an A RR against the PTR RR. 667 # A missing A RR is an error. 668 # 669 670 my $ans = $res->query( $ptr_rr->ptrdname, 'A', $class ); 671 if( defined( $ans )) { 672 673 my $a_rr; 674 foreach my $a_rr ( $ans->answer ) { 675 676 $a_rr->print if( $opt_v ); 677 678 assert( $class eq $a_rr->class ); 679 assert( 'A' eq $a_rr->type ); 680 681 warn( "\tPTR RR '", $ptr_rr->name, "' has name '", 682 $ptr_rr->ptrdname, "' but A query returned '", 683 $a_rr->name, "'\n" ) 684 if( check_w_equivs_and_exceptions($ptr_rr->ptrdname, "ne", $a_rr->name) ); 685 686 warn( "\tPTR RR '", $ptr_rr->name, "' has address '", 687 ip_ptr2a_str( $ptr_rr->name ), 688 "' but A query returned '", $a_rr->address, "'\n" ) 689 if( ip_ptr2a_str( $ptr_rr->name ) ne $a_rr->address ); 690 } 691 } else { 692 693 warn( "\tNO A RR for '", $ptr_rr->ptrdname, 694 "' at address '", ip_ptr2a_str( $ptr_rr->address ), "'\n" ); 695 } 696 return; 697} 698 699 700sub xcheck_name { 701 702 my( $name, $domain, $class, $nsl ) = @_; 703 704 my $res = Net::DNS::Resolver->new(); 705 706 $res->defnames( 0 ); 707 $res->retry( 2 ); 708 $res->nameservers( @$nsl ); 709 710 # Get the A RR for the name. 711 # 712 713 my $ans = $res->query( $name, 'A', $class ); 714 if( defined( $ans )) { 715 716 # There is one or more A RRs. 717 # For each A RR do a reverse look-up 718 # and verify the PTR matches the A. 719 # 720 721 my $a_rr; 722 foreach my $a_rr ( $ans->answer ) { 723 724 $a_rr->print if( $opt_v ); 725 726 assert( $class eq $a_rr->class ); 727 assert( 'A' eq $a_rr->type ); 728 729 warn( "\tQuery for '$name' returned A RR name '", 730 $a_rr->name, "'\n" ) 731 if( check_w_equivs_and_exceptions($name, "ne", $a_rr->name) ); 732 733 xcheck_a2ptr( $a_rr, $domain, $class, $nsl ); 734 } 735 } else { 736 737 warn( "\t", $name, " has no A RR\n" ); 738 } 739 return; 740} 741 742 743sub types4name { 744 745 my( $name, $domain, $class, $nsl ) = @_; 746 747 my $res = Net::DNS::Resolver->new(); 748 my @rr_types; 749 750 $res->defnames( 0 ); 751 $res->retry( 2 ); 752 $res->nameservers( @$nsl ); 753 754 # Get the RRs for the name. 755 # 756 757 my $ans = $res->query( $name, 'ANY', $class ); 758 if( defined( $ans )) { 759 760 my $any_rr; 761 foreach my $any_rr ( $ans->answer ) { 762 763 $any_rr->print if( $opt_v ); 764 765 assert( $class eq $any_rr->class ); 766 767 push @rr_types, ( $any_rr->type ); 768 } 769 } else { 770 771 warn( "\t'", $name, "' doesn't resolve.\n" ); 772 } 773 774 # If there were no RRs for the name then 775 # return the RR types of ??? 776 # 777 778 push @rr_types, ( '???' ) if( ! @rr_types ); 779 780 return @rr_types; 781} 782 783 784sub ip_ptr2a_str { 785 786 my( $d, $c, $b, $a ) = ip_parts( $_[0]); 787 788 return "$a.$b.$c.$d"; 789} 790 791 792 793sub ip_parts { 794 795 my $ip = $_[0]; 796 assert( $ip ne '' ); 797 798 if( $ip =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)/oi ) { 799 800 return ( $1, $2, $3, $4 ); 801 } else { 802 803 warn "Unable to parse '$ip'\n"; 804 } 805 806 assert( 0 ); 807 return; 808} 809 810 811 812 813