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