Package: guix-patches;
Reported by: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
Date: Sat, 13 Aug 2022 06:51:01 UTC
Severity: normal
Tags: patch
Done: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
Bug is archived. No further changes may be made.
To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 57168 in the body.
You can then email your comments to 57168 AT debbugs.gnu.org in the normal way.
Toggle the display of automated, internal messages from the tracker.
View this report as an mbox folder, status mbox, maintainer mbox
guix-patches <at> gnu.org:bug#57168; Package guix-patches.
(Sat, 13 Aug 2022 06:51:01 GMT) Full text and rfc822 format available.Maxim Cournoyer <maxim.cournoyer <at> gmail.com>:guix-patches <at> gnu.org.
(Sat, 13 Aug 2022 06:51:01 GMT) Full text and rfc822 format available.Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):
From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> To: guix-patches <at> gnu.org Cc: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> Subject: [PATCH 00/14] Add a LightDM service. Date: Sat, 13 Aug 2022 02:50:06 -0400
Hello Guix! This adds a lightdm-service-type, which is based on the work of 'L p R n d n' more than two years ago. It reworks the way configurations are define (via define-configuration), exposes VNC and XDMCP configuration options and adds unit and system tests. It works fine, but there are a few gotchas: 1. The session selection menu doesn't show the items. I don't know why. Perhaps a regresssion with newer GTK+. 2. Because of 1., you should specify a default session, otherwise you won't be able to log in, as the default session is 'default.desktop', which doesn't exist. Thanks, Maxim Cournoyer (14): services: configuration: Add a 'maybe-value-set?' procedure. gnu: accountsservice: Update to 22.08.8, enable doc and test suite. gnu: accountsservice: Provide a means to locate extensions. gnu: lightdm-gtk-greeter: Add GDK_PIXBUF_MODULE_FILE to wrapper. gnu: lightdm-gtk-greeter: Use the glib-or-gtk-wrap phase as-is. gnu: lightdm-gtk-greeter: Enable libklavier support. gnu: lightdm-gtk-greeter: Adjust default config file path. gnu: lightdm-gtk-greeter: Adjust --enable-at-spi-command value. gnu: lightdm: Apply patch to fix a problem with VNC integration. gnu: lightdm: Apply patch to allow using VNC options. gnu: lightdm: Apply patch to fix color depth issue with VNC. marionette: Improve the error message of 'wait-for-screen-text'. build: marionette: Add support for Tesseract OCR. services: Add lightdm-service-type. Makefile.am | 1 + doc/guix.texi | 209 +++++- gnu/build/marionette.scm | 79 +- gnu/local.mk | 5 + gnu/packages/display-managers.scm | 83 ++- gnu/packages/freedesktop.scm | 93 ++- .../patches/accountsservice-extensions.patch | 25 + .../patches/lightdm-arguments-ordering.patch | 54 ++ .../patches/lightdm-vnc-color-depth.patch | 81 +++ .../patches/lightdm-vncserver-check.patch | 66 ++ gnu/services/configuration.scm | 5 + gnu/services/lightdm.scm | 687 ++++++++++++++++++ gnu/tests/base.scm | 4 +- gnu/tests/install.scm | 8 +- gnu/tests/lightdm.scm | 161 ++++ tests/services/lightdm.scm | 52 ++ 16 files changed, 1508 insertions(+), 105 deletions(-) create mode 100644 gnu/packages/patches/accountsservice-extensions.patch create mode 100644 gnu/packages/patches/lightdm-arguments-ordering.patch create mode 100644 gnu/packages/patches/lightdm-vnc-color-depth.patch create mode 100644 gnu/packages/patches/lightdm-vncserver-check.patch create mode 100644 gnu/services/lightdm.scm create mode 100644 gnu/tests/lightdm.scm create mode 100644 tests/services/lightdm.scm -- 2.36.1
guix-patches <at> gnu.org:bug#57168; Package guix-patches.
(Sat, 13 Aug 2022 06:55:01 GMT) Full text and rfc822 format available.Message #8 received at 57168 <at> debbugs.gnu.org (full text, mbox):
From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> To: 57168 <at> debbugs.gnu.org Cc: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> Subject: [PATCH 01/14] services: configuration: Add a 'maybe-value-set?' procedure. Date: Sat, 13 Aug 2022 02:54:20 -0400
* gnu/services/configuration.scm (maybe-value-set?): New procedure.
* doc/guix.texi (Complex Configurations): Document it. Remove comment showing
usage of 'maybe-string' with a default value, which doesn't make sense.
---
doc/guix.texi | 7 ++++++-
gnu/services/configuration.scm | 5 +++++
2 files changed, 11 insertions(+), 1 deletion(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 86cfe7d49c..039df29ebc 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -38999,7 +38999,7 @@ to be a string, or left unspecified.
(name
;; If set to a string, the `serialize-string' procedure will be used
;; to serialize the string. Otherwise this field is not serialized.
- maybe-string ; equivalent to (maybe-string *unspecified*)
+ maybe-string
"The name of this module."))
@end lisp
@@ -39030,6 +39030,11 @@ whether its value is set or not.
@end lisp
@end deffn
+@deffn (Scheme Procedure) maybe-value-set? @var{value}
+Predicate to check whether a user explicitly specified the value of a
+maybe field.
+@end deffn
+
@deffn {Scheme Procedure} serialize-configuration @var{configuration} @
@var{fields}
Return a G-expression that contains the values corresponding to the
diff --git a/gnu/services/configuration.scm b/gnu/services/configuration.scm
index 3007e8de35..b41b4d2e62 100644
--- a/gnu/services/configuration.scm
+++ b/gnu/services/configuration.scm
@@ -57,6 +57,7 @@ (define-module (gnu services configuration)
serialize-configuration
define-maybe
define-maybe/no-serialization
+ maybe-value-set?
generate-documentation
configuration->documentation
empty-serializer
@@ -300,6 +301,10 @@ (define-configuration stem (field field-type+def
(define (empty-serializer field-name val) "")
(define serialize-package empty-serializer)
+(define (maybe-value-set? value)
+ "Predicate to check whether a 'maybe' value was explicitly provided."
+ (not (eq? 'unset value)))
+
;; A little helper to make it easier to document all those fields.
(define (generate-documentation documentation documentation-name)
(define (str x) (object->string x))
--
2.36.1
guix-patches <at> gnu.org:bug#57168; Package guix-patches.
(Sat, 13 Aug 2022 06:55:02 GMT) Full text and rfc822 format available.Message #11 received at 57168 <at> debbugs.gnu.org (full text, mbox):
From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> To: 57168 <at> debbugs.gnu.org Cc: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> Subject: [PATCH 02/14] gnu: accountsservice: Update to 22.08.8, enable doc and test suite. Date: Sat, 13 Aug 2022 02:54:21 -0400
* gnu/packages/freedesktop.scm (accountsservice): Update to 22.08.8.
[tests?]: Delete argument.
[configure-flags]: Remove obsolete "-Dsystemd" flag. Add "-Ddocbook=true" and
"-Dgtk_doc=true".
[phases]{patch-docbook-references}: New phase.
{patch-/bin/cat}: Delete and merge into...
[patch-paths]: ... this phase, renamed from pre-configure. Use
search-input-file.
[native-inputs]: Add docbook-xml-4.1.2, docbook-xsl, gtk-doc, libxml2,
libxslt, python-dbusmock, python-pygobject, vala and xmlto.
---
gnu/packages/freedesktop.scm | 85 +++++++++++++++++++++---------------
1 file changed, 51 insertions(+), 34 deletions(-)
diff --git a/gnu/packages/freedesktop.scm b/gnu/packages/freedesktop.scm
index 037a247243..8ebd0e5359 100644
--- a/gnu/packages/freedesktop.scm
+++ b/gnu/packages/freedesktop.scm
@@ -27,7 +27,7 @@
;;; Copyright © 2021 Robby Zambito <contact <at> robbyzambito.me>
;;; Copyright © 2021, 2022 Maxime Devos <maximedevos <at> telenet.be>
;;; Copyright © 2021 John Kehayias <john.kehayias <at> protonmail.com>
-;;; Copyright © 2021, 2021 Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
+;;; Copyright © 2021, 2021, 2022 Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
;;; Copyright © 2022 Daniel Meißner <daniel.meissner-i4k <at> ruhr-uni-bochum.de>
;;; Copyright © 2022 muradm <mail <at> muradm.net>
;;;
@@ -1435,7 +1435,7 @@ (define-public udisks
(define-public accountsservice
(package
(name "accountsservice")
- (version "0.6.55")
+ (version "22.08.8")
(source
(origin
(method url-fetch)
@@ -1443,45 +1443,62 @@ (define-public accountsservice
"accountsservice/accountsservice-"
version ".tar.xz"))
(sha256
- (base32 "16wwd633jak9ajyr1f1h047rmd09fhf3kzjz6g5xjsz0lwcj8azz"))))
+ (base32 "14d3lwik048h62qrzg1djdd2sqmxf3m1r859730pvzhrd6krg6ch"))))
(build-system meson-build-system)
(arguments
- `(#:tests? #f ; XXX: tests require DocBook 4.1.2
- #:configure-flags
+ `(#:configure-flags
'("--localstatedir=/var"
- "-Dsystemdsystemunitdir=/tmp/empty"
- "-Dsystemd=false"
- "-Delogind=true")
+ "-Delogind=true"
+ "-Ddocbook=true"
+ "-Dgtk_doc=true"
+ "-Dsystemdsystemunitdir=/tmp/empty")
#:phases
(modify-phases %standard-phases
- (add-after 'unpack 'patch-/bin/cat
- (lambda _
- (substitute* "src/user.c"
- (("/bin/cat") (which "cat")))))
- (add-before
- 'configure 'pre-configure
- (lambda* (#:key inputs #:allow-other-keys)
- (substitute* "meson_post_install.py"
- (("in dst_dirs") "in []"))
- (let ((shadow (assoc-ref inputs "shadow")))
- (substitute* '("src/user.c" "src/daemon.c")
- (("/usr/sbin/usermod")
- (string-append shadow "/sbin/usermod"))
- (("/usr/sbin/useradd")
- (string-append shadow "/sbin/useradd"))
- (("/usr/sbin/userdel")
- (string-append shadow "/sbin/userdel"))
- (("/usr/bin/passwd")
- (string-append shadow "/bin/passwd"))
- (("/usr/bin/chage")
- (string-append shadow "/bin/chage")))))))))
+ (add-after 'unpack 'patch-docbook-references
+ ;; Having XML_CATALOG_FILES set is not enough; xmlto does not seem
+ ;; to honor it.
+ (lambda* (#:key inputs #:allow-other-keys)
+ (substitute* (find-files "." "\\.xml(\\.in)?$")
+ (("http://www.freedesktop.org/standards/dbus/1.0/introspect.dtd")
+ (search-input-file inputs "share/xml/dbus-1/introspect.dtd"))
+ (("http://www.oasis-open.org/docbook/xml/4.1.2/docbookx.dtd")
+ (search-input-file inputs "xml/dtd/docbook/docbookx.dtd")))))
+ (add-after 'unpack 'patch-paths
+ (lambda* (#:key inputs #:allow-other-keys)
+ (substitute* "meson_post_install.py"
+ (("in dst_dirs") "in []"))
+ (substitute* '("src/user.c" "src/daemon.c")
+ (("/bin/cat")
+ (search-input-file inputs "bin/cat"))
+ (("/usr/sbin/usermod")
+ (search-input-file inputs "sbin/usermod"))
+ (("/usr/sbin/useradd")
+ (search-input-file inputs "sbin/useradd"))
+ (("/usr/sbin/userdel")
+ (search-input-file inputs "sbin/userdel"))
+ (("/usr/bin/passwd")
+ (search-input-file inputs "bin/passwd"))
+ (("/usr/bin/chage")
+ (search-input-file inputs "bin/chage"))))))))
(native-inputs
- `(("glib:bin" ,glib "bin") ; for gdbus-codegen, etc.
- ("gobject-introspection" ,gobject-introspection)
- ("intltool" ,intltool)
- ("pkg-config" ,pkg-config)))
+ (list docbook-xml-4.1.2
+ docbook-xsl
+ `(,glib "bin") ; for gdbus-codegen, etc.
+ gobject-introspection
+ gtk-doc
+ intltool
+ libxml2 ;for XML_CATALOG_FILES
+ libxslt
+ pkg-config
+ python-dbusmock
+ python-pygobject
+ vala
+ xmlto))
(inputs
- (list dbus elogind polkit shadow))
+ (list dbus
+ elogind
+ polkit
+ shadow))
(home-page "https://www.freedesktop.org/wiki/Software/AccountsService/")
(synopsis "D-Bus interface for user account query and manipulation")
(description
--
2.36.1
guix-patches <at> gnu.org:bug#57168; Package guix-patches.
(Sat, 13 Aug 2022 06:55:02 GMT) Full text and rfc822 format available.Message #14 received at 57168 <at> debbugs.gnu.org (full text, mbox):
From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> To: 57168 <at> debbugs.gnu.org Cc: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> Subject: [PATCH 03/14] gnu: accountsservice: Provide a means to locate extensions. Date: Sat, 13 Aug 2022 02:54:22 -0400
* gnu/packages/patches/accountsservice-extensions.patch: New patch.
* gnu/packages/freedesktop.scm (accountsservice)[source]: Apply it.
[phases]{wrap-with-xdg-data-dirs}: New phase.
---
gnu/local.mk | 1 +
gnu/packages/freedesktop.scm | 12 +++++++--
.../patches/accountsservice-extensions.patch | 25 +++++++++++++++++++
3 files changed, 36 insertions(+), 2 deletions(-)
create mode 100644 gnu/packages/patches/accountsservice-extensions.patch
diff --git a/gnu/local.mk b/gnu/local.mk
index 2d32d85d47..c2a33fa7d1 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -840,6 +840,7 @@ dist_patch_DATA = \
%D%/packages/patches/abseil-cpp-fix-strerror_test.patch \
%D%/packages/patches/adb-add-libraries.patch \
%D%/packages/patches/adb-libssl_11-compatibility.patch \
+ %D%/packages/patches/accountsservice-extensions.patch \
%D%/packages/patches/aegis-constness-error.patch \
%D%/packages/patches/aegis-perl-tempdir1.patch \
%D%/packages/patches/aegis-perl-tempdir2.patch \
diff --git a/gnu/packages/freedesktop.scm b/gnu/packages/freedesktop.scm
index 8ebd0e5359..ab6fb480a7 100644
--- a/gnu/packages/freedesktop.scm
+++ b/gnu/packages/freedesktop.scm
@@ -1443,7 +1443,8 @@ (define-public accountsservice
"accountsservice/accountsservice-"
version ".tar.xz"))
(sha256
- (base32 "14d3lwik048h62qrzg1djdd2sqmxf3m1r859730pvzhrd6krg6ch"))))
+ (base32 "14d3lwik048h62qrzg1djdd2sqmxf3m1r859730pvzhrd6krg6ch"))
+ (patches (search-patches "accountsservice-extensions.patch"))))
(build-system meson-build-system)
(arguments
`(#:configure-flags
@@ -1479,7 +1480,14 @@ (define-public accountsservice
(("/usr/bin/passwd")
(search-input-file inputs "bin/passwd"))
(("/usr/bin/chage")
- (search-input-file inputs "bin/chage"))))))))
+ (search-input-file inputs "bin/chage")))))
+ (add-after 'install 'wrap-with-xdg-data-dirs
+ ;; This is to allow accountsservice finding extensions, which
+ ;; should be installed to the system profile.
+ (lambda* (#:key outputs #:allow-other-keys)
+ (wrap-program (search-input-file outputs "libexec/accounts-daemon")
+ '("XDG_DATA_DIRS" prefix
+ ("/run/current-system/profile/share"))))))))
(native-inputs
(list docbook-xml-4.1.2
docbook-xsl
diff --git a/gnu/packages/patches/accountsservice-extensions.patch b/gnu/packages/patches/accountsservice-extensions.patch
new file mode 100644
index 0000000000..2cfab580e3
--- /dev/null
+++ b/gnu/packages/patches/accountsservice-extensions.patch
@@ -0,0 +1,25 @@
+Patch from NixOS retrieved from
+https://raw.githubusercontent.com/NixOS/nixpkgs/master/pkgs/development/libraries/accountsservice/drop-prefix-check-extensions.patch.
+
+diff --git a/src/extensions.c b/src/extensions.c
+index 038dcb2..830465d 100644
+--- a/src/extensions.c
++++ b/src/extensions.c
+@@ -121,16 +121,7 @@ daemon_read_extension_directory (GHashTable *ifaces,
+ continue;
+ }
+
+- /* Ensure it looks like "../../dbus-1/interfaces/${name}" */
+- const gchar * const prefix = "../../dbus-1/interfaces/";
+- if (g_str_has_prefix (symlink, prefix) && g_str_equal (symlink + strlen (prefix), name)) {
+- daemon_read_extension_file (ifaces, filename);
+- }
+- else {
+- g_warning ("Found accounts service vendor extension symlink %s, but it must be exactly "
+- "equal to '../../dbus-1/interfaces/%s' for forwards-compatibility reasons.",
+- filename, name);
+- }
++ daemon_read_extension_file (ifaces, filename);
+ }
+
+ g_dir_close (dir);
--
2.36.1
guix-patches <at> gnu.org:bug#57168; Package guix-patches.
(Sat, 13 Aug 2022 06:55:03 GMT) Full text and rfc822 format available.Message #17 received at 57168 <at> debbugs.gnu.org (full text, mbox):
From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> To: 57168 <at> debbugs.gnu.org Cc: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> Subject: [PATCH 06/14] gnu: lightdm-gtk-greeter: Enable libklavier support. Date: Sat, 13 Aug 2022 02:54:25 -0400
* gnu/packages/display-managers.scm (lightdm-gtk-greeter)
[configure-flags]: Add '--with-libxklavier'.
[inputs]: Add libxklavier.
---
gnu/packages/display-managers.scm | 2 ++
1 file changed, 2 insertions(+)
diff --git a/gnu/packages/display-managers.scm b/gnu/packages/display-managers.scm
index 11d5c519ea..e8f7f68c46 100644
--- a/gnu/packages/display-managers.scm
+++ b/gnu/packages/display-managers.scm
@@ -357,6 +357,7 @@ (define-public lightdm-gtk-greeter
;; Put the binary under /bin rather than /sbin, so that it gets
;; wrapped by the glib-or-gtk-wrap phase.
(string-append "--sbindir=" #$output "/bin")
+ (string-append "--with-libxklavier")
(string-append "--enable-at-spi-command="
(search-input-file
%build-inputs "libexec/at-spi-bus-launcher")))
@@ -400,6 +401,7 @@ (define-public lightdm-gtk-greeter
gtk+
guile-3.0
librsvg
+ libxklavier
lightdm
shared-mime-info))
(synopsis "GTK+ greeter for LightDM")
--
2.36.1
guix-patches <at> gnu.org:bug#57168; Package guix-patches.
(Sat, 13 Aug 2022 06:55:03 GMT) Full text and rfc822 format available.Message #20 received at 57168 <at> debbugs.gnu.org (full text, mbox):
From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> To: 57168 <at> debbugs.gnu.org Cc: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> Subject: [PATCH 07/14] gnu: lightdm-gtk-greeter: Adjust default config file path. Date: Sat, 13 Aug 2022 02:54:26 -0400
* gnu/packages/display-managers.scm (lightdm-gtk-greeter)
[phases]{customize-default-config-path}: New phase.
---
gnu/packages/display-managers.scm | 8 ++++++++
1 file changed, 8 insertions(+)
diff --git a/gnu/packages/display-managers.scm b/gnu/packages/display-managers.scm
index e8f7f68c46..6fbefafe7d 100644
--- a/gnu/packages/display-managers.scm
+++ b/gnu/packages/display-managers.scm
@@ -364,6 +364,14 @@ (define-public lightdm-gtk-greeter
#:phases
#~(modify-phases %standard-phases
+ (add-after 'unpack 'customize-default-config-path
+ (lambda _
+ (substitute* "src/Makefile.in"
+ ;; Have the default config directory sourced from
+ ;; /etc/lightdm/lightdm-gtk-greeter.conf, which is where the
+ ;; lightdm service writes it.
+ (("\\$\\(sysconfdir)/lightdm/lightdm-gtk-greeter.conf")
+ "/etc/lightdm/lightdm-gtk-greeter.conf"))))
(add-after 'install 'fix-.desktop-file
(lambda* (#:key outputs #:allow-other-keys)
(substitute* (search-input-file
--
2.36.1
guix-patches <at> gnu.org:bug#57168; Package guix-patches.
(Sat, 13 Aug 2022 06:56:02 GMT) Full text and rfc822 format available.Message #23 received at 57168 <at> debbugs.gnu.org (full text, mbox):
From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> To: 57168 <at> debbugs.gnu.org Cc: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> Subject: [PATCH 05/14] gnu: lightdm-gtk-greeter: Use the glib-or-gtk-wrap phase as-is. Date: Sat, 13 Aug 2022 02:54:24 -0400
* gnu/packages/display-managers.scm (lightdm-gtk-greeter)
[configure-flags]: Install binaries to bin/, so the wrap phase of glib-or-gtk
handles them.
[phases]{wrap-program}: Delete.
{custom-wrap}: New phase, wrapping the wrapper with a few extra environment
variables.
---
gnu/packages/display-managers.scm | 54 +++++++++++++++----------------
1 file changed, 26 insertions(+), 28 deletions(-)
diff --git a/gnu/packages/display-managers.scm b/gnu/packages/display-managers.scm
index 53002f2122..11d5c519ea 100644
--- a/gnu/packages/display-managers.scm
+++ b/gnu/packages/display-managers.scm
@@ -54,6 +54,7 @@ (define-module (gnu packages display-managers)
#:use-module (gnu packages gnome)
#:use-module (gnu packages gnupg)
#:use-module (gnu packages gtk)
+ #:use-module (gnu packages guile)
#:use-module (gnu packages image)
#:use-module (gnu packages kde-frameworks)
#:use-module (gnu packages linux)
@@ -353,6 +354,9 @@ (define-public lightdm-gtk-greeter
(list
#:configure-flags
#~(list "--disable-indicator-services-command" ;requires upstart
+ ;; Put the binary under /bin rather than /sbin, so that it gets
+ ;; wrapped by the glib-or-gtk-wrap phase.
+ (string-append "--sbindir=" #$output "/bin")
(string-append "--enable-at-spi-command="
(search-input-file
%build-inputs "libexec/at-spi-bus-launcher")))
@@ -367,35 +371,29 @@ (define-public lightdm-gtk-greeter
(("Exec=lightdm-gtk-greeter")
(string-append "Exec="
(search-input-file
- outputs "sbin/lightdm-gtk-greeter"))))))
- (add-after 'fix-.desktop-file 'wrap-program
- ;; Mimic glib-or-gtk build system which doesn't wrap files in
- ;; /sbin.
- (lambda* (#:key outputs inputs #:allow-other-keys)
- (let ((gtk #$(this-package-input "gtk+"))
- (shared-mime-info #$(this-package-input "shared-mime-info"))
- (glib #$(this-package-input "glib")))
- (wrap-program (search-input-file
- outputs "sbin/lightdm-gtk-greeter")
- ;; Wrap GDK_PIXBUF_MODULE_FILE, so that the SVG loader is
- ;; available at all times even outside of profiles, such as
- ;; when used in the lightdm-service-type. Otherwise, it
- ;; wouldn't be able to display its own icons.
- `("GDK_PIXBUF_MODULE_FILE" =
- (,(search-input-file
- inputs
- "lib/gdk-pixbuf-2.0/2.10.0/loaders.cache")))
- `("XDG_DATA_DIRS" ":" prefix
- ,(cons "/run/current-system/profile/share"
- (map (lambda (pkg)
- (string-append pkg "/share"))
- (list gtk shared-mime-info glib))))
- `("GTK_PATH" ":" prefix (,gtk))
- `("GIO_EXTRA_MODULES" ":" prefix (,gtk))
- '("XCURSOR_PATH" ":" prefix
- ("/run/current-system/profile/share/icons")))))))))
+ outputs "bin/lightdm-gtk-greeter"))))))
+ (add-after 'glib-or-gtk-wrap 'custom-wrap
+ (lambda* (#:key outputs #:allow-other-keys)
+ (wrap-script (search-input-file
+ outputs "bin/lightdm-gtk-greeter")
+ ;; Wrap GDK_PIXBUF_MODULE_FILE, so that the SVG loader is
+ ;; available at all times even outside of profiles, such as
+ ;; when used in the lightdm-service-type. Otherwise, it
+ ;; wouldn't be able to display its own icons.
+ `("GDK_PIXBUF_MODULE_FILE" =
+ (,(search-input-file
+ outputs
+ "lib/gdk-pixbuf-2.0/2.10.0/loaders.cache")))
+ `("XDG_DATA_DIRS" ":" prefix
+ (,(string-append "/run/current-system/profile/share:"
+ (getenv "XDG_DATA_DIRS"))))
+ '("XCURSOR_PATH" ":" prefix
+ ("/run/current-system/profile/share/icons"))))))))
(native-inputs
- (list exo intltool pkg-config xfce4-dev-tools))
+ (list exo
+ intltool
+ pkg-config
+ xfce4-dev-tools))
(inputs
(list at-spi2-core
bash-minimal ;for wrap-program
--
2.36.1
guix-patches <at> gnu.org:bug#57168; Package guix-patches.
(Sat, 13 Aug 2022 06:56:02 GMT) Full text and rfc822 format available.Message #26 received at 57168 <at> debbugs.gnu.org (full text, mbox):
From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> To: 57168 <at> debbugs.gnu.org Cc: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> Subject: [PATCH 08/14] gnu: lightdm-gtk-greeter: Adjust --enable-at-spi-command value. Date: Sat, 13 Aug 2022 02:54:27 -0400
* gnu/packages/display-managers.scm (lightdm-gtk-greeter)
[configure-flags]: Add the '--launch-immediately' option to the
at-spi-bus-launcher to match what is used in the source.
---
gnu/packages/display-managers.scm | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/gnu/packages/display-managers.scm b/gnu/packages/display-managers.scm
index 6fbefafe7d..d6cf9445c6 100644
--- a/gnu/packages/display-managers.scm
+++ b/gnu/packages/display-managers.scm
@@ -360,8 +360,8 @@ (define-public lightdm-gtk-greeter
(string-append "--with-libxklavier")
(string-append "--enable-at-spi-command="
(search-input-file
- %build-inputs "libexec/at-spi-bus-launcher")))
-
+ %build-inputs "libexec/at-spi-bus-launcher")
+ " --launch-immediately"))
#:phases
#~(modify-phases %standard-phases
(add-after 'unpack 'customize-default-config-path
--
2.36.1
guix-patches <at> gnu.org:bug#57168; Package guix-patches.
(Sat, 13 Aug 2022 06:56:03 GMT) Full text and rfc822 format available.Message #29 received at 57168 <at> debbugs.gnu.org (full text, mbox):
From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> To: 57168 <at> debbugs.gnu.org Cc: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> Subject: [PATCH 09/14] gnu: lightdm: Apply patch to fix a problem with VNC integration. Date: Sat, 13 Aug 2022 02:54:28 -0400
* gnu/packages/patches/lightdm-vncserver-check.patch: New patch.
* gnu/local.mk (dist_patch_DATA): Register it.
* gnu/packages/display-managers.scm (lightdm): Apply it.
---
gnu/local.mk | 1 +
gnu/packages/display-managers.scm | 7 +-
.../patches/lightdm-vncserver-check.patch | 66 +++++++++++++++++++
3 files changed, 71 insertions(+), 3 deletions(-)
create mode 100644 gnu/packages/patches/lightdm-vncserver-check.patch
diff --git a/gnu/local.mk b/gnu/local.mk
index c2a33fa7d1..b1b0f7ac36 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -1355,6 +1355,7 @@ dist_patch_DATA = \
%D%/packages/patches/librime-fix-build-with-gcc10.patch \
%D%/packages/patches/libvirt-add-install-prefix.patch \
%D%/packages/patches/libziparchive-add-includes.patch \
+ %D%/packages/patches/lightdm-vncserver-check.patch \
%D%/packages/patches/localed-xorg-keyboard.patch \
%D%/packages/patches/kdiagram-Fix-missing-link-libraries.patch \
%D%/packages/patches/kiki-level-selection-crash.patch \
diff --git a/gnu/packages/display-managers.scm b/gnu/packages/display-managers.scm
index d6cf9445c6..022e0509aa 100644
--- a/gnu/packages/display-managers.scm
+++ b/gnu/packages/display-managers.scm
@@ -268,7 +268,8 @@ (define-public lightdm
(file-name (git-file-name name version))
(sha256
(base32
- "1wr60c946p8jz9kb8zi4cd8d4mkcy7infbvlfzwajiglc22nblxn"))))
+ "1wr60c946p8jz9kb8zi4cd8d4mkcy7infbvlfzwajiglc22nblxn"))
+ (patches (search-patches "lightdm-vncserver-check.patch"))))
(build-system gnu-build-system)
(arguments
'(#:parallel-tests? #f ; fails when run in parallel
@@ -303,8 +304,8 @@ (define-public lightdm
(unsetenv "LC_ALL"))))))
(inputs
(list audit
- bash-minimal ;for cross-compilation
- coreutils-minimal ;ditto
+ bash-minimal ;for cross-compilation
+ coreutils-minimal ;ditto
linux-pam
shadow ;for sbin/nologin
libgcrypt
diff --git a/gnu/packages/patches/lightdm-vncserver-check.patch b/gnu/packages/patches/lightdm-vncserver-check.patch
new file mode 100644
index 0000000000..0e31ff3d68
--- /dev/null
+++ b/gnu/packages/patches/lightdm-vncserver-check.patch
@@ -0,0 +1,66 @@
+Honor the Xvnc command specified in the config instead of using a hard-coded
+default.
+
+Submitted upstream at: https://github.com/canonical/lightdm/pull/265
+
+diff --git a/src/lightdm.c b/src/lightdm.c
+index 74f9ff2d..0ccfcd78 100644
+--- a/src/lightdm.c
++++ b/src/lightdm.c
+@@ -349,27 +349,42 @@ start_display_manager (void)
+ /* Start the VNC server */
+ if (config_get_boolean (config_get_instance (), "VNCServer", "enabled"))
+ {
+- g_autofree gchar *path = g_find_program_in_path ("Xvnc");
+- if (path)
++ /* Validate that a the VNC command is available. */
++ g_autofree gchar *command = config_get_string (config_get_instance (), "VNCServer", "command");
++ if (command)
+ {
+- vnc_server = vnc_server_new ();
+- if (config_has_key (config_get_instance (), "VNCServer", "port"))
++ g_auto(GStrv) tokens = g_strsplit (command, " ", 2);
++ if (!g_find_program_in_path (tokens[0]))
+ {
+- gint port = config_get_integer (config_get_instance (), "VNCServer", "port");
+- if (port > 0)
+- vnc_server_set_port (vnc_server, port);
++ g_warning ("Can't start VNC server; command '%s' not found", tokens[0]);
++ return;
+ }
+- g_autofree gchar *listen_address = config_get_string (config_get_instance (), "VNCServer", "listen-address");
+- vnc_server_set_listen_address (vnc_server, listen_address);
+- g_signal_connect (vnc_server, VNC_SERVER_SIGNAL_NEW_CONNECTION, G_CALLBACK (vnc_connection_cb), NULL);
+-
+- g_debug ("Starting VNC server on TCP/IP port %d", vnc_server_get_port (vnc_server));
+- vnc_server_start (vnc_server);
+ }
+ else
+- g_warning ("Can't start VNC server, Xvnc is not in the path");
++ {
++ /* Fallback to 'Xvnc'. */
++ if (!g_find_program_in_path ("Xvnc")) {
++ g_warning ("Can't start VNC server; 'Xvnc' command not found");
++ return;
++ }
++ }
++
++ vnc_server = vnc_server_new ();
++ if (config_has_key (config_get_instance (), "VNCServer", "port"))
++ {
++ gint port = config_get_integer (config_get_instance (), "VNCServer", "port");
++ if (port > 0)
++ vnc_server_set_port (vnc_server, port);
++ }
++ g_autofree gchar *listen_address = config_get_string (config_get_instance (), "VNCServer", "listen-address");
++ vnc_server_set_listen_address (vnc_server, listen_address);
++ g_signal_connect (vnc_server, VNC_SERVER_SIGNAL_NEW_CONNECTION, G_CALLBACK (vnc_connection_cb), NULL);
++
++ g_debug ("Starting VNC server on TCP/IP port %d", vnc_server_get_port (vnc_server));
++ vnc_server_start (vnc_server);
+ }
+ }
++
+ static void
+ service_ready_cb (DisplayManagerService *service)
+ {
--
2.36.1
guix-patches <at> gnu.org:bug#57168; Package guix-patches.
(Sat, 13 Aug 2022 06:56:03 GMT) Full text and rfc822 format available.Message #32 received at 57168 <at> debbugs.gnu.org (full text, mbox):
From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> To: 57168 <at> debbugs.gnu.org Cc: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> Subject: [PATCH 10/14] gnu: lightdm: Apply patch to allow using VNC options. Date: Sat, 13 Aug 2022 02:54:29 -0400
* gnu/packages/patches/lightdm-arguments-ordering.patch: New patch.
* gnu/local.mk (dist_patch_DATA): Register it.
* gnu/packages/display-managers.scm (lightdm): Apply it.
---
gnu/local.mk | 1 +
gnu/packages/display-managers.scm | 3 +-
.../patches/lightdm-arguments-ordering.patch | 54 +++++++++++++++++++
3 files changed, 57 insertions(+), 1 deletion(-)
create mode 100644 gnu/packages/patches/lightdm-arguments-ordering.patch
diff --git a/gnu/local.mk b/gnu/local.mk
index b1b0f7ac36..a6be7cc423 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -1355,6 +1355,7 @@ dist_patch_DATA = \
%D%/packages/patches/librime-fix-build-with-gcc10.patch \
%D%/packages/patches/libvirt-add-install-prefix.patch \
%D%/packages/patches/libziparchive-add-includes.patch \
+ %D%/packages/patches/lightdm-arguments-ordering.patch \
%D%/packages/patches/lightdm-vncserver-check.patch \
%D%/packages/patches/localed-xorg-keyboard.patch \
%D%/packages/patches/kdiagram-Fix-missing-link-libraries.patch \
diff --git a/gnu/packages/display-managers.scm b/gnu/packages/display-managers.scm
index 022e0509aa..2a0a72d145 100644
--- a/gnu/packages/display-managers.scm
+++ b/gnu/packages/display-managers.scm
@@ -269,7 +269,8 @@ (define-public lightdm
(sha256
(base32
"1wr60c946p8jz9kb8zi4cd8d4mkcy7infbvlfzwajiglc22nblxn"))
- (patches (search-patches "lightdm-vncserver-check.patch"))))
+ (patches (search-patches "lightdm-arguments-ordering.patch"
+ "lightdm-vncserver-check.patch"))))
(build-system gnu-build-system)
(arguments
'(#:parallel-tests? #f ; fails when run in parallel
diff --git a/gnu/packages/patches/lightdm-arguments-ordering.patch b/gnu/packages/patches/lightdm-arguments-ordering.patch
new file mode 100644
index 0000000000..c3b513a19a
--- /dev/null
+++ b/gnu/packages/patches/lightdm-arguments-ordering.patch
@@ -0,0 +1,54 @@
+When providing the VNCServer command as 'Xvnc -SecurityTypes None',
+the formatted command line used would look like:
+
+ Xvnc -SecurityTypes None :1 -auth /var/run/lightdm/root/:1
+
+which is invalid (the display number must appear first).
+
+Submitted upstream at: https://github.com/canonical/lightdm/pull/265
+
+ src/x-server-local.c | 14 +++++++++++++-
+ 1 file changed, 13 insertions(+), 1 deletion(-)
+
+diff --git a/src/x-server-local.c b/src/x-server-local.c
+index 7c4ab870..6c540d18 100644
+--- a/src/x-server-local.c
++++ b/src/x-server-local.c
+@@ -463,14 +463,20 @@ x_server_local_start (DisplayServer *display_server)
+ l_debug (display_server, "Logging to %s", log_file);
+
+ g_autofree gchar *absolute_command = get_absolute_command (priv->command);
++ g_auto(GStrv) tokens = g_strsplit (absolute_command, " ", 2);
++ const gchar* binary = tokens[0];
++ const gchar *extra_options = tokens[1];
++
+ if (!absolute_command)
+ {
+ l_debug (display_server, "Can't launch X server %s, not found in path", priv->command);
+ stopped_cb (priv->x_server_process, X_SERVER_LOCAL (server));
+ return FALSE;
+ }
+- g_autoptr(GString) command = g_string_new (absolute_command);
++ g_autoptr(GString) command = g_string_new (binary);
+
++ /* The display argument must be given first when the X server used
++ * is Xvnc. */
+ g_string_append_printf (command, " :%d", priv->display_number);
+
+ if (priv->config_file)
+@@ -513,6 +519,12 @@ x_server_local_start (DisplayServer *display_server)
+ if (X_SERVER_LOCAL_GET_CLASS (server)->add_args)
+ X_SERVER_LOCAL_GET_CLASS (server)->add_args (server, command);
+
++ /* Any extra user options provided via the VNCServer 'command'
++ * config option are appended last, so the user can override any
++ * of the above. */
++ if (extra_options)
++ g_string_append_printf (command, " %s", extra_options);
++
+ process_set_command (priv->x_server_process, command->str);
+
+ l_debug (display_server, "Launching X Server");
+--
+2.36.1
+
--
2.36.1
guix-patches <at> gnu.org:bug#57168; Package guix-patches.
(Sat, 13 Aug 2022 06:56:04 GMT) Full text and rfc822 format available.Message #35 received at 57168 <at> debbugs.gnu.org (full text, mbox):
From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> To: 57168 <at> debbugs.gnu.org Cc: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> Subject: [PATCH 11/14] gnu: lightdm: Apply patch to fix color depth issue with VNC. Date: Sat, 13 Aug 2022 02:54:30 -0400
* gnu/packages/patches/lightdm-vnc-color-depth.patch: New patch.
* gnu/local.mk (dist_patch_DATA): Register it.
* gnu/packages/display-managers.scm (lightdm): Apply it.
---
gnu/local.mk | 1 +
gnu/packages/display-managers.scm | 3 +-
.../patches/lightdm-vnc-color-depth.patch | 81 +++++++++++++++++++
3 files changed, 84 insertions(+), 1 deletion(-)
create mode 100644 gnu/packages/patches/lightdm-vnc-color-depth.patch
diff --git a/gnu/local.mk b/gnu/local.mk
index a6be7cc423..e0c6d6fba1 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -1357,6 +1357,7 @@ dist_patch_DATA = \
%D%/packages/patches/libziparchive-add-includes.patch \
%D%/packages/patches/lightdm-arguments-ordering.patch \
%D%/packages/patches/lightdm-vncserver-check.patch \
+ %D%/packages/patches/lightdm-vnc-color-depth.patch \
%D%/packages/patches/localed-xorg-keyboard.patch \
%D%/packages/patches/kdiagram-Fix-missing-link-libraries.patch \
%D%/packages/patches/kiki-level-selection-crash.patch \
diff --git a/gnu/packages/display-managers.scm b/gnu/packages/display-managers.scm
index 2a0a72d145..137bd2739e 100644
--- a/gnu/packages/display-managers.scm
+++ b/gnu/packages/display-managers.scm
@@ -270,7 +270,8 @@ (define-public lightdm
(base32
"1wr60c946p8jz9kb8zi4cd8d4mkcy7infbvlfzwajiglc22nblxn"))
(patches (search-patches "lightdm-arguments-ordering.patch"
- "lightdm-vncserver-check.patch"))))
+ "lightdm-vncserver-check.patch"
+ "lightdm-vnc-color-depth.patch"))))
(build-system gnu-build-system)
(arguments
'(#:parallel-tests? #f ; fails when run in parallel
diff --git a/gnu/packages/patches/lightdm-vnc-color-depth.patch b/gnu/packages/patches/lightdm-vnc-color-depth.patch
new file mode 100644
index 0000000000..cd69977d6a
--- /dev/null
+++ b/gnu/packages/patches/lightdm-vnc-color-depth.patch
@@ -0,0 +1,81 @@
+There is no longer support for 8 bit color depth in TigerVNC (see:
+https://github.com/TigerVNC/tigervnc/commit/e86d8720ba1e79b486ca29a5c2b27fa25811e6a2);
+using it causes a fatal error.
+
+Submitted upstream at: https://github.com/canonical/lightdm/pull/265.
+
+diff --git a/data/lightdm.conf b/data/lightdm.conf
+index 0df38429..60e3e8b4 100644
+--- a/data/lightdm.conf
++++ b/data/lightdm.conf
+@@ -160,4 +160,4 @@
+ #listen-address=
+ #width=1024
+ #height=768
+-#depth=8
++#depth=24
+diff --git a/src/x-server-xvnc.c b/src/x-server-xvnc.c
+index 68340d53..27ca4454 100644
+--- a/src/x-server-xvnc.c
++++ b/src/x-server-xvnc.c
+@@ -127,7 +127,7 @@ x_server_xvnc_init (XServerXVNC *server)
+ XServerXVNCPrivate *priv = x_server_xvnc_get_instance_private (server);
+ priv->width = 1024;
+ priv->height = 768;
+- priv->depth = 8;
++ priv->depth = 24;
+ }
+
+ static void
+diff --git a/tests/scripts/vnc-command.conf b/tests/scripts/vnc-command.conf
+index 0f1e25fd..335956d9 100644
+--- a/tests/scripts/vnc-command.conf
++++ b/tests/scripts/vnc-command.conf
+@@ -19,7 +19,7 @@ command=Xvnc -option
+ #?VNC-CLIENT CONNECT
+
+ # Xvnc server starts
+-#?XVNC-0 START GEOMETRY=1024x768 DEPTH=8 OPTION=TRUE
++#?XVNC-0 START GEOMETRY=1024x768 DEPTH=24 OPTION=TRUE
+
+ # Daemon connects when X server is ready
+ #?*XVNC-0 INDICATE-READY
+diff --git a/tests/scripts/vnc-guest.conf b/tests/scripts/vnc-guest.conf
+index 431bb244..ce2b97db 100644
+--- a/tests/scripts/vnc-guest.conf
++++ b/tests/scripts/vnc-guest.conf
+@@ -21,7 +21,7 @@ user-session=default
+ #?VNC-CLIENT CONNECT
+
+ # Xvnc server starts
+-#?XVNC-0 START GEOMETRY=1024x768 DEPTH=8 OPTION=FALSE
++#?XVNC-0 START GEOMETRY=1024x768 DEPTH=24 OPTION=FALSE
+
+ # Daemon connects when X server is ready
+ #?*XVNC-0 INDICATE-READY
+diff --git a/tests/scripts/vnc-login.conf b/tests/scripts/vnc-login.conf
+index cdfe17b8..f0d65b7f 100644
+--- a/tests/scripts/vnc-login.conf
++++ b/tests/scripts/vnc-login.conf
+@@ -21,7 +21,7 @@ user-session=default
+ #?VNC-CLIENT CONNECT
+
+ # Xvnc server starts
+-#?XVNC-0 START GEOMETRY=1024x768 DEPTH=8 OPTION=FALSE
++#?XVNC-0 START GEOMETRY=1024x768 DEPTH=24 OPTION=FALSE
+
+ # Daemon connects when X server is ready
+ #?*XVNC-0 INDICATE-READY
+diff --git a/tests/scripts/vnc-open-file-descriptors.conf b/tests/scripts/vnc-open-file-descriptors.conf
+index 753c84dd..e5d35730 100644
+--- a/tests/scripts/vnc-open-file-descriptors.conf
++++ b/tests/scripts/vnc-open-file-descriptors.conf
+@@ -21,7 +21,7 @@ user-session=default
+ #?VNC-CLIENT CONNECT
+
+ # Xvnc server starts
+-#?XVNC-0 START GEOMETRY=1024x768 DEPTH=8 OPTION=FALSE
++#?XVNC-0 START GEOMETRY=1024x768 DEPTH=24 OPTION=FALSE
+
+ # Daemon connects when X server is ready
+ #?*XVNC-0 INDICATE-READY
--
2.36.1
guix-patches <at> gnu.org:bug#57168; Package guix-patches.
(Sat, 13 Aug 2022 06:56:04 GMT) Full text and rfc822 format available.Message #38 received at 57168 <at> debbugs.gnu.org (full text, mbox):
From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> To: 57168 <at> debbugs.gnu.org Cc: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> Subject: [PATCH 12/14] marionette: Improve the error message of 'wait-for-screen-text'. Date: Sat, 13 Aug 2022 02:54:31 -0400
* gnu/build/marionette.scm (wait-for-screen-text): Return the last OCR'd text
when the predicate fails to match instead of the not useful predicate object.
---
gnu/build/marionette.scm | 14 ++++++++------
1 file changed, 8 insertions(+), 6 deletions(-)
diff --git a/gnu/build/marionette.scm b/gnu/build/marionette.scm
index 4f409166db..24170bbd30 100644
--- a/gnu/build/marionette.scm
+++ b/gnu/build/marionette.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016-2022 Ludovic Courtès <ludo <at> gnu.org>
;;; Copyright © 2018 Chris Marusich <cmmarusich <at> gmail.com>
+;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -308,13 +309,14 @@ (define start
(define end
(+ start timeout))
- (let loop ()
+ (let loop ((last-text #f))
(if (> (car (gettimeofday)) end)
- (error "'wait-for-screen-text' timeout" predicate)
- (or (predicate (marionette-screen-text marionette #:ocrad ocrad))
- (begin
- (sleep 1)
- (loop))))))
+ (error "'wait-for-screen-text' timeout" 'ocr-text: last-text)
+ (let ((text (marionette-screen-text marionette #:ocrad ocrad)))
+ (or (predicate text)
+ (begin
+ (sleep 1)
+ (loop text)))))))
(define %qwerty-us-keystrokes
;; Maps "special" characters to their keystrokes.
--
2.36.1
guix-patches <at> gnu.org:bug#57168; Package guix-patches.
(Sat, 13 Aug 2022 06:56:04 GMT) Full text and rfc822 format available.Message #41 received at 57168 <at> debbugs.gnu.org (full text, mbox):
From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> To: 57168 <at> debbugs.gnu.org Cc: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> Subject: [PATCH 13/14] build: marionette: Add support for Tesseract OCR. Date: Sat, 13 Aug 2022 02:54:32 -0400
* gnu/build/marionette.scm (invoke-ocrad-ocr): New procedure.
(invoke-tesseract-ocr): Likewise.
(marionette-screen-text): Rename the #:ocrad argument to #:ocr. Dispatch the
matching OCR invocation procedure.
(wait-for-screen-text): Rename the #:ocrad argument to #:ocr.
* gnu/tests/base.scm (run-basic-test): Adjust accordingly.
* gnu/tests/install.scm (enter-luks-passphrase): Likewise.
(enter-luks-passphrase-for-home): Likewise.
---
gnu/build/marionette.scm | 67 +++++++++++++++++++++++-----------------
gnu/tests/base.scm | 4 +--
gnu/tests/install.scm | 8 ++---
3 files changed, 45 insertions(+), 34 deletions(-)
diff --git a/gnu/build/marionette.scm b/gnu/build/marionette.scm
index 24170bbd30..06b699bd7b 100644
--- a/gnu/build/marionette.scm
+++ b/gnu/build/marionette.scm
@@ -268,39 +268,50 @@ (define (marionette-control command marionette)
;; The "quit" command terminates QEMU immediately, with no output.
(unless (string=? command "quit") (wait-for-monitor-prompt monitor)))))
-(define* (marionette-screen-text marionette
- #:key
- (ocrad "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 OCRAD (file name for GNU Ocrad's command)"
- (define (random-file-name)
- (string-append "/tmp/marionette-screenshot-"
- (number->string (random (expt 2 32)) 16)
- ".ppm"))
-
- (let ((image (random-file-name)))
+(define* (invoke-ocrad-ocr image #:key (ocrad "ocrad"))
+ "Invoke the OCRAD command on image, and return the recognized text."
+ (let* ((pipe (open-pipe* OPEN_READ ocrad "-i" "-s" "10" image))
+ (text (get-string-all pipe)))
+ (unless (zero? (close-pipe pipe))
+ (error "'ocrad' failed" ocrad))
+ text))
+
+(define* (invoke-tesseract-ocr image #:key (tesseract "tesseract"))
+ "Invoke the TESSERACT command on IMAGE, and return the recognized text."
+ (let* ((output-basename (tmpnam))
+ (output-basename* (string-append output-basename ".txt")))
(dynamic-wind
(const #t)
(lambda ()
- (marionette-control (string-append "screendump " image)
- marionette)
-
- ;; Tell Ocrad to invert the image colors (make it black on white) and
- ;; to scale the image up, which significantly improves the quality of
- ;; the result. In spite of this, be aware that OCR confuses "y" and
- ;; "V" and sometimes erroneously introduces white space.
- (let* ((pipe (open-pipe* OPEN_READ ocrad
- "-i" "-s" "10" image))
- (text (get-string-all pipe)))
- (unless (zero? (close-pipe pipe))
- (error "'ocrad' failed" ocrad))
- text))
+ (let ((exit-val (status:exit-val
+ (system* tesseract image output-basename))))
+ (unless (zero? exit-val)
+ (error "'tesseract' failed" tesseract))
+ (call-with-input-file output-basename* get-string-all)))
(lambda ()
- (false-if-exception (delete-file image))))))
+ (false-if-exception (delete-file output-basename))
+ (false-if-exception (delete-file output-basename*))))))
+
+(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."
+ (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))
+ ((string-contains ocr "tesseract")
+ (invoke-tesseract-ocr image #:tesseract ocr))
+ (else (error "unsupported ocr command"))))
(define* (wait-for-screen-text marionette predicate
- #:key (timeout 30) (ocrad "ocrad"))
+ #:key
+ (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."
(define start
@@ -312,7 +323,7 @@ (define end
(let loop ((last-text #f))
(if (> (car (gettimeofday)) end)
(error "'wait-for-screen-text' timeout" 'ocr-text: last-text)
- (let ((text (marionette-screen-text marionette #:ocrad ocrad)))
+ (let ((text (marionette-screen-text marionette #:ocr ocr)))
(or (predicate text)
(begin
(sleep 1)
diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm
index 353d6d415a..636b127fb8 100644
--- a/gnu/tests/base.scm
+++ b/gnu/tests/base.scm
@@ -341,7 +341,7 @@ (define (user-owned? file)
(wait-for-screen-text marionette
(lambda (text)
(string-contains text "Password"))
- #:ocrad
+ #:ocr
#$(file-append ocrad "/bin/ocrad"))
(marionette-type (string-append password "\n\n")
marionette))
@@ -510,7 +510,7 @@ (define (entry->list entry)
(test-assert "screen text"
(let ((text (marionette-screen-text marionette
- #:ocrad
+ #:ocr
#$(file-append ocrad
"/bin/ocrad"))))
;; Check whether the welcome message and shell prompt are
diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm
index fbb97d451c..4e0e274e66 100644
--- a/gnu/tests/install.scm
+++ b/gnu/tests/install.scm
@@ -784,7 +784,7 @@ (define (bios-boot-screen? text)
;; At this point we have no choice but to use OCR to determine
;; when the passphrase should be entered.
(wait-for-screen-text #$marionette passphrase-prompt?
- #:ocrad #$ocrad)
+ #:ocr #$ocrad)
(marionette-type #$(string-append %luks-passphrase "\n")
#$marionette)
@@ -792,7 +792,7 @@ (define (bios-boot-screen? text)
;; we can then be sure we match the "Enter passphrase" prompt from
;; 'cryptsetup', in the initrd.
(wait-for-screen-text #$marionette (negate bios-boot-screen?)
- #:ocrad #$ocrad
+ #:ocr #$ocrad
#:timeout 20)))
(test-assert "enter LUKS passphrase for the initrd"
@@ -800,7 +800,7 @@ (define (bios-boot-screen? text)
;; XXX: Here we use OCR as well but we could instead use QEMU
;; '-serial stdio' and run it in an input pipe,
(wait-for-screen-text #$marionette passphrase-prompt?
- #:ocrad #$ocrad
+ #:ocr #$ocrad
#:timeout 60)
(marionette-type #$(string-append %luks-passphrase "\n")
#$marionette)
@@ -999,7 +999,7 @@ (define (passphrase-prompt? text)
;; XXX: Here we use OCR as well but we could instead use QEMU
;; '-serial stdio' and run it in an input pipe,
(wait-for-screen-text #$marionette passphrase-prompt?
- #:ocrad #$ocrad
+ #:ocr #$ocrad
#:timeout 120)
(marionette-type #$(string-append %luks-passphrase "\n")
#$marionette)
--
2.36.1
guix-patches <at> gnu.org:bug#57168; Package guix-patches.
(Sat, 13 Aug 2022 06:56:05 GMT) Full text and rfc822 format available.Message #44 received at 57168 <at> debbugs.gnu.org (full text, mbox):
From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> To: 57168 <at> debbugs.gnu.org Cc: Ricardo Wurmus <rekado <at> elephly.net>, Maxim Cournoyer <maxim.cournoyer <at> gmail.com>, L p R n d n <guix <at> lprndn.info> Subject: [PATCH 14/14] services: Add lightdm-service-type. Date: Sat, 13 Aug 2022 02:54:33 -0400
* gnu/services/lightdm.scm: New service.
* tests/services/lightdm.scm: Test it.
* doc/guix.texi (X Window): Document it.
* gnu/local.mk (GNU_SYSTEM_MODULES): Register it.
Co-authored-by: L p R n d n <guix <at> lprndn.info>
Co-authored-by: Ricardo Wurmus <rekado <at> elephly.net>
---
Makefile.am | 1 +
doc/guix.texi | 202 +++++++++++
gnu/local.mk | 1 +
gnu/services/lightdm.scm | 687 +++++++++++++++++++++++++++++++++++++
gnu/tests/lightdm.scm | 161 +++++++++
tests/services/lightdm.scm | 52 +++
6 files changed, 1104 insertions(+)
create mode 100644 gnu/services/lightdm.scm
create mode 100644 gnu/tests/lightdm.scm
create mode 100644 tests/services/lightdm.scm
diff --git a/Makefile.am b/Makefile.am
index 8df8222573..502ca73866 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -533,6 +533,7 @@ SCM_TESTS = \
tests/services.scm \
tests/services/file-sharing.scm \
tests/services/configuration.scm \
+ tests/services/lightdm.scm \
tests/services/linux.scm \
tests/services/telephony.scm \
tests/sets.scm \
diff --git a/doc/guix.texi b/doc/guix.texi
index 039df29ebc..596bb15288 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -21267,6 +21267,208 @@ Relogin after logout.
@end table
@end deftp
+@cindex lightdm, graphical login manager
+@cindex display manager, 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
+value must be a @code{lightdm-configuration} record, which is documented
+below. Among its distinguishing features are TigerVNC integration for
+easily remoting your desktop as well as support for the XDMCP protocol,
+which can be used by remote clients to start a session from the login
+manager.
+
+In its most basic form, it can be used simply as:
+
+@lisp
+(service lightdm-service-type)
+@end lisp
+
+A more elaborate example making use of the VNC capabilities and enabling
+more features and verbose logs could look like:
+
+@lisp
+(service lightdm-service-type
+ (lightdm-configuration
+ (allow-empty-passwords? #t)
+ (xdmcp? #t)
+ (vnc-server? #t)
+ (vnc-server-command
+ (file-append tigervnc-server "/bin/Xvnc"
+ " -SecurityTypes None"))
+ (seats
+ (list (lightdm-seat-configuration
+ (name "*")
+ (user-session "ratpoison"))))))
+@end lisp
+@end defvr
+
+@c The LightDM service documentation can be auto-generated via the
+@c 'generate-doc' procedure at the bottom of the (gnu services lightdm)
+@c module.
+@c %start of fragment
+@deftp {Data Type} lightdm-configuration
+Available @code{lightdm-configuration} fields are:
+
+@table @asis
+@item @code{lightdm} (default: @code{lightdm}) (type: file-like)
+The lightdm package to use.
+
+@item @code{allow-empty-passwords?} (default: @code{#f}) (type: boolean)
+Whether users not having a password set can login.
+
+@item @code{debug?} (default: @code{#f}) (type: boolean)
+Enable verbose output.
+
+@item @code{xorg-configuration} (type: xorg-configuration)
+The default Xorg server configuration to use to generate the Xorg server
+start script. It can be refined per seat via the @code{xserver-command}
+of the @code{<lightdm-seat-configuration>} record, if desired.
+
+@item @code{greeters} (type: list-of-greeter-configurations)
+The LightDM greeter configurations specifying the greeters to use.
+
+@item @code{seats} (type: list-of-seat-configurations)
+The seat configurations to use. A LightDM seat is akin to a user.
+
+@item @code{xdmcp?} (default: @code{#f}) (type: boolean)
+Whether a XDMCP server should listen on port UDP 177.
+
+@item @code{xdmcp-listen-address} (type: maybe-string)
+The host or IP address the XDMCP server listens for incoming
+connections. When unspecified, listen on for any hosts/IP addresses.
+
+@item @code{vnc-server?} (default: @code{#f}) (type: boolean)
+Whether a VNC server is started.
+
+@item @code{vnc-server-command} (type: file-like)
+The Xvnc command to use for the VNC server, it's possible to provide
+extra options not otherwise exposed along the command, for example to
+disable security:
+
+@lisp
+(vnc-server-command (file-append tigervnc-server "/bin/Xvnc"
+ " -SecurityTypes None" ))
+@end lisp
+
+Or to set a PasswordFile for the classic (unsecure) VncAuth
+mecanism:
+
+@lisp
+(vnc-server-command (file-append tigervnc-server "/bin/Xvnc"
+ " -PasswordFile /var/lib/lightdm/.vnc/passwd"))
+@end lisp
+
+The password file should be manually created using the
+@command{vncpasswd} command. Note that LightDM will create new sessions
+for VNC users, which means they need to authenticate in the same way as
+local users would.
+
+@item @code{vnc-server-listen-address} (type: maybe-string)
+The host or IP address the VNC server listens for incoming connections.
+When unspecified, listen for any hosts/IP addresses.
+
+@item @code{vnc-server-port} (default: @code{5900}) (type: number)
+The TCP port the VNC server should listen to.
+
+@item @code{extra-config} (default: @code{()}) (type: list-of-strings)
+Extra configuration values to append to the LightDM configuration file.
+
+@end table
+@end deftp
+
+
+@c %end of fragment
+@c %start of fragment
+
+@deftp {Data Type} lightdm-gtk-greeter-configuration
+Available @code{lightdm-gtk-greeter-configuration} fields are:
+
+@table @asis
+@item @code{lightdm-gtk-greeter} (default: @code{lightdm-gtk-greeter}) (type: file-like)
+The lightdm-gtk-greeter package to use.
+
+@item @code{assets} @
+(default: @code{(adwaita-icon-theme gnome-themes-extrahicolor-icon-theme)}) @
+(type: list-of-file-likes)
+The list of packages complementing the greeter, such as package
+providing icon themes.
+
+@item @code{theme-name} (default: @code{"Adwaita"}) (type: string)
+The name of the theme to use.
+
+@item @code{icon-theme-name} (default: @code{"Adwaita"}) (type: string)
+The name of the icon theme to use.
+
+@item @code{cursor-theme-name} (default: @code{"Adwaita"}) (type: string)
+The name of the cursor theme to use.
+
+@item @code{cursor-theme-size} (default: @code{16}) (type: number)
+The size to use for the the cursor theme.
+
+@item @code{allow-debugging?} (type: maybe-boolean)
+Set to #t to enable debug log level.
+
+@item @code{background} (type: file-like)
+The background image to use.
+
+@item @code{at-spi-enabled?} (default: @code{#f}) (type: boolean)
+Enable accessibility support through the Assistive Technology Service
+Provider Interface (AT-SPI).
+
+@item @code{a11y-states} @
+(default: @code{(contrast font keyboard reader)}) (type: list-of-a11y-states)
+The accessibility features to enable, given as list of symbols.
+
+@item @code{reader} (type: maybe-file-like)
+The command to use to launch a screen reader.
+
+@item @code{extra-config} (default: @code{()}) (type: list-of-strings)
+Extra configuration values to append to the LightDM GTK Greeter
+configuration file.
+
+@end table
+@end deftp
+
+@c %end of fragment
+@c %start of fragment
+
+@deftp {Data Type} lightdm-seat-configuration
+Available @code{lightdm-seat-configuration} fields are:
+
+@table @asis
+@item @code{name} (type: seat-name)
+The name of the seat. An asterisk (*) can be used in the name to apply
+the seat configuration to all the seat names it matches.
+
+@item @code{user-session} (type: maybe-string)
+The session to use by default. The session name must be provided as a
+lowercase string, such as @code{"gnome"}, @code{"ratpoison"}, etc.
+
+@item @code{type} (default: @code{local}) (type: seat-type)
+The type of the seat, either the @code{local} or @code{xremote} symbol.
+
+@item @code{autologin-user} (type: maybe-string)
+The username to automatically log in with by default.
+
+@item @code{greeter-session} @
+(default: @code{lightdm-gtk-greeter}) (type: greeter-session)
+The greeter session to use, specified as a symbol. Currently, only
+@code{lightdm-gtk-greeter} is supported.
+
+@item @code{xserver-command} (type: maybe-file-like)
+The Xorg server command to run.
+
+@item @code{session-wrapper} (type: file-like)
+The xinitrc session wrapper to use.
+
+@item @code{extra-config} (default: @code{()}) (type: list-of-strings)
+Extra configuration values to append to the seat configuration section.
+
+@end table
+@end deftp
+@c %end of fragment
+
@cindex Xorg, configuration
@deftp {Data Type} xorg-configuration
diff --git a/gnu/local.mk b/gnu/local.mk
index e0c6d6fba1..69847cdfc2 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -660,6 +660,7 @@ GNU_SYSTEM_MODULES = \
%D%/services/guix.scm \
%D%/services/hurd.scm \
%D%/services/kerberos.scm \
+ %D%/services/lightdm.scm \
%D%/services/linux.scm \
%D%/services/lirc.scm \
%D%/services/virtualization.scm \
diff --git a/gnu/services/lightdm.scm b/gnu/services/lightdm.scm
new file mode 100644
index 0000000000..07f2e808dd
--- /dev/null
+++ b/gnu/services/lightdm.scm
@@ -0,0 +1,687 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2019, 2020 L p R n d n <guix <at> lprndn.info>
+;;; Copyright © 2020 Ricardo Wurmus <rekado <at> elephly.net>
+;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer <at> 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 lightdm)
+ #:use-module (gnu artwork)
+ #:use-module (gnu packages admin)
+ #:use-module (gnu packages display-managers)
+ #:use-module (gnu packages freedesktop)
+ #:use-module (gnu packages gnome)
+ #:use-module (gnu packages vnc)
+ #:use-module (gnu packages xorg)
+ #:use-module (gnu services configuration)
+ #:use-module (gnu services dbus)
+ #:use-module (gnu services desktop)
+ #:use-module (gnu services shepherd)
+ #:use-module (gnu services xorg)
+ #:use-module (gnu services)
+ #:use-module (gnu system pam)
+ #:use-module (gnu system shadow)
+ #:use-module (guix diagnostics)
+ #:use-module (guix gexp)
+ #:use-module (guix i18n)
+ #:use-module (guix records)
+ #:use-module (ice-9 format)
+ #:use-module (ice-9 match)
+ #:use-module (oop goops)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-26)
+ #:export (lightdm-seat-configuration
+ lightdm-seat-configuration?
+ lightdm-seat-configuration-name
+ lightdm-seat-configuration-type
+ lightdm-seat-configuration-user-session
+ lightdm-seat-configuration-autologin-user
+ lightdm-seat-configuration-greeter-session
+ lightdm-seat-configuration-xserver-command
+ lightdm-seat-configuration-session-wrapper
+ lightdm-seat-configuration-extra-config
+
+ lightdm-gtk-greeter-configuration
+ lightdm-gtk-greeter-configuration?
+ lightdm-gtk-greeter-configuration-lightdm-gtk-greeter
+ lightdm-gtk-greeter-configuration-assets
+ lightdm-gtk-greeter-configuration-theme-name
+ lightdm-gtk-greeter-configuration-icon-theme-name
+ lightdm-gtk-greeter-configuration-cursor-theme-name
+ lightdm-gtk-greeter-configuration-allow-debug
+ lightdm-gtk-greeter-configuration-background
+ lightdm-gtk-greeter-configuration-a11y-states
+ lightdm-gtk-greeter-configuration-reader
+ lightdm-gtk-greeter-configuration-extra-config
+
+ lightdm-configuration
+ lightdm-configuration?
+ lightdm-configuration-lightdm
+ lightdm-configuration-allow-empty-passwords?
+ lightdm-configuration-xorg-configuration
+ lightdm-configuration-greeters
+ lightdm-configuration-seats
+ lightdm-configuration-xdmcp?
+ lightdm-configuration-xdmcp-listen-address
+ lightdm-configuration-vnc-server?
+ lightdm-configuration-vnc-server-command
+ lightdm-configuration-vnc-server-listen-address
+ lightdm-configuration-vnc-server-port
+ lightdm-configuration-extra-config
+
+ lightdm-service-type))
+
+;;;
+;;; Greeters.
+;;;
+
+(define list-of-file-likes?
+ (list-of file-like?))
+
+(define %a11y-states '(contrast font keyboard reader))
+
+(define (a11y-state? value)
+ (memq value %a11y-states))
+
+(define list-of-a11y-states?
+ (list-of a11y-state?))
+
+(define-maybe boolean)
+
+(define (serialize-boolean name value)
+ (define (strip-trailing-? name)
+ ;; field? -> field
+ (let ((str (symbol->string name)))
+ (if (string-suffix? "?" str)
+ (string-drop-right str 1)
+ str)))
+ (format #f "~a=~:[false~;true~]~%" (strip-trailing-? name) value))
+
+(define-maybe file-like)
+
+(define (serialize-file-like name value)
+ #~(format #f "~a=~a~%" '#$name #$value))
+
+(define (serialize-list-of-a11y-states name value)
+ (format #f "~a=~a~%" name (string-join (map symbol->string value) ";")))
+
+(define (serialize-string name value)
+ (format #f "~a=~a~%" name value))
+
+(define (serialize-number name value)
+ (format #f "~a=~a~%" name value))
+
+(define (serialize-list-of-strings _ value)
+ (string-join value "\n"))
+
+(define-configuration lightdm-gtk-greeter-configuration
+ (lightdm-gtk-greeter
+ (file-like lightdm-gtk-greeter)
+ "The lightdm-gtk-greeter package to use."
+ empty-serializer)
+ (assets
+ (list-of-file-likes (list adwaita-icon-theme
+ gnome-themes-extra
+ ;; FIXME: hicolor-icon-theme should be in the
+ ;; packages of the desktop templates.
+ hicolor-icon-theme))
+ "The list of packages complementing the greeter, such as package providing
+icon themes."
+ empty-serializer)
+ (theme-name
+ (string "Adwaita")
+ "The name of the theme to use.")
+ (icon-theme-name
+ (string "Adwaita")
+ "The name of the icon theme to use.")
+ (cursor-theme-name
+ (string "Adwaita")
+ "The name of the cursor theme to use.")
+ (cursor-theme-size
+ (number 16)
+ "The size to use for the the cursor theme.")
+ (allow-debugging?
+ maybe-boolean
+ "Set to #t to enable debug log level.")
+ (background
+ (file-like (file-append %artwork-repository
+ "/backgrounds/guix-checkered-16-9.svg"))
+ "The background image to use.")
+ ;; FIXME: This should be enabled by default, but it currently doesn't work,
+ ;; failing to connect to D-Bus, causing the login to fail.
+ (at-spi-enabled?
+ (boolean #f)
+ "Enable accessibility support through the Assistive Technology Service
+Provider Interface (AT-SPI).")
+ (a11y-states
+ (list-of-a11y-states %a11y-states)
+ "The accessibility features to enable, given as list of symbols.")
+ (reader
+ maybe-file-like
+ "The command to use to launch a screen reader.")
+ (extra-config
+ (list-of-strings '())
+ "Extra configuration values to append to the LightDM GTK Greeter
+configuration file."))
+
+(define (strip-class-name-brackets name)
+ "Remove the '<<' and '>>' brackets from NAME, a symbol."
+ (let ((name* (symbol->string name)))
+ (if (and (string-prefix? "<<" name*)
+ (string-suffix? ">>" name*))
+ (string->symbol (string-drop (string-drop-right name* 2) 2))
+ (error "unexpected class name" name*))))
+
+(define (config->name config)
+ "Return the constructor name (a symbol) from CONFIG."
+ (strip-class-name-brackets (class-name (class-of config))))
+
+(define (greeter-configuration->greeter-fields config)
+ "Return the fields of CONFIG, a greeter configuration."
+ (match config
+ ;; Note: register any new greeter configuration here.
+ ((? lightdm-gtk-greeter-configuration?)
+ lightdm-gtk-greeter-configuration-fields)))
+
+(define (greeter-configuration->packages config)
+ "Return the list of greeter packages, including assets, used by CONFIG, a
+greeter configuration."
+ (match config
+ ;; Note: register any new greeter configuration here.
+ ((? lightdm-gtk-greeter-configuration?)
+ (cons (lightdm-gtk-greeter-configuration-lightdm-gtk-greeter config)
+ (lightdm-gtk-greeter-configuration-assets config)))))
+
+;;; TODO: Implement directly in (gnu services configuration), perhaps by
+;;; making the FIELDS argument optional.
+(define (serialize-configuration* config)
+ "Like `serialize-configuration', but not requiring to provide a FIELDS
+argument."
+ (define fields (greeter-configuration->greeter-fields config))
+ (serialize-configuration config fields))
+
+(define (greeter-configuration->conf-name config)
+ "Return the file name of CONFIG, a greeter configuration."
+ (format #f "~a.conf" (greeter-configuration->greeter-session config)))
+
+(define (greeter-configuration->file config)
+ "Serialize CONFIG into a file under the output directory, so that it can be
+easily added to XDG_CONF_DIRS."
+ (computed-file
+ (greeter-configuration->conf-name config)
+ #~(begin
+ (call-with-output-file #$output
+ (lambda (port)
+ (format port (string-append
+ "[greeter]\n"
+ #$(serialize-configuration* config))))))))
+
+
+;;;
+;;; Seats.
+;;;
+
+(define seat-name? string?)
+
+(define (serialize-seat-name _ value)
+ (format #f "[Seat:~a]~%" value))
+
+(define (seat-type? type)
+ (memq type '(local xremote)))
+
+(define (serialize-seat-type name value)
+ (format #f "~a=~a~%" name value))
+
+(define-maybe seat-type)
+
+(define (greeter-session? value)
+ (memq value '(lightdm-gtk-greeter)))
+
+(define (serialize-greeter-session name value)
+ (format #f "~a=~a~%" name value))
+
+(define-maybe greeter-session)
+
+(define-maybe string)
+
+;;; Note: all the fields except for the seat name should be 'maybe's, since
+;;; the real default value is set by the %lightdm-seat-default define later,
+;;; and this avoids repeating ourselves in the serialized configuration file.
+(define-configuration lightdm-seat-configuration
+ (name
+ seat-name
+ "The name of the seat. An asterisk (*) can be used in the name
+to apply the seat configuration to all the seat names it matches.")
+ (user-session
+ maybe-string
+ "The session to use by default. The session name must be provided as a
+lowercase string, such as @code{\"gnome\"}, @code{\"ratpoison\"}, etc.")
+ (type
+ (seat-type 'local)
+ "The type of the seat, either the @code{local} or @code{xremote} symbol.")
+ (autologin-user
+ maybe-string
+ "The username to automatically log in with by default.")
+ (greeter-session
+ (greeter-session 'lightdm-gtk-greeter)
+ "The greeter session to use, specified as a symbol. Currently, only
+@code{lightdm-gtk-greeter} is supported.")
+ ;; Note: xserver-command must be lazily computed, so that it can be
+ ;; overridden via 'lightdm-configuration-xorg-configuration'.
+ (xserver-command
+ maybe-file-like
+ "The Xorg server command to run.")
+ (session-wrapper
+ (file-like (xinitrc))
+ "The xinitrc session wrapper to use.")
+ (extra-config
+ (list-of-strings '())
+ "Extra configuration values to append to the seat configuration section."))
+
+(define (greeter-session->greater-configuration-pred identifier)
+ "Return the predicate to check if a configuration is of the type specifying
+a greeter identified by IDENTIFIER."
+ (match identifier
+ ;; Note: register any new greeter identifier here.
+ ('lightdm-gtk-greeter
+ lightdm-gtk-greeter-configuration?)))
+
+(define (greeter-configuration->greeter-session config)
+ "Given CONFIG, a greeter configuration object, return its identifier,
+a symbol."
+ (let ((suffix "-configuration")
+ (greeter-conf-name (config->name config)))
+ (string->symbol (string-drop-right (symbol->string greeter-conf-name)
+ (string-length suffix)))))
+
+(define list-of-seat-configurations?
+ (list-of lightdm-seat-configuration?))
+
+
+;;;
+;;; LightDM.
+;;;
+
+(define (greeter-configuration? config)
+ (or (lightdm-gtk-greeter-configuration? config)
+ ;; Note: register any new greeter configuration here.
+ ))
+
+(define (list-of-greeter-configurations? greeter-configs)
+ (and ((list-of greeter-configuration?) greeter-configs)
+ ;; Greeter configurations must also not be provided more than once.
+ (let* ((types (map (cut (compose class-name class-of) <>)
+ greeter-configs))
+ (dupes (filter (lambda (type)
+ (< 1 (count (cut eq? type <>) types)))
+ types)))
+ (unless (null? dupes)
+ (leave (G_ "duplicate greeter configurations: ~a~%") dupes)))))
+
+(define-configuration/no-serialization lightdm-configuration
+ (lightdm
+ (file-like lightdm)
+ "The lightdm package to use.")
+ (allow-empty-passwords?
+ (boolean #f)
+ "Whether users not having a password set can login.")
+ (debug?
+ (boolean #f)
+ "Enable verbose output.")
+ (xorg-configuration
+ (xorg-configuration (xorg-configuration))
+ "The default Xorg server configuration to use to generate the Xorg server
+start script. It can be refined per seat via the @code{xserver-command} of
+the @code{<lightdm-seat-configuration>} record, if desired.")
+ (greeters
+ (list-of-greeter-configurations (list (lightdm-gtk-greeter-configuration)))
+ "The LightDM greeter configurations specifying the greeters to use.")
+ (seats
+ (list-of-seat-configurations (list (lightdm-seat-configuration
+ (name "*"))))
+ "The seat configurations to use. A LightDM seat is akin to a user.")
+ (xdmcp?
+ (boolean #f)
+ "Whether a XDMCP server should listen on port UDP 177.")
+ (xdmcp-listen-address
+ maybe-string
+ "The host or IP address the XDMCP server listens for incoming connections.
+When unspecified, listen on for any hosts/IP addresses.")
+ (vnc-server?
+ (boolean #f)
+ "Whether a VNC server is started.")
+ (vnc-server-command
+ (file-like (file-append tigervnc-server "bin/Xvnc"))
+ "The Xvnc command to use for the VNC server, it's possible to provide extra
+options not otherwise exposed along the command, for example to disable
+security:
+@lisp
+(vnc-server-command
+ (file-append tigervnc-server \"/bin/Xvnc\"
+ \" -SecurityTypes None\" ))
+@end lisp
+
+Or to set a PasswordFile for the classic (unsecure) VncAuth mecanism:
+@lisp
+(vnc-server-command
+ (file-append tigervnc-server \"/bin/Xvnc\"
+ \" -PasswordFile /var/lib/lightdm/.vnc/passwd\"))
+@end lisp
+The password file should be manually created using the @command{vncpasswd}
+command.
+
+Note that LightDM will create new sessions for VNC users, which means they
+need to authenticate in the same way as local users would.
+")
+ (vnc-server-listen-address
+ maybe-string
+ "The host or IP address the VNC server listens for incoming connections.
+When unspecified, listen for any hosts/IP addresses.")
+ (vnc-server-port
+ (number 5900)
+ "The TCP port the VNC server should listen to.")
+ (extra-config
+ (list-of-strings '())
+ "Extra configuration values to append to the LightDM configuration file."))
+
+(define (lightdm-configuration->greeters-config-dir config)
+ "Return a directory containing all the serialized greeter configurations
+from CONFIG, a <lightdm-configuration> object."
+ (file-union "etc-lightdm"
+ (append-map (lambda (g)
+ `((,(greeter-configuration->conf-name g)
+ ,(greeter-configuration->file g))))
+ (lightdm-configuration-greeters config))))
+
+(define (lightdm-configuration->packages config)
+ "Return all the greeter packages and their assets defined in CONFIG, a
+<lightdm-configuration> object, as well as the lightdm package itself."
+ (cons (lightdm-configuration-lightdm config)
+ (append-map greeter-configuration->packages
+ (lightdm-configuration-greeters config))))
+
+(define (validate-lightdm-configuration config)
+ "Sanity check CONFIG, a <lightdm-configuration> record instance."
+ ;; This is required to make inter-field validations, such as between the
+ ;; seats and greeters.
+ (let* ((seats (lightdm-configuration-seats config))
+ (greeter-sessions (delete-duplicates
+ (map lightdm-seat-configuration-greeter-session
+ seats)
+ eq?))
+ (greeter-configurations (lightdm-configuration-greeters config))
+ (missing-greeters
+ (filter-map
+ (lambda (id)
+ (define pred (greeter-session->greater-configuration-pred id))
+ (if (find pred greeter-configurations)
+ #f ;happy path
+ id))
+ greeter-sessions)))
+ (unless (null? missing-greeters)
+ (leave (G_ "no greeter configured for seat greeter sessions: ~a~%")
+ missing-greeters))))
+
+(define (lightdm-configuration-file config)
+ (match-record config <lightdm-configuration>
+ (xorg-configuration seats
+ xdmcp? xdmcp-listen-address
+ vnc-server? vnc-server-command vnc-server-listen-address vnc-server-port
+ extra-config)
+ (apply
+ mixed-text-file
+ "lightdm.conf" "
+#
+# General configuration
+#
+[LightDM]
+greeter-user=lightdm
+sessions-directory=/run/current-system/profile/share/xsessions\
+:/run/current-system/profile/share/wayland-sessions
+remote-sessions-directory=/run/current-system/profile/share/remote-sessions
+"
+ #~(string-join '#$extra-config "\n")
+ "
+#
+# XDMCP Server configuration
+#
+[XDMCPServer]
+enabled=" (if xdmcp? "true" "false") "\n"
+(if (maybe-value-set? xdmcp-listen-address)
+ (format #f "xdmcp-listen-address=~a" xdmcp-listen-address)
+ "") "
+
+#
+# VNC Server configuration
+#
+[VNCServer]
+enabled=" (if vnc-server? "true" "false") "
+command=" vnc-server-command "
+port=" (number->string vnc-server-port) "\n"
+(if (maybe-value-set? vnc-server-listen-address)
+ (format #f "vnc-server-listen-address=~a" vnc-server-listen-address)
+ "") "
+
+#
+# Seat configuration.
+#
+"
+ (map (lambda (seat)
+ ;; This complication exists to propagate a default value for
+ ;; the 'xserver-command' field of the seats. Having a
+ ;; 'xorg-configuration' field at the root of the
+ ;; lightdm-configuration enables the use of
+ ;; 'set-xorg-configuration' and can be more convenient.
+ (let ((seat* (if (maybe-value-set?
+ (lightdm-seat-configuration-xserver-command seat))
+ seat
+ (lightdm-seat-configuration
+ (inherit seat)
+ (xserver-command (xorg-start-command
+ xorg-configuration))))))
+ (serialize-configuration seat*
+ lightdm-seat-configuration-fields)))
+ seats))))
+
+(define %lightdm-accounts
+ (list (user-group (name "lightdm") (system? #t))
+ (user-account
+ (name "lightdm")
+ (group "lightdm")
+ (system? #t)
+ (comment "LightDM user")
+ (home-directory "/var/lib/lightdm")
+ (shell (file-append shadow "/sbin/nologin")))))
+
+(define %lightdm-activation
+ ;; Ensure /var/lib/lightdm is owned by the "lightdm" user. Adapted from the
+ ;; %gdm-activation.
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (use-modules (guix build utils))
+
+ (define (ensure-ownership directory)
+ (let* ((lightdm (getpwnam "lightdm"))
+ (uid (passwd:uid lightdm))
+ (gid (passwd:gid lightdm))
+ (st (stat directory #f)))
+ ;; Recurse into directory only if it has wrong ownership.
+ (when (and st
+ (or (not (= uid (stat:uid st)))
+ (not (= gid (stat:gid st)))))
+ (for-each (lambda (file)
+ (chown file uid gid))
+ (find-files "directory"
+ #:directories? #t)))))
+
+ (when (not (stat "/var/lib/lightdm-data" #f))
+ (mkdir-p "/var/lib/lightdm-data"))
+ (for-each ensure-ownership
+ '("/var/lib/lightdm"
+ "/var/lib/lightdm-data")))))
+
+(define (lightdm-pam-service config)
+ "Return a PAM service for @command{lightdm}."
+ (unix-pam-service "lightdm"
+ #:login-uid? #t
+ #:allow-empty-passwords?
+ (lightdm-configuration-allow-empty-passwords? config)))
+
+(define (lightdm-greeter-pam-service)
+ "Return a PAM service for @command{lightdm-greeter}."
+ (pam-service
+ (name "lightdm-greeter")
+ (auth (list
+ ;; Load environment from /etc/environment and ~/.pam_environment.
+ (pam-entry (control "required") (module "pam_env.so"))
+ ;; Always let the greeter start without authentication.
+ (pam-entry (control "required") (module "pam_permit.so"))))
+ ;; No action required for account management
+ (account (list (pam-entry (control "required") (module "pam_permit.so"))))
+ ;; Prohibit changing password.
+ (password (list (pam-entry (control "required") (module "pam_deny.so"))))
+ ;; Setup session.
+ (session (list (pam-entry (control "required") (module "pam_unix.so"))))))
+
+(define (lightdm-autologin-pam-service)
+ "Return a PAM service for @command{lightdm-autologin}}."
+ (pam-service
+ (name "lightdm-autologin")
+ (auth
+ (list
+ ;; Block login if user is globally disabled.
+ (pam-entry (control "required") (module "pam_nologin.so"))
+ (pam-entry (control "required") (module "pam_succeed_if.so")
+ (arguments (list "uid >= 1000")))
+ ;; Allow access without authentication.
+ (pam-entry (control "required") (module "pam_permit.so"))))
+ ;; Stop autologin if account requires action.
+ (account (list (pam-entry (control "required") (module "pam_unix.so"))))
+ ;; Prohibit changing password.
+ (password (list (pam-entry (control "required") (module "pam_deny.so"))))
+ ;; Setup session.
+ (session (list (pam-entry (control "required") (module "pam_unix.so"))))))
+
+(define (lightdm-pam-services config)
+ (list (lightdm-pam-service config)
+ (lightdm-greeter-pam-service)
+ (lightdm-autologin-pam-service)))
+
+(define (lightdm-shepherd-service config)
+ "Return a <lightdm-service> for LightDM using CONFIG."
+
+ (validate-lightdm-configuration config)
+
+ (define lightdm-command
+ #~(list #$(file-append (lightdm-configuration-lightdm config)
+ "/sbin/lightdm")
+ #$@(if (lightdm-configuration-debug? config)
+ #~("--debug")
+ #~())
+ "--config"
+ #$(lightdm-configuration-file config)))
+
+ (define lightdm-paths
+ (let ((lightdm (lightdm-configuration-lightdm config)))
+ #~(string-join
+ '#$(map (lambda (dir)
+ (file-append lightdm dir))
+ '("/bin" "/sbin" "/libexec"))
+ ":")))
+
+ (define greeters-config-dir
+ (lightdm-configuration->greeters-config-dir config))
+
+ (define data-dirs
+ ;; LightDM itself needs to be in XDG_DATA_DIRS for the accountsservice
+ ;; interface it provides to be picked up. The greeters must also be in
+ ;; XDG_DATA_DIRS to be found.
+ (let ((packages (lightdm-configuration->packages config)))
+ #~(string-join '#$(map (cut file-append <> "/share") packages)
+ ":")))
+
+ (list
+ (shepherd-service
+ (documentation "LightDM display manager")
+ (requirement '(dbus-system user-processes host-name))
+ (provision '(lightdm display-manager xorg-server))
+ (respawn? #f)
+ (start
+ #~(lambda ()
+ ;; Note: sadly, environment variables defined for 'lightdm' are
+ ;; cleared and/or overridden by /etc/profile by its spawned greeters,
+ ;; so an out-of-band means such as /etc is required.
+ (fork+exec-command #$lightdm-command
+ ;; Lightdm needs itself in its PATH.
+ #:environment-variables
+ (list
+ ;; It knows to look for greeter configurations in
+ ;; XDG_CONFIG_DIRS...
+ (string-append "XDG_CONFIG_DIRS="
+ #$greeters-config-dir)
+ ;; ... and for greeter .desktop files as well as
+ ;; lightdm accountsservice interface in
+ ;; XDG_DATA_DIRS.
+ (string-append "XDG_DATA_DIRS="
+ #$data-dirs)
+ (string-append "PATH=" #$lightdm-paths)))))
+ (stop #~(make-kill-destructor)))))
+
+(define lightdm-service-type
+ (handle-xorg-configuration
+ lightdm-configuration
+ (service-type
+ (name 'lightdm)
+ (default-value (lightdm-configuration))
+ (extensions
+ (list (service-extension pam-root-service-type lightdm-pam-services)
+ (service-extension shepherd-root-service-type
+ lightdm-shepherd-service)
+ (service-extension activation-service-type
+ (const %lightdm-activation))
+ (service-extension dbus-root-service-type
+ (compose list lightdm-configuration-lightdm))
+ (service-extension polkit-service-type
+ (compose list lightdm-configuration-lightdm))
+ (service-extension account-service-type
+ (const %lightdm-accounts))
+ ;; Add 'lightdm' to the system profile, so that its
+ ;; 'share/accountsservice' D-Bus service extension directory can be
+ ;; found via the 'XDG_DATA_DIRS=/run/current-system/profile/share'
+ ;; environment variable set in the wrapper of the
+ ;; libexec/accounts-daemon binary of the accountsservice package.
+ ;; This daemon is spawned by D-Bus, and there's little we can do to
+ ;; affect its environment. For more reading, see:
+ ;; https://github.com/NixOS/nixpkgs/issues/45059.
+ (service-extension profile-service-type
+ lightdm-configuration->packages)
+ ;; This is needed for the greeter itself to find its configuration,
+ ;; because XDG_CONF_DIRS gets overridden by /etc/profile.
+ (service-extension
+ etc-service-type
+ (lambda (config)
+ `(("lightdm"
+ ,(lightdm-configuration->greeters-config-dir config)))))))
+ (description "Run @code{lightdm}, the LightDM graphical login manager."))))
+
+
+;;;
+;;; Generate documentation.
+;;;
+(define (generate-doc)
+ (configuration->documentation 'lightdm-configuration)
+ (configuration->documentation 'lightdm-gtk-greeter-configuration)
+ (configuration->documentation 'lightdm-seat-configuration))
diff --git a/gnu/tests/lightdm.scm b/gnu/tests/lightdm.scm
new file mode 100644
index 0000000000..c9f3101d8c
--- /dev/null
+++ b/gnu/tests/lightdm.scm
@@ -0,0 +1,161 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer <at> 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 lightdm)
+ #:use-module (gnu bootloader)
+ #:use-module (gnu bootloader grub)
+ #:use-module (gnu packages)
+ #:use-module (gnu packages ocr)
+ #:use-module (gnu packages ratpoison)
+ #:use-module (gnu packages vnc)
+ #:use-module (gnu packages xorg)
+ #:use-module (gnu services)
+ #:use-module (gnu services base)
+ #:use-module (gnu services dbus)
+ #:use-module (gnu services desktop)
+ #:use-module (gnu services networking)
+ #:use-module (gnu services lightdm)
+ #:use-module (gnu services ssh)
+ #: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)
+ #:use-module (srfi srfi-1)
+ #:export (%test-lightdm))
+
+
+(define minimal-desktop-services
+ (list polkit-wheel-service
+ (service upower-service-type)
+ (accountsservice-service)
+ (service polkit-service-type)
+ (elogind-service)
+ (dbus-service)
+ x11-socket-directory-service))
+
+(define %lightdm-os
+ (operating-system
+ (inherit %simple-os)
+ (packages (cons* ocrad ratpoison xterm %base-packages))
+ (services
+ (cons* (service lightdm-service-type
+ (lightdm-configuration
+ (allow-empty-passwords? #t)
+ (debug? #t)
+ (xdmcp? #t)
+ (vnc-server? #t)
+ (vnc-server-command
+ (file-append tigervnc-server "/bin/Xvnc"
+ " -SecurityTypes None"))
+ (greeters (list (lightdm-gtk-greeter-configuration
+ (allow-debugging? #t))))
+ (seats (list (lightdm-seat-configuration
+ (name "*")
+ (user-session "ratpoison"))))))
+
+ ;; For debugging.
+ (service dhcp-client-service-type)
+ (service openssh-service-type
+ (openssh-configuration
+ (permit-root-login #t)
+ (allow-empty-passwords? #t)))
+ (append minimal-desktop-services
+ (remove (lambda (service)
+ (eq? (service-kind service) guix-service-type))
+ %base-services))))))
+
+(define (run-lightdm-test)
+ "Run tests in %LIGHTDM-OS."
+
+ (define os (marionette-operating-system
+ %lightdm-os
+ #:imported-modules (source-module-closure
+ '((gnu services herd)))))
+
+ (define vm (virtual-machine os))
+
+ (define test
+ (with-imported-modules (source-module-closure
+ '((gnu build marionette)))
+ #~(begin
+ (use-modules (gnu build marionette)
+ (srfi srfi-26)
+ (srfi srfi-64))
+
+ (let ((marionette (make-marionette (list #$vm))))
+
+ (test-runner-current (system-test-runner #$output))
+ (test-begin "lightdm")
+
+ (test-assert "service is running"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (start-service 'lightdm))
+ marionette))
+
+ (test-assert "service can be stopped"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (stop-service 'lightdm))
+ marionette))
+
+ (test-assert "service can be restarted"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (restart-service 'lightdm))
+ marionette))
+
+ (test-assert "login screen is displayed"
+ ;; GNU Ocrad fails to recognize the "Log In" button text, so use
+ ;; Tesseract.
+ (wait-for-screen-text marionette
+ (cut string-contains <> "Log In")
+ #:ocr #$(file-append tesseract-ocr
+ "/bin/tesseract")))
+
+ (test-assert "can connect to TCP port 5900 on IPv4"
+ (wait-for-tcp-port 5900 marionette))
+
+ ;; The VNC server fails to listen to IPv6 due to "Error binding to
+ ;; address [::]:5900: Address already in use" (see:
+ ;; https://github.com/canonical/lightdm/issues/266).
+ (test-expect-fail 1)
+ (test-assert "can connect to TCP port 5900 on IPv6"
+ (wait-for-tcp-port 5900 marionette
+ #:address
+ `(make-socket-address
+ AF_INET6
+ (inet-pton AF_INET6 "::1")
+ 5900)))
+
+ (test-end)))))
+
+ (gexp->derivation "lightdm-test" test))
+
+(define %test-lightdm
+ (system-test
+ (name "lightdm")
+ (description "Basic tests for the LightDM service.")
+ (value (run-lightdm-test))))
diff --git a/tests/services/lightdm.scm b/tests/services/lightdm.scm
new file mode 100644
index 0000000000..283df2befc
--- /dev/null
+++ b/tests/services/lightdm.scm
@@ -0,0 +1,52 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer <at> 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 (tests services lightdm)
+ #:use-module (guix diagnostics)
+ #:use-module (gnu services lightdm)
+ #:use-module (srfi srfi-64))
+
+;;; Tests for the (gnu services lightdm) module.
+
+;;; Access some internals for whitebox testing.
+(define validate-lightdm-configuration (@@ (gnu services lightdm)
+ validate-lightdm-configuration))
+
+(test-begin "lightdm-service")
+
+(test-equal "error on missing greeter"
+ 'ok
+ (catch 'quit
+ (lambda ()
+ (validate-lightdm-configuration (lightdm-configuration (greeters '()))))
+ (lambda _
+ 'ok)))
+
+(test-equal "error when a greeter has multiple configurations"
+ 'ok
+ (catch 'quit
+ (lambda ()
+ (lightdm-configuration
+ (greeters (list (lightdm-gtk-greeter-configuration
+ (theme-name "boring"))
+ (lightdm-gtk-greeter-configuration
+ (theme-name "blue"))))))
+ (lambda _
+ 'ok)))
+
+(test-end "lightdm-service")
--
2.36.1
guix-patches <at> gnu.org:bug#57168; Package guix-patches.
(Sat, 13 Aug 2022 06:56:05 GMT) Full text and rfc822 format available.Message #47 received at 57168 <at> debbugs.gnu.org (full text, mbox):
From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> To: 57168 <at> debbugs.gnu.org Cc: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> Subject: [PATCH 04/14] gnu: lightdm-gtk-greeter: Add GDK_PIXBUF_MODULE_FILE to wrapper. Date: Sat, 13 Aug 2022 02:54:23 -0400
* gnu/packages/display-managers.scm (lightdm-gtk-greeter)
[build-system]: Use glib-or-gtk-build-system.
[phases]{wrap-program}: Add GDK_PIXBUF_MODULE_FILE to wrapper.
[inputs]: Add librsvg.
---
gnu/packages/display-managers.scm | 22 ++++++++++++++++------
1 file changed, 16 insertions(+), 6 deletions(-)
diff --git a/gnu/packages/display-managers.scm b/gnu/packages/display-managers.scm
index 6c1c5b6c25..53002f2122 100644
--- a/gnu/packages/display-managers.scm
+++ b/gnu/packages/display-managers.scm
@@ -37,6 +37,7 @@ (define-module (gnu packages display-managers)
#:use-module (guix build-system cmake)
#:use-module (guix build-system qt)
#:use-module (guix build-system gnu)
+ #:use-module (guix build-system glib-or-gtk)
#:use-module (guix build-system trivial)
#:use-module (guix packages)
#:use-module (guix utils)
@@ -347,7 +348,7 @@ (define-public lightdm-gtk-greeter
(sha256
(base32
"04q62mvr97l9gv8h37hfarygqc7p0498ig7xclcg4kxkqw0b7yxy"))))
- (build-system gnu-build-system)
+ (build-system glib-or-gtk-build-system)
(arguments
(list
#:configure-flags
@@ -376,6 +377,14 @@ (define-public lightdm-gtk-greeter
(glib #$(this-package-input "glib")))
(wrap-program (search-input-file
outputs "sbin/lightdm-gtk-greeter")
+ ;; Wrap GDK_PIXBUF_MODULE_FILE, so that the SVG loader is
+ ;; available at all times even outside of profiles, such as
+ ;; when used in the lightdm-service-type. Otherwise, it
+ ;; wouldn't be able to display its own icons.
+ `("GDK_PIXBUF_MODULE_FILE" =
+ (,(search-input-file
+ inputs
+ "lib/gdk-pixbuf-2.0/2.10.0/loaders.cache")))
`("XDG_DATA_DIRS" ":" prefix
,(cons "/run/current-system/profile/share"
(map (lambda (pkg)
@@ -388,12 +397,13 @@ (define-public lightdm-gtk-greeter
(native-inputs
(list exo intltool pkg-config xfce4-dev-tools))
(inputs
- (list bash-minimal ;for wrap-program
+ (list at-spi2-core
+ bash-minimal ;for wrap-program
+ gtk+
+ guile-3.0
+ librsvg
lightdm
- shared-mime-info
- at-spi2-core
- glib
- gtk+))
+ shared-mime-info))
(synopsis "GTK+ greeter for LightDM")
(home-page "https://github.com/xubuntu/lightdm-gtk-greeter")
(description "This package provides a LightDM greeter implementation using
--
2.36.1
guix-patches <at> gnu.org:bug#57168; Package guix-patches.
(Fri, 26 Aug 2022 16:55:03 GMT) Full text and rfc822 format available.Message #50 received at 57168 <at> debbugs.gnu.org (full text, mbox):
From: Maxime Devos <maximedevos <at> telenet.be> To: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>, 57168 <at> debbugs.gnu.org Cc: Ricardo Wurmus <rekado <at> elephly.net>, L p R n d n <guix <at> lprndn.info> Subject: Re: [bug#57168] [PATCH 14/14] services: Add lightdm-service-type. Date: Fri, 26 Aug 2022 18:54:54 +0200
[Message part 1 (text/plain, inline)]
For the SDDM login manager, there is the problem that ~/.profile is not loaded and hence that the various search paths environment variables ($PATH, $INFOPATH, ...) are not set to ~/.guix-profile/bin/...: <https://issues.guix.gnu.org/56661>. Is this the case for lightdm? If so, maybe something similar as done for GDM could be done here: <https://issues.guix.gnu.org/56661#8>. Could be tested with a nice system test ... Greetings, Maxime.
[OpenPGP_0x49E3EE22191725EE.asc (application/pgp-keys, attachment)]
[OpenPGP_signature (application/pgp-signature, attachment)]
Maxim Cournoyer <maxim.cournoyer <at> gmail.com>:Maxim Cournoyer <maxim.cournoyer <at> gmail.com>:Message #55 received at 57168-done <at> debbugs.gnu.org (full text, mbox):
From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> To: Maxime Devos <maximedevos <at> telenet.be> Cc: 57168-done <at> debbugs.gnu.org, Ricardo Wurmus <rekado <at> elephly.net>, L p R n d n <guix <at> lprndn.info> Subject: Re: bug#57168: [PATCH 00/14] Add a LightDM service. Date: Sun, 28 Aug 2022 22:33:19 -0400
Hi Maxime, Maxime Devos <maximedevos <at> telenet.be> writes: > For the SDDM login manager, there is the problem that ~/.profile is > not loaded and hence that the various search paths environment > variables ($PATH, $INFOPATH, ...) are not set to > ~/.guix-profile/bin/...: <https://issues.guix.gnu.org/56661>. > > Is this the case for lightdm? If so, maybe something similar as done > for GDM could be done here: <https://issues.guix.gnu.org/56661#8>. I just tried using: --8<---------------cut here---------------start------------->8--- $(./pre-inst-env guix system vm -e '(@@ (gnu tests lightdm) %lightdm-os)') -m 1G -smp cores=4 --8<---------------cut here---------------end--------------->8--- And this is what I saw, logging in as 'root' graphically, starting xterm and issuing: --8<---------------cut here---------------start------------->8--- root <at> komputilo ~# echo $PATH /run/setuid-programs:/root/.config/guix/current/bin:/root/.guix-profile/bin:/run/current-system/profile/bin:/run/current-system/profile/sbin --8<---------------cut here---------------end--------------->8--- Seems to be alright. > Could be tested with a nice system test ... What would the system test look like? 1. Login using the login manager (difficult unless using autologin -- I've tried). 2. Open a terminal, run 'echo $PATH' and run the OCR on it? That doesn't sound too great. I've pushed the series for now, feel free to experiment with it! Thanks, Maxim
guix-patches <at> gnu.org:bug#57168; Package guix-patches.
(Tue, 30 Aug 2022 19:45:02 GMT) Full text and rfc822 format available.Message #58 received at 57168-done <at> debbugs.gnu.org (full text, mbox):
From: Maxime Devos <maximedevos <at> telenet.be> To: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> Cc: 57168-done <at> debbugs.gnu.org, Ricardo Wurmus <rekado <at> elephly.net>, L p R n d n <guix <at> lprndn.info> Subject: Re: bug#57168: [PATCH 00/14] Add a LightDM service. Date: Tue, 30 Aug 2022 21:44:22 +0200
[Message part 1 (text/plain, inline)]
> And this is what I saw, logging in as 'root' graphically, starting xterm > and issuing: > > --8<---------------cut here---------------start------------->8--- > root <at> komputilo ~# echo $PATH > /run/setuid-programs:/root/.config/guix/current/bin:/root/.guix-profile/bin:/run/current-system/profile/bin:/run/current-system/profile/sbin > --8<---------------cut here---------------end--------------->8--- > > Seems to be alright. Looks good. On 29-08-2022 04:33, Maxim Cournoyer wrote: >> Could be tested with a nice system test ... > What would the system test look like? > > 1. Login using the login manager (difficult unless using autologin -- > I've tried). > > 2. Open a terminal, run 'echo $PATH' and run the OCR on it? That > doesn't sound too great. > > I've pushed the series for now, feel free to experiment with it! I thought there would have already been some similar system test for another login manager, but apparently this is not the case, nevermind. Greetings, Maxime.
[Message part 2 (text/html, inline)]
[OpenPGP_0x49E3EE22191725EE.asc (application/pgp-keys, attachment)]
[OpenPGP_signature (application/pgp-signature, attachment)]
Debbugs Internal Request <help-debbugs <at> gnu.org>
to internal_control <at> debbugs.gnu.org.
(Wed, 28 Sep 2022 11:24:07 GMT) Full text and rfc822 format available.
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.