commit abb21401f996397065207f7596170751c77287b5
Author: Ricardo Wurmus <rekado@elephly.net>
Date:   Sat May 23 00:04:54 2020 +0200

    WIP lightdm

diff --git a/doc/guix.texi b/doc/guix.texi
index c1987e223d..f169a84493 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -80,6 +80,7 @@ Copyright @copyright{} 2020 Brice Waegeneire@*
 Copyright @copyright{} 2020 R Veera Kumar@*
 Copyright @copyright{} 2020 Pierre Langlois@*
 Copyright @copyright{} 2020 pinoaffe@*
+Copyright @copyright{} 2020 L  p R n  d n@*
 
 Permission is granted to copy, distribute and/or modify this document
 under the terms of the GNU Free Documentation License, Version 1.3 or
@@ -15054,9 +15055,9 @@ auto-login session.
 
 @cindex LightDM, login manager
 @defvr {Scheme Variable} lightdm-service-type
-Service type for the LightDM graphical login manager.
-It uses the @code{lightdm-gtk-greeter} as default greeter.
-See @code{lightdm-configuration} below for configuration and greeters'
+Service type for the LightDM graphical login manager.  It uses the
+@code{lightdm-gtk-greeter} as default greeter.  See
+@code{lightdm-configuration} below for configuration and greeters'
 services for their specific configuration.
 @end defvr
 
@@ -15071,22 +15072,22 @@ The LightDM package to use.
 Whether to allow logins with empty passwords.
 
 @item @code{xorg-configuration} (default: @code{(xorg-configuration)})
-Default configuration of the Xorg graphical server. This configuration
+Default configuration of the Xorg graphical server.  This configuration
 will be used for all seats unless explicitly defined.
 
