[proxmox-acme.git] / src / PVE / ACME.pm

package PVE::ACME;

use strict;
use warnings;

use POSIX;

use Data::Dumper;
use Date::Parse;
use MIME::Base64 qw(encode_base64url);
use File::Path qw(make_path);
use JSON;
use Digest::SHA qw(sha256 sha256_hex);

use HTTP::Request;
use LWP::UserAgent;

use Crypt::OpenSSL::RSA;

use PVE::Certificate;
use PVE::Tools qw(
file_set_contents
file_get_contents
);

use PVE::ACME::DNSChallenge;

Crypt::OpenSSL::RSA->import_random_seed();

my $LETSENCRYPT_STAGING = 'https://acme-staging-v02.api.letsencrypt.org/directory';

### ACME library (compatible with Let's Encrypt v2 API)
#
# sample usage:
#
# 1) my $acme = PVE::ACME->new('path/to/account.json', 'API directory URL');
# 2) $acme->init(4096); # generate account key
# 4) my $tos_url = $acme->get_meta()->{termsOfService}; # optional, display if applicable
# 5) $acme->new_account($tos_url, contact => ['mailto:example@example.com']);
#
# 1) my $acme = PVE::ACME->new('path/to/account.json', 'API directory URL');
# 2) $acme->load();
# 3) my ($order_url, $order) = $acme->new_order(['foo.example.com', 'bar.example.com']);
# 4) # repeat a-f for each $auth_url in $order->{authorizations}
# a) my $authorization = $acme->get_authorization($auth_url);
# b) # pick $challenge from $authorization->{challenges} according to desired type
# c) my $key_auth = $acme->key_authorization($challenge->{token});
# d) # setup challenge validation according to specification
# e) $acme->request_challenge_validation($challenge->{url});
# f) # poll $acme->get_authorization($auth_url) until status is 'valid'
# 5) # generate CSR in PEM format
# 6) $acme->finalize_order($order, $csr);
# 7) # poll $acme->get_order($order_url) until status is 'valid'
# 8) my $cert = $acme->get_certificate($order);
# 9) # $key is path to key file, $cert contains PEM-encoded certificate chain
#
# 1) my $acme = PVE::ACME->new('path/to/account.json', 'API directory URL');
# 2) $acme->load();
# 3) $acme->revoke_certificate($cert);

# Tools
sub encode($) { # acme requires 'base64url' encoding
    return encode_base64url($_[0]);
}

sub tojs($;%) { # shortcut for to_json with utf8=>1
    my ($data, %data) = @_;
    return to_json($data, { utf8 => 1, %data });
}

sub fromjs($) {
    my ($data) = @_;
    ($data) = ($data =~ /^(.*)$/s); # untaint from_json croaks on error anyways.
    return from_json($data);
}

sub fatal($$;$$) {
    my ($self, $msg, $dump, $noerr) = @_;

    warn Dumper($dump), "\n" if $self->{debug} && $dump;
    if ($noerr) {
	warn "$msg\n";
    } else {
	die "$msg\n";
    }
}

# Implementation

# $path: account JSON file
# $directory: the ACME directory URL used to find method URLs
sub new($$$) {
    my ($class, $path, $directory) = @_;

    $directory //= $LETSENCRYPT_STAGING;

    my $ua = LWP::UserAgent->new();
    $ua->env_proxy();
    $ua->agent('pve-acme/0.1');
    $ua->protocols_allowed(['https']);

    my $self = {
	ua => $ua,
	path => $path,
	directory => $directory,
	nonce => undef,
	key => undef,
	location => undef,
	account => undef,
	tos => undef,
    };

    return bless $self, $class;
}

# RS256: PKCS#1 padding, no OAEP, SHA256
my $configure_key = sub {
    my ($key) = @_;
    $key->use_pkcs1_padding();
    $key->use_sha256_hash();
};

# Create account key with $keybits bits
# use instead of load, overwrites existing account JSON file!
sub init {
    my ($self, $keybits) = @_;
    die "Already have a key\n" if defined($self->{key});
    $keybits //= 4096;
    my $key = Crypt::OpenSSL::RSA->generate_key($keybits);
    $configure_key->($key);
    $self->{key} = $key;
    $self->save();
}

