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, '-|', 'named-checkconf -p');

    32     while (<$z>) {

    33         state $line;

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

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

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

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

    38             push @conf, $line;

    39             $line = '';

    40         }

    41     }

    42     return grep { 

    43 	# FIXME: 172.0 .. 172.31 is missing

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

    45 	not /^localhost$/;

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

    47 }

    48 

    49 sub get_domains {

    50     my %arg = @_;

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

    52     my @domains = ();

    53 

    54     foreach my $src (@sources) {

    55 

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

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

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

    59             next;

    60         }

    61 

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

    63             push @domains, get_local_zones;

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

    65             next;

    66         }

    67 

    68         push @domains, $src;

    69     }

    70 

    71     return @domains;

    72 }

    73 

    74 # return a list of "official" nameservers

    75 sub ns {

    76     my $domain = shift;

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

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

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

    80     my $override = delete $resflags{override};

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

    82     my @ns;

    83 

    84     return sort @{$override->{$domain}} if exists $override->{$domain};

    85 

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

    87     my $q;

    88 

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

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

    91     }

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

    93 

    94     die "no aa \@$nameservers\n" if $aa and not $q->header->aa;

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

    96 

    97     return sort @ns;

    98 }

    99 

   100 sub serial {

   101     my $domain = shift;

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

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

   104 

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

   106     my $q;

   107 

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

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

   110     }

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

   112 

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

   114 }

   115 

   116 # - the nameservers known from the ns records

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

   118 #   NS for the zone

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

   120 #

   121 # OK - if the serial numbers are in sync

   122 # WARNING - if there is some difference

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

   124 

   125 sub ns_ok {

   126     my ($domain, $reference, $override) = @_;

   127 

   128     my (@errs, @ns);

   129     my @our = eval { sort +ns($domain, nameservers => [$reference], aa => 1, override => $override) };

   130     push @errs, $@ if $@;

   131 

   132     my @their = eval { sort +ns($domain) };

   133     push @errs, $@ if $@;

   134 

   135     if (@errs) {

   136         chomp @errs;

   137         die join(', ' => @errs) . "\n";

   138     }

   139     

   140     if ("@our" ne "@their") {

   141         local $" = ', ';

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

   143             $override->{$domain} ? 'override' : 'our';

   144     }

   145 

   146     @ns = uniq sort @our, @their;

   147     ### @ns

   148     return @ns;

   149 }

   150 

   151 sub serial_ok {

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

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

   154     ### @serials

   155 

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

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

   158     }

   159     

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

   161     return $1;

   162 }

   163 

   164 sub main {

   165     my @argv          = @_;

   166     my $opt_reference = '127.0.0.1';

   167     my $opt_progress  = -t;

   168     my ($opt_override)= grep { -f } '/etc/bind/zones.override';

   169                         

   170 

   171     GetOptionsFromArray(

   172         \@argv,

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

   174         'progress!'   => \$opt_progress,

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

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

   177         'm|man'       => sub {

   178             pod2usage(

   179                 -verbose   => 2,

   180                 -exit      => 0,

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

   182             );

   183         }

   184       )

   185       and @argv

   186       or pod2usage;

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

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

   189 

   190     my (@OK, %CRITICAL);

   191     foreach my $domain (shuffle @domains) {

   192         print STDERR "$domain " if $opt_progress;

   193 

   194         my @ns = eval { ns_ok($domain, $opt_reference, \%override) };

   195 	if ($@) { 

   196             $CRITICAL{$domain} = $@;

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

   198             next;

   199         }

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

   201 

   202         my @serial = eval { serial_ok($domain, @ns, $opt_reference) };

   203         if ($@) {

   204             $CRITICAL{$domain} = $@;

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

   206             next;

   207         }

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

   209         push @OK, $domain;

   210 

   211     }

   212 

   213     #    use DDP;

   214     #    p @OK;

   215     #    p %CRITICAL;

   216 

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

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

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

   220         return 2;

   221     }

   222 

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

   224     return 0;

   225 

   226 }

   227 

   228 1;

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