From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp1 ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms11 with LMTPS id ZP1EN2LQ7F48cgAA0tVLHw (envelope-from ) for ; Fri, 19 Jun 2020 14:49:06 +0000 Received: from aspmx1.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp1 with LMTPS id 0MeoMmLQ7F4tIgAAbx9fmQ (envelope-from ) for ; Fri, 19 Jun 2020 14:49:06 +0000 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id 22E6294050F for ; Fri, 19 Jun 2020 14:49:06 +0000 (UTC) Received: from localhost ([::1]:59990 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jmIKH-0001FY-1a for larch@yhetil.org; Fri, 19 Jun 2020 10:49:05 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:44514) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1jmIJG-0007ej-6C for guix-patches@gnu.org; Fri, 19 Jun 2020 10:48:02 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:45086) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1jmIJF-0002wu-Rk for guix-patches@gnu.org; Fri, 19 Jun 2020 10:48:01 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1jmIJF-0002Dx-QZ for guix-patches@gnu.org; Fri, 19 Jun 2020 10:48:01 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#35305] LightDM service Resent-From: L p R n d n Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Fri, 19 Jun 2020 14:48:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 35305 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: Ricardo Wurmus Cc: brice@waegenei.re, 35305@debbugs.gnu.org Received: via spool by 35305-submit@debbugs.gnu.org id=B35305.15925780448503 (code B ref 35305); Fri, 19 Jun 2020 14:48:01 +0000 Received: (at 35305) by debbugs.gnu.org; 19 Jun 2020 14:47:24 +0000 Received: from localhost ([127.0.0.1]:56632 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jmIIV-0002Cw-3E for submit@debbugs.gnu.org; Fri, 19 Jun 2020 10:47:24 -0400 Received: from mout02.posteo.de ([185.67.36.142]:52103) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jmIIP-0002Ca-Io for 35305@debbugs.gnu.org; Fri, 19 Jun 2020 10:47:13 -0400 Received: from submission (posteo.de [89.146.220.130]) by mout02.posteo.de (Postfix) with ESMTPS id 26EFF2400FB for <35305@debbugs.gnu.org>; Fri, 19 Jun 2020 16:47:03 +0200 (CEST) Received: from customer (localhost [127.0.0.1]) by submission (posteo.de) with ESMTPSA id 49pM8P604Tz9rxT; Fri, 19 Jun 2020 16:47:01 +0200 (CEST) From: L p R n d n References: <87zhooso9g.fsf@lprndn.info> <87imh9gnvy.fsf@lprndn.info> <87k11m2hqx.fsf@elephly.net> <87zhahcfgh.fsf@lprndn.info> <878shz38bf.fsf@elephly.net> <87o8qtzd71.fsf@lprndn.info> <87k116e3ee.fsf@elephly.net> <87tv09zo70.fsf@lprndn.info> <87h7w9ej4w.fsf@elephly.net> Date: Fri, 19 Jun 2020 16:47:01 +0200 In-Reply-To: <87h7w9ej4w.fsf@elephly.net> (Ricardo Wurmus's message of "Thu, 21 May 2020 11:23:43 +0200") Message-ID: <87v9jnqfiy.fsf@lprndn.info> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.3 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Spam-Score: -1.6 (-) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-Spam-Score: -0.3 (/) X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+larch=yhetil.org@gnu.org Sender: "Guix-patches" X-Scanner: scn0 Authentication-Results: aspmx1.migadu.com; dkim=none; dmarc=none; spf=pass (aspmx1.migadu.com: domain of guix-patches-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=guix-patches-bounces@gnu.org X-Spam-Score: -0.01 X-TUID: vRQdrR6Luu3Q --=-=-= Content-Type: text/plain 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 --=-=-= Content-Type: text/x-patch; charset=utf-8 Content-Disposition: attachment; filename=0001-services-Add-lightdm-service-type.patch Content-Transfer-Encoding: quoted-printable >From dad5c510f6c7bbe96140a49d4eb795e8b735c405 Mon Sep 17 00:00:00 2001 From: L p R n d n Date: Thu, 18 Apr 2019 17:58:56 +0200 Subject: [PATCH] services: Add lightdm-service-type. * gnu/services/lightdm.scm: Add file (, , ): 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 =20 +@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/greet= ers" "$XDG_DATA_DIRS/xgreeters" "/run/current-system/profile/share/xgreeter= s")) +Directories where LightDM will search for sessions' @code{.desktop} files. + +@item @code{remote-sessions-directories} (default:'("/run/current-system/p= rofile/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 neces= sary. + +@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 st= ate +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 =3D \ %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 =C2=A9 2019,2020 L p R n d n +;;; Copyright =C2=A9 2020 Ricardo Wurmus +;;; +;;; 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 . + + +(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 make-lightdm-gtk-greeter-configuration + lightdm-gtk-greeter-configuration? + + (lightdm-gtk-greeter lightdm-gtk-greeter-configuration-lightdm-gtk-greet= er + (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 + (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 =3D " theme-name " +icon-theme-name =3D " icon-theme-name " +cursor-theme-name =3D " cursor-theme-name " +cursor-theme-size =3D " (number->string cursor-theme-size) " +background =3D " background " +a11y-states =3D " a11y-states " +" (if reader (string-append "reader =3D " reader) "") " +" (string-join extra-config "\n")))) + +;; LIGHTDM + +(define-record-type* + 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 `app= ly." + (match-record seat + (name-glob + type xorg-configuration session-wrapper + greeter-session default-user-session + autologin-user extra-config) + (list " + [Seat:" name-glob "] + type =3D " (symbol->string type) + ;; If no xorg-configuration is set by the seat use the one provided + ;; by the lightdm service + " + xserver-command =3D " (xorg-start-command + (or xorg-configuration + default-xorg-configuration)) + " + session-wrapper =3D " session-wrapper " + greeter-session =3D " (symbol->string greeter-session) + (if (string-null? default-user-session) "" + (string-append " + user-session =3D " default-user-session)) " + " + ;; Turn autologin ON if autologin-user is set + (if (string-null? autologin-user) "" + (string-append " + autologin-user =3D " autologin-user " + autologin-session =3D " default-user-session)) " + " (string-join extra-config "\n")))) + + +(define-record-type* + 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/xgree= ters"))) + (remote-sessions-directories lightdm-configuration-remote-sessions-direc= tories + (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 + (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 =3D lightdm +greeters-directory =3D " #~(string-join '#$greeters-directories ":") " +sessions-directory =3D " (string-join sessions-directories ":") " +remote-sessions-directory =3D " (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 (=3D uid (stat:uid st))) + (not (=3D 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 >=3D 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 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=3D" #$lightdm-paths))))) + (stop #~(make-kill-destructor))))) + +;; LightDM Aggregate + +(define-record-type* + 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} fiel= d." + (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 agg= regate))))) + (service-extension profile-service-type + (lambda (aggregate) + (concatenate (map lightdm-greeter-profile-service + (lightdm-aggregate-greeters agg= regate))))) + ;; 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) (ca= r 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 defaul= t one. + ;; Also, add greeters' desktop directories to greeters-dir= ectories. + (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-greete= r 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.")))) --=20 2.26.2 --=-=-=--