From 16f7acab036cbe9ba660eb0ff867551b866030b9 Mon Sep 17 00:00:00 2001
From: =?utf8?q?Rapha=C3=ABl=20Gertz?= <git@rapsys.eu>
Date: Wed, 21 Sep 2016 02:32:59 +0200
Subject: [PATCH 1/1] Add caching of challenges

---
 acme.pm | 143 +++++++++++++++++++++++++++++++++++---------------------
 1 file changed, 90 insertions(+), 53 deletions(-)

diff --git a/acme.pm b/acme.pm
index e44c341..dcfabf3 100644
--- a/acme.pm
+++ b/acme.pm
@@ -11,9 +11,12 @@ our @ISA = qw(Exporter);
 
 # Load dependancies
 use Carp qw(carp confess);
+use Date::Parse qw(str2time);
+use DateTime;
 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);
@@ -37,6 +40,7 @@ use constant {
 
 	CERT_DIR => 'cert',
 	KEY_DIR => 'key',
+	PENDING_DIR => 'pending',
 
 	ACCOUNT_KEY => 'account.pem',
 	ACCOUNT_PUB => 'account.pub',
@@ -147,8 +151,10 @@ 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}, {error => \my $err});
 	if (@$err) {
 		map {
 			my ($file, $msg) = %$_;
@@ -386,33 +392,58 @@ sub authorize {
 
 	# Create 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}.'/'.$_;
+
+		# Load in content domain data or post a new authz request
+		#TODO: add 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
+				(DateTime->from_epoch(epoch => str2time($content->{expires})) >= DateTime->now()->add(hours => 1))
+			}
+		) {
+			# 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,
+			dns_uri => undef,
+			dns_token => undef,
 			http_uri => undef,
 			http_token => undef,
 			http_challenge => undef
@@ -423,14 +454,17 @@ sub authorize {
 
 		# Save pending data
 		if ($content->{status} eq 'pending') {
+			#XXX: debug
+			print Dumper($content);
+
 			# Exctract 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};
+				} elsif ($challenge->{type} eq 'dns-01') {
+					$self->{challenges}{$_}{dns_uri} = $challenge->{uri};
+					$self->{challenges}{$_}{dns_token} = $challenge->{token};
 				}
 			}
 
@@ -439,41 +473,44 @@ sub authorize {
 			#$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;
-				}
-
-				# 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";
-			}
+#			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;
+#				}
+#
+#				# 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}};
 
+	#XXX: debug
+	exit EXIT_FAILURE;
+
 	# Poll pending
 	while (scalar map { $_->{status} eq 'pending' ? 1 : (); } values %{$self->{challenges}}) {
 		# Sleep
-- 
2.41.1