--- a/lib/Nagios/Check/DNS/delegation.pm Tue Jul 12 16:10:03 2016 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,248 +0,0 @@
-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, '-|') or do {
- my $bind_directory;
- open(my $x, '-|', 'named-checkconf -p');
- while (<$x>) {
- /^\s*directory\s+"(.*)";/ and $bind_directory = $1;
- print;
- }
- if (defined $bind_directory) {
- local @ARGV = grep { -f } glob "$bind_directory/*nzf";
- print <> if @ARGV;
- }
- exit 0;
- };
- while (<$z>) {
- /^#/ and next; # comment
- 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 $nameservers = join ',' => @{$resflags{nameservers}};
- my @ns;
-
- 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(NS) \@$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 $aa = delete $resflags{aa};
- 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;
- die "no aa(SOA) \@$nameservers\n" if $aa and not $q->header->aa;
-
- 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, $references, $is_override) = @_;
-
- my (@errs, @ns);
- # obtain an authoritive list of nameservers from the reference server
- my @our = eval { sort +ns($domain, nameservers => $references, aa => 1) };
- if (chomp $@) {
- push @errs, $@;
- push @our, $@;
- }
-
- # obtain a list of nameservers from some public nameserver
- my @public = eval { sort +ns($domain) };
- if (chomp $@) {
- push @errs, $@;
- push @public, $@;
- }
-
- if (@errs or "@our" ne "@public") {
- local $" = ', ';
- die sprintf "NS differ (%s: @our) vs (public: @public)\n",
- $is_override ? 'override' : 'our';
-
- }
-
- @ns = uniq sort @our, @public;
- ### @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/check_dns-delegation/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) {
- state $all = @domains;
- state $i++;
- print STDERR "$domain ($i/$all) " if $opt_progress;
-
- my @ns = eval { ns_ok($domain, $override{$domain} ? $override{$domain} : [$opt_reference],
- $override{$domain}) };
- 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, $override{$domain} ? () : $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: