projects/guix·blob python-team · refs

197 lines · 8.1 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2022, 2026 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 ratpoison)
26 #:use-module (gnu packages vnc)
27 #:use-module (gnu packages xorg)
28 #:use-module (gnu services)
29 #:use-module (gnu services dbus)
30 #:use-module (gnu services desktop)
31 #:use-module (gnu services lightdm)
32 #:use-module (gnu services networking)
33 #:use-module (gnu services ssh)
34 #:use-module (gnu services vnc)
35 #:use-module (gnu services xorg)
36 #:use-module (gnu system)
37 #:use-module (gnu system file-systems)
38 #:use-module (gnu system shadow)
39 #:use-module (gnu system vm)
40 #:use-module (gnu tests)
41 #:use-module (guix gexp)
42 #:use-module (guix modules)
43 #:export (%test-xvnc))
44
45;;; For manual inspection/troubleshooting:
46;;;
47;;; ./pre-inst-env guix system vm -e '(@@ (gnu tests vnc) %xvnc-os)'
48;;;
49
50(define %xvnc-os
51 (operating-system
52 ;; Usual boilerplate.
53 (host-name "komputilo")
54 (timezone "Europe/Berlin")
55 (locale "en_US.UTF-8")
56 (bootloader (bootloader-configuration
57 (bootloader grub-bootloader)
58 (targets '("/dev/sdX"))))
59 (file-systems (cons (file-system
60 (device (file-system-label "my-root"))
61 (mount-point "/")
62 (type "ext4"))
63 %base-file-systems))
64
65 (users (cons (user-account
66 (name "dummy")
67 (group "users")
68 (password "") ;empty password
69 (supplementary-groups '("wheel" "netdev"
70 "audio" "video")))
71 %base-user-accounts))
72 (packages (cons* ratpoison tigervnc-client %base-packages))
73 (services (cons*
74 (service openssh-service-type (openssh-configuration
75 (permit-root-login #t)
76 (allow-empty-passwords? #t)))
77 (service xvnc-service-type (xvnc-configuration
78 (display-number 5) ;port 5905
79 (security-types (list "None"))
80 (log-level 100)
81 (localhost? #f)
82 (xdmcp? #t)
83 (inetd? #t)))
84 (service lightdm-service-type
85 (lightdm-configuration
86 (allow-empty-passwords? #t)
87 (debug? #t)
88 (xdmcp? #t)
89 (seats (list (lightdm-seat-configuration
90 ;; XXX: XDMCP sessions only use the
91 ;; 'Seat:*' section (see:
92 ;; <https://github.com/ubuntu/lightdm/issues/474>).
93 (name "*")
94 (user-session "ratpoison"))
95 (lightdm-seat-configuration
96 ;; Auto-login local users.
97 (name "seat*")
98 (autologin-user "dummy"))))))
99 (modify-services %desktop-services
100 (delete gdm-service-type))))))
101
102(define (run-xvnc-test)
103 "Run tests in %XVNC-OS."
104
105 (define os (marionette-operating-system
106 %xvnc-os
107 #:imported-modules (source-module-closure
108 '((gnu services herd)))))
109
110 (define vm (virtual-machine
111 (operating-system os)
112 (memory-size 1024)))
113
114 (define ocr (file-append ocrad "/bin/ocrad"))
115
116 (define test
117 (with-imported-modules (source-module-closure
118 '((gnu build marionette)
119 (guix build utils)))
120 #~(begin
121 (use-modules (gnu build marionette)
122 (srfi srfi-26)
123 (srfi srfi-64))
124
125 (let ((marionette (make-marionette (list #$vm))))
126
127 (test-runner-current (system-test-runner #$output))
128 (test-begin "xvnc")
129
130 (test-assert "service running"
131 (marionette-eval
132 '(begin
133 (use-modules (gnu services herd))
134 (start-service 'xvnc))
135 marionette))
136
137 (test-assert "wait for port 5905, IPv4"
138 (wait-for-tcp-port 5905 marionette))
139
140 (test-assert "wait for port 5905, IPv6"
141 (wait-for-tcp-port 5905 marionette
142 #:address
143 '(make-socket-address
144 AF_INET6 (inet-pton AF_INET6 "::1") 5905)))
145
146 (test-group "vnc lands on the lightdm login screen"
147 ;; This test runs vncviewer on the local VM and verifies that it
148 ;; manages to access the LightDM login screen via XDMCP.
149 (define (ratpoison-abort)
150 (marionette-control "sendkey ctrl-g" marionette))
151
152 (define (ratpoison-help)
153 (marionette-control "sendkey ctrl-t" marionette)
154 (marionette-type "?" marionette)
155 (sleep 1)) ;wait for help screen to appear
156
157 (define (ratpoison-exec command)
158 (marionette-control "sendkey ctrl-t" marionette)
159 (marionette-type "!" marionette)
160 (marionette-type (string-append command "\n") marionette))
161
162 ;; Wait until the ratpoison help screen can be displayed; this
163 ;; means the window manager is ready.
164 ;; XXX: The letters are half of the height preferred by
165 ;; GNU Ocrad, scale it by 2.
166 (test-assert "window manager is ready"
167 (wait-for-screen-text marionette
168 (cut string-contains <> "key bindings")
169 #:ocr #$ocr
170 #:ocr-arguments '("--scale=2")
171 #:pre-action ratpoison-help
172 #:post-action ratpoison-abort))
173
174 ;; Run vncviewer and expect the LightDM login screen (accessed via
175 ;; XDMCP). This can take a while to appear on slower machines.
176 (ratpoison-exec "vncviewer localhost:5905")
177
178 (test-assert "LightDM login screen ready"
179 ;; GNU Ocrad fails to recognize the "Unlock" button text, so use
180 ;; Tesseract.
181 (wait-for-screen-text marionette
182 (cut string-contains <> "Unlock")
183 #:ocr #$(file-append tesseract-ocr
184 "/bin/tesseract")
185 #:timeout 60))) ;for slow systems
186
187 (test-end)))))
188
189 (gexp->derivation "xvnc-test" test))
190
191(define %test-xvnc
192 (system-test
193 (name "xvnc")
194 (description "Basic tests for the Xvnc service. One of the tests validate
195that XDMCP works with LightDM, and is therefore heavy in terms of disk and memory
196requirements.")
197 (value (run-xvnc-test))))