#! /usr/bin/perl
# source: https://ssl.schlittermann.de/hg/ius/nagios/nagios-plugin-dns-serial
# © 2014 Heiko Schlittermann <hs@schlittermann.de>

=head1 NAME

 check_dns-serial - check the dns serial number from multiple sources

=head1 SYNOPSIS

 check_dns-serial [options] DOMAINS

=head1 DESCRIPTION

B<check_dns-delegation> is designed as a Icinga/Nagios plugin to verify that
all responsible NS know about the delegation.

Each domain has to pass the following tests:

=over

=item The I<reference> server needs to be authoritive.

=item The NS records known outside (checked with some public DNS service)
need to match the NS records obtained from the reference server.

=item The serial numbers obtained from the NS servers B<and> the
reference server need to match. All servers need to be authoritive!

=back

The I<DOMAINS> are passed a a list in one of the following forms:

=over

=item I<domain>

A plain domain name.

=item B<file://>I<file>

A file name containing the domains, line by line.

=item B<local:>

This item uses the output of C<named-checkconf -p> to get the list of
master/slave zones. The 127.in-addr.arpa, 168.192.in-addr.arpa, and
0.in-addr.arpa, and 127.in-addr.arpa zones are suppressed.

=back

=cut

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 @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;
            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 @domains = get_domains(@argv);
    my %override = read_override($opt_override) if defined $opt_override;

    my (@OK, %CRITICAL);
    foreach my $domain (shuffle @domains, keys %override) {
        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;

}

exit main @ARGV unless caller;

__END__

=head1 OPTIONS

=over

=item B<--reference>=I<address>

The address of the reference server for our own domains (default: 127.0.0.1)

=item B<--progress>

Tell about the progress. (default: on if input is connected to a terminal)

=item B<--override>=I<override file>

This file lists NS names for domains. Instead of trusting our own server
we use the NS listed as the authoritive ones. This is primarly useful for
some of these domains that are held on the "pending" servers of joker.

=back

=head2 Format

 # comment
 <domain> <ns> ... # comment


=head1 PERMISSIONS

No special permissions are necessary, except for the domain-list URL F<local:>, since
the output of C<named-checkconf -p> is read. This may fail, depending on the configuration of 
your bind.

=cut

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