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