Perl::Cricit fixups
[pve-common.git] / src / PVE / ACME.pm
1 package PVE::ACME;
2
3 use strict;
4 use warnings;
5
6 use POSIX;
7
8 use Data::Dumper;
9 use Date::Parse;
10 use MIME::Base64 qw(encode_base64url);
11 use File::Path qw(make_path);
12 use JSON;
13 use Digest::SHA qw(sha256 sha256_hex);
14
15 use HTTP::Request;
16 use LWP::UserAgent;
17
18 use Crypt::OpenSSL::RSA;
19
20 use PVE::Certificate;
21 use PVE::Tools qw(
22 file_set_contents
23 file_get_contents
24 );
25
26 Crypt::OpenSSL::RSA->import_random_seed();
27
28 my $LETSENCRYPT_STAGING = 'https://acme-staging-v02.api.letsencrypt.org/directory';
29
30 ### ACME library (compatible with Let's Encrypt v2 API)
31 #
32 # sample usage:
33 #
34 # 1) my $acme = PVE::ACME->new('path/to/account.json', 'API directory URL');
35 # 2) $acme->init(4096); # generate account key
36 # 4) my $tos_url = $acme->get_meta()->{termsOfService}; # optional, display if applicable
37 # 5) $acme->new_account($tos_url, contact => ['mailto:example@example.com']);
38 #
39 # 1) my $acme = PVE::ACME->new('path/to/account.json', 'API directory URL');
40 # 2) $acme->load();
41 # 3) my ($order_url, $order) = $acme->new_order(['foo.example.com', 'bar.example.com']);
42 # 4) # repeat a-f for each $auth_url in $order->{authorizations}
43 # a) my $authorization = $acme->get_authorization($auth_url);
44 # b) # pick $challenge from $authorization->{challenges} according to desired type
45 # c) my $key_auth = $acme->key_authorization($challenge->{token});
46 # d) # setup challenge validation according to specification
47 # e) $acme->request_challenge_validation($challenge->{url}, $key_auth);
48 # f) # poll $acme->get_authorization($auth_url) until status is 'valid'
49 # 5) # generate CSR in PEM format
50 # 6) $acme->finalize_order($order, $csr);
51 # 7) # poll $acme->get_order($order_url) until status is 'valid'
52 # 8) my $cert = $acme->get_certificate($order);
53 # 9) # $key is path to key file, $cert contains PEM-encoded certificate chain
54 #
55 # 1) my $acme = PVE::ACME->new('path/to/account.json', 'API directory URL');
56 # 2) $acme->load();
57 # 3) $acme->revoke_certificate($cert);
58
59 # Tools
60 sub encode($) { # acme requires 'base64url' encoding
61     return encode_base64url($_[0]);
62 }
63
64 sub tojs($;%) { # shortcut for to_json with utf8=>1
65     my ($data, %data) = @_;
66     return to_json($data, { utf8 => 1, %data });
67 }
68
69 sub fromjs($) {
70     return from_json($_[0]);
71 }
72
73 sub fatal($$;$$) {
74     my ($self, $msg, $dump, $noerr) = @_;
75
76     warn Dumper($dump), "\n" if $self->{debug} && $dump;
77     if ($noerr) {
78         warn "$msg\n";
79     } else {
80         die "$msg\n";
81     }
82 }
83
84 # Implementation
85
86 # $path: account JSON file
87 # $directory: the ACME directory URL used to find method URLs
88 sub new($$$) {
89     my ($class, $path, $directory) = @_;
90
91     $directory //= $LETSENCRYPT_STAGING;
92
93     my $ua = LWP::UserAgent->new();
94     $ua->env_proxy();
95     $ua->agent('pve-acme/0.1');
96     $ua->protocols_allowed(['https']);
97
98     my $self = {
99         ua => $ua,
100         path => $path,
101         directory => $directory,
102         nonce => undef,
103         key => undef,
104         location => undef,
105         account => undef,
106         tos => undef,
107     };
108
109     return bless $self, $class;
110 }
111
112 # RS256: PKCS#1 padding, no OAEP, SHA256
113 my $configure_key = sub {
114     my ($key) = @_;
115     $key->use_pkcs1_padding();
116     $key->use_sha256_hash();
117 };
118
119 # Create account key with $keybits bits
120 # use instead of load, overwrites existing account JSON file!
121 sub init {
122     my ($self, $keybits) = @_;
123     die "Already have a key\n" if defined($self->{key});
124     $keybits //= 4096;
125     my $key = Crypt::OpenSSL::RSA->generate_key($keybits);
126     $configure_key->($key);
127     $self->{key} = $key;
128     $self->save();
129 }
130
131 my @SAVED_VALUES = qw(location account tos debug directory);
132 # Serialize persistent parts of $self to $self->{path} as JSON
133 sub save {
134     my ($self) = @_;
135     my $o = {};
136     my $keystr;
137     if (my $key = $self->{key}) {
138         $keystr = $key->get_private_key_string();
139         $o->{key} = $keystr;
140     }
141     for my $k (@SAVED_VALUES) {
142         my $v = $self->{$k} // next;
143         $o->{$k} = $v;
144     }
145     # pretty => 1 for readability
146     # canonical => 1 to reduce churn
147     file_set_contents($self->{path}, tojs($o, pretty => 1, canonical => 1));
148 }
149
150 # Load serialized account JSON file into $self
151 sub load {
152     my ($self) = @_;
153     return if $self->{loaded};
154     $self->{loaded} = 1;
155     my $data = fromjs(file_get_contents($self->{path}));
156     $self->{$_} = $data->{$_} for @SAVED_VALUES;
157     if (defined(my $keystr = $data->{key})) {
158         my $key = Crypt::OpenSSL::RSA->new_private_key($keystr);
159         $configure_key->($key);
160         $self->{key} = $key;
161     }
162 }
163
164 # The 'jwk' object needs the key type, key parameters and the usage,
165 # except for when we want to take the JWK-Thumbprint, then the usage
166 # must not be included.
167 sub jwk {
168     my ($self, $pure) = @_;
169     my $key = $self->{key}
170         or die "No key was generated yet\n";
171     my ($n, $e) = $key->get_key_parameters();
172     return {
173         kty => 'RSA',
174         ($pure ? () : (use => 'sig')), # for thumbprints
175         n => encode($n->to_bin),
176         e => encode($e->to_bin),
177     };
178 }
179
180 # The thumbprint is a sha256 hash of the lexicographically sorted (iow.
181 # canonical) condensed json string of the JWK object which gets base64url
182 # encoded.
183 sub jwk_thumbprint {
184     my ($self) = @_;
185     my $jwk = $self->jwk(1); # $pure = 1
186     return encode(sha256(tojs($jwk, canonical=>1))); # canonical sorts
187 }
188
189 # A key authorization string in acme is a challenge token dot-connected with
190 # a JWK Thumbprint. You put the base64url encoded sha256-hash of this string
191 # into the DNS TXT record.
192 sub key_authorization {
193     my ($self, $token) = @_;
194     return $token .'.'. $self->jwk_thumbprint();
195 }
196
197 # JWS signing using the RS256 alg (RSA/SHA256).
198 sub jws {
199     my ($self, $use_jwk, $data, $url) = @_;
200     my $key = $self->{key}
201         or die "No key was generated yet\n";
202
203     my $payload = encode(tojs($data));
204
205     if (!defined($self->{nonce})) {
206         my $method = $self->_method('newNonce');
207         $self->do(GET => $method);
208     }
209
210     # The acme protocol requires the actual request URL be in the protected
211     # header. There is no unprotected header.
212     my $protected = {
213         alg => 'RS256',
214         url => $url,
215         nonce => $self->{nonce} // die "missing nonce\n"
216     };
217
218     # header contains either
219     # - kid, reference to account URL
220     # - jwk, key itself
221     # the latter is only allowed for
222     # - creating accounts (no account URL yet)
223     # - revoking certificates with the certificate key instead of account key
224     if ($use_jwk) {
225         $protected->{jwk} = $self->jwk();
226     } else {
227         $protected->{kid} = $self->{location};
228     }
229
230     $protected = encode(tojs($protected));
231
232     my $signdata = "$protected.$payload";
233     my $signature = encode($key->sign($signdata));
234
235     return {
236         protected => $protected,
237         payload => $payload,
238         signature => $signature,
239     };
240 }
241
242 sub __get_result {
243     my ($resp, $code, $plain) = @_;
244
245     die "expected code '$code', received '".$resp->code."'\n"
246         if $resp->code != $code;
247
248     return $plain ? $resp->decoded_content : fromjs($resp->decoded_content);
249 }
250
251 # Get the list of method URLs and query the directory if we have to.
252 sub __get_methods {
253     my ($self) = @_;
254     if (my $methods = $self->{methods}) {
255         return $methods;
256     }
257     my $r = $self->do(GET => $self->{directory});
258     my $methods = __get_result($r, 200);
259     $self->fatal("unable to decode methods returned by directory - $@", $r) if $@;
260     return ($self->{methods} = $methods);
261 }
262
263 # Get a method, causing the directory to be queried first if necessary.
264 sub _method {
265     my ($self, $method) = @_;
266     my $methods = $self->__get_methods();
267     my $url = $methods->{$method}
268         or die "no such method: $method\n";
269     return $url;
270 }
271
272 # Get $self->{account} with an error if we don't have one yet.
273 sub _account {
274     my ($self) = @_;
275     my $account = $self->{account}
276         // die "no account loaded\n";
277     return wantarray ? ($account, $self->{location}) : $account;
278 }
279
280 # debugging info
281 sub list_methods {
282     my ($self) = @_;
283     my $methods = $self->__get_methods();
284     if (my $meta = $methods->{meta}) {
285         print("(meta): $_ : $meta->{$_}\n") for sort keys %$meta;
286     }
287     print("$_ : $methods->{$_}\n") for sort grep {$_ ne 'meta'} keys %$methods;
288 }
289
290 # return (optional) meta directory entry.
291 # this is public because it might contain the ToS, which should be displayed
292 # and agreed to before creating an account
293 sub get_meta {
294     my ($self) = @_;
295     my $methods = $self->__get_methods();
296     return $methods->{meta};
297 }
298
299 # Common code between new_account and update_account
300 sub __new_account {
301     my ($self, $expected_code, $url, $new, %info) = @_;
302     my $req = {
303         %info,
304     };
305     my $r = $self->do(POST => $url, $req, $new);
306     eval {
307         my $account = __get_result($r, $expected_code);
308         if (!defined($self->{location})) {
309             my $account_url = $r->header('Location')
310                 or die "did not receive an account URL\n";
311             $self->{location} = $account_url;
312         }
313         $self->{account} = $account;
314         $self->save();
315     };
316     $self->fatal("POST to '$url' failed - $@", $r) if $@;
317     return $self->{account};
318 }
319
320 # Create a new account using data in %info.
321 # Optionally pass $tos_url to agree to the given Terms of Service
322 # POST to newAccount endpoint
323 # Expects a '201 Created' reply
324 # Saves and returns the account data
325 sub new_account {
326     my ($self, $tos_url, %info) = @_;
327     my $url = $self->_method('newAccount');
328
329     if ($tos_url) {
330         $self->{tos} = $tos_url;
331         $info{termsOfServiceAgreed} = JSON::true;
332     }
333
334     return $self->__new_account(201, $url, 1, %info);
335 }
336
337 # Update existing account with new %info
338 # POST to account URL
339 # Expects a '200 OK' reply
340 # Saves and returns updated account data
341 sub update_account {
342     my ($self, %info) = @_;
343     my (undef, $url) = $self->_account;
344
345     return $self->__new_account(200, $url, 0, %info);
346 }
347
348 # Retrieves existing account information
349 # POST to account URL with empty body!
350 # Expects a '200 OK' reply
351 # Saves and returns updated account data
352 sub get_account {
353     my ($self) = @_;
354     return $self->update_account();
355 }
356
357 # Start a new order for one or more domains
358 # POST to newOrder endpoint
359 # Expects a '201 Created' reply
360 # returns order URL and parsed order object, including authorization and finalize URLs
361 sub new_order {
362     my ($self, $domains) = @_;
363
364     my $url = $self->_method('newOrder');
365     my $req = {
366         identifiers => [ map { { type => 'dns', value => $_ } } @$domains ],
367     };
368
369     my $r = $self->do(POST => $url, $req);
370     my ($order_url, $order);
371     eval {
372         $order_url = $r->header('Location')
373             or die "did not receive an order URL\n";
374         $order = __get_result($r, 201)
375     };
376     $self->fatal("POST to '$url' failed - $@", $r) if $@;
377     return ($order_url, $order);
378 }
379
380 # Finalize order after all challenges have been validated
381 # POST to order's finalize URL
382 # Expects a '200 OK' reply
383 # returns (potentially updated) order object
384 sub finalize_order {
385     my ($self, $order, $csr) = @_;
386
387     my $req = {
388         csr => encode($csr),
389     };
390     my $r = $self->do(POST => $order->{finalize}, $req);
391     my $return = eval { __get_result($r, 200); };
392     $self->fatal("POST to '$order->{finalize}' failed - $@", $r) if $@;
393     return $return;
394 }
395
396 # Get order status
397 # GET to order URL
398 # Expects a '200 OK' reply
399 # returns order object
400 sub get_order {
401     my ($self, $order_url) = @_;
402     my $r = $self->do(GET => $order_url);
403     my $return = eval { __get_result($r, 200); };
404     $self->fatal("GET of '$order_url' failed - $@", $r) if $@;
405     return $return;
406 }
407
408 # Gets authorization object
409 # GET to authorization URL
410 # Expects a '200 OK' reply
411 # returns authorization object, including challenges array
412 sub get_authorization {
413     my ($self, $auth_url) = @_;
414
415     my $r = $self->do(GET => $auth_url);
416     my $return = eval { __get_result($r, 200); };
417     $self->fatal("GET of '$auth_url' failed - $@", $r) if $@;
418     return $return;
419 }
420
421 # Deactivates existing authorization
422 # POST to authorization URL
423 # Expects a '200 OK' reply
424 # returns updated authorization object
425 sub deactivate_authorization {
426     my ($self, $auth_url) = @_;
427
428     my $req = {
429         status => 'deactivated',
430     };
431     my $r = $self->do(POST => $auth_url, $req);
432     my $return = eval { __get_result($r, 200); };
433     $self->fatal("POST to '$auth_url' failed - $@", $r) if $@;
434     return $return;
435 }
436
437 # Get certificate
438 # GET to order's certificate URL
439 # Expects a '200 OK' reply
440 # returns certificate chain in PEM format
441 sub get_certificate {
442     my ($self, $order) = @_;
443
444     $self->fatal("no certificate URL available (yet?)", $order)
445        if !$order->{certificate};
446
447     my $r = $self->do(GET => $order->{certificate});
448     my $return = eval { __get_result($r, 200, 1); };
449     $self->fatal("GET of '$order->{certificate}' failed - $@", $r) if $@;
450     return $return;
451 }
452
453 # Revoke given certificate
454 # POST to revokeCert endpoint
455 # currently only supports revokation with account key
456 # $certificate can either be PEM or DER encoded
457 # Expects a '200 OK' reply
458 sub revoke_certificate {
459     my ($self, $certificate, $reason) = @_;
460
461     my $url = $self->_method('revokeCert');
462
463     if ($certificate =~ /^-----BEGIN CERTIFICATE-----/) {
464         $certificate = PVE::Certificate::pem_to_der($certificate);
465     }
466
467     my $req = {
468         certificate => encode($certificate),
469         reason => $reason // 0,
470     };
471     # TODO: set use_jwk if revoking with certificate key
472     my $r = $self->do(POST => $url, $req);
473     eval {
474         die "unexpected code $r->code\n" if $r->code != 200;
475     };
476     $self->fatal("POST to '$url' failed - $@", $r) if $@;
477 }
478
479 # Request validation of challenge
480 # POST to challenge URL
481 # call after validation has been setup
482 # returns (potentially updated) challenge object
483 sub request_challenge_validation {
484     my ($self, $url, $key_authorization) = @_;
485
486     my $req = { keyAuthorization => $key_authorization };
487
488     my $r = $self->do(POST => $url, $req);
489     my $return = eval { __get_result($r, 200); };
490     $self->fatal("POST to '$url' failed - $@", $r) if $@;
491     return $return;
492 }
493
494 # actually 'do' a $method request on $url
495 # $data: input for JWS, optional
496 # $use_jwk: use JWK instead of KID in JWD (see sub jws)
497 sub do {
498     my ($self, $method, $url, $data, $use_jwk) = @_;
499
500     $self->fatal("Error: can't $method to empty URL") if !$url || $url eq '';
501
502     my $headers = HTTP::Headers->new();
503     $headers->header('Content-Type' => 'application/jose+json');
504     my $content = defined($data) ? $self->jws($use_jwk, $data, $url) : undef;
505     my $request;
506     if (defined($content)) {
507         $content = tojs($content);
508         $request = HTTP::Request->new($method, $url, $headers, $content);
509     } else {
510         $request = HTTP::Request->new($method, $url, $headers);
511     }
512     my $res = $self->{ua}->request($request);
513     if (!$res->is_success) {
514         # check for nonce rejection
515         if ($res->code == 400 && $res->decoded_content) {
516             my $parsed_content = fromjs($res->decoded_content);
517             if ($parsed_content->{type} eq 'urn:ietf:params:acme:error:badNonce') {
518                 warn("bad Nonce, retrying\n");
519                 $self->{nonce} = $res->header('Replay-Nonce');
520                 return $self->do($method, $url, $data, $use_jwk);
521             }
522         }
523         $self->fatal("Error: $method to $url\n".$res->decoded_content, $res);
524     }
525     if (my $nonce = $res->header('Replay-Nonce')) {
526         $self->{nonce} = $nonce;
527     }
528     return $res;
529 }
530
531 1;