[bug#68757] [PATCH] services: dns: Add unbound service

[soeren]

From: Sören Tempel <soeren@soeren-tempel.net>

This allows using Unbound as a local DNSSEC-enabled resolver. This
commit also allows configuration of the Unbound DNS resolver via a
Scheme API. Conceptually, the Unbound configuration consists of several
"sections" that contain key-value pairs (see unbound.conf(5)). The
configuration sections are modeled in Scheme using record-type fields,
where each field expects a list of pairs.

A sample configuration, which uses a DoT forwarder, looks as follows:

        (service unbound-service-type
          (unbound-configuration
            (forward-zone
              '((name . ".")
                (forward-addr . "149.112.112.112#dns.quad9.net")
                (forward-addr . "2620:fe::9#dns.quad9.net")
                (forward-tls-upstream . yes)))))

* gnu/service/dns.scm (serialize-list): New procedure.
* gnu/service/dns.scm (unbound-configuration): New record.
* gnu/service/dns.scm (unbound-config-file): New procedure.
* gnu/service/dns.scm (unbound-shepherd-service): New procedure.
* gnu/service/dns.scm (unbound-account-service): New constant.
* gnu/service/dns.scm (unbound-service-type): New services.

Signed-off-by: Sören Tempel <soeren@soeren-tempel.net>
---
 gnu/services/dns.scm | 115 ++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 114 insertions(+), 1 deletion(-)

diff --git a/gnu/services/dns.scm b/gnu/services/dns.scm
index 6608046909..224a4d4c32 100644
--- a/gnu/services/dns.scm
+++ b/gnu/services/dns.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2020 Pierre Langlois <pierre.langlois@gmx.com>
 ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
 ;;; Copyright © 2022 Remco van 't Veer <remco@remworks.net>
+;;; Copyright © 2024 Sören Tempel <soeren@soeren-tempel.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -52,7 +53,19 @@ (define-module (gnu services dns)
             knot-resolver-configuration
 
             dnsmasq-service-type
-            dnsmasq-configuration))
+            dnsmasq-configuration
+
+            unbound-service-type
+            unbound-configuration
+            unbound-configuration?
+            unbound-configuration-server
+            unbound-configuration-remote-control
+            unbound-configuration-forward-zone
+            unbound-configuration-stub-zone
+            unbound-configuration-auth-zone
+            unbound-configuration-view
+            unbound-configuration-python
+            unbound-configuration-dynlib))
 
 ;;;
 ;;; Knot DNS.
@@ -897,3 +910,103 @@ (define dnsmasq-service-type
                              dnsmasq-activation)))
    (default-value (dnsmasq-configuration))
    (description "Run the dnsmasq DNS server.")))
+
+
+;;;
+;;; Unbound.
+;;;
+
+(define-maybe list)
+
+(define (serialize-list field-name lst)
+  ;; Ensure that strings within the unbound configuration
+  ;; are not enclosed in double quotes by the serialization.
+  (define (->string obj)
+    (if (string? obj)
+      obj
+      (object->string obj)))
+
+  #~(string-append
+      #$(string-append (symbol->string field-name) ":\n")
+      #$(apply string-append
+          (map
+            (lambda (pair)
+              (string-append "\t"
+                             (symbol->string (car pair))
+                             ": "
+                             (->string (cdr pair))
+                             "\n"))
+            lst))))
+
+(define-configuration unbound-configuration
+  (server
+    (maybe-list '((interface . "127.0.0.1")
+                  (interface . "::1")
+
+                  ;; TLS certificate bundle for DNS over TLS.
+                  (tls-cert-bundle . "/etc/ssl/certs/ca-certificates.crt")
+
+                  (hide-identity . yes)
+                  (hide-version . yes)))
+    "The server section of the configuration.")
+  (remote-control
+    (maybe-list '((control-enable . yes)
+                  (control-interface . "/run/unbound.sock")))
+    "Configuration of the remote control facility.")
+  (forward-zone
+    maybe-list
+    "Configuration of nameservers to forward queries to.")
+  (stub-zone
+    maybe-list
+    "Configuration of stub zones.")
+  (auth-zone
+    maybe-list
+    "Zones for which unbound should response as an authority server.")
+  (view
+    maybe-list
+    "Configuration of view clauses.")
+  (python
+    maybe-list
+    "Configuration of the Python module.")
+  (dynlib
+    maybe-list
+    "Dynamic library module configuration."))
+
+(define (unbound-config-file config)
+  (mixed-text-file "unbound.conf"
+    (serialize-configuration
+      config
+      unbound-configuration-fields)))
+
+(define (unbound-shepherd-service config)
+  (let ((config-file (unbound-config-file config)))
+    (list (shepherd-service
+            (documentation "Unbound daemon.")
+            (provision '(unbound dns))
+            (requirement '(networking))
+            (actions (list (shepherd-configuration-action config-file)))
+            (start #~(make-forkexec-constructor
+                       (list (string-append #$unbound "/sbin/unbound")
+                             "-d" "-p" "-c" #$config-file)))
+            (stop #~(make-kill-destructor))))))
+
+(define unbound-account-service
+  (list (user-group (name "unbound") (system? #t))
+        (user-account
+         (name "unbound")
+         (group "unbound")
+         (system? #t)
+         (comment "Unbound daemon user")
+         (home-directory "/var/empty")
+         (shell "/run/current-system/profile/sbin/nologin"))))
+
+(define unbound-service-type
+  (service-type (name 'unbound)
+                (description "Run the unbound DNS resolver.")
+                (extensions
+                  (list (service-extension account-service-type
+                                           (const unbound-account-service))
+                        (service-extension shepherd-root-service-type
+                                           unbound-shepherd-service)))
+                (compose concatenate)
+                (default-value (unbound-configuration))))