unofficial mirror of guix-patches@gnu.org 
 help / color / mirror / code / Atom feed
* [bug#57168] [PATCH 00/14] Add a LightDM service.
@ 2022-08-13  6:50 Maxim Cournoyer
  2022-08-13  6:54 ` [bug#57168] [PATCH 01/14] services: configuration: Add a 'maybe-value-set?' procedure Maxim Cournoyer
  0 siblings, 1 reply; 18+ messages in thread
From: Maxim Cournoyer @ 2022-08-13  6:50 UTC (permalink / raw)
  To: 57168; +Cc: Maxim Cournoyer

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





^ permalink raw reply	[flat|nested] 18+ messages in thread

* [bug#57168] [PATCH 01/14] services: configuration: Add a 'maybe-value-set?' procedure.
  2022-08-13  6:50 [bug#57168] [PATCH 00/14] Add a LightDM service Maxim Cournoyer
@ 2022-08-13  6:54 ` Maxim Cournoyer
  2022-08-13  6:54   ` [bug#57168] [PATCH 02/14] gnu: accountsservice: Update to 22.08.8, enable doc and test suite Maxim Cournoyer
                     ` (12 more replies)
  0 siblings, 13 replies; 18+ messages in thread
From: Maxim Cournoyer @ 2022-08-13  6:54 UTC (permalink / raw)
  To: 57168; +Cc: Maxim Cournoyer

* 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





^ permalink raw reply related	[flat|nested] 18+ messages in thread

* [bug#57168] [PATCH 02/14] gnu: accountsservice: Update to 22.08.8, enable doc and test suite.
  2022-08-13  6:54 ` [bug#57168] [PATCH 01/14] services: configuration: Add a 'maybe-value-set?' procedure Maxim Cournoyer
@ 2022-08-13  6:54   ` Maxim Cournoyer
  2022-08-13  6:54   ` [bug#57168] [PATCH 03/14] gnu: accountsservice: Provide a means to locate extensions Maxim Cournoyer
                     ` (11 subsequent siblings)
  12 siblings, 0 replies; 18+ messages in thread
From: Maxim Cournoyer @ 2022-08-13  6:54 UTC (permalink / raw)
  To: 57168; +Cc: Maxim Cournoyer

* 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@robbyzambito.me>
 ;;; Copyright © 2021, 2022 Maxime Devos <maximedevos@telenet.be>
 ;;; Copyright © 2021 John Kehayias <john.kehayias@protonmail.com>
-;;; Copyright © 2021, 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2021, 2021, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2022 Daniel Meißner <daniel.meissner-i4k@ruhr-uni-bochum.de>
 ;;; Copyright © 2022 muradm <mail@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





^ permalink raw reply related	[flat|nested] 18+ messages in thread

* [bug#57168] [PATCH 03/14] gnu: accountsservice: Provide a means to locate extensions.
  2022-08-13  6:54 ` [bug#57168] [PATCH 01/14] services: configuration: Add a 'maybe-value-set?' procedure Maxim Cournoyer
  2022-08-13  6:54   ` [bug#57168] [PATCH 02/14] gnu: accountsservice: Update to 22.08.8, enable doc and test suite Maxim Cournoyer
@ 2022-08-13  6:54   ` Maxim Cournoyer
  2022-08-13  6:54   ` [bug#57168] [PATCH 04/14] gnu: lightdm-gtk-greeter: Add GDK_PIXBUF_MODULE_FILE to wrapper Maxim Cournoyer
                     ` (10 subsequent siblings)
  12 siblings, 0 replies; 18+ messages in thread
From: Maxim Cournoyer @ 2022-08-13  6:54 UTC (permalink / raw)
  To: 57168; +Cc: Maxim Cournoyer

* 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





^ permalink raw reply related	[flat|nested] 18+ messages in thread

* [bug#57168] [PATCH 04/14] gnu: lightdm-gtk-greeter: Add GDK_PIXBUF_MODULE_FILE to wrapper.
  2022-08-13  6:54 ` [bug#57168] [PATCH 01/14] services: configuration: Add a 'maybe-value-set?' procedure Maxim Cournoyer
  2022-08-13  6:54   ` [bug#57168] [PATCH 02/14] gnu: accountsservice: Update to 22.08.8, enable doc and test suite Maxim Cournoyer
  2022-08-13  6:54   ` [bug#57168] [PATCH 03/14] gnu: accountsservice: Provide a means to locate extensions Maxim Cournoyer
@ 2022-08-13  6:54   ` Maxim Cournoyer
  2022-08-13  6:54   ` [bug#57168] [PATCH 05/14] gnu: lightdm-gtk-greeter: Use the glib-or-gtk-wrap phase as-is Maxim Cournoyer
                     ` (9 subsequent siblings)
  12 siblings, 0 replies; 18+ messages in thread
From: Maxim Cournoyer @ 2022-08-13  6:54 UTC (permalink / raw)
  To: 57168; +Cc: Maxim Cournoyer

* 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





^ permalink raw reply related	[flat|nested] 18+ messages in thread

* [bug#57168] [PATCH 05/14] gnu: lightdm-gtk-greeter: Use the glib-or-gtk-wrap phase as-is.
  2022-08-13  6:54 ` [bug#57168] [PATCH 01/14] services: configuration: Add a 'maybe-value-set?' procedure Maxim Cournoyer
                     ` (2 preceding siblings ...)
  2022-08-13  6:54   ` [bug#57168] [PATCH 04/14] gnu: lightdm-gtk-greeter: Add GDK_PIXBUF_MODULE_FILE to wrapper Maxim Cournoyer
@ 2022-08-13  6:54   ` Maxim Cournoyer
  2022-08-13  6:54   ` [bug#57168] [PATCH 06/14] gnu: lightdm-gtk-greeter: Enable libklavier support Maxim Cournoyer
                     ` (8 subsequent siblings)
  12 siblings, 0 replies; 18+ messages in thread
From: Maxim Cournoyer @ 2022-08-13  6:54 UTC (permalink / raw)
  To: 57168; +Cc: Maxim Cournoyer

* 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





^ permalink raw reply related	[flat|nested] 18+ messages in thread

* [bug#57168] [PATCH 06/14] gnu: lightdm-gtk-greeter: Enable libklavier support.
  2022-08-13  6:54 ` [bug#57168] [PATCH 01/14] services: configuration: Add a 'maybe-value-set?' procedure Maxim Cournoyer
                     ` (3 preceding siblings ...)
  2022-08-13  6:54   ` [bug#57168] [PATCH 05/14] gnu: lightdm-gtk-greeter: Use the glib-or-gtk-wrap phase as-is Maxim Cournoyer
@ 2022-08-13  6:54   ` Maxim Cournoyer
  2022-08-13  6:54   ` [bug#57168] [PATCH 07/14] gnu: lightdm-gtk-greeter: Adjust default config file path Maxim Cournoyer
                     ` (7 subsequent siblings)
  12 siblings, 0 replies; 18+ messages in thread
From: Maxim Cournoyer @ 2022-08-13  6:54 UTC (permalink / raw)
  To: 57168; +Cc: Maxim Cournoyer

* 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





^ permalink raw reply related	[flat|nested] 18+ messages in thread

* [bug#57168] [PATCH 07/14] gnu: lightdm-gtk-greeter: Adjust default config file path.
  2022-08-13  6:54 ` [bug#57168] [PATCH 01/14] services: configuration: Add a 'maybe-value-set?' procedure Maxim Cournoyer
                     ` (4 preceding siblings ...)
  2022-08-13  6:54   ` [bug#57168] [PATCH 06/14] gnu: lightdm-gtk-greeter: Enable libklavier support Maxim Cournoyer
@ 2022-08-13  6:54   ` Maxim Cournoyer
  2022-08-13  6:54   ` [bug#57168] [PATCH 08/14] gnu: lightdm-gtk-greeter: Adjust --enable-at-spi-command value Maxim Cournoyer
                     ` (6 subsequent siblings)
  12 siblings, 0 replies; 18+ messages in thread
From: Maxim Cournoyer @ 2022-08-13  6:54 UTC (permalink / raw)
  To: 57168; +Cc: Maxim Cournoyer

* 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





^ permalink raw reply related	[flat|nested] 18+ messages in thread

* [bug#57168] [PATCH 08/14] gnu: lightdm-gtk-greeter: Adjust --enable-at-spi-command value.
  2022-08-13  6:54 ` [bug#57168] [PATCH 01/14] services: configuration: Add a 'maybe-value-set?' procedure Maxim Cournoyer
                     ` (5 preceding siblings ...)
  2022-08-13  6:54   ` [bug#57168] [PATCH 07/14] gnu: lightdm-gtk-greeter: Adjust default config file path Maxim Cournoyer
@ 2022-08-13  6:54   ` Maxim Cournoyer
  2022-08-13  6:54   ` [bug#57168] [PATCH 09/14] gnu: lightdm: Apply patch to fix a problem with VNC integration Maxim Cournoyer
                     ` (5 subsequent siblings)
  12 siblings, 0 replies; 18+ messages in thread
From: Maxim Cournoyer @ 2022-08-13  6:54 UTC (permalink / raw)
  To: 57168; +Cc: Maxim Cournoyer

* 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





^ permalink raw reply related	[flat|nested] 18+ messages in thread

* [bug#57168] [PATCH 09/14] gnu: lightdm: Apply patch to fix a problem with VNC integration.
  2022-08-13  6:54 ` [bug#57168] [PATCH 01/14] services: configuration: Add a 'maybe-value-set?' procedure Maxim Cournoyer
                     ` (6 preceding siblings ...)
  2022-08-13  6:54   ` [bug#57168] [PATCH 08/14] gnu: lightdm-gtk-greeter: Adjust --enable-at-spi-command value Maxim Cournoyer
@ 2022-08-13  6:54   ` Maxim Cournoyer
  2022-08-13  6:54   ` [bug#57168] [PATCH 10/14] gnu: lightdm: Apply patch to allow using VNC options Maxim Cournoyer
                     ` (4 subsequent siblings)
  12 siblings, 0 replies; 18+ messages in thread
From: Maxim Cournoyer @ 2022-08-13  6:54 UTC (permalink / raw)
  To: 57168; +Cc: Maxim Cournoyer

* 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





^ permalink raw reply related	[flat|nested] 18+ messages in thread

* [bug#57168] [PATCH 10/14] gnu: lightdm: Apply patch to allow using VNC options.
  2022-08-13  6:54 ` [bug#57168] [PATCH 01/14] services: configuration: Add a 'maybe-value-set?' procedure Maxim Cournoyer
                     ` (7 preceding siblings ...)
  2022-08-13  6:54   ` [bug#57168] [PATCH 09/14] gnu: lightdm: Apply patch to fix a problem with VNC integration Maxim Cournoyer
@ 2022-08-13  6:54   ` Maxim Cournoyer
  2022-08-13  6:54   ` [bug#57168] [PATCH 11/14] gnu: lightdm: Apply patch to fix color depth issue with VNC Maxim Cournoyer
                     ` (3 subsequent siblings)
  12 siblings, 0 replies; 18+ messages in thread
From: Maxim Cournoyer @ 2022-08-13  6:54 UTC (permalink / raw)
  To: 57168; +Cc: Maxim Cournoyer

* 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





^ permalink raw reply related	[flat|nested] 18+ messages in thread

* [bug#57168] [PATCH 11/14] gnu: lightdm: Apply patch to fix color depth issue with VNC.
  2022-08-13  6:54 ` [bug#57168] [PATCH 01/14] services: configuration: Add a 'maybe-value-set?' procedure Maxim Cournoyer
                     ` (8 preceding siblings ...)
  2022-08-13  6:54   ` [bug#57168] [PATCH 10/14] gnu: lightdm: Apply patch to allow using VNC options Maxim Cournoyer
@ 2022-08-13  6:54   ` Maxim Cournoyer
  2022-08-13  6:54   ` [bug#57168] [PATCH 12/14] marionette: Improve the error message of 'wait-for-screen-text' Maxim Cournoyer
                     ` (2 subsequent siblings)
  12 siblings, 0 replies; 18+ messages in thread
From: Maxim Cournoyer @ 2022-08-13  6:54 UTC (permalink / raw)
  To: 57168; +Cc: Maxim Cournoyer

* 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





^ permalink raw reply related	[flat|nested] 18+ messages in thread

* [bug#57168] [PATCH 12/14] marionette: Improve the error message of 'wait-for-screen-text'.
  2022-08-13  6:54 ` [bug#57168] [PATCH 01/14] services: configuration: Add a 'maybe-value-set?' procedure Maxim Cournoyer
                     ` (9 preceding siblings ...)
  2022-08-13  6:54   ` [bug#57168] [PATCH 11/14] gnu: lightdm: Apply patch to fix color depth issue with VNC Maxim Cournoyer
@ 2022-08-13  6:54   ` Maxim Cournoyer
  2022-08-13  6:54   ` [bug#57168] [PATCH 13/14] build: marionette: Add support for Tesseract OCR Maxim Cournoyer
  2022-08-13  6:54   ` [bug#57168] [PATCH 14/14] services: Add lightdm-service-type Maxim Cournoyer
  12 siblings, 0 replies; 18+ messages in thread
From: Maxim Cournoyer @ 2022-08-13  6:54 UTC (permalink / raw)
  To: 57168; +Cc: Maxim Cournoyer

* 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@gnu.org>
 ;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
+;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@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





^ permalink raw reply related	[flat|nested] 18+ messages in thread

* [bug#57168] [PATCH 13/14] build: marionette: Add support for Tesseract OCR.
  2022-08-13  6:54 ` [bug#57168] [PATCH 01/14] services: configuration: Add a 'maybe-value-set?' procedure Maxim Cournoyer
                     ` (10 preceding siblings ...)
  2022-08-13  6:54   ` [bug#57168] [PATCH 12/14] marionette: Improve the error message of 'wait-for-screen-text' Maxim Cournoyer
@ 2022-08-13  6:54   ` Maxim Cournoyer
  2022-08-13  6:54   ` [bug#57168] [PATCH 14/14] services: Add lightdm-service-type Maxim Cournoyer
  12 siblings, 0 replies; 18+ messages in thread
From: Maxim Cournoyer @ 2022-08-13  6:54 UTC (permalink / raw)
  To: 57168; +Cc: Maxim Cournoyer

* 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





^ permalink raw reply related	[flat|nested] 18+ messages in thread

* [bug#57168] [PATCH 14/14] services: Add lightdm-service-type.
  2022-08-13  6:54 ` [bug#57168] [PATCH 01/14] services: configuration: Add a 'maybe-value-set?' procedure Maxim Cournoyer
                     ` (11 preceding siblings ...)
  2022-08-13  6:54   ` [bug#57168] [PATCH 13/14] build: marionette: Add support for Tesseract OCR Maxim Cournoyer
@ 2022-08-13  6:54   ` Maxim Cournoyer
  2022-08-26 16:54     ` Maxime Devos
  12 siblings, 1 reply; 18+ messages in thread
From: Maxim Cournoyer @ 2022-08-13  6:54 UTC (permalink / raw)
  To: 57168; +Cc: Ricardo Wurmus, Maxim Cournoyer, L p R n d n

* 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@lprndn.info>
Co-authored-by: Ricardo Wurmus <rekado@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@lprndn.info>
+;;; Copyright © 2020 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu services 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))))))))
+
+\f
+;;;
+;;; 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?))
+
+\f
+;;;
+;;; 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."))))
+
+\f
+;;;
+;;; 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@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@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





^ permalink raw reply related	[flat|nested] 18+ messages in thread

* [bug#57168] [PATCH 14/14] services: Add lightdm-service-type.
  2022-08-13  6:54   ` [bug#57168] [PATCH 14/14] services: Add lightdm-service-type Maxim Cournoyer
@ 2022-08-26 16:54     ` Maxime Devos
  2022-08-29  2:33       ` bug#57168: [PATCH 00/14] Add a LightDM service Maxim Cournoyer
  0 siblings, 1 reply; 18+ messages in thread
From: Maxime Devos @ 2022-08-26 16:54 UTC (permalink / raw)
  To: Maxim Cournoyer, 57168; +Cc: Ricardo Wurmus, L p R n d n


[-- Attachment #1.1.1: Type: text/plain, Size: 462 bytes --]

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.


[-- Attachment #1.1.2: OpenPGP public key --]
[-- Type: application/pgp-keys, Size: 929 bytes --]

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 236 bytes --]

^ permalink raw reply	[flat|nested] 18+ messages in thread

* bug#57168: [PATCH 00/14] Add a LightDM service.
  2022-08-26 16:54     ` Maxime Devos
@ 2022-08-29  2:33       ` Maxim Cournoyer
  2022-08-30 19:44         ` [bug#57168] " Maxime Devos
  0 siblings, 1 reply; 18+ messages in thread
From: Maxim Cournoyer @ 2022-08-29  2:33 UTC (permalink / raw)
  To: Maxime Devos; +Cc: 57168-done, Ricardo Wurmus, L p R n d n

Hi Maxime,

Maxime Devos <maximedevos@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@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




^ permalink raw reply	[flat|nested] 18+ messages in thread

* [bug#57168] [PATCH 00/14] Add a LightDM service.
  2022-08-29  2:33       ` bug#57168: [PATCH 00/14] Add a LightDM service Maxim Cournoyer
@ 2022-08-30 19:44         ` Maxime Devos
  0 siblings, 0 replies; 18+ messages in thread
From: Maxime Devos @ 2022-08-30 19:44 UTC (permalink / raw)
  To: Maxim Cournoyer; +Cc: 57168-done, Ricardo Wurmus, L p R n d n


[-- Attachment #1.1.1.1: Type: text/plain, Size: 1018 bytes --]

> And this is what I saw, logging in as 'root' graphically, starting xterm
> and issuing:
>
> --8<---------------cut here---------------start------------->8---
> root@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.


[-- Attachment #1.1.1.2: Type: text/html, Size: 1814 bytes --]

[-- Attachment #1.1.2: OpenPGP public key --]
[-- Type: application/pgp-keys, Size: 929 bytes --]

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 236 bytes --]

^ permalink raw reply	[flat|nested] 18+ messages in thread

end of thread, other threads:[~2022-08-30 19:45 UTC | newest]

Thread overview: 18+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-08-13  6:50 [bug#57168] [PATCH 00/14] Add a LightDM service Maxim Cournoyer
2022-08-13  6:54 ` [bug#57168] [PATCH 01/14] services: configuration: Add a 'maybe-value-set?' procedure Maxim Cournoyer
2022-08-13  6:54   ` [bug#57168] [PATCH 02/14] gnu: accountsservice: Update to 22.08.8, enable doc and test suite Maxim Cournoyer
2022-08-13  6:54   ` [bug#57168] [PATCH 03/14] gnu: accountsservice: Provide a means to locate extensions Maxim Cournoyer
2022-08-13  6:54   ` [bug#57168] [PATCH 04/14] gnu: lightdm-gtk-greeter: Add GDK_PIXBUF_MODULE_FILE to wrapper Maxim Cournoyer
2022-08-13  6:54   ` [bug#57168] [PATCH 05/14] gnu: lightdm-gtk-greeter: Use the glib-or-gtk-wrap phase as-is Maxim Cournoyer
2022-08-13  6:54   ` [bug#57168] [PATCH 06/14] gnu: lightdm-gtk-greeter: Enable libklavier support Maxim Cournoyer
2022-08-13  6:54   ` [bug#57168] [PATCH 07/14] gnu: lightdm-gtk-greeter: Adjust default config file path Maxim Cournoyer
2022-08-13  6:54   ` [bug#57168] [PATCH 08/14] gnu: lightdm-gtk-greeter: Adjust --enable-at-spi-command value Maxim Cournoyer
2022-08-13  6:54   ` [bug#57168] [PATCH 09/14] gnu: lightdm: Apply patch to fix a problem with VNC integration Maxim Cournoyer
2022-08-13  6:54   ` [bug#57168] [PATCH 10/14] gnu: lightdm: Apply patch to allow using VNC options Maxim Cournoyer
2022-08-13  6:54   ` [bug#57168] [PATCH 11/14] gnu: lightdm: Apply patch to fix color depth issue with VNC Maxim Cournoyer
2022-08-13  6:54   ` [bug#57168] [PATCH 12/14] marionette: Improve the error message of 'wait-for-screen-text' Maxim Cournoyer
2022-08-13  6:54   ` [bug#57168] [PATCH 13/14] build: marionette: Add support for Tesseract OCR Maxim Cournoyer
2022-08-13  6:54   ` [bug#57168] [PATCH 14/14] services: Add lightdm-service-type Maxim Cournoyer
2022-08-26 16:54     ` Maxime Devos
2022-08-29  2:33       ` bug#57168: [PATCH 00/14] Add a LightDM service Maxim Cournoyer
2022-08-30 19:44         ` [bug#57168] " Maxime Devos

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).