File Coverage

lib/Crypt/Perl/ECDSA/KeyBase.pm
Criterion Covered Total %
statement 178 187 95.1
branch 14 20 70.0
condition 7 12 58.3
subroutine 50 51 98.0
pod 0 11 0.0
total 249 281 88.6


line stmt bran cond sub pod time code
1             package Crypt::Perl::ECDSA::KeyBase;
2              
3 7     7   2377 use strict;
  7         12  
  7         141  
4 7     7   24 use warnings;
  7         9  
  7         125  
5              
6 7     7   25 use Try::Tiny;
  7         11  
  7         319  
7              
8 7         45 use parent qw(
9             Crypt::Perl::KeyBase
10 7     7   38 );
  7         12  
11              
12 7     7   854 use Crypt::Format ();
  7         1156  
  7         90  
13              
14 7     7   1316 use Crypt::Perl::ASN1 ();
  7         19  
  7         115  
15 7     7   33 use Crypt::Perl::BigInt ();
  7         11  
  7         83  
16 7     7   300 use Crypt::Perl::Math ();
  7         40  
  7         87  
17 7     7   964 use Crypt::Perl::ECDSA::EC::Curve ();
  7         14  
  7         88  
18 7     7   29 use Crypt::Perl::ECDSA::EC::DB ();
  7         12  
  7         110  
19 7     7   28 use Crypt::Perl::ECDSA::EC::Point ();
  7         12  
  7         71  
20 7     7   1722 use Crypt::Perl::ECDSA::ECParameters ();
  7         15  
  7         107  
21 7     7   1753 use Crypt::Perl::ECDSA::NIST ();
  7         15  
  7         110  
22 7     7   35 use Crypt::Perl::ECDSA::EncodedPoint ();
  7         15  
  7         86  
23 7     7   27 use Crypt::Perl::ECDSA::Utils ();
  7         13  
  7         92  
24 7     7   28 use Crypt::Perl::X ();
  7         12  
  7         119  
25              
26 7         534 use constant ASN1_SIGNATURE => q<
27             SEQUENCE {
28             r INTEGER,
29             s INTEGER
30             }
31 7     7   29 >;
  7         13  
32              
33 7         428 use constant ASN1_Params => Crypt::Perl::ECDSA::ECParameters::ASN1_ECParameters() . q<
34             EcpkParameters ::= CHOICE {
35             namedCurve OBJECT IDENTIFIER,
36             ecParameters ECParameters
37             }
38 7     7   44 >;
  7         14  
39              
40 7     7   41 use constant _JWK_THUMBPRINT_JSON_ORDER => qw( crv kty x y );
  7         10  
  7         383  
41              
42 7     7   37 use constant JWA_DIGEST_prime256v1 => 'sha256';
  7         12  
  7         325  
43 7     7   46 use constant JWA_DIGEST_secp384r1 => 'sha384';
  7         12  
  7         325  
44 7     7   42 use constant JWA_DIGEST_secp521r1 => 'sha512';
  7         13  
  7         358  
45              
46 7     7   40 use constant JWA_CURVE_ALG_prime256v1 => 'ES256';
  7         12  
  7         317  
47 7     7   36 use constant JWA_CURVE_ALG_secp384r1 => 'ES384';
  7         12  
  7         278  
48 7     7   35 use constant JWA_CURVE_ALG_secp521r1 => 'ES512';
  7         16  
  7         11537  
