File Coverage

blib/lib/Net/ACME2/AccountKey.pm
Criterion Covered Total %
statement 65 114 57.0
branch 28 50 56.0
condition 3 5 60.0
subroutine 13 16 81.2
pod 0 7 0.0
total 109 192 56.7


line stmt bran cond sub pod time code
1             package Net::ACME2::AccountKey;
2              
3 3     3   28 use strict;
  3         6  
  3         98  
4 3     3   15 use warnings;
  3         7  
  3         68  
5              
6 3     3   399 use Net::ACME2::X ();
  3         7  
  3         120  
7              
8             use constant {
9 3         4488 _DEBUG => 0,
10             _JWK_THUMBPRINT_DIGEST => 'sha256',
11              
12             _JWA_ALG => {
13             secp256r1 => 'ES256',
14             secp384r1 => 'ES384',
15             secp521r1 => 'ES521',
16             },
17              
18             # Shouldn’t be needed?
19             # cf. https://github.com/DCIT/perl-CryptX/issues/45
20             _JWA_SHA => {
21             secp256r1 => 'sha256',
22             secp384r1 => 'sha384',
23             secp521r1 => 'sha521',
24             },
25              
26             _TRY_OPENSSL => 1,
27             _TRY_CRYPTX => 1,
28 3     3   16 };
  3         6  
