projects/guix·blob ruby-team · refs

211 lines · 8.7 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2022 Maxim Cournoyer <[email protected]>.
3;;; Copyright © 2023 Bruno Victal <[email protected]>
4;;;
5;;; This file is part of GNU Guix.
6;;;
7;;; GNU Guix is free software; you can redistribute it and/or modify it
8;;; under the terms of the GNU General Public License as published by
9;;; the Free Software Foundation; either version 3 of the License, or (at
10;;; your option) any later version.
11;;;
12;;; GNU Guix is distributed in the hope that it will be useful, but
13;;; WITHOUT ANY WARRANTY; without even the implied warranty of
14;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;;; GNU General Public License for more details.
16;;;
17;;; You should have received a copy of the GNU General Public License
18;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
19
20(define-module (gnu tests vnc)
21 #:use-module (gnu bootloader)
22 #:use-module (gnu bootloader grub)
23 #:use-module (gnu packages)
24 #:use-module (gnu packages ocr)
25 #:use-module (gnu packages glib)
26 #:use-module (gnu packages gnome)
27 #:use-module (gnu packages ratpoison)
28 #:use-module (gnu packages vnc)
29 #:use-module (gnu packages xorg)
30 #:use-module (gnu services)
31 #:use-module (gnu services dbus)
32 #:use-module (gnu services desktop)
33 #:use-module (gnu services networking)
34 #:use-module (gnu services ssh)
35 #:use-module (gnu services vnc)
36 #:use-module (gnu services xorg)
37 #:use-module (gnu system)
38 #:use-module (gnu system file-systems)
39 #:use-module (gnu system shadow)
40 #:use-module (gnu system vm)
41 #:use-module (gnu tests)
42 #:use-module (guix gexp)
43 #:use-module (guix modules)
44 #:export (%test-xvnc))
45
46(define %xvnc-os
47 (operating-system
48 ;; Usual boilerplate.
49 (host-name "komputilo")
50 (timezone "Europe/Berlin")
51 (locale "en_US.UTF-8")
52 (bootloader (bootloader-configuration
53 (bootloader grub-bootloader)
54 (targets '("/dev/sdX"))))
55 (file-systems (cons (file-system
56 (device (file-system-label "my-root"))
57 (mount-point "/")
58 (type "ext4"))
59 %base-file-systems))
60
61 (users (cons (user-account
62 (name "dummy")
63 (group "users")
64 (supplementary-groups '("wheel" "netdev"
65 "audio" "video")))
66 %base-user-accounts))
67 (packages (cons* dbus ;for dbus-run-session
68 dconf
69 `(,glib "bin")
70 glib
71 gnome-settings-daemon ;for schemas
72 ratpoison
73 tigervnc-client
74 xterm
75 %base-packages))
76 (services (cons*
77 (service openssh-service-type (openssh-configuration
78 (permit-root-login #t)
79 (allow-empty-passwords? #t)))
80 (service xvnc-service-type (xvnc-configuration
81 (display-number 5)
82 (security-types (list "None"))
83 (log-level 100)
84 (localhost? #f)
85 (xdmcp? #t)
86 (inetd? #t)))
87 (modify-services %desktop-services
88 (gdm-service-type config => (gdm-configuration
89 (inherit config)
90 (auto-login? #t)
91 (auto-suspend? #f)
92 (default-user "root")
93 (debug? #t)
94 (xdmcp? #t))))))))
95
96(define (run-xvnc-test)
97 "Run tests in %XVNC-OS."
98
99 (define os (marionette-operating-system
100 %xvnc-os
101 #:imported-modules (source-module-closure
102 '((gnu services herd)))))
103
104 (define vm (virtual-machine
105 (operating-system os)
106 (memory-size 1024)))
107
108 (define ocr (file-append ocrad "/bin/ocrad"))
109
110 (define test
111 (with-imported-modules (source-module-closure
112 '((gnu build marionette)
113 (guix build utils)))
114 #~(begin
115 (use-modules (gnu build marionette)
116 (srfi srfi-26)
117 (srfi srfi-64))
118
119 (let ((marionette (make-marionette (list #$vm))))
120
121 (test-runner-current (system-test-runner #$output))
122 (test-begin "xvnc")
123
124 (test-assert "service running"
125 (marionette-eval
126 '(begin
127 (use-modules (gnu services herd))
128 (start-service 'xvnc))
129 marionette))
130
131 (test-assert "wait for port 5905, IPv4"
132 (wait-for-tcp-port 5905 marionette))
133
134 (test-assert "wait for port 5905, IPv6"
135 (wait-for-tcp-port 5905 marionette
136 #:address
137 '(make-socket-address
138 AF_INET6 (inet-pton AF_INET6 "::1") 5905)))
139
140 (test-assert "gdm auto-suspend is disabled"
141 ;; More a GDM than a Xvnc test, but since it's a cross-cutting
142 ;; concern and we have everything set up here, we might as well
143 ;; check it here.
144 (marionette-eval
145 '(begin
146 (use-modules (guix build utils))
147 ;; Check that DCONF_PROFILE is set...
148 (invoke "/bin/sh" "-lc" "\
149pgrep gdm | head -n1 | xargs -I{} grep -Fq DCONF_PROFILE /proc/{}/environ")
150
151 ;; ... and that 'sleep-inactive-ac-type' is unset.
152 (invoke "/bin/sh" "-lc" "\
153sudo -E -u gdm env DCONF_PROFILE=/etc/dconf/profile/gdm dbus-run-session \
154gsettings get org.gnome.settings-daemon.plugins.power sleep-inactive-ac-type \
155| grep -Fq nothing"))
156 marionette))
157
158 (test-group "vnc lands on the gdm login screen"
159 ;; This test runs vncviewer on the local VM and verifies that it
160 ;; manages to access the GDM login screen (via XDMCP).
161 (define (ratpoison-abort)
162 (marionette-control "sendkey ctrl-g" marionette))
163
164 (define (ratpoison-help)
165 (marionette-control "sendkey ctrl-t" marionette)
166 (marionette-type "?" marionette)
167 (sleep 1)) ;wait for help screen to appear
168
169 (define (ratpoison-exec command)
170 (marionette-control "sendkey ctrl-t" marionette)
171 (marionette-type "!" marionette)
172 (marionette-type (string-append command "\n") marionette))
173
174 ;; Wait until the ratpoison help screen can be displayed; this
175 ;; means the window manager is ready.
176 ;; XXX: The letters are half of the height preferred by
177 ;; GNU Ocrad, scale it by 2.
178 (test-assert "window manager is ready"
179 (wait-for-screen-text marionette
180 (cut string-contains <> "key bindings")
181 #:ocr #$ocr
182 #:ocr-arguments '("--scale=2")
183 #:pre-action ratpoison-help
184 #:post-action ratpoison-abort))
185
186 ;; Run vncviewer and expect the GDM login screen (accessed via
187 ;; XDMCP). This can take a while to appear on slower machines.
188 (ratpoison-exec "vncviewer localhost:5905")
189
190 (test-assert "GDM login screen ready"
191 ;; XXX: The '--invert' argument as the sole option to GNU
192 ;; Ocrad is required for it to recognize "Guix" from the
193 ;; background image. 'Username' from the UI would be a better
194 ;; choice but is not recognized at all.
195 (wait-for-screen-text marionette
196 (cut string-contains <> "Guix")
197 #:ocr #$ocr
198 #:ocr-arguments '("--invert")
199 #:timeout 120))) ;for slow systems
200
201 (test-end)))))
202
203 (gexp->derivation "xvnc-test" test))
204
205(define %test-xvnc
206 (system-test
207 (name "xvnc")
208 (description "Basic tests for the Xvnc service. One of the tests validate
209that XDMCP works with GDM, and is therefore heavy in terms of disk and memory
210requirements.")
211 (value (run-xvnc-test))))