49              
50             #Expects $key_parts to be a hash ref:
51             #
52             # version - AFAICT unused
53             # private - BigInt or its byte-string representation
54             # public - ^^
55             #
56             sub new_by_curve_name {
57 55     55 0 3131 my ($class, $key_parts, $curve_name) = @_;
58              
59             #We could store the curve name on here if looking it up
60             #in to_der_with_curve_name() proves prohibitive.
61 55         310 return $class->new(
62             $key_parts,
63              
64             #“Fake out” the $curve_parts attribute by recreating
65             #the structure that ASN.1 would give from a named curve.
66             {
67             namedCurve => Crypt::Perl::ECDSA::EC::DB::get_oid_for_curve_name($curve_name),
68             },
69             );
70             }
71              
72             #$msg has to be small enough that the key could have signed it.
73             #It’s probably a digest rather than the original message.
74             sub verify {
75 248     248 0 7378654 my ($self, $msg, $sig) = @_;
76              
77 248         1611 my $struct = Crypt::Perl::ASN1->new()->prepare(ASN1_SIGNATURE)->decode($sig);
78              
79 248         3049399 return $self->_verify($msg, @{$struct}{ qw( r s ) });
  248         1803  
80             }
81              
82             #cf. RFC 7518, page 8
83             sub verify_jwa {
84 3     3 0 2052 my ($self, $msg, $sig) = @_;
85              
86 3         12 my $dgst_cr = $self->_get_jwk_digest_cr();
87              
88 3         12 my $half_len = (length $sig) / 2;
89              
90 3         8 my $r = substr($sig, 0, $half_len);
91 3         8 my $s = substr($sig, $half_len);
92              
93 3         23 $_ = Crypt::Perl::BigInt->from_bytes($_) for ($r, $s);
94              
95 3         3807 return $self->_verify($dgst_cr->($msg), $r, $s);
96             }
97              
98             sub to_der_with_curve_name {
99 28     28 0 748 my ($self, %params) = @_;
100              
101 28 50       213 if ($params{'seed'}) {
102 0         0 die Crypt::Perl::X::create('Generic', '“seed” is meaningless to a named-curve export.');
103             }
104              
105 28         227 return $self->_get_asn1_parts($self->_named_curve_parameters(), %params);
106             }
107              
108             sub to_der_with_explicit_curve {
109 246     246 0 100291 my ($self, @params) = @_;
110              
111 246         1954 return $self->_get_asn1_parts($self->_explicit_curve_parameters(@params), @params);
112             }
113              
114             sub to_pem_with_curve_name {
115 12     12 0 51168 my ($self, @params) = @_;
116              
117 12         189 my $der = $self->to_der_with_curve_name(@params);
118              
119 12         4162 return Crypt::Format::der2pem($der, $self->_PEM_HEADER());
120             }
121              
122             sub to_pem_with_explicit_curve {
123 236     236 0 53448 my ($self, @params) = @_;
124              
125 236         2631 my $der = $self->to_der_with_explicit_curve(@params);
126              
127 236         7500200 return Crypt::Format::der2pem($der, $self->_PEM_HEADER());
128             }
129              
130             sub max_sign_bits {
131 297     297 0 992 my ($self) = @_;
132              
133 297         1892 return $self->_get_curve_obj()->keylen();
134             }
135              
136             sub get_curve_name {
137 39     39 0 90 my ($self) = @_;
138              
139 39         186 return Crypt::Perl::ECDSA::EC::DB::get_curve_name_by_data( $self->_curve() );
140             }
141              
142             sub get_struct_for_public_jwk {
143 5     5 0 37 my ($self) = @_;
144              
145 5         24 my ($xb, $yb) = Crypt::Perl::ECDSA::Utils::split_G_or_public( $self->_decompress_public_point() );
146              
147 5         40 require MIME::Base64;
148              
149             return {
150 5         27 kty => 'EC',
151             crv => $self->_get_jwk_curve_name(),
152             x => MIME::Base64::encode_base64url($xb),
153             y => MIME::Base64::encode_base64url($yb),
154             }
155             }
156              
157             sub get_jwa_alg {
158 0     0 0 0 my ($self) = @_;
159              
160 0         0 my $name = $self->get_curve_name();
161              
162 0 0       0 my $getter_cr = __PACKAGE__->can("JWA_CURVE_ALG_$name") or do {
163 0         0 my $err = sprintf( "“%s” knows of no JWA “alg” for the curve “%s”!", ref($self), $name);
164              
165 0         0 die Crypt::Perl::X::create('Generic', $err);
166             };
167              
168 0         0 return $getter_cr->();
169             }
170              
171             #----------------------------------------------------------------------
172              
173             sub _set_public {
174 573     573   1869 my ($self, $pub_in) = @_;
175              
176 573         8401 $self->{'_public'} = Crypt::Perl::ECDSA::EncodedPoint->new($pub_in);
177              
178 573         1852 return;
179             }
180              
181             sub _compress_public_point {
182 7     7   18 my ($self) = @_;
183              
184 7         39 return $self->{'_public'}->get_compressed();
185             }
186              
187             sub _decompress_public_point {
188 536     536   1596 my ($self) = @_;
189              
190 536         2402 return $self->{'_public'}->get_uncompressed( $self->_curve() );
191             }
192              
193             sub _get_jwk_digest_cr {
194 6     6   16 my ($self) = @_;
195              
196 6         23 my $name = $self->get_curve_name();
197              
198 6 50       66 my $getter_cr = $self->can("JWA_DIGEST_$name") or do {
199 0         0 my $err = sprintf( "“%s” knows of no digest to use for JWA with the curve “%s”!", ref($self), $name);
200 0         0 die Crypt::Perl::X::create('Generic', $err);
201             };
202              
203 6         32 require Digest::SHA;
204              
205 6         63 return Digest::SHA->can( $getter_cr->() );
206             }
207              
208             sub _get_jwk_curve_name {
209 5     5   12 my ($self) = @_;
210              
211 5         19 my $name = $self->get_curve_name();
212              
213 5         29 return Crypt::Perl::ECDSA::NIST::get_nist_for_curve_name($name);
214             }
215              
216             sub _verify {
217 251     251   1000 my ($self, $msg, $r, $s) = @_;
218              
219 251 50 33     1893 if ($r->is_positive() && $s->is_positive()) {
220 251         13145 my ($x, $y) = Crypt::Perl::ECDSA::Utils::split_G_or_public( $self->_decompress_public_point() );
221 251         2260 $_ = Crypt::Perl::BigInt->from_bytes($_) for ($x, $y);
222              
223 251         191096 my $curve = $self->_get_curve_obj();
224              
225 251         1602 my $Q = Crypt::Perl::ECDSA::EC::Point->new(
226             $curve,
227             $curve->from_bigint($x),
228             $curve->from_bigint($y),
229             );
230              
231 251         1007 my $e = Crypt::Perl::BigInt->from_bytes($msg);
232              
233             #----------------------------------------------------------------------
234              
235 251         96835 my $n = $self->_curve()->{'n'};
236              
237 251 50 33     1084 if ($r->blt($n) && $s->blt($n)) {
238 251         17629 my $c = $s->copy()->bmodinv($n);
239              
240 251         5222923 my $u1 = $e->copy()->bmul($c)->bmod($n);
241 251         156068 my $u2 = $r->copy()->bmul($c)->bmod($n);
242              
243 251         201924 my $point = $self->_G()->multiply($u1)->add( $Q->multiply($u2) );
244              
245 251         4725 my $v = $point->get_x()->to_bigint()->copy()->bmod($n);
246              
247 251 100       27798 return 1 if $v->beq($r);
248             }
249             }
250              
251 8         834 return 0;
252             }
253              
254             #return isa EC::Point
255             sub _G {
256 496     496   1499 my ($self) = @_;
257 496         1871 return $self->_get_curve_obj()->decode_point( @{$self->_curve()}{ qw( gx gy ) } );
  496         1470  
258             }
259              
260             sub _pad_bytes_for_asn1 {
261 518     518   1127 my ($self, $bytes) = @_;
262              
263 518         1208 return Crypt::Perl::ECDSA::Utils::pad_bytes_for_asn1( $bytes, $self->_curve()->{'p'} );
264             }
265              
266             sub _named_curve_parameters {
267 28     28   74 my ($self) = @_;
268              
269 28         130 my $curve_name = $self->get_curve_name();
270              
271             return {
272 28         139 namedCurve => Crypt::Perl::ECDSA::EC::DB::get_oid_for_curve_name($curve_name),
273             };
274             }
275              
276             #The idea is to emulate what Convert::ASN1 gives us as the parse.
277             sub _explicit_curve_parameters {
278 259     259   943 my ($self, %params) = @_;
279              
280 259         1244 my $curve_hr = $self->_curve();
281              
282 259         698 my ($gx, $gy) = map { $_->as_bytes() } @{$curve_hr}{'gx', 'gy'};
  518         2029  
  259         858  
283              
284 259         1992 for my $str ( $gx, $gy ) {
285 518         1954 $str = $self->_pad_bytes_for_asn1($str);
286             }
287              
288             my %curve = (
289             a => $curve_hr->{'a'}->as_bytes(),
290 259         1084 b => $curve_hr->{'b'}->as_bytes(),
291             );
292              
293 259 100 100     1033 if ($params{'seed'} && $curve_hr->{'seed'}) {
294              
295             #We don’t care about the bit count. (Right?)
296 13         644 $curve{'seed'} = $curve_hr->{'seed'}->as_bytes();
297             }
298              
299 259         1723 my $base = "\x{04}$gx$gy";
300 259 100       874 if ( $params{'compressed'} ) {
301 4         18 $base = Crypt::Perl::ECDSA::Utils::compress_point($base);
302             }
303              
304             return {
305             ecParameters => {
306             version => 1,
307             fieldID => {
308             fieldType => Crypt::Perl::ECDSA::ECParameters::OID_prime_field(),
309             parameters => {
310             'prime-field' => $curve_hr->{'p'},
311             },
312             },
313             curve => \%curve,
314             base => $base,
315             order => $curve_hr->{'n'},
316 259         5539 cofactor => $curve_hr->{'h'},
317             },
318             };
319             }
320              
321             sub __to_der {
322 274     274   2071 my ($self, $macro, $template, $data_hr, %params) = @_;
323              
324 274 100       1986 my $pub_bin = $params{'compressed'} ? $self->_compress_public_point() : $self->_decompress_public_point();
325              
326 274         897 local $data_hr->{'publicKey'} = $pub_bin;
327              
328 274         2716 require Crypt::Perl::ASN1;
329 274         1982 my $asn1 = Crypt::Perl::ASN1->new()->prepare($template);
330              
331 274         1797 return $asn1->find($macro)->encode( $data_hr );
332             }
333              
334             #return isa EC::Curve
335             sub _get_curve_obj {
336 1044     1044   2430 my ($self) = @_;
337              
338 1044   66     5951 return $self->{'_curve_obj'} ||= Crypt::Perl::ECDSA::EC::Curve->new( @{$self->_curve()}{ qw( p a b ) } );
  296         872  
339             }
340              
341             sub _add_params {
342 573     573   1555 my ($self, $params_struct) = @_;
343              
344 573 100       2855 if (my $params = $params_struct->{'ecParameters'}) {
345              
346             #Convert::ASN1 returns bit strings as an array of [ $content, $length ].
347             #Since normalize() wants that, we local() it here.
348             #local $params->{'curve'}{'seed'} = [$params->{'curve'}{'seed'}] if $params->{'curve'} && $params->{'curve'}{'seed'};
349              
350 258         2029 $self->{'curve'} = Crypt::Perl::ECDSA::ECParameters::normalize($params);
351             }
352             else {
353 315         1449 $self->{'curve'} = $self->_curve_params_for_OID($params_struct->{'namedCurve'});
354             }
355              
356 333         5628 return $self;
357             }
358              
359             sub _curve_params_for_OID {
360 315     315   845 my ($self, $oid) = @_;
361              
362 315         2705 return Crypt::Perl::ECDSA::EC::DB::get_curve_data_by_oid($oid);
363             }
364              
365             sub _curve {
366 2682     2682   4845 my ($self) = @_;
367              
368 2682         19733 return $self->{'curve'};
369             }
370              
371             #----------------------------------------------------------------------
372              
373             1;