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