unofficial mirror of guix-devel@gnu.org 
 help / color / mirror / code / Atom feed
From: Carlo Zancanaro <carlo@zancanaro.id.au>
To: 46961@debbugs.gnu.org
Cc: guix-devel@gnu.org, brice@waegenei.re, clement@lassieur.org
Subject: bug#46961: [PATCH v2 4/4] services: certbot: Add one-shot service to renew certificates.
Date: Tue, 30 Jan 2024 13:26:40 +0000	[thread overview]
Message-ID: <dacd6d008673b6eaf957211ff4ad41256be533b1.1706621200.git.carlo@zancanaro.id.au> (raw)
Message-ID: <20240130132640.bK82j-spNwKsev5cMEVFjRjnwNr1FkaA9J2IpZ_k760@z> (raw)
In-Reply-To: <cover.1706098718.git.carlo@zancanaro.id.au>

* gnu/services/certbot.scm (certbot-renewal-one-shot): New procedure.
(certbot-service-type)[extensions]: Add it to shepherd-root extension.
(certbot-command): Make connection errors return a different exit code.
(certbot-activation): Remove message with certificate renewal instructions.

Change-Id: I614ac6214a753dba0396e2385a75926c8355caa1
---
 gnu/services/certbot.scm | 77 +++++++++++++++++++++++++++++++++-------
 1 file changed, 65 insertions(+), 12 deletions(-)

