[bug#49969] [PATCH 6/7] gnu: desktop: Add greetd-service-type

[muradm <mail@muradm.net>]

greetd is a minimal and flexible login manager daemon that makes
no assumptions about what you want to launch.

Currently, only agreety configuration is provided.

* gnu/services/desktop.scm: Add greetd-service-type
---
 gnu/services/desktop.scm | 139 +++++++++++++++++++++++++++++++++++++++
 1 file changed, 139 insertions(+)

diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index cc13859532..601b9921a4 100644
--- a/gnu/services/desktop.scm
+++ b/gnu/services/desktop.scm
@@ -49,6 +49,7 @@
   #:use-module (gnu system pam)
   #:use-module (gnu packages glib)
   #:use-module (gnu packages admin)
+  #:use-module (gnu packages bash)
   #:use-module (gnu packages cups)
   #:use-module (gnu packages freedesktop)
   #:use-module (gnu packages gnome)
@@ -160,6 +161,11 @@
             seatd-configuration
             seatd-service-type
 
+            greetd-configuration
+            greetd-agreety-tty-session
+            greetd-agreety-tty-xdg-session
+            greetd-service-type
+
             %desktop-services))
 
 ;;; Commentary:
@@ -1297,6 +1303,139 @@ or setting its password with passwd.")))
                                      seatd-shepherd-service)))
                 (default-value (seatd-configuration))))
 
+\f
+;;;
+;;; greetd-service-type -- minimal and flexible login manager daemon
+;;;
+
+(define %greetd-accounts
+  (list (user-account (name "greeter") (group "wheel") (system? #t))))
+
+(define-record-type* <greetd-agreety-session>
+  greetd-agreety-session make-greetd-agreety-session
+  greetd-agreety-session?
+  (package greetd-agreety-command-package (default bash))
+  (command-bin greetd-agreety-command-bin (default "/bin/bash"))
+  (command-args greetd-agreety-command-args (default '("-l")))
+  (extra-env greetd-agreety-extra-env (default '()))
+  (command-generator greetd-agreety-command-generator))
+
+(define greetd-agreety-tty-session-command
+  (match-lambda
+    (($ <greetd-agreety-session> pkg command-bin command-args extra-env)
+     (program-file
+      "agreety-tty-session-command"
+      #~(begin
+          (use-modules (ice-9 match))
+          (let* ((abs-cmd-bin #$(file-append pkg command-bin)))
+            (for-each
+             (match-lambda ((var . val) (setenv var val)))
+             (quote (#$@extra-env)))
+            (apply execl abs-cmd-bin abs-cmd-bin
+                   (list #$@command-args))))))))
+
+(define greetd-agreety-tty-xdg-session-command
+  (match-lambda
+    (($ <greetd-agreety-session> package command-bin command-args extra-env)
+     (program-file
+      "agreety-tty-xdg-session-command"
+      #~(begin
+          (use-modules (ice-9 popen) (ice-9 rdelim) (ice-9 match))
+          (let*
+              ((pmvarrun-bin #$(file-append seatd-pam-mount "/sbin/pmvarrun"))
+               (username (getenv "USER"))
+               (useruid (passwd:uid (getpwuid username)))
+               (useruid (number->string useruid))
+               (pmvarrun-cmd (string-join (list pmvarrun-bin "-u" username "-o" "0") " "))
+               (pmvarrun-port (open-input-pipe pmvarrun-cmd))
+               (session-id (read-line pmvarrun-port))
+               (session-id (string-append username "-" session-id))
+               (abs-cmd-bin #$(file-append package command-bin)))
+            (close-pipe pmvarrun-port)
+            (setenv "XDG_SESSION_ID" session-id)
+            (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 abs-cmd-bin abs-cmd-bin
+                   (list #$@command-args))))))))
+
+(define greetd-agreety-tty-session
+  (greetd-agreety-session
+   (command-generator greetd-agreety-tty-session-command)))
+
+(define greetd-agreety-tty-xdg-session
+  (greetd-agreety-session
+   (command-generator greetd-agreety-tty-xdg-session-command)))
+
+(define-record-type* <greetd-configuration> greetd-configuration
+  make-greetd-configuration
+  greetd-configuration?
+  (greetd greetd-package (default greetd))
+  (config-file-name greetd-config-file-name (thunked)
+                    (default (default-config-file-name this-record)))
+  (terminal-vt greetd-terminal-vt (default "7"))
+  (default-session-user greetd-default-session-user (default "greeter"))
+  (default-session-command greetd-default-session-command
+    (default greetd-agreety-tty-session)))
+
+(define (default-config-file-name config)
+  (string-join (list "config-" (greetd-terminal-vt config) ".toml") ""))
+
+(define make-greetd-default-session-command
+  (match-lambda
+    (($ <greetd-configuration> greetd _ _ _ default-session-command)
+     (cond ((greetd-agreety-session? default-session-command)
+            (let*
+                ((generator (greetd-agreety-command-generator
+                             default-session-command))
+                 (command (apply generator (list default-session-command)))
+                 (agreety-bin (file-append greetd "/bin/agreety")))
+              (program-file
+               "agreety-command"
+               #~(execl #$agreety-bin #$agreety-bin "-c" #$command))))
+           (else (program-file "agreety-command-exit" #~(exit #f)))))))
+
+(define (greetd-configuration-file config)
+  (let*
+      ((config-file-name (greetd-config-file-name config))
+       (terminal-vt (greetd-terminal-vt config))
+       (default-session-user (greetd-default-session-user config))
+       (default-session-command (make-greetd-default-session-command config)))
+    (mixed-text-file
+     config-file-name
+     "[terminal]\n"
+     "vt = " terminal-vt "\n"
+     "[default_session]\n"
+     "user = " default-session-user "\n"
+     "command = " default-session-command "\n")))
+
+(define (greetd-shepherd-service config)
+  (let*
+      ((greetd-bin (file-append (greetd-package config) "/sbin/greetd"))
+       (greetd-conf (greetd-configuration-file config)))
+    (list
+     (shepherd-service
+      (requirement '(user-processes host-name udev virtual-terminal))
+      (provision (list (symbol-append
+                        'term-tty
+                        (string->symbol (greetd-terminal-vt config)))))
+      (start #~(make-forkexec-constructor
+                (list #$greetd-bin "-c" #$greetd-conf)))
+      (stop #~(make-kill-destructor))))))
+
+(define greetd-service-type
+  (service-type
+   (name 'greetd)
+   (extensions
+    (list
+     (service-extension shepherd-root-service-type
+                        greetd-shepherd-service)
+     (service-extension account-service-type
+                        (const %greetd-accounts))))
+   (default-value (greetd-configuration))))
+
 \f
 ;;;
 ;;; The default set of desktop services.
-- 
2.32.0