Revocation reason, server-specified delay cap, sectigo CA.

do-know · Jun 1, 2024 · ce3560e · ce3560e
1 parent 4d6216e
commit ce3560e
Show file tree

Hide file tree

Showing 5 changed files with 72 additions and 25 deletions.
diff --git a/Changes b/Changes
@@ -1,5 +1,10 @@
 Revision history for Crypt-LE
 
+0.40    01 June 2024
+        - Revocation reason can now be specified via 'revoke-reason'.
+        - It is now possible to cap unreasonably long server-specified 'retry-after' via 'max-server-delay'.
+        - Sectigo added to the CAs as 'sectigo.com'.
+
 0.39    11 March 2023
         - EAB (External Account Binding) support used by some CAs.
         - Asynchronous order finalization support.

diff --git a/lib/Crypt/LE.pm b/lib/Crypt/LE.pm
@@ -4,15 +4,15 @@ use 5.006;
 use strict;
 use warnings;
 
-our $VERSION = '0.39';
+our $VERSION = '0.40';
 
 =head1 NAME
 
 Crypt::LE - Let's Encrypt (and other ACME-based) API interfacing module and client.
 
 =head1 VERSION
 
-Version 0.39
+Version 0.40
 
 =head1 SYNOPSIS
 
@@ -166,6 +166,9 @@ our $cas = {
                                 'live'  => 'https://dv.acme-v02.api.pki.goog/directory',
                                 'stage' => 'https://dv.acme-v02.test-api.pki.goog/directory',
                             },
