* [bug#58014] [PATCH 02/15] gnu: tigervnc-server: Move source production into origin snippet.
2022-09-23 5:00 ` [bug#58014] [PATCH 01/15] gnu: tigervnc-server: Use new style inputs, gexps Maxim Cournoyer
@ 2022-09-23 5:00 ` Maxim Cournoyer
2022-09-23 5:00 ` [bug#58014] [PATCH 03/15] gnu: tigervnc-server: Adjust PAM config Maxim Cournoyer
` (12 subsequent siblings)
13 siblings, 0 replies; 16+ messages in thread
From: Maxim Cournoyer @ 2022-09-23 5:00 UTC (permalink / raw)
To: 58014; +Cc: Maxim Cournoyer
This will make it possible to patch command references in source files, and
also makes it more transparent as to what sources get used.
* gnu/packages/vnc.scm (tigervnc-server): Re-flow comment.
[source]: Inherit from xorg-server. Add a snippet. Use a patch to apply the
xserver patch. Fix file name.
[phases]{copy-tvnc-xserver, patch-xserver}: Delete phases.
{build-tigervnc, install-tigervnc-aux}: Adjust accordingly.
---
gnu/packages/vnc.scm | 70 ++++++++++++++++++++++++++------------------
1 file changed, 42 insertions(+), 28 deletions(-)
diff --git a/gnu/packages/vnc.scm b/gnu/packages/vnc.scm
index 18244b3334..e06dbcceb9 100644
--- a/gnu/packages/vnc.scm
+++ b/gnu/packages/vnc.scm
@@ -210,20 +210,49 @@ (define-public tigervnc-client
(define %tigervnc-client-source (package-source tigervnc-client))
-;; A VNC server is, in fact, an X server so it seems like a good idea
-;; to build on the work already done for xorg-server package. This is
-;; not entirely compatible with the recommendation in BUILDING.txt
-;; where the client is built first, then the source code of the X
-;; server is copied into a subdir of the build directory, patched with
-;; VNC additions and then build and installed as Xvnc. The procedure
-;; was turned around, where TigerVNC code is downloaded and built
-;; inside the Guix X server build dir. Also, the VNC patching process
-;; for the X server is automated in a straightforward manner.
+;; A VNC server is, in fact, an X server so it seems like a good idea to build
+;; on the work already done for xorg-server package. This is not entirely
+;; compatible with the recommendation in BUILDING.txt where the client is
+;; built first, then the source code of the X server is copied into a subdir
+;; of the build directory, patched with VNC additions and then build and
+;; installed as Xvnc. The procedure was turned around, where TigerVNC code is
+;; downloaded and built inside the Guix X server build dir. Also, the VNC
+;; patching process for the X server is automated in a straightforward manner.
(define-public tigervnc-server
(package
(inherit xorg-server)
(name "tigervnc-server")
(version (package-version tigervnc-client))
+ (source
+ (origin
+ (inherit (package-source xorg-server))
+ (modules '((guix build utils)))
+ (snippet
+ #~(begin
+ ;; Copy the VNC extension into the xorg-server sources.
+ (copy-recursively #$(file-append %tigervnc-client-source
+ "/unix/xserver")
+ ".")
+ ;; Include a full copy of tigervnc-client sources, so that the
+ ;; complete sources involved are available and can be edited during
+ ;; the build.
+ (copy-recursively #$%tigervnc-client-source "tigervnc-client")
+ ;; Adjust the VNC extension build system files so that it refers
+ ;; to it.
+ (substitute* "hw/vnc/Makefile.am"
+ (("(TIGERVNC_SRCDIR=).*" _ head)
+ (string-append head "$(CURDIR)/../../tigervnc-client\n"))
+ (("(TIGERVNC_BUILDDIR=).*" _ head)
+ (string-append head
+ "$(CURDIR)/../../tigervnc-client/build\n")))
+ ;; Ensure the Autotools build system gets re-bootstrapped.
+ (delete-file "configure")))
+ ;; Patch the xorg-server build system so that it builds the VNC
+ ;; extension.
+ (patches (cons (file-append %tigervnc-client-source
+ "/unix/xserver21.1.1.patch")
+ (origin-patches (package-source xorg-server))))
+ (file-name (string-append name "-" version ".tar.xz"))))
(arguments
(substitute-keyword-arguments
(package-arguments xorg-server)
@@ -254,28 +283,13 @@ (define-public tigervnc-server
((#:phases phases)
#~(modify-phases #$phases
(delete 'check) ;no test suite
- (add-after 'unpack 'copy-tvnc-xserver
- (lambda* (#:key inputs #:allow-other-keys)
- (copy-recursively (search-input-directory inputs "unix/xserver")
- ".")
- ;; Adjust Makefile variables default values to simplify usage.
- (substitute* "hw/vnc/Makefile.am"
- (("(TIGERVNC_SRCDIR=).*" _ head)
- (string-append head #$%tigervnc-client-source "\n"))
- (("(TIGERVNC_BUILDDIR=).*" _ head)
- (string-append head (getcwd) "/tigervnc-build\n")))))
- (add-after 'copy-tvnc-xserver 'patch-xserver
- (lambda* (#:key inputs #:allow-other-keys)
- (invoke "patch" "-p1" "-i"
- (search-input-file inputs "unix/xserver21.1.1.patch"))
- (invoke "autoreconf" "-fiv")))
(add-before 'build 'build-tigervnc
(lambda* (#:key parallel-build? #:allow-other-keys)
- (mkdir-p "tigervnc-build")
- (with-directory-excursion "tigervnc-build"
+ (mkdir-p "tigervnc-client/build")
+ (with-directory-excursion "tigervnc-client/build"
(invoke "cmake" "-G" "Unix Makefiles"
(string-append "-DCMAKE_INSTALL_PREFIX=" #$output)
- #$%tigervnc-client-source)
+ "..")
(invoke "make" "-j" (number->string (if parallel-build?
(parallel-job-count)
1))))))
@@ -286,7 +300,7 @@ (define-public tigervnc-server
1)))))
(add-before 'install 'install-tigervnc-aux
(lambda _
- (invoke "make" "-C" "tigervnc-build/unix" "install")))
+ (invoke "make" "-C" "tigervnc-client/build/unix" "install")))
(replace 'install
(lambda _
(invoke "make" "install")))))))
--
2.37.3
^ permalink raw reply related [flat|nested] 16+ messages in thread* [bug#58014] [PATCH 03/15] gnu: tigervnc-server: Adjust PAM config.
2022-09-23 5:00 ` [bug#58014] [PATCH 01/15] gnu: tigervnc-server: Use new style inputs, gexps Maxim Cournoyer
2022-09-23 5:00 ` [bug#58014] [PATCH 02/15] gnu: tigervnc-server: Move source production into origin snippet Maxim Cournoyer
@ 2022-09-23 5:00 ` Maxim Cournoyer
2022-09-23 5:00 ` [bug#58014] [PATCH 04/15] gnu: tigervnc-server: Disable tests via #:tests? Maxim Cournoyer
` (11 subsequent siblings)
13 siblings, 0 replies; 16+ messages in thread
From: Maxim Cournoyer @ 2022-09-23 5:00 UTC (permalink / raw)
To: 58014; +Cc: Maxim Cournoyer
* gnu/packages/vnc.scm (tigervnc-server)
[phases]{adjust-pam-config}: New phase.
---
gnu/packages/vnc.scm | 5 +++++
1 file changed, 5 insertions(+)
diff --git a/gnu/packages/vnc.scm b/gnu/packages/vnc.scm
index e06dbcceb9..4795ccc72a 100644
--- a/gnu/packages/vnc.scm
+++ b/gnu/packages/vnc.scm
@@ -283,6 +283,11 @@ (define-public tigervnc-server
((#:phases phases)
#~(modify-phases #$phases
(delete 'check) ;no test suite
+ (add-after 'unpack 'adjust-pam-config
+ (lambda _
+ (substitute* "tigervnc-client/unix/vncserver/tigervnc.pam"
+ (("pam_systemd.so")
+ "pam_elogind.so"))))
(add-before 'build 'build-tigervnc
(lambda* (#:key parallel-build? #:allow-other-keys)
(mkdir-p "tigervnc-client/build")
--
2.37.3
^ permalink raw reply related [flat|nested] 16+ messages in thread* [bug#58014] [PATCH 04/15] gnu: tigervnc-server: Disable tests via #:tests?.
2022-09-23 5:00 ` [bug#58014] [PATCH 01/15] gnu: tigervnc-server: Use new style inputs, gexps Maxim Cournoyer
2022-09-23 5:00 ` [bug#58014] [PATCH 02/15] gnu: tigervnc-server: Move source production into origin snippet Maxim Cournoyer
2022-09-23 5:00 ` [bug#58014] [PATCH 03/15] gnu: tigervnc-server: Adjust PAM config Maxim Cournoyer
@ 2022-09-23 5:00 ` Maxim Cournoyer
2022-09-23 5:00 ` [bug#58014] [PATCH 05/15] gnu: tigervnc-server: Patch and wrap vncserver script Maxim Cournoyer
` (10 subsequent siblings)
13 siblings, 0 replies; 16+ messages in thread
From: Maxim Cournoyer @ 2022-09-23 5:00 UTC (permalink / raw)
To: 58014; +Cc: Maxim Cournoyer
* gnu/packages/vnc.scm (tigervnc-server)
[tests?]: Set to #f.
[phases]: Restore check phase.
---
gnu/packages/vnc.scm | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)
diff --git a/gnu/packages/vnc.scm b/gnu/packages/vnc.scm
index 4795ccc72a..3731f63846 100644
--- a/gnu/packages/vnc.scm
+++ b/gnu/packages/vnc.scm
@@ -256,6 +256,8 @@ (define-public tigervnc-server
(arguments
(substitute-keyword-arguments
(package-arguments xorg-server)
+ ((#:tests? #f #f)
+ #f)
((#:configure-flags flags)
#~(cons* "--with-pic" ; Taken from BUILDING.txt
"--without-dtrace"
@@ -282,7 +284,6 @@ (define-public tigervnc-server
modules))
((#:phases phases)
#~(modify-phases #$phases
- (delete 'check) ;no test suite
(add-after 'unpack 'adjust-pam-config
(lambda _
(substitute* "tigervnc-client/unix/vncserver/tigervnc.pam"
--
2.37.3
^ permalink raw reply related [flat|nested] 16+ messages in thread* [bug#58014] [PATCH 05/15] gnu: tigervnc-server: Patch and wrap vncserver script.
2022-09-23 5:00 ` [bug#58014] [PATCH 01/15] gnu: tigervnc-server: Use new style inputs, gexps Maxim Cournoyer
` (2 preceding siblings ...)
2022-09-23 5:00 ` [bug#58014] [PATCH 04/15] gnu: tigervnc-server: Disable tests via #:tests? Maxim Cournoyer
@ 2022-09-23 5:00 ` Maxim Cournoyer
2022-09-23 5:00 ` [bug#58014] [PATCH 06/15] gnu: gdm: Patch an extra reference to the Xsession script Maxim Cournoyer
` (9 subsequent siblings)
13 siblings, 0 replies; 16+ messages in thread
From: Maxim Cournoyer @ 2022-09-23 5:00 UTC (permalink / raw)
To: 58014; +Cc: Maxim Cournoyer
* gnu/packages/vnc.scm (tigervnc-server):
[phases]{patch-paths, wrap-vncserver}: New phases.
[inputs]: Add font-alias, guile-3.0, util-linux and xinit.
---
gnu/packages/vnc.scm | 44 ++++++++++++++++++++++++++++++++++++++++++--
1 file changed, 42 insertions(+), 2 deletions(-)
diff --git a/gnu/packages/vnc.scm b/gnu/packages/vnc.scm
index 3731f63846..8bbccfb498 100644
--- a/gnu/packages/vnc.scm
+++ b/gnu/packages/vnc.scm
@@ -289,6 +289,31 @@ (define-public tigervnc-server
(substitute* "tigervnc-client/unix/vncserver/tigervnc.pam"
(("pam_systemd.so")
"pam_elogind.so"))))
+ (add-after 'unpack 'patch-paths
+ (lambda* (#:key inputs #:allow-other-keys)
+ (substitute* "tigervnc-client/unix/vncserver/vncserver.in"
+ (("`mcookie`")
+ (format #f "`~a`" (search-input-file inputs "bin/mcookie")))
+ ;; Adjust the places where the vncserver script looks for
+ ;; X11 fonts.
+ (("'/usr/share/X11/fonts'" all)
+ (format #f "'~a', '~a', ~a"
+ "/run/current-system/profile/share/fonts/X11"
+ (string-append #$(this-package-input "font-alias")
+ "share/fonts/X11")
+ all))
+ ;; Adjust the location used to locate of the .desktop files.
+ (("/usr/share/xsessions")
+ "/run/current-system/profile/share/xsessions")
+ ;; Do not require a system-provided Xsession shell script,
+ ;; as Guix System has none. This causes the foreach loop to
+ ;; iterate an empty list (disabled).
+ (("\"/etc/X11/xinit/Xsession\", \"/etc/X11/Xsession\"")
+ "()")
+ (("if \\(not defined \\$Xsession)")
+ "if (0)")
+ (("@cmd, \\$Xsession,")
+ "@cmd,"))))
(add-before 'build 'build-tigervnc
(lambda* (#:key parallel-build? #:allow-other-keys)
(mkdir-p "tigervnc-client/build")
@@ -309,7 +334,16 @@ (define-public tigervnc-server
(invoke "make" "-C" "tigervnc-client/build/unix" "install")))
(replace 'install
(lambda _
- (invoke "make" "install")))))))
+ (invoke "make" "install")))
+ (add-after 'install 'wrap-vncserver
+ (lambda* (#:key inputs outputs #:allow-other-keys)
+ (wrap-script (search-input-file outputs "libexec/vncserver")
+ (list "PATH" 'prefix
+ (map (lambda (p)
+ (dirname (search-input-file inputs p)))
+ '("bin/uname"
+ "bin/xauth"
+ "bin/xinit"))))))))))
(native-inputs
(modify-inputs (append (package-native-inputs xorg-server)
(package-native-inputs tigervnc-client))
@@ -324,7 +358,13 @@ (define-public tigervnc-server
(inputs
(modify-inputs (append (package-inputs xorg-server)
(package-inputs tigervnc-client))
- (prepend perl coreutils xauth)))
+ (prepend coreutils
+ font-alias
+ guile-3.0
+ perl
+ util-linux
+ xauth
+ xinit)))
(propagated-inputs
(modify-inputs (package-propagated-inputs xorg-server)
(prepend xauth)))
--
2.37.3
^ permalink raw reply related [flat|nested] 16+ messages in thread* [bug#58014] [PATCH 06/15] gnu: gdm: Patch an extra reference to the Xsession script.
2022-09-23 5:00 ` [bug#58014] [PATCH 01/15] gnu: tigervnc-server: Use new style inputs, gexps Maxim Cournoyer
` (3 preceding siblings ...)
2022-09-23 5:00 ` [bug#58014] [PATCH 05/15] gnu: tigervnc-server: Patch and wrap vncserver script Maxim Cournoyer
@ 2022-09-23 5:00 ` Maxim Cournoyer
2022-09-23 5:00 ` [bug#58014] [PATCH 07/15] services: gdm: Add a configuration field to enable XDMCP Maxim Cournoyer
` (8 subsequent siblings)
13 siblings, 0 replies; 16+ messages in thread
From: Maxim Cournoyer @ 2022-09-23 5:00 UTC (permalink / raw)
To: 58014; +Cc: Maxim Cournoyer
Without this change, attempting to start a remote session over VNC would fail
with:
Sep 19 19:54:04 localhost gdm-session-worker: Gdm: GdmSessionWorker: child
'/gnu/store/yy9wq647l37658vgi291a287ll9iw6dc-gdm-42.0/etc/gdm/Xsession' could
not be started: No such file or directory
* gnu/packages/gnome.scm (gdm)[phases]{patch-paths}
<daemon/gdm-session.c>: Patch a reference in so the Xsession script is
correctly found via the GDM_X_SESSION environment variable.
---
gnu/packages/gnome.scm | 5 ++++-
1 file changed, 4 insertions(+), 1 deletion(-)
diff --git a/gnu/packages/gnome.scm b/gnu/packages/gnome.scm
index 0adb065eb5..facc8515f5 100644
--- a/gnu/packages/gnome.scm
+++ b/gnu/packages/gnome.scm
@@ -8830,7 +8830,10 @@ (define-public gdm
"gdm_session_set_environment_variable "
"(self, \"" name "\","
"g_getenv (\"" name "\"));\n"))
- propagate)))))
+ propagate)))
+ ;; This is used by remote sessions, such as when using VNC.
+ (("\\(GDMCONFDIR \"/Xsession \\\\\"%s\\\\\"\", command)")
+ "(\"%s \\\"%s\\\"\", g_getenv (\"GDM_X_SESSION\"), command)")))
;; Find the configuration file using an environment variable.
(substitute* '("common/gdm-settings.c")
(("GDM_CUSTOM_CONF")
--
2.37.3
^ permalink raw reply related [flat|nested] 16+ messages in thread* [bug#58014] [PATCH 07/15] services: gdm: Add a configuration field to enable XDMCP.
2022-09-23 5:00 ` [bug#58014] [PATCH 01/15] gnu: tigervnc-server: Use new style inputs, gexps Maxim Cournoyer
` (4 preceding siblings ...)
2022-09-23 5:00 ` [bug#58014] [PATCH 06/15] gnu: gdm: Patch an extra reference to the Xsession script Maxim Cournoyer
@ 2022-09-23 5:00 ` Maxim Cournoyer
2022-09-23 5:00 ` [bug#58014] [PATCH 08/15] marionette: Make marionette-screen-text private Maxim Cournoyer
` (7 subsequent siblings)
13 siblings, 0 replies; 16+ messages in thread
From: Maxim Cournoyer @ 2022-09-23 5:00 UTC (permalink / raw)
To: 58014; +Cc: Maxim Cournoyer
* gnu/services/xorg.scm (<gdm-configuration>)[xdmcp?]: New field.
* gnu/services/xorg.scm (gdm-configuration-file): Use it. Use (ice-9 format)
to serialize boolean.
(gdm-polkit-rules): New variable.
(gdm-service-type): Use it to extend polkit.
* doc/guix.texi (X Window): Document it.
---
doc/guix.texi | 6 +++++
gnu/services/xorg.scm | 56 +++++++++++++++++++++++++++++++++++++------
2 files changed, 55 insertions(+), 7 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index eb12efa85e..be1f2e0063 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -21062,6 +21062,12 @@ Configuration of the Xorg graphical server.
@item @code{x-session} (default: @code{(xinitrc)})
Script to run before starting a X session.
+@item @code{xdmcp?} (default: @code{#f})
+When true, enable the X Display Manager Control Protocol (XDMCP). This
+should only be enabled in trusted environments, as the protocol is not
+secure. When enabled, GDM listens for XDMCP queries on the UDP port
+177.
+
@item @code{dbus-daemon} (default: @code{dbus-daemon-wrapper})
File name of the @code{dbus-daemon} executable.
diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm
index 3ff290c197..eb77822741 100644
--- a/gnu/services/xorg.scm
+++ b/gnu/services/xorg.scm
@@ -63,6 +63,7 @@ (define-module (gnu services xorg)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-26)
+ #:use-module (ice-9 format)
#:use-module (ice-9 match)
#:export (xorg-configuration
xorg-configuration?
@@ -885,6 +886,8 @@ (define-record-type* <gdm-configuration>
(default (xorg-configuration)))
(x-session gdm-configuration-x-session
(default (xinitrc)))
+ (xdmcp? gdm-configuration-xdmcp?
+ (default #f))
(wayland? gdm-configuration-wayland? (default #f))
(wayland-session gdm-configuration-wayland-session
(default gdm-wayland-session-wrapper)))
@@ -913,18 +916,20 @@ (define (gdm-configuration-file config)
;; See also
;; <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=39281>.
"InitialSetupEnable=false\n"
- "WaylandEnable=" (if (gdm-configuration-wayland? config)
- "true"
- "false") "\n"
+ (format #f "WaylandEnable=~:[false~;true~]~%"
+ (gdm-configuration-wayland? config))
"\n"
"[debug]\n"
- "Enable=" (if (gdm-configuration-debug? config)
- "true"
- "false") "\n"
+ (format #f "Enable=~:[false~;true~]~%"
+ (gdm-configuration-debug? config))
"\n"
"[security]\n"
"#DisallowTCP=true\n"
- "#AllowRemoteAutoLogin=false\n"))
+ "#AllowRemoteAutoLogin=false\n"
+ "\n"
+ "[xdmcp]\n"
+ (format #f "Enable=~:[false~;true~]~%"
+ (gdm-configuration-xdmcp? config))))
(define (gdm-pam-service config)
"Return a PAM service for @command{gdm}."
@@ -995,6 +1000,41 @@ (define (gdm-shepherd-service config)
(stop #~(make-kill-destructor))
(respawn? #t))))
+(define gdm-polkit-rules
+ (lambda (config)
+ (if (gdm-configuration-xdmcp? config)
+ ;; Allow remote (XDMCP) users to use colord; otherwise an
+ ;; authentication dialog would appear on the GDM screen (see the
+ ;; upstream bug:
+ ;; https://gitlab.gnome.org/GNOME/gnome-settings-daemon/-/issues/273).
+ (list (computed-file
+ "02-allow-colord.rules"
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (use-modules (guix build utils))
+
+ (let* ((rules.d
+ (string-append #$output
+ "/share/polkit-1"
+ "/rules.d"))
+ (allow-colord.rules (string-append
+ rules.d
+ "/02-allow-colord.rules")))
+ (mkdir-p rules.d)
+ (call-with-output-file allow-colord.rules
+ (lambda (port)
+ ;; This workaround enables any local or remote in
+ ;; the "users" group to use colord (see:
+ ;; https://c-nergy.be/blog/?p=12073).
+ (format port "\
+polkit.addRule(function(action, subject) {
+ if (action.id.match(\"org.freedesktop.color-manager\")) {
+ polkit.log(\"POLKIT DEBUG returning YES for action: \" + action);
+ return polkit.Result.YES;
+ }
+});~%"))))))))
+ '())))
+
(define gdm-service-type
(handle-xorg-configuration gdm-configuration
(service-type (name 'gdm)
@@ -1005,6 +1045,8 @@ (define gdm-service-type
(const %gdm-accounts))
(service-extension pam-root-service-type
gdm-pam-service)
+ (service-extension polkit-service-type
+ gdm-polkit-rules)
(service-extension profile-service-type
gdm-configuration-gnome-shell-assets)
(service-extension dbus-root-service-type
--
2.37.3
^ permalink raw reply related [flat|nested] 16+ messages in thread* [bug#58014] [PATCH 08/15] marionette: Make marionette-screen-text private.
2022-09-23 5:00 ` [bug#58014] [PATCH 01/15] gnu: tigervnc-server: Use new style inputs, gexps Maxim Cournoyer
` (5 preceding siblings ...)
2022-09-23 5:00 ` [bug#58014] [PATCH 07/15] services: gdm: Add a configuration field to enable XDMCP Maxim Cournoyer
@ 2022-09-23 5:00 ` Maxim Cournoyer
2022-09-23 5:00 ` [bug#58014] [PATCH 09/15] marionette: Preserve screen dumps on failures Maxim Cournoyer
` (6 subsequent siblings)
13 siblings, 0 replies; 16+ messages in thread
From: Maxim Cournoyer @ 2022-09-23 5:00 UTC (permalink / raw)
To: 58014; +Cc: Maxim Cournoyer
It has only one user, which is better suited for wait-for-screen-text anyway.
* gnu/tests/base.scm (run-basic-test): Refactor to use wait-for-screen-text
instead of marionette-screen-text.
---
gnu/build/marionette.scm | 1 -
gnu/tests/base.scm | 25 +++++++++++++------------
2 files changed, 13 insertions(+), 13 deletions(-)
diff --git a/gnu/build/marionette.scm b/gnu/build/marionette.scm
index 5ebf783892..aba6fb8146 100644
--- a/gnu/build/marionette.scm
+++ b/gnu/build/marionette.scm
@@ -33,7 +33,6 @@ (define-module (gnu build marionette)
wait-for-tcp-port
wait-for-unix-socket
marionette-control
- marionette-screen-text
wait-for-screen-text
%qwerty-us-keystrokes
marionette-type
diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm
index 636b127fb8..64cd6a911a 100644
--- a/gnu/tests/base.scm
+++ b/gnu/tests/base.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016, 2017, 2018, 2019, 2020, 2022 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
+;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -509,18 +510,18 @@ (define (entry->list entry)
(file-exists? capture))))
(test-assert "screen text"
- (let ((text (marionette-screen-text marionette
- #:ocr
- #$(file-append ocrad
- "/bin/ocrad"))))
- ;; Check whether the welcome message and shell prompt are
- ;; displayed. Note: OCR confuses "y" and "V" for instance, so
- ;; we cannot reliably match the whole text.
- (and (string-contains text "This is the GNU")
- (string-contains text
- (string-append
- "root@"
- #$(operating-system-host-name os))))))
+ (wait-for-screen-text
+ marionette
+ (lambda (text)
+ ;; Check whether the welcome message and shell prompt are
+ ;; displayed. Note: OCR confuses "y" and "V" for instance, so
+ ;; we cannot reliably match the whole text.
+ (and (string-contains text "This is the GNU")
+ (string-contains text
+ (string-append
+ "root@"
+ #$(operating-system-host-name os)))))
+ #:ocr #$(file-append ocrad "/bin/ocrad")))
(test-end))))
--
2.37.3
^ permalink raw reply related [flat|nested] 16+ messages in thread* [bug#58014] [PATCH 09/15] marionette: Preserve screen dumps on failures.
2022-09-23 5:00 ` [bug#58014] [PATCH 01/15] gnu: tigervnc-server: Use new style inputs, gexps Maxim Cournoyer
` (6 preceding siblings ...)
2022-09-23 5:00 ` [bug#58014] [PATCH 08/15] marionette: Make marionette-screen-text private Maxim Cournoyer
@ 2022-09-23 5:00 ` Maxim Cournoyer
2022-09-23 5:00 ` [bug#58014] [PATCH 10/15] marionette: Define keystrokes for typing colons and exclamation marks Maxim Cournoyer
` (5 subsequent siblings)
13 siblings, 0 replies; 16+ messages in thread
From: Maxim Cournoyer @ 2022-09-23 5:00 UTC (permalink / raw)
To: 58014; +Cc: Maxim Cournoyer
This is to make it easier to debug test failures involving
'wait-for-screen-text': the screendump image used for the OCR is now preserved
for inspection when 'wait-for-screen-text' fails.
* gnu/build/marionette.scm (marionette-screen-text): Return the screendump
image file as the second value. Adjust doc.
(wait-for-screen-text): Add the preserved screendump image file name to the
error message. Adjust doc.
---
gnu/build/marionette.scm | 42 +++++++++++++++++++++++++++-------------
1 file changed, 29 insertions(+), 13 deletions(-)
diff --git a/gnu/build/marionette.scm b/gnu/build/marionette.scm
index aba6fb8146..5f8a74717a 100644
--- a/gnu/build/marionette.scm
+++ b/gnu/build/marionette.scm
@@ -22,6 +22,7 @@ (define-module (gnu build marionette)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-64)
+ #:use-module (srfi srfi-71)
#:use-module (rnrs io ports)
#:use-module (ice-9 match)
#:use-module (ice-9 popen)
@@ -311,18 +312,20 @@ (define* (invoke-tesseract-ocr image #:key (tesseract "tesseract"))
(define* (marionette-screen-text marionette #:key (ocr "ocrad"))
"Take a screenshot of MARIONETTE, perform optical character
-recognition (OCR), and return the text read from the screen as a string. Do
-this by invoking OCR, which should be the file name of GNU Ocrad's
-@command{ocrad} or Tesseract OCR's @command{tesseract} command."
+recognition (OCR), and return the text read from the screen as a string, along
+the screen dump image used. Do this by invoking OCR, which should be the file
+name of GNU Ocrad's@command{ocrad} or Tesseract OCR's @command{tesseract}
+command. The screen dump image returned as the second value should be deleted
+if it is not needed."
(define image (string-append (tmpnam) ".ppm"))
;; Use the QEMU Monitor to save an image of the screen to the host.
(marionette-control (string-append "screendump " image) marionette)
;; Process it via the OCR.
(cond
((string-contains ocr "ocrad")
- (invoke-ocrad-ocr image #:ocrad ocr))
+ (values (invoke-ocrad-ocr image #:ocrad ocr) image))
((string-contains ocr "tesseract")
- (invoke-tesseract-ocr image #:tesseract ocr))
+ (values (invoke-tesseract-ocr image #:tesseract ocr) image))
(else (error "unsupported ocr command"))))
(define* (wait-for-screen-text marionette predicate
@@ -330,21 +333,34 @@ (define* (wait-for-screen-text marionette predicate
(ocr "ocrad")
(timeout 30))
"Wait for TIMEOUT seconds or until the screen text on MARIONETTE matches
-PREDICATE, whichever comes first. Raise an error when TIMEOUT is exceeded."
+PREDICATE, whichever comes first. Raise an error when TIMEOUT is exceeded.
+The error contains the recognized text along the preserved file name of the
+screen dump, which is relative to the current working directory."
(define start
(car (gettimeofday)))
(define end
(+ start timeout))
- (let loop ((last-text #f))
+ (let loop ((last-text #f)
+ (last-screendump #f))
(if (> (car (gettimeofday)) end)
- (error "'wait-for-screen-text' timeout" 'ocr-text: last-text)
- (let ((text (marionette-screen-text marionette #:ocr ocr)))
- (or (predicate text)
- (begin
- (sleep 1)
- (loop text)))))))
+ (let ((screendump-backup (string-drop last-screendump 5)))
+ ;; Move the file from /tmp/fileXXXXXX.pmm to the current working
+ ;; directory, so that it is preserved in the test derivation output.
+ (copy-file last-screendump screendump-backup)
+ (delete-file last-screendump)
+ (error "'wait-for-screen-text' timeout"
+ 'ocr-text: last-text
+ 'screendump: screendump-backup))
+ (let* ((text screendump (marionette-screen-text marionette #:ocr ocr))
+ (result (predicate text)))
+ (cond (result
+ (delete-file screendump)
+ result)
+ (else
+ (sleep 1)
+ (loop text screendump)))))))
(define %qwerty-us-keystrokes
;; Maps "special" characters to their keystrokes.
--
2.37.3
^ permalink raw reply related [flat|nested] 16+ messages in thread* [bug#58014] [PATCH 10/15] marionette: Define keystrokes for typing colons and exclamation marks.
2022-09-23 5:00 ` [bug#58014] [PATCH 01/15] gnu: tigervnc-server: Use new style inputs, gexps Maxim Cournoyer
` (7 preceding siblings ...)
2022-09-23 5:00 ` [bug#58014] [PATCH 09/15] marionette: Preserve screen dumps on failures Maxim Cournoyer
@ 2022-09-23 5:00 ` Maxim Cournoyer
2022-09-23 5:00 ` [bug#58014] [PATCH 11/15] marionette: Add a callback arguments to wait-for-screen-text Maxim Cournoyer
` (4 subsequent siblings)
13 siblings, 0 replies; 16+ messages in thread
From: Maxim Cournoyer @ 2022-09-23 5:00 UTC (permalink / raw)
To: 58014; +Cc: Maxim Cournoyer
* gnu/build/marionette.scm (%qwerty-us-keystrokes): Register keystrokes for
the ':' and '!' characters.
---
gnu/build/marionette.scm | 2 ++
1 file changed, 2 insertions(+)
diff --git a/gnu/build/marionette.scm b/gnu/build/marionette.scm
index 5f8a74717a..6f373f87b6 100644
--- a/gnu/build/marionette.scm
+++ b/gnu/build/marionette.scm
@@ -382,8 +382,10 @@ (define %qwerty-us-keystrokes
(#\> . "shift-dot")
(#\. . "dot")
(#\, . "comma")
+ (#\: . "shift-semicolon")
(#\; . "semicolon")
(#\' . "apostrophe")
+ (#\! . "shift-1")
(#\" . "shift-apostrophe")
(#\` . "grave_accent")
(#\bs . "backspace")
--
2.37.3
^ permalink raw reply related [flat|nested] 16+ messages in thread* [bug#58014] [PATCH 11/15] marionette: Add a callback arguments to wait-for-screen-text.
2022-09-23 5:00 ` [bug#58014] [PATCH 01/15] gnu: tigervnc-server: Use new style inputs, gexps Maxim Cournoyer
` (8 preceding siblings ...)
2022-09-23 5:00 ` [bug#58014] [PATCH 10/15] marionette: Define keystrokes for typing colons and exclamation marks Maxim Cournoyer
@ 2022-09-23 5:00 ` Maxim Cournoyer
2022-09-23 5:00 ` [bug#58014] [PATCH 12/15] gnu: dconf: Set sysconfdir to /etc Maxim Cournoyer
` (3 subsequent siblings)
13 siblings, 0 replies; 16+ messages in thread
From: Maxim Cournoyer @ 2022-09-23 5:00 UTC (permalink / raw)
To: 58014; +Cc: Maxim Cournoyer
* gnu/build/marionette.scm (wait-for-screen-text): New 'pre-action' and
'post-action' arguments. Update doc. Call the procedures before and after
the OCR occurs, respectively.
---
gnu/build/marionette.scm | 12 +++++++++---
1 file changed, 9 insertions(+), 3 deletions(-)
diff --git a/gnu/build/marionette.scm b/gnu/build/marionette.scm
index 6f373f87b6..f4b219e842 100644
--- a/gnu/build/marionette.scm
+++ b/gnu/build/marionette.scm
@@ -331,11 +331,15 @@ (define image (string-append (tmpnam) ".ppm"))
(define* (wait-for-screen-text marionette predicate
#:key
(ocr "ocrad")
- (timeout 30))
+ (timeout 30)
+ pre-action
+ post-action)
"Wait for TIMEOUT seconds or until the screen text on MARIONETTE matches
PREDICATE, whichever comes first. Raise an error when TIMEOUT is exceeded.
The error contains the recognized text along the preserved file name of the
-screen dump, which is relative to the current working directory."
+screen dump, which is relative to the current working directory. If
+PRE-ACTION is provided, it should be a thunk to call before each OCR attempt.
+Likewise for POST-ACTION, except it runs at the end of a successful OCR."
(define start
(car (gettimeofday)))
@@ -353,7 +357,9 @@ (define end
(error "'wait-for-screen-text' timeout"
'ocr-text: last-text
'screendump: screendump-backup))
- (let* ((text screendump (marionette-screen-text marionette #:ocr ocr))
+ (let* ((_ (and (procedure? pre-action) (pre-action)))
+ (text screendump (marionette-screen-text marionette #:ocr ocr))
+ (_ (and (procedure? post-action) (post-action)))
(result (predicate text)))
(cond (result
(delete-file screendump)
--
2.37.3
^ permalink raw reply related [flat|nested] 16+ messages in thread* [bug#58014] [PATCH 12/15] gnu: dconf: Set sysconfdir to /etc.
2022-09-23 5:00 ` [bug#58014] [PATCH 01/15] gnu: tigervnc-server: Use new style inputs, gexps Maxim Cournoyer
` (9 preceding siblings ...)
2022-09-23 5:00 ` [bug#58014] [PATCH 11/15] marionette: Add a callback arguments to wait-for-screen-text Maxim Cournoyer
@ 2022-09-23 5:00 ` Maxim Cournoyer
2022-09-23 5:00 ` [bug#58014] [PATCH 13/15] services: Add dconf-service-type Maxim Cournoyer
` (2 subsequent siblings)
13 siblings, 0 replies; 16+ messages in thread
From: Maxim Cournoyer @ 2022-09-23 5:00 UTC (permalink / raw)
To: 58014; +Cc: Maxim Cournoyer
* gnu/packages/gnome.scm (dconf) [arguments]: Use gexps.
[configure-flags]: Add --sysconfdir=/etc.
[native-inputs]: Remove labels.
---
gnu/packages/gnome.scm | 54 +++++++++++++++++++++++-------------------
1 file changed, 30 insertions(+), 24 deletions(-)
diff --git a/gnu/packages/gnome.scm b/gnu/packages/gnome.scm
index facc8515f5..24d869f496 100644
--- a/gnu/packages/gnome.scm
+++ b/gnu/packages/gnome.scm
@@ -4719,33 +4719,39 @@ (define-public dconf
(base32
"0cs5nayg080y8pb9b7qccm1ni8wkicdmqp1jsgc22110r6j24zyg"))))
(build-system meson-build-system)
+ (arguments
+ (list
+ #:glib-or-gtk? #t
+ ;; Configure sysconfdir to /etc so that gconf profiles can be written
+ ;; there and loaded without having to set GCONF_PROFILE, which cannot be
+ ;; safely set globally (as a gconf profile is a per-user thing).
+ #:configure-flags #~(list "--sysconfdir=/etc"
+ "-Dgtk_doc=true")
+ #:phases #~(modify-phases %standard-phases
+ (add-after 'unpack 'increase-test-timeout
+ (lambda _
+ ;; On big-memory systems, the engine test may take
+ ;; much longer than the default of 30 seconds.
+ (substitute* "tests/meson.build"
+ (("test\\(unit_test\\[0\\], exe" all)
+ (string-append all ", timeout: 300"))))))))
+ (native-inputs
+ (list bash-completion
+ libxslt ;for xsltproc
+ libxml2 ;for XML_CATALOG_FILES
+ docbook-xml-4.2
+ docbook-xsl
+ `(,glib "bin")
+ gtk-doc/stable
+ pkg-config
+ python
+ vala))
+ (inputs
+ (list gtk+
+ dbus))
(propagated-inputs
;; In Requires of dconf.pc.
(list glib))
- (inputs
- (list gtk+ dbus))
- (native-inputs
- `(("bash-completion" ,bash-completion)
- ("libxslt" ,libxslt) ;for xsltproc
- ("libxml2" ,libxml2) ;for XML_CATALOG_FILES
- ("docbook-xml" ,docbook-xml-4.2)
- ("docbook-xsl" ,docbook-xsl)
- ("glib:bin" ,glib "bin")
- ("gtk-doc" ,gtk-doc/stable)
- ("pkg-config" ,pkg-config)
- ("python" ,python)
- ("vala" ,vala)))
- (arguments
- `(#:glib-or-gtk? #t
- #:configure-flags '("-Dgtk_doc=true")
- #:phases (modify-phases %standard-phases
- (add-after 'unpack 'increase-test-timeout
- (lambda _
- ;; On big-memory systems, the engine test may take
- ;; much longer than the default of 30 seconds.
- (substitute* "tests/meson.build"
- (("test\\(unit_test\\[0\\], exe" all)
- (string-append all ", timeout: 300"))))))))
(home-page "https://developer.gnome.org/dconf/")
(synopsis "Low-level GNOME configuration system")
(description "Dconf is a low-level configuration system. Its main purpose
--
2.37.3
^ permalink raw reply related [flat|nested] 16+ messages in thread* [bug#58014] [PATCH 13/15] services: Add dconf-service-type.
2022-09-23 5:00 ` [bug#58014] [PATCH 01/15] gnu: tigervnc-server: Use new style inputs, gexps Maxim Cournoyer
` (10 preceding siblings ...)
2022-09-23 5:00 ` [bug#58014] [PATCH 12/15] gnu: dconf: Set sysconfdir to /etc Maxim Cournoyer
@ 2022-09-23 5:00 ` Maxim Cournoyer
2022-09-23 5:00 ` [bug#58014] [PATCH 14/15] services: xorg: Add auto-suspend? field to <gdm-configuration> Maxim Cournoyer
2022-09-23 5:00 ` [bug#58014] [PATCH 15/15] services: Add xvnc-service-type Maxim Cournoyer
13 siblings, 0 replies; 16+ messages in thread
From: Maxim Cournoyer @ 2022-09-23 5:00 UTC (permalink / raw)
To: 58014; +Cc: Maxim Cournoyer
This allows the dconf profile directive "system-db:" to look up profiles by
name from under /etc/dconf/db/.
* gnu/services/xorg.scm (dconf-keyfile, dconf-profile): New procedures.
(dconf-profiles?): New predicate.
(dconf-configuration): New procedure.
(dconf-profile->profile-file): Likewise.
(dconf-profile->db-keyfile): Likewise.
(dconf-profile->db-keyfile-dir): Likewise.
(dconf-profile->db): Likewise.
(dconf-profile->files): Likewise.
(dconf-service-type): New service type.
---
gnu/services/xorg.scm | 109 ++++++++++++++++++++++++++++++++++++++++++
1 file changed, 109 insertions(+)
diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm
index eb77822741..9205c6f9f4 100644
--- a/gnu/services/xorg.scm
+++ b/gnu/services/xorg.scm
@@ -12,6 +12,7 @@
;;; Copyright © 2021 Oleg Pykhalov <go.wigust@gmail.com>
;;; Copyright © 2021 Josselin Poiret <josselin.poiret@protonmail.ch>
;;; Copyright © 2022 Chris Marusich <cmmarusich@gmail.com>
+;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -32,6 +33,7 @@ (define-module (gnu services xorg)
#:autoload (gnu services sddm) (sddm-service-type)
#:use-module (gnu artwork)
#:use-module (gnu services)
+ #:use-module (gnu services configuration)
#:use-module (gnu services shepherd)
#:use-module (gnu system pam)
#:use-module (gnu system setuid)
@@ -114,6 +116,13 @@ (define-module (gnu services xorg)
localed-configuration?
localed-service-type
+ dconf-keyfile
+ dconf-profile
+ dconf-profile-name
+ dconf-profile-content
+ dconf-profile-keyfile
+ dconf-service-type
+
gdm-configuration
gdm-service-type
@@ -803,6 +812,106 @@ (define localed-service-type
the GNOME desktop environment.")
(default-value (localed-configuration)))))
+\f
+;;;
+;;; Dconf.
+;;;
+
+(define-maybe text-config)
+
+(define-configuration/no-serialization dconf-keyfile
+ (name string
+ "The file name of the associated keyfile, e.g. \"00-login-screen\".")
+ (content text-config "The content of the associated keyfile."))
+
+(define-configuration/no-serialization dconf-profile
+ (name string "The file name of the dconf system profile, which should match
+the name of a user for which the profile is to be used with. To have the
+profile used, the environment variable \"DCONF_PROFILE\" should be set to the
+profile file, e.g.:
+@example
+ export DCONF_PROFILE=/etc/dconf/profile/gdm
+@end example")
+ (content maybe-text-config "The content of the Dconf profile. Unless
+provided, it defaults to include the user database (\"user-db:NAME\") as well
+as the system database (\"system-db:NAME\"), which corresponds to the
+generated database, @file{/etc/dconf/db/NAME}.")
+ (keyfile dconf-keyfile "The keyfile associated with the profile"))
+
+(define dconf-profiles?
+ (list-of dconf-profile?))
+
+(define-configuration/no-serialization dconf-configuration
+ (profiles dconf-profiles "The list of <dconf-profile> objects to populate."))
+
+(define (dconf-profile->profile-file profile)
+ "Given PROFILE, a <dconf-profile> object, return a dconf profile file."
+ (let ((name (dconf-profile-name profile))
+ (content (dconf-profile-content profile)))
+ (apply mixed-text-file
+ name
+ (if (maybe-value-set? content)
+ (interpose content "\n" 'suffix)
+ (interpose (list (string-append "user-db:" name)
+ (string-append "system-db:" name))
+ "\n" 'suffix)))))
+
+(define (dconf-profile->db-keyfile profile)
+ "Given PROFILE, a <dconf-profile> object, return a dconf profile file."
+ (let ((keyfile (dconf-profile-keyfile profile)))
+ (apply mixed-text-file (dconf-keyfile-name keyfile)
+ (interpose (dconf-keyfile-content keyfile) "\n" 'suffix))))
+
+(define (dconf-profile->db-keyfile-dir profile)
+ "Wrap the keyfile in a directory, to satisfy 'dconf compile'."
+ (let ((name (dconf-profile-name profile))
+ (keyfile-name (dconf-keyfile-name (dconf-profile-keyfile profile))))
+ (computed-file name
+ #~(begin
+ (mkdir #$output)
+ (symlink #$(dconf-profile->db-keyfile profile)
+ (string-append #$output "/" #$keyfile-name))))))
+
+(define (dconf-profile->db profile)
+ "Compile the a <dconf-profile> object into a GVariant Database file."
+ (let ((name (dconf-profile-name profile)))
+ (computed-file
+ name
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (use-modules (guix build utils))
+ (setenv "DCONF_PROFILE" #$(dconf-profile->profile-file profile))
+ (invoke #$(file-append dconf "/bin/dconf") "compile"
+ #$output #$(dconf-profile->db-keyfile-dir profile)))))))
+
+(define (dconf-profile->files profile)
+ "Given PROFILE, a <dconf-profile> object, return a dconf directory
+containing the associated profile, keyfile and database files to be assembled
+under /etc."
+ (let ((name (dconf-profile-name profile))
+ (keyfile-name (dconf-keyfile-name (dconf-profile-keyfile profile))))
+ (list (list (string-append "dconf/profile/" name)
+ (dconf-profile->profile-file profile))
+ (list (string-append "dconf/db/" name ".d/" keyfile-name)
+ (dconf-profile->db-keyfile profile))
+ (list (string-append "dconf/db/" name)
+ (dconf-profile->db profile)))))
+
+(define dconf-service-type
+ (service-type
+ (name 'dconf-profile)
+ (extensions
+ (list (service-extension etc-service-type
+ (lambda (dconf-profiles)
+ (append-map dconf-profile->files
+ dconf-profiles)))))
+ (compose concatenate)
+ (extend append)
+ (default-value '())
+ (description "Extend the @code{etc-service-type} to populate the file
+hierarchy under @file{/etc/dconf} with the <dconf-profile> objects provided as
+argument.")))
+
\f
;;;
;;; GNOME Desktop Manager.
--
2.37.3
^ permalink raw reply related [flat|nested] 16+ messages in thread* [bug#58014] [PATCH 14/15] services: xorg: Add auto-suspend? field to <gdm-configuration>.
2022-09-23 5:00 ` [bug#58014] [PATCH 01/15] gnu: tigervnc-server: Use new style inputs, gexps Maxim Cournoyer
` (11 preceding siblings ...)
2022-09-23 5:00 ` [bug#58014] [PATCH 13/15] services: Add dconf-service-type Maxim Cournoyer
@ 2022-09-23 5:00 ` Maxim Cournoyer
2022-09-23 5:00 ` [bug#58014] [PATCH 15/15] services: Add xvnc-service-type Maxim Cournoyer
13 siblings, 0 replies; 16+ messages in thread
From: Maxim Cournoyer @ 2022-09-23 5:00 UTC (permalink / raw)
To: 58014; +Cc: Maxim Cournoyer
* gnu/services/xorg.scm (<gdm-configuration>)
<auto-suspend?>: New field.
(gdm-dconf-profiles): New variable.
* gnu/services/xorg.scm (gdm-shepherd-service)
<environment-variables> [!auto-suspend?]: Specify DCONF_PROFILE.
(gdm-service-type): Extend DCONF-SERVICE-TYPE.
* doc/guix.texi (X Window): Document the new field.
---
doc/guix.texi | 6 ++++++
gnu/services/xorg.scm | 32 +++++++++++++++++++++++++++++++-
2 files changed, 37 insertions(+), 1 deletion(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index be1f2e0063..b04ec25399 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -21050,6 +21050,12 @@ When @code{auto-login?} is false, GDM presents a log-in screen.
When @code{auto-login?} is true, GDM logs in directly as
@code{default-user}.
+@item @code{auto-suspend?} (default @code{#t})
+When true, GDM will automatically suspend to RAM when nobody is
+physically connected. When a machine is used via remote desktop or SSH,
+this should be set to false to avoid GDM interrupting remote sessions or
+rendering the machine unavailable.
+
@item @code{debug?} (default: @code{#f})
When true, GDM writes debug messages to its log.
diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm
index 9205c6f9f4..902fef0058 100644
--- a/gnu/services/xorg.scm
+++ b/gnu/services/xorg.scm
@@ -986,6 +986,7 @@ (define-record-type* <gdm-configuration>
(gdm gdm-configuration-gdm (default gdm))
(allow-empty-passwords? gdm-configuration-allow-empty-passwords? (default #t))
(auto-login? gdm-configuration-auto-login? (default #f))
+ (auto-suspend? gdm-configuration-auto-suspend? (default #t))
(dbus-daemon gdm-configuration-dbus-daemon (default dbus-daemon-wrapper))
(debug? gdm-configuration-debug? (default #f))
(default-user gdm-configuration-default-user (default #f))
@@ -1001,6 +1002,30 @@ (define-record-type* <gdm-configuration>
(wayland-session gdm-configuration-wayland-session
(default gdm-wayland-session-wrapper)))
+(define (gdm-dconf-profiles config)
+ (if (gdm-configuration-auto-suspend? config)
+ '()
+ ;; This custom gconf profile works around a lack of configuration option
+ ;; to disable auto-suspend when no users are physically logged in (see:
+ ;; https://gitlab.gnome.org/GNOME/gnome-control-center/-/issues/22).
+ (list (dconf-profile
+ (name "gdm")
+ (content (list #~(begin
+ (use-modules (ice-9 textual-ports))
+ (string-trim
+ (call-with-input-file
+ #$(file-append gdm "/share/dconf/profile/gdm")
+ get-string-all)))
+ "system-db:gdm"))
+ (keyfile (dconf-keyfile
+ (name "00-disable-suspend")
+ (content
+ (list "[org/gnome/settings-daemon/plugins/power]"
+ "sleep-inactive-ac-type='nothing'"
+ "sleep-inactive-battery-type='nothing'"
+ "sleep-inactive-ac-timeout=0"
+ "sleep-inactive-battery-timeout=0"))))))))
+
(define (gdm-configuration-file config)
(mixed-text-file "gdm-custom.conf"
"[daemon]\n"
@@ -1073,7 +1098,10 @@ (define (gdm-shepherd-service config)
(list #$(file-append (gdm-configuration-gdm config)
"/bin/gdm"))
#:environment-variables
- (list (string-append
+ (list #$@(if (gdm-configuration-auto-suspend? config)
+ #~()
+ #~("DCONF_PROFILE=/etc/dconf/profile/gdm"))
+ (string-append
"GDM_CUSTOM_CONF="
#$(gdm-configuration-file config))
(string-append
@@ -1152,6 +1180,8 @@ (define gdm-service-type
gdm-shepherd-service)
(service-extension account-service-type
(const %gdm-accounts))
+ (service-extension dconf-service-type
+ gdm-dconf-profiles)
(service-extension pam-root-service-type
gdm-pam-service)
(service-extension polkit-service-type
--
2.37.3
^ permalink raw reply related [flat|nested] 16+ messages in thread* [bug#58014] [PATCH 15/15] services: Add xvnc-service-type.
2022-09-23 5:00 ` [bug#58014] [PATCH 01/15] gnu: tigervnc-server: Use new style inputs, gexps Maxim Cournoyer
` (12 preceding siblings ...)
2022-09-23 5:00 ` [bug#58014] [PATCH 14/15] services: xorg: Add auto-suspend? field to <gdm-configuration> Maxim Cournoyer
@ 2022-09-23 5:00 ` Maxim Cournoyer
13 siblings, 0 replies; 16+ messages in thread
From: Maxim Cournoyer @ 2022-09-23 5:00 UTC (permalink / raw)
To: 58014; +Cc: Maxim Cournoyer
* gnu/services/vnc.scm: New file.
* gnu/tests/vnc.scm: Likewise.
* gnu/local.mk: Register them.
---
doc/guix.texi | 163 +++++++++++++++++++++++++++-
gnu/local.mk | 2 +
gnu/services/vnc.scm | 247 +++++++++++++++++++++++++++++++++++++++++++
gnu/tests/vnc.scm | 200 +++++++++++++++++++++++++++++++++++
4 files changed, 608 insertions(+), 4 deletions(-)
create mode 100644 gnu/services/vnc.scm
create mode 100644 gnu/tests/vnc.scm
diff --git a/doc/guix.texi b/doc/guix.texi
index b04ec25399..26dcc7fdbe 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -17514,6 +17514,7 @@ declaration.
* Web Services:: Web servers.
* Certificate Services:: TLS certificates via Let's Encrypt.
* DNS Services:: DNS daemons.
+* VNC Services:: VNC daemons.
* VPN Services:: VPN daemons.
* Network File System:: NFS related services.
* Continuous Integration:: Cuirass and Laminar services.
@@ -21005,6 +21006,7 @@ started by the @dfn{login manager}, by default the GNOME Display Manager (GDM).
@cindex GDM
@cindex GNOME, login manager
+@anchor{gdm}
GDM of course allows users to log in into window managers and desktop
environments other than GNOME; for those using GNOME, GDM is required for
features such as automatic screen locking.
@@ -21306,6 +21308,7 @@ Relogin after logout.
@cindex lightdm, graphical login manager
@cindex display manager, lightdm
+@anchor{lightdm}
@defvr {Scheme Variable} lightdm-service-type
This is the type of the service to run the
@url{https://github.com/canonical/lightdm,LightDM display manager}. Its
@@ -21509,10 +21512,11 @@ Extra configuration values to append to the seat configuration section.
@cindex Xorg, configuration
@deftp {Data Type} xorg-configuration
-This data type represents the configuration of the Xorg graphical display
-server. Note that there is no Xorg service; instead, the X server is started
-by a ``display manager'' such as GDM, SDDM, and SLiM@. Thus, the configuration
-of these display managers aggregates an @code{xorg-configuration} record.
+This data type represents the configuration of the Xorg graphical
+display server. Note that there is no Xorg service; instead, the X
+server is started by a ``display manager'' such as GDM, SDDM, LightDM or
+SLiM@. Thus, the configuration of these display managers aggregates an
+@code{xorg-configuration} record.
@table @asis
@item @code{modules} (default: @code{%default-xorg-modules})
@@ -30779,6 +30783,157 @@ Defaults to @samp{()}.
@c %end of fragment
+@node VNC Services
+@subsection VNC Services
+@cindex VNC (virtual network computing)
+@cindex XDMCP (x display manager control protocol)
+
+The @code{(gnu services vnc)} module provides services related to
+@dfn{Virtual Network Computing} (VNC), which makes it possible to
+locally use graphical Xorg applications running on a remote machine.
+Combined with a graphical manager that supports the @dfn{X Display
+Manager Control Protocol}, such as GDM (@pxref{gdm}) or LightDM
+(@pxref{lightdm}), it is possible to remote an entire desktop for a
+multi-user environment.
+
+@subsubheading Xvnc
+
+Xvnc is a VNC server that spawns its own X window server; which means it
+can run on headless servers. The Xvnc implementations provided by the
+@code{tigervnc-server} and @code{turbovnc} aim to be fast and efficient.
+
+@defvar {Scheme Variable} xvnc-service-type
+
+The @code{xvnc-server-type} service can be configured via the
+@code{xvnc-configuration} record, documented below. A second virtual
+display could be made available on a remote machine for via the
+following configuration:
+@end defvar
+
+@lisp
+(service xvnc-service-type (xvnc-configuration (display-number 10)
+@end lisp
+
+As a demonstration, the @command{xclock} command could then be started
+on the remote machine on display number 10, and it could be display
+locally via the @command{vncviewer} command:
+@example
+# Start xclock on the remote machine.
+ssh -L5910:localhost:5910 -- guix shell xclock -- env DISPLAY=:10 xclock
+# Access it via VNC.
+guix shell tigervnc-client -- vncviewer localhost:5910
+@end example
+
+The following configuration combines XDMCP and Inetd to allow multiple
+users to concurrently use the remote system, login in graphically via
+the GDM display manager:
+
+@lisp
+(operating-system
+ [...]
+ (services (cons*
+ [...]
+ (service xvnc-service-type (xvnc-configuration
+ (display-number 5)
+ (localhost? #f)
+ (xdmcp? #t)
+ (inetd? #t)))
+ (modify-services %desktop-services
+ (gdm-service-type config => (gdm-configuration
+ (inherit config)
+ (auto-suspend? #f)
+ (xdmcp? #t)))))))
+@end lisp
+
+A remote user could then connect to it by using the @command{vncviewer}
+command or a compatible VNC client and start a desktop session of their
+choosing:
+@example
+vncviewer remote-host:5905
+@end example
+
+@quotation Warning
+Unless your machine is in a controlled environment, for security
+reasons, the @code{localhost?} configuration of the
+@code{xvnc-configuration} record should be left to its default @code{#t}
+value and exposed via a secure means such as an SSH port forward. The
+XDMCP port, UDP 177 should also be blocked from the outside by a
+firewall, as it is not a secure protocol and can expose login
+credentials in clear.
+@end quotation
+
+@c Use (configuration->documentation 'xvnc-configuration) to regenerate
+@c the documentation.
+@c %start of fragment
+@deftp {Data Type} xvnc-configuration
+Available @code{xvnc-configuration} fields are:
+
+@table @asis
+@item @code{xvnc} (default: @code{tigervnc-server}) (type: file-like)
+The package that provides the Xvnc binary.
+
+@item @code{display-number} (default: @code{0}) (type: number)
+The display number used by Xvnc. You should set this to a number not
+already used a Xorg server.
+
+@item @code{geometry} (default: @code{"1024x768"}) (type: string)
+The size of the desktop to be created.
+
+@item @code{depth} (default: @code{24}) (type: color-depth)
+The pixel depth in bits of the desktop to be created. Accepted values
+are 16, 24 or 32.
+
+@item @code{port} (type: maybe-port)
+The port on which to listen for connections from viewers. When left
+unspecified, it defaults to 5900 plus the display number.
+
+@item @code{ipv4?} (default: @code{#t}) (type: boolean)
+Use IPv4 for incoming and outgoing connections.
+
+@item @code{ipv6?} (default: @code{#t}) (type: boolean)
+Use IPv6 for incoming and outgoing connections.
+
+@item @code{password-file} (type: maybe-string)
+The password file to use, if any. Refer to vncpasswd(1) to learn how to
+generate such a file.
+
+@item @code{xdmcp?} (default: @code{#f}) (type: boolean)
+Query the XDMCP server for a session. This enables users to log in a
+desktop session from the login manager screen. For a multiple users
+scenario, you'll want to enable the @code{inetd?} option as well, so
+that each connection to the VNC server is handled separately rather than
+shared.
+
+@item @code{inetd?} (default: @code{#f}) (type: boolean)
+Use an Inetd-style service, which runs the Xvnc server on demand.
+
+@item @code{frame-rate} (default: @code{60}) (type: number)
+The maximum number of updates per second sent to each client.
+
+@item @code{security-types} (default: @code{("None")}) (type: security-types)
+The allowed security schemes to use for incoming connections. The
+default is "None", which is safe given that Xvnc is configured to
+authenticate the user via the display manager, and only for local
+connections. Accepted values are any of the following: ("None"
+"VncAuth" "Plain" "TLSNone" "TLSVnc" "TLSPlain" "X509None" "X509Vnc")
+
+@item @code{localhost?} (default: @code{#t}) (type: boolean)
+Only allow connections from the same machine. It is set to #true by
+default for security, which means SSH or another secure means should be
+used to expose the remote port.
+
+@item @code{log-level} (default: @code{30}) (type: log-level)
+The log level, a number between 0 and 100, 100 meaning most verbose
+output. The log messages are output to syslog.
+
+@item @code{extra-options} (default: @code{()}) (type: strings)
+This can be used to provide extra Xvnc options not exposed via this
+<xvnc-configuration> record.
+
+@end table
+
+@end deftp
+@c %end of fragment
@node VPN Services
@subsection VPN Services
diff --git a/gnu/local.mk b/gnu/local.mk
index ef1bae5f3c..eaccf763c7 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -689,6 +689,7 @@ GNU_SYSTEM_MODULES = \
%D%/services/sysctl.scm \
%D%/services/telephony.scm \
%D%/services/version-control.scm \
+ %D%/services/vnc.scm \
%D%/services/vpn.scm \
%D%/services/web.scm \
%D%/services/xorg.scm \
@@ -768,6 +769,7 @@ GNU_SYSTEM_MODULES = \
%D%/tests/telephony.scm \
%D%/tests/version-control.scm \
%D%/tests/virtualization.scm \
+ %D%/tests/vnc.scm \
%D%/tests/web.scm
INSTALLER_MODULES = \
diff --git a/gnu/services/vnc.scm b/gnu/services/vnc.scm
new file mode 100644
index 0000000000..15c3c14fee
--- /dev/null
+++ b/gnu/services/vnc.scm
@@ -0,0 +1,247 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu services vnc)
+ #:use-module (gnu packages vnc)
+ #:use-module ((gnu services) #:hide (delete))
+ #:use-module (gnu system shadow)
+ #:use-module (gnu services configuration)
+ #:use-module (gnu services shepherd)
+ #:use-module (guix gexp)
+ #:use-module (guix records)
+
+ #:export (xvnc-configuration
+ xvnc-configuration-xvnc
+ xvnc-configuration-display-number
+ xvnc-configuration-geometry
+ xvnc-configuration-depth
+ xvnc-configuration-port
+ xvnc-configuration-ipv4?
+ xvnc-configuration-ipv6?
+ xvnc-configuration-password-file
+ xvnc-configuration-xdmcp?
+ xvnc-configuration-inetd?
+ xvnc-configuration-frame-rate
+ xvnc-configuration-security-types
+ xvnc-configuration-localhost?
+ xvnc-configuration-log-level
+ xvnc-configuration-extra-options
+
+ xvnc-service-type))
+
+;;;
+;;; Xvnc.
+;;;
+
+(define (color-depth? x)
+ (member x '(16 24 32)))
+
+(define (port? x)
+ (and (number? x)
+ (and (>= x 0) (<= x 65535))))
+
+(define-maybe/no-serialization port)
+
+(define-maybe/no-serialization string)
+
+(define %security-types '("None" "VncAuth" "Plain" "TLSNone" "TLSVnc" "TLSPlain"
+ "X509None" "X509Vnc"))
+
+(define (security-type? x)
+ (member x %security-types))
+
+(define (security-types? x)
+ (and (list? x)
+ (and-map security-type? x)))
+
+(define (log-level? x)
+ (and (number? x)
+ (and (>= x 0) (<= x 100))))
+
+(define (strings? x)
+ (and (list? x)
+ (and-map string? x)))
+
+(define-configuration/no-serialization xvnc-configuration
+ (xvnc
+ (file-like tigervnc-server)
+ "The package that provides the Xvnc binary.")
+ (display-number
+ (number 0)
+ "The display number used by Xvnc. You should set this to a number not
+already used by a Xorg server. When remoting a complete desktop session via
+XDMCP and using a compatible VNC viewer as provided by the
+@code{tigervnc-client} or @code{turbovnc} packages, the geometry is
+automatically adjusted.")
+ (geometry
+ (string "1024x768")
+ "The size of the desktop to be created.")
+ (depth
+ (color-depth 24)
+ "The pixel depth in bits of the desktop to be created. Accepted values are
+16, 24 or 32.")
+ (port
+ maybe-port
+ "The port on which to listen for connections from viewers. When left
+unspecified, it defaults to 5900 plus the display number.")
+ (ipv4?
+ (boolean #t)
+ "Use IPv4 for incoming and outgoing connections.")
+ (ipv6?
+ (boolean #t)
+ "Use IPv6 for incoming and outgoing connections.")
+ (password-file
+ maybe-string
+ "The password file to use, if any. Refer to vncpasswd(1) to learn how to
+generate such a file.")
+ (xdmcp?
+ (boolean #f)
+ "Query the XDMCP server for a session. This enables users to log in a
+desktop session from the login manager screen. For a multiple users scenario,
+you'll want to enable the @code{inetd?} option as well, so that each
+connection to the VNC server is handled separately rather than shared.")
+ (inetd?
+ (boolean #f)
+ "Use an Inetd-style service, which runs the Xvnc server on demand.")
+ (frame-rate
+ (number 60)
+ "The maximum number of updates per second sent to each client.")
+ (security-types
+ (security-types (list "None"))
+ (format #f "The allowed security schemes to use for incoming connections.
+The default is \"None\", which is safe given that Xvnc is configured to
+authenticate the user via the display manager, and only for local connections.
+Accepted values are any of the following: ~s" %security-types))
+ (localhost?
+ (boolean #t)
+ "Only allow connections from the same machine. It is set to @code{#true}
+by default for security, which means SSH or another secure means should be
+used to expose the remote port.")
+ (log-level
+ (log-level 30)
+ "The log level, a number between 0 and 100, 100 meaning most verbose
+output. The log messages are output to syslog.")
+ (extra-options
+ (strings '())
+ "This can be used to provide extra Xvnc options not exposed via this
+<xvnc-configuration> record."))
+
+(define (xvnc-configuration->command-line-arguments config)
+ "Derive the command line arguments to used to launch the Xvnc daemon from
+CONFIG, a <xvnc-configuration> object."
+ (match-record config <xvnc-configuration>
+ (xvnc display-number geometry depth port ipv4? ipv6? password-file xdmcp?
+ inetd? frame-rate security-types localhost? log-level extra-options)
+ #~(list #$(file-append xvnc "/bin/Xvnc")
+ #$(format #f ":~a" display-number)
+ "-geometry" #$geometry
+ "-depth" #$(number->string depth)
+ #$@(if inetd?
+ (list "-inetd")
+ '())
+ #$@(if (not inetd?)
+ (if (maybe-value-set? port)
+ (list "-rfbport" (number->string port))
+ '())
+ '())
+ #$@(if (not inetd?)
+ (if ipv4?
+ (list "-UseIPv4")
+ '())
+ '())
+ #$@(if (not inetd?)
+ (if ipv6?
+ (list "-UseIPv6")
+ '())
+ '())
+ #$@(if (maybe-value-set? password-file)
+ (list "-PasswordFile" password-file)
+ '())
+ "-FrameRate" #$(number->string frame-rate)
+ "-SecurityTypes" #$(string-join security-types ",")
+ #$@(if localhost?
+ (list "-localhost")
+ '())
+ "-Log" #$(format #f "*:syslog:~a" log-level)
+ #$@(if xdmcp?
+ (list "-query" "localhost" "-once")
+ '())
+ #$@extra-options)))
+
+(define %xvnc-accounts
+ (list (user-group
+ (name "xvnc")
+ (system? #t))
+ (user-account
+ (name "xvnc")
+ (group "xvnc")
+ (system? #t)
+ (comment "User for Xvnc server"))))
+
+(define (xvnc-shepherd-service config)
+ "Return a <shepherd-service> for Xvnc with CONFIG."
+ (let* ((display-number (xvnc-configuration-display-number config))
+ (port (if (maybe-value-set? (xvnc-configuration-port config))
+ (xvnc-configuration-port config)
+ #f))
+ (port* (or port (+ 5900 display-number))))
+ (shepherd-service
+ (provision '(xvnc vncserver))
+ (documentation "Run the Xvnc server.")
+ (requirement '(networking syslogd))
+ (start (if (xvnc-configuration-inetd? config)
+ #~(let* ((inaddr (if #$(xvnc-configuration-localhost? config)
+ INADDR_LOOPBACK
+ INADDR_ANY))
+ (in6addr (if #$(xvnc-configuration-localhost? config)
+ IN6ADDR_LOOPBACK
+ IN6ADDR_ANY))
+ (ipv4-socket (and #$(xvnc-configuration-ipv4? config)
+ (make-socket-address AF_INET inaddr
+ #$port*)))
+ (ipv6-socket (and #$(xvnc-configuration-ipv6? config)
+ (make-socket-address AF_INET6 in6addr
+ #$port*))))
+ (make-inetd-constructor
+ #$(xvnc-configuration->command-line-arguments config)
+ `(,@(if ipv4-socket
+ (list (endpoint ipv4-socket))
+ '())
+ ,@(if ipv6-socket
+ (list (endpoint ipv6-socket))
+ '()))
+ #:user "xvnc"
+ #:group "xvnc"))
+ #~(make-forkexec-constructor
+ #$(xvnc-configuration->command-line-arguments config)
+ #:user "xvnc"
+ #:group "xvnc")))
+ (stop #~(make-inetd-destructor)))))
+
+(define xvnc-service-type
+ (service-type
+ (name 'xvnc)
+ (default-value (xvnc-configuration))
+ (description "Run the Xvnc server, which creates a virtual X11 session and
+allow remote clients connecting to it via the remote framebuffer (RFB)
+protocol.")
+ (extensions (list (service-extension
+ shepherd-root-service-type
+ (compose list xvnc-shepherd-service))
+ (service-extension account-service-type
+ (const %xvnc-accounts))))))
diff --git a/gnu/tests/vnc.scm b/gnu/tests/vnc.scm
new file mode 100644
index 0000000000..34c2db1203
--- /dev/null
+++ b/gnu/tests/vnc.scm
@@ -0,0 +1,200 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>.
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu tests vnc)
+ #:use-module (gnu bootloader)
+ #:use-module (gnu bootloader grub)
+ #:use-module (gnu packages)
+ #:use-module (gnu packages ocr)
+ #:use-module (gnu packages glib)
+ #:use-module (gnu services)
+ #:use-module (gnu services dbus)
+ #:use-module (gnu services desktop)
+ #:use-module (gnu services networking)
+ #:use-module (gnu services ssh)
+ #:use-module (gnu services vnc)
+ #:use-module (gnu services xorg)
+ #:use-module (gnu system)
+ #:use-module (gnu system file-systems)
+ #:use-module (gnu system shadow)
+ #:use-module (gnu system vm)
+ #:use-module (gnu tests)
+ #:use-module (guix gexp)
+ #:use-module (guix modules)
+ #:export (%test-xvnc))
+
+(define %xvnc-os
+ (operating-system
+ ;; Usual boilerplate.
+ (host-name "komputilo")
+ (timezone "Europe/Berlin")
+ (locale "en_US.UTF-8")
+ (bootloader (bootloader-configuration
+ (bootloader grub-bootloader)
+ (targets '("/dev/sdX"))))
+ (file-systems (cons (file-system
+ (device (file-system-label "my-root"))
+ (mount-point "/")
+ (type "ext4"))
+ %base-file-systems))
+
+ (users (cons (user-account
+ (name "dummy")
+ (group "users")
+ (supplementary-groups '("wheel" "netdev"
+ "audio" "video")))
+ %base-user-accounts))
+ (packages (append (map specification->package
+ '("dbus" ;for dbus-run-session
+ "dconf"
+ "gnome-settings-daemon" ;for schemas
+ "ratpoison"
+ "tigervnc-client"
+ "xterm"))
+ %base-packages
+ (list `(,glib "bin")
+ glib)))
+ (services (cons*
+ (service openssh-service-type (openssh-configuration
+ (permit-root-login #t)
+ (allow-empty-passwords? #t)))
+ (service xvnc-service-type (xvnc-configuration
+ (display-number 5)
+ (security-types (list "None"))
+ (log-level 100)
+ (localhost? #f)
+ (xdmcp? #t)
+ (inetd? #t)))
+ (modify-services %desktop-services
+ (gdm-service-type config => (gdm-configuration
+ (inherit config)
+ (auto-login? #t)
+ (auto-suspend? #f)
+ (default-user "root")
+ (debug? #t)
+ (xdmcp? #t))))))))
+
+(define (run-xvnc-test)
+ "Run tests in %XVNC-OS."
+
+ (define os (marionette-operating-system
+ %xvnc-os
+ #:imported-modules (source-module-closure
+ '((gnu services herd)))))
+
+ (define vm (virtual-machine
+ (operating-system os)
+ (memory-size 1024)))
+
+ (define test
+ (with-imported-modules (source-module-closure
+ '((gnu build marionette)
+ (guix build utils)))
+ #~(begin
+ (use-modules (gnu build marionette)
+ (guix build utils)
+ (srfi srfi-26)
+ (srfi srfi-64))
+
+ (let ((marionette (make-marionette (list #$vm))))
+
+ (test-runner-current (system-test-runner #$output))
+ (test-begin "xvnc")
+
+ (test-assert "service running"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (start-service 'xvnc))
+ marionette))
+
+ (test-assert "wait for port 5905, IPv4"
+ (wait-for-tcp-port 5905 marionette))
+
+ (test-assert "wait for port 5905, IPv6"
+ (wait-for-tcp-port 5905 marionette
+ #:address
+ '(make-socket-address
+ AF_INET6 (inet-pton AF_INET6 "::1") 5905)))
+
+ (test-assert "gdm auto-suspend is disabled"
+ ;; More a GDM than a Xvnc test, but since it's a cross-cutting
+ ;; concern and we have everything set up here, we might as well
+ ;; check it here.
+ (marionette-eval
+ '(begin
+ ;; Check that DCONF_PROFILE is set...
+ (invoke "/bin/sh" "-lc" "\
+pgrep gdm | head -n1 | xargs -I{} grep -Fq DCONF_PROFILE /proc/{}/environ")
+
+ ;; ... and that
+ (invoke "/bin/sh" "-lc" "\
+sudo -E -u gdm env DCONF_PROFILE=/etc/dconf/profile/gdm dbus-run-session \
+gsettings get org.gnome.settings-daemon.plugins.power sleep-inactive-ac-type \
+| grep -Fq nothing"))
+ marionette))
+
+ (test-assert "vnc lands on the gdm login screen"
+ ;; This test runs vncviewer on the local VM and verifies that it
+ ;; manages to access the GDM login screen (via XDMCP).
+ (begin
+ (define (ratpoison-abort)
+ (marionette-control "sendkey ctrl-g" marionette))
+
+ (define (ratpoison-help)
+ (marionette-control "sendkey ctrl-t" marionette)
+ (marionette-type "?" marionette)
+ (sleep 1)) ;wait for help screen to appear
+
+ (define (ratpoison-exec command)
+ (marionette-control "sendkey ctrl-t" marionette)
+ (marionette-type "!" marionette)
+ (marionette-type (string-append command "\n") marionette))
+
+ ;; Wait until the ratpoison help screen can be displayed; this
+ ;; means the window manager is ready.
+ (wait-for-screen-text marionette
+ (cut string-contains <> "key bindings")
+ #:ocr #$(file-append tesseract-ocr
+ "/bin/tesseract")
+ #:pre-action ratpoison-help
+ #:post-action ratpoison-abort)
+
+ ;; Run vncviewer and expect the GDM login screen (accessed via
+ ;; XDMCP). This can take a while to appear on slower machines.
+ (ratpoison-exec "vncviewer localhost:5905")
+ ;; XXX: tesseract narrowly recognizes "Guix" as "uix" from the
+ ;; background image; ocrad fares worst. Sadly, 'Username' is
+ ;; not recognized at all.
+ (wait-for-screen-text marionette
+ (cut string-contains <> "uix")
+ #:ocr #$(file-append tesseract-ocr
+ "/bin/tesseract")
+ #:timeout 120)))
+
+ (test-end)))))
+
+ (gexp->derivation "xvnc-test" test))
+
+(define %test-xvnc
+ (system-test
+ (name "xvnc")
+ (description "Basic tests for the Xvnc service. One of the tests validate
+that XDMCP works with GDM, and is therefore heavy in terms of disk and memory
+requirements.")
+ (value (run-xvnc-test))))
--
2.37.3
^ permalink raw reply related [flat|nested] 16+ messages in thread