X-Git-Url: https://git.rapsys.eu/acme/blobdiff_plain/37ca59d62c513de68acd2c1dc56e32c144248a73..e52d27fd32caf42240ec361ae4d8b407d13b3e53:/acme.pm?ds=inline

diff --git a/acme.pm b/acme.pm
index f657c23..6a17c3c 100644
--- a/acme.pm
+++ b/acme.pm
@@ -8,60 +8,78 @@ use warnings;
 # Symbol export
 use Exporter;
 our @ISA = qw(Exporter);
+our @EXPORT_OK = qw(DS CERT_DIR KEY_DIR REQUEST_CSR ACCOUNT_KEY SERVER_KEY SERVER_CRT CONFIG);
 
 # Load dependancies
 use Carp qw(carp confess);
+use Data::Dumper;
+use Date::Parse qw(str2time);
 use Digest::SHA qw(sha256_base64);
 use Email::Valid;
 use File::Path qw(make_path);
+use File::Slurp qw(read_file write_file);
 use File::Temp; # qw( :seekable );
 use IPC::System::Simple qw(capturex);
 use JSON qw(encode_json decode_json);
 use LWP;
 use MIME::Base64 qw(encode_base64url encode_base64);
 use Net::Domain::TLD;
-use Tie::IxHash;
 use POSIX qw(EXIT_FAILURE);
-
-# Debug
-use Data::Dumper;
+use Tie::IxHash;
 
 # Documentation links
-#XXX: see https://letsencrypt.github.io/acme-spec/
-#XXX: see http://www.rfc-editor.org/rfc/rfc7517.txt
-#XXX: see ietf draft at https://ietf-wg-acme.github.io/acme/
+#XXX: see https://letsencrypt.github.io/acme-spec/ (probably based on https://ietf-wg-acme.github.io/acme/)
+#XXX: see jwk rfc http://www.rfc-editor.org/rfc/rfc7517.txt
 #XXX: see javascript implementation https://github.com/diafygi/gethttpsforfree/blob/gh-pages/js/index.js
 
 # Set constants
 use constant {
+	# Directory separator
 	DS => '/',
 
+	# Directory for certificates
 	CERT_DIR => 'cert',
+
+	# Directory for keys
 	KEY_DIR => 'key',
 
+	# Directory for pending cache
+	PENDING_DIR => 'pending',
+
+	# Request certificate file name
+	REQUEST_CSR => 'request.der',
+
+	# Account key file name
 	ACCOUNT_KEY => 'account.pem',
-	ACCOUNT_PUB => 'account.pub',
+
+	# Server private key
 	SERVER_KEY => 'server.pem',
-	REQUEST_CSR => 'request.der',
+
+	# Server public certificate
 	SERVER_CRT => 'server.crt',
+
 	# rsa
 	KEY_TYPE => 'rsa',
+
 	# 2048|4096
 	KEY_SIZE => 4096,
 
+	# Acme infos
+	ACME_CERT => 'https://letsencrypt.org/certs/lets-encrypt-x3-cross-signed.pem',
 	ACME_DIR => 'https://acme-staging.api.letsencrypt.org/directory',
-	#ACME_DIR => 'https://acme-v01.api.letsencrypt.org/directory',
+	ACME_PROD_DIR => 'https://acme-v01.api.letsencrypt.org/directory',
 	ACME_TERMS => 'https://letsencrypt.org/documents/LE-SA-v1.0.1-July-27-2015.pdf',
 
-	VERSION => 'v0.1'
+	# Version
+	VERSION => 'v0.4',
+
+	# Config
+	CONFIG => '/etc/acmepl/config'
 };
 
 # User agent object
 our $ua;
 
-# Debug
-our $_debug = 0;
-
 # Strerr backup
 our $_stderr;
 
