bug#46961: [PATCH 2/2] services: certbot: Create self-signed certificates before certbot runs

[Carlo Zancanaro <carlo@zancanaro.id.au>]

* gnu/services/certbot.scm (<certificate-configuration>): Add
start-self-signed? field.
(generate-certificate-gexp): New procedure.
(certbot-activation): Generate self-signed certificates when
start-self-signed? is #t.
* doc/guix.texi (Certificate services): Document start-self-signed?.
---
 doc/guix.texi            |  6 +++++
 gnu/services/certbot.scm | 56 +++++++++++++++++++++++++++++++++++++---
 2 files changed, 59 insertions(+), 3 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 2d43ab9a65..15b256d0a3 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -32664,6 +32664,12 @@ Certificate Services
 contain a space-delimited list of renewed certificate domains (for
 example, @samp{"example.com www.example.com"}.
 
+@item @code{start-self-signed?} (default: @code{#t})
+Whether to generate an initial self-signed certificate during system
+activation.  This option is particularly useful to allow @code{nginx} to
+start before @code{certbot} has run, because @code{certbot} relies on
+@code{nginx} running to perform HTTP challenges.
+
 @end table
 @end deftp
 
diff --git a/gnu/services/certbot.scm b/gnu/services/certbot.scm
index 58e709f8a4..bb321a1b50 100644
--- a/gnu/services/certbot.scm
+++ b/gnu/services/certbot.scm
@@ -64,7 +64,9 @@ (define-record-type* <certificate-configuration>
   (cleanup-hook        certificate-cleanup-hook
                        (default #f))
   (deploy-hook         certificate-configuration-deploy-hook
-                       (default #f)))
+                       (default #f))
+  (start-self-signed?  certificate-configuration-start-self-signed?
+                       (default #t)))
 
 (define-record-type* <certbot-configuration>
   certbot-configuration make-certbot-configuration
@@ -91,7 +93,10 @@ (define-record-type* <certbot-configuration>
 (define (certbot-deploy-hook name deploy-hook-script)
   "Returns a gexp which creates symlinks for privkey.pem and fullchain.pem
 from /etc/certs/NAME to /etc/letsenctypt/live/NAME.  If DEPLOY-HOOK-SCRIPT is
-not #f then it is run after the symlinks have been created."
+not #f then it is run after the symlinks have been created.  This wrapping is
+necessary for certificates with start-self-signed? set to #t, as it will
+overwrite the initial self-signed certificates upon the first successful
+deploy."
   (program-file
    (string-append name "-deploy-hook")
    (with-imported-modules '((guix build utils))
@@ -108,7 +113,8 @@ (define (certbot-deploy-hook name deploy-hook-script)
                      "/etc/letsencrypt/live/" name "/fullchain.pem")
                   #$(string-append "/etc/certs/" name "/fullchain.pem.new"))
 
-         ;; Rename over the top of the old ones, if there are any.
+         ;; Rename over the top of the old ones, just in case they were the
+         ;; original self-signed certificates.
          (rename-file #$(string-append "/etc/certs/" name "/privkey.pem.new")
                       #$(string-append "/etc/certs/" name "/privkey.pem"))
          (rename-file #$(string-append "/etc/certs/" name "/fullchain.pem.new")
@@ -182,6 +188,44 @@ (define (certbot-renewal-jobs config)
    #~(job '(next-minute-from (next-hour '(0 12)) (list (random 60)))
           #$(certbot-command config))))
 
+(define (generate-certificate-gexp certbot-cert-directory rsa-key-size)
+  (match-lambda
+    (($ <certificate-configuration> name (primary-domain other-domains ...) challenge
+                                    csr authentication-hook
+                                    cleanup-hook deploy-hook)
+     (let (;; Arbitrary default subject, with just the
+           ;; right domain filled in. These values don't
+           ;; have any real significance.
+           (subject (string-append "/C=US/ST=Oregon/L=Portland/O=Company Name/OU=Org/CN="
+                                   primary-domain))
+           (alt-names (if (null? other-domains)
+                          #f
+                          (format #f "subjectAltName=~{DNS:~a~^,~}" other-domains)))
+           (directory (string-append "/etc/certs/" (or name primary-domain))))
+       #~(begin
+           (use-modules (ice-9 format))
+           (when (not (file-exists? #$directory))
+             ;; Due to the way certbot runs, we need to
+             ;; create the self-signed certificates in the
+             ;; archive folder and symlink them into the live
+             ;; folder. This mimics what certbot does well
+             ;; enough to make acquiring new certificates
+             ;; work.
+             (mkdir-p #$directory)
+             (chmod #$directory #o755)
+             (invoke #$(file-append openssl "/bin/openssl")
+                     "req" "-x509"
+                     "-newkey" #$(string-append "rsa:" (or rsa-key-size "4096"))
+                     "-keyout" #$(string-append directory "/privkey.pem")
+                     "-out" #$(string-append directory "/fullchain.pem")
+                     "-sha256"
+                     "-days" "1" ; Only one day, because we expect certbot to run
+                     "-nodes"
+                     "-subj" #$subject
+                     #$@(if alt-names
+                            (list "-addext" alt-names)
+                            (list)))))))))
+
 (define (certbot-activation config)
   (let* ((certbot-directory "/var/lib/certbot")
          (certbot-cert-directory "/etc/letsencrypt/live")
@@ -196,6 +240,12 @@ (define (certbot-activation config)
              (mkdir-p #$webroot)
              (mkdir-p #$certbot-directory)
              (mkdir-p #$certbot-cert-directory)
+
+             #$@(map (generate-certificate-gexp certbot-cert-directory
+                                                (and rsa-key-size (number->string rsa-key-size)))
+                     (filter certificate-configuration-start-self-signed?
+                             certificates))
+
              (copy-file #$(certbot-command config) #$script)
              (display #$message)))))))
 
-- 
2.41.0