1#!/usr/bin/perl
2#
3# $Id: DNSSEC.pm 882 2010-05-25 08:13:27Z el $
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
31package DNSCheck::Test::DNSSEC;
32
33require 5.008;
34use warnings;
35use strict;
36
37our $SVN_VERSION = '$Revision: 882 $';
38
39use base 'DNSCheck::Test::Common';
40
41use Net::DNS 0.59;
42use Net::DNS::SEC 0.14;
43use Date::Parse;
44use POSIX qw(strftime);
45
46######################################################################
47
48sub test {
49    my $self   = shift;
50    my $parent = $self->parent;
51    my $zone   = shift;
52
53    return unless $parent->config->should_run;
54
55    my $qclass = $self->qclass;
56    my $logger = $parent->logger;
57    my $errors = 0;
58    my $flags  = { transport => "tcp", dnssec => 1, aaonly => 1 };
59    my $packet;
60
61    my $ds;
62    my $dnskey;
63
64    my $child_errors;
65    my $child_result;
66    my $parent_errors;
67
68    $logger->module_stack_push();
69    $logger->auto("DNSSEC:BEGIN", $zone);
70
71    my $faked_zone = $self->parent->resolver->faked_zone($zone);
72
73    # Query parent for DS
74    # if DS is found at parent, the child must be signed
75    $logger->auto("DNSSEC:CHECKING_DS_AT_PARENT", $zone);
76    $packet =
77      $parent->dns->query_parent_nocache($zone, $zone, $qclass, "DS", $flags);
78    unless ($packet and $packet->header->rcode eq 'NXDOMAIN' and $faked_zone) {
79        $ds = _dissect($packet, "DS");
80        if ($ds && $#{ $ds->{DS} } >= 0) {
81            $logger->auto("DNSSEC:DS_FOUND", $zone);
82        } else {
83            $logger->auto("DNSSEC:NO_DS_FOUND", $zone);
84        }
85    }
86
87    # Query child for DNSKEY
88    # if DNSKEY is found at child, the child is probably running DNSSEC
89    $logger->auto("DNSSEC:CHECKING_DNSKEY_AT_CHILD", $zone);
90
91    # Loop over all children. Ask for DNSKEY with DNSSEC enabled.
92    # Check for DNSKEY+RRSIG. Let through the best one we find.
93    # Warn for inconsistent replies.
94    my @nsc;
95    my $v4nsc;
96    $v4nsc = $parent->dns->get_nameservers_ipv4($zone, $qclass)
97      if $self->config->get("net")->{ipv4};
98    push @nsc, @$v4nsc if $v4nsc;
99    my $v6nsc;
100    $v6nsc = $parent->dns->get_nameservers_ipv6($zone, $qclass)
101      if $self->config->get("net")->{ipv6};
102    push @nsc, @$v6nsc if $v6nsc;
103
104    my %extra;
105    my $good_packet;
106    foreach my $childns (@nsc) {
107        $packet =
108          $parent->dns->query_explicit($zone, $qclass, 'DNSKEY', $childns,
109            $flags);
110        next unless ($packet and $packet->header->ancount > 0);
111        my $tmp = _dissect($packet, 'DNSKEY');
112        if (    $tmp
113            and ($tmp->{DNSKEY} and @{ $tmp->{DNSKEY} } > 0)
114            and ($tmp->{RRSIG}  and @{ $tmp->{RRSIG} } > 0))
115        {
116            $logger->auto('DNSSEC:EXTRA_PROCESSING', $childns);
117            $extra{yes} += 1;
118            $good_packet = $packet;
119        } else {
120            $logger->auto('DNSSEC:NO_EXTRA_PROCESSING', $childns);
121            $extra{no} += 1;
122        }
123    }
124
125    if ($extra{yes} and $extra{no}) {
126        $logger->auto('DNSSEC:INCONSISTENT_EXTRA_PROCESSING', $zone);
127    } else {
128        $logger->auto('DNSSEC:CONSISTENT_EXTRA_PROCESSING', $zone);
129    }
130
131    $packet = $good_packet || $packet;
132
133    # End of all-child processing.
134
135    $dnskey = _dissect($packet, "DNSKEY");
136
137    # TODO: check that the DNSKEY protocol field is equal to 3
138    if ($dnskey && $#{ $dnskey->{DNSKEY} } >= 0) {
139        $logger->auto("DNSSEC:DNSKEY_FOUND", $zone);
140    } else {
141        $logger->auto("DNSSEC:DNSKEY_NOT_FOUND", $zone);
142    }
143
144    # Determine security status
145    $logger->auto("DNSSEC:DETERMINE_SECURITY_STATUS", $zone);
146    if ($ds) {
147        if ($dnskey) {
148            ## DS at parent, DNSKEY at child
149            $logger->auto("DNSSEC:CONSISTENT_SECURITY", $zone);
150        } else {
151            ## DS at parent, but no DNSKEY at child
152            $errors += $logger->auto("DNSSEC:INCONSISTENT_SECURITY", $zone);
153            goto DONE;
154        }
155    } else {
156        if ($dnskey) {
157            ## DNSKEY at child, no DS at parent
158            # TODO: is this noteworthy?
159        } else {
160            ## No DNSKEY at child and no DS at parent
161            # TODO: is this noteworthy?
162        }
163    }
164
165    if (!$dnskey) {
166
167        # Child has no DNSKEY, we're done
168        $logger->auto("DNSSEC:SKIPPED_NO_KEYS", $zone);
169        goto DONE;
170    }
171
172    if (!$ds and $dnskey and !$faked_zone) {
173        $errors += $logger->auto("DNSSEC:MISSING_DS", $zone);
174    }
175
176    ($child_errors, $child_result) = _check_child($parent, $zone, $dnskey);
177    $errors += $child_errors;
178
179    # Only check parent if we've found a DS at the parent
180    if ($ds) {
181        $parent_errors =
182          _check_parent($parent, $zone, $ds, $dnskey, $child_result);
183        $errors += $parent_errors;
184    }
185
186  DONE:
187    $logger->auto("DNSSEC:END", $zone);
188    $logger->module_stack_pop();
189    return $errors;
190}
191
192######################################################################
193
194sub _check_child {
195    my $parent = shift;
196    my $zone   = shift;
197    my $dnskey = shift;
198
199    my $qclass = $parent->config->get("dns")->{class};
200    my $logger = $parent->logger;
201    my $errors = 0;
202
203    my $flags = { transport => "tcp", dnssec => 1 };
204
205    my $packet;
206    my %keyhash;
207    my %result;
208
209    my $mandatory_algorithm = 0;
210    my $sep                 = 0;
211
212    # initialize result set
213    $result{rr}      = undef;
214    $result{allkeys} = undef;
215    $result{anchors} = ();
216    $result{sep}     = ();
217
218    $logger->auto("DNSSEC:CHECKING_CHILD", $zone);
219
220    foreach my $key (@{ $dnskey->{DNSKEY} }) {
221
222        # REQUIRE: a DNSKEY SHOULD NOT be of type RSA/MD5
223        if ($key->algorithm == Net::DNS::SEC->algorithm("RSAMD5")) {
224            $logger->auto("DNSSEC:DNSKEY_ALGORITHM_NOT_RECOMMENDED",
225                $zone, $key->keytag, "RSA/MD5");
226        }
227
228        if ($key->algorithm == Net::DNS::SEC->algorithm("RSASHA1")
229            || $key->algorithm == Net::DNS::SEC->algorithm("RSA-NSEC3-SHA1"))
230        {
231            $mandatory_algorithm++;
232        }
233
234        # REQUIRE: a DNSKEY used for RRSIGs MUST have protocol DNSSEC (3)
235        if ($key->protocol != 3) {
236            $logger->auto("DNSSEC:DNSKEY_SKIP_PROTOCOL",
237                $zone, $key->keytag, $key->protocol);
238            next;
239        }
240
241        # REQUIRE: a DNSKEY used for RRSIGs MUST be a zone key
242        unless ($key->flags & 0x0100) {
243            $logger->auto("DNSSEC:DNSKEY_SKIP_TYPE", $zone, $key->keytag);
244            next;
245        }
246
247        $keyhash{ $key->keytag } = $key;
248
249        if ($key->is_sep) {
250            $logger->auto("DNSSEC:DNSKEY_SEP", $zone, $key->keytag);
251            push @{ $result{sep} }, $key->keytag;
252            $sep++;
253        }
254    }
255
256    # fill result set
257    $result{rr} = \%keyhash;
258    @{ $result{allkeys} } = keys %keyhash;
259
260    # REQUIRE: at least one DNSKEY SHOULD be RSA/SHA1
261    if ($mandatory_algorithm > 0) {
262        $logger->auto("DNSSEC:DNSKEY_MANDATORY_FOUND", $zone);
263    } else {
264        $errors += $logger->auto("DNSSEC:DNSKEY_MANDATORY_NOT_FOUND", $zone);
265    }
266
267    unless ($#{ $dnskey->{RRSIG} } >= 0) {
268
269        $packet =
270          $parent->dns->query_child_nocache($zone, $zone, $qclass, "RRSIG",
271            $flags);
272
273        if (    $packet->header->rcode eq "NOERROR"
274            and $packet->header->ancount > 0)
275        {
276            my $tmp = $packet->answerfrom;
277            $errors += $logger->auto("DNSSEC:ADDITIONAL_PROCESSING_BROKEN",
278                $zone, ($tmp ? $tmp : 'Unknown'));
279        } else {
280            $errors += $logger->auto("DNSSEC:NO_SIGNATURES", $zone);
281        }
282
283        $logger->auto("DNSSEC:CHILD_CHECK_ABORTED", $zone);
284
285        goto DONE;
286    }
287
288    # REQUIRE: RRSIG(DNSKEY) MUST be valid and created by a valid DNSKEY
289    my $valid_dnskey_signatures = 0;
290    foreach my $sig (@{ $dnskey->{RRSIG} }) {
291        my $valid =
292          _check_signature($parent, $zone, $sig, $dnskey->{DNSKEY},
293            $dnskey->{DNSKEY});
294
295        push @{ $result{anchors} }, $sig->keytag;
296
297        if (_count_in_list($sig->keytag, $result{allkeys}) == 1) {
298            $valid_dnskey_signatures += $valid;
299
300            $logger->auto("DNSSEC:DNSKEY_SIGNATURE_OK", $zone, $sig->keytag);
301        } else {
302            $logger->auto("DNSSEC:DNSKEY_SIGNER_UNPUBLISHED",
303                $zone, $sig->keytag);
304        }
305    }
306    if ($valid_dnskey_signatures > 0) {
307        ## Enough valid signatures over DNSKEY RRset
308        $logger->auto("DNSSEC:DNSKEY_VALID_SIGNATURES", $zone);
309    } else {
310        ## No valid signatures over the DNSKEY RRset
311        $logger->auto("DNSSEC:DNSKEY_NO_VALID_SIGNATURES", $zone);
312    }
313
314    # REQUIRE: RRSIG(SOA) MUST be valid and created by a valid DNSKEY
315    $packet =
316      $parent->dns->query_child_nocache($zone, $zone, $qclass, "SOA", $flags);
317    goto DONE unless ($packet);
318    my $soa = _dissect($packet, "SOA");
319    my $valid_soa_signatures = 0;
320    foreach my $sig (@{ $soa->{RRSIG} }) {
321        my $valid =
322          _check_signature($parent, $zone, $sig, $dnskey->{DNSKEY},
323            $soa->{SOA});
324
325        push @{ $result{anchors} }, $sig->keytag;
326
327        if (_count_in_list($sig->keytag, $result{allkeys}) == 1) {
328            $valid_soa_signatures += $valid;
329            $logger->auto("DNSSEC:SOA_SIGNATURE_OK", $zone, $sig->keytag);
330        } else {
331            $logger->auto("DNSSEC:SOA_SIGNER_UNPUBLISHED", $zone, $sig->keytag);
332        }
333    }
334    if ($valid_soa_signatures > 0) {
335        ## Enough valid signatures over SOA RRset
336        $logger->auto("DNSSEC:SOA_VALID_SIGNATURES", $zone);
337    } else {
338        ## No valid signatures over the SOA RRset
339        $logger->auto("DNSSEC:SOA_NO_VALID_SIGNATURES", $zone);
340    }
341
342  DONE:
343    $logger->auto("DNSSEC:CHILD_CHECKED", $zone);
344    return ($errors, \%result);
345}
346
347######################################################################
348
349sub _check_parent {
350    my $parent       = shift;
351    my $zone         = shift;
352    my $ds           = shift;
353    my $dnskey       = shift;
354    my $child_result = shift;
355
356    my $qclass = $parent->config->get("dns")->{class};
357    my $logger = $parent->logger;
358    my $errors = 0;
359
360    my $mandatory_algorithm = 0;
361
362    $logger->auto("DNSSEC:CHECKING_PARENT", $zone);
363
364    foreach my $rr (@{ $ds->{DS} }) {
365
366        my $ds_message = sprintf("DS(%s/%d/%d/%d)",
367            $zone, $rr->algorithm, $rr->digtype, $rr->keytag);
368
369        $logger->auto("DNSSEC:PARENT_DS", $zone, $ds_message);
370
371        # FIXME: Add RSA/SHA256 when we get a Net::DNS::SEC. that supports it.
372        if (   $rr->algorithm == Net::DNS::SEC->algorithm("RSASHA1")
373            || $rr->algorithm == Net::DNS::SEC->algorithm("RSA-NSEC3-SHA1"))
374        {
375            $mandatory_algorithm++;
376        }
377
378        if ($rr->algorithm == Net::DNS::SEC->algorithm("RSAMD5")) {
379            $logger->auto("DNSSEC:DS_ALGORITHM_MD5");
380        }
381
382        # REQUIRE: the DS MUST point to a DNSKEY that is
383        # signing the child's DNSKEY RRset
384        if (_count_in_list($rr->keytag, $child_result->{anchors}) >= 1
385            and $rr->verify($child_result->{rr}{ $rr->keytag }))
386        {
387            ## DS refers to key signing the DNSKEY RRset
388            $logger->auto("DNSSEC:DS_KEYREF_OK", $zone, $ds_message);
389        } else {
390            ## DS refers to key not signing the DNSKEY RRset
391            $logger->auto("DNSSEC:DS_KEYREF_INVALID", $zone, $ds_message);
392        }
393
394        # REQUIRE: the DS MAY point to a SEP at the child
395        if ($#{ $child_result->{sep} } >= 0) {
396            if (_count_in_list($rr->keytag, $child_result->{sep}) > 0) {
397                ## Child is using SEP and DS refers to a SEP
398                $logger->auto("DNSSEC:DS_TO_SEP", $zone, $ds_message);
399            } else {
400                ## Child is using SEP and DS refers to a non-SEP
401                $logger->auto("DNSSEC:DS_TO_NONSEP", $zone, $ds_message);
402            }
403        }
404    }
405
406    # REQUIRE: at least one DS algorithm SHOULD be of type RSA/SHA1
407    if ($mandatory_algorithm > 0) {
408        $logger->auto("DNSSEC:DS_MANDATORY_FOUND", $zone);
409    } else {
410        $errors += $logger->auto("DNSSEC:DS_MANDATORY_NOT_FOUND", $zone);
411    }
412
413  DONE:
414    $logger->auto("DNSSEC:PARENT_CHECKED", $zone);
415    return $errors;
416}
417
418######################################################################
419
420sub _dissect {
421    my $packet = shift;
422    my $qtype  = shift;
423
424    my %response = ();
425
426    return unless ($packet);
427
428    foreach my $rr ($packet->answer) {
429        if (    $rr->type eq "RRSIG"
430            and $qtype ne "RRSIG"
431            and $rr->typecovered eq $qtype)
432        {
433            push @{ $response{RRSIG} }, $rr;
434            next;
435        }
436
437        if ($rr->type eq $qtype) {
438            push @{ $response{$qtype} }, $rr;
439            next;
440        }
441    }
442
443    if ($#{ $response{$qtype} } < 0) {    # FIXME: This must be a bug
444        return;
445    }
446
447    return \%response;
448}
449
450sub _check_signature ($$$$) {
451    my $parent = shift;
452    my $zone   = shift;
453    my $rrsig  = shift;
454    my $keys   = shift;
455    my $rrset  = shift;
456
457    my $result;
458
459    my $logger = $parent->logger;
460
461    die "bad call to check_signature()" unless ($rrsig->type eq "RRSIG");
462
463    my $now = time();
464
465    my $inception  = _parse_timestamp($rrsig->siginception);
466    my $expiration = _parse_timestamp($rrsig->sigexpiration);
467
468    my $message = sprintf("RRSIG(%s/%s/%s/%d)",
469        $rrsig->name, $rrsig->class, $rrsig->typecovered, $rrsig->keytag);
470
471    if ($inception > $now) {
472        $logger->auto("DNSSEC:RRSIG_NOT_YET_VALID", $message);
473        return 0;
474    } elsif ($expiration < $now) {
475        $logger->auto("DNSSEC:RRSIG_EXPIRED", $message);
476        return 0;
477    } else {
478        $logger->auto("DNSSEC:RRSIG_EXPIRES_AT", scalar(gmtime($expiration)));
479    }
480
481    if ($rrsig->verify($rrset, $keys)) {
482        $logger->auto("DNSSEC:RRSIG_VERIFIES", $message);
483    } else {
484        $logger->auto("DNSSEC:RRSIG_FAILS_VERIFY", $message,
485            $rrsig->vrfyerrstr);
486        return 0;
487    }
488
489    $logger->auto("DNSSEC:RRSIG_VALID", $message);
490    return 1;
491}
492
493sub _parse_timestamp ($) {
494    my $str = shift;
495
496    if ($str =~ /^(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})$/) {
497        return str2time("$1-$2-$3 $4:$5:$6", "GMT");
498    } else {
499        return;
500    }
501}
502
503sub _count_in_list ($$) {
504    my $value = shift;
505    my $list  = shift;
506
507    my $n = 0;
508
509    foreach my $x (@{$list}) {
510        $n++ if ($x == $value);
511    }
512
513    return $n;
514}
515
5161;
517
518__END__
519
520
521=head1 NAME
522
523DNSCheck::Test::DNSSEC - Test DNSSEC
524
525=head1 DESCRIPTION
526
527=over 4
528
529=item *
530If there exists DS at parent, the child must use DNSSEC.
531
532=item *
533If there exists DNSKEY at child, the parent should have a DS.
534
535=item *
536A DNSSEC key should not be of type RSA/MD5.
537
538=item *
539At least one DNSKEY should be of type RSA/SHA1.
540
541=item *
542There may exist a SEP at the child.
543
544=item *
545RRSIG(DNSKEY) must be valid and created by a valid DNSKEY.
546
547=item *
548RRSIG(SOA) must be valid and created by a valid DNSKEY.
549
550=item *
551The DS must point to a DNSKEY signing the child's DNSKEY RRset.
552
553=item *
554The DS may point to a SEP at the child.
555
556=item *
557At least one DS algorithm should be of type RSA/SHA1.
558
559=back
560
561=head1 METHODS
562
563=over
564
565=item ->test($zonename)
566
567=item ->rrsig_validities($zonename)
568
569=back
570
571=head1 EXAMPLES
572
573=head1 SEE ALSO
574
575L<DNSCheck>, L<DNSCheck::Logger>
576
577=cut
578