my @SAVED_VALUES = qw(location account tos debug directory);
# Serialize persistent parts of $self to $self->{path} as JSON
sub save {
    my ($self) = @_;
    my $o = {};
    my $keystr;
    if (my $key = $self->{key}) {
	$keystr = $key->get_private_key_string();
	$o->{key} = $keystr;
    }
    for my $k (@SAVED_VALUES) {
	my $v = $self->{$k} // next;
	$o->{$k} = $v;
    }
    # pretty => 1 for readability
    # canonical => 1 to reduce churn
    file_set_contents($self->{path}, tojs($o, pretty => 1, canonical => 1));
}

# Load serialized account JSON file into $self
sub load {
    my ($self) = @_;
    return if $self->{loaded};
    $self->{loaded} = 1;
    my $raw = file_get_contents($self->{path});
    if ($raw =~ m/^(.*)$/s) { $raw = $1; }  # untaint
    my $data = fromjs($raw);
    $self->{$_} = $data->{$_} for @SAVED_VALUES;
    if (defined(my $keystr = $data->{key})) {
	my $key = Crypt::OpenSSL::RSA->new_private_key($keystr);
	$configure_key->($key);
	$self->{key} = $key;
    }
}

# The 'jwk' object needs the key type, key parameters and the usage,
# except for when we want to take the JWK-Thumbprint, then the usage
# must not be included.
sub jwk {
    my ($self, $pure) = @_;
    my $key = $self->{key}
	or die "No key was generated yet\n";
    my ($n, $e) = $key->get_key_parameters();
    return {
	kty => 'RSA',
	($pure ? () : (use => 'sig')), # for thumbprints
	n => encode($n->to_bin),
	e => encode($e->to_bin),
    };
}

# The thumbprint is a sha256 hash of the lexicographically sorted (iow.
# canonical) condensed json string of the JWK object which gets base64url
# encoded.
sub jwk_thumbprint {
    my ($self) = @_;
    my $jwk = $self->jwk(1); # $pure = 1
    return encode(sha256(tojs($jwk, canonical=>1))); # canonical sorts
}

# A key authorization string in acme is a challenge token dot-connected with
# a JWK Thumbprint. You put the base64url encoded sha256-hash of this string
# into the DNS TXT record.
sub key_authorization {
    my ($self, $token) = @_;
    return $token .'.'. $self->jwk_thumbprint();
}

# JWS signing using the RS256 alg (RSA/SHA256).
sub jws {
    my ($self, $use_jwk, $data, $url) = @_;
    my $key = $self->{key}
	or die "No key was generated yet\n";

    my $payload = $data ne '' ? encode(tojs($data)) : $data;

    if (!defined($self->{nonce})) {
	my $method = $self->_method('newNonce');
	$self->do(GET => $method);
    }

    # The acme protocol requires the actual request URL be in the protected
    # header. There is no unprotected header.
    my $protected = {
	alg => 'RS256',
	url => $url,
	nonce => $self->{nonce} // die "missing nonce\n"
    };

    # header contains either
    # - kid, reference to account URL
    # - jwk, key itself
    # the latter is only allowed for
    # - creating accounts (no account URL yet)
    # - revoking certificates with the certificate key instead of account key
    if ($use_jwk) {
	$protected->{jwk} = $self->jwk();
    } else {
	$protected->{kid} = $self->{location};
    }

    $protected = encode(tojs($protected));

    my $signdata = "$protected.$payload";
    my $signature = encode($key->sign($signdata));

    return {
	protected => $protected,
	payload => $payload,
	signature => $signature,
    };
}

sub __get_result {
    my ($resp, $code, $plain) = @_;

    die "expected code '$code', received '".$resp->code."'\n"
	if $resp->code != $code;

    return $plain ? $resp->decoded_content : fromjs($resp->decoded_content);
}

# Get the list of method URLs and query the directory if we have to.
sub __get_methods {
    my ($self) = @_;
    if (my $methods = $self->{methods}) {
	return $methods;
    }
    my $r = $self->do(GET => $self->{directory});
    my $methods = __get_result($r, 200);
    $self->fatal("unable to decode methods returned by directory - $@", $r) if $@;
    return ($self->{methods} = $methods);
}

# Get a method, causing the directory to be queried first if necessary.
sub _method {
    my ($self, $method) = @_;
    my $methods = $self->__get_methods();
    my $url = $methods->{$method}
	or die "no such method: $method\n";
    return $url;
}