29              
30             #----------------------------------------------------------------------
31             # An abstraction that allows use of OpenSSL or CryptX for crypto operations
32             # as available and useful. Either will be faster than Crypt::Perl.
33             #----------------------------------------------------------------------
34              
35             sub new {
36 13     13 0 49 my ($class, $pem_or_der) = @_;
37              
38 13         28 my ($engine, $obj);
39              
40 13         51 my $key_type = _guess_at_key_type($pem_or_der);
41              
42 13 100       50 if (!$key_type) {
43 6         21 ($obj, $key_type) = _parse_via_crypt_perl($pem_or_der);
44             }
45              
46 13         34 my $err = $@;
47              
48 13         33 my %self;
49              
50 13 100       73 if ($key_type eq 'rsa') {
    50          
51 4 50       20 if (_TRY_OPENSSL() && eval { require Crypt::OpenSSL::RSA; require Crypt::OpenSSL::Bignum }) {
  4 50       731  
  0         0  
52              
53 0         0 my $pem;
54 0 0       0 if (0 == index($pem_or_der, '----')) {
55 0         0 $pem = $pem_or_der;
56             }
57             else {
58 0         0 require Crypt::Format;
59 0         0 $pem = Crypt::Format::der2pem($pem_or_der, 'RSA PRIVATE KEY');
60             }
61              
62 0         0 $obj = Crypt::OpenSSL::RSA->new_private_key($pem);
63 0         0 $obj->use_pkcs1_padding();
64 0         0 $obj->use_sha256_hash();
65              
66 0         0 $engine = 'crypt_openssl_rsa';
67             }
68 4         495 elsif (_TRY_CRYPTX() && eval { require Crypt::PK::RSA }) {
69 0         0 $obj = Crypt::PK::RSA->new(\$pem_or_der);
70 0         0 $engine = 'crypt_pk';
71             }
72             }
73             elsif ($key_type eq 'ecdsa') {
74 9 50       24 if (_TRY_CRYPTX() && eval { require Crypt::PK::ECC }) {
  9         1767  
75 0         0 $obj = Crypt::PK::ECC->new(\$pem_or_der);
76 0         0 $engine = 'crypt_pk';
77              
78 0         0 $self{'curve_name'} = $obj->key2hash()->{'curve_name'};
79              
80 0 0       0 _JWA_ALG()->{ $self{'curve_name'} } or do {
81 0         0 die Net::ACME2::X->create('Generic', "RFC 7518 does not support ECDSA curve “$self{'curve_name'}”!");
82             };
83             }
84             }
85              
86 13         76 $@ = $err;
87              
88             # If we got PEM in but don’t have an XS library …
89 13   66     81 $obj ||= (_parse_via_crypt_perl($pem_or_der))[0];
90 13   50     96 $engine ||= 'crypt_perl';
91              
92 13         22 _DEBUG() && print STDERR "Key backend: $engine/$key_type$/";
93              
94 13         115 %self = (
95             %self,
96             engine => $engine,
97             key_type => $key_type,
98             obj => $obj,
99             );
100              
101 13         288 return bless \%self, $class;
102             }
103              
104             sub _parse_via_crypt_perl {
105 13     13   41 my ($pem_or_der) = @_;
106              
107 13         525 require Crypt::Perl::PK;
108 13         5291 my $obj = Crypt::Perl::PK::parse_key($pem_or_der);
109              
110 13         1921046 my $key_type;
111              
112 13 100       215 if ($obj->isa('Crypt::Perl::RSA::PrivateKey')) {
    50          
113 4         12 $key_type = 'rsa';
114             }
115             elsif ($obj->isa('Crypt::Perl::ECDSA::PrivateKey')) {
116 9         26 $key_type = 'ecdsa';
117             }
118             else {
119              
120             # As of this writing, Crypt::Perl only does RSA and ECDSA keys.
121             # If we get here, it’s possible that Crypt::Perl now supports
122             # an additional key type that this library doesn’t recognize.
123 0         0 die Net::ACME2::X->create('Generic', "Unrecognized key type: $obj");
124             }
125              
126 13         94 return ($obj, $key_type);
127             }
128              
129             sub _guess_at_key_type {
130 13     13   42 my ($key_str) = @_;
131              
132             # PEM makes it easy …
133 13 100       66 return 'rsa' if 0 == index($key_str, '-----BEGIN RSA ');
134 11 100       74 return 'ecdsa' if 0 == index($key_str, '-----BEGIN EC ');
135              
136 6         18 return undef;
137             }
138              
139             sub get_type {
140 12     12 0 42 my ($self) = @_;
141              
142 12         35 return $self->{'key_type'};
143             }
144              
145             # Worth submitting this upstream?
146             sub _build_jwk_thumbprint_for_crypt_openssl_rsa {
147 0     0   0 my ($self) = @_;
148              
149 0         0 my ($n, $e) = $self->_get_crypt_openssl_rsa_n_e_strings();
150 0         0 my $json = qq<{"e":"$e","kty":"RSA","n":"$n"}>;
151              
152 0         0 require Digest::SHA;
153 0         0 my $hash_cr = Digest::SHA->can( _JWK_THUMBPRINT_DIGEST() );
154 0         0 return MIME::Base64::encode_base64url( $hash_cr->($json) );
155             }
156              
157             sub _get_crypt_openssl_rsa_n_e_strings {
158 0     0   0 my ($self) = @_;
159              
160 0         0 my ($n, $e) = $self->{'obj'}->get_key_parameters();
161              
162 0         0 require MIME::Base64;
163 0         0 $_ = MIME::Base64::encode_base64url( $_->to_bin() ) for ($n, $e);
164              
165 0         0 return ($n, $e);
166             }
167              
168             #----------------------------------------------------------------------
169              
170             # for RSA
171             sub sign_RS256 {
172 8     8 0 39 my ($self, $msg) = @_;
173              
174 8         22 my $engine = $self->{'engine'};
175              
176 8 50       63 if ($engine eq 'crypt_openssl_rsa') {
    50          
    50          
177 0         0 return $self->{'obj'}->sign($msg);
178             }
179             elsif ($engine eq 'crypt_pk') {
180 0         0 return $self->{'obj'}->sign_message($msg, 'sha256', 'v1.5');
181             }
182             elsif ($engine eq 'crypt_perl') {
183 8         55 return $self->{'obj'}->sign_RS256($msg);
184             }
185              
186 0         0 return _die_unknown_engine($engine);
187             }
188              
189             # for ECC
190             sub get_jwa_alg {
191 16     16 0 46 my ($self) = @_;
192              
193 16         45 my $engine = $self->{'engine'};
194              
195 16 50       90 if ($engine eq 'crypt_pk') {
    50          
196 0         0 return _JWA_ALG()->{$self->{'curve_name'}};
197             }
198             elsif ($engine eq 'crypt_perl') {
199 16         98 return $self->{'obj'}->get_jwa_alg();
200             }
201              
202 0         0 return _die_unknown_engine($engine);
203             }
204              
205             # for ECC
206             sub sign_jwa {
207 16     16 0 60 my ($self, $msg) = @_;
208              
209 16         43 my $engine = $self->{'engine'};
210              
211 16 50       78 if ($engine eq 'crypt_pk') {
    50          
212              
213             # This shouldn’t be needed??
214             # cf. https://github.com/DCIT/perl-CryptX/issues/45
215             my @extra_args = (
216 0         0 _JWA_SHA()->{$self->{'curve_name'}},
217             );
218              
219 0         0 return $self->{'obj'}->sign_message_rfc7518($msg, @extra_args);
220             }
221             elsif ($engine eq 'crypt_perl') {
222 16         101 return $self->{'obj'}->sign_jwa($msg);
223             }
224              
225 0         0 return _die_unknown_engine($engine);
226             }
227              
228             sub get_struct_for_public_jwk {
229 24     24 0 72 my ($self) = @_;
230              
231 24         71 my $engine = $self->{'engine'};
232              
233 24 50       154 if ($engine eq 'crypt_openssl_rsa') {
    50          
    50          
234 0         0 my ($n, $e) = $self->_get_crypt_openssl_rsa_n_e_strings();
235              
236             return {
237 0         0 e => $e,
238             kty => 'RSA',
239             n => $n,
240             };
241             }
242             elsif ($engine eq 'crypt_pk') {
243 0         0 return $self->{'obj'}->export_key_jwk('public', 1);
244             }
245             elsif ($engine eq 'crypt_perl') {
246 24         175 return $self->{'obj'}->get_struct_for_public_jwk();
247             }
248              
249 0         0 return _die_unknown_engine($engine);
250             }
251              
252             sub get_jwk_thumbprint {
253 1     1 0 3 my ($self) = @_;
254              
255 1         3 my $engine = $self->{'engine'};
256              
257 1 50       22 if ($engine eq 'crypt_openssl_rsa') {
    50          
    50          
258 0         0 my $thumbprint = $self->_build_jwk_thumbprint_for_crypt_openssl_rsa();
259              
260 0         0 _DEBUG() && print STDERR "key thumbprint: $thumbprint$/";
261              
262 0         0 return $thumbprint;
263             }
264             elsif ($engine eq 'crypt_pk') {
265 0         0 return $self->{'obj'}->export_key_jwk_thumbprint( _JWK_THUMBPRINT_DIGEST() );
266             }
267             elsif ($engine eq 'crypt_perl') {
268 1         11 return $self->{'obj'}->get_jwk_thumbprint( _JWK_THUMBPRINT_DIGEST() );
269             }
270              
271 0           return _die_unknown_engine($engine);
272             }
273              
274             sub _die_unknown_engine {
275 0     0     my ($engine) = @_;
276              
277 0           my $func = (caller 0)[3];
278 0           die "$func: unknown engine “$engine”";
279             }
280              
281             1;