File: SEC.pm

package info (click to toggle)
libnet-dns-sec-perl 0.16-2
  • links: PTS, VCS
  • area: main
  • in suites: wheezy
  • size: 460 kB
  • sloc: perl: 4,427; makefile: 4
file content (344 lines) | stat: -rw-r--r-- 8,574 bytes parent folder | download | duplicates (2)
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
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
#
# $Id: SEC.pm 850 2010-03-12 13:14:33Z olaf $
#

use strict;



package Net::DNS::SEC;
use Net::DNS;
use bytes;
use Carp;
use strict;
use Exporter;
use vars qw($SVNVERSION $VERSION $HAS_NSEC3 $HAS_DLV @EXPORT_OK @ISA);
@ISA=qw(Exporter);
$VERSION = '0.16';

$HAS_DLV=1;     # Signals availability of DLV to Net::DNS::RR
$HAS_NSEC3=1;   # Signals availability of NSEC3 to Net::DNS::RR


$SVNVERSION = (qw$LastChangedRevision: 850 $)[1];


@EXPORT_OK= qw (
              key_difference
              verify_selfsig
               );


=head1 NAME

Net::DNS::SEC - DNSSEC extensions to Net::DNS

=head1 SYNOPSIS

C<use Net::DNS;>

The Net::DNS::SEC module implements a few class methods used by the
other modules in this suite and a few functions that can be exported.


=head1 DESCRIPTION

The Net::DSN::SEC suite provides the resource records that are needed
for DNSSEC (RFC 4033, 4034 and 4035). In addition the DLV RR, a clone
of the DS RR is supported (RFC 4431)

It also provides support for SIG0. That later is useful for dynamic
updates using key-pairs.

RSA and DSA crypto routines are supported.

For details see L<Net::DNS::RR::RRSIG>, L<Net::DNS::RR::DNSKEY>,
L<Net::DNS::RR::NSEC>, L<Net::DNS::RR:DS>, L<Net::DNS::RR::DLV>, and
see L<Net::DNS::RR::SIG> and L<Net::DNS::RR::KEY> for the use with
SIG0.

Net::DNS contains all needed hooks to load the Net::DNS::SEC
extensions when they are available.

See L<Net::DNS> for general help.

=head1 Utility function

Use the following construct if you want to use thos function in your code.

   use Net::DNS::SEC qw( key_difference );


=head2 key_difference

    $result=key_differnece(\@a,\@b,\@result);


Fills @result with all keys in the array "@a" that are not in the
array "@b".

Returns 0 on success or an error message on failure.


=cut



sub key_difference {
    my $a=shift;
    my $b=shift;
    my $r=shift;

    my %b_index;
    foreach my $b_key (@$b){
	return "Second array contains something different than a ".
	    "Net::DNS::RR::DNSKEY objects (".ref($b_key).")" if
	    ref($b_key) ne "Net::DNS::RR::DNSKEY";
	    
	$b_index{$b_key->name."+".$b_key->algorithm."+".$b_key->keytag}++;
    }
    foreach my $a_key (@$a){
	return "First array contains something different than a ".
	    "Net::DNS::RR::DNSKEY objects (".ref($a_key).")" if
	    ref($a_key) ne "Net::DNS::RR::DNSKEY";

	push @$r,$a_key  unless 
	    defined ($b_index{$a_key->name."+".$a_key->algorithm."+".$a_key->keytag});
    }
    return (0);
}


=head1 Class methods

These functions are inherited by relevant Net::DNS::RR classes. They
are not exported.

=head2 algorithm

    $value=Net::DNS::SEC->algorithm("RSASHA1");
    $value=$self->algorithm("RSASHA1");
    $value=$self->algorithm(5);

    $algorithm=$self->algorithm();
    $memonic=$self->algorithm("mnemonic");


The algorithm method is used to set or read the value of the algorithm
field in Net::DNS::RR::DNSKEY and Net::DNS::RR::RRSIG.

If supplied with an argument it will set the algorithm accordingly, except
when the argument equals the string "mnemonic" the method will return the
mnemonic of the algorithm.

Can also be called as a class method to do Mnemonic to Value conversion.

=head2 digtype

    $value=$self->digtype("SHA1");
    $value=$self->digtype(1);

    $algorithm=$self->digtype();
    $memonic=$self->digtype("mnemonic");


The algorithm method is used to set or read the value of the digest or
hash algorithm field in Net::DNS::RR::DS and Net::DNS::RR::NSEC3
objects.

If supplied with an argument it will set the digetstype/hash algorithm
accordingly, except when the argument equals the string "mnemonic" the
method will return the mnemonic of the digetstype/hash algorithm.

