File Coverage

blib/lib/Net/DNS/SEC/DSA.pm
Criterion Covered Total %
statement 54 54 100.0
branch 6 6 100.0
condition n/a
subroutine 12 12 100.0
pod 2 2 100.0
total 74 74 100.0


line stmt bran cond sub pod time code
1             package Net::DNS::SEC::DSA;
2              
3 12     12   6738 use strict;
  12         36  
  12         385  
4 12     12   80 use warnings;
  12         33  
  12         758  
5              
6             our $VERSION = (qw$Id: DSA.pm 1863 2022-03-14 14:59:21Z willem $)[2];
7              
8              
9             =head1 NAME
10              
11             Net::DNS::SEC::DSA - DNSSEC DSA digital signature algorithm
12              
13              
14             =head1 SYNOPSIS
15              
16             require Net::DNS::SEC::DSA;
17              
18             $signature = Net::DNS::SEC::DSA->sign( $sigdata, $private );
19              
20             $validated = Net::DNS::SEC::DSA->verify( $sigdata, $keyrr, $sigbin );
21              
22              
23             =head1 DESCRIPTION
24              
25             Implementation of DSA digital signature
26             generation and verification procedures.
27              
28             =head2 sign
29              
30             $signature = Net::DNS::SEC::DSA->sign( $sigdata, $private );
31              
32             Generates the wire-format signature from the sigdata octet string
33             and the appropriate private key object.
34              
35             =head2 verify
36              
37             $validated = Net::DNS::SEC::DSA->verify( $sigdata, $keyrr, $sigbin );
38              
39             Verifies the signature over the sigdata octet string using the specified
40             public key resource record.
41              
42             =cut
43              
44 12     12   77 use integer;
  12         24  
  12         79  
45 12     12   313 use MIME::Base64;
  12         30  
  12         1112  
46              
47 12     12   111 use constant Digest_SHA1 => Net::DNS::SEC::libcrypto->can('EVP_sha1');
  12         25  
  12         978  
48 12     12   131 use constant DSA_configured => Digest_SHA1 && Net::DNS::SEC::libcrypto->can('EVP_PKEY_new_DSA');
  12         28  
  12         1265  
49              
50 12     12   8270 BEGIN { die 'DSA disabled or application has no "use Net::DNS::SEC"' unless DSA_configured }
51              
52              
53             my %parameters = (
54             3 => scalar eval { Net::DNS::SEC::libcrypto::EVP_sha1() },
55             6 => scalar eval { Net::DNS::SEC::libcrypto::EVP_sha1() },
56             );
57              
58 12     12   173 sub _index { return keys %parameters }
59              
60              
61             sub sign {
62 2     2 1 12017 my ( $class, $sigdata, $private ) = @_;
63              
64 2         9 my $evpmd = $parameters{$private->algorithm};
65 2 100       21 die 'private key not DSA' unless $evpmd;
66              
67             my ( $p, $q, $g, $x, $y ) =
68 1         3 map { decode_base64( $private->$_ ) } qw(prime subprime base private_value public_value);
  5         29  
69 1         4 my $t = ( length($g) - 64 ) / 8;
70              
71 1         64 my $evpkey = Net::DNS::SEC::libcrypto::EVP_PKEY_new_DSA( $p, $q, $g, $y, $x );
72              
73 1         457 my $asn1 = Net::DNS::SEC::libcrypto::EVP_sign( $sigdata, $evpkey, $evpmd );
74 1         6 return _ASN1decode( $asn1, $t );
75             }
76              
77              
78             sub verify {
79 4     4 1 1140 my ( $class, $sigdata, $keyrr, $sigbin ) = @_;
80              
81 4         13 my $evpmd = $parameters{$keyrr->algorithm};
82 4 100       47 die 'public key not DSA' unless $evpmd;
83              
84 3 100       11 return unless $sigbin;
85              
86 2         5 my $key = $keyrr->keybin; # public key
87 2         17 my $len = 64 + 8 * unpack( 'C', $key ); # RFC2536, section 2
88 2         13 my ( $q, $p, $g, $y ) = unpack "x a20 a$len a$len a$len", $key;
89              
90 2         16 my $evpkey = Net::DNS::SEC::libcrypto::EVP_PKEY_new_DSA( $p, $q, $g, $y, '' );
91              
92 2         6 my $asn1 = _ASN1encode($sigbin);
93 2         502 return Net::DNS::SEC::libcrypto::EVP_verify( $sigdata, $asn1, $evpkey, $evpmd );
94             }
95              
96              
97             ########################################
98              
99             sub _ASN1encode {
100 2     2   6 my @part = unpack 'x a20 a20', shift; # discard "t"
101 2         4 my $length;
102 2         3 foreach (@part) {
103 4         9 s/^[\000]+//;
104 4         9 s/^$/\000/;
105 4         12 s/^(?=[\200-\377])/\000/;
106 4         13 $_ = pack 'C2 a*', 2, length, $_;
107 4         8 $length += length;
108             }
109 2         7 return pack 'C2 a* a*', 0x30, $length, @part;
110             }
111              
112             sub _ASN1decode {
113 1     1   3 my ( $asn1, $t ) = @_;
114 1         3 my $n = unpack 'x3 C', $asn1;
115 1         5 my $m = unpack "x5 x$n C", $asn1;
116 1         7 my @part = unpack "x4 a$n x2 a$m", $asn1;
117 1         2 return pack 'C a* a*', $t, map { substr( pack( 'x20 a*', $_ ), -20 ) } @part;
  2         19  
118             }
119              
120              
121             1;
122              
123             __END__