diff options
| -rw-r--r-- | doc/guix.texi | 97 | ||||
| -rw-r--r-- | gnu/local.mk | 1 | ||||
| -rw-r--r-- | gnu/services/dns.scm | 192 | ||||
| -rw-r--r-- | gnu/tests/dns.scm | 110 |
4 files changed, 399 insertions, 1 deletions
diff --git a/doc/guix.texi b/doc/guix.texi index 42381a7b394..3a64fede2d2 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -135,6 +135,7 @@ Copyright @copyright{} 2024 Nigko Yerden@* Copyright @copyright{} 2024 Troy Figiel@* Copyright @copyright{} 2024 Sharlatan Hellseher@* Copyright @copyright{} 2024 45mg@* +Copyright @copyright{} 2025 Sören Tempel@* Permission is granted to copy, distribute and/or modify this document under the terms of the GNU Free Documentation License, Version 1.3 or @@ -34300,6 +34301,102 @@ 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 service to run @uref{https://www.unbound.net, +Unbound}, a validating, recursive, and caching DNS resolver. Its value +must 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) diff --git a/gnu/local.mk b/gnu/local.mk index 1d15be886da..9201230f35f 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -838,6 +838,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 \ diff --git a/gnu/services/dns.scm b/gnu/services/dns.scm index 532e20e38a9..c74001fac29 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 @@ 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 @@ cache.size = 100 * MB 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)))) diff --git a/gnu/tests/dns.scm b/gnu/tests/dns.scm new file mode 100644 index 00000000000..ff42456760c --- /dev/null +++ b/gnu/tests/dns.scm @@ -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)))) |