mirror/guix
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2025-01-18 13:36:36 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

services: dns: Add unbound service.

Browse source 
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.
(unbound-serialize-alist, unbound-serialize-section)
(unbound-serialize-string, unbound-serialize-boolean)
(unbound-serialize-list-of-strings): New procedures.
(unbound-zone): New record type.
(unbound-serialize-unbound-zone)
(unbound-serialize-list-of-unbound-zone): New procedures.
(unbound-remote): New record type.
(unbound-serialize-unbound-remote): New procedure.
(unbound-server): New record type.
(unbound-serialize-unbound-server): New procedure.
(unbound-configuration): New record type.
(unbound-config-file, unbound-shepherd-service): New procedures.
(unbound-account-service): New variable.
(unbound-service-type): New services.
* gnu/tests/dns.scm: New file.
* gnu/local.mk (GNU_SYSTEM_MODULES): Add it.
* doc/guix.texi (DNS Services): Document it.

Signed-off-by: Ludovic Courtès <ludo@gnu.org>
Change-Id: I4c9646c9e17d4882e596d33ff8f738e1877fa1ae
This commit is contained in:
Sören Tempel 2025-01-08 22:13:54 +01:00 committed by Ludovic Courtès
parent 73e413b6cd
commit 8db6cfe022
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
4 changed files with 399 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

97
doc/guix.texi
View file

@ -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)

1
gnu/local.mk
View file

@ -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 \

192
gnu/services/dns.scm
View file

@ -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))))

110
gnu/tests/dns.scm Normal file
View file

@ -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))))