Package: guix-patches;
Reported by: soeren <at> soeren-tempel.net
Date: Sat, 27 Jan 2024 12:13:01 UTC
Severity: normal
Tags: patch
Done: Ludovic Courtès <ludo <at> gnu.org>
Bug is archived. No further changes may be made.
Message #17 received at 68757 <at> debbugs.gnu.org (full text, mbox):
From: soeren <at> soeren-tempel.net To: 68757 <at> debbugs.gnu.org Cc: ludo <at> gnu.org Subject: [PATCH v2 1/1] services: dns: Add unbound service Date: Tue, 7 Jan 2025 19:17:30 +0100
From: Sören Tempel <soeren <at> 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 <at> 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 <at> gmx.com>
;;; Copyright © 2021 Maxime Devos <maximedevos <at> telenet.be>
;;; Copyright © 2022 Remco van 't Veer <remco <at> remworks.net>
+;;; Copyright © 2024 Sören Tempel <soeren <at> 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: ~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))))
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.