1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
|
#!/usr/bin/perl
# vim: shiftwidth=4 tabstop=4
#
# This program implements the procedure defined in RFC 7958bis to update the
# root zone DNSSEC trust anchors.
#
# https://datatracker.ietf.org/doc/draft-ietf-dnsop-rfc7958bis/
use v5.32;
use warnings;
use XML::LibXML;
use DateTime;
use DateTime::Format::RFC3339;
use Net::DNS;
use Path::Tiny;
##############################################################################
sub parse_root_anchors {
my ($file) = @_;
my $now = DateTime->now;
my $format = DateTime::Format::RFC3339->new;
my $dom = XML::LibXML->load_xml(location => $file);
# check the basic XML structure of the file
my ($zone) = $dom->findnodes('/TrustAnchor/Zone')
or die "<TrustAnchor><Zone> node not found!\n";
my $zone_value = $zone->to_literal or die;
die "These hints are not for the root zone!\n" if not $zone_value eq '.';
# parse each anchor
my (@dnskey, @ds);
foreach my $key ($dom->findnodes('/TrustAnchor/KeyDigest')) {
my $id = $key->{id} or die 'No key id';
my $tag = $key->findvalue('./KeyTag') or die 'No key tag';
my $valid_until = $key->{validUntil};
if (defined $valid_until) {
$valid_until = $format->parse_datetime($valid_until);
if (DateTime->compare($valid_until, $now) <= 0) {
say "Key $tag ignored: it expired on $valid_until.";
next;
}
}
my $valid_from = $key->{validFrom};
if (defined $valid_from) {
$valid_from = $format->parse_datetime($valid_from);
say "Key $tag is or will be valid from $valid_from.";
} else {
say "Key $tag has no initial validity date defined.";
}
my $new_ds = Net::DNS::RR->new(
owner => '.',
type => 'DS',
keytag => $tag,
algorithm => $key->findvalue('./Algorithm'),
digtype => $key->findvalue('./DigestType'),
digest => $key->findvalue('./Digest')
);
push(@ds, $new_ds);
my $publickey = $key->findvalue('./PublicKey') or next;
my $new_dnskey = Net::DNS::RR->new(
owner => '.',
type => 'DNSKEY',
keytag => $tag,
algorithm => $key->findvalue('./Algorithm'),
flags => $key->findvalue('./Flags'),
key => $publickey,
);
compare_key_ds($new_dnskey, $new_ds);
push(@dnskey, $new_dnskey);
}
return {
dnskey => \@dnskey,
ds => \@ds,
};
}
##############################################################################
# Make sure that the DS record matches the DNSKEY record, as required by
# RFC 7958bis section 4.1.2.
sub compare_key_ds {
my ($key, $ds) = @_;
# create a DS record computed from the key in the DNSKEY record
my $dsk = Net::DNS::RR::DS->create(
$key,
digtype => $ds->digtype,
);
# and check they it matches the anchor DS record
if ($ds->algorithm ne $dsk->algorithm or $ds->digest ne $dsk->digest) {
say 'The DS record in the root anchors file:';
$ds->print;
say "\ndoes not match the DS record computed from the key in the"
. " root anchors file:";
$dsk->print;
die;
}
return 1;
}
##############################################################################
sub write_ds {
my ($file, $data) = @_;
my $out = path($file);
my @lines = map {
join(' ', $_->{owner}->string, $_->class, $_->type,
$_->keytag, $_->algorithm, $_->digtype, uc $_->digest)
. "\n"
} @$data;
$out->spew(@lines);
return;
}
sub write_dnskey {
my ($file, $data) = @_;
my $out = path($file);
my @lines = map {
join(' ', $_->{owner}->string, $_->class, $_->type,
$_->flags, $_->protocol, $_->algorithm, $_->key)
. " ; keytag " . $_->keytag . "\n"
} @$data;
$out->spew(@lines);
return;
}
##############################################################################
my $data = parse_root_anchors('root-anchors.xml');
die 'No DNSKEY records found' if not @{ $data->{dnskey} };
die 'No DS records found' if not @{ $data->{ds} };
write_ds('root.ds', $data->{ds});
write_dnskey('root.key', $data->{dnskey});
|
