[bug#68757,v3,1/1] services: dns: Add unbound service
Commit Message
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.
* 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.
* gnu/tests/dns.scm: New file.
* gnu/local.mk: Add new files.
* doc/guix.texi: Add documentation.
Signed-off-by: Sören Tempel <soeren@soeren-tempel.net>
---
Changes since v2: Added a system test and documentation.
doc/guix.texi | 95 +++++++++++++++++++++
gnu/local.mk | 1 +
gnu/services/dns.scm | 192 ++++++++++++++++++++++++++++++++++++++++++-
gnu/tests/dns.scm | 110 +++++++++++++++++++++++++
4 files changed, 397 insertions(+), 1 deletion(-)
create mode 100644 gnu/tests/dns.scm
@@ -34300,6 +34300,101 @@ command-line arguments to @command{dnsmasq} as a list of strings.
@end table
@end deftp
+@subsubheading Unbound Service
+
+@defvar unbound-service-type
+This is the type of the unbound service, whose value should be a
+@code{unbound-configuration} object as in this example:
+
+@lisp
+(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))))))
+@end lisp
+@end defvar
+
+@deftp {Data Type} unbound-configuration
+Available @code{unbound-configuration} fields are:
+
+@table @asis
+@item @code{server} (type: unbound-server)
+General options for the Unbound server.
+
+@item @code{remote-control} (type: unbound-remote)
+Remote control options for the daemon.
+
+@item @code{forward-zone} (default: @code{()}) (type: list-of-unbound-zone)
+A zone for which queries should be forwarded to another resolver.
+
+@item @code{extra-content} (type: maybe-string)
+Raw content to add to the configuration file.
+
+@end table
+@end deftp
+
+@deftp {Data Type} unbound-server
+Available @code{unbound-server} fields are:
+
+@table @asis
+@item @code{interface} (type: maybe-list-of-strings)
+Interfaces listened on for queries from clients.
+
+@item @code{hide-version} (type: maybe-boolean)
+Refuse the version.server and version.bind queries.
+
+@item @code{hide-identity} (type: maybe-boolean)
+Refuse the id.server and hostname.bind queries.
+
+@item @code{tls-cert-bundle} (type: maybe-string)
+Certificate bundle file, used for DNS over TLS.
+
+@item @code{extra-options} (default: @code{()}) (type: alist)
+An association list of options to append.
+
+@end table
+@end deftp
+
+@deftp {Data Type} unbound-remote
+Available @code{unbound-remote} fields are:
+
+@table @asis
+@item @code{control-enable} (type: maybe-boolean)
+Enable remote control.
+
+@item @code{control-interface} (type: maybe-string)
+IP address or local socket path to listen on for remote control.
+
+@item @code{extra-options} (default: @code{()}) (type: alist)
+An association list of options to append.
+
+@end table
+@end deftp
+
+@deftp {Data Type} unbound-zone
+Available @code{unbound-zone} fields are:
+
+@table @asis
+@item @code{name} (type: string)
+Zone name.
+
+@item @code{forward-addr} (type: maybe-list-of-strings)
+IP address of server to forward to.
+
+@item @code{forward-tls-upstream} (type: maybe-boolean)
+Whether the queries to this forwarder use TLS for transport.
+
+@item @code{extra-options} (default: @code{()}) (type: alist)
+An association list of options to append.
+
+@end table
+@end deftp
+
@node VNC Services
@subsection VNC Services
@cindex VNC (virtual network computing)
@@ -832,6 +832,7 @@ GNU_SYSTEM_MODULES = \
%D%/tests/cups.scm \
%D%/tests/databases.scm \
%D%/tests/desktop.scm \
+ %D%/tests/dns.scm \
%D%/tests/dict.scm \
%D%/tests/docker.scm \
%D%/tests/emacs.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.")))
+
+
+;;;
+;;; 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: ~s~%" #$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))))
new file mode 100644
@@ -0,0 +1,110 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2025 Sören Tempel <soeren@soeren-tempel.net>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu tests dns)
+ #:use-module (gnu tests)
+ #:use-module (gnu system)
+ #:use-module (gnu system vm)
+ #:use-module (gnu services)
+ #:use-module (gnu services dns)
+ #:use-module (gnu services networking)
+ #:use-module (gnu packages dns)
+ #:use-module (guix gexp)
+ #:export (%test-unbound))
+
+(define %unbound-os
+ ;; TODO: Unbound config
+ (let ((base-os
+ (simple-operating-system
+ (service dhcp-client-service-type)
+ (service unbound-service-type
+ (unbound-configuration
+ (server
+ (unbound-server
+ (interface '("127.0.0.1" "::1"))
+ (extra-options
+ '((local-data . "example.local A 192.0.2.1"))))))))))
+ (operating-system
+ (inherit base-os)
+ (packages
+ (append (list
+ `(,isc-bind "utils")
+ unbound)
+ (operating-system-packages base-os))))))
+
+(define (run-unbound-test)
+ "Run tests in %unbound-os with a running unbound daemon on localhost."
+ (define os
+ (marionette-operating-system
+ %unbound-os
+ #:imported-modules '((gnu services herd))))
+
+ (define vm
+ (virtual-machine os))
+
+ (define test
+ (with-imported-modules '((gnu build marionette))
+ #~(begin
+ (use-modules (srfi srfi-64)
+ (gnu build marionette))
+ (define marionette
+ (make-marionette (list #$vm)))
+
+ (test-runner-current (system-test-runner #$output))
+ (test-begin "unbound")
+
+ (test-assert "service is running"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+
+ ;; Make sure the 'unbound-control' and 'host' command is found.
+ (setenv "PATH" "/run/current-system/profile/bin:/run/current-system/profile/sbin")
+
+ (start-service 'unbound))
+ marionette))
+
+ (test-equal "unbound remote control works"
+ 0
+ (marionette-eval
+ '(status:exit-val
+ (system* "unbound-control" "-s" "/run/unbound.sock" "status"))
+ marionette))
+
+ ;; We use a custom local-data A record here to avoid depending
+ ;; on network access and being able to contact the root servers.
+ (test-equal "resolves local-data domain"
+ "192.0.2.1"
+ (marionette-eval
+ '(begin
+ (use-modules (ice-9 popen) (rnrs io ports))
+
+ (let* ((port (open-input-pipe "dig @127.0.0.1 example.local +short"))
+ (out (get-string-all port)))
+ (close-port port)
+ (string-drop-right out 1))) ;; drop newline
+ marionette))
+
+ (test-end))))
+ (gexp->derivation "unbound-test" test))
+
+(define %test-unbound
+ (system-test
+ (name "unbound")
+ (description "Test that the unbound can respond to queries.")
+ (value (run-unbound-test))))