+    'sectigo.com'        => {
+                                'live'  => 'https://acme.sectigo.com/v2/DV',
+                            },
 };
 
 use constant {
@@ -250,6 +253,15 @@ my $compat = {
     revokeCert	=> 'revoke-cert',
 };
 
+# Subset of https://datatracker.ietf.org/doc/html/rfc5280#section-5.3.1 as supported by Boulder.
+my $revocation_reasons = {
+    unspecified          => 0,
+    keycompromise        => 1,
+    affiliationchanged   => 3,
+    superseded           => 4,
+    cessationofoperation => 5,
+};
+
 =head1 METHODS (API Setup)
 
 The following methods are provided for the API setup. Please note that account key setup by default requests the resource directory from Let's Encrypt servers.
@@ -297,8 +309,13 @@ Enables automatic retrieval of the resource directory (required for normal API p
 
 =item C<delay>
 
-Specifies the time in seconds to wait before Let's Encrypt servers are checked for the challenge verification results again. By default set to 2 seconds.
-Non-integer values are supported (so for example you can set it to 1.5 if you like).
+Specifies the time in seconds to wait before the challenge verification results are checked again. By default set to 2 seconds.
+Non-integer values are supported (so for example you can set it to 1.5 if you like). Please note that the server-specified delay overrides this value,
+but it can be adjusted by using max_server_delay (see below).
+
+=item C<max_server_delay>
+
+Overrides server-specified delay in seconds to wait before the challenge verification results are checked again.
 
 =item C<version>
 
@@ -323,20 +340,23 @@ sub new {
     my $class = shift;
     my %params = @_;
     my $self = {
-        ua      => '',
-        server  => '',
-        ca      => '',
-        dir     => '',
-        live    => 0,
-        debug   => 0,
-        autodir => 1,
-        delay   => 2,
-        version => 0,
-        try     => 300,
+        ua                  => '',
+        server              => '',
+        ca                  => '',
+        dir                 => '',
+        live                => 0,
+        debug               => 0,
+        autodir             => 1,
+        delay               => 0,
+        max_server_delay    => 0,
+        version             => 0,
+        try                 => 300,
     };
     foreach my $key (keys %{$self}) {
         $self->{$key} = $params{$key} if (exists $params{$key} and !ref $params{$key});
     }
+    # Some defaults.
+    $self->{delay} ||= 2;
     # Init UA
     $self->{ua} = HTTP::Tiny->new( agent => $self->{ua} || __PACKAGE__ . " v$VERSION", verify_SSL => 1 );
     # Init server
@@ -1371,7 +1391,7 @@ sub request_issuer_certificate {
     return $self->_status(ERROR, $content);
 }
 
-=head2 revoke_certificate($certificate_file|$scalar_ref)
+=head2 revoke_certificate($certificate_file|$scalar_ref, [ $revoke_reason ])
 
 Revokes a certificate.
 
@@ -1380,13 +1400,22 @@ Returns: OK | READ_ERROR | ALREADY_DONE | ERROR.
 =cut
 
 sub revoke_certificate {
-    my $self = shift;
-    my $file = shift;
+    my ($self, $file, $reason) = @_;
     my $crt = $self->_file($file);
     return $self->_status(READ_ERROR, "Certificate reading error.") unless $crt;
-    my ($status, $content) = $self->_request($self->{directory}->{'revoke-cert'},
-                             { resource => 'revoke-cert', certificate => encode_base64url($self->pem2der($crt)) },
-                             { jwk => 0 });
+
+    my $reason_code = 0;
+    my $payload = { resource => 'revoke-cert', certificate => encode_base64url($self->pem2der($crt)) };
+    if ($reason) {
+        $reason_code = $revocation_reasons->{lc $reason};
+        return $self->_status(ERROR, "Unsupported revocation reason specified.") unless defined $reason_code;
+        # Only add the reason field if it is different from Unspecified/0,
+        # since custom CAs might not support the reason (as per rfc8555#section-7.6)
+        $payload->{reason} = $reason_code if $reason_code;
+    }
+
+    my ($status, $content) = $self->_request($self->{directory}->{'revoke-cert'}, $payload, { jwk => 0 });
+
     if ($status == SUCCESS) {
         return $self->_status(OK, "Certificate has been revoked.");
     } elsif ($status == ALREADY_DONE) {
@@ -1863,6 +1892,11 @@ sub _request {
     $self->{location} = $resp->{headers}->{location} ? $resp->{headers}->{location} : undef;
     if ($resp->{headers}->{'retry-after'} and $resp->{headers}->{'retry-after'}=~/^(\d+)$/) {
         $self->{retry} = $1; # Set retry based on the last request where it was present, do not reset.
+        # Some servers might be sending unreasonably long retry-after (such as 86400 seconds - the whole day),
+        # effectively pausing the process - this behaviour can be overriden by 'max_server_delay' option.
+        if ($self->{max_server_delay} and $self->{max_server_delay} < $self->{retry}) {
+            $self->{retry} = $self->{max_server_delay};
+        }
     }
 
     return wantarray ? ($status, $rv) : $rv;
@@ -1875,6 +1909,7 @@ sub _await {
     $opts ||= {};
     my $expected_status = $opts->{status} || SUCCESS;
     ($status, $content) = $self->_request($url, $payload, $opts);
+    $self->_debug("Retry is set to " . ($self->{retry} ? $self->{retry} : '-') . ", and delay is $self->{delay}");
     while ($status == $expected_status and $content and $content->{status} and $content->{status}=~/^(?:pending|processing)$/) {
         select(undef, undef, undef, $self->{retry} || $self->{delay});
         ($status, $content) = $self->_request($url, $payload, $opts);

diff --git a/lib/Crypt/LE/Challenge/Simple.pm b/lib/Crypt/LE/Challenge/Simple.pm
@@ -4,7 +4,7 @@ use warnings;
 use Digest::SHA 'sha256';
 use MIME::Base64 'encode_base64url';
 
-our $VERSION = '0.39';
+our $VERSION = '0.40';
 
 =head1 NAME
 

diff --git a/lib/Crypt/LE/Complete/Simple.pm b/lib/Crypt/LE/Complete/Simple.pm
@@ -3,7 +3,7 @@ use Data::Dumper;
 use strict;
 use warnings;
 
-our $VERSION = '0.39';
+our $VERSION = '0.40';
 
 =head1 NAME
 

diff --git a/script/le.pl b/script/le.pl
@@ -13,7 +13,7 @@
 use Crypt::LE ':errors', ':keys';
 use utf8;
 
-my $VERSION = '0.39';
+my $VERSION = '0.40';
 
 exit main();
 
@@ -43,6 +43,8 @@ sub work {
         version => $opt->{'api'}||0,
         debug => $opt->{'debug'},
         logger => $opt->{'logger'},
+        delay => $opt->{'delay'},
+        max_server_delay => $opt->{'max-server-delay'},
     );
 
     # Check if CA is supported if it was specified explicitly.
@@ -93,7 +95,7 @@ sub work {
         # Register.
         my $reg = _register($le, $opt);
         return $reg if $reg;
-        my $rv = $le->revoke_certificate(\$crt);
+        my $rv = $le->revoke_certificate(\$crt, $opt->{'revoke-reason'});
         if ($rv == OK) {
             $opt->{'logger'}->info("Certificate has been revoked.");
         } elsif ($rv == ALREADY_DONE) {
@@ -292,7 +294,7 @@ sub parse_options {
 
     GetOptions ($opt, 'key=s', 'csr=s', 'csr-key=s', 'domains=s', 'path=s', 'crt=s', 'email=s', 'curve=s', 'server=s', 'directory=s', 'api=i', 'config=s', 'renew=i', 'renew-check=s','issue-code=i',
         'handle-with=s', 'handle-as=s', 'handle-params=s', 'complete-with=s', 'complete-params=s', 'log-config=s', 'update-contacts=s', 'export-pfx=s', 'tag-pfx=s',
-        'eab-kid=s', 'eab-hmac-key=s', 'ca=s', 'alternative=i', 'generate-missing', 'generate-only', 'revoke', 'legacy', 'unlink', 'delayed', 'live', 'quiet', 'debug+', 'help') ||
+        'eab-kid=s', 'eab-hmac-key=s', 'ca=s', 'alternative=i', 'generate-missing', 'generate-only', 'delay=i', 'max-server-delay=i', 'revoke', 'revoke-reason=s', 'legacy', 'unlink', 'delayed', 'live', 'quiet', 'debug+', 'help') ||
         return $opt->{'error'}->("Use --help to see the usage examples.", 'PARAMETERS_PARSE');
 
     if ($opt->{'config'}) {
@@ -783,6 +785,8 @@ sub usage_and_exit {
 
  le.pl --key account.key --crt domain.crt --revoke
 
+ le.pl --key account.key --crt domain.crt --revoke --revoke-reason "Superseded"
+
 i) To update your contact details:
 
  le.pl --key account.key --update-contacts "[email protected], [email protected]" --live
@@ -889,6 +893,9 @@ sub usage_and_exit {
 -generate-only               : Exit after generating the missing files.
 -unlink                      : Remove challenge files automatically.
 -revoke                      : Revoke a certificate.
+-revoke-reason <reason>      : Revocation reason.
+-delay <seconds>             : Delay between attempts to check the challenge results.
+-max-server-delay <seconds>  : Cap server-specified delay (which could be unreasonably long).
 -legacy                      : Legacy mode (shorter keys, separate CA file).
 -delayed                     : Exit after requesting the challenge.
 -live                        : Use the live server instead of the test one.