all messages for Guix-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
From: L  p R n  d n    <guix@lprndn.info>
To: Ricardo Wurmus <rekado@elephly.net>
Cc: brice@waegenei.re, 35305@debbugs.gnu.org
Subject: [bug#35305] LightDM service
Date: Fri, 19 Jun 2020 16:47:01 +0200	[thread overview]
Message-ID: <87v9jnqfiy.fsf@lprndn.info> (raw)
In-Reply-To: <87h7w9ej4w.fsf@elephly.net> (Ricardo Wurmus's message of "Thu, 21 May 2020 11:23:43 +0200")

[-- Attachment #1: Type: text/plain, Size: 1647 bytes --]

Hello,

Here I come again with a new attempt for the LightDM service.
This one is a little too complex to my taste but it succeeds IMHO at
dealing with most cases nicely. Also I didn't find any other occurence
of this in Guix, so it might just not fit in. It's a draft and it's
ugly, it probably needs some refactoring/renaming, maybe using methods?
or just alists?

In the meantime, the chosen design is to have the lightdm-service and
greeter services to extend another, private service (lightdm-aggregate)
that deals with mergin everything all configuration and extending the
needed services accordingly. This way, data can be shared between
lightdm's and greeters' configurations (here, greeters' desktop file
directories and a list of greeters needed by the seats definition)

It features:

* A user can define only the a lightdm-service or only a greeter service
  or both, he should always get a working LightDM. If a seats asks for a
  greeter which is not defined in the user config, the lightdm-aggregate
  service adds its service with default config.

* Seats are defined only in the lightdm service so, on one hand, the user needs to
  manually set the `greeter-session field but, on the other hand, we get
  a clear distinction between configurations.

* Too many (cond ...). There might be better solutions.


Please give me your opinion. I think I'll try one last design which will
be the complete opposite of this one. (lightdm-service deals with its
conf, greeters deal with theirs. The user deals with the rest. Also
(service lightdm-service-type) is not enough for a working
display-manager).

Have a nice day,

L  p R n  d n


[-- Attachment #2: 0001-services-Add-lightdm-service-type.patch --]
[-- Type: text/x-patch, Size: 27380 bytes --]

From dad5c510f6c7bbe96140a49d4eb795e8b735c405 Mon Sep 17 00:00:00 2001
From: L  p R n  d n <guix@lprndn.info>
Date: Thu, 18 Apr 2019 17:58:56 +0200
Subject: [PATCH] services: Add lightdm-service-type.

* gnu/services/lightdm.scm: Add file
(<lightdm-configuration>, <lightdm-seat-configuration>,
<lightdm-gtk-greeter-configuration>): New record types.
(lightdm-seat-configuration->list, lightdm-configuration-file,
lightdm-pam-services, lightdm-pam-service, lightdm-etc-service,
lightdm-shepherd-service, lightdm-profile-service,
lightdm-gtk-greeter-configuration-file, lightdm-gtk-greeter-profile-service,
lightdm-gtk-greeter-lightdm-service, lightdm-gtk-greeter-etc-service): New
procedures.
(%lightdm-accounts, %lightdm-activation, lightdm-greeter-pam-service,
lightdm-autologin-pam-service, lightdm-service-type,
lightdm-gtk-greeter-service-type): New variables.
* doc/guix.texi (X Window): Add documentation.
* gnu/local.mk (GNU_SYSTEM_MODULES): Add it.
---
 doc/guix.texi            | 123 ++++++++++
 gnu/local.mk             |   1 +
 gnu/services/lightdm.scm | 496 +++++++++++++++++++++++++++++++++++++++
 3 files changed, 620 insertions(+)
 create mode 100644 gnu/services/lightdm.scm

diff --git a/doc/guix.texi b/doc/guix.texi
index 2268e159a2..be45313ac5 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -15325,6 +15325,129 @@ auto-login session.
 @end table
 @end deftp
 
+@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'
+services for their specific configuration.
+@end defvr
+
+@deftp {Data Type} lightdm-configuration
+Data type representing the LightDM service configuration.
+
+@table @asis
+@item @code{lightdm} (default: @code{lightdm})
+The LightDM package to use.
+
+@item @code{allow-empty-passwords?} (default: @code{#f})
+Whether to allow logins with empty passwords.
+
+@item @code{xorg-configuration} (default: @code{(xorg-configuration)})
+Default configuration of the Xorg graphical server. This configuration
+will be used for all seats unless explicitly defined.
+
+@item @code{sessions-directories} (default:'("/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{greeters-directories} (default:'("$XDG_DATA_DIRS/lightdm/greeters" "$XDG_DATA_DIRS/xgreeters" "/run/current-system/profile/share/xgreeters"))
+Directories where LightDM will search for sessions' @code{.desktop} files.
+
+@item @code{remote-sessions-directories} (default:'("/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.
+
+@item @code{extra-config} (default: @code{'()})
+A list of strings each describing a custom setting to append to the LightDM
+configuration.
+
+@end table
+@end deftp
+
+@deftp {Data Type} lightdm-seat-configuration
+Record representing a seat configuration for LightDM.
+
+@table @asis
+@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{xorg-configuration} (default: @code{#f})
+Configuration of the Xorg graphical server.
+
+@item @code{session-wrapper} (default: @code{(xinitrc)})
+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.
+
+@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}.
+
+@item @code{extra-config} (default: @code{'()})
+A list of strings each describing a custom setting to append to the seat
+configuration.
+
+@end table
+@end deftp
+
+@defvr {Scheme Variable} lightdm-gtk-greeter-service-type
+Service type for the @code{lightdm-gtk-greeter} for LightDM.
+See @code{lightdm-gtk-greeter-configuration} below for configuration.
+@end defvr
+
+@deftp {Data Type} lightdm-gtk-greeter-configuration
+This data type represents the configuration for @code{lightdm-gtk-greeter}.
+Use it as an argument of @code{lightdm-gtk-greeter-configuration-file} to
+get the corresponding file.
+
+@table @asis
+@item @code{lightdm-gtk-greeter} (default: @code{lightdm-gtk-greeter})
+lightdm-gtk-greeter package to use.
+
+@item @code{assets} (default: @code{(list adwaita-icon-theme gnome-themes-standard)})
+A list of packages needed by the greeter: icons, themes, fonts etc.
+
+@item @code{theme-name} (default: "Adwaita")
+The name of the GTK+ theme to be used.
+
+@item @code{icon-theme-name} (default: "Adwaita")
+The name of the icon theme to be used for displaying icons.
+
+@item @code{cursor-theme-name} (default: "Adwaita")
+The name of the theme to be used for the cursor.
+
+@item @code{cursor-size} (default: @code{16})
+The size of the cursor.
+
+@item @code{background} (default: @code{(file-append %artwork-repository "/grub/GuixSD-fully-black-16-9.svg")})
+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
+on exit, @code{"-name"} disables at start and @code{"+name"} enables it.
+
+@item @code{reader} (default: "")
+Command to launch screen reader.
+
+@item @code{extra-config} (default: @code{'()})
+A list of string each describing a custom setting to append to the greeter
+configuration.
+
+@end table
+@end deftp
+
 @cindex Xorg, configuration
 @deftp {Data Type} xorg-configuration
 This data type represents the configuration of the Xorg graphical display
diff --git a/gnu/local.mk b/gnu/local.mk
index fd3cc88af5..6d19b54874 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -586,6 +586,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..1869140609
--- /dev/null
+++ b/gnu/services/lightdm.scm
@@ -0,0 +1,496 @@
+;;; 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>
+;;;
+;;; 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 (srfi srfi-1)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 receive)
+
+  #:use-module (guix gexp)
+  #:use-module (guix records)
+
+  #:use-module (gnu artwork)
+  #:use-module (gnu system pam)
+  #:use-module (gnu system shadow)
+
+  #:use-module (gnu services)
+  #:use-module (gnu services dbus)
+  #:use-module (gnu services desktop)
+  #:use-module (gnu services shepherd)
+  #:use-module (gnu services xorg)
+
+  #: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 xorg)
+
+  #:export (lightdm-seat-configuration
+
+            lightdm-configuration
+            lightdm-configuration?
+            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-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"))))
+
+;; LIGHTDM
+
+(define-record-type* <lightdm-seat-configuration>
+  lightdm-seat-configuration make-lightdm-seat-configuration
+  lightdm-seat-configuration?
+  (name-glob lightdm-seat-configuration-name-glob
+             (default "*"))
+  (type lightdm-seat-configuration-type
+        (default 'local))
+  (xorg-configuration lightdm-seat-configuration-xorg-configuration
+                      (default #f))
+  (session-wrapper lightdm-seat-configuration-session-wrapper
+                   (default (xinitrc)))
+  (greeter-session lightdm-seat-configuration-greeter-session
+                   (default 'lightdm-gtk-greeter))
+  (default-user-session lightdm-seat-configuration-default-user-session
+    (default ""))
+  (autologin-user lightdm-seat-configuration-autologin-user
+                  (default ""))
+  (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."
+  (match-record seat <lightdm-seat-configuration>
+                (name-glob
+                 type xorg-configuration session-wrapper
+                 greeter-session default-user-session
+                 autologin-user extra-config)
+                (list "
+  [Seat:"               name-glob                              "]
+  type = "              (symbol->string type)
+  ;; If no xorg-configuration is set by the seat use the one provided
+  ;; by the lightdm service
+  "
+  xserver-command = "   (xorg-start-command
+                         (or xorg-configuration
+                             default-xorg-configuration))
+  "
+  session-wrapper = "   session-wrapper                         "
+  greeter-session = "   (symbol->string greeter-session)
+  (if (string-null? default-user-session) ""
+      (string-append "
+  user-session = "      default-user-session))                  "
+  "
+  ;; Turn autologin ON if autologin-user is set
+  (if (string-null? autologin-user) ""
+      (string-append "
+  autologin-user = "    autologin-user                          "
+  autologin-session = " default-user-session))                  "
+  " (string-join extra-config "\n"))))
+
+
+(define-record-type* <lightdm-configuration>
+  lightdm-configuration make-lightdm-configuration
+  lightdm-configuration?
+  ;; General configuration
+  (lightdm lightdm-configuration-lightdm
+           (default lightdm))
+  (allow-empty-passwords? lightdm-configuration-allow-empty-passwords?
+                          (default #f))
+  (sessions-directories
+   lightdm-configuration-sessions-directory
+   (default '("/run/current-system/profile/share/xsessions"
+              "/run/current-system/profile/share/wayland-sessions")))
+  (greeters-directories lightdm-configuration-greeters-directories
+                        (default '("$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 (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-directories greeters-directories
+                 remote-sessions-directories xorg-configuration
+                 seats extra-config)
+                ;; Little trick to allow unquote-splicing of seats
+                (apply mixed-text-file "lightdm.conf" "
+[LightDM]
+greeter-user = lightdm
+greeters-directory = " #~(string-join '#$greeters-directories ":") "
+sessions-directory = " (string-join sessions-directories ":") "
+remote-sessions-directory = " (string-join remote-sessions-directories ":") "
+
+#Seats
+ " (append
+    (concatenate
+     (map (lambda (seat)
+            (lightdm-seat-configuration->list seat xorg-configuration))
+          seats))
+    (list "
+#Extra config
+" (string-join extra-config "\n"))))))
+
+(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.
+  ;; Mimics what is done for gdm
+  ;; see a43e9157ef479e94c19951cc9d228cf153bf78ee
+  (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"))))
+   ;; Can't change 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 they are 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"))))
+   ;; Can't change 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 with CONFIG."
+
+  (define lightdm-command
+    #~(list #$(file-append (lightdm-configuration-lightdm config)
+                           "/sbin/lightdm")
+            "-c"
+            #$(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"))
+         ":")))
+
+  (list
+   (shepherd-service
+    (documentation "LightDM display manager.")
+    (requirement '(dbus-system user-processes host-name))
+    (provision '(display-manager xorg-server))
+    (respawn? #f)
+    (start
+     #~(lambda ()
+         (fork+exec-command
+          #$lightdm-command
+          ;; Lightdm needs itself in its PATH
+          #:environment-variables
+          (list
+           (string-append "PATH=" #$lightdm-paths)))))
+    (stop #~(make-kill-destructor)))))
+
+;; LightDM Aggregate
+
+(define-record-type* <lightdm-aggregate>
+  lightdm-aggregate make-lightdm-aggregate
+  lightdm-aggregate?
+  (lightdm lightdm-aggregate-lightdm
+           (default (lightdm-configuration)))
+  (greeters lightdm-aggregate-greeters
+            (default '())))
+
+;; WHAT TO DO IF THERE IS A NON DEFAULT GREETER SERVICE AND
+;; A DEFAULT LIGHTDM SERVICE DEFINED OR THE OPPOSITE
+
+;;
+(define (greeter-default-configuration greeter-symbol)
+  "Given a greeter's symbol, return its default configuration."
+  (cond
+   ((eq? 'lightdm-gtk-greeter greeter-symbol)
+    (lightdm-gtk-greeter-configuration))
+   (else #f)))
+
+(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 (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)
+  (lightdm-gtk-greeter-configuration-assets config))
+
+(define (lightdm-greeter-etc-service greeter-config)
+  (cond
+   ((lightdm-gtk-greeter-configuration? greeter-config)
+    (lightdm-gtk-greeter-etc-service greeter-config))
+   (else #f)))
+
+(define (lightdm-greeter-profile-service greeter-config)
+  (cond
+   ((lightdm-gtk-greeter-configuration? greeter-config)
+    (lightdm-gtk-greeter-profile-service greeter-config))
+   (else #f)))
+
+(define (augment-greeters-directories lightdm-config greeters)
+  "Returns a new lightdm-configuration record based on @code{lightdm-conf}
+but with @code{greeters} available in its @code{greeters-directories} field."
+  (lightdm-configuration
+   (inherit lightdm-config)
+   (greeters-directories
+    (append (map greeter-desktop-directory greeters)
+            (lightdm-configuration-greeters-directories lightdm-config)))))
+
+(define (aggregate->greeters aggregate)
+  "Given a lightdm-aggregate, outputs a list of greeter
+configurations."
+  (let ( ;; Greeters found in seat-configurations.
+        (needed-greeters
+         (map (lambda (seat)
+                (lightdm-seat-configuration-greeter-session seat))
+              (lightdm-configuration-seats
+               (lightdm-aggregate-lightdm aggregate))))
+        ;; Greeter configurations defined by the user
+        (user-defined-greeters (lightdm-aggregate-greeters aggregate)))
+    (map
+     (lambda (greeter)
+       ;; If a greeter is used in a seat but not defined by the user
+       ;; get its default configuration object
+       (or (assoc-ref greeter user-defined-greeters)
+           (greeter-default-configuration greeter)))
+     needed-greeters)))
+
+;; Private service merging configuration of lightdm and its greeters
+(define lightdm-aggregate-service-type
+  (service-type
+   (name 'lightdm-aggregate)
+   (extensions
+    (list (service-extension etc-service-type
+                       (lambda (aggregate)
+                         (concatenate (map lightdm-greeter-etc-service
+                                           (lightdm-aggregate-greeters aggregate)))))
+    (service-extension profile-service-type
+                       (lambda (aggregate)
+                         (concatenate (map lightdm-greeter-profile-service
+                                           (lightdm-aggregate-greeters aggregate)))))
+    ;; LightDM Specifics (at leats for now)
+    (service-extension pam-root-service-type
+                       (compose lightdm-pam-services
+                                lightdm-aggregate-lightdm))
+    (service-extension shepherd-root-service-type
+                       (compose lightdm-shepherd-service
+                                lightdm-aggregate-lightdm))
+    (service-extension activation-service-type
+                       (const %lightdm-activation))
+    (service-extension dbus-root-service-type
+                       (compose list lightdm-configuration-lightdm
+                                lightdm-aggregate-lightdm))
+    (service-extension polkit-service-type
+                       (compose list lightdm-configuration-lightdm
+                                lightdm-aggregate-lightdm))
+    (service-extension account-service-type
+                       (const %lightdm-accounts))))
+   ;; Get lightdm-configuration from its service and pairs like
+   ;; ('greeter-symbol . greeter-configuration) from greeters
+   (compose (lambda (extensions)
+              (receive (lightdm-extension greeters-extensions)
+                  (partition lightdm-configuration? extensions)
+                (make-lightdm-aggregate
+                 (if (null? lightdm-extension) (lightdm-configuration) (car lightdm-extension))
+                 greeters-extensions))))
+   (extend (lambda (config extensions)
+             (let ((greeters (aggregate->greeters extensions)))
+               (make-lightdm-aggregate
+                ;; If there are no lightdm-service defined, use the default one.
+                ;; Also, add greeters' desktop directories to greeters-directories.
+                (augment-greeters-directories
+                 (lightdm-aggregate-lightdm extensions) greeters)
+                greeters))))
+   (default-value (lightdm-aggregate))
+   (description "Private service merging LightDM and LightDM's greeters
+services configurations and extending needed services.")))
+
+;; GREETERS
+
+(define lightdm-gtk-greeter-service-type
+  (service-type (name 'lightdm-gtk-greeter)
+                (extensions
+                 (list
+                  (service-extension lightdm-aggregate-service-type
+                                     (lambda (g) (cons 'lightdm-gtk-greeter g)))))
+                (default-value (lightdm-gtk-greeter-configuration))
+                (description
+                 "Set-up lightdm-gtk-greeter as well
+as its configuration file and extends LightDM with its seats.")))
+
+;; LightDM
+
+(define lightdm-service-type
+  (handle-xorg-configuration
+   lightdm-configuration
+   (service-type (name 'lightdm)
+                 (extensions
+                  (list
+                   (service-extension lightdm-aggregate-service-type
+                                      const)))
+                 (default-value (lightdm-configuration))
+                 (description "Return a service that spawns the
+ LightDM graphical login manager."))))
-- 
2.26.2


  parent reply	other threads:[~2020-06-19 14:49 UTC|newest]

Thread overview: 30+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2019-04-17 14:24 [bug#35305] [WIP] LightDM service L p R n d n
2019-04-18 11:20 ` Jonathan Brielmaier
     [not found] ` <handler.35305.B.155550391014002.ack@debbugs.gnu.org>
2019-04-18 13:20   ` [bug#35305] Acknowledgement ([WIP] LightDM service) L p R n d n
2019-04-18 16:03     ` L p R n d n
2019-08-26 15:58   ` L p R n d n
2020-03-15 21:50     ` Nicolò Balzarotti
2020-03-16  7:34       ` Efraim Flashner
2020-03-16  8:36         ` L p R n d n
2020-03-19 11:54       ` [bug#35305] LightDM service L p R n d n
2019-05-23 11:04 ` [bug#35305] [PATCH] " L p R n d n
2020-04-07 17:06 ` [bug#35305] " Brice Waegeneire
2020-04-09 16:02   ` L p R n d n
2020-04-12  9:53     ` Brice Waegeneire
2020-04-14  9:38       ` L p R n d n
2020-04-14 13:17         ` L p R n d n
2020-04-22 15:26       ` L p R n d n
2020-05-06 14:05 ` L p R n d n
2020-05-08 22:18   ` Ricardo Wurmus
2020-05-09 15:09     ` L p R n d n
2020-05-10 19:21       ` Ricardo Wurmus
2020-05-11 10:14         ` L p R n d n
2020-05-12  9:59         ` L p R n d n
2020-05-20 20:51           ` Ricardo Wurmus
2020-05-21  8:28             ` L p R n d n
2020-05-21  9:23               ` Ricardo Wurmus
2020-06-08 15:35                 ` L p R n d n
2022-08-04  5:09                   ` [bug#35305] [WIP] " Maxim Cournoyer
2020-06-19 14:47                 ` L p R n d n [this message]
2022-08-04  2:19   ` Maxim Cournoyer
2022-08-31  7:13 ` bug#35305: " Ricardo Wurmus

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=87v9jnqfiy.fsf@lprndn.info \
    --to=guix@lprndn.info \
    --cc=35305@debbugs.gnu.org \
    --cc=brice@waegenei.re \
    --cc=rekado@elephly.net \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this external index

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

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.