services: Add snakeoil-service-type.

The `snakeoil-service-type' generates self-issued certificates for use by
various system daemons.

* gnu/services/ca.scm: New file.
* gnu/local.mk (GNU_SYSTEM_MODULES): Add it.

Change-Id: I57bbe51f43958c0f2f437d81645ce44f9a68470b

1 files changed, 163 insertions, 0 deletions

diff --git a/gnu/services/ca.scm b/gnu/services/ca.scm
new file mode 100644
index 0000000000..1b10ef3e1c
--- /dev/null
+++ b/gnu/services/ca.scm
@@ -0,0 +1,163 @@
+;;; SPDX-License-Identifier: CC0-1.0
+;;;
+;;; Copyright © 2023, 2024 Wojtek Kosior <koszko@koszko.org>
+
+(define-module (gnu services ca)
+  #:use-module ((srfi srfi-1) #:select (concatenate))
+  #:use-module ((guix records) #:select (define-record-type* match-record))
+  #:use-module ((guix gexp) #:select (gexp file-append))
+  #:use-module ((gnu services) #:select
+                (service-extension activation-service-type service-type))
+  #:use-module ((gnu packages tls) #:select (openssl))
+  #:export (snakeoil-service-type
+            snakeoil-configuration
+            snakeoil-configuration?
+            snakeoil-cert-configuration))
+
+(define-record-type* <snakeoil-cert-configuration> snakeoil-cert-configuration
+  make-snakeoil-cert-configuration snakeoil-cert-configuration?
+  (name            snakeoil-cert-configuration-name
+                   (default #f))
+  (domains         snakeoil-cert-configuration-domains
+                   (default '()))
+  (key-group-owner snakeoil-cert-configuration-key-group-owner
+                   (default #f)))
+
+(define-record-type* <snakeoil-configuration> snakeoil-configuration
+  make-snakeoil-configuration snakeoil-configuration?
+  (openssl      snakeoil-configuration-openssl
+                (default openssl))
+  (owner        snakeoil-configuration-owner
+                (default "root"))
+  (group-owner  snakeoil-configuration-group-owner
+                (default #f))
+  (rsa-key-size snakeoil-configuration-rsa-key-size
+                (default 4096))
+  (certificates snakeoil-configuration-certificates
+                (default '())))
+
+(define (snakeoil-activation config)
+  (match-record config <snakeoil-configuration>
+    (openssl owner group-owner rsa-key-size certificates)
+    #~(begin
+        (use-modules (ice-9 format)
+                     (ice-9 textual-ports))
+
+        (define openssl
+          #$(file-append openssl "/bin/openssl"))
+
+        (define pwnam
+          (getpw #$owner))
+
+        (define grnam
+          (and=> #$group-owner getgr))
+
+        (define (chown-file filename)
+          (chown filename (passwd:uid pwnam) (or (and=> grnam group:gid) -1)))
+
+        (define (generate-private-key path)
+          (let ((initial-umask (umask))
+                (tmp-path (string-append path ".tmp.pem")))
+            (umask #o027)
+            (system* openssl "genrsa" "-out" tmp-path
+                     #$(number->string rsa-key-size))
+            (rename-file tmp-path path)
+            (umask initial-umask)))
+
+        (mkdir-p "/etc/snakeoil/certs")
+
+        (unless (false-if-exception
+                 (stat "/etc/snakeoil/private/key.pem"))
+          (mkdir-p "/etc/snakeoil/private/")
+          (generate-private-key "/etc/snakeoil/private/key.pem"))
+
+        (unless (false-if-exception
+                 (stat "/etc/snakeoil/root-cert.pem"))
+          ;; Self-sign a local certificate authority.
+          (system* openssl "req"
+                   "-x509" "-new" "-nodes" "-sha256"
+                   "-days" (number->string (* 20 365))
+                   "-out" "/etc/snakeoil/root-cert.pem"
+                   "-key" "/etc/snakeoil/private/key.pem"
+                   "-subj" "/CN=snakeoil-root"))
+
+        (chown-file "/etc/snakeoil")
+        (chown-file "/etc/snakeoil/certs")
+        (chown-file "/etc/snakeoil/private")
+        (chown-file "/etc/snakeoil/private/key.pem")
+        (chown-file "/etc/snakeoil/root-cert.pem")
+
+        (define (issue-cert cert-name domains key-group-owner)
+          (let* ((cert-name* (or cert-name (car domains)))
+                 (cert-dir (format #f "/etc/snakeoil/certs/~a" cert-name*))
+                 (tmp-dir (format #f "/etc/snakeoil/certs-tmp/~a" cert-name*))
+                 (cert-path (format #f "~a/cert.pem" tmp-dir))
+                 (chain-link-path (format #f "~a/chain.pem" tmp-dir))
+                 (key-path (format #f "~a/privkey.pem" tmp-dir))
+                 (fullchain-path (format #f "~a/fullchain.pem" tmp-dir))
+                 (csr-path (format #f "~a/csr.pem" tmp-dir)))
+            (unless (false-if-exception (stat cert-dir))
+              (system* "rm" "-rf" tmp-dir)
+              (mkdir-p tmp-dir)
+
+              (generate-private-key key-path)
+
+              (system* openssl "req"
+                       "-new" "-nodes" "-out" csr-path
+                       "-key" key-path
+                       "-subj" (format #f "/CN=~a" (car domains))
+                       "-addext" (format #f "subjectAltName=~{DNS:~a~^,~}"
+                                         domains))
+
+              (system* openssl "x509"
+                       "-req" "-sha256" "-CAcreateserial"
+                       "-days" (number->string (* 20 365))
+                       "-copy_extensions=copyall"
+                       "-in" csr-path
+                       "-CA" "/etc/snakeoil/root-cert.pem"
+                       "-CAkey" "/etc/snakeoil/private/key.pem"
+                       "-out" cert-path "-days" (number->string (* 20 365)))
+
+              (symlink "../../../snakeoil/root-cert.pem" chain-link-path)
+
+              ;; Concatenate cert.pem and chain.pem into fullchain.pem.
+              (with-output-to-file fullchain-path
+                (lambda _
+                  (for-each (lambda (part)
+                              (call-with-input-file part
+                                (compose display get-string-all)))
+                            (list cert-path chain-link-path))))
+
+              (delete-file csr-path)
+
+              (map chown-file
+                   (list tmp-dir cert-path fullchain-path))
+
+              (when key-group-owner
+                (chown key-path -1  (if (integer? key-group-owner)
+                                        key-group-owner
+                                        (group:gid (getgr key-group-owner))))
+                (chmod key-path #o640))
+
+              (rename-file tmp-dir cert-dir))))
+
+        (map issue-cert
+             '#$(map snakeoil-cert-configuration-name certificates)
+             '#$(map snakeoil-cert-configuration-domains certificates)
+             '#$(map snakeoil-cert-configuration-key-group-owner
+                     certificates)))))
+
+(define snakeoil-service-type
+  (service-type
+   (name 'snakeoil)
+   (extensions
+    (list (service-extension activation-service-type snakeoil-activation)))
+   (compose concatenate)
+   (extend (lambda (config extra-certificates)
+             (snakeoil-configuration
+              (inherit config)
+              (certificates (append
+                             (snakeoil-configuration-certificates config)
+                             extra-certificates)))))
+   (default-value (snakeoil-configuration))
+   (description "Generate self-issued TLS certificates.")))