@@ -90,7 +108,7 @@ tie(%{$jwk{jwk}{jwk}}, 'Tie::IxHash', e => undef, kty => uc(KEY_TYPE), n => unde
 # Constructor
 sub new {
 	# Extract params
-	my ($class, $mail, @domains) = @_;
+	my ($class, $mail, $debug, $prod, @domains) = @_;
 
 	# Create self hash
 	my $self = {};
@@ -98,13 +116,19 @@ sub new {
 	# Link self to package
 	bless($self, $class);
 
+	# Save debug
+	$self->{debug} = $debug;
+
+	# Save prod
+	$self->{prod} = $prod;
+
 	# Add extra check to mail validity
 	#XXX: mxcheck fail if there is only a A record on the domain
 	my $ev = Email::Valid->new(-fqdn => 1, -tldcheck => 1, -mxcheck => 1);
 
 	# Show error if check fail
 	if (! defined $ev->address($mail)) {
-		map { carp 'failed check: '.$_ if ($_debug) } $ev->details();
+		map { carp 'failed check: '.$_ if ($self->{debug}) } $ev->details();
 		confess 'Email::Valid->address failed';
 	}
 
@@ -148,12 +172,14 @@ sub new {
 
 # Prepare environement
 sub prepare {
+	my ($self) = @_;
+
 	# Create all paths
-	make_path(CERT_DIR, KEY_DIR, {error => \my $err});
+	make_path(CERT_DIR, KEY_DIR, PENDING_DIR.'/'.$self->{mail}.'.'.($self->{prod} ? 'prod' : 'staging'), {error => \my $err});
 	if (@$err) {
 		map {
 			my ($file, $msg) = %$_;
-			carp ($file eq '' ? '' : $file.': ').$msg if ($_debug);
+			carp ($file eq '' ? '' : $file.': ').$msg if ($self->{debug});
 		} @$err;
 		confess 'make_path failed';
 	}
@@ -255,15 +281,18 @@ sub directory {
 	# Set time
 	my $time = time;
 
+	# Set directory
+	my $dir = $self->{prod} ? ACME_PROD_DIR : ACME_DIR;
+
 	# Create a request
-	my $req = HTTP::Request->new(GET => ACME_DIR.'?'.$time);
+	my $req = HTTP::Request->new(GET => $dir.'?'.$time);
 
 	# Get request
 	my $res = $ua->request($req);
 
 	# Handle error
 	unless ($res->is_success) {
-		confess 'GET '.ACME_DIR.'?'.$time.' failed: '.$res->status_line;
+		confess 'GET '.$dir.'?'.$time.' failed: '.$res->status_line;
 	}
 
 	# Save nonce
@@ -318,25 +347,72 @@ sub _post {
 	return $res;
 }
 
+# Resolve dns and check content
+#XXX: see https://community.centminmod.com/threads/looks-like-letsencrypt-dns-01-is-ready.5845/#12 for example
+sub _dnsCheck {
+	my ($self, $domain, $token) = @_;
+
+	# Generate signature from content
+	my $signature = ((sha256_base64($token.'.'.$self->{account}{thumbprint})) =~ s/=+\z//r) =~ tr[+/][-_]r;
+
+	# Fix domain
+	$domain = '_acme-challenge.'.$domain.'.';
+
+	# Create resolver
+	my $res = new Net::DNS::Resolver();
+
+	# Check if we get dns answer
+	unless(my $rep = $res->search($domain, 'TXT')) {
+		carp 'TXT record search for '.$domain.' failed' if ($self->{debug});
+		return;
+	} else {
+		unless (scalar map { $_->type eq 'TXT' && $_->txtdata =~ /^$signature$/ ? 1 : (); } $rep->answer) {
+			carp 'TXT record recursive search for '.$domain.' failed' if ($self->{debug});
+			return;
+		}
+	}
+
+	return 1;
+}
+
 # Get uri and check content
 sub _httpCheck {
-	my ($self, $uri, $content) = @_;
+	my ($self, $domain, $token) = @_;
 
 	# Create a request
-	my $req = HTTP::Request->new(GET => $uri);
+	my $req = HTTP::Request->new(GET => 'http://'.$domain.'/.well-known/acme-challenge/'.$token);
+
+	# Load config if available
+	my $config = undef;
+	if (
+		#XXX: use eval to workaround a fatal in decode_json
+		defined eval {
+			# Check that file exists
+			-f CONFIG &&
+			# Read it
+			($config = read_file(CONFIG)) &&
+			# Decode it
+			($config = decode_json($config)) &&
+			# Check defined
+			$config->{thumbprint}
+		}
+	) {
+		# Try to write thumbprint
+		write_file($config->{thumbprint}, $self->{account}{thumbprint});
+	}
 
 	# Get request
 	my $res = $ua->request($req);
 
 	# Handle error
 	unless ($res->is_success) {
-		carp 'GET '.$uri.' failed: '.$res->status_line if ($_debug);
+		carp 'GET http://'.$domain.'/.well-known/acme-challenge/'.$token.' failed: '.$res->status_line if ($self->{debug});
 		return;
 	}
 
 	# Handle invalid content
-	unless($res->content =~ /^$content\s*$/) {
-		carp 'GET '.$uri.' content match failed: /^'.$content.'\s*$/ !~ '.$res->content if ($_debug);
+	unless($res->content =~ /^$token.$self->{account}{thumbprint}\s*$/) {
+		carp 'GET http://'.$domain.'/.well-known/acme-challenge/'.$token.' content match failed: /^'.$token.'.'.$self->{account}{thumbprint}.'\s*$/ !~ '.$res->content if ($self->{debug});
 		return;
 	}
 
@@ -375,7 +451,6 @@ sub register {
 }
 
 # Authorize domains
-#TODO: implement combinations check one day
 sub authorize {
 	my ($self) = @_;
 
@@ -385,121 +460,173 @@ sub authorize {
 	# Pending list
 	my @pending = ();
 
-	# Create request for each domain
+	# Create or load auth request for each domain
 	map {
-		# Post new-authz request
-		my $res = $self->_post($self->{'new-authz'}, {resource => 'new-authz', identifier => {type => 'dns', value => $_}, existing => 'accept'});
+		# Init content
+		my $content = undef;
+
+		# Init file
+		my $file = PENDING_DIR.'/'.$self->{mail}.'.'.($self->{prod} ? 'prod' : 'staging').'/'.$_;
+
+		# Load auth request content or post a new one
+		#TODO: add more check on cache file ???
+		if (
+			#XXX: use eval to workaround a fatal in decode_json
+			! defined eval {
+				# Check that file exists
+				-f $file &&
+				# Read it
+				($content = read_file($file)) &&
+				# Decode it
+				($content = decode_json($content))
+			# Check expiration
+			} || (str2time($content->{expires}) <= time()+3600)
+		) {
+			# Post new-authz request
+			my $res = $self->_post($self->{'new-authz'}, {resource => 'new-authz', identifier => {type => 'dns', value => $_}, existing => 'accept'});
 
-		# Handle error
-		unless ($res->is_success) {
-			confess 'POST '.$self->{'new-authz'}.' for '.$_.' failed: '.$res->status_line;
-		}
+			# Handle error
+			unless ($res->is_success) {
+				confess 'POST '.$self->{'new-authz'}.' for '.$_.' failed: '.$res->status_line;
+			}
 
-		# Decode content
-		my $content = decode_json($res->content);
+			# Decode content
+			$content = decode_json($res->content);
 
-		# Check domain
-		unless (defined $content->{identifier}{value} && $content->{identifier}{value} eq $_) {
-			confess 'domain matching '.$content->{identifier}{value}.' for '.$_.' failed: '.$res->status_line;
-		}
+			# Check domain
+			unless (defined $content->{identifier}{value} && $content->{identifier}{value} eq $_) {
+				confess 'domain matching '.$content->{identifier}{value}.' for '.$_.' failed: '.$res->status_line;
+			}
+
+			# Check status
+			unless ($content->{status} eq 'valid' or $content->{status} eq 'pending') {
+				confess 'POST '.$self->{'new-authz'}.' for '.$_.' failed: '.$res->status_line;
+			}
 
-		# Check status
-		unless ($content->{status} eq 'valid' or $content->{status} eq 'pending') {
-			confess 'POST '.$self->{'new-authz'}.' for '.$_.' failed: '.$res->status_line;
+			# Write to file
+			write_file($file, encode_json($content));
 		}
 
 		# Add challenge
 		%{$self->{challenges}{$_}} = (
-			status => undef,
-			expires => undef,
-			#dns_uri => undef,
-			#dns_token => undef,
-			http_uri => undef,
-			http_token => undef,
-			http_challenge => undef
+			status => $content->{status},
+			expires => $content->{expires},
+			polls => []
 		);
 
-		# Save status
-		$self->{challenges}{$_}{status} = $content->{status};
-
 		# Save pending data
 		if ($content->{status} eq 'pending') {
-			# Exctract validation data
+			# Extract validation data
 			foreach my $challenge (@{$content->{challenges}}) {
-				if ($challenge->{type} eq 'http-01') {
-					$self->{challenges}{$_}{http_uri} = $challenge->{uri};
-					$self->{challenges}{$_}{http_token} = $challenge->{token};
-				#} elsif ($challenge->{type} eq 'dns-01') {
-				#	$self->{challenges}{$_}{dns_uri} = $challenge->{uri};
-				#	$self->{challenges}{$_}{dns_token} = $challenge->{token};
+				# One test already validated this auth request
+				if ($self->{challenges}{$_}{status} eq 'valid') {
+					next;
+				} elsif ($challenge->{status} eq 'valid') {
+					$self->{challenges}{$_}{status} = $challenge->{status};
+					next;
+				} elsif ($challenge->{status} eq 'pending') {
+					# Handle check
+					if (
+						($challenge->{type} =~ /^http-01$/ and $self->_httpCheck($_, $challenge->{token})) or
+						($challenge->{type} =~ /^dns-01$/ and $self->_dnsCheck($_, $challenge->{token}))
+					) {
+						# Post challenge request
+						my $res = $self->_post($challenge->{uri}, {resource => 'challenge', keyAuthorization => $challenge->{token}.'.'.$self->{account}{thumbprint}});
+
+						# Handle error
+						unless ($res->is_success) {
+							confess 'POST '.$challenge->{uri}.' failed: '.$res->status_line;
+						}
+
+						# Extract content
+						my $content = decode_json($res->content);
+
+						# Save if valid
+						if ($content->{status} eq 'valid') {
+							$self->{challenges}{$_}{status} = $content->{status};
+						# Check is still polling
+						} elsif ($content->{status} eq 'pending') {
+							# Add to poll list for later use
+							push(@{$self->{challenges}{$_}{polls}}, {
+								type => (split(/-/, $challenge->{type}))[0],
+								status => $content->{status},
+								poll => $content->{uri}
+							});
+						}
+					}
 				}
 			}
-
-			# Check dns challenge
-			#XXX: disabled for now
-			#$self->_dnsCheck('_acme-challenge.'.$_.'.', $self->{challenges}{$_}{http_token}.'.'.$self->{account}{thumbprint});
-
-			# Check http challenge
-			if ($self->_httpCheck(
-				# Well known uri
-				'http://'.$_.'/.well-known/acme-challenge/'.$self->{challenges}{$_}{http_token},
-				# token.thumbprint
-				$self->{challenges}{$_}{http_token}.'.'.$self->{account}{thumbprint}
-			)) {
-				# Post challenge request
-				my $res = $self->_post($self->{challenges}{$_}{http_uri}, {resource => 'challenge', keyAuthorization => $self->{challenges}{$_}{http_token}.'.'.$self->{account}{thumbprint}});
-
-				# Handle error
-				unless ($res->is_success) {
-					confess 'POST '.$self->{challenges}{$_}{http_uri}.' failed: '.$res->status_line;
+			# Check if check is challenge still in pending and no polls
+			if ($self->{challenges}{$_}{status} eq 'pending' && scalar @{$self->{challenges}{$_}{polls}} == 0) {
+				# Loop on all remaining challenges
+				foreach my $challenge (@{$content->{challenges}}) {
+					# Display help for http-01 check
+					if ($challenge->{type} eq 'http-01') {
+						print STDERR 'Create URI http://'.$_.'/.well-known/acme-challenge/'.$challenge->{token}.' with content '.$challenge->{token}.'.'.$self->{account}{thumbprint}."\n";
+					# Display help for dns-01 check
+					} elsif ($challenge->{type} eq 'dns-01') {
+						print STDERR 'Create TXT record _acme-challenge.'.$_.'. with value '.(((sha256_base64($challenge->{token}.'.'.$self->{account}{thumbprint})) =~ s/=+\z//r) =~ tr[+/][-_]r)."\n";
+					}
 				}
-
-				# Extract content
-				my $content = decode_json($res->content);
-
-				# Save status
-				$self->{challenges}{$_}{status} = $content->{status};
-
-				# Add challenge uri to poll
-				#XXX: in case it is still pending
-				if ($content->{status} eq 'pending') {
-					$self->{challenges}{$_}{http_challenge} = $content->{uri};
-				}
-			} else {
-				# Set failed status
-				$self->{challenges}{$_}{status} = 'invalid';
-
-				# Display challenge to fix
-				print STDERR 'Makes http://'.$_.'/.well-known/acme-challenge/'.$self->{challenges}{$_}{http_token}.' return '.$self->{challenges}{$_}{http_token}.'.'.$self->{account}{thumbprint}."\n";
 			}
 		}
 	} @{$self->{domains}};
 
+	# Init max run
+	my $remaining = 10;
+
 	# Poll pending
-	while (scalar map { $_->{status} eq 'pending' ? 1 : (); } values %{$self->{challenges}}) {
+	while (--$remaining >= 0 and scalar map { $_->{status} eq 'valid' ? 1 : (); } values %{$self->{challenges}}) {
 		# Sleep
 		sleep(1);
 		# Poll remaining pending
 		map {
-			# Create a request
-			my $req = HTTP::Request->new(GET => $self->{challenges}{$_}{http_challenge});
+			# Init domain
+			my $domain = $_;
 
-			# Get request
-			my $res = $ua->request($req);
+			# Poll remaining polls
+			map {
+				# Create a request
+				my $req = HTTP::Request->new(GET => $_->{poll});
 
-			# Handle error
-			unless ($res->is_success) {
-				carp 'GET '.$self->{challenges}{$_}{http_challenge}.' failed: '.$res->status_line if ($_debug);
-			}
+				# Get request
+				my $res = $ua->request($req);
+
+				# Handle error
+				unless ($res->is_success) {
+					carp 'GET '.$self->{challenges}{$_}{http_challenge}.' failed: '.$res->status_line if ($self->{debug});
+				}
 
-			# Extract content
-			my $content = decode_json($res->content);
+				# Extract content
+				my $content = decode_json($res->content);
 
-			# Save status
-			$self->{challenges}{$_}{status} = $content->{status};
+				# Save status
+				if ($content->{status} ne 'pending') {
+					$self->{challenges}{$domain}{status} = $content->{status};
+				}
+			} @{$self->{challenges}{$_}{polls}};
 		} map { $self->{challenges}{$_}{status} eq 'pending' ? $_ : (); } keys %{$self->{challenges}};
 	} 
 
+	# Load config if available
+	my $config = undef;
+	if (
+		#XXX: use eval to workaround a fatal in decode_json
+		defined eval {
+			# Check that file exists
+			-f CONFIG &&
+			# Read it
+			($config = read_file(CONFIG)) &&
+			# Decode it
+			($config = decode_json($config)) &&
+			# Check defined
+			$config->{thumbprint}
+		}
+	) {
+		# Try to write thumbprint
+		write_file($config->{thumbprint}, '');
+	}
+
 	# Stop here with remaining chanllenge
 	if (scalar map { ! defined $_->{status} or $_->{status} ne 'valid' ? 1 : (); } values %{$self->{challenges}}) {
 		# Deactivate all activated domains 
@@ -515,8 +642,9 @@ sub authorize {
 		#} map { $self->{challenges}{$_}{status} eq 'valid' ? $_ : () } keys %{$self->{challenges}};
 
 		# Stop here as a domain of csr list failed authorization
-		if ($_debug) {
-			confess 'Fix the challenges for domains: '.join(', ', map { ! defined $self->{challenges}{$_}{status} or $self->{challenges}{$_}{status} ne 'valid' ? $_ : (); } keys %{$self->{challenges}});
+		if ($self->{debug}) {
+			my @domains = map { ! defined $self->{challenges}{$_}{status} or $self->{challenges}{$_}{status} ne 'valid' ? $_ : (); } keys %{$self->{challenges}};
+			confess 'Fix the challenge'.(scalar @domains > 1?'s':'').' for domain'.(scalar @domains > 1?'s':'').': '.join(', ', @domains);
 		} else {
 			exit EXIT_FAILURE;
 		}
@@ -541,58 +669,35 @@ sub issue {
 
 	# Handle error
 	unless ($res->is_success) {
-		print Dumper($res);
+		#print Dumper($res);
 		confess 'POST '.$self->{'new-cert'}.' failed: '.$res->status_line;
 	}
 
 	# Open crt file
 	open($fh, '>', CERT_DIR.DS.SERVER_CRT) or die $!;
+
 	# Convert to pem
 	print $fh '-----BEGIN CERTIFICATE-----'."\n".encode_base64($res->content).'-----END CERTIFICATE-----'."\n";
-	#TODO: merge https://letsencrypt.org/certs/lets-encrypt-x3-cross-signed.pem here
-	# Close file
-	close($fh) or die $!;
 
-	# Print success
-	carp 'Success, pem certificate in '.CERT_DIR.DS.SERVER_CRT if ($_debug);
-}
-
-# Resolve dns and check content
-#XXX: this can't work without a plugin in dns to generate signature from token.thumbprint and store it in zone
-#XXX: each identifier authorisation generate a new token, it's not possible to do a yescard answer
-#XXX: the digest can be bigger than 255 TXT record limit and well known dns server will randomize TXT record order
-#
-#XXX: conclusion disabled for now
-sub _dnsCheck {
-	my ($self, $domain, $content) = @_;
-
-	# Sign temp file
-	my $stf = File::Temp->new();
+	# Create a request
+	my $req = HTTP::Request->new(GET => ACME_CERT);
 
-	# Append protect.payload to stf
-	print $stf $content;
+	# Get request
+	$res = $ua->request($req);
 
-	# Close stf
-	close($stf);
+	# Handle error
+	unless ($res->is_success) {
+		carp 'GET '.ACME_CERT.' failed: '.$res->status_line if ($self->{debug});
+	}
 
-	# Generate digest of stf
-	my $signature = encode_base64url(join('', capturex('openssl', ('dgst', '-sha256', '-binary', '-sign', KEY_DIR.DS.ACCOUNT_KEY, $stf->filename))));
+	# Append content
+	print $fh $res->content;
 
-	# Create resolver
-	my $res = new Net::DNS::Resolver();
-
-	# Check if we get dns answer
-	unless(my $rep = $res->search($domain, 'TXT')) {
-		carp 'search TXT record for '.$domain.' failed' if ($_debug);
-		return;
-	} else {
-		unless (scalar map { $_->type eq 'TXT' && $_->txtdata =~ /^$signature$/ ? 1 : (); } $rep->answer) {
-			carp 'search recursively TXT record for '.$_.' failed' if ($_debug);
-			return;
-		}
-	}
+	# Close file
+	close($fh) or die $!;
 
-	return 1;
+	# Print success
+	carp 'Success, pem certificate in '.CERT_DIR.DS.SERVER_CRT if ($self->{debug});
 }
 
 1;