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

[soeren@soeren-tempel.net]

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. The API currently provides very common options and
includes an escape hatch to enable less common configurations.

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

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

* gnu/service/dns.scm (unbound-serialize-field): New procedure.
* gnu/service/dns.scm (unbound-serialize-alist): New procedure.
* gnu/service/dns.scm (unbound-serialize-section): New procedure.
* gnu/service/dns.scm (unbound-serialize-string): New procedure.
* gnu/service/dns.scm (unbound-serialize-boolean): New procedure.
* gnu/service/dns.scm (unbound-serialize-list-of-strings): New procedure.
* gnu/service/dns.scm (unbound-zone): New record.
* gnu/service/dns.scm (unbound-serialize-unbound-zone): New procedure.
* gnu/service/dns.scm (unbound-serialize-list-of-unbound-zone): New procedure.
* gnu/service/dns.scm (unbound-remote): New record.
* gnu/service/dns.scm (unbound-serialize-unbound-remote): New procedure.
* gnu/service/dns.scm (unbound-server): New record.
* gnu/service/dns.scm (unbound-serialize-unbound-server): 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>
---
Changes since v1: This revision revises unbound-configuration to use
record types with the most common options as record fields instead of
association-list, as requested by ludo@.

 gnu/services/dns.scm | 192 ++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 191 insertions(+), 1 deletion(-)

diff --git a/gnu/services/dns.scm b/gnu/services/dns.scm
index 532e20e38a..efef5f0fed 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,21 @@ (define-module (gnu services dns)
             knot-resolver-configuration
 
             dnsmasq-service-type
-            dnsmasq-configuration))
+            dnsmasq-configuration
+
+            unbound-service-type
+            unbound-zone
+            unbound-server
+            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.
@@ -902,3 +917,178 @@ (define dnsmasq-service-type
                              dnsmasq-activation)))
    (default-value (dnsmasq-configuration))
    (description "Run the dnsmasq DNS server.")))
+
+\f
+;;;
+;;; Unbound.
+;;;
+
+(define (unbound-serialize-field field-name value)
+  (let ((field (object->string field-name))
+        (value (cond
+                 ((boolean? value) (if value "yes" "no"))
+                 ((string? value) value)
+                 (else (object->string value)))))
+    (if (string=? field "extra-content")
+      #~(string-append #$value "\n")
+      #~(format #f "	~a: ~a~%" #$field #$value))))
+
+(define (unbound-serialize-alist field-name value)
+  #~(string-append #$@(generic-serialize-alist list
+                                               unbound-serialize-field
+                                               value)))
+
+(define (unbound-serialize-section section-name value fields)
+  #~(format #f "~a:~%~a"
+            #$(object->string section-name)
+            #$(serialize-configuration value fields)))
+
+(define unbound-serialize-string unbound-serialize-field)
+(define unbound-serialize-boolean unbound-serialize-field)
+
+(define-maybe string (prefix unbound-))
+(define-maybe list-of-strings (prefix unbound-))
+(define-maybe boolean (prefix unbound-))
+
+(define (unbound-serialize-list-of-strings field-name value)
+  #~(string-append #$@(map (cut unbound-serialize-string field-name <>) value)))
+
+(define-configuration unbound-zone
+  (name
+    string
+    "Zone name.")
+
+  (forward-addr
+    maybe-list-of-strings
+    "IP address of server to forward to.")
+
+  (forward-tls-upstream
+    maybe-boolean
+    "Whether the queries to this forwarder use TLS for transport.")
+
+  (extra-options
+   (alist '())
+   "An association list of options to append.")
+
+  (prefix unbound-))
+
+(define (unbound-serialize-unbound-zone field-name value)
+  (unbound-serialize-section field-name value unbound-zone-fields))
+
+(define (unbound-serialize-list-of-unbound-zone field-name value)
+  #~(string-append #$@(map (cut unbound-serialize-unbound-zone field-name <>)
+                           value)))
+
+(define list-of-unbound-zone? (list-of unbound-zone?))
+
+(define-configuration unbound-remote
+  (control-enable
+    maybe-boolean
+    "Enable remote control.")
+
+  (control-interface
+    maybe-string
+    "IP address or local socket path to listen on for remote control.")
+
+  (extra-options
+   (alist '())
+   "An association list of options to append.")
+
+  (prefix unbound-))
+
+(define (unbound-serialize-unbound-remote field-name value)
+  (unbound-serialize-section field-name value unbound-remote-fields))
+
+(define-configuration unbound-server
+  (interface
+    maybe-list-of-strings
+    "Interfaces listened on for queries from clients.")
+
+  (hide-version
+    maybe-boolean
+    "Refuse the version.server and version.bind queries.")
+
+  (hide-identity
+    maybe-boolean
+    "Refuse the id.server and hostname.bind queries.")
+
+  (tls-cert-bundle
+    maybe-string
+    "Certificate bundle file, used for DNS over TLS.")
+
+  (extra-options
+   (alist '())
+   "An association list of options to append.")
+
+  (prefix unbound-))
+
+(define (unbound-serialize-unbound-server field-name value)
+  (unbound-serialize-section field-name value unbound-server-fields))
+
+(define-configuration unbound-configuration
+  (server
+    (unbound-server
+      (unbound-server
+        (interface '("127.0.0.1" "::1"))
+
+        (hide-version #t)
+        (hide-identity #t)
+
+        (tls-cert-bundle "/etc/ssl/certs/ca-certificates.crt")))
+    "General options for the Unbound server.")
+
+  (remote-control
+    (unbound-remote
+      (unbound-remote
+        (control-enable #t)
+        (control-interface "/run/unbound.sock")))
+    "Remote control options for the daemon.")
+
+  (forward-zone
+    (list-of-unbound-zone '())
+    "A zone for which queries should be forwarded to another resolver.")
+
+  (extra-content
+    maybe-string
+    "Raw content to add to the configuration file.")
+
+  (prefix unbound-))
+
+(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))))