# Get $self->{account} with an error if we don't have one yet.
sub _account {
    my ($self) = @_;
    my $account = $self->{account}
	// die "no account loaded\n";
    return wantarray ? ($account, $self->{location}) : $account;
}

# debugging info
sub list_methods {
    my ($self) = @_;
    my $methods = $self->__get_methods();
    if (my $meta = $methods->{meta}) {
	print("(meta): $_ : $meta->{$_}\n") for sort keys %$meta;
    }
    print("$_ : $methods->{$_}\n") for sort grep {$_ ne 'meta'} keys %$methods;
}

# return (optional) meta directory entry.
# this is public because it might contain the ToS, which should be displayed
# and agreed to before creating an account
sub get_meta {
    my ($self) = @_;
    my $methods = $self->__get_methods();
    return $methods->{meta};
}

# Common code between new_account and update_account
sub __new_account {
    my ($self, $expected_code, $url, $new, %info) = @_;
    my $req = {
	%info,
    };
    my $r = $self->do(POST => $url, $req, $new);
    eval {
	my $account = __get_result($r, $expected_code);
	if (!defined($self->{location})) {
	    my $account_url = $r->header('Location')
		or die "did not receive an account URL\n";
	    $self->{location} = $account_url;
	}
	$self->{account} = $account;
	$self->save();
    };
    $self->fatal("POST to '$url' failed - $@", $r) if $@;
    return $self->{account};
}

# Create a new account using data in %info.
# Optionally pass $tos_url to agree to the given Terms of Service
# POST to newAccount endpoint
# Expects a '201 Created' reply
# Saves and returns the account data
sub new_account {
    my ($self, $tos_url, %info) = @_;
    my $url = $self->_method('newAccount');

    if ($tos_url) {
	$self->{tos} = $tos_url;
	$info{termsOfServiceAgreed} = JSON::true;
    }

    return $self->__new_account(201, $url, 1, %info);
}

# Update existing account with new %info
# POST to account URL
# Expects a '200 OK' reply
# Saves and returns updated account data
sub update_account {
    my ($self, %info) = @_;
    my (undef, $url) = $self->_account;

    return $self->__new_account(200, $url, 0, %info);
}

# Retrieves existing account information
# POST to account URL with empty body!
# Expects a '200 OK' reply
# Saves and returns updated account data
sub get_account {
    my ($self) = @_;
    return $self->update_account();
}

# Start a new order for one or more domains
# POST to newOrder endpoint
# Expects a '201 Created' reply
# returns order URL and parsed order object, including authorization and finalize URLs
sub new_order {
    my ($self, $domains) = @_;

    my $url = $self->_method('newOrder');
    my $req = {
	identifiers => [ map { { type => 'dns', value => $_ } } @$domains ],
    };

    my $r = $self->do(POST => $url, $req);
    my ($order_url, $order);
    eval {
	$order_url = $r->header('Location')
	    or die "did not receive an order URL\n";
	$order = __get_result($r, 201)
    };
    $self->fatal("POST to '$url' failed - $@", $r) if $@;
    return ($order_url, $order);
}

# Finalize order after all challenges have been validated
# POST to order's finalize URL
# Expects a '200 OK' reply
# returns (potentially updated) order object
sub finalize_order {
    my ($self, $order, $csr) = @_;

    my $req = {
	csr => encode($csr),
    };
    my $r = $self->do(POST => $order->{finalize}, $req);
    my $return = eval { __get_result($r, 200); };
    $self->fatal("POST to '$order->{finalize}' failed - $@", $r) if $@;
    return $return;
}

# Get order status
# GET-as-POST to order URL
# Expects a '200 OK' reply
# returns order object
sub get_order {
    my ($self, $order_url) = @_;
    my $r = $self->do(POST => $order_url, '');
    my $return = eval { __get_result($r, 200); };
    $self->fatal("POST of '$order_url' failed - $@", $r) if $@;
    return $return;
}

# Gets authorization object
# GET-as-POST to authorization URL
# Expects a '200 OK' reply
# returns authorization object, including challenges array
sub get_authorization {
    my ($self, $auth_url) = @_;

    my $r = $self->do(POST => $auth_url, '');
    my $return = eval { __get_result($r, 200); };
    $self->fatal("POST of '$auth_url' failed - $@", $r) if $@;
    return $return;
}

# Deactivates existing authorization
# POST to authorization URL
# Expects a '200 OK' reply
# returns updated authorization object
sub deactivate_authorization {
    my ($self, $auth_url) = @_;

    my $req = {
	status => 'deactivated',
    };
    my $r = $self->do(POST => $auth_url, $req);
    my $return = eval { __get_result($r, 200); };
    $self->fatal("POST to '$auth_url' failed - $@", $r) if $@;
    return $return;
}

# Get certificate
# GET-as-POST to order's certificate URL
# if $root is specified, attempts to find a matching (alternate) chain
# Expects a '200 OK' reply
# returns certificate chain in PEM format
sub get_certificate {
    my ($self, $order, $root) = @_;

    $self->fatal("no certificate URL available (yet?)", $order)
       if !$order->{certificate};

    my $check_root = sub {
	my ($chain) = @_;

	my @certs = PVE::Certificate::split_pem($chain);
	my $root_pem = $certs[-1];

	my ($file, $fh) = PVE::Tools::tempfile_contents($root_pem);
	my $info = PVE::Certificate::get_certificate_info($file);

	return defined($info->{issuer}) && $info->{issuer} =~ m/\Q$root\E/i;
    };

    my $r = $self->do(POST => $order->{certificate}, '');
    my $return = eval {
	# default chain
	my $res = __get_result($r, 200, 1);
	if ($root && !$check_root->($res)) {
	    # alternate chains if requested and default didn't match
	    $res = undef;
	    my @links = $r->header('link');
	    for my $link (@links) {
		if ($link =~ /^<(.*)>;rel="alternate"$/) {
		    my $url = $1;
		    my $chain = eval { __get_result($self->do(POST => $url, ''), 200, 1); };
		    die "failed to retrieve alternate chain from '$url' - $@\n" if $@;
		    if ($check_root->($chain)) {
			$res = $chain;
			last;
		    }
		}
	    }
	    die "no matching alternate chain for '$root' returned by server\n"
		if !defined($res);
	}

	if ($res =~ /^(-----BEGIN CERTIFICATE-----)(.+)(-----END CERTIFICATE-----)$/s) { # untaint
	    return $1 . $2 . $3;
	}
	die "Server reply does not look like a PEM encoded certificate\n";
    };
    $self->fatal("POST of '$order->{certificate}' failed - $@", $r) if $@;
    return $return;
}

# Revoke given certificate
# POST to revokeCert endpoint
# currently only supports revokation with account key
# $certificate can either be PEM or DER encoded
# Expects a '200 OK' reply
sub revoke_certificate {
    my ($self, $certificate, $reason) = @_;

    my $url = $self->_method('revokeCert');

    if ($certificate =~ /^-----BEGIN CERTIFICATE-----/) {
	$certificate = PVE::Certificate::pem_to_der($certificate);
    }

    my $req = {
	certificate => encode($certificate),
	reason => $reason // 0,
    };
    # TODO: set use_jwk if revoking with certificate key
    my $r = $self->do(POST => $url, $req);
    eval {
	die "unexpected code $r->code\n" if $r->code != 200;
    };
    $self->fatal("POST to '$url' failed - $@", $r) if $@;
}

# Request validation of challenge
# POST to challenge URL
# call after validation has been setup
# returns (potentially updated) challenge object
sub request_challenge_validation {
    my ($self, $url) = @_;

    my $r = $self->do(POST => $url, {});
    my $return = eval { __get_result($r, 200); };
    $self->fatal("POST to '$url' failed - $@", $r) if $@;
    return $return;
}

# actually 'do' a $method request on $url
# $data: input for JWS, optional
# $use_jwk: use JWK instead of KID in JWD (see sub jws)
sub do {
    my ($self, $method, $url, $data, $use_jwk) = @_;

    $self->fatal("Error: can't $method to empty URL") if !$url || $url eq '';

    my $headers = HTTP::Headers->new();
    $headers->header('Content-Type' => 'application/jose+json');
    my $content = defined($data) ? $self->jws($use_jwk, $data, $url) : undef;
    my $request;
    if (defined($content)) {
	$content = tojs($content);
	$request = HTTP::Request->new($method, $url, $headers, $content);
    } else {
	$request = HTTP::Request->new($method, $url, $headers);
    }
    my $res = $self->{ua}->request($request);
    if (!$res->is_success) {
	# check for nonce rejection
	if ($res->code == 400 && $res->decoded_content) {
	    my $parsed_content = fromjs($res->decoded_content);
	    if ($parsed_content->{type} eq 'urn:ietf:params:acme:error:badNonce') {
		warn("bad Nonce, retrying\n");
		$self->{nonce} = $res->header('Replay-Nonce');
		return $self->do($method, $url, $data, $use_jwk);
	    }
	}
	$self->fatal("Error: $method to $url\n".$res->decoded_content, $res);
    }
    if (my $nonce = $res->header('Replay-Nonce')) {
	$self->{nonce} = $nonce;
    }
    return $res;
}

