working on pu for now.
authorheiko
Tue, 06 Jan 2015 13:35:59 +0100
changeset 9 b2a26d05b063
parent 8 a220ea51b60b
child 10 4243e22505f9
working on pu for now. Further testing expected.
plugins/check_dns-serial
t/10-minimal.t
--- a/plugins/check_dns-serial	Tue Dec 30 23:27:37 2014 +0100
+++ b/plugins/check_dns-serial	Tue Jan 06 13:35:59 2015 +0100
@@ -1,4 +1,5 @@
 #! /usr/bin/perl
+# source: https://ssl.schlittermann.de/hg/ius/nagios/nagios-plugin-dns-serial
 # © 2014 Heiko Schlittermann <hs@schlittermann.de>
 
 =head1 NAME
@@ -47,6 +48,16 @@
 use if $ENV{DEBUG} => 'Smart::Comments';
 
 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(@_);
+    }
+}
 
 # return a list of the zones known to the local
 # bind
@@ -97,15 +108,20 @@
 sub ns {
     my $domain = shift;
     ### assert: @_ % 2 == 0
-    my %resflags = (nameservers => [qw/8.8.8.8/], @_);
+    my %resflags = (nameservers => \@extns, @_);
     my $aa = delete $resflags{aa};
-    my $nameservers = $resflags{nameservers};
+    my $nameservers = join ',' => @{$resflags{nameservers}};
     my @ns;
 
     my $r = Net::DNS::Resolver->new(%resflags);
-    my $q = $r->query($domain, 'NS') or die $r->errorstring, "\@@$nameservers\n";
+    my $q;
 
-    die "no aa @@$nameservers\n" if $aa and not $q->header->aa;
+    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;
@@ -113,11 +129,17 @@
 
 sub serial {
     my $domain = shift;
-    my %resflags = (nameservers => [qw/8.8.8.8/], @_);
-    my $nameservers = $resflags{nameservers};
+    my %resflags = (nameservers => \@extns, @_);
+    my $nameservers = join ',' => @{$resflags{nameservers}};
 
     my $r = Net::DNS::Resolver->new(%resflags);
-    my $q = $r->query($domain, 'SOA') or die $r->errorstring, "\@@$nameservers\n";
+    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];
 }
 
@@ -139,16 +161,29 @@
     my @their = eval { sort +ns($domain) };
     push @errs, $@ if $@;
 
-    if (!@errs) {
+    if (@errs) {
+        chomp @errs;
+        die join(', ' => @errs) . "\n";
+    }
+    
+    if ("@our" ne "@their") {
         local $" = ', ';
-	if ("@our" eq "@their") {
-		return 1;
-	}
         die "NS differ (our @our) vs (their @their)\n";
     }
-    chomp @errs;
-    die join(', ', @errs) . "\n";
+
+    return uniq sort @our, @their;
+}
 
+sub serial_ok {
+    my ($domain, @ns) = @_;
+    my @serials = map { my $s = serial $domain, nameservers => [$_]; "$s\@$_" } @ns;
+
+    if (uniq(map { /(\d+)/ } @serials) != 1) {
+        die "serials do not match: @serials\n";
+    }
+    
+    $serials[0] =~ /(\d+)/;
+    return $1;
 }
 
 sub main {
@@ -176,10 +211,24 @@
     my (@OK, %CRITICAL);
     foreach my $domain (@domains) {
         print STDERR "$domain " if $opt_progress;
-        eval { ns_ok($domain, $opt_reference) };
-	if ($@) { $CRITICAL{$domain} = $@ }
-        else { push @OK, $domain }
-        say STDERR $@ ? 'not ok' : 'ok' if $opt_progress;
+
+        my @ns = eval { ns_ok($domain, $opt_reference) };
+	if ($@) { 
+            $CRITICAL{$domain} = $@;
+            say STDERR 'ns not ok' if $opt_progress;
+            next;
+        }
+        print STDERR 'ok(ns) ';
+
+        my @serial = eval { serial_ok($domain, @ns) };
+        if ($@) {
+            $CRITICAL{$domain} = $@;
+            say STDERR 'serial not ok' if $opt_progress;
+            next;
+        }
+        say STDERR 'ok(serial)' if $opt_progress;
+        push @OK, $domain;
+
     }
 
     #    use DDP;
@@ -216,3 +265,5 @@
 =back
 
 =cut
+
+# vim:sts=4 ts=8 sw=4 et:
--- a/t/10-minimal.t	Tue Dec 30 23:27:37 2014 +0100
+++ b/t/10-minimal.t	Tue Jan 06 13:35:59 2015 +0100
@@ -1,3 +1,4 @@
+#! perl
 use 5.014;
 use strict;
 use warnings;
@@ -23,7 +24,33 @@
 require_ok 'blib/nagios/plugins/ius/check_dns-serial'
   or BAIL_OUT q{can't require the module};
 
-is_deeply [sort +uniq(qw(a b a c))], [qw(a b c)] => 'uniq helper';
+
+subtest 'tools' => sub {
+    is_deeply [sort +uniq(qw(a b a c))], [qw(a b c)] => 'uniq helper';
+
+    my %google = ( nameservers => [qw/8.8.8.8 8.8.4.4/]);
+    my %level3 = ( nameservers => [qw/209.244.0.3 209.244.0.4/]);
+
+    my $r1a = Net::DNS::Resolver->new(%google);
+    my $r1b = Net::DNS::Resolver->new(%google);
+
+    my $r2a = Net::DNS::Resolver->new(%level3);
+    my $r2b = Net::DNS::Resolver->new(%level3);
+
+    is $r1a, $r1b => 'same google';
+    is $r2a, $r2b => 'same level3';
+    isnt $r1a, $r2a => 'not same google/level3';
+
+    my @a;
+    @a = qw[8.8.8.8];
+    my $r3a = Net::DNS::Resolver->new(nameservers => \@a);
+    @a = qw[8.8.4.4];
+    my $r3b = Net::DNS::Resolver->new(nameservers => \@a);
+
+    isnt $r3a, $r3b => 'same ref, but not same object';
+
+};
+
 
 # get_domains should read a list of names, either from a file
 # or from the arguments, or from a combination of both
@@ -60,3 +87,5 @@
 # serial
 
 done_testing();
+
+# vim:sts=4 sw=4 ts=8: