gnu/tests/vnc.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>.
   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 vnc)
  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 glib)
  25   #:use-module (gnu packages gnome)
  26   #:use-module (gnu packages ratpoison)
  27   #:use-module (gnu packages vnc)
  28   #:use-module (gnu packages xorg)
  29   #:use-module (gnu services)
  30   #:use-module (gnu services dbus)
  31   #:use-module (gnu services desktop)
  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 (define %xvnc-os
  46   (operating-system
  47     ;; Usual boilerplate.
  48     (host-name "komputilo")
  49     (timezone "Europe/Berlin")
  50     (locale "en_US.UTF-8")
  51     (bootloader (bootloader-configuration
  52                  (bootloader grub-bootloader)
  53                  (targets '("/dev/sdX"))))
  54     (file-systems (cons (file-system
  55                           (device (file-system-label "my-root"))
  56                           (mount-point "/")
  57                           (type "ext4"))
  58                         %base-file-systems))
  59
  60     (users (cons (user-account
  61                   (name "dummy")
  62                   (group "users")
  63                   (supplementary-groups '("wheel" "netdev"
  64                                           "audio" "video")))
  65                  %base-user-accounts))
  66     (packages (cons* dbus               ;for dbus-run-session
  67                      dconf
  68                      `(,glib "bin")
  69                      glib
  70                      gnome-settings-daemon ;for schemas
  71                      ratpoison
  72                      tigervnc-client
  73                      xterm
  74                      %base-packages))
  75     (services (cons*
  76                (service openssh-service-type (openssh-configuration
  77                                               (permit-root-login #t)
  78                                               (allow-empty-passwords? #t)))
  79                (service xvnc-service-type (xvnc-configuration
  80                                            (display-number 5)
  81                                            (security-types (list "None"))
  82                                            (log-level 100)
  83                                            (localhost? #f)
  84                                            (xdmcp? #t)
  85                                            (inetd? #t)))
  86                (modify-services %desktop-services
  87                  (gdm-service-type config => (gdm-configuration
  88                                               (inherit config)
  89                                               (auto-login? #t)
  90                                               (auto-suspend? #f)
  91                                               (default-user "root")
  92                                               (debug? #t)
  93                                               (xdmcp? #t))))))))
  94
  95 (define (run-xvnc-test)
  96   "Run tests in %XVNC-OS."
  97
  98   (define os (marionette-operating-system
  99               %xvnc-os
 100               #:imported-modules (source-module-closure
 101                                   '((gnu services herd)))))
 102
 103   (define vm (virtual-machine
 104               (operating-system os)
 105               (memory-size 1024)))
 106
 107   (define test
 108     (with-imported-modules (source-module-closure
 109                             '((gnu build marionette)
 110                               (guix build utils)))
 111       #~(begin
 112           (use-modules (gnu build marionette)
 113                        (guix build utils)
 114                        (srfi srfi-26)
 115                        (srfi srfi-64))
 116
 117           (let ((marionette (make-marionette (list #$vm))))
 118
 119             (test-runner-current (system-test-runner #$output))
 120             (test-begin "xvnc")
 121
 122             (test-assert "service running"
 123               (marionette-eval
 124                '(begin
 125                   (use-modules (gnu services herd))
 126                   (start-service 'xvnc))
 127                marionette))
 128
 129             (test-assert "wait for port 5905, IPv4"
 130               (wait-for-tcp-port 5905 marionette))
 131
 132             (test-assert "wait for port 5905, IPv6"
 133               (wait-for-tcp-port 5905 marionette
 134                                  #:address
 135                                  '(make-socket-address
 136                                    AF_INET6 (inet-pton AF_INET6 "::1") 5905)))
 137
 138             (test-assert "gdm auto-suspend is disabled"
 139               ;; More a GDM than a Xvnc test, but since it's a cross-cutting
 140               ;; concern and we have everything set up here, we might as well
 141               ;; check it here.
 142               (marionette-eval
 143                '(begin
 144                   ;; Check that DCONF_PROFILE is set...
 145                   (invoke "/bin/sh" "-lc" "\
 146 pgrep gdm | head -n1 | xargs -I{} grep -Fq DCONF_PROFILE /proc/{}/environ")
 147
 148                   ;; ... and that
 149                   (invoke "/bin/sh" "-lc" "\
 150 sudo -E -u gdm env DCONF_PROFILE=/etc/dconf/profile/gdm dbus-run-session \
 151 gsettings get org.gnome.settings-daemon.plugins.power sleep-inactive-ac-type \
 152 | grep -Fq nothing"))
 153                marionette))
 154
 155             (test-assert "vnc lands on the gdm login screen"
 156               ;; This test runs vncviewer on the local VM and verifies that it
 157               ;; manages to access the GDM login screen (via XDMCP).
 158               (begin
 159                 (define (ratpoison-abort)
 160                   (marionette-control "sendkey ctrl-g" marionette))
 161
 162                 (define (ratpoison-help)
 163                   (marionette-control "sendkey ctrl-t" marionette)
 164                   (marionette-type "?" marionette)
 165                   (sleep 1))            ;wait for help screen to appear
 166
 167                 (define (ratpoison-exec command)
 168                   (marionette-control "sendkey ctrl-t" marionette)
 169                   (marionette-type "!" marionette)
 170                   (marionette-type (string-append command "\n") marionette))
 171
 172                 ;; Wait until the ratpoison help screen can be displayed; this
 173                 ;; means the window manager is ready.
 174                 (wait-for-screen-text marionette
 175                                       (cut string-contains <> "key bindings")
 176                                       #:ocr #$(file-append tesseract-ocr
 177                                                            "/bin/tesseract")
 178                                       #:pre-action ratpoison-help
 179                                       #:post-action ratpoison-abort)
 180
 181                 ;; Run vncviewer and expect the GDM login screen (accessed via
 182                 ;; XDMCP).  This can take a while to appear on slower machines.
 183                 (ratpoison-exec "vncviewer localhost:5905")
 184                 ;; XXX: tesseract narrowly recognizes "Guix" as "uix" from the
 185                 ;; background image; ocrad fares worst.  Sadly, 'Username' is
 186                 ;; not recognized at all.
 187                 (wait-for-screen-text marionette
 188                                       (cut string-contains <> "uix")
 189                                       #:ocr #$(file-append tesseract-ocr
 190                                                            "/bin/tesseract")
 191                                       #:timeout 120)))
 192
 193             (test-end)))))
 194
 195   (gexp->derivation "xvnc-test" test))
 196
 197 (define %test-xvnc
 198   (system-test
 199    (name "xvnc")
 200    (description "Basic tests for the Xvnc service.  One of the tests validate
 201 that XDMCP works with GDM, and is therefore heavy in terms of disk and memory
 202 requirements.")
 203    (value (run-xvnc-test))))