projects/guix·blob python-team · refs

110 lines · 3.8 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2025 Sören Tempel <[email protected]>
3;;;
4;;; This file is part of GNU Guix.
5;;;
6;;; GNU Guix is free software; you can redistribute it and/or modify it
7;;; under the terms of the GNU General Public License as published by
8;;; the Free Software Foundation; either version 3 of the License, or (at
9;;; your option) any later version.
10;;;
11;;; GNU Guix is distributed in the hope that it will be useful, but
12;;; WITHOUT ANY WARRANTY; without even the implied warranty of
13;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14;;; GNU General Public License for more details.
15;;;
16;;; You should have received a copy of the GNU General Public License
17;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
18
19(define-module (gnu tests dns)
20 #:use-module (gnu tests)
21 #:use-module (gnu system)
22 #:use-module (gnu system vm)
23 #:use-module (gnu services)
24 #:use-module (gnu services dns)
25 #:use-module (gnu services networking)
26 #:use-module (gnu packages dns)
27 #:use-module (guix gexp)
28 #:export (%test-unbound))
29
30(define %unbound-os
31 ;; TODO: Unbound config
32 (let ((base-os
33 (simple-operating-system
34 (service dhcpcd-service-type)
35 (service unbound-service-type
36 (unbound-configuration
37 (server
38 (unbound-server
39 (interface '("127.0.0.1" "::1"))
40 (extra-options
41 '((local-data . "example.local A 192.0.2.1"))))))))))
42 (operating-system
43 (inherit base-os)
44 (packages
45 (append (list
46 `(,isc-bind "utils")
47 unbound)
48 (operating-system-packages base-os))))))
49
50(define (run-unbound-test)
51 "Run tests in %unbound-os with a running unbound daemon on localhost."
52 (define os
53 (marionette-operating-system
54 %unbound-os
55 #:imported-modules '((gnu services herd))))
56
57 (define vm
58 (virtual-machine os))
59
60 (define test
61 (with-imported-modules '((gnu build marionette))
62 #~(begin
63 (use-modules (srfi srfi-64)
64 (gnu build marionette))
65 (define marionette
66 (make-marionette (list #$vm)))
67
68 (test-runner-current (system-test-runner #$output))
69 (test-begin "unbound")
70
71 (test-assert "service is running"
72 (marionette-eval
73 '(begin
74 (use-modules (gnu services herd))
75
76 ;; Make sure the 'unbound-control' and 'host' command is found.
77 (setenv "PATH" "/run/current-system/profile/bin:/run/current-system/profile/sbin")
78
79 (start-service 'unbound))
80 marionette))
81
82 (test-equal "unbound remote control works"
83 0
84 (marionette-eval
85 '(status:exit-val
86 (system* "unbound-control" "-s" "/run/unbound.sock" "status"))
87 marionette))
88
89 ;; We use a custom local-data A record here to avoid depending
90 ;; on network access and being able to contact the root servers.
91 (test-equal "resolves local-data domain"
92 "192.0.2.1"
93 (marionette-eval
94 '(begin
95 (use-modules (ice-9 popen) (rnrs io ports))
96
97 (let* ((port (open-input-pipe "dig @127.0.0.1 example.local +short"))
98 (out (get-string-all port)))
99 (close-port port)
100 (string-drop-right out 1))) ;; drop newline
101 marionette))
102
103 (test-end))))
104 (gexp->derivation "unbound-test" test))
105
106(define %test-unbound
107 (system-test
108 (name "unbound")
109 (description "Test that the unbound can respond to queries.")
110 (value (run-unbound-test))))