--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/Nagios/Check/DNS/delegation.pm Wed Jan 07 23:57:31 2015 +0100
@@ -0,0 +1,229 @@
+use 5.014;
+use strict;
+use warnings;
+use Getopt::Long qw(GetOptionsFromArray);
+use Net::DNS;
+use Pod::Usage;
+use if $ENV{DEBUG} => 'Smart::Comments';
+use List::Util qw(shuffle);
+
+sub uniq { my %h; @h{@_} = (); return keys %h; }
+my @extns = qw(8.8.8.8 8.8.4.4);
+
+package Net::DNS::Resolver {
+ use Storable qw(freeze);
+ sub new {
+ my $class = shift;
+ state %cache;
+ return $cache{freeze \@_} //= $class->SUPER::new(@_);
+ }
+}
+
+sub read_override { # YEAH! :) black magic
+ local @ARGV = shift;
+ return map { (shift @$_, $_) } grep { @$_ > 1 } map { [split] } map { s/#.*//r } <>;
+}
+
+# return a list of the zones known to the local
+# bind
+sub get_local_zones {
+ my @conf;
+ open(my $z, '-|', 'named-checkconf -p');
+ while (<$z>) {
+ state $line;
+ s/^\s*(.*?)\s*$/$1 /;
+ chomp($line .= $_); # continuation line
+ if (/\A\}/) { # config item done
+ $line =~ s/\s$//;
+ push @conf, $line;
+ $line = '';
+ }
+ }
+ return grep {
+ # FIXME: 172.0 .. 172.31 is missing
+ not /\b(?:0|127|10|168\.192|255)\.in-addr\.arpa$/ and
+ not /^localhost$/;
+ } map { /zone\s"(\S+)"\s/ } grep { /type (?:master|slave)/ } @conf;
+}
+
+sub get_domains {
+ my %arg = @_;
+ my @sources = @{ $arg{sources} };
+ my @domains = ();
+
+ foreach my $src (@sources) {
+
+ if ($src =~ m{^(?:(/.*)|file://(/.*))}) {
+ open(my $f, '<', $1) or die "$0: Can't open $1 for reading: $!\n";
+ push @domains, map { /^\s*(\S+)\s*/ } grep { !/^\s*#/ } <$f>;
+ next;
+ }
+
+ if ($src =~ m{^local:}) {
+ push @domains, get_local_zones;
+ push @domains, @{$arg{local}} if $arg{local};
+ next;
+ }
+
+ push @domains, $src;
+ }
+
+ return @domains;
+}
+
+# return a list of "official" nameservers
+sub ns {
+ my $domain = shift;
+ ### assert: @_ % 2 == 0
+ my %resflags = (nameservers => \@extns, @_);
+ my $aa = delete $resflags{aa};
+ my $override = delete $resflags{override};
+ my $nameservers = join ',' => @{$resflags{nameservers}};
+ my @ns;
+
+ return sort @{$override->{$domain}} if exists $override->{$domain};
+
+ my $r = Net::DNS::Resolver->new(%resflags);
+ my $q;
+
+ for (my $i = 3; $i; --$i) {
+ $q = $r->query($domain, 'NS') and last;
+ }
+ die $r->errorstring . "\@$nameservers\n" if not $q;
+
+ die "no aa \@$nameservers\n" if $aa and not $q->header->aa;
+ push @ns, map { $_->nsdname } grep { $_->type eq 'NS' } $q->answer;
+
+ return sort @ns;
+}
+
+sub serial {
+ my $domain = shift;
+ my %resflags = (nameservers => \@extns, @_);
+ my $nameservers = join ',' => @{$resflags{nameservers}};
+
+ my $r = Net::DNS::Resolver->new(%resflags);
+ my $q;
+
+ for (my $i = 3; $i; --$i) {
+ $q = $r->query($domain, 'SOA') and last;
+ }
+ die $r->errorstring, "\@$nameservers\n" if not $q;
+
+ return (map { $_->serial } grep { $_->type eq 'SOA' } $q->answer)[0];
+}
+
+# - the nameservers known from the ns records
+# - from the primary master if this is not one of the
+# NS for the zone
+# - from a list of additional (hidden) servers
+#
+# OK - if the serial numbers are in sync
+# WARNING - if there is some difference
+# CRITICAL - if the serial cannot be found at one of the sources
+
+sub ns_ok {
+ my ($domain, $reference, $override) = @_;
+
+ my (@errs, @ns);
+ my @our = eval { sort +ns($domain, nameservers => [$reference], aa => 1, override => $override) };
+ push @errs, $@ if $@;
+
+ my @their = eval { sort +ns($domain) };
+ push @errs, $@ if $@;
+
+ if (@errs) {
+ chomp @errs;
+ die join(', ' => @errs) . "\n";
+ }
+
+ if ("@our" ne "@their") {
+ local $" = ', ';
+ die sprintf "NS differ (%s @our) vs (public @their)\n",
+ $override->{$domain} ? 'override' : 'our';
+ }
+
+ @ns = uniq sort @our, @their;
+ ### @ns
+ return @ns;
+}
+
+sub serial_ok {
+ my ($domain, @ns) = @_;
+ my @serials = map { my $s = serial $domain, nameservers => [$_], aa => 1; "$s\@$_" } @ns;
+ ### @serials
+
+ if (uniq(map { /(\d+)/ } @serials) != 1) {
+ die "serials do not match: @serials\n";
+ }
+
+ $serials[0] =~ /(\d+)/;
+ return $1;
+}
+
+sub main {
+ my @argv = @_;
+ my $opt_reference = '127.0.0.1';
+ my $opt_progress = -t;
+ my ($opt_override)= grep { -f } '/etc/bind/zones.override';
+
+
+ GetOptionsFromArray(
+ \@argv,
+ 'reference=s' => \$opt_reference,
+ 'progress!' => \$opt_progress,
+ 'override=s' => \$opt_override,
+ 'h|help' => sub { pod2usage(-verbose => 1, -exit => 0) },
+ 'm|man' => sub {
+ pod2usage(
+ -verbose => 2,
+ -exit => 0,
+ -noperldoc => system('perldoc -V 2>/dev/null 1>&2')
+ );
+ }
+ )
+ and @argv
+ or pod2usage;
+ my %override = read_override($opt_override) if defined $opt_override;
+ my @domains = get_domains(sources => \@argv, local => [keys %override]);
+
+ my (@OK, %CRITICAL);
+ foreach my $domain (shuffle @domains) {
+ print STDERR "$domain " if $opt_progress;
+
+ my @ns = eval { ns_ok($domain, $opt_reference, \%override) };
+ if ($@) {
+ $CRITICAL{$domain} = $@;
+ say STDERR 'fail(ns)' if $opt_progress;
+ next;
+ }
+ print STDERR 'ok(ns) ' if $opt_progress;
+
+ my @serial = eval { serial_ok($domain, @ns, $opt_reference) };
+ if ($@) {
+ $CRITICAL{$domain} = $@;
+ say STDERR 'fail(serial)' if $opt_progress;
+ next;
+ }
+ say STDERR 'ok(serial)' if $opt_progress;
+ push @OK, $domain;
+
+ }
+
+ # use DDP;
+ # p @OK;
+ # p %CRITICAL;
+
+ if (my $n = keys %CRITICAL) {
+ print "CRITICAL: $n of " . @domains . " domains\n",
+ map { "$_: $CRITICAL{$_}" } sort keys %CRITICAL;
+ return 2;
+ }
+
+ say 'OK: ' . @OK . ' domains checked';
+ return 0;
+
+}
+
+1;
+# vim:sts=4 ts=8 sw=4 et: