#!/usr/bin/env perl
# This is a simplified rewrite of acme-tiny in Perl, since Python 3 is 125 MiB
# but Perl is everywhere and JSON::PP mostly in default installations.
# Depends on curl and openssl.
#
# TODO: eventually the ACME protocol will stabilize:
#   https://github.com/ietf-wg-acme/acme/blob/master/draft-ietf-acme-acme.md
use strict;
use warnings;
use MIME::Base64 qw(encode_base64 encode_base64url);
use JSON::PP;
use Digest::SHA qw(sha256);
use IPC::Open2;

# https://acme-staging.api.letsencrypt.org
# https://acme-v01.api.letsencrypt.org
my $ca          = $ENV{ACME_CA}     || die 'ACME_CA not set';
my $account_key = $ENV{ACCOUNT_KEY} || die 'ACCOUNT_KEY not set';
my $csr_file    = shift             || die 'no file was given';
my $acme_dir    = $ENV{ACME_DIR}    || die 'ACME_DIR not set';

# Prepare some values derived from account key for the ACME protocol
sub b64 { encode_base64url(shift, '') =~ s/=//gr }
my $key_info = `openssl rsa -in '$account_key' -noout -text`;
die 'cannot process account key' if $?;

my ($pub_hex, $pub_exp) =
	$key_info =~ /modulus:\n\s+00:([a-f\d:\s]+?)\npublicExponent: (\d+)/m;
$pub_exp = sprintf("%x", $pub_exp);
$pub_exp = "0$pub_exp" if length($pub_exp) % 2;

my $header = { alg => 'RS256', jwk => { kty => 'RSA',
	e => b64(pack 'H*', $pub_exp),
	n => b64(pack 'H*', $pub_hex =~ s/\s|://gr)
}};

my $json = JSON::PP->new->pretty(0)->canonical(1);
my $thumbprint = b64(sha256($json->encode($header->{jwk})));

# Pipe data through an external program, keeping status in $?
sub communicate {
	my $data = pop;
	my $pid = open2(\*Reader, \*Writer, @_);
	print Writer $data if defined($data);
	close Writer;
	local $/ = undef;
	my $resp = <Reader>;
	waitpid $pid, 0;
	return $resp;
}

# Use cURL to download a file over HTTPS but parse it ourselves (quite silly)
sub get {
	my ($url, $data) = @_;
	my @args = ('curl', '-sS', '-D-', '-H', 'Expect:');
	push @args, ('-X', 'POST', '--data-binary', '@-') if defined($data);
	my $resp = communicate(@args, $url, $data);
	die 'cannot download' if $? >> 8;
	my ($code, $headers, $body) =
		$resp =~ m#\AHTTP/\d(?:\.\d)? (\d+) .*?\r\n(.*?)\r\n\r\n(.*)#sm;
	return ($code, $body, { $headers =~ /(\S+?): (.*)\r\n/mg })
}

# Make a signed request to an ACME endpoint
sub send_signed {
	my ($url, $payload) = @_;
	my $protected = { nonce => `curl -sSfI '$ca/directory'`
		=~ /Replay-Nonce: (\S+)/i, %$header };
	die 'cannot retrieve nonce' if $?;

	my $b64payload = b64 $json->encode($payload);
	my $b64protected = b64 $json->encode($protected);
	my $out = communicate('openssl', 'dgst', '-sha256', '-sign',
		$account_key, "$b64protected.$b64payload");
	die 'cannot sign request' if $? >> 8;
	return get $url, $json->encode({
		header => $header, protected => $b64protected,
		payload => $b64payload, signature => b64 $out
	})
}

# Find all domains specified in the certificate request
my $csr = `openssl req -in '$csr_file' -noout -text`;
die 'cannot parse CSR' if $?;

my @domains;
push @domains, $1 if $csr =~ /Subject:.*? CN *= *([^\s,;\/]+)/;
# FIXME: this may not parse correctly anymore, try it out
push @domains, map { substr $_, 4 } grep { /^DNS:/ } split(/, /)
	for $csr =~ /X509v3 Subject Alternative Name: \n +([^\n]+)\n/g;

# Get certificate domains and expiration
my ($code, $result, $headers) = get "$ca/terms";
($code, $result) = send_signed("$ca/acme/new-reg", {
	resource => 'new-reg',
	agreement => ($code == 302 && exists $headers->{Location})
		? $headers->{Location}
		: 'https://letsencrypt.org/documents/LE-SA-v1.1.1-August-1-2016.pdf'
});
die "cannot register: $code\n$result" if $code != 201 && $code != 409;

# Check if the file is really there, submit an HTTP challenge and wait
sub verify_http {
	my ($checked_url, $key_auth, $challenge_uri) = @_;
	my ($code, $result) = get $checked_url;
	die "checking $checked_url failed: $code" if $code != 200;
	die 'challenge contents differ' if $result ne $key_auth;

	($code, $result) = send_signed($challenge_uri, {
		resource => 'challenge', keyAuthorization => $key_auth
	});
	die "challenge submission failed: $code\n$result" if $code != 202;

	while (1) {
		($code, $result) = get $challenge_uri;
		die "challenge verification failed: $code\n$result" if $code >= 400;
		my $status = $json->decode($result);
		if ($status->{status} eq 'valid') {
			last;
		} elsif ($status->{status} eq 'pending') {
			sleep 1;
		} else {
			die "challenge verification failed: $result";
		}
	}
}

for my $domain (@domains) {
	my ($code, $result) = send_signed("$ca/acme/new-authz", {
		resource => 'new-authz',
		identifier => { type => 'dns', value => $domain }
	});
	die "cannot request challenge: $code\n$result" if $code != 201;

	my ($challenge) = grep { $_->{type} eq 'http-01' }
		@{$json->decode($result)->{challenges}};
	my $token = $challenge->{token} =~ s/[^A-Za-z0-9_-]/_/gr;
	my $key_auth = "$token.$thumbprint";
	my $known_path = "$acme_dir/$token";

	open(my $fh, '>', $known_path) or die "cannot write to $known_path: $!";
	print $fh $key_auth;
	close $fh;

	eval { verify_http("http://$domain/.well-known/acme-challenge/$token",
		$key_auth, $challenge->{uri}) };

	unlink $known_path;
	die "$domain: $@" if $@;
}

# Get the new certificate and convert it to the PEM format
my $der = `openssl req -in '$csr_file' -outform DER`;
die 'cannot convert CSR' if $?;
($code, $result) = send_signed("$ca/acme/new-cert", {
	resource => 'new-cert', csr => b64 $der
});
die "cannot sign certificate: $code\n$result" if $code != 201;

my $pem = join("\n", unpack '(A64)*', encode_base64($result, ''));
print "-----BEGIN CERTIFICATE-----\n$pem\n-----END CERTIFICATE-----\n";