X-Git-Url: https://git.rapsys.eu/acme/blobdiff_plain/ea6cf63c91a3b7482193c9c7faf8a169fcdd05ea..e52d27fd32caf42240ec361ae4d8b407d13b3e53:/acme.pm?ds=sidebyside

diff --git a/acme.pm b/acme.pm
index b3629f9..6a17c3c 100644
--- a/acme.pm
+++ b/acme.pm
@@ -8,11 +8,12 @@ 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 DateTime;
 use Digest::SHA qw(sha256_base64);
 use Email::Valid;
 use File::Path qw(make_path);
@@ -23,8 +24,8 @@ 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);
+use Tie::IxHash;
 
 # Documentation links
 #XXX: see https://letsencrypt.github.io/acme-spec/ (probably based on https://ietf-wg-acme.github.io/acme/)
@@ -70,15 +71,15 @@ use constant {
 	ACME_TERMS => 'https://letsencrypt.org/documents/LE-SA-v1.0.1-July-27-2015.pdf',
 
 	# Version
-	VERSION => 'v0.3'
+	VERSION => 'v0.4',
+
+	# Config
+	CONFIG => '/etc/acmepl/config'
 };
 
 # User agent object
 our $ua;
 
-# Debug
-our $_debug = 0;
-
 # Strerr backup
 our $_stderr;
 
@@ -107,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 = {};
@@ -115,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';
 	}
 
@@ -165,14 +172,14 @@ sub new {
 
 # Prepare environement
 sub prepare {
-	my ($self, $prod) = @_;
+	my ($self) = @_;
 
 	# Create all paths
-	make_path(CERT_DIR, KEY_DIR, PENDING_DIR.'/'.$self->{mail}.'.'.($prod ? 'prod' : 'staging'), {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';
 	}
@@ -269,13 +276,13 @@ sub genCsr {
 
 # Directory call
 sub directory {
-	my ($self, $prod) = @_;
+	my ($self) = @_;
 
 	# Set time
 	my $time = time;
 
 	# Set directory
-	my $dir = $prod ? ACME_PROD_DIR : ACME_DIR;
+	my $dir = $self->{prod} ? ACME_PROD_DIR : ACME_DIR;
 
 	# Create a request
 	my $req = HTTP::Request->new(GET => $dir.'?'.$time);
@@ -356,11 +363,11 @@ sub _dnsCheck {
 
 	# Check if we get dns answer
 	unless(my $rep = $res->search($domain, 'TXT')) {
-		carp 'TXT record search for '.$domain.' failed' if ($_debug);
+		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 ($_debug);
+			carp 'TXT record recursive search for '.$domain.' failed' if ($self->{debug});
 			return;
 		}
 	}
@@ -375,18 +382,37 @@ sub _httpCheck {
 	# Create a request
 	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 http://'.$domain.'/.well-known/acme-challenge/'.$token.' 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 =~ /^$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 ($_debug);
+		carp 'GET http://'.$domain.'/.well-known/acme-challenge/'.$token.' content match failed: /^'.$token.'.'.$self->{account}{thumbprint}.'\s*$/ !~ '.$res->content if ($self->{debug});
 		return;
 	}
 
@@ -426,7 +452,7 @@ sub register {
 
 # Authorize domains
 sub authorize {
-	my ($self, $prod) = @_;
+	my ($self) = @_;
 
 	# Create challenges hash
 	%{$self->{challenges}} = ();
@@ -440,7 +466,7 @@ sub authorize {
 		my $content = undef;
 
 		# Init file
-		my $file = PENDING_DIR.'/'.$self->{mail}.'.'.($prod ? 'prod' : 'staging').'/'.$_;
+		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 ???
@@ -452,10 +478,9 @@ sub authorize {
 				# 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))
-			}
+				($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'});
@@ -502,8 +527,8 @@ sub authorize {
 				} elsif ($challenge->{status} eq 'pending') {
 					# Handle check
 					if (
-						($challenge->{type} =~ /^http-[0-9]+$/ and $self->_httpCheck($_, $challenge->{token})) or
-						($challenge->{type} =~ /^dns-[0-9]+$/ and $self->_dnsCheck($_, $challenge->{token}))
+						($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}});
@@ -528,11 +553,18 @@ sub authorize {
 								poll => $content->{uri}
 							});
 						}
-					# Print http help
-					} elsif ($challenge->{type} =~ /^http-[0-9]+$/) {
+					}
+				}
+			}
+			# 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";
-					# Print dns help
-					} elsif ($challenge->{type} =~ /^dns-[0-9]+$/) {
+					# 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";
 					}
 				}
@@ -562,7 +594,7 @@ sub authorize {
 
 				# Handle error
 				unless ($res->is_success) {
-					carp 'GET '.$self->{challenges}{$_}{http_challenge}.' failed: '.$res->status_line if ($_debug);
+					carp 'GET '.$self->{challenges}{$_}{http_challenge}.' failed: '.$res->status_line if ($self->{debug});
 				}
 
 				# Extract content
@@ -576,6 +608,25 @@ sub authorize {
 		} 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 
@@ -591,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;
 		}
@@ -617,6 +669,7 @@ sub issue {
 
 	# Handle error
 	unless ($res->is_success) {
+		#print Dumper($res);
 		confess 'POST '.$self->{'new-cert'}.' failed: '.$res->status_line;
 	}
 
@@ -634,7 +687,7 @@ sub issue {
 
 	# Handle error
 	unless ($res->is_success) {
-		carp 'GET '.ACME_CERT.' failed: '.$res->status_line if ($_debug);
+		carp 'GET '.ACME_CERT.' failed: '.$res->status_line if ($self->{debug});
 	}
 
 	# Append content
@@ -644,7 +697,7 @@ sub issue {
 	close($fh) or die $!;
 
 	# Print success
-	carp 'Success, pem certificate in '.CERT_DIR.DS.SERVER_CRT if ($_debug);
+	carp 'Success, pem certificate in '.CERT_DIR.DS.SERVER_CRT if ($self->{debug});
 }
 
 1;