File Coverage

blib/lib/Net/DNS/SEC/Keyset.pm
Criterion Covered Total %
statement 112 112 100.0
branch 28 28 100.0
condition 7 7 100.0
subroutine 19 19 100.0
pod 9 9 100.0
total 175 175 100.0


line stmt bran cond sub pod time code
1             package Net::DNS::SEC::Keyset;
2              
3 1     1   2530 use strict;
  1         3  
  1         33  
4 1     1   5 use warnings;
  1         3  
  1         50  
5              
6             our $VERSION = (qw$Id: Keyset.pm 1868 2022-08-31 20:13:35Z willem $)[2];
7              
8              
9             =head1 NAME
10              
11             Net::DNS::SEC::Keyset - DNSSEC Keyset object class
12              
13              
14             =head1 SYNOPSIS
15              
16             use Net::DNS::SEC::Keyset;
17              
18              
19             =head1 DESCRIPTION
20              
21             A keyset is an "administrative" unit used for DNSSEC maintenance.
22              
23             This class provides interfaces for creating, reading and writing keysets.
24              
25             Object methods are provided to extract DNSKEY, RRSIG and DS records.
26              
27             Note that this class is still being developed.
28             Attributes and methods are subject to change.
29              
30             =cut
31              
32              
33 1     1   6 use Carp;
  1         1  
  1         50  
34 1     1   6 use File::Spec;
  1         2  
  1         19  
35 1     1   20 use IO::File;
  1         3  
  1         153  
36              
37 1     1   556 use Net::DNS::ZoneFile;
  1         4363  
  1         1353  
