Toggle diff (252 lines)
diff --git a/doc/guix.texi b/doc/guix.texi
index c21235f28d..0203685f82 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -106,6 +106,7 @@ Copyright @copyright{} 2022 Philip M@sup{c}Grath@*
Copyright @copyright{} 2022 Karl Hallsby@*
Copyright @copyright{} 2022 Justin Veilleux@*
Copyright @copyright{} 2022 Reily Siegel@*
+Copyright @copyright{} 2022 (@*
Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.3 or
@@ -18633,6 +18634,81 @@ are set right after mentioned variables, so that they can be overriden.
@end table
@end deftp
+@deftp {Data Type} greetd-wlgreet-session
+Generic configuration record for the wlgreet greetd greeter.
+
+@table @asis
+@item @code{wlgreet} (default: @code{wlgreet})
+The package with the @command{/bin/wlgreet} 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-args} (default: @code{'()})
+Command arguments to pass to command.
+
+@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)})
+RGBA list to use as the background colour of the login prompt.
+
+@item @code{headline} (default: @code{'(1 1 1 1)})
+RGBA list to use as the headline colour of the UI popup.
+
+@item @code{prompt} (default: @code{'(1 1 1 1)})
+RGBA list to use as the prompt colour of the UI popup.
+
+@item @code{prompt-error} (default: @code{'(1 1 1 1)})
+RGBA list to use as the error colour of the UI popup.
+
+@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
+
+@deftp {Data Type} greetd-wlgreet-sway-session
+Sway-specific configuration record for the 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.
+
+@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.
+
+@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.
+ (greeter-supplementary-groups (list "video" "input" "seat"))
+ (terminals
+ (list (greetd-terminal-configuration
+ (terminal-vt "1")
+ (terminal-switch #t)
+ (default-session-command
+ (greetd-wlgreet-sway-session
+ (sway-configuration
+ (local-file "sway-greetd.conf"))))))))
+@end lisp
+@end deftp
+
@node Scheduled Job Execution
@subsection Scheduled Job Execution
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 616bc42e69..16c4b1f533 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -19,6 +19,7 @@
;;; Copyright © 2021 muradm <mail@muradm.net>
;;; Copyright © 2022 Guillaume Le Vaillant <glv@posteo.net>
;;; Copyright © 2022 Justin Veilleux <terramorpha@cock.li>
+;;; Copyright © 2022 ( <paren@disroot.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -66,6 +67,7 @@ (define-module (gnu services base)
#:use-module ((gnu packages gnupg) #:select (guile-gcrypt))
#:use-module (gnu packages linux)
#:use-module (gnu packages terminals)
+ #:use-module ((gnu packages wm) #:select (sway))
#:use-module ((gnu build file-systems)
#:select (mount-flags->bit-mask
swap-space->flags-bit-mask))
@@ -231,6 +233,8 @@ (define-module (gnu services base)
greetd-configuration
greetd-terminal-configuration
greetd-agreety-session
+ greetd-wlgreet-session
+ greetd-wlgreet-sway-session
%base-services))
@@ -2869,6 +2873,117 @@ (define (make-greetd-agreety-session-command config command)
"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)))))))
+
+(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 #f)))
+
+(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"
+ (if sway-config
+ #~(string-append "include " #$sway-config "\n")
+ "")
+ "xwayland disable\n"
+ "exec \"" wlgreet " --config " wlgreet-config "; "
+ swaymsg " exit\"\n")))
+
+(define (greetd-wlgreet-sway-session-command session)
+ (program-file "wlgreet-sway-session-command"
+ #~(let* ((sway #$(file-append (greetd-wlgreet-sway-session-sway session)
+ "/bin/sway"))
+ (config #$(make-wlgreet-sway-configuration-file session))
+ (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)
+
+ ;; XXX: If we start sway immediately, it won't find seatd for some
+ ;; reason...
+ (sleep 1)
+
+ (setenv "XDG_RUNTIME_DIR" (string-append "/run/user/" useruid))
+ (execl sway sway "-d" "-c" config))))
+
+
(define (make-greetd-default-session-command config-or-command)
(cond ((greetd-agreety-session? config-or-command)
(cond ((greetd-agreety-xdg-env? config-or-command)
@@ -2879,6 +2994,8 @@ (define (make-greetd-default-session-command config-or-command)
(make-greetd-agreety-session-command
config-or-command
(greetd-agreety-tty-session-command config-or-command)))))
+ ((greetd-wlgreet-sway-session? config-or-command)
+ (greetd-wlgreet-sway-session-command config-or-command))
(#t config-or-command)))
(define-record-type* <greetd-terminal-configuration>
--
2.37.3
