3 # Copyright (c) 2010, 2014, 2015, 2017 Peter Palfrader <peter@palfrader.org>
5 # Permission is hereby granted, free of charge, to any person obtaining
6 # a copy of this software and associated documentation files (the
7 # "Software"), to deal in the Software without restriction, including
8 # without limitation the rights to use, copy, modify, merge, publish,
9 # distribute, sublicense, and/or sell copies of the Software, and to
10 # permit persons to whom the Software is furnished to do so, subject to
11 # the following conditions:
13 # The above copyright notice and this permission notice shall be
14 # included in all copies or substantial portions of the Software.
16 # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
17 # EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
18 # MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
19 # NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
20 # LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
21 # OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
22 # WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
27 use Net::DNS::Resolver;
31 # taken from Array::Utils
32 # http://cpansearch.perl.org/src/ZMIJ/Array-Utils-0.5/Utils.pm
33 # This module is Copyright (c) 2007 Sergei A. Fedorov.
34 # You may distribute under the terms of either the GNU General Public
35 # License or the Artistic License, as specified in the Perl README file.
38 my %e = map { $_ => undef } @{$_[0]};
39 return grep { exists( $e{$_} ) } @{$_[1]};
41 sub array_diff(\@\@) {
42 my %e = map { $_ => undef } @{$_[1]};
43 return @{[ ( grep { (exists $e{$_}) ? ( delete $e{$_} ) : ( 1 ) } @{ $_[0] } ), keys %e ] };
45 sub array_minus(\@\@) {
46 my %e = map{ $_ => undef } @{$_[1]};
47 return grep( ! exists( $e{$_} ), @{$_[0]} );
51 $SIG{'__DIE__'} = sub { print @_; exit 4; };
53 my $RES = Net::DNS::Resolver->new;
54 my $DLV = 'dlv.isc.org';
64 print "Querying $type $zone\n" if $params->{'verbose'};
65 my $pkt = $RES->send($zone, $type);
66 return () unless $pkt;
67 return () unless $pkt->answer;
68 for my $rr ($pkt->answer) {
69 next unless ($rr->type eq $type);
70 next unless (lc($rr->name) eq lc($zone));
72 my $tag = $options{'pretty'} ? sprintf("%5d(%d)", $rr->keytag, $rr->algorithm) : $rr->keytag;
74 if ($type eq 'DNSKEY' && ($rr->{'flags'} & (1<<(15-8)))) {
79 # for now only handle KSKs, i.e. keys with the SEP flag set
80 if ($type eq 'DNSKEY' && !($rr->sep)) {
87 if ($type eq 'DNSKEY' && (scalar @result) == 0) {
88 # use remaining keys if no keys with the SEP bit are present
92 @result = sort {$a cmp $b} grep {!$unique{$_}++} @result;
99 return get_tag_generic($zone, 'DNSKEY', %options);
104 return get_tag_generic($zone, 'DS', %options);
110 return get_tag_generic($zone, 'DLV', %options);
112 sub has_dnskey_parent {
115 my $potential_parent;
116 if ($zone =~ m/\./) {
117 $potential_parent = $zone;
118 $potential_parent =~ s/^[^.]+\.//;
120 $potential_parent = '.';
123 print "Querying DNSKEY $potential_parent\n" if $params->{'verbose'};
124 my $pkt = $RES->send($potential_parent, 'DNSKEY');
125 return undef unless $pkt;
126 return undef unless $pkt->header;
128 unless ($pkt->answer) {
129 return undef unless $pkt->authority;
130 for my $rr ($pkt->authority) {
131 next unless ($rr->type eq 'SOA');
133 $potential_parent = $rr->name;
134 print "Querying DNSKEY $potential_parent\n" if $params->{'verbose'};
135 $pkt = $RES->send($potential_parent, 'DNSKEY');
136 return undef unless $pkt;
141 return (0, $potential_parent) unless $pkt->answer;
142 for my $rr ($pkt->answer) {
143 next unless ($rr->type eq 'DNSKEY');
144 return (1, $potential_parent);
147 sub get_parent_dnssec_status {
152 my ($status, $parent) = has_dnskey_parent($zone);
153 last unless defined $status;
154 push @result, ($status ? "yes" : "no") . ("($parent)");
156 last if $zone eq "" || $zone eq '.';
159 return join(', ', @result);
166 print $fd "Usage: $PROGRAM_NAME [--dir <dir>] overview|check-dlv|check-ds|check-header zone [zone...]\n";
167 print $fd " $PROGRAM_NAME --dir <dir> overview|check-dlv|check-ds|check-header\n";
168 print $fd " $PROGRAM_NAME --help\n";
174 my $zonefile = shift;
179 open(F, "<", $zonefile) or die ("Cannot open zonefile $zonefile for $zone: $!\n");
181 if (/^[#;]\s*dlv-submit\s*=\s*yes\s*$/) { $do_dlv = 1; }
182 if (/^[#;]\s*ds-in-parent\s*=\s*yes\s*$/) { $do_ds = 1; }
186 return { 'dlv' => $do_dlv,
193 my @elems = intersect(@$a, @$b);
194 push @elems, map { '-'.$_ } array_minus(@$a, @$b);
195 push @elems, map { '+'.$_ } array_minus(@$b, @$a);
196 return join(',', @elems);
199 Getopt::Long::config('bundling');
201 '--help' => \$params->{'help'},
202 '--dir=s@' => \$params->{'dir'},
203 '--dlv=s' => \$params->{'dlv'},
204 '--verbose' => \$params->{'verbose'},
205 ) or usage(\*STDERR, 1);
206 usage(\*STDOUT, 0) if ($params->{'help'});
208 my $mode = shift @ARGV;
209 usage(\*STDOUT, 0) unless (defined $mode && $mode =~ /^(overview|check-dlv|check-ds|check-header)$/);
210 die ("check-header needs --dir") if ($mode eq 'check-header' && !defined $params->{'dir'});
214 if (defined $params->{'dir'} && $mode ne 'check-header') {
215 warn "--dir option ignored"
217 %zones = map { $_ => $_} @ARGV;
219 my $dirs = $params->{'dir'};
220 usage(\*STDOUT, 0) unless (defined $dirs);
222 for my $dir (@$dirs) {
223 chdir $dir or die "chdir $dir failed? $!\n";
224 opendir DIR, '.' or die ("Cannot opendir $dir\n");
225 for my $file (readdir DIR) {
226 next if ( -l "$file" );
227 next unless ( -f "$file" );
228 next if $file =~ /^(dsset|keyset)-/;
231 if ($file =~ /\.zone$/) { # it's one of our yaml things
232 $zone = basename($file, '.zone');
234 $zones{$zone} = "$dir/$file";
240 $DLV = $params->{'dlv'} if $params->{'dlv'};
243 if ($mode eq 'overview') {
245 for my $zone (keys %zones) {
246 $data{$zone} = { 'dnskey' => join(', ', get_dnskeytags($zone, pretty=>1)),
247 'ds' => join(', ', get_dstags($zone, pretty=>1)),
248 'dlv' => join(', ', get_dlvtags($zone, pretty=>1)),
249 'parent_dnssec' => get_parent_dnssec_status($zone) };
252 my $format = "%60s %-20s %-15s %-3s %-10s\n";
253 printf $format, "zone", "DNSKEY", "DS\@parent", "DLV", "dnssec\@parent";
254 printf $format, "-"x 60, "-"x 20, "-"x 15, "-"x 3, "-"x 10;
255 for my $zone (sort {$a cmp $b} keys %data) {
256 printf $format, $zone,
257 $data{$zone}->{'dnskey'},
258 $data{$zone}->{'ds'},
259 $data{$zone}->{'dlv'},
260 $data{$zone}->{'parent_dnssec'};
263 } elsif ($mode eq 'check-dlv' || $mode eq 'check-ds' || $mode eq 'check-header') {
265 push @to_check, 'dlv' if $mode eq 'check-header' || $mode eq 'check-dlv';
266 push @to_check, 'ds' if $mode eq 'check-header' || $mode eq 'check-ds';
270 for my $zone (sort {$a cmp $b} keys %zones) {
271 my $require = { map { $_ => 1 } @to_check };
272 if ($mode eq 'check-header') {
273 $require = what_to_check($zone, $zones{$zone})
276 my @dnskey = get_dnskeytags($zone);
277 for my $thiskey (@to_check) {
278 my @target = $thiskey eq 'ds' ? get_dstags($zone) : get_dlvtags($zone);
280 my $spec = diff_spec(\@target, \@dnskey);
281 # if the intersection between DS and KEY is empty,
282 # or if there are DS records for keys we do not have, that's an issue.
283 if (intersect(@dnskey, @target) == 0 || array_minus(@target, @dnskey)) {
284 if ($require->{$thiskey} || scalar @target > 0) {
285 push @warn, "$zone ($spec)";
288 if ($require->{$thiskey}) {
289 push @ok, "$zone ($spec)";
294 print "WARNING: ", join(", ", @warn), "\n" if (scalar @warn);
295 print "OK: ", join(", ", @ok), "\n" if (scalar @ok);
296 exit (1) if (scalar @warn);
299 die ("Invalid mode '$mode'\n");