diff --git a/gnu/services/certbot.scm b/gnu/services/certbot.scm
index 490b9e8d6d..d6354c86d3 100644
--- a/gnu/services/certbot.scm
+++ b/gnu/services/certbot.scm
@@ -183,15 +183,37 @@ (define certbot-command
        (program-file
         "certbot-command"
         #~(begin
-            (use-modules (ice-9 match))
-            (let ((code 0))
+            (use-modules (ice-9 match)
+                         (ice-9 textual-ports))
+
+            (define (file-contains? file string)
+              (string-contains (call-with-input-file file
+                                 get-string-all)
+                               string))
+
+            (define (connection-error?)
+              (file-contains? "/var/log/letsencrypt/letsencrypt.log"
+                              "Failed to establish a new connection"))
+
+            (let ((script-code 0))
               (for-each
                (match-lambda
                  ((name . command)
                   (begin
                     (format #t "Acquiring or renewing certificate: ~a~%" name)
-                    (set! code (or (apply system* command) code)))))
-               '#$commands) code)))))))
+                    (unless (zero? (status:exit-val (apply system* command)))
+                      ;; Certbot errors are always exit code 1, but we'd like
+                      ;; to separate connection errors from other error types.
+                      (if (connection-error?)
+                          ;; If we have a connection error, then bail early
+                          ;; with exit code 2. We don't expect this to
+                          ;; resolve within the timespan of this script.
+                          (exit 2)
+                          ;; If we have any other type of error, then continue
+                          ;; but exit with a failing status code in the end.
+                          (set! script-code 1))))))
+               '#$commands)
+              (exit script-code))))))))
 
 (define (certbot-renewal-jobs config)
   (list
@@ -200,6 +222,40 @@ (define (certbot-renewal-jobs config)
    #~(job '(next-minute-from (next-hour '(0 12)) (list (random 60)))
           #$(certbot-command config))))
 
+(define (certbot-renewal-one-shot config)
+  (list
+   ;; Renew certificates when the system first starts. This is a one-shot
+   ;; service, because the mcron configuration will take care of running this
+   ;; periodically. This is most useful the very first time the system starts,
+   ;; to overwrite our self-signed certificates as soon as possible without
+   ;; user intervention.
+   (shepherd-service
+    (provision '(renew-certbot-certificates))
+    (requirement '(nginx))
+    (one-shot? #t)
+    (start #~(lambda _
+               ;; This needs the network, but there's no reliable way to know
+               ;; if the network is up other than trying. If we fail due to a
+               ;; connection error we retry a number of times in the hope that
+               ;; the network comes up soon.
+               (let loop ((attempt 0))
+                 (let ((code (status:exit-val
+                              (system* #$(certbot-command config)))))
+                   (cond
+                    ((and (= code 2)      ; Exit code 2 means connection error
+                          (< attempt 12)) ; 12 * 10 seconds = 2 minutes
+                     (sleep 10)
+                     (loop (1+ attempt)))
+                    ((zero? code)
+                     ;; Success!
+                     #t)
+                    (else
+                     ;; Failure.
+                     #f))))))
+    (auto-start? #t)
+    (documentation "Call certbot to renew certificates.")
+    (actions (list (shepherd-configuration-action (certbot-command config)))))))
+
 (define (generate-certificate-gexp certbot-cert-directory rsa-key-size)
   (match-lambda
     (($ <certificate-configuration> name (primary-domain other-domains ...)
@@ -243,9 +299,7 @@ (define (generate-certificate-gexp certbot-cert-directory rsa-key-size)
 
 (define (certbot-activation config)
   (let* ((certbot-directory "/var/lib/certbot")
-         (certbot-cert-directory "/etc/letsencrypt/live")
-         (script (in-vicinity certbot-directory "renew-certificates"))
-         (message (format #f (G_ "~a may need to be run~%") script)))
+         (certbot-cert-directory "/etc/letsencrypt/live"))
     (match config
       (($ <certbot-configuration> package webroot certificates email
                                   server rsa-key-size default-location)
@@ -261,10 +315,7 @@ (define (certbot-activation config)
                   (map (generate-certificate-gexp certbot-cert-directory
                                                   rsa-key-size)
                        (filter certificate-configuration-start-self-signed?
-                               certificates)))
-
-             (copy-file #$(certbot-command config) #$script)
-             (display #$message)))))))
+                               certificates)))))))))
 
 (define certbot-nginx-server-configurations
   (match-lambda
@@ -297,7 +348,9 @@ (define certbot-service-type
                        (service-extension activation-service-type
                                           certbot-activation)
                        (service-extension mcron-service-type
-                                          certbot-renewal-jobs)))
+                                          certbot-renewal-jobs)
+                       (service-extension shepherd-root-service-type
+                                          certbot-renewal-one-shot)))
                 (compose concatenate)
                 (extend (lambda (config additional-certificates)
                           (certbot-configuration
-- 
2.41.0





  parent reply	other threads:[~2024-01-30 13:36 UTC|newest]

Thread overview: 15+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
     [not found] <cover.1706098718.git.carlo@zancanaro.id.au>
2024-01-30 13:26 ` [PATCH v2 0/4] Make certbot play more nicely with nginx Carlo Zancanaro
2024-01-30 13:26   ` bug#46961: " Carlo Zancanaro
2024-01-30 14:49   ` Felix Lechner via Development of GNU Guix and the GNU System distribution.
2024-01-30 21:48     ` Carlo Zancanaro
2024-01-31  0:04       ` Wojtek Kosior via Development of GNU Guix and the GNU System distribution.
     [not found]   ` <875xzanaer.fsf__22488.5524179385$1706626282$gmane$org@lease-up.com>
2024-01-30 19:39     ` bug#46961: " Clément Lassieur
2024-04-13  1:17       ` Felix Lechner via Development of GNU Guix and the GNU System distribution.
2024-04-14 11:42         ` Carlo Zancanaro
2024-04-14 13:51         ` Carlo Zancanaro
2024-04-14 16:25           ` Felix Lechner via Development of GNU Guix and the GNU System distribution.
2024-01-30 13:26 ` [PATCH v2 1/4] services: certbot: Symlink certificates to /etc/certs Carlo Zancanaro
2024-01-30 13:26 ` [PATCH v2 2/4] services: certbot: Create self-signed certificates before certbot runs Carlo Zancanaro
2024-01-30 13:26 ` [PATCH v2 3/4] services: certbot: Add a default deploy hook to reload nginx Carlo Zancanaro
2024-01-30 13:26 ` Carlo Zancanaro [this message]
2024-01-30 13:26   ` bug#46961: [PATCH v2 4/4] services: certbot: Add one-shot service to renew certificates Carlo Zancanaro

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://guix.gnu.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=dacd6d008673b6eaf957211ff4ad41256be533b1.1706621200.git.carlo@zancanaro.id.au \
    --to=carlo@zancanaro.id.au \
    --cc=46961@debbugs.gnu.org \
    --cc=brice@waegenei.re \
    --cc=clement@lassieur.org \
    --cc=guix-devel@gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).