From 94e7362e370e4a1f51e15ea543fba5495a65d3de Mon Sep 17 00:00:00 2001
From: Wojtek Kosior <koszko@koszko.org>
Date: Sat, 17 Dec 2022 12:35:57 +0100
Subject: add certbot service; replace trivial lambdas with `cut`

---
 container.scm | 70 +++++++++++++++++++++++++++++++++++++++++++++++++++++++----
 1 file changed, 66 insertions(+), 4 deletions(-)

diff --git a/container.scm b/container.scm
index 8232951..c5a79dd 100644
--- a/container.scm
+++ b/container.scm
@@ -11,7 +11,10 @@
              (hydrilla-json-schemas)
              (hydrilla)
              (ice-9 match)
+             ;; srfi-1 provides `append-map`.
              (srfi srfi-1)
+             ;; srfi-26 provides `cut`.
+             (srfi srfi-26)
              (guix records)
              ;; (guix gexp) is needed for `file-append`.
              (guix gexp)
@@ -26,6 +29,7 @@
 (use-package-modules version-control)
 (use-service-modules web)
 (use-service-modules shepherd)
+(use-service-modules certbot)
 
 (define %here
   (getcwd))
@@ -39,7 +43,7 @@
 (define (httpd-conf-token arg)
   (match arg
     ((? string?)
-     (if (or-map (lambda (substr) (string-contains arg substr)) '(" " "\""))
+     (if (or-map (cut string-contains arg <>) '(" " "\""))
          (format #f "~s" arg)
          arg))
     ((? symbol?)
@@ -83,7 +87,7 @@
      (let ((name (car name-and-aliases))
            (aliases (cdr name-and-aliases)))
        `(,(httpd-directive 'ServerName name)
-         ,@(map (lambda (alias) (httpd-directive 'ServerAlias alias))
+         ,@(map (cut httpd-directive 'ServerAlias <>)
                 aliases)
          ,@(if auto-www-aliases
                (map (lambda (alias-or-name)
@@ -95,6 +99,9 @@
          ,(httpd-tag 'If (list (format #f "%{HTTP_HOST} != '~a'" name))
                      (httpd-directive 'Redirect 'permanent "/"
                                       (format #f "https://~a/" name)))
+         ,(httpd-directive
+           'Alias "/.well-known/acme-challenge"
+           (string-append "/srv/http/acme-challenge/" name))
          ,@body)))))
 
 (define (make-virtualhosts koszko-site-conf-record)
@@ -151,8 +158,7 @@
 
      ,@(apply append
               (map (lambda (file-name)
-                     (map (lambda (suffix)
-                            (string-append "readme=" file-name suffix))
+                     (map (cut string-append "readme=" file-name <>)
                           '(".md" ".mkd" ".rst" ".html" ".htm" ".txt" "")))
                    '("readme" "README" "install" "INSTALL")))
 
@@ -348,6 +354,61 @@
         "CustomLog /var/log/httpd/access.log combined" "\n"
         "ScriptSock /var/run/cgid.sock" "\n")))))))
 
+(define %koszko-httpd-deploy-hook
+  (program-file
+   "httpd-deploy-hook"
+   #~(let ((pid (call-with-input-file "/var/run/httpd" read)))
+       (kill pid SIGHUP))))
+
+(define %certbot-token-filename-gexp
+  #~(format "/srv/http/acme-challenge/~a/~a"
+            (getenv "CERTBOT_DOMAIN") (getenv "CERTBOT_TOKEN")))
+
+(define %koszko-certbot-auth-hook
+  (program-file
+   "cert-auth-hook"
+   (with-imported-modules '((guix build utils))
+     #~(begin
+         (use-modules (guix build utils))
+         (let ((filename #$%certbot-token-filename-gexp))
+           (mkdir-p (dirname filename))
+           (call-with-output-file filename
+             (lambda () (display (getenv "CERTBOT_VALIDATION")))))))))
+
+(define %koszko-certbot-cleanup-hook
+  (program-file
+   "cert-cleanup-hook"
+   (with-imported-modules '((guix build utils))
+     #~(begin
+         (use-modules (guix build utils))
+         (delete-file-recursively (dirname #$%certbot-token-filename-gexp))))))
+
+(define %koszko-certbot-service
+  (service
+   (service-type
+    (inherit certbot-service-type)
+    (name 'koszko-certbot)
+    ;; Prevent certbot from pulling in Nginx — we use Apache here.
+    (extensions (filter
+                 (lambda (ext)
+                   (not (eq? (service-type-name (service-extension-target ext))
+                             (service-type-name nginx-service-type))))
+                 (service-type-extensions certbot-service-type))))
+   (certbot-configuration
+    (email "koszko@koszko.org")
+    (certificates
+     (map
+      (match-lambda
+        (($ <koszko-httpd-site-conf> name-and-aliases auto-www-aliases)
+         (let ((www-aliases (map (cut string-append "www." <>)
+                                 (if auto-www-aliases name-and-aliases '()))))
+           (certificate-configuration
+            (domains (append name-and-aliases www-aliases))
+            (authentication-hook %koszko-certbot-auth-hook)
+            (cleanup-hook %koszko-certbot-cleanup-hook)
+            (deploy-hook %koszko-httpd-deploy-hook)))))
+      %all-site-confs)))))
+
 (operating-system
   (host-name "koszko")
   (timezone "Europe/Warsaw")
@@ -395,4 +456,5 @@
               (respawn? #f)))
             (description "Make other services assume network is there."))
            #f)
+          %koszko-certbot-service
           %base-services)))
-- 
cgit v1.2.3