projects/guix·blob python-team · refs

358 lines · 13.4 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2017, 2021, 2023 Ludovic Courtès <[email protected]>
3;;; Copyright © 2021 muradm <[email protected]>
4;;; Copyright © 2026 Maxim Cournoyer <[email protected]>
5;;;
6;;; This file is part of GNU Guix.
7;;;
8;;; GNU Guix is free software; you can redistribute it and/or modify it
9;;; under the terms of the GNU General Public License as published by
10;;; the Free Software Foundation; either version 3 of the License, or (at
11;;; your option) any later version.
12;;;
13;;; GNU Guix is distributed in the hope that it will be useful, but
14;;; WITHOUT ANY WARRANTY; without even the implied warranty of
15;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16;;; GNU General Public License for more details.
17;;;
18;;; You should have received a copy of the GNU General Public License
19;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
20
21(define-module (gnu tests desktop)
22 #:use-module (gnu tests)
23 #:use-module (gnu packages guile)
24 #:use-module (gnu packages shells)
25 #:use-module (gnu services)
26 #:use-module (gnu services base)
27 #:use-module (gnu services dbus)
28 #:use-module (gnu services desktop)
29 #:use-module (gnu system)
30 #:use-module (gnu system vm)
31 #:use-module (guix gexp)
32 #:use-module (srfi srfi-1)
33 #:export (%test-elogind
34 %test-minimal-desktop))
35
36
37;;;
38;;; Elogind.
39;;;
40
41(define (run-elogind-test vm)
42 (define test
43 (with-imported-modules '((gnu build marionette)
44 (guix build syscalls))
45 #~(begin
46 (use-modules (gnu build marionette)
47 (guix build syscalls)
48 (srfi srfi-1)
49 (srfi srfi-26)
50 (srfi srfi-64))
51
52 (define marionette
53 (make-marionette '(#$vm)))
54
55 (test-runner-current (system-test-runner #$output))
56 (test-begin "elogind")
57
58 ;; Log in as root on tty1, and check what 'loginctl' returns.
59 (test-equal "login on tty1"
60 '(("c1" 0 "root" "seat0" "tty1" #false) ;session
61 ("seat0") ;seat
62 (0 "root" #false "active")) ;user
63
64 (begin
65 ;; Wait for tty1.
66 (marionette-eval
67 '(begin
68 (use-modules (gnu services herd))
69 (start-service 'term-tty1)
70 (start-service 'elogind))
71 marionette)
72 (marionette-control "sendkey ctrl-alt-f1" marionette)
73
74 ;; Now we can type.
75 (marionette-type "root\n" marionette)
76 (marionette-type
77 "loginctl list-users --json=pretty > users.json\n"
78 marionette)
79 (marionette-type
80 "loginctl list-seats --json=pretty > seats.json\n"
81 marionette)
82 (marionette-type
83 "loginctl list-sessions --json=pretty > sessions.json\n"
84 marionette)
85
86 ;; Read the three files.
87 (marionette-eval '(use-modules (json parser)
88 (rnrs io ports))
89 marionette)
90 (let ((guest-file (lambda (file keys)
91 (let ((data (first (vector->list
92 (wait-for-file
93 file marionette
94 #:read 'json->scm)))))
95 (map (cut assoc-ref data <>) keys)))))
96 (list (guest-file "/root/sessions.json"
97 '("session" "uid" "user" "seat" "tty" "idle"))
98 (guest-file "/root/seats.json" '("seat"))
99 (guest-file "/root/users.json"
100 '("uid" "user" "linger" "state"))))))
101
102 (test-assert "screendump"
103 (begin
104 (let ((capture (string-append #$output "/tty1.ppm")))
105 (marionette-control
106 (string-append "screendump " capture) marionette)
107 (file-exists? capture))))
108
109 (test-end))))
110
111 (gexp->derivation "elogind" test))
112
113(define %test-elogind
114 (system-test
115 (name "elogind")
116 (description
117 "Test whether we can log in when elogind is enabled, and whether
118'loginctl' reports accurate user, session, and seat information.")
119 (value
120 (let ((os (marionette-operating-system
121 (simple-operating-system
122 (service elogind-service-type)
123 (service polkit-service-type)
124 (service dbus-root-service-type))
125 #:imported-modules '((gnu services herd)
126 (guix combinators))
127 #:extensions (list guile-json-4))))
128 (run-elogind-test (virtual-machine os))))))
129
130
131;;;
132;;; Seatd/greetd based minimal desktop
133;;;
134
135(define %minimal-services
136 (append
137 (modify-services %base-services
138 ;; greetd-service-type provides "greetd" PAM service
139 (delete login-service-type)
140 ;; and can be used in place of mingetty-service-type
141 (delete mingetty-service-type))
142 (list
143 (service seatd-service-type)
144 (service greetd-service-type
145 (greetd-configuration
146 (greeter-supplementary-groups '("input" "video"))
147 (terminals
148 (list
149 ;; we can make any terminal active by default
150 (greetd-terminal-configuration (terminal-vt "1") (terminal-switch #t))
151 ;; we can make environment without XDG_RUNTIME_DIR set
152 ;; even provide our own environment variables
153 (greetd-terminal-configuration
154 (terminal-vt "2")
155 (default-session-command
156 (greetd-agreety-session
157 (command
158 (greetd-user-session
159 (extra-env '(("MY_VAR" . "1")))
160 (xdg-env? #f))))))
161 ;; we can use different shell instead of default bash
162 (greetd-terminal-configuration
163 (terminal-vt "3")
164 (default-session-command
165 (greetd-agreety-session
166 (command
167 (greetd-user-session
168 (command (file-append zsh "/bin/zsh"))
169 (command-args '("-l"))
170 (extra-env '(("MY_VAR" . "1")))
171 (xdg-env? #f))))))
172 ;; we can use any other executable command as greeter
173 (greetd-terminal-configuration
174 (terminal-vt "4")
175 (default-session-command (program-file "my-noop-greeter" #~(exit))))
176 (greetd-terminal-configuration (terminal-vt "5"))
177 (greetd-terminal-configuration (terminal-vt "6"))))))
178 ;; mingetty-service-type can be used in parallel
179 ;; if needed to do so, do not (delete login-service-type)
180 ;; as illustrated above
181 #| (service mingetty-service-type (mingetty-configuration (tty "tty8"))) |#)))
182
183(define-syntax-rule (minimal-operating-system user-services ...)
184 "Return an operating system that includes USER-SERVICES in addition to
185minimal %BASE-SERVICES."
186 (operating-system (inherit %simple-os)
187 (services (cons* user-services ... %minimal-services))))
188
189(define (run-minimal-desktop-test os vm)
190 (define test
191 (with-imported-modules '((gnu build marionette)
192 (guix build syscalls))
193 #~(begin
194 (use-modules (gnu build marionette)
195 (guix build syscalls)
196 (srfi srfi-1)
197 (srfi srfi-64)
198 (ice-9 pretty-print))
199
200 (define marionette
201 (make-marionette #$vm))
202
203 (define (file-get-all-strings fname)
204 (marionette-eval '(use-modules (rnrs io ports)) marionette)
205 (wait-for-file fname marionette #:read 'get-string-all))
206
207 (define (wait-for-unix-socket-m socket)
208 (wait-for-unix-socket socket marionette))
209
210 (mkdir #$output)
211 (chdir #$output)
212
213 (test-runner-current (system-test-runner #$output))
214 (test-begin "minimal-desktop")
215
216 (test-assert "seatd is ready"
217 (wait-for-unix-socket-m "/run/seatd.sock"))
218
219 (test-equal "login user on tty1"
220 "alice\n"
221 (begin
222 ;; Wait for tty1.
223 (marionette-eval
224 '(begin
225 (use-modules (gnu services herd))
226 (start-service 'term-tty1))
227 marionette)
228 (marionette-control "sendkey ctrl-alt-f1" marionette)
229
230 ;; login as root change alice password and exit
231 ;; then login as alice
232 (for-each
233 (lambda (cmd) (marionette-type cmd marionette) (sleep 1))
234 (list
235 "root\n"
236 "passwd alice\n"
237 "alice\n"
238 "alice\n"
239 "exit\n"
240 "alice\n"
241 "alice\n"
242 "id -un > logged-in\n"))
243
244 (file-get-all-strings "/home/alice/logged-in")))
245
246 (test-equal "validate user environment"
247 '("SEATD_SOCK=/run/seatd.sock"
248 "XDG_RUNTIME_DIR=/run/user/1000"
249 "XDG_SEAT=seat0"
250 "XDG_VTNR=1")
251
252 (begin
253 (marionette-type "env > env\n" marionette)
254 (sleep 1)
255
256 (define user-env (string-tokenize
257 (file-get-all-strings "/home/alice/env")))
258
259 (define (expected-var var)
260 (any (lambda (s) (string-contains var s))
261 '("SEATD_SOCK"
262 "XDG_RUNTIME_DIR"
263 "XDG_SEAT"
264 "XDG_VTNR")))
265
266 (sort (filter expected-var user-env) string<?)))
267
268 (test-assert "validate SEATD_SOCK"
269 (begin
270 (marionette-type "env > env\n" marionette)
271 (sleep 1)
272
273 (define (sock-var? var)
274 (any (lambda (s) (string-contains var s))
275 '("SEATD_SOCK")))
276
277 (define (sock-var-sock var)
278 (car (cdr (string-split var #\=))))
279
280 (let*
281 ((out (file-get-all-strings "/home/alice/env"))
282 (out (string-tokenize out))
283 (out (filter sock-var? out))
284 (socks (map sock-var-sock out))
285 (socks (map wait-for-unix-socket-m socks)))
286 (and (= 1 (length socks)) (every identity socks)))))
287
288 (test-equal "seatd.sock ownership"
289 '("root" "seat")
290 `(,(marionette-eval
291 '(passwd:name (getpwuid (stat:uid (stat "/run/seatd.sock"))))
292 marionette)
293 ,(marionette-eval
294 '(group:name (getgrgid (stat:gid (stat "/run/seatd.sock"))))
295 marionette)))
296
297 (test-assert "greetd is ready"
298 (begin
299 (marionette-type "ps -C greetd -o pid,args --no-headers > ps-greetd\n"
300 marionette)
301 (sleep 1)
302
303 (define (greetd-daemon? cmd)
304 (string-contains cmd "config"))
305
306 (define (greetd-cmd-to-pid cmd)
307 (car (string-split cmd #\space)))
308
309 (define (greetd-pid-to-sock pid)
310 (string-append "/run/greetd-" pid ".sock"))
311
312 (let* ((out (file-get-all-strings "/home/alice/ps-greetd"))
313 (out (string-split out #\newline))
314 (out (map string-trim-both out))
315 (out (filter greetd-daemon? out))
316 (pids (map greetd-cmd-to-pid out))
317 (socks (map greetd-pid-to-sock pids))
318 (socks (map wait-for-unix-socket-m socks)))
319 (every identity socks))))
320
321 ;; a bit weak, but tests everything at once actually
322 (test-equal "check /run/user/<uid> mounted and writable"
323 "alice\n"
324 (begin
325 (marionette-type "echo alice > /run/user/1000/test\n" marionette)
326 (file-get-all-strings "/run/user/1000/test")))
327
328 (test-equal "check greeter user has correct groups"
329 "greeter input video\n"
330 (begin
331 (marionette-type "id -Gn greeter > /run/user/1000/greeter-groups\n"
332 marionette)
333 (file-get-all-strings "/run/user/1000/greeter-groups")))
334
335 (test-assert "screendump"
336 (begin
337 (marionette-control (string-append "screendump " #$output
338 "/tty1.ppm")
339 marionette)
340 (file-exists? "tty1.ppm")))
341
342 (test-end))))
343
344 (gexp->derivation "minimal-desktop" test))
345
346(define %test-minimal-desktop
347 (system-test
348 (name "minimal-desktop")
349 (description
350 "Test whether we can log in when seatd and greetd is enabled")
351 (value
352 (let* ((os (marionette-operating-system
353 (minimal-operating-system)
354 #:imported-modules '((gnu services herd)
355 (guix combinators))))
356 (vm (virtual-machine os)))
357 (run-minimal-desktop-test (virtualized-operating-system os '())
358 #~(list #$vm))))))