From patchwork Sat Jan 11 19:12:32 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: =?utf-8?q?S=C3=B6ren_Tempel?= X-Patchwork-Id: 36977 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 5A48727BBEA; Sat, 11 Jan 2025 19:15:17 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-7.6 required=5.0 tests=BAYES_00,DKIMWL_WL_HIGH, DKIM_SIGNED,DKIM_VALID,MAILING_LIST_MULTI,RCVD_IN_DNSWL_BLOCKED, RCVD_IN_VALIDITY_CERTIFIED,RCVD_IN_VALIDITY_RPBL,RCVD_IN_VALIDITY_SAFE, SPF_HELO_PASS,URIBL_BLOCKED autolearn=ham autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id E398527BBE2 for ; Sat, 11 Jan 2025 19:15:14 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1tWgwq-0005Bb-44; Sat, 11 Jan 2025 14:15:04 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1tWgwo-0005Ad-Ru for guix-patches@gnu.org; Sat, 11 Jan 2025 14:15:03 -0500 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1tWgwo-0001Po-H8 for guix-patches@gnu.org; Sat, 11 Jan 2025 14:15:02 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=debbugs.gnu.org; s=debbugs-gnu-org; h=MIME-Version:Date:From:To:In-Reply-To:References:Subject; bh=Mv7/IO9TN/X3toLBpqZ0gR7XfDTe5nAioj29ymRJKJM=; b=CSPQZW+vJzUPoj8gxpvGGfbnjfAoF8GhaDPTnekY4lcV25rZpUkPXT32zxu/KsdEYqESaDxcZI/2Aj8tGFbrxwfLQmKT9mVeYasRWcTAXMT7EJ0eBmnfZMrfwsBSDIWEc+LtO0UqATt3EJs1k1jVmMtQofBCjYEJKEDPgsgfqKAmT6IaFZSgSuEfA7ITjPhgH6t1ucLotAK61m//m2RChUzylXxtGAqxxGojnSn4Su3IJPIuyv6mwfkn6dl0XQimwT0uI92iKaBuETWY4KkwPe2bogyb8rJfJbl160CWxkAzKbxEQp3Sy6lDQ6FLE5Ry800JzrF7qtOqN0mGtKaoPQ==; Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1tWgwo-00076X-Ci for guix-patches@gnu.org; Sat, 11 Jan 2025 14:15:02 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#68757] [PATCH v4 1/1] services: dns: Add unbound service References: <20240127121040.7156-2-soeren@soeren-tempel.net> In-Reply-To: <20240127121040.7156-2-soeren@soeren-tempel.net> Resent-From: soeren@soeren-tempel.net Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sat, 11 Jan 2025 19:15:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 68757 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 68757@debbugs.gnu.org Received: via spool by 68757-submit@debbugs.gnu.org id=B68757.173662284627192 (code B ref 68757); Sat, 11 Jan 2025 19:15:02 +0000 Received: (at 68757) by debbugs.gnu.org; 11 Jan 2025 19:14:06 +0000 Received: from localhost ([127.0.0.1]:44946 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tWgvq-00074S-Ek for submit@debbugs.gnu.org; Sat, 11 Jan 2025 14:14:06 -0500 Received: from magnesium.8pit.net ([45.76.88.171]:39597) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1tWgvm-00073t-TG; Sat, 11 Jan 2025 14:14:01 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; s=opensmtpd; bh=Mv7/IO9T N/X3toLBpqZ0gR7XfDTe5nAioj29ymRJKJM=; h=date:subject:to:from; d=soeren-tempel.net; b=LQHX0e6gYguDU8ViwPlano5V8Qn6oFvDoMNvQ1SXU2oSSKS 1kS4zVXypEWzINZnSiGoFKP9Q3ywhYiN1xdFUkJpihNob0BsQErv1oBhgkHMR83c3mpIJc u4y9Mb6/Klv0a+WxzQd8vlyalf4JQwcbOLq34j2ez52tmn0PsaMCWE= Received: from localhost ( [2a02:560:4d3d:df00:dc2b:c47d:2594:21b8]) by magnesium.8pit.net (OpenSMTPD) with ESMTPSA id d6384b72 (TLSv1.3:TLS_AES_256_GCM_SHA384:256:YES); Sat, 11 Jan 2025 20:13:56 +0100 (CET) From: soeren@soeren-tempel.net Date: Sat, 11 Jan 2025 20:12:32 +0100 Message-ID: <20250111191341.32416-1-soeren@soeren-tempel.net> X-Mailer: git-send-email 2.47.1 MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches From: Sören Tempel 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. --- Changes since v3: Removed service dependency on networking, depend on user-processes instead. Remove some removed variables from the module's export declaration and fix some typos. doc/guix.texi | 95 ++++++++++++++++++++++ gnu/local.mk | 1 + gnu/services/dns.scm | 185 ++++++++++++++++++++++++++++++++++++++++++- gnu/tests/dns.scm | 108 +++++++++++++++++++++++++ 4 files changed, 388 insertions(+), 1 deletion(-) create mode 100644 gnu/tests/dns.scm diff --git a/doc/guix.texi b/doc/guix.texi index caebe3b03c..d9ed112494 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -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) diff --git a/gnu/local.mk b/gnu/local.mk index 1d15be886d..9201230f35 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 532e20e38a..a237c12883 100644 --- a/gnu/services/dns.scm +++ b/gnu/services/dns.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2020 Pierre Langlois ;;; Copyright © 2021 Maxime Devos ;;; Copyright © 2022 Remco van 't Veer +;;; Copyright © 2024 Sören Tempel ;;; ;;; This file is part of GNU Guix. ;;; @@ -52,7 +53,14 @@ (define-module (gnu services dns) knot-resolver-configuration dnsmasq-service-type - dnsmasq-configuration)) + dnsmasq-configuration + + unbound-service-type + unbound-configuration + unbound-configuration + unbound-server + unbound-zone + unbound-remote)) ;;; ;;; Knot DNS. @@ -902,3 +910,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 '(user-processes)) + (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 (file-append shadow "/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 0000000000..057ce63484 --- /dev/null +++ b/gnu/tests/dns.scm @@ -0,0 +1,108 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2025 Sören Tempel +;;; +;;; 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 . + +(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 packages dns) + #:use-module (guix gexp) + #:export (%test-unbound)) + +(define %unbound-os + ;; TODO: Unbound config + (let ((base-os + (simple-operating-system + (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))))