From: Raphaël Gertz <git@rapsys.eu>
Date: Thu, 11 Sep 2025 05:00:57 +0000 (+0200)
Subject: Add asynch request support
X-Git-Url: https://git.rapsys.eu/acme/commitdiff_plain/94acb555f31af65b1a2f918ebcc24dc1e71e81ce

Add asynch request support
Add shortlived certificate support
(should be available in letsencrypt production in late 2025)
Add note about certificate expiration requiring an update
Add early retry after support
---

diff --git a/Acme.pm b/Acme.pm
index 2360380..9388e5d 100644
--- a/Acme.pm
+++ b/Acme.pm
@@ -32,6 +32,7 @@ our @EXPORT_OK = qw(ACCOUNT CONFIG MAIL PENDING TERM THUMBPRINT VERSION);
 
 # Load dependancies
 use Carp qw(carp confess);
+use Data::Validate::IP qw(is_public_ip is_public_ipv6);
 use Date::Parse qw(str2time);
 use DateTime;
 use Digest::SHA qw(sha256_base64);
@@ -58,6 +59,13 @@ use Tie::IxHash;
 #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
+#XXX: see https://www.rfc-editor.org/rfc/rfc8555.html
+
+# Todo list
+#TODO: try to drop retry code in _post, asynch answer may obsolete it
+#TODO: cleanup challenge verification code ?
+#TODO: verify that shortlived certificates get renewed in time
+#TODO: try to drop mail address from newAccount, unused by letsencrypt now ?
 
 # Set constants
 use constant {
@@ -66,7 +74,7 @@ use constant {
 	CONFIG => '/etc/acme/config',
 	PENDING => '/tmp/acme',
 	THUMBPRINT => '/etc/acme/thumbprint',
-	TERM => 'https://letsencrypt.org/documents/LE-SA-v1.3-September-21-2022.pdf',
+	TERM => 'https://letsencrypt.org/documents/LE-SA-v1.5-February-24-2025.pdf',
 	MAIL => 'webmaster',
 
 	# Certificate info
@@ -109,6 +117,9 @@ our $ua;
 # Strerr backup
 our $_stderr;
 
+# Retry count
+our $retry;
+
 # JSON Web Key (JWK)
 #XXX: tie to Tie::IxHash to keep a stable ordering of hash keys
 #our %jwk = (
@@ -142,6 +153,9 @@ sub new {
 	# Link self to package
 	bless($self, $class);
 
+	# Save retry
+	$self->{retry} = 0;
+
 	# Save verbose
 	$self->{verbose} = $verbose;
 
@@ -181,35 +195,38 @@ sub new {
 	map {
 		my $tld;
 
-		# Extract tld
-		unless (($tld) = $_ =~ m/\.(\w+)$/) {
-			confess('Extract '.$_.' tld failed');
-		}
+		# With non-numeric tld
+		if (!is_public_ip($_)) {
+			# Extract tld
+			unless (($tld) = $_ =~ m/\.(\w+)$/) {
+				confess('Extract '.$_.' tld failed');
+			}
 
-		# Check if tld exists
-		unless(Net::Domain::TLD::tld_exists($tld)) {
-			confess('Extracted '.$_.' tld '.$tld.' do not exists');
-		}
+			# Check if tld exists
+			unless(Net::Domain::TLD::tld_exists($tld)) {
+				confess('Extracted '.$_.' tld '.$tld.' do not exists');
+			}
 
-		# Search a record
-		my $a = Net::DNS::Resolver->new->search($_, 'A', 'IN');
+			# Search a record
+			my $a = Net::DNS::Resolver->new->search($_, 'A', 'IN');
 
-		# Search aaaa record
-		my $aaaa = Net::DNS::Resolver->new->search($_, 'AAAA', 'IN');
+			# Search aaaa record
+			my $aaaa = Net::DNS::Resolver->new->search($_, 'AAAA', 'IN');
 
-		# Trigger error for unresolvable domain
-		unless (
-			# Check if either has a A or AAAA record
-			scalar map {
-				($_->type eq 'A' or $_->type eq 'AAAA') ? 1 : ();
+			# Trigger error for unresolvable domain
+			unless (
+				# Check if either has a A or AAAA record
+				scalar map {
+					($_->type eq 'A' or $_->type eq 'AAAA') ? 1 : ();
+				}
+				# Merge both answer
+				(
+					(defined $a and defined $a->answer) ? $a->answer : (),
+					(defined $aaaa and defined $aaaa->answer) ? $aaaa->answer : ()
+				)
+			) {
+				confess('Resolve '.$_.' to an A or AAAA record failed');
 			}
-			# Merge both answer
-			(
-				(defined $a and defined $a->answer) ? $a->answer : (),
-				(defined $aaaa and defined $aaaa->answer) ? $aaaa->answer : ()
-			)
-		) {
-			confess('Resolve '.$_.' to an A or AAAA record failed');
 		}
 	} @domains;
 
@@ -456,6 +473,26 @@ sub _post {
 		$self->{req}{nonce} = $res->headers->{'replay-nonce'};
 	}
 
+	# Handle error
+	#TODO: see if we may drop retry section with asynch answer which should fix the problem ?
+	#TODO: https://community.letsencrypt.org/t/shortlived-certificate-stuck-as-processing/241006/9
+	unless ($res->is_success and $self->{retry} <= 3) {
+		# Display error
+		confess('POST '.$uri.' failed: '.$res->status_line.':'.$res->content) if ($self->{verbose});
+
+		# Increment retry
+		$self->{retry}++;
+
+		# Sleep
+		sleep(1);
+
+		# Next try
+		$res = $self->_post($uri, $payload);
+	}
+
+	# Reset retry
+	$self->{retry} = 0;
+
 	# Return res object
 	return $res;
 }
@@ -500,8 +537,11 @@ sub _dnsCheck {
 sub _httpCheck {
 	my ($self, $domain, $token) = @_;
 
+	# Set uri
+	my $uri = 'http://'.(is_public_ipv6($domain)?'['.$domain.']':$domain).'/.well-known/acme-challenge/'.$token;
+
 	# Create a request
-	my $req = HTTP::Request->new(GET => 'http://'.$domain.'/.well-known/acme-challenge/'.$token);
+	my $req = HTTP::Request->new(GET => $uri);
 
 	# Check if thumbprint is writeable
 	if (-w $self->{config}{thumbprint}) {
@@ -514,13 +554,13 @@ sub _httpCheck {
 
 	# Handle error
 	unless ($res->is_success) {
-		carp 'Fetch http://'.$domain.'/.well-known/acme-challenge/'.$token.' failed: '.$res->status_line if ($self->{verbose});
+		carp 'Fetch '.$uri.' failed: '.$res->status_line if ($self->{verbose});
 		return;
 	}
 
 	# Handle invalid content
 	unless($res->content =~ /^$token.$self->{account}{thumbprint}\s*$/) {
-		carp 'Fetched http://'.$domain.'/.well-known/acme-challenge/'.$token.' with "'.$res->content.'" instead of "'.$token.'.'.$self->{account}{thumbprint}.'"' if ($self->{verbose});
+		carp 'Fetched '.$uri.' with "'.$res->content.'" instead of "'.$token.'.'.$self->{account}{thumbprint}.'"' if ($self->{verbose});
 		return;
 	}
 
@@ -630,13 +670,24 @@ sub order {
 		#XXX: tie to Tie::IxHash to keep a stable ordering of hash keys
 		#XXX: https://www.perlmonks.org/?node_id=1215976
 		#XXX: optional notBefore, notAfter, see https://ietf-wg-acme.github.io/acme/draft-ietf-acme-acme.html#applying-for-certificate-issuance
-		tie(my %payload, 'Tie::IxHash', identifiers => []);
+		tie(my %payload, 'Tie::IxHash', 'profile' => 'classic', identifiers => []);
 
 		# Loop on domains
 		map {
-			# Tie in a stable hash and append to identifiers array
-			#XXX: tie to Tie::IxHash to keep a stable ordering of hash keys
-			tie(%{$payload{identifiers}[scalar @{$payload{identifiers}}]}, 'Tie::IxHash', type => 'dns', value => $_);
+			# With public ip
+			if (is_public_ip($_)) {
+				# Set shortlived profile
+				$payload{profile} = 'shortlived';
+
+				# Tie in a stable hash and append to identifiers array
+				#XXX: tie to Tie::IxHash to keep a stable ordering of hash keys
+				tie(%{$payload{identifiers}[scalar @{$payload{identifiers}}]}, 'Tie::IxHash', type => 'ip', value => $_);
+			# With fqdn
+			} else {
+				# Tie in a stable hash and append to identifiers array
+				#XXX: tie to Tie::IxHash to keep a stable ordering of hash keys
+				tie(%{$payload{identifiers}[scalar @{$payload{identifiers}}]}, 'Tie::IxHash', type => 'dns', value => $_);
+			}
 		} ($self->{domain}{domain}, @{$self->{domain}{domains}});
 
 		# Post new order request
@@ -660,6 +711,18 @@ sub order {
 		# Extract content
 		$content = from_json($res->content);
 
+		# Check status
+		unless ($content->{status} eq 'ready' or $content->{status} eq 'pending') {
+			confess('POST '.$self->{req}{'newOrder'}.' invalid status: '.$content->{status}.': '.$res->status_line);
+		}
+
+		# Store location
+		# XXX: used with async response
+		$content->{location} = $res->headers->{location};
+
+		# Store retry after
+		$content->{retryafter} = (defined $res->headers->{'retry-after'} and $res->headers->{'retry-after'}) ? $res->headers->{'retry-after'} : 1;
+
 		# Write to file
 		write_file($file, to_json($content));
 	}
@@ -667,12 +730,21 @@ sub order {
 	# Save the authorizations
 	$self->{req}{authorizations} = [ keys %{{ map { $_ => undef } @{$content->{authorizations}} }} ];
 
-	# Save the finalize uri
-	$self->{req}{finalize} = $content->{finalize};
-
 	# Create challenges hash
 	%{$self->{req}{challenges}} = ();
 
+	# Save finalize uri
+	$self->{req}{finalize} = $content->{finalize};
+
+	# Save location
+	$self->{req}{location} = $content->{location};
+
+	# Save retry after
+	$self->{req}{retryafter} = $content->{retryafter};
+
+	# Save status
+	$self->{req}{status} = $content->{status};
+
 	# Extract authorizations
 	map {
 		# Init uri
@@ -683,7 +755,7 @@ sub order {
 
 		# Init file
 		#XXX: tmpdir.'/'.<orderuri>.'/'.<authuri>
-		my $file = $self->{req}{pending}.'/'.encode_base64url($uri);
+		my $authFile = $self->{req}{pending}.'/'.encode_base64url($uri);
 
 		# Load auth request content or post a new one
 		#TODO: add more check on cache file ???
@@ -691,9 +763,9 @@ sub order {
 			#XXX: use eval to workaround a fatal in from_json
 			! defined eval {
 				# Check that file exists
-				-f $file &&
+				-f $authFile &&
 				# Read it
-				($content = read_file($file)) &&
+				($content = read_file($authFile)) &&
 				# Decode it
 				($content = from_json($content))
 			# Check expiration
@@ -719,7 +791,10 @@ sub order {
 				confess('POST '.$uri.' missing identifier: '.$res->status_line);
 			} else {
 				unless (
-					$content->{identifier}{type} eq 'dns' and
+					(
+						$content->{identifier}{type} eq 'dns' or
+						$content->{identifier}{type} eq 'ip'
+					) and
 					$content->{identifier}{value}
 				) {
 					confess('POST '.$uri.' invalid identifier: '.$res->status_line);
@@ -732,7 +807,7 @@ sub order {
 			}
 
 			# Write to file
-			write_file($file, to_json($content));
+			write_file($authFile, to_json($content));
 		}
 
 		# Add challenge
@@ -780,7 +855,7 @@ sub order {
 						) {
 							# Init file
 							#XXX: tmpdir.'/'.<orderuri>.'/'.<authuri>
-							my $file = $self->{req}{pending}.'/'.encode_base64url($self->{req}{challenges}{$identifier}{challenges}{$_}{url});
+							my $authFile = $self->{req}{pending}.'/'.encode_base64url($self->{req}{challenges}{$identifier}{challenges}{$_}{url});
 
 							# Reset content
 							$content = undef;
@@ -791,9 +866,9 @@ sub order {
 								#XXX: use eval to workaround a fatal in from_json
 								! defined eval {
 									# Check that file exists
-									-f $file &&
+									-f $authFile &&
 									# Read it
-									($content = read_file($file)) &&
+									($content = read_file($authFile)) &&
 									# Decode it
 									($content = from_json($content))
 								#TODO: Check file modification time ? There is no expires field in json answer
@@ -814,7 +889,7 @@ sub order {
 								$content = from_json($res->content);
 
 								# Write to file
-								write_file($file, to_json($content));
+								write_file($authFile, to_json($content));
 							}
 
 							# Save if valid
@@ -862,6 +937,10 @@ sub order {
 
 			# Poll remaining polls
 			map {
+				# Init file
+				#XXX: tmpdir.'/'.<orderuri>.'/'.<authuri>
+				my $authFile = $self->{req}{pending}.'/'.encode_base64url($self->{req}{challenges}{$identifier}{challenges}{$_}{url});
+
 				# Post challenge request
 				#XXX: no cache here we force update
 				my $res = $self->_post(
@@ -877,12 +956,8 @@ sub order {
 				# Extract content
 				$content = from_json($res->content);
 
-				# Init file
-				#XXX: tmpdir.'/'.<orderuri>.'/'.<authuri>
-				my $file = $self->{req}{pending}.'/'.encode_base64url($self->{req}{challenges}{$identifier}{challenges}{$_}{url});
-
 				# Write to file
-				write_file($file, to_json($content));
+				write_file($authFile, to_json($content));
 
 				# Save status
 				if ($content->{status} ne 'pending') {
@@ -892,7 +967,6 @@ sub order {
 		} map { $self->{req}{challenges}{$_}{status} eq 'pending' ? $_ : (); } keys %{$self->{req}{challenges}};
 	} 
 
-
 	# Check if thumbprint is writeable
 	if (-w $self->{config}{thumbprint}) {
 		# Try to write thumbprint
@@ -920,6 +994,61 @@ sub order {
 		}
 		exit EXIT_FAILURE;
 	}
+
+	# With pending
+	if ($self->{req}{status} eq 'pending') {
+		# Init max run
+		$remaining = TIMEOUT;
+
+		# Iterate until processing order becomes ready
+		while (--$remaining >= 0 and $self->{req}{status} eq 'pending') {
+			# Sleep
+			sleep($self->{req}{retryafter});
+
+			# Refresh content
+			my $res = $self->_post($self->{req}{location}, '');
+
+			# Handle error
+			unless ($res->is_success) {
+				confess('POST '.$self->{req}{location}.' failed: '.$res->status_line);
+			}
+
+			# Handle error
+			unless ($res->content) {
+				confess('POST '.$self->{req}{location}.' empty content: '.$res->status_line);
+			}
+
+			# Handle error
+			unless ($res->headers->{location}) {
+				confess('POST '.$self->{req}{location}.' missing location: '.$res->status_line);
+			}
+
+			# Extract content
+			$content = from_json($res->content);
+
+			# Check status
+			unless ($content->{status} eq 'ready' or $content->{status} eq 'pending') {
+				confess('POST '.$self->{req}{location}.' invalid status: '.$content->{status}.': '.$res->status_line);
+			}
+
+			# Store location
+			$self->{req}{location} = $res->headers->{location};
+
+			# Store retry after
+			$self->{req}{retryafter} = (defined $res->headers->{'retry-after'} and $res->headers->{'retry-after'}) ? $res->headers->{'retry-after'} : 1;
+
+			# Store status
+			$self->{req}{status} = $content->{status};
+
+			# Write to file
+			write_file($file, to_json($content));
+		}
+
+		# Without ready state
+		unless($self->{req}{status} eq 'ready') {
+			confess('POST '.$self->{req}{location}.' invalid status: '.$self->{req}{status});
+		}
+	}
 }
 
 # Generate certificate request
@@ -939,7 +1068,7 @@ sub genCsr {
 		my $pos = tell DATA;
 
 		# Init counter
-		my $i = 0;
+		my ($i, $j) = (0) x 2;
 
 		# Prepare mail
 		my $mail = join("\n", map { $i++.'.emailAddress'."\t\t\t".'= '.$_; } @{$self->{domain}{mail}});
@@ -950,9 +1079,9 @@ sub genCsr {
 		# Reseek data
 		seek(DATA, $pos, 0);
 
-		# Append domain names
+		# Append domain names and ips
 		$i = 0;
-		map { print $oct 'DNS.'.$i++.' = '.$_."\n"; } ($self->{domain}{domain}, @{$self->{domain}{domains}});
+		map { print $oct (is_public_ip($_)?'IP.'.$j++:'DNS.'.$i++).' = '.$_."\n"; } ($self->{domain}{domain}, @{$self->{domain}{domains}});
 
 		# Generate csr
 		#XXX: read certificate request with: openssl req -inform DER -in $self->{req}{csr} -text
@@ -1012,19 +1141,86 @@ sub issue {
 		$content = from_json($res->content);
 
 		# Check status
-		unless (defined $content->{status} and $content->{status} eq 'valid') {
-			confess('POST '.$self->{req}{finalize}.' failed: invalid status: '.(defined $content->{status}?$content->{status}:'undefined'));
+		unless ($content->{status} eq 'processing' or $content->{status} eq 'valid') {
+			confess('POST '.$self->{req}{location}.' invalid status: '.$content->{status}.': '.$res->status_line);
 		}
 
-		# Check certificate
-		unless (defined $content->{certificate} and $content->{certificate}) {
-			confess('POST '.$self->{req}{finalize}.' failed: invalid certificate: '.(defined $content->{certificate}?$content->{certificate}:'undefined'));
-		}
+		# Store location
+		# XXX: used with async response
+		$content->{location} = $res->headers->{location};
+
+		# Store retry after
+		$content->{retryafter} = (defined $res->headers->{'retry-after'} and $res->headers->{'retry-after'}) ? $res->headers->{'retry-after'} : 1;
 
 		# Write to file
 		write_file($file, to_json($content));
 	}
 
+	# Store location
+	$self->{req}{location} = $content->{location};
+
+	# Store restry after
+	$self->{req}{retryafter} = $content->{retryafter};
+
+	# Store status
+	$self->{req}{status} = $content->{status};
+
+	# With processing
+	if ($self->{req}{status} eq 'processing') {
+		# Init max run
+		my $remaining = TIMEOUT;
+
+		# Iterate until processing order becomes ready
+		while (--$remaining >= 0 and $self->{req}{status} eq 'processing') {
+			# Sleep
+			sleep($self->{req}{retryafter});
+
+			# Refresh content
+			my $res = $self->_post($self->{req}{location}, '');
+
+			# Handle error
+			unless ($res->is_success) {
+				confess('POST '.$self->{req}{location}.' failed: '.$res->status_line);
+			}
+
+			# Handle error
+			unless ($res->content) {
+				confess('POST '.$self->{req}{location}.' empty content: '.$res->status_line);
+			}
+
+			# Handle error
+			unless ($res->headers->{location}) {
+				confess('POST '.$self->{req}{location}.' missing location: '.$res->status_line);
+			}
+
+			# Extract content
+			$content = from_json($res->content);
+
+			# Check status
+			unless ($content->{status} eq 'valid' or $content->{status} eq 'processing') {
+				confess('POST '.$self->{req}{location}.' invalid status: '.$content->{status}.': '.$res->status_line);
+			}
+
+			# Store location
+			# XXX: used with async response
+			$self->{req}{location} = $res->headers->{location};
+
+			# Store retry after
+			$self->{req}{retryafter} = (defined $res->headers->{'retry-after'} and $res->headers->{'retry-after'}) ? $res->headers->{'retry-after'} : 1;
+
+			# Store status
+			$self->{req}{status} = $content->{status};
+
+			# Write to file
+			write_file($file, to_json($content));
+		}
+
+		# Without valid state
+		unless($self->{req}{status} eq 'valid') {
+			confess('POST '.$self->{req}{location}.' invalid status: '.$self->{req}{status});
+		}
+	}
+
 	# Set certificate
 	$self->{req}{certificate} = $content->{certificate};
 
@@ -1035,7 +1231,7 @@ sub issue {
 	# Reset content
 	$content = undef;
 
-	# Load auth request content or post a new one
+	# Load certificate request content or post a new one
 	#TODO: add more check on cache file ???
 	if (
 		#XXX: use eval to workaround a fatal in from_json
diff --git a/acme b/acme
index 553911e..6b5a736 100755
--- a/acme
+++ b/acme
@@ -455,10 +455,14 @@ if (scalar(@domains) < 1) {
 # Deal with each domain
 foreach my $domain (@domains) {
 	# Skip certificate, in cron action, issued within the last 60 days
+	#TODO: XXX: with shortlived certificate this code will not work anymore
+	#TODO: XXX: we need to look certificate real expiration date and not mtime anymore
+	#TODO: XXX: (or store profile somewhere)
 	if ($action eq 'cron' and -f $domain->{cert} and stat($domain->{cert})->mtime >= (time() - 60*24*3600)) {
 		carp('Domain '.$domain->{domain}.' certificate '.$domain->{cert}.' skipped') if ($verbose);
 		next;
 	}
+
 	# Create new object
 	my $acme = Acme->new($verbose, $domain, {thumbprint => $config->{thumbprint}, pending => $config->{pending}, term => $config->{term}});