unofficial mirror of guix-patches@gnu.org 
 help / color / mirror / code / Atom feed
From: muradm <mail@muradm.net>
To: 75270@debbugs.gnu.org
Cc: "Ludovic Courtès" <ludo@gnu.org>,
	"Maxim Cournoyer" <maxim.cournoyer@gmail.com>
Subject: [bug#75270] [PATCH v2 1/3] services: greetd: Improve greeter configurations.
Date: Sat,  4 Jan 2025 19:58:41 +0300	[thread overview]
Message-ID: <a30ec51224da27d0887de636c8fd1a83ca3ba63d.1736009605.git.mail@muradm.net> (raw)
In-Reply-To: <cover.1736009605.git.mail@muradm.net>

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 its 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 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-color>): New record, `wlgreet` color holder.
(<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: Id957801bd67d24281bea6b3c554a8853f7cb55e3
---
 doc/guix.texi         | 115 ++++++++++++------
 gnu/services/base.scm | 276 +++++++++++++++++++++++-------------------
 gnu/tests/desktop.scm |  14 ++-
 3 files changed, 240 insertions(+), 165 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 924f13f0f6..6d0c349b1a 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -20510,13 +20510,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 '())
+                      (extra-env '(("MY_VAR" . "1")))
+                      (xdg-env? #f))))))
                 ;; we can use any other executable command as greeter
                 (greetd-terminal-configuration
                  (terminal-vt "4")
@@ -20584,19 +20592,20 @@ 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. User should prefer stable shell command like @code{bash},
+which can start actual user terminal shell, window manager or desktop environment
+with its own mechanism, which would be @code{~/.bashrc} in case of @code{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.
 
@@ -20606,6 +20615,10 @@ 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}. User environment may
+adapt depending on its value (normaly by @code{.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
@@ -20614,60 +20627,86 @@ Base Services
 @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{/bin/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{/bin/agreety} on successful login.
+Normally should be a variation of @code{greetd-user-session}, but could
+be any @code{gexp->script} like object.
 
-@item @code{command-args} (default: @code{'()})
-Command arguments to pass to command.
+@end table
+@end deftp
+
+@deftp {Data Type} greetd-wlgreet-color
+
+@table @asis
+@item @code{red}
+Value of red.
+
+@item @code{green}
+Value of green.
+
+@item @code{blue}
+Value of blue.
+
+@item @code{opacity}
+Value of opacity.
+
+@end table
+@end deftp
+
+@deftp {Data Type} greetd-wlgreet-configuration
 
+@table @asis
 @item @code{output-mode} (default: @code{"all"})
 Option to use for @code{outputMode} in the TOML configuration file.
 
 @item @code{scale} (default: @code{1})
 Option to use for @code{scale} in the TOML configuration file.
 
-@item @code{background} (default: @code{'(0 0 0 0.9)})
+@item @code{background} (default: @code{(greetd-wlgreet-color (red 0) (green 0) (blue 0) (opacity 0.9))})
 RGBA list to use as the background colour of the login prompt.
 
-@item @code{headline} (default: @code{'(1 1 1 1)})
+@item @code{headline} (default: @code{(greetd-wlgreet-color (red 1) (green 1) (blue 1) (opacity 1))})
 RGBA list to use as the headline colour of the UI popup.
 
-@item @code{prompt} (default: @code{'(1 1 1 1)})
+@item @code{prompt} (default: @code{(greetd-wlgreet-color (red 1) (green 1) (blue 1) (opacity 1))})
 RGBA list to use as the prompt colour of the UI popup.
 
-@item @code{prompt-error} (default: @code{'(1 1 1 1)})
+@item @code{prompt-error} (default: @code{(greetd-wlgreet-color (red 1) (green 1) (blue 1) (opacity 1))})
 RGBA list to use as the error colour of the UI popup.
 
-@item @code{border} (default: @code{'(1 1 1 1)})
+@item @code{border} (default: @code{(greetd-wlgreet-color (red 1) (green 1) (blue 1) (opacity 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
 
 @deftp {Data Type} greetd-wlgreet-sway-session
-Sway-specific configuration record for the wlgreet greetd greeter.
+Configuration record for the in sway wlgreet greetd greeter.
 
 @table @asis
-@item @code{wlgreet-session} (default: @code{(greetd-wlgreet-session)})
-A @code{greetd-wlgreet-session} record for generic wlgreet configuration,
-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 with @command{/bin/sway} and @command{/bin/swaymsg} commands.
 
-@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{sway-config} (default: @code{(plain-file "greetd-wlgreet-sway-config" "")})
+Extra configuration for sway to be included before executing greeter.
+
+@item @code{wlgreet} (default: @code{wlgreet})
+The package with the @command{/bin/wlgreet} command.
+
+@item @code{wlgreet-config} (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{/bin/agreety} on successful login.
+Normally should be a variation of @code{greetd-user-session}, but could
+be any @code{gexp->script} like object.
 
 @end table
 
@@ -20675,8 +20714,7 @@ Base Services
 
 @lisp
   (greetd-configuration
-   ;; We need to give the greeter user these permissions, otherwise
-   ;; Sway will crash on launch.
+   ;; Graphical greeter require additional group membership.
    (greeter-supplementary-groups (list "video" "input" "seat"))
    (terminals
     (list (greetd-terminal-configuration
@@ -20685,7 +20723,10 @@ Base Services
            (default-session-command
             (greetd-wlgreet-sway-session
              (sway-configuration
-              (local-file "sway-greetd.conf"))))))))
+              (local-file "sway-greetd.conf")) ;; optional extra sway configuration
+             (command
+              (greetd-user-session
+               (xdg-session-type "wayland")))))))))
 @end lisp
 @end deftp
 
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 75ce4e8fe5..4105da6c05 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-color
+            greetd-wlgreet-configuration
             greetd-wlgreet-sway-session
 
             %base-services))
@@ -3381,161 +3383,177 @@ (define %qemu-static-networking
 ;;; greetd-service-type -- minimal and flexible login manager daemon
 ;;;
 
-(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>
+(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
-     "agreety-tty-session-command"
+     "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 (greetd-agreety-tty-xdg-session-command config)
-  (match-record config <greetd-agreety-session>
-    (command command-args extra-env)
+(define (make-greetd-xdg-user-session-command config)
+  (match-record config <greetd-user-session>
+    (command command-args extra-env xdg-session-type)
     (program-file
-     "agreety-tty-xdg-session-command"
+     "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" "tty")
+           (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 (greetd-user-session))))
+
 (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) "/bin/agreety"))
+        (command (greetd-agreety-command session)))
     (lower-object
-     (program-file "agreety-command"
-       #~(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))
-  (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)
-  (match color
-    ((red green blue opacity)
-     (string-append
-      "[" section-name "]\n"
-      "red = " (number->string red) "\n"
-      "green = " (number->string green) "\n"
-      "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)))))))
+     (program-file "agreety-wrapper" #~(execl #$agreety #$agreety "-c" #$command)))))
+
+(define (make-greetd-sway-greeter-command sway sway-config)
+  (let ((sway-bin (file-append sway "/bin/sway")))
+    (program-file
+     "greeter-sway-command"
+     #~(begin
+         (let* ((username (getenv "USER"))
+                (useruid (passwd:uid (getpwuid username)))
+                (useruid (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-xdg-runtime-dir "/" log-file)))
+           (for-each (lambda (dir) (mkdir dir #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-color>
+  greetd-wlgreet-color make-greetd-wlgreet-color greetd-wlgreet-color?
+  (red greetd-wlgreet-color-red)
+  (green greetd-wlgreet-color-green)
+  (blue greetd-wlgreet-color-blue)
+  (opacity greetd-wlgreet-color-opacity))
+
+(define (greetd-wlgreet-color-for-section section-name color)
+  (match-record color <greetd-wlgreet-color>
+    (red green blue opacity)
+    (string-append
+     "[" section-name "]\n"
+     "red = " (number->string red) "\n"
+     "green = " (number->string green) "\n"
+     "blue = " (number->string blue) "\n"
+     "opacity = " (number->string opacity) "\n")))
+
+(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 (greetd-wlgreet-color (red 0) (green 0) (blue 0) (opacity 0.9))))
+  (headline greetd-wlgreet-configuration-headline
+            (default (greetd-wlgreet-color (red 1) (green 1) (blue 1) (opacity 1))))
+  (prompt greetd-wlgreet-configuration-prompt
+          (default (greetd-wlgreet-color (red 1) (green 1) (blue 1) (opacity 1))))
+  (prompt-error greetd-wlgreet-configuration-prompt-error
+                (default (greetd-wlgreet-color (red 1) (green 1) (blue 1) (opacity 1))))
+  (border greetd-wlgreet-configuration-border
+          (default (greetd-wlgreet-color (red 1) (green 1) (blue 1) (opacity 1)))))
+
+(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)
+                    (greetd-wlgreet-color-for-section 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-config greetd-wlgreet-sway-session-sway-config
+               (default (plain-file "greetd-wlgreet-sway-config" "")))
+  (wlgreet greetd-wlgreet-sway-session-wlgreet (default wlgreet))
+  (wlgreet-config greetd-wlgreet-sway-session-wlgreet-config
+                  (default (greetd-wlgreet-configuration)))
+  (command greetd-wlgreet-sway-session-command (default (greetd-user-session))))
+
+(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"
+        "include " sway-config "\n"
+        "xwayland disable\n"
+        "exec \"" wlgreet-bin " --config " wlgreet-config-file "; " swaymsg-bin " exit\"\n")))))
 
 (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)))
+  (match-record session <greetd-wlgreet-sway-session>
+    (sway)
     (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))))))
+     (make-greetd-sway-greeter-command
+      sway
+      (make-greetd-wlgreet-sway-session-sway-config session)))))
 
 (define-record-type* <greetd-terminal-configuration>
   greetd-terminal-configuration make-greetd-terminal-configuration
@@ -3613,7 +3631,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
@@ -3663,6 +3682,12 @@ (define (greetd-pam-service config)
                              (list optional-pam-mount))))
            pam))))))
 
+(define (greetd-run-user-activation config)
+  #~(begin
+      (let ((directory "/run/user"))
+        (mkdir directory #o755)
+        (chmod directory #o755))))
+
 (define (greetd-shepherd-services config)
   (map
    (lambda (tc)
@@ -3694,6 +3719,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 ef30442886..1693bbcebf 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 '())
+                      (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





  reply	other threads:[~2025-01-04 16:59 UTC|newest]

Thread overview: 14+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
     [not found] <87jzbar8oa.fsf@muradm.net>
2025-01-01 22:47 ` [bug#75270] [PATCH 0/3] services: greetd: Improve greeter configurations muradm
2025-01-01 22:53   ` [bug#75270] [PATCH 1/3] " muradm
2025-01-03 13:23     ` Nicolas Graves via Guix-patches via
2025-01-03 17:08       ` muradm
2025-01-04 10:57         ` Nicolas Graves via Guix-patches via
2025-01-04 13:36           ` muradm
2025-01-01 22:53   ` [bug#75270] [PATCH 2/3] gnu: Add gtkgreet muradm
2025-01-01 22:53   ` [bug#75270] [PATCH 3/3] services: greetd: Add new gtkgreet greeter muradm
2025-01-03 11:34   ` [bug#75270] [PATCH 0/3] services: greetd: Improve greeter configurations muradm
2025-01-04 16:14   ` [bug#75270] Fwd: [bug#75270] [PATCH 1/3] " Nicolas Graves via Guix-patches via
2025-01-04 16:58   ` [bug#75270] [PATCH v2 0/3] " muradm
2025-01-04 16:58     ` muradm [this message]
2025-01-04 16:58     ` [bug#75270] [PATCH v2 2/3] gnu: Add gtkgreet muradm
2025-01-04 16:58     ` [bug#75270] [PATCH v2 3/3] services: greetd: Add new gtkgreet greeter muradm

Reply instructions:

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

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

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

  List information: https://guix.gnu.org/

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

  git send-email \
    --in-reply-to=a30ec51224da27d0887de636c8fd1a83ca3ba63d.1736009605.git.mail@muradm.net \
    --to=mail@muradm.net \
    --cc=75270@debbugs.gnu.org \
    --cc=ludo@gnu.org \
    --cc=maxim.cournoyer@gmail.com \
    /path/to/YOUR_REPLY

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

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

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

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).