1;
Commit	Line	Data
5460050d WL	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
98b96d9e WL	26	use PVE::ACME::DNSChallenge;
98b96d9e WL	27
5460050d WL	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
109fc3fd	49	# e) $acme->request_challenge_validation($challenge->{url});
5460050d WL	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($) {
a5320155 SI	72	my ($data) = @_;
	73	($data) = ($data =~ /^(.*)$/s); # untaint from_json croaks on error anyways.
	74	return from_json($data);
5460050d WL	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	# RS256: PKCS#1 padding, no OAEP, SHA256
	117	my $configure_key = sub {
	118	my ($key) = @_;
	119	$key->use_pkcs1_padding();
	120	$key->use_sha256_hash();
	121	};
	122
	123	# Create account key with $keybits bits
	124	# use instead of load, overwrites existing account JSON file!
	125	sub init {
	126	my ($self, $keybits) = @_;
	127	die "Already have a key\n" if defined($self->{key});
	128	$keybits //= 4096;
	129	my $key = Crypt::OpenSSL::RSA->generate_key($keybits);
	130	$configure_key->($key);
	131	$self->{key} = $key;
	132	$self->save();
	133	}
	134
	135	my @SAVED_VALUES = qw(location account tos debug directory);
	136	# Serialize persistent parts of $self to $self->{path} as JSON
	137	sub save {
	138	my ($self) = @_;
139	my $o = {};
140	my $keystr;
141	if (my $key = $self->{key}) {
142	$keystr = $key->get_private_key_string();
143	$o->{key} = $keystr;
144	}
145	for my $k (@SAVED_VALUES) {
146	my $v = $self->{$k} // next;
147	$o->{$k} = $v;
148	}
149	# pretty => 1 for readability
150	# canonical => 1 to reduce churn
151	file_set_contents($self->{path}, tojs($o, pretty => 1, canonical => 1));
152	}
153
154	# Load serialized account JSON file into $self
155	sub load {
156	my ($self) = @_;
157	return if $self->{loaded};
158	$self->{loaded} = 1;
159	my $raw = file_get_contents($self->{path});
160	if ($raw =~ m/^(.*)$/s) { $raw = $1; } # untaint
161	my $data = fromjs($raw);
162	$self->{$_} = $data->{$_} for @SAVED_VALUES;
163	if (defined(my $keystr = $data->{key})) {
164	my $key = Crypt::OpenSSL::RSA->new_private_key($keystr);
165	$configure_key->($key);
166	$self->{key} = $key;
167	}
168	}
169
170	# The 'jwk' object needs the key type, key parameters and the usage,
171	# except for when we want to take the JWK-Thumbprint, then the usage
172	# must not be included.
173	sub jwk {
174	my ($self, $pure) = @_;
175	my $key = $self->{key}
176	or die "No key was generated yet\n";
177	my ($n, $e) = $key->get_key_parameters();
178	return {
179	kty => 'RSA',
180	($pure ? () : (use => 'sig')), # for thumbprints
181	n => encode($n->to_bin),
182	e => encode($e->to_bin),
183	};
184	}
185
186	# The thumbprint is a sha256 hash of the lexicographically sorted (iow.
187	# canonical) condensed json string of the JWK object which gets base64url
188	# encoded.
189	sub jwk_thumbprint {
190	my ($self) = @_;
191	my $jwk = $self->jwk(1); # $pure = 1
192	return encode(sha256(tojs($jwk, canonical=>1))); # canonical sorts
193	}
194
195	# A key authorization string in acme is a challenge token dot-connected with
196	# a JWK Thumbprint. You put the base64url encoded sha256-hash of this string
197	# into the DNS TXT record.
198	sub key_authorization {
199	my ($self, $token) = @_;
200	return $token .'.'. $self->jwk_thumbprint();
201	}
202
203	# JWS signing using the RS256 alg (RSA/SHA256).
204	sub jws {
205	my ($self, $use_jwk, $data, $url) = @_;
206	my $key = $self->{key}
207	or die "No key was generated yet\n";
208
209	my $payload = $data ne '' ? encode(tojs($data)) : $data;
210
211	if (!defined($self->{nonce})) {
212	my $method = $self->_method('newNonce');
213	$self->do(GET => $method);
214	}
215
216	# The acme protocol requires the actual request URL be in the protected
217	# header. There is no unprotected header.
218	my $protected = {
219	alg => 'RS256',
220	url => $url,
221	nonce => $self->{nonce} // die "missing nonce\n"
222	};
223
224	# header contains either
225	# - kid, reference to account URL
226	# - jwk, key itself
227	# the latter is only allowed for
228	# - creating accounts (no account URL yet)
229	# - revoking certificates with the certificate key instead of account key
230	if ($use_jwk) {
231	$protected->{jwk} = $self->jwk();
232	} else {
233	$protected->{kid} = $self->{location};
234	}
235
236	$protected = encode(tojs($protected));
237
238	my $signdata = "$protected.$payload";
239	my $signature = encode($key->sign($signdata));
240
241	return {
242	protected => $protected,
243	payload => $payload,
244	signature => $signature,
245	};
246	}
247
248	sub __get_result {
249	my ($resp, $code, $plain) = @_;
250
251	die "expected code '$code', received '".$resp->code."'\n"
252	if $resp->code != $code;
253
254	return $plain ? $resp->decoded_content : fromjs($resp->decoded_content);
255	}
256
257	# Get the list of method URLs and query the directory if we have to.
258	sub __get_methods {
259	my ($self) = @_;
260	if (my $methods = $self->{methods}) {
261	return $methods;
262	}
263	my $r = $self->do(GET => $self->{directory});
264	my $methods = __get_result($r, 200);
265	$self->fatal("unable to decode methods returned by directory - $@", $r) if $@;
266	return ($self->{methods} = $methods);
267	}
268
269	# Get a method, causing the directory to be queried first if necessary.
270	sub _method {
271	my ($self, $method) = @_;
272	my $methods = $self->__get_methods();
273	my $url = $methods->{$method}
274	or die "no such method: $method\n";
275	return $url;
276	}
277
278	# Get $self->{account} with an error if we don't have one yet.
279	sub _account {
280	my ($self) = @_;
281	my $account = $self->{account}
282	// die "no account loaded\n";
283	return wantarray ? ($account, $self->{location}) : $account;
284	}
285
286	# debugging info
287	sub list_methods {
288	my ($self) = @_;
289	my $methods = $self->__get_methods();
290	if (my $meta = $methods->{meta}) {
291	print("(meta): $_ : $meta->{$_}\n") for sort keys %$meta;
292	}
293	print("$_ : $methods->{$_}\n") for sort grep {$_ ne 'meta'} keys %$methods;
294	}
295
296	# return (optional) meta directory entry.
297	# this is public because it might contain the ToS, which should be displayed
298	# and agreed to before creating an account
299	sub get_meta {
300	my ($self) = @_;
301	my $methods = $self->__get_methods();
302	return $methods->{meta};
303	}
304
305	# Common code between new_account and update_account
306	sub __new_account {
307	my ($self, $expected_code, $url, $new, %info) = @_;
308	my $req = {
309	%info,
310	};
311	my $r = $self->do(POST => $url, $req, $new);
312	eval {
313	my $account = __get_result($r, $expected_code);
314	if (!defined($self->{location})) {
315	my $account_url = $r->header('Location')
316	or die "did not receive an account URL\n";
317	$self->{location} = $account_url;
318	}
319	$self->{account} = $account;
320	$self->save();
321	};
322	$self->fatal("POST to '$url' failed - $@", $r) if $@;
323	return $self->{account};
324	}
325
326	# Create a new account using data in %info.
327	# Optionally pass $tos_url to agree to the given Terms of Service
328	# POST to newAccount endpoint
329	# Expects a '201 Created' reply
330	# Saves and returns the account data
331	sub new_account {
332	my ($self, $tos_url, %info) = @_;
333	my $url = $self->_method('newAccount');
334
335	if ($tos_url) {
336	$self->{tos} = $tos_url;
337	$info{termsOfServiceAgreed} = JSON::true;
338	}
339
340	return $self->__new_account(201, $url, 1, %info);
341	}
342
343	# Update existing account with new %info
344	# POST to account URL
345	# Expects a '200 OK' reply
346	# Saves and returns updated account data
347	sub update_account {
348	my ($self, %info) = @_;
349	my (undef, $url) = $self->_account;
350
351	return $self->__new_account(200, $url, 0, %info);
352	}
353
354	# Retrieves existing account information
355	# POST to account URL with empty body!
356	# Expects a '200 OK' reply
357	# Saves and returns updated account data
358	sub get_account {
359	my ($self) = @_;
360	return $self->update_account();
361	}
362
363	# Start a new order for one or more domains
364	# POST to newOrder endpoint
365	# Expects a '201 Created' reply
366	# returns order URL and parsed order object, including authorization and finalize URLs
367	sub new_order {
368	my ($self, $domains) = @_;
369
370	my $url = $self->_method('newOrder');
371	my $req = {
372	identifiers => [ map { { type => 'dns', value => $_ } } @$domains ],
373	};
374
375	my $r = $self->do(POST => $url, $req);
376	my ($order_url, $order);
377	eval {
378	$order_url = $r->header('Location')
379	or die "did not receive an order URL\n";
380	$order = __get_result($r, 201)
381	};
382	$self->fatal("POST to '$url' failed - $@", $r) if $@;
383	return ($order_url, $order);
384	}
385
386	# Finalize order after all challenges have been validated
387	# POST to order's finalize URL
388	# Expects a '200 OK' reply
389	# returns (potentially updated) order object
390	sub finalize_order {
391	my ($self, $order, $csr) = @_;
392
393	my $req = {
394	csr => encode($csr),
395	};
396	my $r = $self->do(POST => $order->{finalize}, $req);
397	my $return = eval { __get_result($r, 200); };
398	$self->fatal("POST to '$order->{finalize}' failed - $@", $r) if $@;
399	return $return;
400	}
401
402	# Get order status
403	# GET-as-POST to order URL
404	# Expects a '200 OK' reply
405	# returns order object
406	sub get_order {
407	my ($self, $order_url) = @_;
408	my $r = $self->do(POST => $order_url, '');
409	my $return = eval { __get_result($r, 200); };
410	$self->fatal("POST of '$order_url' failed - $@", $r) if $@;
411	return $return;
412	}
413
414	# Gets authorization object
415	# GET-as-POST to authorization URL
416	# Expects a '200 OK' reply
417	# returns authorization object, including challenges array
418	sub get_authorization {
419	my ($self, $auth_url) = @_;
420
421	my $r = $self->do(POST => $auth_url, '');
422	my $return = eval { __get_result($r, 200); };
423	$self->fatal("POST of '$auth_url' failed - $@", $r) if $@;
424	return $return;
425	}
426
427	# Deactivates existing authorization
428	# POST to authorization URL
429	# Expects a '200 OK' reply
430	# returns updated authorization object
431	sub deactivate_authorization {
432	my ($self, $auth_url) = @_;
433
434	my $req = {
435	status => 'deactivated',
436	};
437	my $r = $self->do(POST => $auth_url, $req);
438	my $return = eval { __get_result($r, 200); };
439	$self->fatal("POST to '$auth_url' failed - $@", $r) if $@;
440	return $return;
441	}
442
443	# Get certificate
444	# GET-as-POST to order's certificate URL
2307c38b	445	# if $root is specified, attempts to find a matching (alternate) chain
5460050d WL	446	# Expects a '200 OK' reply
	447	# returns certificate chain in PEM format
	448	sub get_certificate {
2307c38b	449	my ($self, $order, $root) = @_;
5460050d WL	450
	451	$self->fatal("no certificate URL available (yet?)", $order)
	452	if !$order->{certificate};
	453
2307c38b FG	454	my $check_root = sub {
	455	my ($chain) = @_;
	456
	457	my @certs = PVE::Certificate::split_pem($chain);
	458	my $root_pem = $certs[-1];
	459
	460	my ($file, $fh) = PVE::Tools::tempfile_contents($root_pem);
	461	my $info = PVE::Certificate::get_certificate_info($file);
	462
	463	return defined($info->{issuer}) && $info->{issuer} =~ m/\Q$root\E/i;
	464	};
	465
5460050d	466	my $r = $self->do(POST => $order->{certificate}, '');
a5320155	467	my $return = eval {
2307c38b	468	# default chain
a5320155	469	my $res = __get_result($r, 200, 1);
2307c38b FG	470	if ($root && !$check_root->($res)) {
	471	# alternate chains if requested and default didn't match
	472	$res = undef;
	473	my @links = $r->header('link');
	474	for my $link (@links) {
	475	if ($link =~ /^<(.*)>;rel="alternate"$/) {
	476	my $url = $1;
	477	my $chain = eval { __get_result($self->do(POST => $url, ''), 200, 1); };
	478	die "failed to retrieve alternate chain from '$url' - $@\n" if $@;
	479	if ($check_root->($chain)) {
	480	$res = $chain;
	481	last;
	482	}
	483	}
	484	}
	485	die "no matching alternate chain for '$root' returned by server\n"
	486	if !defined($res);
	487	}
	488
a5320155 SI	489	if ($res =~ /^(-----BEGIN CERTIFICATE-----)(.+)(-----END CERTIFICATE-----)$/s) { # untaint
	490	return $1 . $2 . $3;
	491	}
	492	die "Server reply does not look like a PEM encoded certificate\n";
	493	};
5460050d WL	494	$self->fatal("POST of '$order->{certificate}' failed - $@", $r) if $@;
	495	return $return;
	496	}
	497
	498	# Revoke given certificate
	499	# POST to revokeCert endpoint
	500	# currently only supports revokation with account key
	501	# $certificate can either be PEM or DER encoded
	502	# Expects a '200 OK' reply
	503	sub revoke_certificate {
	504	my ($self, $certificate, $reason) = @_;
	505
	506	my $url = $self->_method('revokeCert');
	507
	508	if ($certificate =~ /^-----BEGIN CERTIFICATE-----/) {
	509	$certificate = PVE::Certificate::pem_to_der($certificate);
	510	}
	511
	512	my $req = {
	513	certificate => encode($certificate),
	514	reason => $reason // 0,
	515	};
	516	# TODO: set use_jwk if revoking with certificate key
	517	my $r = $self->do(POST => $url, $req);
	518	eval {
	519	die "unexpected code $r->code\n" if $r->code != 200;
	520	};
	521	$self->fatal("POST to '$url' failed - $@", $r) if $@;
	522	}
	523
	524	# Request validation of challenge
	525	# POST to challenge URL
	526	# call after validation has been setup
	527	# returns (potentially updated) challenge object
	528	sub request_challenge_validation {
109fc3fd	529	my ($self, $url) = @_;
5460050d	530
109fc3fd	531	my $r = $self->do(POST => $url, {});
5460050d WL	532	my $return = eval { __get_result($r, 200); };
	533	$self->fatal("POST to '$url' failed - $@", $r) if $@;
	534	return $return;
	535	}
	536
	537	# actually 'do' a $method request on $url
	538	# $data: input for JWS, optional
	539	# $use_jwk: use JWK instead of KID in JWD (see sub jws)
	540	sub do {
	541	my ($self, $method, $url, $data, $use_jwk) = @_;
	542
	543	$self->fatal("Error: can't $method to empty URL") if !$url \|\| $url eq '';
	544
	545	my $headers = HTTP::Headers->new();
	546	$headers->header('Content-Type' => 'application/jose+json');
	547	my $content = defined($data) ? $self->jws($use_jwk, $data, $url) : undef;
	548	my $request;
	549	if (defined($content)) {
	550	$content = tojs($content);
	551	$request = HTTP::Request->new($method, $url, $headers, $content);
	552	} else {
	553	$request = HTTP::Request->new($method, $url, $headers);
	554	}
	555	my $res = $self->{ua}->request($request);
	556	if (!$res->is_success) {
	557	# check for nonce rejection
	558	if ($res->code == 400 && $res->decoded_content) {
	559	my $parsed_content = fromjs($res->decoded_content);
	560	if ($parsed_content->{type} eq 'urn:ietf:params:acme:error:badNonce') {
	561	warn("bad Nonce, retrying\n");
	562	$self->{nonce} = $res->header('Replay-Nonce');
	563	return $self->do($method, $url, $data, $use_jwk);
	564	}
	565	}
	566	$self->fatal("Error: $method to $url\n".$res->decoded_content, $res);
	567	}
	568	if (my $nonce = $res->header('Replay-Nonce')) {
	569	$self->{nonce} = $nonce;
	570	}
	571	return $res;
	572	}
	573
	574	1;