Can also be called as a class method to do Mnemonic to Value
conversion, note however that it will then use the "Delegation Signer
(DS) Resource Record (RR) Type Digest Algorithms" and not the "DNSSEC
NSEC3 Hash Algorithms" IANA registry. If you want to specifically get
access to the NSEC3  digest types then use a construct like:

 bless $self, Net::DNS::RR::NSEC3;
 $self->digtype("SHA1");




=head1 COPYRIGHT

Copyright (c) 2001-2005  RIPE NCC.  Author Olaf M. Kolkman <olaf@net-dns.org>

All Rights Reserved

Permission to use, copy, modify, and distribute this software and its
documentation for any purpose and without fee is hereby granted,
provided that the above copyright notice appear in all copies and that
both that copyright notice and this permission notice appear in
supporting documentation, and that the name of the author not be
used in advertising or publicity pertaining to distribution of the
software without specific, written prior permission.


THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS; IN NO EVENT SHALL
AUTHOR BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY
DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN
AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.


 
=head1 SEE ALSO

L<http://www.net-dns.org/> 


L<perl(1)>, L<Net::DNS>, L<Net::DNS::RR::KEY>, L<Net::DNS::RR::SIG>,
L<Net::DNS::RR::DNSKEY>, L<Net::DNS::RR::RRSIG>,
L<Net::DNS::RR::NSEC>, L<Net::DNS::RR::DS>, L<Net::DNS::SEC::Private>.

RFC4033, 4034 and 4035.

=cut






 sub algorithm {
    my $self=shift;
    my $argument=shift;

   # classmethod is true if called as class method.
    my $classmethod=0;
    $classmethod=1 unless  ref ($self);
 
    my %algbyname = (
	"RSAMD5"              => 1,
	"DH"                  => 2,           # Not implemented
	"DSA"                 => 3,
	"ECC"                 => 4,           # Not implemented
	"RSASHA1"             => 5,
	"DSA-NSEC3-SHA1"      => 6,
	"RSA-NSEC3-SHA1"      => 7,
	"RSASHA256"           => 8,
	"RSASHA512"           => 10,
	"INDIRECT"            => 252,         # Not implemented
	"PRIVATEDNS"          => 253,         # Not implemented
	"PRIVATEOID"          => 254,         # Not implemented
	);      
    my %algbyval = reverse %algbyname;

    # If the argument is undefined...
    
    if (!defined $argument){
	return if $classmethod;
	return $self->{"algorithm"};
    }

    # Argument has some value...
    $argument =~ s/\s//g; # Remove strings to be kind
    $argument =~ s!RSA/!RSA!;  # Be kind for those who use RSA/SHA1
    if ($argument =~ /^\d+$/ ){    #Numeric argument.

	if ($classmethod){
	    return $argument ;
	}else{
	    return $self->{"algorithm"}=$argument ;
	}
    }else{  # argument is not numeric
	if ($classmethod){
	    # This will return undefined if the argument does not exist
	    return $algbyname{uc($argument)};
	    
	}else{ # Not a class method..
	    if (lc($argument) eq "mnemonic"){
		return $algbyval{$self->{"algorithm"}};
	    }else{
		# This will return undefined if the argument does not exist
		return $self->{"algorithm"}=$algbyname{uc($argument)};
	    }	    
	}

	
    }	
    die "algorithm method should never end here";

	
}







sub digtype {
    _digtype(@_);
}

sub _digtype {
    my $self=shift;
    my $argument=shift;
    # classmethod is true if called as class method.
    my $classmethod=0;
    $classmethod=1 unless  ref ($self);

    my %digestbyname= (
			"SHA1"		   => 1,		
			"SHA256"	   => 2,		
			);      

    
    if (! $classmethod && defined ($self->{'digestbyname'}) ){
	%digestbyname= %{$self->{"digestbyname"}};
    }


    my %digestbyval = reverse %digestbyname;
    
    # If the argument is undefined...
    
    if (!defined $argument){
	return if $classmethod;
	return $self->{"digest"};
    }

    # Argument has some value...
    $argument =~ s/\s//g; # Remove strings to be kind

    if ($argument =~ /^\d+$/ ){    #Numeric argument.
	carp "$argument does not map to a valid digest" unless 
	    exists $digestbyval{$argument};
	if ($classmethod){
	    return $argument ;
	}else{
	    return $self->{"digest"}=$argument ;
	}
    }else{  # argument is not numeric
	if ($classmethod){
	    carp "$argument does not map to a valid digest" unless
		exists $digestbyname{uc($argument)};
	    return $digestbyname{uc($argument)};
	    
	}else{ # Not a class method..
	    if (lc($argument) eq "mnemonic"){
		return $digestbyval{$self->{"digest"}};
	    }else{
		carp "$argument does not map to a valid digest" unless
		    exists $digestbyname{uc($argument)};
		return $self->{"digest"}=$digestbyname{uc($argument)};
	    }	    
	}

	
    }	
    die "digest method should never end here";

	
}