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   2855 use strict;
  7         16  
  7         168  
4 7     7   29 use warnings;
  7         9  
  7         140  
5              
6 7     7   31 use Try::Tiny;
  7         9  
  7         665  
7              
8 7         53 use parent qw(
9             Crypt::Perl::KeyBase
10 7     7   35 );
  7         13  
11              
12 7     7   1071 use Crypt::Format ();
  7         927  
  7         95  
13              
14 7     7   1374 use Crypt::Perl::ASN1 ();
  7         16  
  7         103  
15 7     7   33 use Crypt::Perl::BigInt ();
  7         15  
  7         79  
16 7     7   330 use Crypt::Perl::Math ();
  7         47  
  7         84  
17 7     7   1144 use Crypt::Perl::ECDSA::EC::Curve ();
  7         14  
  7         96  
18 7     7   33 use Crypt::Perl::ECDSA::EC::DB ();
  7         11  
  7         78  
19 7     7   28 use Crypt::Perl::ECDSA::EC::Point ();
  7         10  
  7         70  
20 7     7   1638 use Crypt::Perl::ECDSA::ECParameters ();
  7         17  
  7         111  
21 7     7   5342 use Crypt::Perl::ECDSA::NIST ();
  7         12  
  7         114  
22 7     7   36 use Crypt::Perl::ECDSA::EncodedPoint ();
  7         11  
  7         115  
23 7     7   29 use Crypt::Perl::ECDSA::Utils ();
  7         12  
  7         87  
24 7     7   31 use Crypt::Perl::X ();
  7         12  
  7         132  
25              
26 7         476 use constant ASN1_SIGNATURE => q<
27             SEQUENCE {
28             r INTEGER,
29             s INTEGER
30             }
31 7     7   27 >;
  7         8  
32              
33 7         378 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   39 >;
  7         10  
39              
40 7     7   35 use constant _JWK_THUMBPRINT_JSON_ORDER => qw( crv kty x y );
  7         12  
  7         351  
41              
42 7     7   35 use constant JWA_DIGEST_prime256v1 => 'sha256';
  7         9  
  7         319  
43 7     7   34 use constant JWA_DIGEST_secp384r1 => 'sha384';
  7         13  
  7         287  
44 7     7   38 use constant JWA_DIGEST_secp521r1 => 'sha512';
  7         18  
  7         346  
45              
46 7     7   36 use constant JWA_CURVE_ALG_prime256v1 => 'ES256';
  7         25  
  7         288  
47 7     7   33 use constant JWA_CURVE_ALG_secp384r1 => 'ES384';
  7         13  
  7         288  
48 7     7   35 use constant JWA_CURVE_ALG_secp521r1 => 'ES512';
  7         8  
  7         11408  
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 2836 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         367 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 7757138 my ($self, $msg, $sig) = @_;
76              
77 248         1587 my $struct = Crypt::Perl::ASN1->new()->prepare(ASN1_SIGNATURE)->decode($sig);
78              
79 248         3228687 return $self->_verify($msg, @{$struct}{ qw( r s ) });
  248         3267  
