1#!/opt/local/bin/perl 2# 3# $Id: dnscheck.pl 721 2009-03-04 15:27:27Z calle $ 4# 5# Copyright (c) 2007 .SE (The Internet Infrastructure Foundation). 6# All rights reserved. 7# 8# Redistribution and use in source and binary forms, with or without 9# modification, are permitted provided that the following conditions 10# are met: 11# 1. Redistributions of source code must retain the above copyright 12# notice, this list of conditions and the following disclaimer. 13# 2. Redistributions in binary form must reproduce the above copyright 14# notice, this list of conditions and the following disclaimer in the 15# documentation and/or other materials provided with the distribution. 16# 17# THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR 18# IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 19# WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 20# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY 21# DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 22# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE 23# GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 24# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER 25# IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR 26# OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN 27# IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 28# 29###################################################################### 30 31use warnings; 32use strict; 33 34use Getopt::Long; 35use DNSCheck; 36use Time::HiRes qw[time]; 37 38my %changed; 39my %dropped; 40my %added; 41 42my $debug; 43my $dc; 44my $config; 45my %flagdomain; 46my $filename; 47my $tsig; 48my $dig; 49my @servers; 50my $domain; 51 52my $newsuffix = '.new'; 53my $backupsuffix = '.bak'; 54 55sub setup { 56 GetOptions("debug" => \$debug); 57 58 print "Running in debug mode.\n" if $debug; 59 60 $dc = DNSCheck->new; 61 $config = $dc->config->get("zonediff"); 62 foreach my $domain (@{ $config->{flagdomain} }) { 63 $flagdomain{exist}{$domain} = 1; 64 print "Flag domain: $domain\n" if $debug; 65 } 66 67 $filename = $config->{datafile}; 68 $tsig = $config->{tsig}; 69 $tsig =~ s/ TSIG /:/; 70 $dig = $config->{dig}; 71 @servers = @{ $config->{servers} }; 72 $domain = $config->{domain}; 73 74 if ($debug) { 75 print "Data file: $filename\n"; 76 print "TSIG: $tsig\n"; 77 print "dig: $dig\n"; 78 print "Servers: @servers\n"; 79 print "Domain: $domain\n"; 80 } 81} 82 83sub fetch_new_zone { 84 my $success; 85 86 foreach my $server (@servers) { 87 my $start = time; 88 print "Trying server $server...\n" if $debug; 89 print "$dig axfr $domain \@$server -y $tsig > $filename$newsuffix\n" 90 if $debug; 91 my $res = 92 system("$dig axfr $domain \@$server -y $tsig > $filename$newsuffix"); 93 printf("Transfer ended after %0.2f seconds.\n", time() - $start); 94 $res >>= 8; 95 if ($res == 0) { 96 print "Got file.\n" if $debug; 97 $success = 1; 98 last; 99 } 100 } 101 102 unless (-e $filename) { 103 print "$filename missing.\n"; 104 if ($success) { 105 print "Moving just fetched file to $filename and exiting.\n"; 106 rename $filename . $newsuffix, $filename; 107 exit(1); 108 } 109 } 110 111 my $newsize = -s $filename . $newsuffix; 112 my $oldsize = -s $filename; 113 my $ratio = $newsize / $oldsize; 114 115 if ($ratio < 0.83) { 116 die "New file is more than 20% smaller than old file. Exiting.\n"; 117 } else { 118 printf("Ratio of new file size to old file size: %0.3f\n", $ratio) 119 if $debug; 120 } 121} 122 123sub switch_files_around { 124 rename $filename, $filename . $backupsuffix 125 or die "Failed to rename save file to backup file: $!\n"; 126 print "$filename renamed to $filename$backupsuffix\n" if $debug; 127 rename $filename . $newsuffix, $filename 128 or die "Failed to rename new file to save file: $!\n"; 129 print "$filename$newsuffix renamed to $filename\n" if $debug; 130} 131 132sub check_for_flagdomains { 133 foreach my $name (keys %{ $flagdomain{exist} }) { 134 unless ($flagdomain{new}{$name}) { 135 die "Flag domain $name missing from new file. Exiting.\n"; 136 } 137 unless ($flagdomain{old}{$name}) { 138 die "Flag domain $name missing from old file. Exiting.\n"; 139 } 140 } 141} 142 143sub line_parse { 144 my ($line) = @_; 145 146 my ($name, $type, $rest) = $line =~ m/ 147 ^ 148 ([-.a-z0-9]+)\. # Name 149 \s+ 150 \d+ # TTL 151 \s+ 152 IN 153 \s+ 154 ((?:NS)|(?:DS)|(?:A)|(?:AAAA)) # Type 155 \s+ 156 (.+) # Rest 157 $ 158 /x; 159 if ($name) { 160 if ($type eq 'A' or $type eq 'AAAA') { 161 return ($rest, $type, $name); 162 } else { 163 return ($name, $type, $rest); 164 } 165 } else { 166 return; 167 } 168} 169 170sub extract { 171 my ($ary, $type) = @_; 172 173 return join '', map { $_->[2] } 174 grep { $_->[1] eq $type } sort { $a->[2] cmp $b->[2] } @$ary; 175} 176 177sub compare { 178 my ($n, $o) = @_; 179 my $name = $n->[0][0]; 180 181 my $nns = extract($n, 'NS'); 182 my $ons = extract($o, 'NS'); 183 my $nds = extract($n, 'DS'); 184 my $ods = extract($o, 'DS'); 185 my $na = extract($n, 'A'); 186 my $oa = extract($o, 'A'); 187 my $naaaa = extract($n, 'AAAA'); 188 my $oaaaa = extract($o, 'AAAA'); 189 190 $changed{$name} .= 'NS ' if $nns ne $ons; 191 $changed{$name} .= 'DS ' if $nds ne $ods; 192 $changed{$name} .= 'A ' if $na ne $oa; 193 $changed{$name} .= 'AAAA ' if $naaaa ne $oaaaa; 194 195 my %oldns = map { $_->[2], 1 } grep { $_->[1] eq 'NS' } @$o; 196 foreach my $new (map { $_->[2], 1 } grep { $_->[1] eq 'NS' } @$n) { 197 delete $oldns{$new}; 198 } 199 foreach my $ns (keys %oldns) { 200 $dropped{$name}{$ns} = 1; 201 } 202} 203 204sub process { 205 my %res; 206 207 open my $new, '<', $filename . $newsuffix 208 or die "Failed to open $filename$newsuffix: $!\n"; 209 open my $old, '<', $filename 210 or die "Failed ot open $filename: $!\n"; 211 my $nline = ''; 212 my $oline = ''; 213 214 print "Datafiles opened.\n" if $debug; 215 216 while (defined($nline) or defined($oline)) { 217 my @n; 218 my @o; 219 220 $nline = <$new>; 221 chomp($nline) if $nline; 222 $oline = <$old>; 223 chomp($oline) if $oline; 224 225 if (defined($nline) and (@n = line_parse($nline))) { 226 $flagdomain{new}{ $n[0] } = 1 if $flagdomain{exist}{ $n[0] }; 227 $res{$nline} += 1; 228 if (defined($res{$nline}) and $res{$nline} == 0) { 229 delete $res{$nline}; 230 } 231 } 232 233 if (defined($oline) and (@o = line_parse($oline))) { 234 $flagdomain{old}{ $o[0] } = 1 if $flagdomain{exist}{ $o[0] }; 235 $res{$oline} -= 1; 236 if (defined($res{$oline}) and $res{$oline} == 0) { 237 delete $res{$oline}; 238 } 239 } 240 } 241 242 print "Data files read (" . scalar(keys %res) . " entries retained).\n" 243 if $debug; 244 245 my %old; 246 my %new; 247 while (my ($k, $v) = each %res) { 248 my ($name, $type, $data) = line_parse($k); 249 250 if ($v == 1) { 251 push @{ $new{$name} }, [$name, $type, $data]; 252 } elsif ($v == -1) { 253 push @{ $old{$name} }, [$name, $type, $data]; 254 } else { 255 print "Error: $v => $k\n"; 256 } 257 } 258 %res = (); 259 260 foreach my $zone (keys %new) { 261 if (!$old{$zone}) { 262 $added{$zone} = 1; 263 } else { 264 compare($new{$zone}, $old{$zone}); 265 } 266 } 267 print "Retained data compared.\n" if $debug; 268} 269 270sub get_source_id { 271 my $dbh = $dc->dbh; 272 273 $dbh->do(q[INSERT IGNORE INTO source (name) VALUES (?)], 274 undef, $config->{sourcestring}); 275 my @res = $dbh->selectrow_array(q[SELECT id FROM source WHERE name = ?], 276 undef, $config->{sourcestring}); 277 278 print "Got source id " . $res[0] . "\n" if $debug; 279 return $res[0]; 280} 281 282sub save_to_database { 283 my $dbh = $dc->dbh; 284 my $source_id = get_source_id(); 285 286 my $drop_sth = $dbh->prepare( 287q[INSERT IGNORE INTO delegation_history (domain, nameserver) VALUES (?,?)] 288 ); 289 my $queue_sth = $dbh->prepare( 290q[INSERT INTO queue (priority,domain,source_id,source_data) VALUES (?,?,?,?)] 291 ); 292 293 foreach my $name (keys %added) { 294 $queue_sth->execute(3, $name, $source_id, 'NEW'); 295 print "Queue: $name NEW\n" if $debug; 296 } 297 298 foreach my $name (keys %changed) { 299 $queue_sth->execute(3, $name, $source_id, $changed{$name}); 300 print "Queue: $name " . $changed{$name} . "\n" if $debug; 301 } 302 303 foreach my $zone (keys %dropped) { 304 foreach my $ns (keys %{ $dropped{$zone} }) { 305 $drop_sth->execute($zone, $ns); 306 print "Delegation History: $zone $ns\n" if $debug; 307 } 308 } 309} 310 311setup(); 312fetch_new_zone(); 313process(); 314check_for_flagdomains(); 315save_to_database(); 316switch_files_around(); 317 318=head1 NAME 319 320dnscheck-zonediff - Tool to periodically detect changes in a zone 321 322=head1 SYNOPSIS 323 324dnscheck-zonediff [--debug] 325 326Options: 327 328 --debug Make the script print out some progress and result information. 329 330=head1 EXPLANATION 331 332This script calls out to L<dig> to download a zonefile using a cryptographic 333signature. The zone, the signature, the servers to ask, the file to save the 334data in, the database to put insert differences into and so on is all 335specified in L<config.yaml> (or the corresponding site_config). 336 337This script relies heavily on the output from L<dig> nor changing its format 338and to be in properly sorted order. 339