-@item @code{sessions-directory} (default:"/run/current-system/profile/share/xsessions:/run/current-system/profile/share/wayland-sessions")
+@item @code{sessions-directories} (default: @code{'("/run/current-system/profile/share/xsessions" "/run/current-system/profile/share/wayland-sessions")})
 Directories where LightDM will search for sessions' @code{.desktop} files.
 
-@item @code{remote-sessions-directory} (default:"/run/current-system/profile/share/remote-session")
+@item @code{remote-sessions-directories} (default: @code{'("/run/current-system/profile/share/remote-session")})
 Directories where LightDM will search for remote sessions'
 @code{.desktop} files.
 
-@item @code{seats} (default: @code{'()})
-A list of @code{lightdm-seat-configuration} records (see below)
-to include in configuration. Note that needed additional packages or
-configuration will need to be done manually. Thus, we recommend using a
-greeter service for defining seats. If none are provided here or by a greeter,
-a fallback one is added.
+@item @code{seats} (default: @code{(list (lightdm-seat-configuration))})
+A list of @code{lightdm-seat-configuration} records (see below) to
+include in configuration.  Note that additional packages or
+configuration will need to be added manually.  Thus, we recommend using
+a greeter service for defining seats.  If none are provided here or by a
+greeter, a fallback is added.
 
 @item @code{extra-config} (default: @code{'()})
 A list of strings each describing a custom setting to append to the LightDM
@@ -15102,8 +15103,8 @@ Record representing a seat configuration for LightDM.
 @item @code{name-glob} (default: @code{"*"})
 Seat configuration is matched to all seats matching the name glob.
 
-@item @code{type} (default: @code{"local"})
-Type of seat. @code{"local"} or @code{"xremote"}.
+@item @code{type} (default: @code{'local})
+Type of seat.  @code{'local} or @code{'xremote}.
 
 @item @code{xorg-configuration} (default: @code{#f})
 Configuration of the Xorg graphical server.
@@ -15112,17 +15113,17 @@ Configuration of the Xorg graphical server.
 Script to run before starting a X session.
 
 @item @code{greeter-session} (default: "lightdm-gtk-greeter")
-The name of the greeter to be used for this seat.
+The name of the greeter to be used for this seat.  This must match the
+base name of the greeter's @file{.desktop} file.
 
 @item @code{default-user-session} (default: "")
 The name of the default @code{.desktop} file describing a session.
 Will be used for @code{user-session} and @code{autologin-session} if necessary.
 
 @item @code{autologin-user} (default: "")
-If @code{autologin-user} is set, LightDM logs in directly
-as @code{autologin-user} to the session defined in
-@code{default-user-session}. This user should be part of the
-@code{autologin} group.
+If @code{autologin-user} is set, LightDM logs in directly as
+@code{autologin-user} to the session defined in
+@code{default-user-session}.
 
 @item @code{extra-config} (default: @code{'()})
 A list of strings each describing a custom setting to append to the seat
@@ -15164,16 +15165,15 @@ The size of the cursor.
 Path to the background image to be used.
 
 @item @code{a11y-state} (default: "contrast; font; keyboard; reader")
-String describing states of accessibility features. @code{"name"} saves state
+String describing states of accessibility features.  @code{"name"} saves state
 on exit, @code{"-name"} disables at start and @code{"+name"} enables it.
 
 @item @code{reader} (default: "")
 Command to launch screen reader.
 
-@item @code{seats} (default: @code{'()})
+@item @code{seats} (default: @code{(list (lightdm-seat-configuration))})
 List of @code{lightdm-seat-configuration} records (see above) to add to
-lightdm.conf through extension. @code{greeter-session} fields
-will be forced to @code{"lightdm-gtk-greeter"}
+@file{lightdm.conf} through extension.
 
 @item @code{extra-config} (default: @code{'()})
 A list of string each describing a custom setting to append to the greeter
diff --git a/gnu/services/lightdm.scm b/gnu/services/lightdm.scm
index fa5330aade..bcc1a42cf5 100644
--- a/gnu/services/lightdm.scm
+++ b/gnu/services/lightdm.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2019,2020 L  p R n  d n   <guix@lprndn.info>
+;;; Copyright © 2019, 2020 L  p R n  d n   <guix@lprndn.info>
+;;; Copyright © 2020 Ricardo Wurmus <rekado@elephly.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -43,14 +44,77 @@
 
   #:export (lightdm-seat-configuration
 
+            lightdm-gtk-greeter-configuration
+            lightdm-gtk-greeter-configuration?
+
             lightdm-configuration
             lightdm-configuration?
-            lightdm-service-type
+            lightdm-service-type))
 
-            lightdm-gtk-greeter-configuration
-            lightdm-gtk-greeter-configuration?
-            lightdm-gtk-greeter-service-type))
 
+;; GREETERS
+(define-record-type* <lightdm-gtk-greeter-configuration>
+  lightdm-gtk-greeter-configuration make-lightdm-gtk-greeter-configuration
+  lightdm-gtk-greeter-configuration?
+
+  (lightdm-gtk-greeter lightdm-gtk-greeter-configuration-lightdm-gtk-greeter
+                       (default lightdm-gtk-greeter))
+  (assets lightdm-gtk-greeter-configuration-assets
+          (default (list adwaita-icon-theme
+                         gnome-themes-standard)))
+  (theme-name lightdm-gtk-greeter-configuration-theme-name
+              (default "Adwaita"))
+  (icon-theme-name
+   lightdm-gtk-greeter-configuration-icon-theme-name
+   (default "Adwaita"))
+  (cursor-theme-name
+   lightdm-gtk-greeter-configuration-cursor-theme-name
+   (default "Adwaita"))
+  (cursor-theme-size lightdm-gtk-greeter-configuration-cursor-theme-size
+                     (default 16))
+  (background lightdm-gtk-greeter-configuration-background
+              (default (file-append %artwork-repository
+                                    "/grub/GuixSD-fully-black-16-9.svg")))
+  (a11y-states lightdm-gtk-greeter-a11y-states
+              (default "contrast; font; keyboard; reader"))
+  (reader lightdm-gtk-greeter-reader
+          (default #f))
+  (extra-config lightdm-gtk-greeter-configuration-extra-config
+                (default '())))
+
+(define (lightdm-gtk-greeter-configuration-file config)
+  (match-record config <lightdm-gtk-greeter-configuration>
+                (theme-name icon-theme-name cursor-theme-name
+                            cursor-theme-size background a11y-states
+                            reader extra-config)
+                (mixed-text-file "lightdm/lightdm-gtk-greeter.conf" "
+[greeter]
+theme-name = "          theme-name                         "
+icon-theme-name = "     icon-theme-name                    "
+cursor-theme-name = "   cursor-theme-name                  "
+cursor-theme-size = "   (number->string cursor-theme-size) "
+background = "          background                         "
+a11y-states = "         a11y-states                        "
+" (if reader (string-append "reader = " reader) "") "
+" (string-join extra-config "\n"))))
+
+(define (greeter-desktop-directory greeter-config)
+  "Return the directory providing the greeter's .desktop file given a
+configuration object.  Return #F for unknown greeters."
+  (cond
+   ((lightdm-gtk-greeter-configuration? greeter-config)
+    (file-append (lightdm-gtk-greeter-configuration-lightdm-gtk-greeter
+                  greeter-config)
+                 "/share/xgreeters"))
+   (else #f)))
+
+(define (greeter-name greeter-config)
+  "Return the greeter name given a configuration object.  Return #F for
+unknown greeters."
+  (cond
+   ((lightdm-gtk-greeter-configuration? greeter-config)
+    "lightdm-gtk-greeter")
+   (else #f)))
 
 ;; LIGHTDM
 
@@ -60,7 +124,7 @@
   (name-glob lightdm-seat-configuration-name-glob
              (default "*"))
   (type lightdm-seat-configuration-type
-        (default "local"))
+        (default 'local))
   (xorg-configuration lightdm-seat-configuration-xorg-configuration
                       (default #f))
   (session-wrapper lightdm-seat-configuration-session-wrapper
@@ -74,9 +138,9 @@
   (extra-config lightdm-seat-configuration-extra-config
                 (default '())))
 
-
 (define (lightdm-seat-configuration->list seat default-xorg-configuration)
-  "Given a seat, outputs a list to be used by mixed-text-file through `apply."
+  "Given a seat, outputs a list of configuration file chunks to be passed as
+arguments to mixed-text-file."
   (match-record seat <lightdm-seat-configuration>
                 (name-glob
                  type xorg-configuration session-wrapper
@@ -84,7 +148,7 @@
                  autologin-user extra-config)
                 (list "
   [Seat:"               name-glob                              "]
-  type = "              type
+  type = "              (symbol->string type)
   ;; If no xorg-configuration is set by the seat use the one provided
   ;; by the lightdm service
   "
@@ -114,48 +178,57 @@
            (default lightdm))
   (allow-empty-passwords? lightdm-configuration-allow-empty-passwords?
                           (default #f))
-  (sessions-directory
-   lightdm-configuration-sessions-directory
-   (default
-     "/run/current-system/profile/share/xsessions:/run/current-system/profile/share/wayland-sessions"))
-  (greeters-directory lightdm-configuration-greeters-directory
-                      (default "/run/current-system/profile/share/xgreeters"))
-  (remote-sessions-directory lightdm-configuration-remote-sessions-directory
-                             (default
-                               "/run/current-system/profile/share/remote-sessions"))
+  (greeters lightdm-configuration-greeters
+            (default (list (lightdm-gtk-greeter-configuration))))
+  (sessions-directories
+   lightdm-configuration-sessions-directories
+   (default '("/run/current-system/profile/share/xsessions"
+              "/run/current-system/profile/share/wayland-sessions")))
+  (greeters-directories lightdm-configuration-greeters-directories
+                        (default (list "$XDG_DATA_DIRS/lightdm/greeters"
+                                       "$XDG_DATA_DIRS/xgreeters"
+                                       "/run/current-system/profile/share/xgreeters")))
+  (remote-sessions-directories
+   lightdm-configuration-remote-sessions-directories
+   (default '("/run/current-system/profile/share/remote-sessions")))
   ;; Having a xorg-configuration field here allows us
   ;; to benefit from set-xorg-configuration.
   (xorg-configuration lightdm-configuration-xorg-configuration
                       (default (xorg-configuration)))
   (seats lightdm-configuration-seats
-         (default '()))
+         (default (list (lightdm-seat-configuration))))
   (extra-config lightdm-configuration-extra-config
                 (default '())))
 
 (define (lightdm-configuration-file config)
   (match-record config <lightdm-configuration>
-                (allow-empty-passwords?
-                 sessions-directory greeters-directory
-                 remote-sessions-directory xorg-configuration
-                 seats extra-config)
-                ;; Little trick to allow unquote-splicing of seats
-                (apply mixed-text-file `("lightdm.conf" "
-[LightDM]
+    (allow-empty-passwords?
+     greeters sessions-directories greeters-directories
+     remote-sessions-directories xorg-configuration
+     seats extra-config)
+    (apply mixed-text-file "lightdm.conf"
+           "[LightDM]
 greeter-user = lightdm
-greeters-directory = " ,greeters-directory "
-sessions-directory = " ,sessions-directory "
-remote-sessions-directory = " ,remote-sessions-directory "
+greeters-directory = "
+           #~(string-join
+              (append '#$(filter-map greeter-desktop-directory greeters)
+                      '#$greeters-directories) ":")
+           "
+sessions-directory = " (string-join sessions-directories ":")
+           "
+remote-sessions-directory = " (string-join remote-sessions-directories ":")
+           "
 
 #Seats
- " ,@(if (null? seats)
-         (lightdm-seat-configuration->list (lightdm-seat-configuration)
-                                           xorg-configuration)
-         (concatenate
-          (map (lambda (seat)
-                 (lightdm-seat-configuration->list seat xorg-configuration))
-               seats))) "
+"
+           (append (concatenate
+                    (map (lambda (seat)
+                           (lightdm-seat-configuration->list seat xorg-configuration))
+                         seats))
+                   (list
+                    "
 #Extra config
-" ,(string-join extra-config "\n")))))
+" (string-join extra-config "\n"))))))
 
 (define %lightdm-accounts
   (list (user-group (name "lightdm") (system? #t))
@@ -229,7 +302,7 @@ remote-sessions-directory = " ,remote-sessions-directory "
 
 
 (define (lightdm-autologin-pam-service)
-  "Return a PAM service for @command{lightdm-autologin}}."
+  "Return a PAM service for @command{lightdm-autologin}."
   (pam-service
    (name "lightdm-autologin")
    (auth
@@ -264,7 +337,10 @@ remote-sessions-directory = " ,remote-sessions-directory "
 
   (define lightdm-command
     #~(list #$(file-append (lightdm-configuration-lightdm config)
-                           "/sbin/lightdm")))
+                           "/sbin/lightdm")
+            "-d"
+            "-c"
+            #$(lightdm-configuration-file config)))
 
   (list
    (shepherd-service
@@ -274,26 +350,9 @@ remote-sessions-directory = " ,remote-sessions-directory "
     (respawn? #f)
     (start
      #~(lambda ()
-         (fork+exec-command
-          #$lightdm-command
-          #:environment-variables
-          (list
-           "PATH=/run/current-system/profile/sbin:/run/current-system/profile/bin"))))
+         (fork+exec-command #$lightdm-command)))
     (stop #~(make-kill-destructor)))))
 
-(define (lightdm-etc-service config)
-  `(("xdg/lightdm/lightdm.conf.d/lightdm.conf"
-     ,(lightdm-configuration-file config))))
-
-(define (lightdm-profile-service config)
-  ;; In case no seats are provided, we fall back on a default one
-  ;; with lightdm-gtk-greeter. Add necessary packages.
-  (let ((seats (lightdm-configuration-seats config))
-        (lightdm (lightdm-configuration-lightdm config)))
-    (if (null? seats)
-        (list lightdm lightdm-gtk-greeter)
-        (list lightdm))))
-
 (define lightdm-service-type
   ;; (handle-xorg-configuration lightdm-configuration)
   (service-type (name 'lightdm)
@@ -308,12 +367,10 @@ remote-sessions-directory = " ,remote-sessions-directory "
                   (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))
-                  (service-extension etc-service-type
-                                     lightdm-etc-service)
-                  (service-extension profile-service-type
-                                     lightdm-profile-service)))
+                                     (const %lightdm-accounts))))
                 ;; LightDM is extended with lists of seats
                 ;; or with a xorg-configuration by set-xorg-configuration
                 ;; Deal with both cases.
@@ -337,86 +394,5 @@ remote-sessions-directory = " ,remote-sessions-directory "
                            (seats (append (assoc-ref extensions "seats")
                                           (lightdm-configuration-seats config))))))
                 (default-value (lightdm-configuration))
-                (description "Return a service that spawns the
- LightDM graphical login manager.")))
-
-;; GREETERS
-
-(define-record-type* <lightdm-gtk-greeter-configuration>
-  lightdm-gtk-greeter-configuration make-lightdm-gtk-greeter-configuration
-  lightdm-gtk-greeter-configuration?
-
-  (lightdm-gtk-greeter lightdm-gtk-greeter-configuration-lightdm-gtk-greeter
-                       (default lightdm-gtk-greeter))
-  (assets lightdm-gtk-greeter-configuration-assets
-          (default (list adwaita-icon-theme
-                         gnome-themes-standard)))
-  (theme-name lightdm-gtk-greeter-configuration-theme-name
-              (default "Adwaita"))
-  (icon-theme-name
-   lightdm-gtk-greeter-configuration-icon-theme-name
-   (default "Adwaita"))
-  (cursor-theme-name
-   lightdm-gtk-greeter-configuration-cursor-theme-name
-   (default "Adwaita"))
-  (cursor-theme-size lightdm-gtk-greeter-configuration-cursor-theme-size
-                     (default 16))
-  (background lightdm-gtk-greeter-configuration-background
-              (default (file-append %artwork-repository
-                                    "/grub/GuixSD-fully-black-16-9.svg")))
-  (a11y-states lightdm-gtk-greeter-a11y-states
-              (default "contrast; font; keyboard; reader"))
-  (reader lightdm-gtk-greeter-reader
-          (default #f))
-  (seats lightdm-gtk-greeter-configuration-seats
-         (default (list (lightdm-seat-configuration))))
-  (extra-config lightdm-gtk-greeter-configuration-extra-config
-                (default '())))
-
-(define (lightdm-gtk-greeter-configuration-file config)
-  (match-record config <lightdm-gtk-greeter-configuration>
-                (theme-name icon-theme-name cursor-theme-name
-                            cursor-theme-size background a11y-states
-                            reader extra-config)
-                (mixed-text-file "lightdm-gtk-greeter.conf" "
-[greeter]
-theme-name = "          theme-name                         "
-icon-theme-name = "     icon-theme-name                    "
-cursor-theme-name = "   cursor-theme-name                  "
-cursor-theme-size = "   (number->string cursor-theme-size) "
-background = "          background                         "
-a11y-states = "         a11y-states                        "
-" (if reader (string-append "reader = " reader) "") "
-" (string-join extra-config "\n"))))
-
-(define (lightdm-gtk-greeter-lightdm-service config)
-  ;; Enforce greeter-session field to lightdm-gtk-greeter
-  (map
-   (lambda (seat)
-     (lightdm-seat-configuration
-      (inherit seat)
-      (greeter-session "lightdm-gtk-greeter")))
-   (lightdm-gtk-greeter-configuration-seats config)))
-
-(define (lightdm-gtk-greeter-etc-service config)
-  `(("xdg/lightdm/lightdm-gtk-greeter.conf"
-     ,(lightdm-gtk-greeter-configuration-file config))))
-
-(define (lightdm-gtk-greeter-profile-service config)
-  (cons (lightdm-gtk-greeter-configuration-lightdm-gtk-greeter config)
-        (lightdm-gtk-greeter-configuration-assets config)))
-
-(define lightdm-gtk-greeter-service-type
-  (service-type (name 'lightdm-gtk-greeter)
-                (extensions
-                 (list
-                  (service-extension lightdm-service-type
-                                     lightdm-gtk-greeter-lightdm-service)
-                  (service-extension etc-service-type
-                                     lightdm-gtk-greeter-etc-service)
-                  (service-extension profile-service-type
-                                     lightdm-gtk-greeter-profile-service)))
-                (default-value (lightdm-gtk-greeter-configuration))
-                (description
-                 "Set-up lightdm-gtk-greeter as well
-as its configuration file and extends LightDM with its seats.")))
+                (description "Return a service that spawns the LightDM
+graphical login manager.")))