80             }
81              
82             #cf. RFC 7518, page 8
83             sub verify_jwa {
84 3     3 0 1624 my ($self, $msg, $sig) = @_;
85              
86 3         16 my $dgst_cr = $self->_get_jwk_digest_cr();
87              
88 3         11 my $half_len = (length $sig) / 2;
89              
90 3         14 my $r = substr($sig, 0, $half_len);
91 3         8 my $s = substr($sig, $half_len);
92              
93 3         26 $_ = Crypt::Perl::BigInt->from_bytes($_) for ($r, $s);
94              
95 3         4204 return $self->_verify($dgst_cr->($msg), $r, $s);
96             }
97              
98             sub to_der_with_curve_name {
99 28     28 0 800 my ($self, %params) = @_;
100              
101 28 50       197 if ($params{'seed'}) {
102 0         0 die Crypt::Perl::X::create('Generic', '“seed” is meaningless to a named-curve export.');
103             }
104              
105 28         222 return $self->_get_asn1_parts($self->_named_curve_parameters(), %params);
106             }
107              
108             sub to_der_with_explicit_curve {
109 246     246 0 101823 my ($self, @params) = @_;
110              
111 246         2796 return $self->_get_asn1_parts($self->_explicit_curve_parameters(@params), @params);
112             }
113              
114             sub to_pem_with_curve_name {
115 12     12 0 49945 my ($self, @params) = @_;
116              
117 12         199 my $der = $self->to_der_with_curve_name(@params);
118              
119 12         4555 return Crypt::Format::der2pem($der, $self->_PEM_HEADER());
120             }
121              
122             sub to_pem_with_explicit_curve {
123 236     236 0 59768 my ($self, @params) = @_;
124              
125 236         2187 my $der = $self->to_der_with_explicit_curve(@params);
126              
127 236         7966664 return Crypt::Format::der2pem($der, $self->_PEM_HEADER());
128             }
129              
130             sub max_sign_bits {
131 297     297 0 1257 my ($self) = @_;
132              
133 297         2304 return $self->_get_curve_obj()->keylen();
134             }
135              
136             sub get_curve_name {
137 39     39 0 144 my ($self) = @_;
138              
139 39         232 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 32 my ($self) = @_;
144              
145 5         19 my ($xb, $yb) = Crypt::Perl::ECDSA::Utils::split_G_or_public( $self->_decompress_public_point() );
146              
147 5         30 require MIME::Base64;
148              
149             return {
150 5         24 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   1993 my ($self, $pub_in) = @_;
175              
176 573         7766 $self->{'_public'} = Crypt::Perl::ECDSA::EncodedPoint->new($pub_in);
177              
178 573         1584 return;
179             }
180              
181             sub _compress_public_point {
182 7     7   19 my ($self) = @_;
183              
184 7         37 return $self->{'_public'}->get_compressed();
185             }
186              
187             sub _decompress_public_point {
188 536     536   2138 my ($self) = @_;
189              
190 536         2492 return $self->{'_public'}->get_uncompressed( $self->_curve() );
191             }
192              
193             sub _get_jwk_digest_cr {
194 6     6   17 my ($self) = @_;
195              
196 6         23 my $name = $self->get_curve_name();
197              
198 6 50       64 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         28 require Digest::SHA;
204              
205 6         75 return Digest::SHA->can( $getter_cr->() );
206             }
207              
208             sub _get_jwk_curve_name {
209 5     5   11 my ($self) = @_;
210              
211 5         14 my $name = $self->get_curve_name();
212              
213 5         28 return Crypt::Perl::ECDSA::NIST::get_nist_for_curve_name($name);
214             }
215              
216             sub _verify {
217 251     251   1425 my ($self, $msg, $r, $s) = @_;
218              
219 251 50 33     1729 if ($r->is_positive() && $s->is_positive()) {
220 251         14019 my ($x, $y) = Crypt::Perl::ECDSA::Utils::split_G_or_public( $self->_decompress_public_point() );
221 251         2214 $_ = Crypt::Perl::BigInt->from_bytes($_) for ($x, $y);
222              
223 251         203883 my $curve = $self->_get_curve_obj();
224              
225 251         1796 my $Q = Crypt::Perl::ECDSA::EC::Point->new(
226             $curve,
227             $curve->from_bigint($x),
228             $curve->from_bigint($y),
229             );
230              
231 251         973 my $e = Crypt::Perl::BigInt->from_bytes($msg);
232              
233             #----------------------------------------------------------------------
234              
235 251         104732 my $n = $self->_curve()->{'n'};
236              
237 251 50 33     1159 if ($r->blt($n) && $s->blt($n)) {
238 251         19458 my $c = $s->copy()->bmodinv($n);
239              
240 251         5593792 my $u1 = $e->copy()->bmul($c)->bmod($n);
241 251         163654 my $u2 = $r->copy()->bmul($c)->bmod($n);
242              
243 251         218346 my $point = $self->_G()->multiply($u1)->add( $Q->multiply($u2) );
244              
245 251         4142 my $v = $point->get_x()->to_bigint()->copy()->bmod($n);
246              
247 251 100       33465 return 1 if $v->beq($r);
248             }
249             }
250              
251 8         668 return 0;
252             }
253              
254             #return isa EC::Point
255             sub _G {
256 496     496   1713 my ($self) = @_;
257 496         1836 return $self->_get_curve_obj()->decode_point( @{$self->_curve()}{ qw( gx gy ) } );
  496         1452  
258             }
259              
260             sub _pad_bytes_for_asn1 {
261 518     518   1274 my ($self, $bytes) = @_;
262              
263 518         1216 return Crypt::Perl::ECDSA::Utils::pad_bytes_for_asn1( $bytes, $self->_curve()->{'p'} );
264             }
265              
266             sub _named_curve_parameters {
267 28     28   126 my ($self) = @_;
268              
269 28         203 my $curve_name = $self->get_curve_name();
270              
271             return {
272 28         177 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   804 my ($self, %params) = @_;
279              
280 259         1212 my $curve_hr = $self->_curve();
281              
282 259         909 my ($gx, $gy) = map { $_->as_bytes() } @{$curve_hr}{'gx', 'gy'};
  518         1939  
  259         950  
283              
284 259         2440 for my $str ( $gx, $gy ) {
285 518         2976 $str = $self->_pad_bytes_for_asn1($str);
286             }
287              
288             my %curve = (
289             a => $curve_hr->{'a'}->as_bytes(),
290 259         1732 b => $curve_hr->{'b'}->as_bytes(),
291             );
292              
293 259 100 100     1834 if ($params{'seed'} && $curve_hr->{'seed'}) {
294              
295             #We don’t care about the bit count. (Right?)
296 13         583 $curve{'seed'} = $curve_hr->{'seed'}->as_bytes();
297             }
298              
299 259         915 my $base = "\x{04}$gx$gy";
300 259 100       945 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         6813 cofactor => $curve_hr->{'h'},
317             },
318             };
319             }
320              
321             sub __to_der {
322 274     274   2748 my ($self, $macro, $template, $data_hr, %params) = @_;
323              
324 274 100       2006 my $pub_bin = $params{'compressed'} ? $self->_compress_public_point() : $self->_decompress_public_point();
325              
326 274         1048 local $data_hr->{'publicKey'} = $pub_bin;
327              
328 274         3559 require Crypt::Perl::ASN1;
329 274         2076 my $asn1 = Crypt::Perl::ASN1->new()->prepare($template);
330              
331 274         1829 return $asn1->find($macro)->encode( $data_hr );
332             }
333              
334             #return isa EC::Curve
335             sub _get_curve_obj {
336 1044     1044   2805 my ($self) = @_;
337              
338 1044   66     6370 return $self->{'_curve_obj'} ||= Crypt::Perl::ECDSA::EC::Curve->new( @{$self->_curve()}{ qw( p a b ) } );
  296         945  
339             }
340              
341             sub _add_params {
342 573     573   1715 my ($self, $params_struct) = @_;
343              
344 573 100       1968 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         2052 $self->{'curve'} = Crypt::Perl::ECDSA::ECParameters::normalize($params);
351             }
352             else {
353 315         1447 $self->{'curve'} = $self->_curve_params_for_OID($params_struct->{'namedCurve'});
354             }
355              
356 333         6042 return $self;
357             }
358              
359             sub _curve_params_for_OID {
360 315     315   1223 my ($self, $oid) = @_;
361              
362 315         2414 return Crypt::Perl::ECDSA::EC::DB::get_curve_data_by_oid($oid);
363             }
364              
365             sub _curve {
366 2682     2682   5414 my ($self) = @_;
367              
368 2682         22722 return $self->{'curve'};
369             }
370              
371             #----------------------------------------------------------------------
372              
373             1;