Package: guix-patches;
Reported by: muradm <mail <at> muradm.net>
Date: Wed, 1 Jan 2025 22:49:02 UTC
Severity: normal
Tags: patch
Done: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
Bug is archived. No further changes may be made.
Message #122 received at 75270 <at> debbugs.gnu.org (full text, mbox):
From: muradm <mail <at> muradm.net> To: 75270 <at> debbugs.gnu.org, Maxim Cournoyer <maxim.cournoyer <at> gmail.com> Subject: [PATCH v5 1/3] services: greetd: Improve greeter configurations. Date: Mon, 3 Feb 2025 01:54:21 +0300
This improvement focuses on providing common user session scripts
for use by multiple greeters. Now user session entry point is
factored out into `<greetd-user-session>`, which can be reused
as is with different greeters. By default it uses `bash` as
first user process. Then user normally starts additional programs
with `.profile` or `.bashrc`. Using `command`, `command-args` and
`extra-env` one can specify something else, which could be
`dbus-session` wrapped process, some desktop environment or else.
While the above is possible, one is still encouraged to use
`.bashrc`, `.profile` or similar.
It also fixes incorrect use of `XDG_RUNTIME_DIR` for `wlgreet`.
`wlgreet` requires a compositor to run. We provide common sway based
greeter script, which can be shared by other graphical greeters.
* gnu/services/base.scm (<greetd-user-session>): Common user session
factored out, for shared use by multiple greeters.
(<greetd-agreety-session>): Switch to common user session.
(<greetd-wlgreet-configuration>): Refactor `wlgreet` configuration.
(<greetd-wlgreet-sway-session>): Switch to common user session.
* gnu/tests/desktop.scm (%minimal-services): Reflect configuration
changes.
* doc/guix.texi (Base Services): Document refactoring changes.
Change-Id: Ibfd79e71a97b0d7fb4a866138d501236b9646ca4
---
doc/guix.texi | 77 +++++---
gnu/services/base.scm | 430 +++++++++++++++++++++++++++++-------------
gnu/tests/desktop.scm | 14 +-
3 files changed, 360 insertions(+), 161 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index bb5f29277fb..c60ad4f216b 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -20512,13 +20512,21 @@ Base Services
(terminal-vt "2")
(default-session-command
(greetd-agreety-session
- (extra-env '(("MY_VAR" . "1")))
- (xdg-env? #f))))
+ (command
+ (greetd-user-session
+ (extra-env '(("MY_VAR" . "1")))
+ (xdg-env? #f))))))
;; we can use different shell instead of default bash
(greetd-terminal-configuration
(terminal-vt "3")
(default-session-command
- (greetd-agreety-session (command (file-append zsh "/bin/zsh")))))
+ (greetd-agreety-session
+ (command
+ (greetd-user-session
+ (command (file-append zsh "/bin/zsh"))
+ (command-args '("-l"))
+ (extra-env '(("MY_VAR" . "1")))
+ (xdg-env? #f))))))
;; we can use any other executable command as greeter
(greetd-terminal-configuration
(terminal-vt "4")
@@ -20586,21 +20594,23 @@ Base Services
The user to use for running the greeter.
@item @code{default-session-command} (default: @code{(greetd-agreety-session)})
-Can be either instance of @code{greetd-agreety-session} configuration or
+Can be either @code{greetd-agreety-session}, @code{greetd-wlgreet-sway-session} or
@code{gexp->script} like object to use as greeter.
@end table
@end deftp
-@deftp {Data Type} greetd-agreety-session
-Configuration record for the agreety greetd greeter.
+@deftp {Data Type} greetd-user-session
+Configuration record for the user session command. Greeters require user
+command to be specified in some or another way. @code{greetd-user-session}
+provides a common command for that. Users should prefer POSIX shell commands
+like @command{bash}, which can start an actual user terminal shell, window
+manager or desktop environment with its own mechanism, which would
+be @file{~/.bashrc} in case of @command{bash}.
@table @asis
-@item @code{agreety} (default: @code{greetd})
-The package with @command{/bin/agreety} command.
-
@item @code{command} (default: @code{(file-append bash "/bin/bash")})
-Command to be started by @command{/bin/agreety} on successful login.
+Command to be started by @command{agreety} on successful login.
@item @code{command-args} (default: @code{'("-l")})
Command arguments to pass to command.
@@ -20608,27 +20618,36 @@ Base Services
@item @code{extra-env} (default: @code{'()})
Extra environment variables to set on login.
+@item @code{xdg-session-type} (default: @code{"tty"})
+Specify the value of @code{XDG_SESSION_TYPE}. The User environment may
+adapt depending on its value (normally by @file{.bashrc} or similar).
+
@item @code{xdg-env?} (default: @code{#t})
If true @code{XDG_RUNTIME_DIR} and @code{XDG_SESSION_TYPE} will be set
-before starting command. One should note that, @code{extra-env} variables
+before starting command. One should note that, @code{extra-env} variables
are set right after mentioned variables, so that they can be overridden.
@end table
@end deftp
-@deftp {Data Type} greetd-wlgreet-session
-Generic configuration record for the wlgreet greetd greeter.
+@deftp {Data Type} greetd-agreety-session
+Configuration record for the agreety greetd greeter.
@table @asis
-@item @code{wlgreet} (default: @code{wlgreet})
-The package with the @command{/bin/wlgreet} command.
+@item @code{agreety} (default: @code{greetd})
+The package with @command{agreety} command.
-@item @code{command} (default: @code{(file-append sway "/bin/sway")})
-Command to be started by @command{/bin/wlgreet} on successful login.
+@item @code{command} (default: @code{(greetd-user-session)})
+Command to be started by @command{agreety} on successful login, an
+instance of @code{greetd-user-session}.
-@item @code{command-args} (default: @code{'()})
-Command arguments to pass to command.
+@end table
+@end deftp
+
+@deftp {Data Type} greetd-wlgreet-configuration
+Generic configuration record for the wlgreet greetd greeter.
+@table @asis
@item @code{output-mode} (default: @code{"all"})
Option to use for @code{outputMode} in the TOML configuration file.
@@ -20650,9 +20669,6 @@ Base Services
@item @code{border} (default: @code{'(1 1 1 1)})
RGBA list to use as the border colour of the UI popup.
-@item @code{extra-env} (default: @code{'()})
-Extra environment variables to set on login.
-
@end table
@end deftp
@@ -20665,20 +20681,30 @@ Base Services
on top of the Sway-specific @code{greetd-wlgreet-sway-session}.
@item @code{sway} (default: @code{sway})
-The package providing the @command{/bin/sway} command.
+The package providing the @command{sway} command.
@item @code{sway-configuration} (default: #f)
File-like object providing an additional Sway configuration file to be
prepended to the mandatory part of the configuration.
+@item @code{wlgreet} (default: @code{wlgreet})
+The package with the @command{wlgreet} command.
+
+@item @code{wlgreet-configuration} (default: @code{(greetd-wlgreet-configuration)})
+Configuration of @code{wlgreet} represented
+by @code{greetd-wlgreet-configuration}.
+
+@item @code{command} (default: @code{(greetd-user-session)})
+Command to be started by @command{wlgreet} on successful login, an
+instance of @code{greetd-user-session}.
+
@end table
Here is an example of a greetd configuration that uses wlgreet and Sway:
@lisp
(greetd-configuration
- ;; We need to give the greeter user these permissions, otherwise
- ;; Sway will crash on launch.
+ ;; The graphical greeter requires additional group membership.
(greeter-supplementary-groups (list "video" "input" "seat"))
(terminals
(list (greetd-terminal-configuration
@@ -20687,6 +20713,7 @@ Base Services
(default-session-command
(greetd-wlgreet-sway-session
(sway-configuration
+ ;; Optional extra sway configuration.
(local-file "sway-greetd.conf"))))))))
@end lisp
@end deftp
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 7331c030d71..926fc973c8b 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -16,7 +16,7 @@
;;; Copyright © 2021 qblade <qblade <at> protonmail.com>
;;; Copyright © 2021 Hui Lu <luhuins <at> 163.com>
;;; Copyright © 2021, 2022, 2023 Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
-;;; Copyright © 2021 muradm <mail <at> muradm.net>
+;;; Copyright © 2021, 2025 muradm <mail <at> muradm.net>
;;; Copyright © 2022 Guillaume Le Vaillant <glv <at> posteo.net>
;;; Copyright © 2022 Justin Veilleux <terramorpha <at> cock.li>
;;; Copyright © 2022 ( <paren <at> disroot.org>
@@ -274,8 +274,10 @@ (define-module (gnu services base)
greetd-service-type
greetd-configuration
greetd-terminal-configuration
+ greetd-user-session
greetd-agreety-session
- greetd-wlgreet-session
+ greetd-wlgreet-session ; deprecated
+ greetd-wlgreet-configuration
greetd-wlgreet-sway-session
%base-services))
@@ -3393,87 +3395,218 @@ (define %qemu-static-networking
;;; greetd-service-type -- minimal and flexible login manager daemon
;;;
+(define-record-type* <greetd-user-session>
+ greetd-user-session make-greetd-user-session greetd-user-session?
+ (command greetd-user-session-command (default (file-append bash "/bin/bash")))
+ (command-args greetd-user-session-command-args (default '("-l")))
+ (extra-env greetd-user-session-extra-env (default '()))
+ (xdg-session-type greetd-user-session-xdg-session-type (default "tty"))
+ (xdg-env? greetd-user-session-xdg-env? (default #t)))
+
+(define (make-greetd-user-session-command config)
+ (match-record config <greetd-user-session>
+ (command command-args extra-env)
+ (program-file
+ "greetd-user-session-command"
+ #~(begin
+ (use-modules (ice-9 match))
+ (for-each (match-lambda ((var . val) (setenv var val)))
+ (quote (#$@extra-env)))
+ (apply execl #$command #$command (list #$@command-args))))))
+
+(define (make-greetd-xdg-user-session-command config)
+ (match-record config <greetd-user-session>
+ (command command-args extra-env xdg-session-type)
+ (program-file
+ "greetd-xdg-user-session-command"
+ #~(begin
+ (use-modules (ice-9 match))
+ (let* ((username (getenv "USER"))
+ (useruid (passwd:uid (getpwuid username)))
+ (useruid (number->string useruid)))
+ (setenv "XDG_SESSION_TYPE" #$xdg-session-type)
+ (setenv "XDG_RUNTIME_DIR" (string-append "/run/user/" useruid)))
+ (for-each (match-lambda ((var . val) (setenv var val)))
+ (quote (#$@extra-env)))
+ (apply execl #$command #$command (list #$@command-args))))))
+
+(define-gexp-compiler (greetd-user-session-compiler
+ (session <greetd-user-session>)
+ system target)
+ (lower-object
+ ((if (greetd-user-session-xdg-env? session)
+ make-greetd-xdg-user-session-command
+ make-greetd-user-session-command) session)))
+
(define-record-type* <greetd-agreety-session>
- greetd-agreety-session make-greetd-agreety-session
- greetd-agreety-session?
- (agreety greetd-agreety (default greetd))
- (command greetd-agreety-command (default (file-append bash "/bin/bash")))
- (command-args greetd-agreety-command-args (default '("-l")))
- (extra-env greetd-agreety-extra-env (default '()))
- (xdg-env? greetd-agreety-xdg-env? (default #t)))
-
-(define (greetd-agreety-tty-session-command config)
- (match-record config <greetd-agreety-session>
- (command command-args extra-env)
- (program-file
- "agreety-tty-session-command"
- #~(begin
- (use-modules (ice-9 match))
- (for-each (match-lambda ((var . val) (setenv var val)))
- (quote (#$@extra-env)))
- (apply execl #$command #$command (list #$@command-args))))))
-
-(define (greetd-agreety-tty-xdg-session-command config)
- (match-record config <greetd-agreety-session>
- (command command-args extra-env)
- (program-file
- "agreety-tty-xdg-session-command"
- #~(begin
- (use-modules (ice-9 match))
- (let*
- ((username (getenv "USER"))
- (useruid (passwd:uid (getpwuid username)))
- (useruid (number->string useruid)))
- (setenv "XDG_SESSION_TYPE" "tty")
- (setenv "XDG_RUNTIME_DIR" (string-append "/run/user/" useruid)))
- (for-each (match-lambda ((var . val) (setenv var val)))
- (quote (#$@extra-env)))
- (apply execl #$command #$command (list #$@command-args))))))
+ greetd-agreety-session make-greetd-agreety-session greetd-agreety-session?
+ (agreety greetd-agreety-session-agreety (default greetd))
+ (command greetd-agreety-session-command
+ (default (greetd-user-session))
+ (sanitize warn-greetd-agreety-session-command-type))
+ (command-args greetd-agreety-command-args
+ (default #nil)
+ (sanitize warn-deprecated-greetd-agreety-command-args))
+ (extra-env greetd-agreety-extra-env
+ (default #nil)
+ (sanitize warn-deprecated-greetd-agreety-extra-env))
+ (xdg-env? greetd-agreety-xdg-env?
+ (default #nil)
+ (sanitize warn-deprecated-greetd-agreety-xdg-env?)))
+
+(define (warn-deprecated-greetd-agreety-command-args value)
+ (when (not (nil? value))
+ (warn-about-deprecation
+ 'command-args #f
+ #:replacement '<greetd-user-seesion>))
+ value)
+
+(define (warn-deprecated-greetd-agreety-extra-env value)
+ (when (not (nil? value))
+ (warn-about-deprecation
+ 'extra-env #f
+ #:replacement '<greetd-user-seesion>))
+ value)
+
+(define (warn-deprecated-greetd-agreety-xdg-env? value)
+ (when (not (nil? value))
+ (warn-about-deprecation
+ 'xdg-env? #f
+ #:replacement '<greetd-user-seesion>))
+ value)
+
+(define-deprecated/alias greetd-agreety greetd-agreety-session-agreety)
+(define-deprecated/alias greetd-agreety-command greetd-agreety-session-command)
+
+(define (warn-greetd-agreety-session-command-type value)
+ (when (not (greetd-user-session? value))
+ (warn-about-deprecation
+ "arbitrary command" #f
+ #:replacement '<greetd-user-seesion>))
+ value)
+
+(define (greetd-agreety-session-to-user-session session default-command)
+ (let ((command (greetd-agreety-session-command session))
+ (command-args (or (greetd-agreety-command-args session)
+ (greetd-user-session-command-args default-command)))
+ (extra-env (or (greetd-agreety-extra-env session)
+ (greetd-user-session-extra-env default-command)))
+ (xdg-env? (or (greetd-agreety-xdg-env? session)
+ (greetd-user-session-xdg-env? default-command))))
+ (greetd-user-session
+ (command command)
+ (command-args command-args)
+ (extra-env extra-env)
+ (xdg-env? xdg-env?))))
(define-gexp-compiler (greetd-agreety-session-compiler
(session <greetd-agreety-session>)
system target)
- (let ((agreety (file-append (greetd-agreety session)
- "/bin/agreety"))
- (command ((if (greetd-agreety-xdg-env? session)
- greetd-agreety-tty-xdg-session-command
- greetd-agreety-tty-session-command)
- session)))
+ (let* ((agreety
+ (file-append (greetd-agreety-session-agreety session) "/bin/agreety"))
+ (command
+ (greetd-agreety-session-command session))
+ (command
+ (if (greetd-user-session? command)
+ command
+ (greetd-agreety-session-to-user-session
+ session
+ (greetd-user-session)))))
(lower-object
- (program-file "agreety-command"
- #~(execl #$agreety #$agreety "-c" #$command)))))
+ (program-file
+ "agreety-wrapper"
+ #~(execl #$agreety #$agreety "-c" #$command)))))
-(define-record-type* <greetd-wlgreet-session>
- greetd-wlgreet-session make-greetd-wlgreet-session
- greetd-wlgreet-session?
- (wlgreet greetd-wlgreet (default wlgreet))
+(define (make-greetd-sway-greeter-command sway sway-config)
+ (let ((sway-bin (file-append sway "/bin/sway")))
+ (program-file
+ "greeter-sway-command"
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (use-modules (guix build utils))
+
+ (let* ((username (getenv "USER"))
+ (user (getpwnam username))
+ (useruid (passwd:uid user))
+ (usergid (passwd:gid user))
+ (useruid-s (number->string useruid))
+ ;; /run/user/<greeter-user-uid> won't exist yet
+ ;; this will contain WAYLAND_DISPLAY socket file
+ ;; and log-file below
+ (user-home-dir "/tmp/.greeter-home")
+ (user-xdg-runtime-dir (string-append user-home-dir "/run"))
+ (user-xdg-cache-dir (string-append user-home-dir "/cache"))
+ (log-file (string-append (number->string (getpid)) ".log"))
+ (log-file (string-append user-home-dir "/" log-file)))
+ (for-each (lambda (d)
+ (mkdir-p d)
+ (chown d useruid usergid) (chmod d #o700))
+ (list user-home-dir
+ user-xdg-runtime-dir
+ user-xdg-cache-dir))
+ (setenv "HOME" user-home-dir)
+ (setenv "XDG_CACHE_DIR" user-xdg-cache-dir)
+ (setenv "XDG_RUNTIME_DIR" user-xdg-runtime-dir)
+ (sleep 1) ;; give time to elogind or seatd
+ (dup2 (open-fdes log-file
+ (logior O_CREAT O_WRONLY O_APPEND) #o640) 1)
+ (dup2 1 2)
+ (execl #$sway-bin #$sway-bin "-d" "-c" #$sway-config)))))))
+
+(define-record-type* <greetd-wlgreet-configuration>
+ greetd-wlgreet-configuration make-greetd-wlgreet-configuration
+ greetd-wlgreet-configuration?
+ (output-mode greetd-wlgreet-configuration-output-mode (default "all"))
+ (scale greetd-wlgreet-configuration-scale (default 1))
+ (background greetd-wlgreet-configuration-background (default '(0 0 0 0.9)))
+ (headline greetd-wlgreet-configuration-headline (default '(1 1 1 1)))
+ (prompt greetd-wlgreet-configuration-prompt (default '(1 1 1 1)))
+ (prompt-error greetd-wlgreet-configuration-prompt-error (default '(1 1 1 1)))
+ (border greetd-wlgreet-configuration-border (default '(1 1 1 1)))
+ (wlgreet greetd-wlgreet
+ (default #nil)
+ (sanitize warn-deprecated-greetd-wlgreet))
(command greetd-wlgreet-command
- (default (file-append sway "/bin/sway")))
- (command-args greetd-wlgreet-command-args (default '()))
- (output-mode greetd-wlgreet-output-mode (default "all"))
- (scale greetd-wlgreet-scale (default 1))
- (background greetd-wlgreet-background (default '(0 0 0 0.9)))
- (headline greetd-wlgreet-headline (default '(1 1 1 1)))
- (prompt greetd-wlgreet-prompt (default '(1 1 1 1)))
- (prompt-error greetd-wlgreet-prompt-error (default '(1 1 1 1)))
- (border greetd-wlgreet-border (default '(1 1 1 1)))
- (extra-env greetd-wlgreet-extra-env (default '())))
-
-(define (greetd-wlgreet-wayland-session-command session)
- (program-file "wlgreet-session-command"
- #~(let* ((username (getenv "USER"))
- (useruid (number->string
- (passwd:uid (getpwuid username))))
- (command #$(greetd-wlgreet-command session)))
- (use-modules (ice-9 match))
- (setenv "XDG_SESSION_TYPE" "wayland")
- (setenv "XDG_RUNTIME_DIR" (string-append "/run/user/" useruid))
- (for-each (lambda (env) (setenv (car env) (cdr env)))
- '(#$@(greetd-wlgreet-extra-env session)))
- (apply execl command command
- (list #$@(greetd-wlgreet-command-args session))))))
-
-(define (make-wlgreet-config-color section-name color)
+ (default #nil)
+ (sanitize warn-deprecated-greetd-wlgreet-command))
+ (command-args greetd-wlgreet-command-args
+ (default #nil)
+ (sanitize warn-deprecated-greetd-wlgreet-command-args))
+ (extra-env greetd-wlgreet-extra-env
+ (default #nil)
+ (sanitize warn-deprecated-greetd-wlgreet-extra-env)))
+
+(define-deprecated/alias greetd-wlgreet-session greetd-wlgreet-configuration)
+
+(define (warn-deprecated-greetd-wlgreet value)
+ (when (not (nil? value))
+ (warn-about-deprecation
+ 'wlgreet #f
+ #:replacement '<greetd-wlgreet-sway-session>))
+ value)
+
+(define (warn-deprecated-greetd-wlgreet-command value)
+ (when (not (nil? value))
+ (warn-about-deprecation
+ 'command #f
+ #:replacement '<greetd-wlgreet-sway-session>))
+ value)
+
+(define (warn-deprecated-greetd-wlgreet-command-args value)
+ (when (not (nil? value))
+ (warn-about-deprecation
+ 'command-args #f
+ #:replacement '<greetd-wlgreet-sway-session>))
+ value)
+
+(define (warn-deprecated-greetd-wlgreet-extra-env value)
+ (when (not (nil? value))
+ (warn-about-deprecation
+ 'extra-env #f
+ #:replacement '<greetd-wlgreet-sway-session>))
+ value)
+
+(define (make-greetd-wlgreet-config-color section-name color)
(match color
((red green blue opacity)
(string-append
@@ -3483,71 +3616,97 @@ (define (make-wlgreet-config-color section-name color)
"blue = " (number->string blue) "\n"
"opacity = " (number->string opacity) "\n"))))
-(define (make-wlgreet-configuration-file session)
- (let ((command (greetd-wlgreet-wayland-session-command session))
- (output-mode (greetd-wlgreet-output-mode session))
- (scale (greetd-wlgreet-scale session))
- (background (greetd-wlgreet-background session))
- (headline (greetd-wlgreet-headline session))
- (prompt (greetd-wlgreet-prompt session))
- (prompt-error (greetd-wlgreet-prompt-error session))
- (border (greetd-wlgreet-border session)))
- (mixed-text-file "wlgreet.toml"
- "command = \"" command "\"\n"
- "outputMode = \"" output-mode "\"\n"
- "scale = " (number->string scale) "\n"
- (apply string-append
- (map (match-lambda
- ((section-name . color)
- (make-wlgreet-config-color section-name color)))
- `(("background" . ,background)
- ("headline" . ,headline)
- ("prompt" . ,prompt)
- ("prompt-error" . ,prompt-error)
- ("border" . ,border)))))))
+(define (make-greetd-wlgreet-config command color)
+ (match-record color <greetd-wlgreet-configuration>
+ (output-mode scale background headline prompt prompt-error border)
+ (mixed-text-file
+ "wlgreet.toml"
+ "command = \"" command "\"\n"
+ "outputMode = \"" output-mode "\"\n"
+ "scale = " (number->string scale) "\n"
+ (apply string-append
+ (map (match-lambda
+ ((section-name . color)
+ (make-greetd-wlgreet-config-color section-name color)))
+ `(("background" . ,background)
+ ("headline" . ,headline)
+ ("prompt" . ,prompt)
+ ("prompt-error" . ,prompt-error)
+ ("border" . ,border)))))))
(define-record-type* <greetd-wlgreet-sway-session>
greetd-wlgreet-sway-session make-greetd-wlgreet-sway-session
greetd-wlgreet-sway-session?
- (wlgreet-session greetd-wlgreet-sway-session-wlgreet-session ;<greetd-wlgreet-session>
- (default (greetd-wlgreet-session)))
- (sway greetd-wlgreet-sway-session-sway (default sway)) ;<package>
- (sway-configuration greetd-wlgreet-sway-session-sway-configuration ;file-like
- (default (plain-file "wlgreet-sway-config" ""))))
-
-(define (make-wlgreet-sway-configuration-file session)
- (let* ((wlgreet-session (greetd-wlgreet-sway-session-wlgreet-session session))
- (wlgreet-config (make-wlgreet-configuration-file wlgreet-session))
- (wlgreet (file-append (greetd-wlgreet wlgreet-session) "/bin/wlgreet"))
- (sway-config (greetd-wlgreet-sway-session-sway-configuration session))
- (swaymsg (file-append (greetd-wlgreet-sway-session-sway session)
- "/bin/swaymsg")))
- (mixed-text-file "wlgreet-sway.conf"
- "include " sway-config "\n"
- "xwayland disable\n"
- "exec \"" wlgreet " --config " wlgreet-config "; "
- swaymsg " exit\"\n")))
+ (sway greetd-wlgreet-sway-session-sway (default sway))
+ (sway-configuration greetd-wlgreet-sway-session-sway-configuration
+ (default #f))
+ (wlgreet greetd-wlgreet-sway-session-wlgreet (default wlgreet))
+ (wlgreet-configuration greetd-wlgreet-sway-session-wlgreet-configuration
+ (default (greetd-wlgreet-configuration)))
+ (command greetd-wlgreet-sway-session-command (default (greetd-user-session)))
+ (wlgreet-session
+ greetd-wlgreet-sway-session-wlgreet-session
+ (default #nil)
+ (sanitize warn-deprecated-greetd-wlgreet-sway-session-wlgreet-session)))
+
+(define (warn-deprecated-greetd-wlgreet-sway-session-wlgreet-session value)
+ (when (not (nil? value))
+ (warn-about-deprecation
+ 'wlgreet-session #f
+ #:replacement 'wlgreet-configuration))
+ value)
+
+(define make-greetd-wlgreet-sway-session-sway-config
+ (match-lambda
+ (($ <greetd-wlgreet-sway-session>
+ sway sway-config wlgreet wlgreet-config command)
+ (let ((wlgreet-bin (file-append wlgreet "/bin/wlgreet"))
+ (wlgreet-config-file
+ (make-greetd-wlgreet-config command wlgreet-config))
+ (swaymsg-bin (file-append sway "/bin/swaymsg")))
+ (mixed-text-file
+ "wlgreet-sway-config"
+ (if sway-config "include " "")
+ (if sway-config sway-config "")
+ (if sway-config "\n" "")
+ "xwayland disable\n"
+ "exec \"" wlgreet-bin " --config " wlgreet-config-file
+ "; " swaymsg-bin " exit\"\n")))))
+
+(define (greetd-wlgreet-session-to-config session config)
+ (let* ((wlgreet (or (greetd-wlgreet config)
+ (greetd-wlgreet-sway-session-wlgreet session)))
+ (default-command (greetd-wlgreet-sway-session-command session))
+ (command (or (greetd-wlgreet-command config)
+ (greetd-user-session-command default-command)))
+ (command-args (or (greetd-wlgreet-command-args config)
+ (greetd-user-session-command-args default-command)))
+ (extra-env (or (greetd-wlgreet-extra-env config)
+ (greetd-user-session-extra-env default-command))))
+ (greetd-wlgreet-sway-session
+ (sway (greetd-wlgreet-sway-session-sway session))
+ (sway-configuration (greetd-wlgreet-sway-session-sway-configuration session))
+ (wlgreet wlgreet)
+ (wlgreet-configuration config)
+ (command
+ (greetd-user-session
+ (command command)
+ (command-args command-args)
+ (extra-env extra-env))))))
(define-gexp-compiler (greetd-wlgreet-sway-session-compiler
(session <greetd-wlgreet-sway-session>)
system target)
- (let ((sway (file-append (greetd-wlgreet-sway-session-sway session)
- "/bin/sway"))
- (config (make-wlgreet-sway-configuration-file session)))
- (lower-object
- (program-file "wlgreet-sway-session-command"
- #~(let* ((log-file (open-output-file
- (string-append "/tmp/sway-greeter."
- (number->string (getpid))
- ".log")))
- (username (getenv "USER"))
- (useruid (number->string (passwd:uid (getpwuid username)))))
- ;; redirect stdout/err to log-file
- (dup2 (fileno log-file) 1)
- (dup2 1 2)
- (sleep 1) ;give seatd/logind some time to start up
- (setenv "XDG_RUNTIME_DIR" (string-append "/run/user/" useruid))
- (execl #$sway #$sway "-d" "-c" #$config))))))
+ (let ((s (if (nil? (greetd-wlgreet-sway-session-wlgreet-session session))
+ session
+ (greetd-wlgreet-session-to-config
+ session
+ (greetd-wlgreet-sway-session-wlgreet-session session)))))
+ (match-record s <greetd-wlgreet-sway-session> (sway)
+ (lower-object
+ (make-greetd-sway-greeter-command
+ sway
+ (make-greetd-wlgreet-sway-session-sway-config s))))))
(define-record-type* <greetd-terminal-configuration>
greetd-terminal-configuration make-greetd-terminal-configuration
@@ -3625,7 +3784,8 @@ (define (greetd-accounts config)
(name "greeter")
(group "greeter")
(supplementary-groups (greetd-greeter-supplementary-groups config))
- (system? #t))))
+ (system? #t)
+ (create-home-directory? #f))))
(define (make-greetd-pam-mount-conf-file config)
(computed-file
@@ -3675,6 +3835,9 @@ (define (greetd-pam-service config)
(list optional-pam-mount))))
pam))))))
+(define (greetd-run-user-activation config)
+ #~(let ((d "/run/user")) (mkdir d #o755) (chmod d #o755)))
+
(define (greetd-shepherd-services config)
(map
(lambda (tc)
@@ -3706,6 +3869,7 @@ (define greetd-service-type
(list
(service-extension account-service-type greetd-accounts)
(service-extension file-system-service-type (const %greetd-file-systems))
+ (service-extension activation-service-type greetd-run-user-activation)
(service-extension etc-service-type greetd-etc-service)
(service-extension pam-root-service-type greetd-pam-service)
(service-extension shepherd-root-service-type greetd-shepherd-services)))
diff --git a/gnu/tests/desktop.scm b/gnu/tests/desktop.scm
index 1c32076ccb2..3f861b253b0 100644
--- a/gnu/tests/desktop.scm
+++ b/gnu/tests/desktop.scm
@@ -141,13 +141,21 @@ (define %minimal-services
(terminal-vt "2")
(default-session-command
(greetd-agreety-session
- (extra-env '(("MY_VAR" . "1")))
- (xdg-env? #f))))
+ (command
+ (greetd-user-session
+ (extra-env '(("MY_VAR" . "1")))
+ (xdg-env? #f))))))
;; we can use different shell instead of default bash
(greetd-terminal-configuration
(terminal-vt "3")
(default-session-command
- (greetd-agreety-session (command (file-append zsh "/bin/zsh")))))
+ (greetd-agreety-session
+ (command
+ (greetd-user-session
+ (command (file-append zsh "/bin/zsh"))
+ (command-args '("-l"))
+ (extra-env '(("MY_VAR" . "1")))
+ (xdg-env? #f))))))
;; we can use any other executable command as greeter
(greetd-terminal-configuration
(terminal-vt "4")
--
2.47.1
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.