1 use 5.014;

     2 use strict;

     3 use warnings;

     4 use Getopt::Long qw(GetOptionsFromArray);

     5 use Net::DNS;

     6 use Pod::Usage;

     7 use if $ENV{DEBUG} => 'Smart::Comments';

     8 use List::Util qw(shuffle);

     9 

    10 sub uniq { my %h; @h{@_} = (); return keys %h; }

    11 my @extns = qw(8.8.8.8 8.8.4.4);

    12 

    13 package Net::DNS::Resolver {

    14     use Storable qw(freeze);

    15     sub new {

    16         my $class = shift;

    17         state %cache;

    18         return $cache{freeze \@_} //= $class->SUPER::new(@_);

    19     }

    20 }

    21 

    22 sub read_override {    # YEAH! :) black magic

    23     local @ARGV = shift;

    24     return map { (shift @$_, $_) } grep { @$_ > 1 } map { [split] } map { s/#.*//r } <>;

    25 }

    26 

    27 # return a list of the zones known to the local

    28 # bind

    29 sub get_local_zones {

    30     my @conf;

    31     open(my $z, '-|') or do {

    32         my $bind_directory;

    33         open(my $x, '-|', 'named-checkconf -p');

    34         while (<$x>) {

    35             /^\s*directory\s+"(.*)";/ and $bind_directory = $1;

    36             print;

    37         }

    38         if (defined $bind_directory) {

    39             local @ARGV = grep { -f } glob "$bind_directory/*nzf";

    40             print <> if @ARGV;

    41         }

    42         exit 0;

    43     };

    44     while (<$z>) {

    45         /^#/ and next;         # comment

    46         state $line;

    47         s/^\s*(.*?)\s*$/$1 /;

    48         chomp($line .= $_);    # continuation line

    49         if (/\A\}/) {          # config item done

    50             $line =~ s/\s$//;

    51             push @conf, $line;

    52             $line = '';

    53         }

    54     }

    55     return grep {

    56 	# FIXME: 172.0 .. 172.31 is missing

    57 	not /\b(?:0|127|10|168\.192|255)\.in-addr\.arpa$/ and

    58 	not /^localhost$/;

    59     } map { /zone\s"?(\S+?)"?\s/ } grep { /type (?:master|slave)/ } @conf;

    60 }

    61 

    62 sub get_domains {

    63     my %arg = @_;

    64     my @sources = @{ $arg{sources} };

    65     my @domains = ();

    66 

    67     foreach my $src (@sources) {

    68 

    69         if ($src =~ m{^(?:(/.*)|file://(/.*))}) {

    70             open(my $f, '<', $1) or die "$0: Can't open $1 for reading: $!\n";

    71             push @domains, map { /^\s*(\S+)\s*/ } grep { !/^\s*#/ } <$f>;

    72             next;

    73         }

    74 

    75         if ($src =~ m{^local:}) {

    76             push @domains, get_local_zones;

    77             push @domains, @{$arg{local}} if $arg{local};

    78             next;

    79         }

    80 

    81         push @domains, $src;

    82     }

    83 

    84     return @domains;

    85 }

    86 

    87 # return a list of "official" nameservers

    88 sub ns {

    89     my $domain = shift;

    90     ### assert: @_ % 2 == 0

    91     my %resflags = (nameservers => \@extns, @_);

    92     my $aa = delete $resflags{aa};

    93     my $nameservers = join ',' => @{$resflags{nameservers}};

    94     my @ns;

    95 

    96     my $r = Net::DNS::Resolver->new(%resflags);

    97     my $q;

    98 

    99     for (my $i = 3; $i; --$i) {

   100         $q = $r->query($domain, 'NS') and last;

   101     }

   102     die $r->errorstring . "\@$nameservers\n" if not $q;

   103 

   104     die "no aa(NS) \@$nameservers\n" if $aa and not $q->header->aa;

   105     push @ns, map { $_->nsdname } grep { $_->type eq 'NS' } $q->answer;

   106 

   107     return sort @ns;

   108 }

   109 

   110 sub serial {

   111     my $domain = shift;

   112     my %resflags = (nameservers => \@extns, @_);

   113     my $aa = delete $resflags{aa};

   114     my $nameservers = join ',' => @{$resflags{nameservers}};

   115 

   116     my $r = Net::DNS::Resolver->new(%resflags);

   117     my $q;

   118 

   119     for (my $i = 3; $i; --$i) {

   120         $q  = $r->query($domain, 'SOA') and last;

   121     }

   122     die $r->errorstring, "\@$nameservers\n" if not $q;

   123     die "no aa(SOA) \@$nameservers\n" if $aa and not $q->header->aa;

   124 

   125     return (map { $_->serial } grep { $_->type eq 'SOA' } $q->answer)[0];

   126 }

   127 

   128 # - the nameservers known from the ns records

   129 # - from the primary master if this is not one of the

   130 #   NS for the zone

   131 # - from a list of additional (hidden) servers

   132 #

   133 # OK - if the serial numbers are in sync

   134 # WARNING - if there is some difference

   135 # CRITICAL - if the serial cannot be found at one of the sources

   136 

   137 sub ns_ok {

   138     my ($domain, $references, $is_override) = @_;

   139 

   140     my (@errs, @ns);

   141     # obtain an authoritive list of nameservers from the reference server

   142     my @our = eval { sort +ns($domain, nameservers => $references, aa => 1) };

   143     if (chomp $@) {

   144         push @errs, $@;

   145         push @our, $@;

   146     }

   147 

   148     # obtain a list of nameservers from some public nameserver

   149     my @public = eval { sort +ns($domain) };

   150     if (chomp $@) {

   151         push @errs, $@;

   152         push @public, $@;

   153     }

   154 

   155     if (@errs or "@our" ne "@public") {

   156         local $" = ', ';

   157         die sprintf "NS differ (%s: @our) vs (public: @public)\n",

   158             $is_override ? 'override' : 'our';

   159 

   160     }

   161 

   162     @ns = uniq sort @our, @public;

   163     ### @ns

   164     return @ns;

   165 }

   166 

   167 sub serial_ok {

   168     my ($domain, $ns) = @_;

   169     my @serials = map { my $s = serial $domain, nameservers => [$_], aa => 1; "$s\@$_" } @$ns;

   170     ### @serials

   171 

   172     if (uniq(map { /(\d+)/ } @serials) != 1) {

   173         die "serials do not match: @serials\n";

   174     }

   175 

   176     $serials[0] =~ /(\d+)/;

   177     return $1;

   178 }

   179 

   180 sub main {

   181     my @argv          = @_;

   182     my $opt_reference = '127.0.0.1';

   183     my $opt_progress  = -t;

   184     my ($opt_override)= grep { -f } '/etc/check_dns-delegation/override';

   185 

   186 

   187     GetOptionsFromArray(

   188         \@argv,

   189         'reference=s' => \$opt_reference,

   190         'progress!'   => \$opt_progress,

   191         'override=s'  => \$opt_override,

   192         'h|help'      => sub { pod2usage(-verbose => 1, -exit => 0) },

   193         'm|man'       => sub {

   194             pod2usage(

   195                 -verbose   => 2,

   196                 -exit      => 0,

   197                 -noperldoc => system('perldoc -V 2>/dev/null 1>&2')

   198             );

   199         }

   200       )

   201       and @argv

   202       or pod2usage;

   203     my %override = read_override($opt_override) if defined $opt_override;

   204     my @domains = get_domains(sources => \@argv, local => [keys %override]);

   205 

   206     my (@OK, %CRITICAL);

   207     foreach my $domain (shuffle @domains) {

   208         state $all = @domains;

   209         state $i++;

   210         print STDERR "$domain ($i/$all) " if $opt_progress;

   211 

   212         my @ns = eval { ns_ok($domain, $override{$domain} ? $override{$domain} : [$opt_reference],

   213                               $override{$domain}) };

   214 	if ($@) {

   215             $CRITICAL{$domain} = $@;

   216             say STDERR 'fail(ns)' if $opt_progress;

   217             next;

   218         }

   219         print STDERR 'ok(ns) ' if $opt_progress;

   220 

   221         my @serial = eval { serial_ok($domain, [@ns, $override{$domain} ? () : $opt_reference]) };

   222         if ($@) {

   223             $CRITICAL{$domain} = $@;

   224             say STDERR 'fail(serial)' if $opt_progress;

   225             next;

   226         }

   227         say STDERR 'ok(serial)' if $opt_progress;

   228         push @OK, $domain;

   229 

   230     }

   231 

   232     #    use DDP;

   233     #    p @OK;

   234     #    p %CRITICAL;

   235 

   236     if (my $n = keys %CRITICAL) {

   237         print "CRITICAL: $n of " . @domains . " domains\n",

   238           map { "$_: $CRITICAL{$_}" } sort keys %CRITICAL;

   239         return 2;

   240     }

   241 

   242     say 'OK: ' . @OK . ' domains checked';

   243     return 0;

   244 

   245 }

   246 

   247 1;

   248 # vim:sts=4 ts=8 sw=4 et: