projects/guix·blob python-team · refs

164 lines · 6.1 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2022, 2023 Maxim Cournoyer <[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 lightdm)
20 #:use-module (gnu bootloader)
21 #:use-module (gnu bootloader grub)
22 #:use-module (gnu packages)
23 #:use-module (gnu packages ocr)
24 #:use-module (gnu packages ratpoison)
25 #:use-module (gnu packages vnc)
26 #:use-module (gnu packages xorg)
27 #:use-module (gnu services)
28 #:use-module (gnu services base)
29 #:use-module (gnu services dbus)
30 #:use-module (gnu services desktop)
31 #:use-module (gnu services networking)
32 #:use-module (gnu services lightdm)
33 #:use-module (gnu services ssh)
34 #:use-module (gnu services xorg)
35 #:use-module (gnu system)
36 #:use-module (gnu system file-systems)
37 #:use-module (gnu system keyboard)
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 #:use-module (srfi srfi-1)
44 #:export (%test-lightdm))
45
46(define minimal-desktop-services
47 (list polkit-wheel-service
48 (service upower-service-type)
49 (service accountsservice-service-type)
50 (service polkit-service-type)
51 (service elogind-service-type)
52 (service dbus-root-service-type)
53 (service x11-socket-directory-service-type)))
54
55(define %lightdm-os
56 (operating-system
57 (inherit %simple-os)
58 (packages (cons* ocrad ratpoison xterm %base-packages))
59 (services
60 (cons* (set-xorg-configuration (xorg-configuration
61 (keyboard-layout (keyboard-layout "us")))
62 lightdm-service-type)
63
64 (service lightdm-service-type
65 (lightdm-configuration
66 (allow-empty-passwords? #t)
67 (debug? #t)
68 (xdmcp? #t)
69 (vnc-server? #t)
70 (vnc-server-command
71 (file-append tigervnc-server "/bin/Xvnc"
72 " -SecurityTypes None"))
73 (greeters (list (lightdm-gtk-greeter-configuration
74 (allow-debugging? #t))))
75 (seats (list (lightdm-seat-configuration
76 (name "*")
77 (user-session "ratpoison"))))))
78
79 ;; For debugging.
80 (service dhcpcd-service-type)
81 (service openssh-service-type
82 (openssh-configuration
83 (permit-root-login #t)
84 (allow-empty-passwords? #t)))
85 (append minimal-desktop-services
86 (remove (lambda (service)
87 (eq? (service-kind service) guix-service-type))
88 %base-services))))))
89
90(define (run-lightdm-test)
91 "Run tests in %LIGHTDM-OS."
92
93 (define os (marionette-operating-system
94 %lightdm-os
95 #:imported-modules (source-module-closure
96 '((gnu services herd)))))
97
98 (define vm (virtual-machine
99 (operating-system os)
100 (memory-size 700))) ;uses about 616 MiB
101
102 (define test
103 (with-imported-modules (source-module-closure
104 '((gnu build marionette)))
105 #~(begin
106 (use-modules (gnu build marionette)
107 (srfi srfi-26)
108 (srfi srfi-64))
109
110 (let ((marionette (make-marionette (list #$vm))))
111
112 (test-runner-current (system-test-runner #$output))
113 (test-begin "lightdm")
114
115 (test-assert "service is running"
116 (marionette-eval
117 '(begin
118 (use-modules (gnu services herd))
119 (start-service 'lightdm))
120 marionette))
121
122 (test-assert "service can be stopped"
123 (marionette-eval
124 '(begin
125 (use-modules (gnu services herd))
126 (stop-service 'lightdm))
127 marionette))
128
129 (test-assert "service can be restarted"
130 (marionette-eval
131 '(begin
132 (use-modules (gnu services herd))
133 (restart-service 'lightdm))
134 marionette))
135
136 (test-assert "login screen is displayed"
137 ;; GNU Ocrad fails to recognize the "Log In" button text, so use
138 ;; Tesseract.
139 (wait-for-screen-text marionette
140 (cut string-contains <> "Log In")
141 #:ocr #$(file-append tesseract-ocr
142 "/bin/tesseract")
143 #:timeout 60)) ;for slow systems
144
145 (test-assert "can connect to TCP port 5900 on IPv4"
146 (wait-for-tcp-port 5900 marionette))
147
148 (test-assert "can connect to TCP port 5900 on IPv6"
149 (wait-for-tcp-port 5900 marionette
150 #:address
151 `(make-socket-address
152 AF_INET6
153 (inet-pton AF_INET6 "::1")
154 5900)))
155
156 (test-end)))))
157
158 (gexp->derivation "lightdm-test" test))
159
160(define %test-lightdm
161 (system-test
162 (name "lightdm")
163 (description "Basic tests for the LightDM service.")
164 (value (run-lightdm-test))))