38              
39             our $keyset_err;
40              
41              
42             sub new {
43 9     9 1 3583 my ( $class, $arg1, $arg2 ) = @_;
44              
45 9         21 my $ref1 = ref($arg1);
46 9 100       31 return &_new_from_file unless $ref1;
47              
48 6 100       34 return &_new_from_packet if $ref1 eq 'Net::DNS::Packet';
49              
50 5 100       22 return &_new_from_keys unless ref($arg2);
51              
52 3         8 return &_new_from_keys_sigs;
53             }
54              
55              
56             =head2 new (from file)
57              
58             $keyset = Net::DNS::SEC::Keyset->new( $filename );
59             $keyset = Net::DNS::SEC::Keyset->new( $filename, $directory );
60             die Net::DNS::SEC::Keyset->keyset_err unless $keyset;
61              
62             Constructor method which reads the specified keyset file and returns a
63             keyset object.
64              
65             The optional second argument specifies the filename base directory.
66              
67             Sets keyset_err and returns undef on failure.
68              
69             =cut
70              
71             sub _new_from_file {
72 3     3   8 my ( $class, $name, @path ) = @_;
73              
74 3         25 my $file = File::Spec->catfile( @path, $name );
75              
76 3         20 my @rr = Net::DNS::ZoneFile->new($file)->read;
77              
78 3         14337 return $class->_new_from_keys_sigs( \@rr, \@rr );
79             }
80              
81              
82             =head2 new (by signing keys)
83              
84             $keyset = Net::DNS::SEC::Keyset->new( [@keyrr], $privatekeypath );
85             die Net::DNS::SEC::Keyset->keyset_err unless $keyset;
86              
87             Creates a keyset object from the keys provided through the reference to an
88             array of Net::DNS::RR::DNSKEY objects.
89              
90             The method will create and self-sign the whole keyset. The private keys as
91             generated by the BIND dnssec-keygen tool are assumed to be in the current
92             directory or, if specified, the directory indicated by $privatekeypath.
93              
94             Sets keyset_err and returns undef on failure.
95              
96             =cut
97              
98             sub _new_from_keys {
99 2     2   6 my ( $class, $keylist, @keypath ) = @_;
100              
101 2         4 my @sigrr;
102 2         5 foreach my $key ( grep { $_->type eq 'DNSKEY' } @$keylist ) {
  3         24  
103 3         35 my $keyname = $key->privatekeyname;
104 3         303 my $keyfile = File::Spec->catfile( @keypath, $keyname );
105 3         15 my @rrsig = Net::DNS::RR::RRSIG->create( $keylist, $keyfile );
106 3         12 push @sigrr, grep {defined} @rrsig;
  3         17  
107             }
108              
109 2         20 return $class->_new_from_keys_sigs( $keylist, \@sigrr );
110             }
111              
112              
113             =head2 new (from key and sig RRsets)
114              
115             $keyset = Net::DNS::Keyset->new( [@keyrr], [@sigrr] );
116             die Net::DNS::SEC::Keyset->keyset_err unless $keyset;
117              
118             Creates a keyset object from the keys provided through the references
119             to arrays of Net::DNS::RR::DNSKEY and Net::DNS::RR::RRSIG objects.
120              
121             Sets keyset_err and returns undef on failure.
122              
123             =cut
124              
125             sub _new_from_keys_sigs {
126 9     9   24 my ( $class, $key_ref, $sig_ref ) = @_;
127              
128 9         19 my @keyrr = grep { $_->type eq 'DNSKEY' } @$key_ref;
  24         194  
129 9         100 my @sigrr = grep { $_->type eq 'RRSIG' } @$sig_ref;
  23         155  
130              
131 9         112 my $keyset = bless {keys => \@keyrr, sigs => \@sigrr}, $class;
132              
133 9 100       26 return scalar( $keyset->verify ) ? $keyset : undef;
134             }
135              
136              
137             =head2 new (from Packet)
138              
139             $resolver = Net::DNS::Resolver->new;
140             $resolver->dnssec(1);
141            
142             $reply = $res->send ( "example.com", "DNSKEY" );
143              
144             $keyset = Net::DNS::SEC::Keyset->new( $reply );
145             die Net::DNS::SEC::Keyset->keyset_err unless $keyset;
146              
147             Creates a keyset object from a Net::DNS::Packet that contains the answer
148             to a query for key records at the zone apex.
149              
150             This is the method you should use for automatically fetching keys.
151              
152             Sets keyset_err and returns undef on failure.
153              
154             =cut
155              
156             sub _new_from_packet {
157 1     1   4 my ( $class, $packet ) = @_;
158 1         11 my @rrset = $packet->answer;
159 1         14 return $class->_new_from_keys_sigs( \@rrset, \@rrset );
160             }
161              
162              
163             =head2 keys
164              
165             @keyrr = $keyset->keys;
166              
167             Returns an array of Net::DNS::RR::DNSKEY objects.
168              
169             =cut
170              
171             sub keys {
172 24     24 1 916 my $self = shift;
173 24         33 my @keys = @{$self->{keys}};
  24         60  
174 24         61 return @keys;
175             }
176              
177              
178             =head2 sigs
179              
180             @sigrr = $keyset->sigs;
181              
182             Returns an array of Net::DNS::RR::RRSIG objects.
183              
184             =cut
185              
186             sub sigs {
187 23     23 1 367 my $self = shift;
188 23         29 my @sigs = @{$self->{sigs}};
  23         45  
189 23         50 return @sigs;
190             }
191              
192              
193             =head2 extract_ds
194              
195             @ds = $keyset->extract_ds(); # default SHA-1
196             @ds = $keyset->extract_ds( digtype => 'SHA-256' );
197             die Net::DNS::SEC::Keyset->keyset_err unless @ds;
198              
199             Extracts DS records from the keyset. Note that the keyset will be verified
200             during extraction. All keys will need to have a valid self-signature.
201              
202             The method sets keyset_err if verification fails.
203              
204             =cut
205              
206             sub extract_ds {
207 2     2 1 594 my ( $self, @arg ) = @_;
208 2         21 my @ds;
209 2 100       7 @ds = map { Net::DNS::RR::DS->create( $_, @arg ) } $self->keys if $self->verify;
  2         434  
210 2         316 return @ds;
211             }
212              
213              
214             =head2 verify
215              
216             @keytags = $keyset->verify();
217             die Net::DNS::SEC::Keyset->keyset_err unless @keytags;
218              
219             $keyset->verify( $keytag ) || die $keyset->keyset_err;
220              
221             If no arguments are given:
222              
223             =over 2
224              
225             =item
226              
227             Verifies if all signatures present verify the keyset.
228              
229             =item
230              
231             Verifies if there are DNSKEYs with the SEP flag set, there is at
232             least one RRSIG made using that key.
233              
234             =item
235              
236             Verifies that if there are no DNSKEYs with the SEP flag set there
237             is at least one RRSIG made with one of the keys from the keyset.
238              
239             =back
240              
241             If an argument is given, it is should be the numeric keytag of the key
242             in the keyset which will be verified using the corresponding RRSIG.
243              
244             The method returns a list of keytags of verified keys in the keyset.
245              
246             The method sets keyset_err and returns empty list if verification fails.
247              
248             =cut
249              
250             sub verify {
251 16     16 1 1245 my ( $self, $keyid ) = @_;
252              
253 16         38 my @keys = $self->keys;
254              
255 16         25 my %keysbytag;
256 16         31 push( @{$keysbytag{$_->keytag}}, $_ ) foreach @keys;
  29         803  
257              
258 16         781 my @sigs = $self->sigs;
259              
260 16         28 my @keyset_err;
261 16         25 my %names = map { ( $_->name => $_ ) } @keys, @sigs;
  56         583  
262 16         208 my @names = CORE::keys %names;
263 16 100       46 push @keyset_err, "Multiple names in keyset: @names" if scalar(@names) > 1;
264              
265              
266 16 100       39 if ($keyid) {
    100          
267 2         4 @sigs = grep { $_->keytag == $keyid } @sigs;
  4         22  
268 2 100       19 push @keyset_err, "No signature made with key $keyid" unless @sigs;
269 25         182 } elsif ( my @sepkeys = grep { $_->sep } @keys ) {
270 12         103 my %sepkey = map { ( $_->keytag => $_ ) } @sepkeys;
  12         25  
271             push @keyset_err, 'No signature found for key with SEP flag'
272 12 100       589 unless grep { $sepkey{$_->keytag} } @sigs;
  21         103  
273             }
274              
275 16         130 foreach my $sig (@sigs) {
276 24         309 my $keytag = $sig->keytag;
277 24 100 100     208 next if $sig->verify( \@keys, $keysbytag{$keytag} || [] );
278 3         181 my $vrfyerr = $sig->vrfyerrstr;
279 3         25 push @keyset_err, "$vrfyerr for keyset @names";
280             }
281              
282 16         442 $keyset_err = join "\n", @keyset_err;
283              
284 16         27 my @tags_verified;
285 16 100       38 @tags_verified = map { $_->keytag } @sigs unless $keyset_err;
  20         88  
286 16         212 return @tags_verified;
287             }
288              
289              
290             =head2 keyset_err
291            
292             $keyset_err = Net::DNS::SEC::Keyset->keyset_err;
293              
294             Returns the keyset error string.
295              
296             =cut
297              
298             sub keyset_err {
299 4     4 1 639 return $keyset_err;
300             }
301              
302              
303             =head2 string
304            
305             $string = $keyset->string;
306              
307             Returns a string representation of the keyset.
308              
309             =cut
310              
311             sub string {
312 1     1 1 820 my $self = shift;
313 1         4 return join "\n", map { $_->string } ( $self->keys, $self->sigs );
  4         1020  
314             }
315              
316              
317             =head2 print
318              
319             $keyset->print; # similar to print( $keyset->string )
320              
321             Prints the keyset.
322              
323             =cut
324              
325             sub print {
326 2     2 1 5 my $self = shift;
327 2         6 foreach ( $self->keys, $self->sigs ) { $_->print }
  8         2100  
328 2         572 return;
329             }
330              
331              
332             =head2 writekeyset
333              
334             $keyset->writekeyset;
335             $keyset->writekeyset( $path );
336             $keyset->writekeyset( $prefix );
337             $keyset->writekeyset( $prefix, $path );
338              
339             Writes the keyset to a file named "keyset-." in the current
340             working directory or directory defined by the optional $path argument.
341              
342             The optional $prefix argument specifies the prefix that will be
343             prepended to the domain name to form the keyset filename.
344              
345             =cut
346              
347             sub writekeyset {
348 3     3 1 717 my ( $self, $arg1, @path ) = @_;
349 3         5 shift;
350 3 100 100     39 @path = shift() if $arg1 && File::Spec->file_name_is_absolute($arg1);
351 3   100     14 my $prefix = shift || 'keyset-';
352              
353 3         10 my @keysetrr = ( $self->keys, $self->sigs );
354 3         21 my $domainname = $keysetrr[0]->name;
355 3         45 my $keysetname = "$prefix$domainname.";
356 3         26 my $filename = File::Spec->catfile( @path, $keysetname );
357 3         22 $filename =~ s/[.]+/\./; ## avoid antisocial consequences of $path with ..
358 3 100       19 my $handle = IO::File->new( $filename, '>' ) or croak qq("$filename": $!);
359 2         318 select( ( select($handle), $self->print )[0] );
360 2         108 close($handle);
361 2         19 return $filename;
362             }
363              
364              
365             1;
366              
367             __END__