[bug#75270,v5,1/3] services: greetd: Improve greeter configurations.

Message ID 81ca14e1ce416e71e56593e5dcb75fc50699eaca.1738536455.git.mail@muradm.net
State New
Headers
Series [bug#75270,v5,1/3] services: greetd: Improve greeter configurations. |

Commit Message

muradm Feb. 2, 2025, 10:54 p.m. UTC
  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(-)
  

Comments

Maxim Cournoyer Feb. 5, 2025, 5:27 a.m. UTC | #1
Hi again!

muradm <mail@muradm.net> writes:

[...]

> +@item @code{xdg-session-type} (default: @code{"tty"})
> +Specify the value of @code{XDG_SESSION_TYPE}.  The User environment may

s/User/user/

[...]

> +(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))))))

Please break long lines under 80 chars.

> +
> +(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))))))

Please break long lines under 80 chars.

[...]

> +  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))

#nil.  Interesting, I had never used it.  You should use 'unless' here
instead of 'when ... not' though.

> +    (warn-about-deprecation

Despite being public, this particular deprecation procedure is not the
best, as it deosn't handle the source location itself.  I've tested the
following successfully:

> +     'command-args #f
> +     #:replacement '<greetd-user-seesion>))
> +  value)

There's a typo, here and for the other deprecation procedures:
s/seesion/session/

Ideally deprecation warns and the configuration records are
automatically rewritten to the modern equivalent in the code, which
means only one code path in the service exists for one given option, but
I don't think that's possible here given the new command record replaces
multiple fields, so OK.  I couldn't find a way to preserve the syntax
source info too, in my quick experiment.

[...]

> +(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)))
> +  (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))

Line width > 80 :-)

Part from these nitpicks:

Reviewed-by: Maxim Cournoyer <maxim.cournoyer@gmail>
  

Patch

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@protonmail.com>
 ;;; Copyright © 2021 Hui Lu <luhuins@163.com>
 ;;; Copyright © 2021, 2022, 2023 Maxim Cournoyer <maxim.cournoyer@gmail.com>
-;;; Copyright © 2021 muradm <mail@muradm.net>
+;;; Copyright © 2021, 2025 muradm <mail@muradm.net>
 ;;; Copyright © 2022 Guillaume Le Vaillant <glv@posteo.net>
 ;;; Copyright © 2022 Justin Veilleux <terramorpha@cock.li>
 ;;; Copyright © 2022 ( <paren@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")