projects/guix·blob python-team · refs

180 lines · 6.5 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2016-2020, 2022, 2024-2026 Ludovic Courtès <[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 avahi)
20 #:use-module (gnu tests)
21 #:use-module (gnu system)
22 #:use-module (gnu system nss)
23 #:use-module (gnu system vm)
24 #:use-module (gnu services)
25 #:use-module (gnu services avahi)
26 #:use-module (gnu services base)
27 #:use-module (gnu services dbus)
28 #:use-module (gnu services networking)
29 #:use-module (gnu services shepherd)
30 #:use-module (guix gexp)
31 #:use-module (guix store)
32 #:use-module (guix monads)
33 #:export (%test-nss-mdns))
34
35;;;
36;;; Avahi and NSS-mDNS.
37;;;
38
39(define %avahi-os
40 (operating-system
41 (inherit %simple-os)
42 (name-service-switch %mdns-host-lookup-nss)
43 (services (cons* (service avahi-service-type
44 (avahi-configuration (debug? #t)))
45 (service dbus-root-service-type)
46 (service dhcpcd-service-type) ;needed for multicast
47
48 ;; Enable heavyweight debugging output.
49 (modify-services services
50 (nscd-service-type config
51 => (nscd-configuration
52 (inherit config)
53 (debug-level 3)
54 (log-file "/dev/console")))
55 (shepherd-system-log-service-type
56 config
57 =>
58 (system-log-configuration
59 (inherit config)
60 (message-destination #~(const '("/dev/console"))))))))))
61
62(define (run-nss-mdns-test)
63 ;; Test resolution of '.local' names via libc. Start the marionette service
64 ;; *after* nscd. Failing to do that, libc will try to connect to nscd,
65 ;; fail, then never try again (see '__nss_not_use_nscd_hosts' in libc),
66 ;; leading to '.local' resolution failures.
67 (define os
68 (marionette-operating-system
69 %avahi-os
70 #:requirements '(nscd)
71 #:imported-modules '((gnu services herd)
72 (guix combinators))))
73
74 (define mdns-host-name
75 (string-append (operating-system-host-name os)
76 ".local"))
77
78 (define test
79 (with-imported-modules '((gnu build marionette))
80 #~(begin
81 (use-modules (gnu build marionette)
82 (srfi srfi-1)
83 (srfi srfi-64)
84 (ice-9 match))
85
86 (define marionette
87 (make-marionette (list #$(virtual-machine os))))
88
89 (mkdir #$output)
90 (chdir #$output)
91
92 (test-runner-current (system-test-runner))
93 (test-begin "avahi")
94
95 (test-assert "nscd PID file is created"
96 (marionette-eval
97 '(begin
98 (use-modules (gnu services herd))
99 (start-service 'nscd))
100 marionette))
101
102 (test-assert "nscd is listening on its socket"
103 (marionette-eval
104 ;; XXX: Work around a race condition in nscd: nscd creates its
105 ;; PID file before it is listening on its socket.
106 '(let ((sock (socket PF_UNIX SOCK_STREAM 0)))
107 (let try ()
108 (catch 'system-error
109 (lambda ()
110 (connect sock AF_UNIX "/var/run/nscd/socket")
111 (close-port sock)
112 (format #t "nscd is ready~%")
113 #t)
114 (lambda args
115 (format #t "waiting for nscd...~%")
116 (usleep 500000)
117 (try)))))
118 marionette))
119
120 (test-assert "avahi is running"
121 (marionette-eval
122 '(begin
123 (use-modules (gnu services herd))
124 (start-service 'avahi-daemon))
125 marionette))
126
127 (test-assert "network is up"
128 (marionette-eval
129 '(begin
130 (use-modules (gnu services herd))
131 (start-service 'networking))
132 marionette))
133
134 (test-assert "getaddrinfo .local"
135 ;; Wait for the 'avahi-daemon' service and perform a resolution.
136 (match (marionette-eval
137 '(getaddrinfo #$mdns-host-name)
138 marionette)
139 (((? vector? addrinfos) ..1)
140 (pk 'getaddrinfo addrinfos)
141 (and (any (lambda (ai)
142 (= AF_INET (addrinfo:fam ai)))
143 addrinfos)
144 (any (lambda (ai)
145 (= AF_INET6 (addrinfo:fam ai)))
146 addrinfos)))))
147
148 (test-assert "gethostbyname .local"
149 (match (pk 'gethostbyname
150 (marionette-eval '(gethostbyname #$mdns-host-name)
151 marionette))
152 ((? vector? result)
153 (and (string=? (hostent:name result) #$mdns-host-name)
154 (= (hostent:addrtype result) AF_INET)))))
155
156 (test-equal "avahi-resolve host name"
157 0
158 (marionette-eval
159 '(system* "/run/current-system/profile/bin/avahi-resolve"
160 "--verbose" "--name" #$mdns-host-name)
161 marionette))
162
163 (test-equal "avahi-browse"
164 0
165 (marionette-eval
166 '(system* "/run/current-system/profile/bin/avahi-browse"
167 "--all" "--verbose" "--terminate")
168 marionette))
169
170 (test-end))))
171
172 (gexp->derivation "nss-mdns" test))
173
174(define %test-nss-mdns
175 (system-test
176 (name "nss-mdns")
177 (description
178 "Test Avahi's multicast-DNS implementation, and in particular, test its
179glibc name service switch (NSS) module.")
180 (value (run-nss-mdns-test))))