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