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

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

[muradm]

This patch series introduces two new services;

 - seatd-service-type: simple seat management daemon
 - greetd-service-type: simple login daemon

Both services are very minimalistic in nature. Simple seatd daemon could
be said as replacement for elogind-service-type. greetd daemon is simple
replacement for mingetty/agetty.

In addition to the base services, special build of pam-mount module is
included as seatd-pam-mount. It is used to provide auto-(mounting/unmounting)
of XDG_RUNTIME_DIR. Special build is required to avoid interference with
default pam-mount if used in the system.

greetd provides agreety terminal greeter out of the box. Current
greetd-service-type includes configuration for greetd-agreety-session
variations, i.e. only terminal are supported at the moment.

Next step would be adding gtkgreet and/or wlgreet alternatives for
graphical greeter.

muradm (7):
  gnu: rust-enquote: Add rust-enquote 1.0.3
  gnu: rust-pam-sys: Add rust-pam-sys 0.5.6
  gnu: greetd: Add greetd 0.7.0
  gnu: seatd-pam-mount: Add seatd-pam-mount
  gnu: desktop: Add seatd-service-type
  gnu: desktop: Add greetd-service-type
  doc: Add desktop seatd-service-type and greetd-service-type.

 doc/guix.texi                | 151 +++++++++++++++++++++
 gnu/packages/admin.scm       |  20 +++
 gnu/packages/crates-io.scm   |  48 +++++++
 gnu/packages/freedesktop.scm |  71 ++++++++++
 gnu/services/desktop.scm     | 256 ++++++++++++++++++++++++++++++++++-
 5 files changed, 545 insertions(+), 1 deletion(-)

-- 
2.32.0

[bug#49969] [PATCH 1/7] gnu: rust-enquote: Add rust-enquote 1.0.3

[muradm]

* gnu/packages/crates-io.scm (rust-enquote-1): Add rust-enquote 1.0.3
---
 gnu/packages/crates-io.scm | 22 ++++++++++++++++++++++
 1 file changed, 22 insertions(+)

diff --git a/gnu/packages/crates-io.scm b/gnu/packages/crates-io.scm
index 24cc772ba7..16620218b3 100644
--- a/gnu/packages/crates-io.scm
+++ b/gnu/packages/crates-io.scm
@@ -18,6 +18,7 @@
 ;;; Copyright © 2021 Antero Mejr <antero@kodmin.com>
 ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2021 Vinicius Monego <monego@posteo.net>
+;;; Copyright © 2021 muradm <muradm@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -56972,3 +56973,24 @@ variant of this library is available separately as @code{im}.")
     (description
       "Generate Rust register maps (`struct`s) from SVD files")
     (license (list license:expat license:asl2.0))))
+
+(define-public rust-enquote-1
+  (package
+    (name "rust-enquote")
+    (version "1.0.3")
+    (home-page "https://github.com/reujab/enquote")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (crate-uri "enquote" version))
+       (file-name
+        (string-append name "-" version ".tar.gz"))
+       (sha256
+        (base32
+         "0vm687r2wwgc3d3l2iqhag9wgkql6k93sdvjxvmfkdpksajpij1f"))))
+    (build-system cargo-build-system)
+    (synopsis
+     "This Rust library quotes, unquotes, and unescapes strings.")
+    (description
+     "This Rust library quotes, unquotes, and unescapes strings.")
+    (license license:unlicense)))
-- 
2.32.0

[bug#49969] [PATCH 2/7] gnu: rust-pam-sys: Add rust-pam-sys 0.5.6

[muradm]

* gnu/packages/crates-io.scm (rust-pam-sys): Add rust-pam-sys 0.5.6
---
 gnu/packages/crates-io.scm | 26 ++++++++++++++++++++++++++
 1 file changed, 26 insertions(+)

diff --git a/gnu/packages/crates-io.scm b/gnu/packages/crates-io.scm
index 16620218b3..fc235c2aa6 100644
--- a/gnu/packages/crates-io.scm
+++ b/gnu/packages/crates-io.scm
@@ -56994,3 +56994,29 @@ variant of this library is available separately as @code{im}.")
     (description
      "This Rust library quotes, unquotes, and unescapes strings.")
     (license license:unlicense)))
+
+(define-public rust-pam-sys-0.5.6
+  (package
+    (name "rust-pam-sys")
+    (version "0.5.6")
+    (home-page "https://github.com/1wilkens/pam-sys")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (crate-uri "pam-sys" version))
+       (file-name
+        (string-append name "-" version ".tar.gz"))
+       (sha256
+        (base32
+         "0d14501d5vybjnzxfjf96321xa5wa36x1xvf02h02zq938qmhj6d"))))
+    (build-system cargo-build-system)
+    (arguments
+     `(#:cargo-inputs
+       (("rust-libc" ,rust-libc-0.2))))
+    (native-inputs
+     `(("linux-pam" ,linux-pam)))
+    (synopsis
+     "Rust FFI wrappers for the Linux Pluggable Authentication Modules (PAM).")
+    (description
+     "Rust FFI wrappers for the Linux Pluggable Authentication Modules (PAM).")
+    (license (list license:expat license:asl2.0))))
-- 
2.32.0

[bug#49969] [PATCH 3/7] gnu: greetd: Add greetd 0.7.0

[muradm]

* gnu/packages/freedesktop.scm (greetd): Add greetd 0.7.0
---
 gnu/packages/freedesktop.scm | 71 ++++++++++++++++++++++++++++++++++++
 1 file changed, 71 insertions(+)

diff --git a/gnu/packages/freedesktop.scm b/gnu/packages/freedesktop.scm
index 693a79c738..62c47ad70e 100644
--- a/gnu/packages/freedesktop.scm
+++ b/gnu/packages/freedesktop.scm
@@ -24,6 +24,7 @@
 ;;; Copyright © 2020 Raghav Gururajan <raghavgururajan@disroot.org>
 ;;; Copyright © 2021 Brendan Tildesley <mail@brendan.scot>
 ;;; Copyright © 2021 pineapples <guixuser6392@protonmail.com>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -46,6 +47,7 @@
   #:use-module (guix packages)
   #:use-module (guix download)
   #:use-module (guix git-download)
+  #:use-module (guix build-system cargo)
   #:use-module (guix build-system cmake)
   #:use-module (guix build-system gnu)
   #:use-module (guix build-system meson)
@@ -62,6 +64,7 @@
   #:use-module (gnu packages check)
   #:use-module (gnu packages cmake)
   #:use-module (gnu packages compression)
+  #:use-module (gnu packages crates-io)
   #:use-module (gnu packages cryptsetup)
   #:use-module (gnu packages databases)
   #:use-module (gnu packages disk)
@@ -862,6 +865,74 @@ that require it.  It also provides a universal seat management library that
 allows applications to use whatever seat management is available.")
     (license license:expat)))
 
+(define-public greetd
+  (package
+    (name "greetd")
+    (version "0.7.0")
+    (home-page "https://git.sr.ht/~kennylevinsen/greetd")
+    (source (origin
+              (method git-fetch)
+              (uri (git-reference
+                    (url home-page)
+                    (commit version)))
+              (file-name (git-file-name name version))
+              (sha256
+               (base32 "0lmwr5ld9x2wlq00i7mjgm9by8zndiq9girj8g93k0kww9zbgr3g"))))
+    (build-system cargo-build-system)
+    (arguments
+     `(#:cargo-inputs
+       (("rust-nix" ,rust-nix-0.17)
+        ("rust-pam-sys" ,rust-pam-sys-0.5.6)
+        ("rust-rpassword" ,rust-rpassword-4)
+        ("rust-users" ,rust-users-0.9)
+        ("rust-serde" ,rust-serde-1)
+        ("rust-serde-json" ,rust-serde-json-1)
+        ("rust-libc" ,rust-libc-0.2)
+        ("rust-tokio" ,rust-tokio-0.2)
+        ("rust-getopts" ,rust-getopts-0.2)
+        ("rust-thiserror" ,rust-thiserror-1)
+        ("rust-async-trait" ,rust-async-trait-0.1)
+        ("rust-enquote" ,rust-enquote-1))
+       #:phases
+       (modify-phases %standard-phases
+         (delete 'package)
+         (replace 'install
+           (lambda* (#:key inputs outputs #:allow-other-keys)
+             (let* ((out (assoc-ref outputs "out"))
+                    (bin (string-append out "/bin"))
+                    (sbin (string-append out "/sbin"))
+                    (share (string-append out "/share"))
+                    (man (string-append share "/man"))
+                    (man1 (string-append man "/man1"))
+                    (man5 (string-append man "/man5"))
+                    (man7 (string-append man "/man7"))
+                    (release "target/release")
+                    (greetd-bin (string-append release "/greetd"))
+                    (agreety-bin (string-append release "/agreety")))
+               (install-file greetd-bin sbin)
+               (install-file agreety-bin bin)
+               (mkdir-p man1)
+               (mkdir-p man5)
+               (mkdir-p man7)
+               (with-directory-excursion "man"
+                 (system "scdoc < greetd-1.scd > greetd.1")
+                 (system "scdoc < greetd-5.scd > greetd.5")
+                 (system "scdoc < greetd-ipc-7.scd > greetd-ipc.7")
+                 (system "scdoc < agreety-1.scd > agreety.1"))
+               (install-file "man/greetd.1" man1)
+               (install-file "man/greetd.5" man5)
+               (install-file "man/greetd-ipc.7" man7)
+               (install-file "man/agreety.1" man1)
+               #t))))))
+    (native-inputs
+     `(("linux-pam" ,linux-pam)
+       ("scdoc" ,scdoc)))
+    (synopsis "minimal and flexible login manager daemon")
+    (description
+     "greetd is a minimal and flexible login manager daemon
+that makes no assumptions about what you want to launch.")
+    (license license:gpl3+)))
+
 (define-public packagekit
   (package
     (name "packagekit")
-- 
2.32.0

[bug#49969] [PATCH 4/7] gnu: seatd-pam-mount: Add seatd-pam-mount

[muradm]

This package inherits pam-mount in the way that it is compiled
specifically for use with seatd daemon. It uses different
configuration location and name space for storing data in PAM.

seatd-pam-mount is used in configuration of seatd to provide
auto-(mounting/unmounting) of XDG_RUNTIME_DIR in the way that
it will not interfere with default pam-mount configuration.

* gnu/packages/admin.scm (seatd-pam-mount): Add seatd-pam-mount
---
 gnu/packages/admin.scm | 20 ++++++++++++++++++++
 1 file changed, 20 insertions(+)

diff --git a/gnu/packages/admin.scm b/gnu/packages/admin.scm
index eda269f148..adc5f4d8fd 100644
--- a/gnu/packages/admin.scm
+++ b/gnu/packages/admin.scm
@@ -42,6 +42,7 @@
 ;;; Copyright © 2021 David Larsson <david.larsson@selfhosted.xyz>
 ;;; Copyright © 2021 WinterHound <winterhound@yandex.com>
 ;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -4247,6 +4248,25 @@ supports.  It can also mount encrypted LUKS volumes using the password
 supplied by the user when logging in.")
     (license (list license:gpl2+ license:lgpl2.1+))))
 
+(define-public seatd-pam-mount
+  (package
+    (inherit pam-mount)
+    (name "seatd-pam-mount")
+    (arguments
+     (substitute-keyword-arguments (package-arguments pam-mount)
+       ((#:configure-flags flags ''())
+        `(cons* "--with-rundir=/run/seatd" ,flags))
+       ((#:phases phases)
+        `(modify-phases ,phases
+           (add-after 'unpack 'patch-config-file-name
+             (lambda* (#:key inputs #:allow-other-keys)
+               (substitute* "src/pam_mount.c"
+                 ((".*define CONFIGFILE .*$")
+                  "#define CONFIGFILE \"/etc/security/seatd_pam_mount.conf.xml\"\n")
+                 (("pam_mount_config") "seatd_pam_mount_config")
+                 (("pam_mount_system_authtok") "seatd_pam_mount_system_authtok"))))))))
+    (synopsis "pam-mount specifically compiled for use with seatd/greetd")))
+
 (define-public jc
   (package
     (name "jc")
-- 
2.32.0

[bug#49969] [PATCH 5/7] gnu: desktop: Add seatd-service-type

[muradm]

A seat management daemon, that does everything it needs to do.
Nothing more, nothing less. Depends only on libc.

* gnu/services/desktop.scm: Add seatd-service-type
---
 gnu/services/desktop.scm | 117 ++++++++++++++++++++++++++++++++++++++-
 1 file changed, 116 insertions(+), 1 deletion(-)

diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index 64d0e85301..cc13859532 100644
--- a/gnu/services/desktop.scm
+++ b/gnu/services/desktop.scm
@@ -13,6 +13,7 @@
 ;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2020 Reza Alizadeh Majd <r.majd@pantherx.org>
 ;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -39,7 +40,9 @@
   #:use-module (gnu services networking)
   #:use-module (gnu services sound)
   #:use-module ((gnu system file-systems)
-                #:select (%elogind-file-systems file-system))
+                #:select (%elogind-file-systems
+                          %control-groups
+                          file-system))
   #:use-module (gnu system)
   #:use-module (gnu system setuid)
   #:use-module (gnu system shadow)
@@ -154,6 +157,9 @@
             gnome-keyring-configuration?
             gnome-keyring-service-type
 
+            seatd-configuration
+            seatd-service-type
+
             %desktop-services))
 
 ;;; Commentary:
@@ -1182,6 +1188,115 @@ or setting its password with passwd.")))
 (define polkit-wheel-service
   (simple-service 'polkit-wheel polkit-service-type (list polkit-wheel)))
 
+\f
+;;;
+;;; seatd-service-type -- Seat management daemon
+;;;
+
+;; TODO: separate service-type is needed for cgroups
+(define %seatd-file-systems
+  (append
+   (list (file-system
+           (device "none")
+           (mount-point "/run/seatd/pam_mount")
+           (type "tmpfs")
+           (check? #f)
+           (flags '(no-suid no-dev no-exec))
+           (options "mode=0755")
+           (create-mount-point? #t)))
+   %control-groups))
+
+(define %seatd-pam-mount-rules
+  `((debug (@ (enable "0")))
+    (volume (@ (sgrp "users")
+               (fstype "tmpfs")
+               (mountpoint "/run/user/%(USERUID)")
+               (options "noexec,nosuid,nodev,size=1g,mode=0700,uid=%(USERUID),gid=%(USERGID)")))
+    (logout (@ (wait "0")
+               (hup "0")
+               (term "yes")
+               (kill "no")))
+    (mkmountpoint (@ (enable "1") (remove "true")))))
+
+(define-record-type* <seatd-configuration> seatd-configuration
+  make-seatd-configuration
+  seatd-configuration?
+  (seatd seatd-package (default seatd))
+  (user seatd-user (default "root"))
+  (group seatd-group (default "users"))
+  (socket seatd-socket (default "/run/seatd.sock")))
+
+(define (make-seatd-pam-mount-configuration-file config)
+  (computed-file
+   "seatd_pam_mount.conf.xml"
+   #~(begin
+       (use-modules (sxml simple))
+       (call-with-output-file #$output
+         (lambda (port)
+           (sxml->xml
+            '(*TOP*
+              (*PI* xml "version='1.0' encoding='utf-8'")
+              (pam_mount
+               #$@%seatd-pam-mount-rules
+               (pmvarrun
+                #$(file-append seatd-pam-mount
+                               "/sbin/pmvarrun -u '%(USER)' -o '%(OPERATION)'"))))
+            port))))))
+
+(define (seatd-pam-mount-etc-service config)
+  `(("security/seatd_pam_mount.conf.xml"
+     ,(make-seatd-pam-mount-configuration-file config))))
+
+(define (seatd-pam-mount-pam-service config)
+  (define optional-pam-mount
+    (pam-entry
+     (control "optional")
+     (module #~(string-append #$seatd-pam-mount "/lib/security/pam_mount.so"))))
+  (list (lambda (pam)
+          (if (member (pam-service-name pam)
+                      '("login" "su" "slim" "gdm-password"))
+              (pam-service
+               (inherit pam)
+               (auth (append (pam-service-auth pam)
+                             (list optional-pam-mount)))
+               (session (append (pam-service-session pam)
+                                (list optional-pam-mount))))
+              pam))))
+
+(define (seatd-shepherd-service config)
+  (list (shepherd-service
+         (requirement '())
+         ;; TODO: once cgroups is separate dependency
+         ;; here we should depend on it rather than elogind
+         (provision '(seatd elogind))
+         (start #~(make-forkexec-constructor
+                   (list #$(file-append (seatd-package config) "/bin/seatd")
+                         "-u" #$(seatd-user config)
+                         "-g" #$(seatd-group config)
+                         "-s" #$(seatd-socket config))))
+         (stop #~(make-kill-destructor)))))
+
+(define seatd-environment
+  (match-lambda
+    (($ <seatd-configuration> _ _ _ socket)
+     `(("SEATD_SOCK" . ,socket)))))
+
+(define seatd-service-type
+  (service-type (name 'seatd)
+                (extensions
+                 (list
+                  (service-extension session-environment-service-type
+                                     seatd-environment)
+                  (service-extension file-system-service-type
+                                     (const %seatd-file-systems))
+                  (service-extension etc-service-type
+                                     seatd-pam-mount-etc-service)
+                  (service-extension pam-root-service-type
+                                     seatd-pam-mount-pam-service)
+                  (service-extension shepherd-root-service-type
+                                     seatd-shepherd-service)))
+                (default-value (seatd-configuration))))
+
 \f
 ;;;
 ;;; The default set of desktop services.
-- 
2.32.0

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

[muradm]

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

[bug#49969] [PATCH 7/7] doc: Add desktop seatd-service-type and greetd-service-type.

[muradm]

* doc/guix.texi (Desktop Services): Provide documentation for
seatd-service-type and greetd-service-type including configuration
and sample usage.
---
 doc/guix.texi | 151 ++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 151 insertions(+)

diff --git a/doc/guix.texi b/doc/guix.texi
index 4eb5324b51..6c76a8d68a 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -94,6 +94,7 @@ Copyright @copyright{} 2021 Xinglu Chen@*
 Copyright @copyright{} 2021 Raghav Gururajan@*
 Copyright @copyright{} 2021 Domagoj Stolfa@*
 Copyright @copyright{} 2021 Hui Lu@*
+Copyright @copyright{} 2021 muradm@*
 
 Permission is granted to copy, distribute and/or modify this document
 under the terms of the GNU Free Documentation License, Version 1.3 or
@@ -19694,6 +19695,156 @@ and ``passwd'' is with the value @code{passwd}.
 @end table
 @end deftp
 
+@defvr {Scheme Variable} seatd-service-type
+A minimal seat management daemon, and a universal seat management library.
+
+Seat management takes care of mediating access to shared devices (graphics,
+input), without requiring the applications needing access to be root.
+
+In general should be used as replacement to @code{elogind-service-type}.
+And currently should be used with @code{greetd-service-type}.
+
+@lisp
+
+(append
+  (list
+   ;; make sure seatd is running
+   (service seatd-service-type)
+
+   ;; let's make terminals 1, 2 and 3 be an XDG terminal
+   ;; with XDG variables set on login.
+   (service greetd-service-type
+            (greetd-configuration
+             (terminal-vt "1")
+             (default-session-command greetd-agreety-tty-xdg-session)))
+   (service greetd-service-type
+            (greetd-configuration
+             (terminal-vt "2")
+             (default-session-command greetd-agreety-tty-xdg-session)))
+   (service greetd-service-type
+            (greetd-configuration
+             (terminal-vt "3")
+             (default-session-command greetd-agreety-tty-xdg-session)))
+
+   ;; let's make terminals 4, 5 and 6 be a plain bash terminal session
+   (service greetd-service-type
+            (greetd-configuration (terminal-vt "4")))
+   (service greetd-service-type
+            (greetd-configuration (terminal-vt "5")))
+   (service greetd-service-type
+            (greetd-configuration (terminal-vt "6"))))
+
+  (modify-services %desktop-services
+    ;; seatd/greetd combination can replace these
+    (delete elogind-service-type)
+    (delete agetty-service-type)
+    (delete mingetty-service-type)))
+
+@end lisp
+
+@end defvr
+
+@deftp {Data Type} seatd-configuration
+Configuration record for the seatd daemon service.
+
+@table @asis
+@item @code{seatd} (default: @code{seatd})
+The seatd package to use.
+
+@item @code{user} (default: @samp{"root"})
+User to own the seatd socket.
+
+@item @code{group} (default: @samp{"users"})
+Group to own the seatd socket.
+
+@item @code{socket} (default: @samp{"/run/seatd/socket"})
+Where to create the seatd socket.
+
+@end table
+@end deftp
+
+@defvr {Scheme Variable} greetd-service-type
+greetd is a minimal and flexible login manager daemon that makes no
+assumptions about what you want to launch.
+
+If you can run it from your shell in a TTY, greetd can start it. If it
+can be taught to speak a simple JSON-based IPC protocol, then it can
+be a greeter.
+@end defvr
+
+@deftp {Data Type} greetd-configuration
+Configuration record for the greetd daemon service.
+
+@table @asis
+@item @code{greetd} (default: @code{greetd})
+The greetd package to use.
+
+@item @code{config-file-name}
+Configuration file name to use for greetd daemon. Generally, autogenerated
+derivation based on @code{terminal-vt} value.
+
+@item @code{terminal-vt} (default: @samp{"7"})
+The VT to run on. Use of a specific VT with appropriate conflict avoidance
+is recommended.
+
+@item @code{default-session-user} (default: @samp{"greeter"})
+The user to use for running the greeter.
+
+@item @code{default-session-command} (default: @code{greetd-agreety-tty-session})
+The command-line to run to start the default session.
+
+Possible values are:
+
+@itemize @bullet
+@item
+@code{greetd-agreety-tty-session} - bash terminal session
+
+@item
+@code{greetd-agreety-tty-xdg-session} - bash terminal session with XDG environment
+
+@item
+@code{greetd-agreety-session} - custom instance of terminal session
+@end itemize
+
+@end table
+@end deftp
+
+@deftp {Data Type} greetd-agreety-session
+Configuration record for the agreety greetd greeter.
+
+@table @asis
+@item @code{package} (default: @code{bash})
+The package of command.
+
+@item @code{command-bin} (default: @samp{"/bin/bash"})
+Path to binary relative to @code{package}.
+
+@item @code{command-args} (default: @code{'("-l")})
+Command arguments to pass to command.
+
+@item @code{extra-env} (default: @code{'()})
+Extra environment variables to set on login.
+
+@item @code{command-generator}
+Function that receives instance of this configuration as an argument and
+returns @code{program-file} that can be used with @code{agreety} greeter.
+
+Both @code{greetd-agreety-tty-session} and @code{greetd-agreety-tty-xdg-session}
+uses @code{greetd-agreety-session} under the hood.
+
+@end table
+@end deftp
+
+@defvr {Scheme Variable} greetd-agreety-tty-session
+Provides instance of @code{greetd-agreety-session} which starts @samp{"bash -l"}
+on login.
+@end defvr
+
+@defvr {Scheme Variable} greetd-agreety-tty-xdg-session
+Provides instance of @code{greetd-agreety-session} which starts @samp{"bash -l"}
+on login. Additionally, will set @code{XDG_SESSION_ID}, @code{XDG_SESSION_TYPE} and
+@code{XDG_RUNTIME_DIR} environment variables for session.
+@end defvr
 
 @node Sound Services
 @subsection Sound Services
-- 
2.32.0

[bug#49969] [PATCH v2 0/7] gnu: desktop: Add seatd-service-type and greetd-service-type

[muradm]

This patch series introduces two new services;

 - seatd-service-type: simple seat management daemon
 - greetd-service-type: simple login daemon

Both services are very minimalistic in nature. Simple seatd daemon
could be said as replacement for elogind-service-type. greetd daemon
is simple replacement for mingetty/agetty.

In addition to the base services, special build of pam-mount module is
included as greetd-pam-mount. It is used to provide
auto-(mounting/unmounting) of XDG_RUNTIME_DIR. Special build is
required to avoid interference with default pam-mount, if used in
the system.

greetd provides agreety terminal greeter out of the box. Current
greetd-service-type includes configuration for greetd-agreety-session
variations, i.e. only terminal are supported at the moment.

Next step would be adding gtkgreet and/or wlgreet alternatives for
graphical greeter.

muradm (7):
  gnu: crates-io: Add rust-enquote 1.0.3
  gnu: crates-io: Add rust-pam-sys 0.5.6
  gnu: freedesktop: Add greetd 0.7.0
  gnu: admin: Add greetd-pam-mount
  gnu: desktop: Add seatd-service-type
  gnu: desktop: Add greetd-service-type
  doc: Add desktop seatd-service-type and greetd-service-type

 doc/guix.texi                | 183 ++++++++++++++++++++++++
 gnu/packages/admin.scm       |  20 +++
 gnu/packages/crates-io.scm   |  49 +++++++
 gnu/packages/freedesktop.scm |  80 +++++++++++
 gnu/services/desktop.scm     | 269 ++++++++++++++++++++++++++++++++++-
 5 files changed, 600 insertions(+), 1 deletion(-)

-- 
2.32.0

[bug#49969] [PATCH v2 1/7] gnu: crates-io: Add rust-enquote 1.0.3

[muradm]

* gnu/packages/crates-io.scm (rust-enquote-1): Add rust-enquote 1.0.3
---
 gnu/packages/crates-io.scm | 22 ++++++++++++++++++++++
 1 file changed, 22 insertions(+)

diff --git a/gnu/packages/crates-io.scm b/gnu/packages/crates-io.scm
index 24cc772ba7..b458080ca7 100644
--- a/gnu/packages/crates-io.scm
+++ b/gnu/packages/crates-io.scm
@@ -18,6 +18,7 @@
 ;;; Copyright © 2021 Antero Mejr <antero@kodmin.com>
 ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2021 Vinicius Monego <monego@posteo.net>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -56972,3 +56973,24 @@ variant of this library is available separately as @code{im}.")
     (description
       "Generate Rust register maps (`struct`s) from SVD files")
     (license (list license:expat license:asl2.0))))
+
+(define-public rust-enquote-1
+  (package
+    (name "rust-enquote")
+    (version "1.0.3")
+    (home-page "https://github.com/reujab/enquote")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (crate-uri "enquote" version))
+       (file-name
+        (string-append name "-" version ".tar.gz"))
+       (sha256
+        (base32
+         "0vm687r2wwgc3d3l2iqhag9wgkql6k93sdvjxvmfkdpksajpij1f"))))
+    (build-system cargo-build-system)
+    (synopsis
+     "This Rust library quotes, unquotes, and unescapes strings.")
+    (description
+     "This Rust library quotes, unquotes, and unescapes strings.")
+    (license license:unlicense)))
-- 
2.32.0

[bug#49969] [PATCH v2 2/7] gnu: crates-io: Add rust-pam-sys 0.5.6

[muradm]

* gnu/packages/crates-io.scm (rust-pam-sys): Add rust-pam-sys 0.5.6
---
 gnu/packages/crates-io.scm | 27 +++++++++++++++++++++++++++
 1 file changed, 27 insertions(+)

diff --git a/gnu/packages/crates-io.scm b/gnu/packages/crates-io.scm
index b458080ca7..b365a2c8c0 100644
--- a/gnu/packages/crates-io.scm
+++ b/gnu/packages/crates-io.scm
@@ -56,6 +56,7 @@
   #:use-module (gnu packages image)
   #:use-module (gnu packages jemalloc)
   #:use-module (gnu packages llvm)
+  #:use-module (gnu packages linux)
   #:use-module (gnu packages multiprecision)
   #:use-module (gnu packages nettle)
   #:use-module (gnu packages pcre)
@@ -56994,3 +56995,29 @@ variant of this library is available separately as @code{im}.")
     (description
      "This Rust library quotes, unquotes, and unescapes strings.")
     (license license:unlicense)))
+
+(define-public rust-pam-sys-0.5.6
+  (package
+    (name "rust-pam-sys")
+    (version "0.5.6")
+    (home-page "https://github.com/1wilkens/pam-sys")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (crate-uri "pam-sys" version))
+       (file-name
+        (string-append name "-" version ".tar.gz"))
+       (sha256
+        (base32
+         "0d14501d5vybjnzxfjf96321xa5wa36x1xvf02h02zq938qmhj6d"))))
+    (build-system cargo-build-system)
+    (arguments
+     `(#:cargo-inputs
+       (("rust-libc" ,rust-libc-0.2))))
+    (native-inputs
+     `(("linux-pam" ,linux-pam)))
+    (synopsis
+     "Rust FFI wrappers for the Linux Pluggable Authentication Modules (PAM).")
+    (description
+     "Rust FFI wrappers for the Linux Pluggable Authentication Modules (PAM).")
+    (license (list license:expat license:asl2.0))))
-- 
2.32.0

[bug#49969] [PATCH v2 3/7] gnu: freedesktop: Add greetd 0.7.0

[muradm]

* gnu/packages/freedesktop.scm (greetd): Add greetd 0.7.0
---
 gnu/packages/freedesktop.scm | 80 ++++++++++++++++++++++++++++++++++++
 1 file changed, 80 insertions(+)

diff --git a/gnu/packages/freedesktop.scm b/gnu/packages/freedesktop.scm
index 693a79c738..631d36e765 100644
--- a/gnu/packages/freedesktop.scm
+++ b/gnu/packages/freedesktop.scm
@@ -24,6 +24,7 @@
 ;;; Copyright © 2020 Raghav Gururajan <raghavgururajan@disroot.org>
 ;;; Copyright © 2021 Brendan Tildesley <mail@brendan.scot>
 ;;; Copyright © 2021 pineapples <guixuser6392@protonmail.com>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -46,6 +47,7 @@
   #:use-module (guix packages)
   #:use-module (guix download)
   #:use-module (guix git-download)
+  #:use-module (guix build-system cargo)
   #:use-module (guix build-system cmake)
   #:use-module (guix build-system gnu)
   #:use-module (guix build-system meson)
@@ -62,6 +64,7 @@
   #:use-module (gnu packages check)
   #:use-module (gnu packages cmake)
   #:use-module (gnu packages compression)
+  #:use-module (gnu packages crates-io)
   #:use-module (gnu packages cryptsetup)
   #:use-module (gnu packages databases)
   #:use-module (gnu packages disk)
@@ -862,6 +865,83 @@ that require it.  It also provides a universal seat management library that
 allows applications to use whatever seat management is available.")
     (license license:expat)))
 
+(define-public greetd
+  (package
+    (name "greetd")
+    (version "0.7.0")
+    (home-page "https://git.sr.ht/~kennylevinsen/greetd")
+    (source (origin
+              (method git-fetch)
+              (uri (git-reference
+                    (url home-page)
+                    (commit version)))
+              (file-name (git-file-name name version))
+              (sha256
+               (base32 "0lmwr5ld9x2wlq00i7mjgm9by8zndiq9girj8g93k0kww9zbgr3g"))))
+    (build-system cargo-build-system)
+    (arguments
+     `(#:cargo-inputs
+       (("rust-nix" ,rust-nix-0.17)
+        ("rust-pam-sys" ,rust-pam-sys-0.5.6)
+        ("rust-rpassword" ,rust-rpassword-4)
+        ("rust-users" ,rust-users-0.9)
+        ("rust-serde" ,rust-serde-1)
+        ("rust-serde-json" ,rust-serde-json-1)
+        ("rust-libc" ,rust-libc-0.2)
+        ("rust-tokio" ,rust-tokio-0.2)
+        ("rust-getopts" ,rust-getopts-0.2)
+        ("rust-thiserror" ,rust-thiserror-1)
+        ("rust-async-trait" ,rust-async-trait-0.1)
+        ("rust-enquote" ,rust-enquote-1))
+       #:phases
+       (modify-phases %standard-phases
+         ;; once https://todo.sr.ht/~kennylevinsen/greetd/25
+         ;; is solved, below patch can be removed
+         (add-after 'unpack 'patch-terminal-switch
+           (lambda* (#:key inputs #:allow-other-keys)
+             (substitute* "greetd/src/server.rs"
+               (("switch: true,")
+                "switch: false,"))))
+         (delete 'package)
+         (replace 'install
+           (lambda* (#:key inputs outputs #:allow-other-keys)
+             (let* ((out (assoc-ref outputs "out"))
+                    (bin (string-append out "/bin"))
+                    (sbin (string-append out "/sbin"))
+                    (share (string-append out "/share"))
+                    (man (string-append share "/man"))
+                    (man1 (string-append man "/man1"))
+                    (man5 (string-append man "/man5"))
+                    (man7 (string-append man "/man7"))
+                    (release "target/release")
+                    (greetd-bin (string-append release "/greetd"))
+                    (agreety-bin (string-append release "/agreety")))
+               (install-file greetd-bin sbin)
+               (install-file agreety-bin bin)
+               (mkdir-p man1)
+               (mkdir-p man5)
+               (mkdir-p man7)
+               (with-directory-excursion "man"
+                 (system "scdoc < greetd-1.scd > greetd.1")
+                 (system "scdoc < greetd-5.scd > greetd.5")
+                 (system "scdoc < greetd-ipc-7.scd > greetd-ipc.7")
+                 (system "scdoc < agreety-1.scd > agreety.1"))
+               (install-file "man/greetd.1" man1)
+               (install-file "man/greetd.5" man5)
+               (install-file "man/greetd-ipc.7" man7)
+               (install-file "man/agreety.1" man1)
+               #t))))))
+    (native-inputs
+     `(("linux-pam" ,linux-pam)
+       ("scdoc" ,scdoc)))
+    (synopsis
+     "greetd is a minimal and flexible login manager daemon
+that makes no assumptions about what you want to launch.")
+    (description
+     "greetd is a minimal and flexible login manager daemon
+that makes no assumptions about what you want to launch.")
+    (license license:gpl3+)))
+
 (define-public packagekit
   (package
     (name "packagekit")
-- 
2.32.0

[bug#49969] [PATCH v2 4/7] gnu: admin: Add greetd-pam-mount

[muradm]

This package inherits pam-mount in the way that it is compiled
specifically for use with greetd daemon. It uses different
configuration location and name space for storing data in PAM.

greetd-pam-mount is used in configuration of greetd to provide
auto-(mounting/unmounting) of XDG_RUNTIME_DIR in the way that
it will not interfere with default pam-mount configuration.

* gnu/packages/admin.scm (greetd-pam-mount): Add greetd-pam-mount
---
 gnu/packages/admin.scm | 20 ++++++++++++++++++++
 1 file changed, 20 insertions(+)

diff --git a/gnu/packages/admin.scm b/gnu/packages/admin.scm
index eda269f148..e805b219c5 100644
--- a/gnu/packages/admin.scm
+++ b/gnu/packages/admin.scm
@@ -42,6 +42,7 @@
 ;;; Copyright © 2021 David Larsson <david.larsson@selfhosted.xyz>
 ;;; Copyright © 2021 WinterHound <winterhound@yandex.com>
 ;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -4247,6 +4248,25 @@ supports.  It can also mount encrypted LUKS volumes using the password
 supplied by the user when logging in.")
     (license (list license:gpl2+ license:lgpl2.1+))))
 
+(define-public greetd-pam-mount
+  (package
+    (inherit pam-mount)
+    (name "greetd-pam-mount")
+    (arguments
+     (substitute-keyword-arguments (package-arguments pam-mount)
+       ((#:configure-flags flags ''())
+        `(cons* "--with-rundir=/run/greetd" ,flags))
+       ((#:phases phases)
+        `(modify-phases ,phases
+           (add-after 'unpack 'patch-config-file-name
+             (lambda* (#:key inputs #:allow-other-keys)
+               (substitute* "src/pam_mount.c"
+                 ((".*define CONFIGFILE .*$")
+                  "#define CONFIGFILE \"/etc/security/greetd_pam_mount.conf.xml\"\n")
+                 (("pam_mount_config") "greetd_pam_mount_config")
+                 (("pam_mount_system_authtok") "greetd_pam_mount_system_authtok"))))))))
+    (synopsis "pam-mount specifically compiled for use with greetd")))
+
 (define-public jc
   (package
     (name "jc")
-- 
2.32.0

[bug#49969] [PATCH v2 5/7] gnu: desktop: Add seatd-service-type

[muradm]

A seat management daemon, that does everything it needs to do.
Nothing more, nothing less. Depends only on libc.

* gnu/services/desktop.scm: Add seatd-service-type
---
 gnu/services/desktop.scm | 59 +++++++++++++++++++++++++++++++++++++++-
 1 file changed, 58 insertions(+), 1 deletion(-)

diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index 64d0e85301..bfba9bccec 100644
--- a/gnu/services/desktop.scm
+++ b/gnu/services/desktop.scm
@@ -13,6 +13,7 @@
 ;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2020 Reza Alizadeh Majd <r.majd@pantherx.org>
 ;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -39,7 +40,9 @@
   #:use-module (gnu services networking)
   #:use-module (gnu services sound)
   #:use-module ((gnu system file-systems)
-                #:select (%elogind-file-systems file-system))
+                #:select (%control-groups
+                          %elogind-file-systems
+                          file-system))
   #:use-module (gnu system)
   #:use-module (gnu system setuid)
   #:use-module (gnu system shadow)
@@ -154,6 +157,9 @@
             gnome-keyring-configuration?
             gnome-keyring-service-type
 
+            seatd-configuration
+            seatd-service-type
+
             %desktop-services))
 
 ;;; Commentary:
@@ -1182,6 +1188,57 @@ or setting its password with passwd.")))
 (define polkit-wheel-service
   (simple-service 'polkit-wheel polkit-service-type (list polkit-wheel)))
 
+\f
+;;;
+;;; seatd-service-type -- minimal seat management daemon
+;;;
+
+(define-record-type* <seatd-configuration> seatd-configuration
+  make-seatd-configuration
+  seatd-configuration?
+  (seatd seatd-package (default seatd))
+  (user seatd-user (default "root"))
+  (group seatd-group (default "users"))
+  (socket seatd-socket (default "/run/seatd/socket"))
+  (loglevel seatd-loglevel (default "error")))
+
+(define (seatd-shepherd-service config)
+  (list (shepherd-service
+         (requirement '())
+         ;; TODO: once cgroups is separate dependency
+         ;; here we should depend on it rather than elogind
+         (provision '(seatd elogind))
+         (start #~(make-forkexec-constructor
+                   (list #$(file-append (seatd-package config) "/bin/seatd")
+                         "-u" #$(seatd-user config)
+                         "-g" #$(seatd-group config)
+                         "-s" #$(seatd-socket config))
+                   #:environment-variables
+                   (list (string-append "SEATD_LOGLEVEL="
+                                        #$(seatd-loglevel config)))
+                   #:log-file "/tmp/seatd.log"))
+         (stop #~(make-kill-destructor)))))
+
+(define seatd-environment
+  (match-lambda
+    (($ <seatd-configuration> _ _ _ socket)
+     `(("SEATD_SOCK" . ,socket)))))
+
+(define seatd-service-type
+  (service-type
+   (name 'seatd)
+   (extensions
+    (list
+     (service-extension session-environment-service-type
+                        seatd-environment)
+     ;; TODO: once cgroups is separate dependency
+     ;; we should not mount it here
+     (service-extension file-system-service-type
+                        (const %control-groups))
+     (service-extension shepherd-root-service-type
+                        seatd-shepherd-service)))
+   (default-value (seatd-configuration))))
+
 \f
 ;;;
 ;;; The default set of desktop services.
-- 
2.32.0

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

[muradm]

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 | 210 +++++++++++++++++++++++++++++++++++++++
 1 file changed, 210 insertions(+)

diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index bfba9bccec..be6bb0a86f 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)
@@ -1239,6 +1240,215 @@ or setting its password with passwd.")))
                         seatd-shepherd-service)))
    (default-value (seatd-configuration))))
 
+\f
+;;;
+;;; 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?
+  (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*
+              ((username (getenv "USER"))
+               (useruid (passwd:uid (getpwuid username)))
+               (useruid (number->string useruid))
+               (abs-cmd-bin #$(file-append package command-bin)))
+            (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-terminal-configuration>
+  greetd-terminal-configuration make-greetd-terminal-configuration
+  greetd-terminal-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-xdg-session)))
+
+(define (default-config-file-name config)
+  (string-join (list "config-" (greetd-terminal-vt config) ".toml") ""))
+
+(define make-greetd-terminal-default-session-command
+  (match-lambda
+    (($ <greetd-terminal-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 (make-greetd-terminal-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-terminal-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 %default-motd
+  (plain-file "motd" "This is the GNU operating system, welcome!\n\n"))
+
+(define %greetd-accounts
+  (list (user-account (name "greeter") (group "wheel") (system? #t))))
+
+(define %greetd-file-systems
+  (list (file-system
+          (device "none")
+          (mount-point "/run/greetd/pam_mount")
+          (type "tmpfs")
+          (check? #f)
+          (flags '(no-suid no-dev no-exec))
+          (options "mode=0755")
+          (create-mount-point? #t))))
+
+(define %greetd-pam-mount-rules
+  `((debug (@ (enable "0")))
+    (volume (@ (sgrp "users")
+               (fstype "tmpfs")
+               (mountpoint "/run/user/%(USERUID)")
+               (options "noexec,nosuid,nodev,size=1g,mode=0700,uid=%(USERUID),gid=%(USERGID)")))
+    (logout (@ (wait "0")
+               (hup "0")
+               (term "yes")
+               (kill "no")))
+    (mkmountpoint (@ (enable "1") (remove "true")))))
+
+(define-record-type* <greetd-configuration>
+  greetd-configuration make-greetd-configuration
+  greetd-configuration?
+  (motd greetd-motd (default %default-motd))
+  (allow-empty-passwords? greetd-allow-empty-passwords? (default #t))
+  (terminals greetd-terminals (default '())))
+
+(define (make-greetd-pam-mount-conf-file config)
+  (computed-file
+   "greetd_pam_mount.conf.xml"
+   #~(begin
+       (use-modules (sxml simple))
+       (call-with-output-file #$output
+         (lambda (port)
+           (sxml->xml
+            '(*TOP*
+              (*PI* xml "version='1.0' encoding='utf-8'")
+              (pam_mount
+               #$@%greetd-pam-mount-rules
+               (pmvarrun
+                #$(file-append greetd-pam-mount
+                               "/sbin/pmvarrun -u '%(USER)' -o '%(OPERATION)'"))))
+            port))))))
+
+(define (greetd-etc-service config)
+  `(("security/greetd_pam_mount.conf.xml"
+     ,(make-greetd-pam-mount-conf-file config))))
+
+(define (greetd-pam-service config)
+  (define optional-pam-mount
+    (pam-entry
+     (control "optional")
+     (module #~(string-append #$greetd-pam-mount "/lib/security/pam_mount.so"))))
+
+  (list
+   (unix-pam-service "greetd"
+                     #:login-uid? #t
+                     #:allow-empty-passwords?
+                     (greetd-allow-empty-passwords? config)
+                     #:motd
+                     (greetd-motd config))
+   (lambda (pam)
+     (if (member (pam-service-name pam)
+                 '("login" "greetd" "su" "slim" "gdm-password"))
+         (pam-service
+          (inherit pam)
+          (auth (append (pam-service-auth pam)
+                        (list optional-pam-mount)))
+          (session (append (pam-service-session pam)
+                           (list optional-pam-mount))))
+         pam))))
+
+(define (greetd-shepherd-services config)
+  (map
+   (lambda (tc)
+     (let*
+         ((greetd-bin (file-append (greetd-package tc) "/sbin/greetd"))
+          (greetd-conf (make-greetd-terminal-configuration-file tc))
+          (greetd-vt (greetd-terminal-vt tc)))
+       (shepherd-service
+        (requirement '(user-processes host-name udev virtual-terminal))
+        (provision (list (symbol-append
+                          'term-tty
+                          (string->symbol (greetd-terminal-vt tc)))))
+        (start #~(make-forkexec-constructor
+                  (list #$greetd-bin "-c" #$greetd-conf)
+                  #:log-file
+                  (string-append "/tmp/greetd." #$greetd-vt ".log")))
+        (stop #~(make-kill-destructor)))))
+   (greetd-terminals config)))
+
+(define greetd-service-type
+  (service-type
+   (name 'greetd)
+   (extensions
+    (list
+     (service-extension account-service-type (const %greetd-accounts))
+     (service-extension file-system-service-type (const %greetd-file-systems))
+     (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)))
+   (default-value (greetd-configuration))))
+
 \f
 ;;;
 ;;; The default set of desktop services.
-- 
2.32.0

[bug#49969] [PATCH v2 7/7] doc: Add desktop seatd-service-type and greetd-service-type

[muradm]

* doc/guix.texi (Desktop Services): Provide documentation for
seatd-service-type and greetd-service-type including configuration
and sample usage.
---
 doc/guix.texi | 183 ++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 183 insertions(+)

diff --git a/doc/guix.texi b/doc/guix.texi
index 4eb5324b51..586b879608 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -94,6 +94,7 @@ Copyright @copyright{} 2021 Xinglu Chen@*
 Copyright @copyright{} 2021 Raghav Gururajan@*
 Copyright @copyright{} 2021 Domagoj Stolfa@*
 Copyright @copyright{} 2021 Hui Lu@*
+Copyright @copyright{} 2021 muradm@*
 
 Permission is granted to copy, distribute and/or modify this document
 under the terms of the GNU Free Documentation License, Version 1.3 or
@@ -19694,6 +19695,188 @@ and ``passwd'' is with the value @code{passwd}.
 @end table
 @end deftp
 
+@defvr {Scheme Variable} seatd-service-type
+A minimal seat management daemon, and a universal seat management library.
+
+Seat management takes care of mediating access to shared devices (graphics,
+input), without requiring the applications needing access to be root.
+
+In general should be used as replacement to @code{elogind-service-type}.
+
+@lisp
+(append
+  (list
+   ;; make sure seatd is running
+   (service seatd-service-type)
+
+   (service greetd-service-type
+            (greetd-configuration
+             (terminals
+              (list
+               ;; lets have terminals 1, 2 and 3 run default XDG terminal session
+               (greetd-terminal-configuration (terminal-vt "1"))
+               (greetd-terminal-configuration (terminal-vt "2"))
+               (greetd-terminal-configuration (terminal-vt "3"))
+               ;; and terminals 4, 5 and 6 plain bash terminal session
+               ;; although not so plain, just to illustrate flexibility
+               (greetd-terminal-configuration
+                (terminal-vt "4")
+                (default-session-command greetd-agreety-tty-session))
+               (greetd-terminal-configuration
+                (terminal-vt "5")
+                (default-session-command greetd-agreety-tty-session))
+               (greetd-terminal-configuration
+                (terminal-vt "6")
+                (default-session-command greetd-agreety-tty-session))))))
+
+  ;; normaly one would want %base-services
+  (modify-services %desktop-services
+    ;; seatd/greetd combination can replace these
+    (delete elogind-service-type)
+    (delete agetty-service-type)
+    (delete mingetty-service-type)))
+
+@end lisp
+
+@end defvr
+
+@deftp {Data Type} seatd-configuration
+Configuration record for the seatd daemon service.
+
+@table @asis
+@item @code{seatd} (default: @code{seatd})
+The seatd package to use.
+
+@item @code{user} (default: @samp{"root"})
+User to own the seatd socket.
+
+@item @code{group} (default: @samp{"users"})
+Group to own the seatd socket.
+
+@item @code{socket} (default: @samp{"/run/seatd/socket"})
+Where to create the seatd socket.
+
+@item @code{loglevel} (default: @samp{"error"})
+Log level to output logs. Possible values: @samp{"silent"}, @samp{"error"},
+@samp{"info"} and @samp{"debug"}.
+
+@end table
+@end deftp
+
+@defvr {Scheme Variable} greetd-service-type
+greetd is a minimal and flexible login manager daemon that makes no
+assumptions about what you want to launch.
+
+If you can run it from your shell in a TTY, greetd can start it. If it
+can be taught to speak a simple JSON-based IPC protocol, then it can
+be a greeter.
+
+@code{<greetd-service-type>} provides necessary infrastructure for
+logging in users, including:
+
+@itemize @bullet
+@item
+@code{greetd} PAM service
+
+@item
+Special variation of @code{pam-mount} to mount @code{XDG_RUNTIME_DIR}
+
+@end itemize
+
+@end defvr
+
+@deftp {Data Type} greetd-configuration
+Configuration record for the greetd service.
+
+@table @asis
+@item @code{motd}
+A file-like object containing the ``message of the day''.
+
+@item @code{allow-empty-passwords?} (default: @code{#t})
+Allow empty passwords by default so that first-time users can log in when
+the 'root' account has just been created.
+
+@item @code{terminals} (default: @code{'()})
+List of @code{<greetd-terminal-configuration>} per terminal for which
+@code{greetd} should be started.
+
+@end table
+@end deftp
+
+@deftp {Data Type} greetd-terminal-configuration
+Configuration record for per terminal greetd daemon service.
+
+@table @asis
+@item @code{greetd} (default: @code{greetd})
+The greetd package to use.
+
+@item @code{config-file-name}
+Configuration file name to use for greetd daemon. Generally, autogenerated
+derivation based on @code{terminal-vt} value.
+
+@item @code{terminal-vt} (default: @samp{"7"})
+The VT to run on. Use of a specific VT with appropriate conflict avoidance
+is recommended.
+
+@item @code{default-session-user} (default: @samp{"greeter"})
+The user to use for running the greeter.
+
+@item @code{default-session-command} (default: @code{greetd-agreety-tty-xdg-session})
+The command-line to run to start the default session.
+
+Possible values are:
+
+@itemize @bullet
+@item
+@code{greetd-agreety-tty-session} - bash terminal session
+
+@item
+@code{greetd-agreety-tty-xdg-session} - bash terminal session with XDG environment
+
+@item
+@code{greetd-agreety-session} - custom instance of terminal session
+@end itemize
+
+@end table
+@end deftp
+
+@deftp {Data Type} greetd-agreety-session
+Configuration record for the agreety greetd greeter.
+
+@table @asis
+@item @code{package} (default: @code{bash})
+The package of command.
+
+@item @code{command-bin} (default: @samp{"/bin/bash"})
+Path to binary relative to @code{package}.
+
+@item @code{command-args} (default: @code{'("-l")})
+Command arguments to pass to command.
+
+@item @code{extra-env} (default: @code{'()})
+Extra environment variables to set on login.
+
+@item @code{command-generator}
+Function that receives instance of this configuration as an argument and
+returns @code{program-file} that can be used with @code{agreety} greeter.
+
+Both @code{greetd-agreety-tty-session} and @code{greetd-agreety-tty-xdg-session}
+uses @code{greetd-agreety-session} under the hood.
+
+@end table
+@end deftp
+
+@defvr {Scheme Variable} greetd-agreety-tty-session
+Provides instance of @code{greetd-agreety-session} which starts @samp{"bash -l"}
+on login.
+@end defvr
+
+@defvr {Scheme Variable} greetd-agreety-tty-xdg-session
+Provides instance of @code{greetd-agreety-session} which starts @samp{"bash -l"}
+on login. Additionally, will set @code{XDG_SESSION_TYPE} and
+@code{XDG_RUNTIME_DIR} environment variables for session.
+@end defvr
+
 
 @node Sound Services
 @subsection Sound Services
-- 
2.32.0

[bug#49969] [PATCH v2 1/7] gnu: crates-io: Add rust-enquote 1.0.3

[Xinglu Chen]

[-- Attachment #1: Type: text/plain, Size: 1804 bytes --]

On Tue, Aug 10 2021, muradm wrote:

> * gnu/packages/crates-io.scm (rust-enquote-1): Add rust-enquote 1.0.3
> ---
>  gnu/packages/crates-io.scm | 22 ++++++++++++++++++++++
>  1 file changed, 22 insertions(+)
>
> diff --git a/gnu/packages/crates-io.scm b/gnu/packages/crates-io.scm
> index 24cc772ba7..b458080ca7 100644
> --- a/gnu/packages/crates-io.scm
> +++ b/gnu/packages/crates-io.scm
> @@ -18,6 +18,7 @@
>  ;;; Copyright © 2021 Antero Mejr <antero@kodmin.com>
>  ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
>  ;;; Copyright © 2021 Vinicius Monego <monego@posteo.net>
> +;;; Copyright © 2021 muradm <mail@muradm.net>
>  ;;;
>  ;;; This file is part of GNU Guix.
>  ;;;
> @@ -56972,3 +56973,24 @@ variant of this library is available separately as @code{im}.")
>      (description
>        "Generate Rust register maps (`struct`s) from SVD files")
>      (license (list license:expat license:asl2.0))))
> +
> +(define-public rust-enquote-1
> +  (package
> +    (name "rust-enquote")
> +    (version "1.0.3")
> +    (home-page "https://github.com/reujab/enquote")
> +    (source
> +     (origin
> +       (method url-fetch)
> +       (uri (crate-uri "enquote" version))
> +       (file-name
> +        (string-append name "-" version ".tar.gz"))
> +       (sha256
> +        (base32
> +         "0vm687r2wwgc3d3l2iqhag9wgkql6k93sdvjxvmfkdpksajpij1f"))))
> +    (build-system cargo-build-system)
> +    (synopsis
> +     "This Rust library quotes, unquotes, and unescapes strings.")

The synopsis should not end with a period.  “This” doesn’t really bring
anything, maybe something like

  Rust library that quotes, unquotes, and unescapes strings

See “16.4.4 Synopses and Descriptions” in the manual for more details.

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 861 bytes --]

[bug#49969] [PATCH v2 2/7] gnu: crates-io: Add rust-pam-sys 0.5.6

[Xinglu Chen]

[-- Attachment #1: Type: text/plain, Size: 1980 bytes --]

On Tue, Aug 10 2021, muradm wrote:

> * gnu/packages/crates-io.scm (rust-pam-sys): Add rust-pam-sys 0.5.6
> ---
>  gnu/packages/crates-io.scm | 27 +++++++++++++++++++++++++++
>  1 file changed, 27 insertions(+)
>
> diff --git a/gnu/packages/crates-io.scm b/gnu/packages/crates-io.scm
> index b458080ca7..b365a2c8c0 100644
> --- a/gnu/packages/crates-io.scm
> +++ b/gnu/packages/crates-io.scm
> @@ -56,6 +56,7 @@
>    #:use-module (gnu packages image)
>    #:use-module (gnu packages jemalloc)
>    #:use-module (gnu packages llvm)
> +  #:use-module (gnu packages linux)
>    #:use-module (gnu packages multiprecision)
>    #:use-module (gnu packages nettle)
>    #:use-module (gnu packages pcre)
> @@ -56994,3 +56995,29 @@ variant of this library is available separately as @code{im}.")
>      (description
>       "This Rust library quotes, unquotes, and unescapes strings.")
>      (license license:unlicense)))
> +
> +(define-public rust-pam-sys-0.5.6
> +  (package
> +    (name "rust-pam-sys")
> +    (version "0.5.6")
> +    (home-page "https://github.com/1wilkens/pam-sys")
> +    (source
> +     (origin
> +       (method url-fetch)
> +       (uri (crate-uri "pam-sys" version))
> +       (file-name
> +        (string-append name "-" version ".tar.gz"))
> +       (sha256
> +        (base32
> +         "0d14501d5vybjnzxfjf96321xa5wa36x1xvf02h02zq938qmhj6d"))))
> +    (build-system cargo-build-system)
> +    (arguments
> +     `(#:cargo-inputs
> +       (("rust-libc" ,rust-libc-0.2))))
> +    (native-inputs
> +     `(("linux-pam" ,linux-pam)))
> +    (synopsis
> +     "Rust FFI wrappers for the Linux Pluggable Authentication Modules (PAM).")

The synopsis should not end with a period.

> +    (description
> +     "Rust FFI wrappers for the Linux Pluggable Authentication Modules (PAM).")

The description should contain one or more complete sentences, see
“16.4.4 Synopses and Descriptions” in the manual.

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 861 bytes --]

[bug#49969] [PATCH v2 3/7] gnu: freedesktop: Add greetd 0.7.0

[Xinglu Chen]

[-- Attachment #1: Type: text/plain, Size: 5602 bytes --]

On Tue, Aug 10 2021, muradm wrote:

> * gnu/packages/freedesktop.scm (greetd): Add greetd 0.7.0
> ---
>  gnu/packages/freedesktop.scm | 80 ++++++++++++++++++++++++++++++++++++
>  1 file changed, 80 insertions(+)
>
> diff --git a/gnu/packages/freedesktop.scm b/gnu/packages/freedesktop.scm
> index 693a79c738..631d36e765 100644
> --- a/gnu/packages/freedesktop.scm
> +++ b/gnu/packages/freedesktop.scm
> @@ -24,6 +24,7 @@
>  ;;; Copyright © 2020 Raghav Gururajan <raghavgururajan@disroot.org>
>  ;;; Copyright © 2021 Brendan Tildesley <mail@brendan.scot>
>  ;;; Copyright © 2021 pineapples <guixuser6392@protonmail.com>
> +;;; Copyright © 2021 muradm <mail@muradm.net>
>  ;;;
>  ;;; This file is part of GNU Guix.
>  ;;;
> @@ -46,6 +47,7 @@
>    #:use-module (guix packages)
>    #:use-module (guix download)
>    #:use-module (guix git-download)
> +  #:use-module (guix build-system cargo)
>    #:use-module (guix build-system cmake)
>    #:use-module (guix build-system gnu)
>    #:use-module (guix build-system meson)
> @@ -62,6 +64,7 @@
>    #:use-module (gnu packages check)
>    #:use-module (gnu packages cmake)
>    #:use-module (gnu packages compression)
> +  #:use-module (gnu packages crates-io)
>    #:use-module (gnu packages cryptsetup)
>    #:use-module (gnu packages databases)
>    #:use-module (gnu packages disk)
> @@ -862,6 +865,83 @@ that require it.  It also provides a universal seat management library that
>  allows applications to use whatever seat management is available.")
>      (license license:expat)))
>  
> +(define-public greetd
> +  (package
> +    (name "greetd")
> +    (version "0.7.0")
> +    (home-page "https://git.sr.ht/~kennylevinsen/greetd")
> +    (source (origin
> +              (method git-fetch)
> +              (uri (git-reference
> +                    (url home-page)
> +                    (commit version)))
> +              (file-name (git-file-name name version))
> +              (sha256
> +               (base32 "0lmwr5ld9x2wlq00i7mjgm9by8zndiq9girj8g93k0kww9zbgr3g"))))
> +    (build-system cargo-build-system)
> +    (arguments
> +     `(#:cargo-inputs
> +       (("rust-nix" ,rust-nix-0.17)
> +        ("rust-pam-sys" ,rust-pam-sys-0.5.6)
> +        ("rust-rpassword" ,rust-rpassword-4)
> +        ("rust-users" ,rust-users-0.9)
> +        ("rust-serde" ,rust-serde-1)
> +        ("rust-serde-json" ,rust-serde-json-1)
> +        ("rust-libc" ,rust-libc-0.2)
> +        ("rust-tokio" ,rust-tokio-0.2)
> +        ("rust-getopts" ,rust-getopts-0.2)
> +        ("rust-thiserror" ,rust-thiserror-1)
> +        ("rust-async-trait" ,rust-async-trait-0.1)
> +        ("rust-enquote" ,rust-enquote-1))
> +       #:phases
> +       (modify-phases %standard-phases
> +         ;; once https://todo.sr.ht/~kennylevinsen/greetd/25
> +         ;; is solved, below patch can be removed
> +         (add-after 'unpack 'patch-terminal-switch
> +           (lambda* (#:key inputs #:allow-other-keys)
> +             (substitute* "greetd/src/server.rs"
> +               (("switch: true,")
> +                "switch: false,"))))
> +         (delete 'package)
> +         (replace 'install
> +           (lambda* (#:key inputs outputs #:allow-other-keys)
> +             (let* ((out (assoc-ref outputs "out"))
> +                    (bin (string-append out "/bin"))
> +                    (sbin (string-append out "/sbin"))
> +                    (share (string-append out "/share"))
> +                    (man (string-append share "/man"))
> +                    (man1 (string-append man "/man1"))
> +                    (man5 (string-append man "/man5"))
> +                    (man7 (string-append man "/man7"))
> +                    (release "target/release")
> +                    (greetd-bin (string-append release "/greetd"))
> +                    (agreety-bin (string-append release "/agreety")))
> +               (install-file greetd-bin sbin)
> +               (install-file agreety-bin bin)
> +               (mkdir-p man1)
> +               (mkdir-p man5)
> +               (mkdir-p man7)

No need to ‘mkdir-p’ if you will call ‘install-file’ on the directory.

> +               (with-directory-excursion "man"
> +                 (system "scdoc < greetd-1.scd > greetd.1")
> +                 (system "scdoc < greetd-5.scd > greetd.5")
> +                 (system "scdoc < greetd-ipc-7.scd > greetd-ipc.7")
> +                 (system "scdoc < agreety-1.scd > agreety.1"))
> +               (install-file "man/greetd.1" man1)
> +               (install-file "man/greetd.5" man5)
> +               (install-file "man/greetd-ipc.7" man7)
> +               (install-file "man/agreety.1" man1)

Why not put these four lines inside the (with-directory-excursion "man"
…) form, and remove the "man" prefix?

> +               #t))))))

Phases don’t need to return #t once the ‘core-updates’ branch gets
merged.

> +    (native-inputs
> +     `(("linux-pam" ,linux-pam)
> +       ("scdoc" ,scdoc)))
> +    (synopsis
> +     "greetd is a minimal and flexible login manager daemon
> +that makes no assumptions about what you want to launch.")

The synosis is a bit long, maybe

  Minimal and flexible login manager daemon

> +    (description
> +     "greetd is a minimal and flexible login manager daemon
> +that makes no assumptions about what you want to launch.")

“what you want to launch” sounds a bit vague, is it referring to desktop
environment, window manager, or something else?

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 861 bytes --]

[bug#49969] [PATCH v2 4/7] gnu: admin: Add greetd-pam-mount

[Xinglu Chen]

[-- Attachment #1: Type: text/plain, Size: 2325 bytes --]

On Tue, Aug 10 2021, muradm wrote:

> This package inherits pam-mount in the way that it is compiled
> specifically for use with greetd daemon. It uses different
> configuration location and name space for storing data in PAM.
>
> greetd-pam-mount is used in configuration of greetd to provide
> auto-(mounting/unmounting) of XDG_RUNTIME_DIR in the way that
> it will not interfere with default pam-mount configuration.

It might be a good idea to put this in a comment in the code too.  :-)

> * gnu/packages/admin.scm (greetd-pam-mount): Add greetd-pam-mount
> ---
>  gnu/packages/admin.scm | 20 ++++++++++++++++++++
>  1 file changed, 20 insertions(+)
>
> diff --git a/gnu/packages/admin.scm b/gnu/packages/admin.scm
> index eda269f148..e805b219c5 100644
> --- a/gnu/packages/admin.scm
> +++ b/gnu/packages/admin.scm
> @@ -42,6 +42,7 @@
>  ;;; Copyright © 2021 David Larsson <david.larsson@selfhosted.xyz>
>  ;;; Copyright © 2021 WinterHound <winterhound@yandex.com>
>  ;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
> +;;; Copyright © 2021 muradm <mail@muradm.net>
>  ;;;
>  ;;; This file is part of GNU Guix.
>  ;;;
> @@ -4247,6 +4248,25 @@ supports.  It can also mount encrypted LUKS volumes using the password
>  supplied by the user when logging in.")
>      (license (list license:gpl2+ license:lgpl2.1+))))
>  
> +(define-public greetd-pam-mount
> +  (package
> +    (inherit pam-mount)
> +    (name "greetd-pam-mount")
> +    (arguments
> +     (substitute-keyword-arguments (package-arguments pam-mount)
> +       ((#:configure-flags flags ''())
> +        `(cons* "--with-rundir=/run/greetd" ,flags))
> +       ((#:phases phases)
> +        `(modify-phases ,phases
> +           (add-after 'unpack 'patch-config-file-name
> +             (lambda* (#:key inputs #:allow-other-keys)
> +               (substitute* "src/pam_mount.c"
> +                 ((".*define CONFIGFILE .*$")
> +                  "#define CONFIGFILE \"/etc/security/greetd_pam_mount.conf.xml\"\n")
> +                 (("pam_mount_config") "greetd_pam_mount_config")
> +                 (("pam_mount_system_authtok") "greetd_pam_mount_system_authtok"))))))))
> +    (synopsis "pam-mount specifically compiled for use with greetd")))

The description should also be updated.

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 861 bytes --]

[bug#49969] [PATCH v2 5/7] gnu: desktop: Add seatd-service-type

[Xinglu Chen]

[-- Attachment #1: Type: text/plain, Size: 4134 bytes --]

On Tue, Aug 10 2021, muradm wrote:

> A seat management daemon, that does everything it needs to do.
> Nothing more, nothing less. Depends only on libc.

I don’t it is necessary to put this in the commit log.

> * gnu/services/desktop.scm: Add seatd-service-type
> ---
>  gnu/services/desktop.scm | 59 +++++++++++++++++++++++++++++++++++++++-
>  1 file changed, 58 insertions(+), 1 deletion(-)
>
> diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
> index 64d0e85301..bfba9bccec 100644
> --- a/gnu/services/desktop.scm
> +++ b/gnu/services/desktop.scm
> @@ -13,6 +13,7 @@
>  ;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
>  ;;; Copyright © 2020 Reza Alizadeh Majd <r.majd@pantherx.org>
>  ;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
> +;;; Copyright © 2021 muradm <mail@muradm.net>
>  ;;;
>  ;;; This file is part of GNU Guix.
>  ;;;
> @@ -39,7 +40,9 @@
>    #:use-module (gnu services networking)
>    #:use-module (gnu services sound)
>    #:use-module ((gnu system file-systems)
> -                #:select (%elogind-file-systems file-system))
> +                #:select (%control-groups
> +                          %elogind-file-systems
> +                          file-system))
>    #:use-module (gnu system)
>    #:use-module (gnu system setuid)
>    #:use-module (gnu system shadow)
> @@ -154,6 +157,9 @@
>              gnome-keyring-configuration?
>              gnome-keyring-service-type
>  
> +            seatd-configuration
> +            seatd-service-type
> +
>              %desktop-services))
>  
>  ;;; Commentary:
> @@ -1182,6 +1188,57 @@ or setting its password with passwd.")))
>  (define polkit-wheel-service
>    (simple-service 'polkit-wheel polkit-service-type (list polkit-wheel)))
>  
> +\f
> +;;;
> +;;; seatd-service-type -- minimal seat management daemon
> +;;;
> +
> +(define-record-type* <seatd-configuration> seatd-configuration
> +  make-seatd-configuration
> +  seatd-configuration?
> +  (seatd seatd-package (default seatd))
> +  (user seatd-user (default "root"))
> +  (group seatd-group (default "users"))
> +  (socket seatd-socket (default "/run/seatd/socket"))
> +  (loglevel seatd-loglevel (default "error")))
> +
> +(define (seatd-shepherd-service config)
> +  (list (shepherd-service
> +         (requirement '())
> +         ;; TODO: once cgroups is separate dependency
> +         ;; here we should depend on it rather than elogind
> +         (provision '(seatd elogind))
> +         (start #~(make-forkexec-constructor
> +                   (list #$(file-append (seatd-package config) "/bin/seatd")
> +                         "-u" #$(seatd-user config)
> +                         "-g" #$(seatd-group config)
> +                         "-s" #$(seatd-socket config))
> +                   #:environment-variables
> +                   (list (string-append "SEATD_LOGLEVEL="
> +                                        #$(seatd-loglevel config)))
> +                   #:log-file "/tmp/seatd.log"))
> +         (stop #~(make-kill-destructor)))))

‘documentation’ field is missing.

> +
> +(define seatd-environment
> +  (match-lambda
> +    (($ <seatd-configuration> _ _ _ socket)
> +     `(("SEATD_SOCK" . ,socket)))))
> +
> +(define seatd-service-type
> +  (service-type
> +   (name 'seatd)
> +   (extensions
> +    (list
> +     (service-extension session-environment-service-type
> +                        seatd-environment)
> +     ;; TODO: once cgroups is separate dependency
> +     ;; we should not mount it here
> +     (service-extension file-system-service-type
> +                        (const %control-groups))
> +     (service-extension shepherd-root-service-type
> +                        seatd-shepherd-service)))
> +   (default-value (seatd-configuration))))

Missing ‘description’ field.

It might also be a good idea to write a system test for the service, you
can look at the (gnu tests …) modules for examples.

I am not familiar with how seatd works, so I can’t really comment too
much.  :-)

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 861 bytes --]

[bug#49969] [PATCH v2 1/7] gnu: crates-io: Add rust-enquote 1.0.3

[muradm]

Noted for next update, thanks

Xinglu Chen <public@yoctocell.xyz> writes:

> On Tue, Aug 10 2021, muradm wrote:
>
>> * gnu/packages/crates-io.scm (rust-enquote-1): Add rust-enquote 
>> 1.0.3
>> ---
>>  gnu/packages/crates-io.scm | 22 ++++++++++++++++++++++
>>  1 file changed, 22 insertions(+)
>>
>> diff --git a/gnu/packages/crates-io.scm 
>> b/gnu/packages/crates-io.scm
>> index 24cc772ba7..b458080ca7 100644
>> --- a/gnu/packages/crates-io.scm
>> +++ b/gnu/packages/crates-io.scm
>> @@ -18,6 +18,7 @@
>>  ;;; Copyright © 2021 Antero Mejr <antero@kodmin.com>
>>  ;;; Copyright © 2021 Maxim Cournoyer 
>>  <maxim.cournoyer@gmail.com>
>>  ;;; Copyright © 2021 Vinicius Monego <monego@posteo.net>
>> +;;; Copyright © 2021 muradm <mail@muradm.net>
>>  ;;;
>>  ;;; This file is part of GNU Guix.
>>  ;;;
>> @@ -56972,3 +56973,24 @@ variant of this library is available 
>> separately as @code{im}.")
>>      (description
>>        "Generate Rust register maps (`struct`s) from SVD 
>>        files")
>>      (license (list license:expat license:asl2.0))))
>> +
>> +(define-public rust-enquote-1
>> +  (package
>> +    (name "rust-enquote")
>> +    (version "1.0.3")
>> +    (home-page "https://github.com/reujab/enquote")
>> +    (source
>> +     (origin
>> +       (method url-fetch)
>> +       (uri (crate-uri "enquote" version))
>> +       (file-name
>> +        (string-append name "-" version ".tar.gz"))
>> +       (sha256
>> +        (base32
>> +         "0vm687r2wwgc3d3l2iqhag9wgkql6k93sdvjxvmfkdpksajpij1f"))))
>> +    (build-system cargo-build-system)
>> +    (synopsis
>> +     "This Rust library quotes, unquotes, and unescapes 
>> strings.")
>
> The synopsis should not end with a period.  “This” doesn’t 
> really bring
> anything, maybe something like
>
>   Rust library that quotes, unquotes, and unescapes strings
>
> See “16.4.4 Synopses and Descriptions” in the manual for more 
> details.

[bug#49969] [PATCH v2 2/7] gnu: crates-io: Add rust-pam-sys 0.5.6

[muradm]

Noted for next update, thanks

Xinglu Chen <public@yoctocell.xyz> writes:

> On Tue, Aug 10 2021, muradm wrote:
>
>> * gnu/packages/crates-io.scm (rust-pam-sys): Add rust-pam-sys 
>> 0.5.6
>> ---
>>  gnu/packages/crates-io.scm | 27 +++++++++++++++++++++++++++
>>  1 file changed, 27 insertions(+)
>>
>> diff --git a/gnu/packages/crates-io.scm 
>> b/gnu/packages/crates-io.scm
>> index b458080ca7..b365a2c8c0 100644
>> --- a/gnu/packages/crates-io.scm
>> +++ b/gnu/packages/crates-io.scm
>> @@ -56,6 +56,7 @@
>>    #:use-module (gnu packages image)
>>    #:use-module (gnu packages jemalloc)
>>    #:use-module (gnu packages llvm)
>> +  #:use-module (gnu packages linux)
>>    #:use-module (gnu packages multiprecision)
>>    #:use-module (gnu packages nettle)
>>    #:use-module (gnu packages pcre)
>> @@ -56994,3 +56995,29 @@ variant of this library is available 
>> separately as @code{im}.")
>>      (description
>>       "This Rust library quotes, unquotes, and unescapes 
>>       strings.")
>>      (license license:unlicense)))
>> +
>> +(define-public rust-pam-sys-0.5.6
>> +  (package
>> +    (name "rust-pam-sys")
>> +    (version "0.5.6")
>> +    (home-page "https://github.com/1wilkens/pam-sys")
>> +    (source
>> +     (origin
>> +       (method url-fetch)
>> +       (uri (crate-uri "pam-sys" version))
>> +       (file-name
>> +        (string-append name "-" version ".tar.gz"))
>> +       (sha256
>> +        (base32
>> +         "0d14501d5vybjnzxfjf96321xa5wa36x1xvf02h02zq938qmhj6d"))))
>> +    (build-system cargo-build-system)
>> +    (arguments
>> +     `(#:cargo-inputs
>> +       (("rust-libc" ,rust-libc-0.2))))
>> +    (native-inputs
>> +     `(("linux-pam" ,linux-pam)))
>> +    (synopsis
>> +     "Rust FFI wrappers for the Linux Pluggable Authentication 
>> Modules (PAM).")
>
> The synopsis should not end with a period.
>
>> +    (description
>> +     "Rust FFI wrappers for the Linux Pluggable Authentication 
>> Modules (PAM).")
>
> The description should contain one or more complete sentences, 
> see
> “16.4.4 Synopses and Descriptions” in the manual.

[bug#49969] [PATCH v2 3/7] gnu: freedesktop: Add greetd 0.7.0

[muradm]

Xinglu Chen <public@yoctocell.xyz> writes:

> On Tue, Aug 10 2021, muradm wrote:
>
>> * gnu/packages/freedesktop.scm (greetd): Add greetd 0.7.0
>> ---
>>  gnu/packages/freedesktop.scm | 80 
>>  ++++++++++++++++++++++++++++++++++++
>>  1 file changed, 80 insertions(+)
>>
>> diff --git a/gnu/packages/freedesktop.scm 
>> b/gnu/packages/freedesktop.scm
>> index 693a79c738..631d36e765 100644
>> --- a/gnu/packages/freedesktop.scm
>> +++ b/gnu/packages/freedesktop.scm
>> @@ -24,6 +24,7 @@
>>  ;;; Copyright © 2020 Raghav Gururajan 
>>  <raghavgururajan@disroot.org>
>>  ;;; Copyright © 2021 Brendan Tildesley <mail@brendan.scot>
>>  ;;; Copyright © 2021 pineapples <guixuser6392@protonmail.com>
>> +;;; Copyright © 2021 muradm <mail@muradm.net>
>>  ;;;
>>  ;;; This file is part of GNU Guix.
>>  ;;;
>> @@ -46,6 +47,7 @@
>>    #:use-module (guix packages)
>>    #:use-module (guix download)
>>    #:use-module (guix git-download)
>> +  #:use-module (guix build-system cargo)
>>    #:use-module (guix build-system cmake)
>>    #:use-module (guix build-system gnu)
>>    #:use-module (guix build-system meson)
>> @@ -62,6 +64,7 @@
>>    #:use-module (gnu packages check)
>>    #:use-module (gnu packages cmake)
>>    #:use-module (gnu packages compression)
>> +  #:use-module (gnu packages crates-io)
>>    #:use-module (gnu packages cryptsetup)
>>    #:use-module (gnu packages databases)
>>    #:use-module (gnu packages disk)
>> @@ -862,6 +865,83 @@ that require it.  It also provides a 
>> universal seat management library that
>>  allows applications to use whatever seat management is 
>>  available.")
>>      (license license:expat)))
>>
>> +(define-public greetd
>> +  (package
>> +    (name "greetd")
>> +    (version "0.7.0")
>> +    (home-page "https://git.sr.ht/~kennylevinsen/greetd")
>> +    (source (origin
>> +              (method git-fetch)
>> +              (uri (git-reference
>> +                    (url home-page)
>> +                    (commit version)))
>> +              (file-name (git-file-name name version))
>> +              (sha256
>> +               (base32 
>> "0lmwr5ld9x2wlq00i7mjgm9by8zndiq9girj8g93k0kww9zbgr3g"))))
>> +    (build-system cargo-build-system)
>> +    (arguments
>> +     `(#:cargo-inputs
>> +       (("rust-nix" ,rust-nix-0.17)
>> +        ("rust-pam-sys" ,rust-pam-sys-0.5.6)
>> +        ("rust-rpassword" ,rust-rpassword-4)
>> +        ("rust-users" ,rust-users-0.9)
>> +        ("rust-serde" ,rust-serde-1)
>> +        ("rust-serde-json" ,rust-serde-json-1)
>> +        ("rust-libc" ,rust-libc-0.2)
>> +        ("rust-tokio" ,rust-tokio-0.2)
>> +        ("rust-getopts" ,rust-getopts-0.2)
>> +        ("rust-thiserror" ,rust-thiserror-1)
>> +        ("rust-async-trait" ,rust-async-trait-0.1)
>> +        ("rust-enquote" ,rust-enquote-1))
>> +       #:phases
>> +       (modify-phases %standard-phases
>> +         ;; once https://todo.sr.ht/~kennylevinsen/greetd/25
>> +         ;; is solved, below patch can be removed
>> +         (add-after 'unpack 'patch-terminal-switch
>> +           (lambda* (#:key inputs #:allow-other-keys)
>> +             (substitute* "greetd/src/server.rs"
>> +               (("switch: true,")
>> +                "switch: false,"))))
>> +         (delete 'package)
>> +         (replace 'install
>> +           (lambda* (#:key inputs outputs #:allow-other-keys)
>> +             (let* ((out (assoc-ref outputs "out"))
>> +                    (bin (string-append out "/bin"))
>> +                    (sbin (string-append out "/sbin"))
>> +                    (share (string-append out "/share"))
>> +                    (man (string-append share "/man"))
>> +                    (man1 (string-append man "/man1"))
>> +                    (man5 (string-append man "/man5"))
>> +                    (man7 (string-append man "/man7"))
>> +                    (release "target/release")
>> +                    (greetd-bin (string-append release 
>> "/greetd"))
>> +                    (agreety-bin (string-append release 
>> "/agreety")))
>> +               (install-file greetd-bin sbin)
>> +               (install-file agreety-bin bin)
>> +               (mkdir-p man1)
>> +               (mkdir-p man5)
>> +               (mkdir-p man7)
>
> No need to ‘mkdir-p’ if you will call ‘install-file’ on the 
> directory.
>

Didn't work for me, without it I get:
In procedure copy-file: No such file or directory

>> +               (with-directory-excursion "man"
>> +                 (system "scdoc < greetd-1.scd > greetd.1")
>> +                 (system "scdoc < greetd-5.scd > greetd.5")
>> +                 (system "scdoc < greetd-ipc-7.scd > 
>> greetd-ipc.7")
>> +                 (system "scdoc < agreety-1.scd > agreety.1"))
>> +               (install-file "man/greetd.1" man1)
>> +               (install-file "man/greetd.5" man5)
>> +               (install-file "man/greetd-ipc.7" man7)
>> +               (install-file "man/agreety.1" man1)
>
> Why not put these four lines inside the 
> (with-directory-excursion "man"
> …) form, and remove the "man" prefix?
>

Refactored, scdoc moved to 'build-man-pages after 'build, install 
minimized

         (add-after 'build 'build-man-pages
           (lambda* (#:key inputs #:allow-other-keys)
             (define (scdoc-cmd doc lvl)
               (system (string-append "scdoc < "
                                      doc "-" lvl ".scd > "
                                      doc "." lvl)))
             (with-directory-excursion "man"
               (scdoc-cmd "greetd" "1")
               (scdoc-cmd "greetd" "5")
               (scdoc-cmd "greetd-ipc" "7")
               (scdoc-cmd "agreety" "1"))))
         (replace 'install
           (lambda* (#:key inputs outputs #:allow-other-keys)
             (let* ((out (assoc-ref outputs "out"))
                    (bin (string-append out "/bin"))
                    (sbin (string-append out "/sbin"))
                    (share (string-append out "/share"))
                    (man (string-append share "/man"))
                    (man1 (string-append man "/man1"))
                    (man5 (string-append man "/man5"))
                    (man7 (string-append man "/man7"))
                    (release "target/release")
                    (greetd-bin (string-append release "/greetd"))
                    (agreety-bin (string-append release 
                    "/agreety")))
               (install-file greetd-bin sbin)
               (install-file agreety-bin bin)
               (with-directory-excursion "man"
                 (install-file "greetd.1" man1)
                 (install-file "greetd.5" man5)
                 (install-file "greetd-ipc.7" man7)
                 (install-file "agreety.1" man1))))))))

Noted for next update, thanks

>> +               #t))))))
>
> Phases don’t need to return #t once the ‘core-updates’ branch 
> gets
> merged.
>

Left over, i was using this to fail package build, noted for next 
update, thanks

>> +    (native-inputs
>> +     `(("linux-pam" ,linux-pam)
>> +       ("scdoc" ,scdoc)))
>> +    (synopsis
>> +     "greetd is a minimal and flexible login manager daemon
>> +that makes no assumptions about what you want to launch.")
>
> The synosis is a bit long, maybe
>
>   Minimal and flexible login manager daemon
>

Noted for next update, thanks

>> +    (description
>> +     "greetd is a minimal and flexible login manager daemon
>> +that makes no assumptions about what you want to launch.")
>
> “what you want to launch” sounds a bit vague, is it referring to 
> desktop
> environment, window manager, or something else?

As description says anything, it is from official documentation. 
Launches any thing,
could be DE, WM, Emacs, top etc. literally any thing :)

[bug#49969] [PATCH v2 4/7] gnu: admin: Add greetd-pam-mount

[muradm]

Noted for next update, thanks

Xinglu Chen <public@yoctocell.xyz> writes:

> On Tue, Aug 10 2021, muradm wrote:
>
>> This package inherits pam-mount in the way that it is compiled
>> specifically for use with greetd daemon. It uses different
>> configuration location and name space for storing data in PAM.
>>
>> greetd-pam-mount is used in configuration of greetd to provide
>> auto-(mounting/unmounting) of XDG_RUNTIME_DIR in the way that
>> it will not interfere with default pam-mount configuration.
>
> It might be a good idea to put this in a comment in the code 
> too.  :-)
>
>> * gnu/packages/admin.scm (greetd-pam-mount): Add 
>> greetd-pam-mount
>> ---
>>  gnu/packages/admin.scm | 20 ++++++++++++++++++++
>>  1 file changed, 20 insertions(+)
>>
>> diff --git a/gnu/packages/admin.scm b/gnu/packages/admin.scm
>> index eda269f148..e805b219c5 100644
>> --- a/gnu/packages/admin.scm
>> +++ b/gnu/packages/admin.scm
>> @@ -42,6 +42,7 @@
>>  ;;; Copyright © 2021 David Larsson 
>>  <david.larsson@selfhosted.xyz>
>>  ;;; Copyright © 2021 WinterHound <winterhound@yandex.com>
>>  ;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
>> +;;; Copyright © 2021 muradm <mail@muradm.net>
>>  ;;;
>>  ;;; This file is part of GNU Guix.
>>  ;;;
>> @@ -4247,6 +4248,25 @@ supports.  It can also mount encrypted 
>> LUKS volumes using the password
>>  supplied by the user when logging in.")
>>      (license (list license:gpl2+ license:lgpl2.1+))))
>>
>> +(define-public greetd-pam-mount
>> +  (package
>> +    (inherit pam-mount)
>> +    (name "greetd-pam-mount")
>> +    (arguments
>> +     (substitute-keyword-arguments (package-arguments 
>> pam-mount)
>> +       ((#:configure-flags flags ''())
>> +        `(cons* "--with-rundir=/run/greetd" ,flags))
>> +       ((#:phases phases)
>> +        `(modify-phases ,phases
>> +           (add-after 'unpack 'patch-config-file-name
>> +             (lambda* (#:key inputs #:allow-other-keys)
>> +               (substitute* "src/pam_mount.c"
>> +                 ((".*define CONFIGFILE .*$")
>> +                  "#define CONFIGFILE 
>> \"/etc/security/greetd_pam_mount.conf.xml\"\n")
>> +                 (("pam_mount_config") 
>> "greetd_pam_mount_config")
>> +                 (("pam_mount_system_authtok") 
>> "greetd_pam_mount_system_authtok"))))))))
>> +    (synopsis "pam-mount specifically compiled for use with 
>> greetd")))
>
> The description should also be updated.

[bug#49969] [PATCH v2 5/7] gnu: desktop: Add seatd-service-type

[muradm]

Noted for next update, thanks

Xinglu Chen <public@yoctocell.xyz> writes:

> On Tue, Aug 10 2021, muradm wrote:
>
>> A seat management daemon, that does everything it needs to do.
>> Nothing more, nothing less. Depends only on libc.
>
> I don’t it is necessary to put this in the commit log.
>
>> * gnu/services/desktop.scm: Add seatd-service-type
>> ---
>>  gnu/services/desktop.scm | 59 
>>  +++++++++++++++++++++++++++++++++++++++-
>>  1 file changed, 58 insertions(+), 1 deletion(-)
>>
>> diff --git a/gnu/services/desktop.scm 
>> b/gnu/services/desktop.scm
>> index 64d0e85301..bfba9bccec 100644
>> --- a/gnu/services/desktop.scm
>> +++ b/gnu/services/desktop.scm
>> @@ -13,6 +13,7 @@
>>  ;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
>>  ;;; Copyright © 2020 Reza Alizadeh Majd <r.majd@pantherx.org>
>>  ;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
>> +;;; Copyright © 2021 muradm <mail@muradm.net>
>>  ;;;
>>  ;;; This file is part of GNU Guix.
>>  ;;;
>> @@ -39,7 +40,9 @@
>>    #:use-module (gnu services networking)
>>    #:use-module (gnu services sound)
>>    #:use-module ((gnu system file-systems)
>> -                #:select (%elogind-file-systems file-system))
>> +                #:select (%control-groups
>> +                          %elogind-file-systems
>> +                          file-system))
>>    #:use-module (gnu system)
>>    #:use-module (gnu system setuid)
>>    #:use-module (gnu system shadow)
>> @@ -154,6 +157,9 @@
>>              gnome-keyring-configuration?
>>              gnome-keyring-service-type
>>
>> +            seatd-configuration
>> +            seatd-service-type
>> +
>>              %desktop-services))
>>
>>  ;;; Commentary:
>> @@ -1182,6 +1188,57 @@ or setting its password with passwd.")))
>>  (define polkit-wheel-service
>>    (simple-service 'polkit-wheel polkit-service-type (list 
>>    polkit-wheel)))
>>
>> +\f
>> +;;;
>> +;;; seatd-service-type -- minimal seat management daemon
>> +;;;
>> +
>> +(define-record-type* <seatd-configuration> seatd-configuration
>> +  make-seatd-configuration
>> +  seatd-configuration?
>> +  (seatd seatd-package (default seatd))
>> +  (user seatd-user (default "root"))
>> +  (group seatd-group (default "users"))
>> +  (socket seatd-socket (default "/run/seatd/socket"))
>> +  (loglevel seatd-loglevel (default "error")))
>> +
>> +(define (seatd-shepherd-service config)
>> +  (list (shepherd-service
>> +         (requirement '())
>> +         ;; TODO: once cgroups is separate dependency
>> +         ;; here we should depend on it rather than elogind
>> +         (provision '(seatd elogind))
>> +         (start #~(make-forkexec-constructor
>> +                   (list #$(file-append (seatd-package config) 
>> "/bin/seatd")
>> +                         "-u" #$(seatd-user config)
>> +                         "-g" #$(seatd-group config)
>> +                         "-s" #$(seatd-socket config))
>> +                   #:environment-variables
>> +                   (list (string-append "SEATD_LOGLEVEL="
>> +                                        #$(seatd-loglevel 
>> config)))
>> +                   #:log-file "/tmp/seatd.log"))
>> +         (stop #~(make-kill-destructor)))))
>
> ‘documentation’ field is missing.
>
>> +
>> +(define seatd-environment
>> +  (match-lambda
>> +    (($ <seatd-configuration> _ _ _ socket)
>> +     `(("SEATD_SOCK" . ,socket)))))
>> +
>> +(define seatd-service-type
>> +  (service-type
>> +   (name 'seatd)
>> +   (extensions
>> +    (list
>> +     (service-extension session-environment-service-type
>> +                        seatd-environment)
>> +     ;; TODO: once cgroups is separate dependency
>> +     ;; we should not mount it here
>> +     (service-extension file-system-service-type
>> +                        (const %control-groups))
>> +     (service-extension shepherd-root-service-type
>> +                        seatd-shepherd-service)))
>> +   (default-value (seatd-configuration))))
>
> Missing ‘description’ field.
>
> It might also be a good idea to write a system test for the 
> service, you
> can look at the (gnu tests …) modules for examples.
>
> I am not familiar with how seatd works, so I can’t really 
> comment too
> much.  :-)

[bug#49969] [PATCH v2 3/7] gnu: freedesktop: Add greetd 0.7.0

[Xinglu Chen]

[-- Attachment #1: Type: text/plain, Size: 7975 bytes --]

On Wed, Aug 11 2021, muradm wrote:

> Xinglu Chen <public@yoctocell.xyz> writes:
>
>> On Tue, Aug 10 2021, muradm wrote:
>>
>>> * gnu/packages/freedesktop.scm (greetd): Add greetd 0.7.0
>>> ---
>>>  gnu/packages/freedesktop.scm | 80 
>>>  ++++++++++++++++++++++++++++++++++++
>>>  1 file changed, 80 insertions(+)
>>>
>>> diff --git a/gnu/packages/freedesktop.scm 
>>> b/gnu/packages/freedesktop.scm
>>> index 693a79c738..631d36e765 100644
>>> --- a/gnu/packages/freedesktop.scm
>>> +++ b/gnu/packages/freedesktop.scm
>>> @@ -24,6 +24,7 @@
>>>  ;;; Copyright © 2020 Raghav Gururajan 
>>>  <raghavgururajan@disroot.org>
>>>  ;;; Copyright © 2021 Brendan Tildesley <mail@brendan.scot>
>>>  ;;; Copyright © 2021 pineapples <guixuser6392@protonmail.com>
>>> +;;; Copyright © 2021 muradm <mail@muradm.net>
>>>  ;;;
>>>  ;;; This file is part of GNU Guix.
>>>  ;;;
>>> @@ -46,6 +47,7 @@
>>>    #:use-module (guix packages)
>>>    #:use-module (guix download)
>>>    #:use-module (guix git-download)
>>> +  #:use-module (guix build-system cargo)
>>>    #:use-module (guix build-system cmake)
>>>    #:use-module (guix build-system gnu)
>>>    #:use-module (guix build-system meson)
>>> @@ -62,6 +64,7 @@
>>>    #:use-module (gnu packages check)
>>>    #:use-module (gnu packages cmake)
>>>    #:use-module (gnu packages compression)
>>> +  #:use-module (gnu packages crates-io)
>>>    #:use-module (gnu packages cryptsetup)
>>>    #:use-module (gnu packages databases)
>>>    #:use-module (gnu packages disk)
>>> @@ -862,6 +865,83 @@ that require it.  It also provides a 
>>> universal seat management library that
>>>  allows applications to use whatever seat management is 
>>>  available.")
>>>      (license license:expat)))
>>>
>>> +(define-public greetd
>>> +  (package
>>> +    (name "greetd")
>>> +    (version "0.7.0")
>>> +    (home-page "https://git.sr.ht/~kennylevinsen/greetd")
>>> +    (source (origin
>>> +              (method git-fetch)
>>> +              (uri (git-reference
>>> +                    (url home-page)
>>> +                    (commit version)))
>>> +              (file-name (git-file-name name version))
>>> +              (sha256
>>> +               (base32 
>>> "0lmwr5ld9x2wlq00i7mjgm9by8zndiq9girj8g93k0kww9zbgr3g"))))
>>> +    (build-system cargo-build-system)
>>> +    (arguments
>>> +     `(#:cargo-inputs
>>> +       (("rust-nix" ,rust-nix-0.17)
>>> +        ("rust-pam-sys" ,rust-pam-sys-0.5.6)
>>> +        ("rust-rpassword" ,rust-rpassword-4)
>>> +        ("rust-users" ,rust-users-0.9)
>>> +        ("rust-serde" ,rust-serde-1)
>>> +        ("rust-serde-json" ,rust-serde-json-1)
>>> +        ("rust-libc" ,rust-libc-0.2)
>>> +        ("rust-tokio" ,rust-tokio-0.2)
>>> +        ("rust-getopts" ,rust-getopts-0.2)
>>> +        ("rust-thiserror" ,rust-thiserror-1)
>>> +        ("rust-async-trait" ,rust-async-trait-0.1)
>>> +        ("rust-enquote" ,rust-enquote-1))
>>> +       #:phases
>>> +       (modify-phases %standard-phases
>>> +         ;; once https://todo.sr.ht/~kennylevinsen/greetd/25
>>> +         ;; is solved, below patch can be removed
>>> +         (add-after 'unpack 'patch-terminal-switch
>>> +           (lambda* (#:key inputs #:allow-other-keys)
>>> +             (substitute* "greetd/src/server.rs"
>>> +               (("switch: true,")
>>> +                "switch: false,"))))
>>> +         (delete 'package)
>>> +         (replace 'install
>>> +           (lambda* (#:key inputs outputs #:allow-other-keys)
>>> +             (let* ((out (assoc-ref outputs "out"))
>>> +                    (bin (string-append out "/bin"))
>>> +                    (sbin (string-append out "/sbin"))
>>> +                    (share (string-append out "/share"))
>>> +                    (man (string-append share "/man"))
>>> +                    (man1 (string-append man "/man1"))
>>> +                    (man5 (string-append man "/man5"))
>>> +                    (man7 (string-append man "/man7"))
>>> +                    (release "target/release")
>>> +                    (greetd-bin (string-append release 
>>> "/greetd"))
>>> +                    (agreety-bin (string-append release 
>>> "/agreety")))
>>> +               (install-file greetd-bin sbin)
>>> +               (install-file agreety-bin bin)
>>> +               (mkdir-p man1)
>>> +               (mkdir-p man5)
>>> +               (mkdir-p man7)
>>
>> No need to ‘mkdir-p’ if you will call ‘install-file’ on the 
>> directory.
>>
>
> Didn't work for me, without it I get:
> In procedure copy-file: No such file or directory

Hmm, weird, the docs for ‘install-file’ says

   -- Scheme Procedure: install-file FILE DIRECTORY
       Create DIRECTORY if it does not exist and copy FILE in there under
       the same name.

>>> +               (with-directory-excursion "man"
>>> +                 (system "scdoc < greetd-1.scd > greetd.1")
>>> +                 (system "scdoc < greetd-5.scd > greetd.5")
>>> +                 (system "scdoc < greetd-ipc-7.scd > 
>>> greetd-ipc.7")
>>> +                 (system "scdoc < agreety-1.scd > agreety.1"))
>>> +               (install-file "man/greetd.1" man1)
>>> +               (install-file "man/greetd.5" man5)
>>> +               (install-file "man/greetd-ipc.7" man7)
>>> +               (install-file "man/agreety.1" man1)
>>
>> Why not put these four lines inside the 
>> (with-directory-excursion "man"
>> …) form, and remove the "man" prefix?
>>
>
> Refactored, scdoc moved to 'build-man-pages after 'build, install 
> minimized
>
>          (add-after 'build 'build-man-pages
>            (lambda* (#:key inputs #:allow-other-keys)
>              (define (scdoc-cmd doc lvl)
>                (system (string-append "scdoc < "
>                                       doc "-" lvl ".scd > "
>                                       doc "." lvl)))
>              (with-directory-excursion "man"
>                (scdoc-cmd "greetd" "1")
>                (scdoc-cmd "greetd" "5")
>                (scdoc-cmd "greetd-ipc" "7")
>                (scdoc-cmd "agreety" "1"))))
>          (replace 'install
>            (lambda* (#:key inputs outputs #:allow-other-keys)
>              (let* ((out (assoc-ref outputs "out"))
>                     (bin (string-append out "/bin"))
>                     (sbin (string-append out "/sbin"))
>                     (share (string-append out "/share"))
>                     (man (string-append share "/man"))
>                     (man1 (string-append man "/man1"))
>                     (man5 (string-append man "/man5"))
>                     (man7 (string-append man "/man7"))
>                     (release "target/release")
>                     (greetd-bin (string-append release "/greetd"))
>                     (agreety-bin (string-append release 
>                     "/agreety")))
>                (install-file greetd-bin sbin)
>                (install-file agreety-bin bin)
>                (with-directory-excursion "man"
>                  (install-file "greetd.1" man1)
>                  (install-file "greetd.5" man5)
>                  (install-file "greetd-ipc.7" man7)
>                  (install-file "agreety.1" man1))))))))
>
> Noted for next update, thanks

The phases LGTM!

>>> +    (description
>>> +     "greetd is a minimal and flexible login manager daemon
>>> +that makes no assumptions about what you want to launch.")
>>
>> “what you want to launch” sounds a bit vague, is it referring to 
>> desktop
>> environment, window manager, or something else?
>
> As description says anything, it is from official documentation. 
> Launches any thing,
> could be DE, WM, Emacs, top etc. literally any thing :)

Ah, OK, then maybe “what program” instead of just “what”?  Someone might
try to launch a missile with it ;-)

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 861 bytes --]

[bug#49969] [PATCH v2 3/7] gnu: freedesktop: Add greetd 0.7.0

[muradm]

Xinglu Chen <public@yoctocell.xyz> writes:

> On Wed, Aug 11 2021, muradm wrote:
>
>> Xinglu Chen <public@yoctocell.xyz> writes:
>>
>>> On Tue, Aug 10 2021, muradm wrote:
>>>
>>>> * gnu/packages/freedesktop.scm (greetd): Add greetd 0.7.0
>>>> ---
>>>>  gnu/packages/freedesktop.scm | 80
>>>>  ++++++++++++++++++++++++++++++++++++
>>>>  1 file changed, 80 insertions(+)
>>>>
>>>> diff --git a/gnu/packages/freedesktop.scm
>>>> b/gnu/packages/freedesktop.scm
>>>> index 693a79c738..631d36e765 100644
>>>> --- a/gnu/packages/freedesktop.scm
>>>> +++ b/gnu/packages/freedesktop.scm
>>>> @@ -24,6 +24,7 @@
>>>>  ;;; Copyright © 2020 Raghav Gururajan
>>>>  <raghavgururajan@disroot.org>
>>>>  ;;; Copyright © 2021 Brendan Tildesley <mail@brendan.scot>
>>>>  ;;; Copyright © 2021 pineapples 
>>>>  <guixuser6392@protonmail.com>
>>>> +;;; Copyright © 2021 muradm <mail@muradm.net>
>>>>  ;;;
>>>>  ;;; This file is part of GNU Guix.
>>>>  ;;;
>>>> @@ -46,6 +47,7 @@
>>>>    #:use-module (guix packages)
>>>>    #:use-module (guix download)
>>>>    #:use-module (guix git-download)
>>>> +  #:use-module (guix build-system cargo)
>>>>    #:use-module (guix build-system cmake)
>>>>    #:use-module (guix build-system gnu)
>>>>    #:use-module (guix build-system meson)
>>>> @@ -62,6 +64,7 @@
>>>>    #:use-module (gnu packages check)
>>>>    #:use-module (gnu packages cmake)
>>>>    #:use-module (gnu packages compression)
>>>> +  #:use-module (gnu packages crates-io)
>>>>    #:use-module (gnu packages cryptsetup)
>>>>    #:use-module (gnu packages databases)
>>>>    #:use-module (gnu packages disk)
>>>> @@ -862,6 +865,83 @@ that require it.  It also provides a
>>>> universal seat management library that
>>>>  allows applications to use whatever seat management is
>>>>  available.")
>>>>      (license license:expat)))
>>>>
>>>> +(define-public greetd
>>>> +  (package
>>>> +    (name "greetd")
>>>> +    (version "0.7.0")
>>>> +    (home-page "https://git.sr.ht/~kennylevinsen/greetd")
>>>> +    (source (origin
>>>> +              (method git-fetch)
>>>> +              (uri (git-reference
>>>> +                    (url home-page)
>>>> +                    (commit version)))
>>>> +              (file-name (git-file-name name version))
>>>> +              (sha256
>>>> +               (base32
>>>> "0lmwr5ld9x2wlq00i7mjgm9by8zndiq9girj8g93k0kww9zbgr3g"))))
>>>> +    (build-system cargo-build-system)
>>>> +    (arguments
>>>> +     `(#:cargo-inputs
>>>> +       (("rust-nix" ,rust-nix-0.17)
>>>> +        ("rust-pam-sys" ,rust-pam-sys-0.5.6)
>>>> +        ("rust-rpassword" ,rust-rpassword-4)
>>>> +        ("rust-users" ,rust-users-0.9)
>>>> +        ("rust-serde" ,rust-serde-1)
>>>> +        ("rust-serde-json" ,rust-serde-json-1)
>>>> +        ("rust-libc" ,rust-libc-0.2)
>>>> +        ("rust-tokio" ,rust-tokio-0.2)
>>>> +        ("rust-getopts" ,rust-getopts-0.2)
>>>> +        ("rust-thiserror" ,rust-thiserror-1)
>>>> +        ("rust-async-trait" ,rust-async-trait-0.1)
>>>> +        ("rust-enquote" ,rust-enquote-1))
>>>> +       #:phases
>>>> +       (modify-phases %standard-phases
>>>> +         ;; once https://todo.sr.ht/~kennylevinsen/greetd/25
>>>> +         ;; is solved, below patch can be removed
>>>> +         (add-after 'unpack 'patch-terminal-switch
>>>> +           (lambda* (#:key inputs #:allow-other-keys)
>>>> +             (substitute* "greetd/src/server.rs"
>>>> +               (("switch: true,")
>>>> +                "switch: false,"))))
>>>> +         (delete 'package)
>>>> +         (replace 'install
>>>> +           (lambda* (#:key inputs outputs 
>>>> #:allow-other-keys)
>>>> +             (let* ((out (assoc-ref outputs "out"))
>>>> +                    (bin (string-append out "/bin"))
>>>> +                    (sbin (string-append out "/sbin"))
>>>> +                    (share (string-append out "/share"))
>>>> +                    (man (string-append share "/man"))
>>>> +                    (man1 (string-append man "/man1"))
>>>> +                    (man5 (string-append man "/man5"))
>>>> +                    (man7 (string-append man "/man7"))
>>>> +                    (release "target/release")
>>>> +                    (greetd-bin (string-append release
>>>> "/greetd"))
>>>> +                    (agreety-bin (string-append release
>>>> "/agreety")))
>>>> +               (install-file greetd-bin sbin)
>>>> +               (install-file agreety-bin bin)
>>>> +               (mkdir-p man1)
>>>> +               (mkdir-p man5)
>>>> +               (mkdir-p man7)
>>>
>>> No need to ‘mkdir-p’ if you will call ‘install-file’ on the
>>> directory.
>>>
>>
>> Didn't work for me, without it I get:
>> In procedure copy-file: No such file or directory
>
> Hmm, weird, the docs for ‘install-file’ says
>
>    -- Scheme Procedure: install-file FILE DIRECTORY
>        Create DIRECTORY if it does not exist and copy FILE in 
>        there under
>        the same name.
>

Yeah, you are right, there was wrong excursions when i tested,
now works as expected, i think i just forgot to delete this 
comment,
thanks.

>>>> +               (with-directory-excursion "man"
>>>> +                 (system "scdoc < greetd-1.scd > greetd.1")
>>>> +                 (system "scdoc < greetd-5.scd > greetd.5")
>>>> +                 (system "scdoc < greetd-ipc-7.scd >
>>>> greetd-ipc.7")
>>>> +                 (system "scdoc < agreety-1.scd > 
>>>> agreety.1"))
>>>> +               (install-file "man/greetd.1" man1)
>>>> +               (install-file "man/greetd.5" man5)
>>>> +               (install-file "man/greetd-ipc.7" man7)
>>>> +               (install-file "man/agreety.1" man1)
>>>
>>> Why not put these four lines inside the
>>> (with-directory-excursion "man"
>>> …) form, and remove the "man" prefix?
>>>
>>
>> Refactored, scdoc moved to 'build-man-pages after 'build, 
>> install
>> minimized
>>
>>          (add-after 'build 'build-man-pages
>>            (lambda* (#:key inputs #:allow-other-keys)
>>              (define (scdoc-cmd doc lvl)
>>                (system (string-append "scdoc < "
>>                                       doc "-" lvl ".scd > "
>>                                       doc "." lvl)))
>>              (with-directory-excursion "man"
>>                (scdoc-cmd "greetd" "1")
>>                (scdoc-cmd "greetd" "5")
>>                (scdoc-cmd "greetd-ipc" "7")
>>                (scdoc-cmd "agreety" "1"))))
>>          (replace 'install
>>            (lambda* (#:key inputs outputs #:allow-other-keys)
>>              (let* ((out (assoc-ref outputs "out"))
>>                     (bin (string-append out "/bin"))
>>                     (sbin (string-append out "/sbin"))
>>                     (share (string-append out "/share"))
>>                     (man (string-append share "/man"))
>>                     (man1 (string-append man "/man1"))
>>                     (man5 (string-append man "/man5"))
>>                     (man7 (string-append man "/man7"))
>>                     (release "target/release")
>>                     (greetd-bin (string-append release 
>>                     "/greetd"))
>>                     (agreety-bin (string-append release
>>                     "/agreety")))
>>                (install-file greetd-bin sbin)
>>                (install-file agreety-bin bin)
>>                (with-directory-excursion "man"
>>                  (install-file "greetd.1" man1)
>>                  (install-file "greetd.5" man5)
>>                  (install-file "greetd-ipc.7" man7)
>>                  (install-file "agreety.1" man1))))))))
>>
>> Noted for next update, thanks
>
> The phases LGTM!
>
>>>> +    (description
>>>> +     "greetd is a minimal and flexible login manager daemon
>>>> +that makes no assumptions about what you want to launch.")
>>>
>>> “what you want to launch” sounds a bit vague, is it referring 
>>> to
>>> desktop
>>> environment, window manager, or something else?
>>
>> As description says anything, it is from official 
>> documentation.
>> Launches any thing,
>> could be DE, WM, Emacs, top etc. literally any thing :)
>
> Ah, OK, then maybe “what program” instead of just “what”? 
> Someone might
> try to launch a missile with it ;-)

/gnu/store/....-missiles-1.01/bin/launch why not? :D

in next update, i will try to put some more sentences from greetd
description, it might be more useful may be.

[bug#49969] [PATCH 00/10] gnu: desktop: Add seatd-service-type and greetd-service-type

[muradm]

This patch series introduces two new services;

 - seatd-service-type: simple seat management daemon
 - greetd-service-type: simple login daemon

Both services are very minimalistic in nature. Simple seatd daemon
could be said as replacement for elogind-service-type. greetd daemon
is simple replacement for mingetty.

In addition to the base services, special build of pam-mount module is
included as greetd-pam-mount. It is used to provide
auto-(mounting/unmounting) of XDG_RUNTIME_DIR. Special build is
required to avoid interference with default pam-mount, if used in
the system.

greetd provides agreety terminal greeter out of the box. Current
greetd-service-type includes configuration for greetd-agreety-session
variations, i.e. only terminal are supported at the moment.

Next step would be adding gtkgreet and/or wlgreet alternatives for
graphical greeter.

muradm (10):
  gnu: crates-io: Add rust-enquote 1.0.3
  gnu: crates-io: Add rust-pam-sys 0.5.6
  gnu: freedesktop: Add greetd 0.7.0
  gnu: admin: Add greetd-pam-mount
  gnu: desktop: Add seatd-service-type
  gnu: desktop: Add greetd-service-type
  gnu: base: Add greetd to applied PAM services
  gnu: pam-mount: Add greetd to applied PAM services
  gnu: tests: Add seatd/greetd based minimal desktop system tests
  doc: Add desktop seatd-service-type and greetd-service-type

 doc/guix.texi                | 183 ++++++++++++++++++++++
 gnu/packages/admin.scm       |  33 ++++
 gnu/packages/crates-io.scm   |  49 ++++++
 gnu/packages/freedesktop.scm |  86 +++++++++++
 gnu/services/base.scm        |   3 +-
 gnu/services/desktop.scm     | 285 ++++++++++++++++++++++++++++++++++-
 gnu/services/pam-mount.scm   |   3 +-
 gnu/tests/desktop.scm        | 191 ++++++++++++++++++++++-
 8 files changed, 829 insertions(+), 4 deletions(-)

-- 
2.32.0

[bug#49969] [PATCH 00/10] gnu: desktop: Add seatd-service-type and greetd-service-type

[muradm]

This patch series introduces two new services;

 - seatd-service-type: simple seat management daemon
 - greetd-service-type: simple login daemon

Both services are very minimalistic in nature. Simple seatd daemon
could be said as replacement for elogind-service-type. greetd daemon
is simple replacement for mingetty.

In addition to the base services, special build of pam-mount module is
included as greetd-pam-mount. It is used to provide
auto-(mounting/unmounting) of XDG_RUNTIME_DIR. Special build is
required to avoid interference with default pam-mount, if used in
the system.

greetd provides agreety terminal greeter out of the box. Current
greetd-service-type includes configuration for greetd-agreety-session
variations, i.e. only terminal are supported at the moment.

Next step would be adding gtkgreet and/or wlgreet alternatives for
graphical greeter.

muradm (10):
  gnu: crates-io: Add rust-enquote 1.0.3
  gnu: crates-io: Add rust-pam-sys 0.5.6
  gnu: freedesktop: Add greetd 0.7.0
  gnu: admin: Add greetd-pam-mount
  gnu: desktop: Add seatd-service-type
  gnu: desktop: Add greetd-service-type
  gnu: base: Add greetd to applied PAM services
  gnu: pam-mount: Add greetd to applied PAM services
  gnu: tests: Add seatd/greetd based minimal desktop system tests
  doc: Add desktop seatd-service-type and greetd-service-type

 doc/guix.texi                | 183 ++++++++++++++++++++++
 gnu/packages/admin.scm       |  33 ++++
 gnu/packages/crates-io.scm   |  49 ++++++
 gnu/packages/freedesktop.scm |  86 +++++++++++
 gnu/services/base.scm        |   3 +-
 gnu/services/desktop.scm     | 285 ++++++++++++++++++++++++++++++++++-
 gnu/services/pam-mount.scm   |   3 +-
 gnu/tests/desktop.scm        | 191 ++++++++++++++++++++++-
 8 files changed, 829 insertions(+), 4 deletions(-)

-- 
2.32.0

[bug#49969] [PATCH v3 00/10] gnu: desktop: Add seatd-service-type and greetd-service-type

[muradm]

This patch series introduces two new services;

 - seatd-service-type: simple seat management daemon
 - greetd-service-type: simple login daemon

Both services are very minimalistic in nature. Simple seatd daemon
could be said as replacement for elogind-service-type. greetd daemon
is simple replacement for mingetty.

In addition to the base services, special build of pam-mount module is
included as greetd-pam-mount. It is used to provide
auto-(mounting/unmounting) of XDG_RUNTIME_DIR. Special build is
required to avoid interference with default pam-mount, if used in
the system.

greetd provides agreety terminal greeter out of the box. Current
greetd-service-type includes configuration for greetd-agreety-session
variations, i.e. only terminal are supported at the moment.

Next step would be adding gtkgreet and/or wlgreet alternatives for
graphical greeter.

muradm (10):
  gnu: crates-io: Add rust-enquote 1.0.3
  gnu: crates-io: Add rust-pam-sys 0.5.6
  gnu: freedesktop: Add greetd 0.7.0
  gnu: admin: Add greetd-pam-mount
  gnu: desktop: Add seatd-service-type
  gnu: desktop: Add greetd-service-type
  gnu: base: Add greetd to applied PAM services
  gnu: pam-mount: Add greetd to applied PAM services
  gnu: tests: Add seatd/greetd based minimal desktop system tests
  doc: Add desktop seatd-service-type and greetd-service-type

 doc/guix.texi                | 183 ++++++++++++++++++++++
 gnu/packages/admin.scm       |  33 ++++
 gnu/packages/crates-io.scm   |  49 ++++++
 gnu/packages/freedesktop.scm |  86 +++++++++++
 gnu/services/base.scm        |   3 +-
 gnu/services/desktop.scm     | 285 ++++++++++++++++++++++++++++++++++-
 gnu/services/pam-mount.scm   |   3 +-
 gnu/tests/desktop.scm        | 191 ++++++++++++++++++++++-
 8 files changed, 829 insertions(+), 4 deletions(-)

-- 
2.32.0

[bug#49969] [PATCH v3 01/10] gnu: crates-io: Add rust-enquote 1.0.3

[muradm]

* gnu/packages/crates-io.scm (rust-enquote-1): Add rust-enquote 1.0.3
---
 gnu/packages/crates-io.scm | 22 ++++++++++++++++++++++
 1 file changed, 22 insertions(+)

diff --git a/gnu/packages/crates-io.scm b/gnu/packages/crates-io.scm
index 24cc772ba7..6484d4c4fc 100644
--- a/gnu/packages/crates-io.scm
+++ b/gnu/packages/crates-io.scm
@@ -18,6 +18,7 @@
 ;;; Copyright © 2021 Antero Mejr <antero@kodmin.com>
 ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2021 Vinicius Monego <monego@posteo.net>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -56972,3 +56973,24 @@ variant of this library is available separately as @code{im}.")
     (description
       "Generate Rust register maps (`struct`s) from SVD files")
     (license (list license:expat license:asl2.0))))
+
+(define-public rust-enquote-1
+  (package
+    (name "rust-enquote")
+    (version "1.0.3")
+    (home-page "https://github.com/reujab/enquote")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (crate-uri "enquote" version))
+       (file-name
+        (string-append name "-" version ".tar.gz"))
+       (sha256
+        (base32
+         "0vm687r2wwgc3d3l2iqhag9wgkql6k93sdvjxvmfkdpksajpij1f"))))
+    (build-system cargo-build-system)
+    (synopsis
+     "A Rust library quotes, unquotes, and unescapes strings")
+    (description
+     "A Rust library quotes, unquotes, and unescapes strings")
+    (license license:unlicense)))
-- 
2.32.0

[bug#49969] [PATCH v3 02/10] gnu: crates-io: Add rust-pam-sys 0.5.6

[muradm]

* gnu/packages/crates-io.scm (rust-pam-sys): Add rust-pam-sys 0.5.6
---
 gnu/packages/crates-io.scm | 27 +++++++++++++++++++++++++++
 1 file changed, 27 insertions(+)

diff --git a/gnu/packages/crates-io.scm b/gnu/packages/crates-io.scm
index 6484d4c4fc..d91417d76f 100644
--- a/gnu/packages/crates-io.scm
+++ b/gnu/packages/crates-io.scm
@@ -55,6 +55,7 @@
   #:use-module (gnu packages glib)
   #:use-module (gnu packages image)
   #:use-module (gnu packages jemalloc)
+  #:use-module (gnu packages linux)
   #:use-module (gnu packages llvm)
   #:use-module (gnu packages multiprecision)
   #:use-module (gnu packages nettle)
@@ -56994,3 +56995,29 @@ variant of this library is available separately as @code{im}.")
     (description
      "A Rust library quotes, unquotes, and unescapes strings")
     (license license:unlicense)))
+
+(define-public rust-pam-sys-0.5.6
+  (package
+    (name "rust-pam-sys")
+    (version "0.5.6")
+    (home-page "https://github.com/1wilkens/pam-sys")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (crate-uri "pam-sys" version))
+       (file-name
+        (string-append name "-" version ".tar.gz"))
+       (sha256
+        (base32
+         "0d14501d5vybjnzxfjf96321xa5wa36x1xvf02h02zq938qmhj6d"))))
+    (build-system cargo-build-system)
+    (arguments
+     `(#:cargo-inputs
+       (("rust-libc" ,rust-libc-0.2))))
+    (native-inputs
+     `(("linux-pam" ,linux-pam)))
+    (synopsis
+     "Rust FFI wrappers for the Linux Pluggable Authentication Modules (PAM)")
+    (description
+     "Rust FFI wrappers for the Linux Pluggable Authentication Modules (PAM)")
+    (license (list license:expat license:asl2.0))))
-- 
2.32.0

[bug#49969] [PATCH 03/10] gnu: freedesktop: Add greetd 0.7.0

[muradm]

* gnu/packages/freedesktop.scm (greetd): Add greetd 0.7.0
---
 gnu/packages/freedesktop.scm | 86 ++++++++++++++++++++++++++++++++++++
 1 file changed, 86 insertions(+)

diff --git a/gnu/packages/freedesktop.scm b/gnu/packages/freedesktop.scm
index 693a79c738..0be7d0fe4d 100644
--- a/gnu/packages/freedesktop.scm
+++ b/gnu/packages/freedesktop.scm
@@ -24,6 +24,7 @@
 ;;; Copyright © 2020 Raghav Gururajan <raghavgururajan@disroot.org>
 ;;; Copyright © 2021 Brendan Tildesley <mail@brendan.scot>
 ;;; Copyright © 2021 pineapples <guixuser6392@protonmail.com>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -46,6 +47,7 @@
   #:use-module (guix packages)
   #:use-module (guix download)
   #:use-module (guix git-download)
+  #:use-module (guix build-system cargo)
   #:use-module (guix build-system cmake)
   #:use-module (guix build-system gnu)
   #:use-module (guix build-system meson)
@@ -62,6 +64,7 @@
   #:use-module (gnu packages check)
   #:use-module (gnu packages cmake)
   #:use-module (gnu packages compression)
+  #:use-module (gnu packages crates-io)
   #:use-module (gnu packages cryptsetup)
   #:use-module (gnu packages databases)
   #:use-module (gnu packages disk)
@@ -862,6 +865,89 @@ that require it.  It also provides a universal seat management library that
 allows applications to use whatever seat management is available.")
     (license license:expat)))
 
+(define-public greetd
+  (package
+    (name "greetd")
+    (version "0.7.0")
+    (home-page "https://git.sr.ht/~kennylevinsen/greetd")
+    (source (origin
+              (method git-fetch)
+              (uri (git-reference
+                    (url home-page)
+                    (commit version)))
+              (file-name (git-file-name name version))
+              (sha256
+               (base32 "0lmwr5ld9x2wlq00i7mjgm9by8zndiq9girj8g93k0kww9zbgr3g"))))
+    (build-system cargo-build-system)
+    (arguments
+     `(#:cargo-inputs
+       (("rust-nix" ,rust-nix-0.17)
+        ("rust-pam-sys" ,rust-pam-sys-0.5.6)
+        ("rust-rpassword" ,rust-rpassword-4)
+        ("rust-users" ,rust-users-0.9)
+        ("rust-serde" ,rust-serde-1)
+        ("rust-serde-json" ,rust-serde-json-1)
+        ("rust-libc" ,rust-libc-0.2)
+        ("rust-tokio" ,rust-tokio-0.2)
+        ("rust-getopts" ,rust-getopts-0.2)
+        ("rust-thiserror" ,rust-thiserror-1)
+        ("rust-async-trait" ,rust-async-trait-0.1)
+        ("rust-enquote" ,rust-enquote-1))
+       #:phases
+       (modify-phases %standard-phases
+         ;; once https://todo.sr.ht/~kennylevinsen/greetd/25
+         ;; is solved, below patch can be removed
+         (add-after 'unpack 'patch-terminal-switch
+           (lambda* (#:key inputs #:allow-other-keys)
+             (substitute* "greetd/src/server.rs"
+               (("switch: true,")
+                "switch: false,"))))
+         (delete 'package)
+         (add-after 'build 'build-man-pages
+           (lambda* (#:key inputs #:allow-other-keys)
+             (define (scdoc-cmd doc lvl)
+               (system (string-append "scdoc < "
+                                      doc "-" lvl ".scd > "
+                                      doc "." lvl)))
+             (with-directory-excursion "man"
+               (scdoc-cmd "greetd" "1")
+               (scdoc-cmd "greetd" "5")
+               (scdoc-cmd "greetd-ipc" "7")
+               (scdoc-cmd "agreety" "1"))))
+         (replace 'install
+           (lambda* (#:key inputs outputs #:allow-other-keys)
+             (let* ((out (assoc-ref outputs "out"))
+                    (bin (string-append out "/bin"))
+                    (sbin (string-append out "/sbin"))
+                    (share (string-append out "/share"))
+                    (man (string-append share "/man"))
+                    (man1 (string-append man "/man1"))
+                    (man5 (string-append man "/man5"))
+                    (man7 (string-append man "/man7"))
+                    (release "target/release")
+                    (greetd-bin (string-append release "/greetd"))
+                    (agreety-bin (string-append release "/agreety")))
+               (install-file greetd-bin sbin)
+               (install-file agreety-bin bin)
+               (with-directory-excursion "man"
+                 (install-file "greetd.1" man1)
+                 (install-file "greetd.5" man5)
+                 (install-file "greetd-ipc.7" man7)
+                 (install-file "agreety.1" man1))))))))
+    (native-inputs
+     `(("linux-pam" ,linux-pam)
+       ("scdoc" ,scdoc)))
+    (synopsis "minimal and flexible login manager daemon")
+    (description
+     "greetd is a minimal and flexible login manager daemon
+that makes no assumptions about what you want to launch.
+
+If you can run it from your shell in a TTY, greetd can start it.
+
+If it can be taught to speak a simple JSON-based IPC protocol,
+then it can be a greeter.")
+    (license license:gpl3+)))
+
 (define-public packagekit
   (package
     (name "packagekit")
-- 
2.32.0

[bug#49969] [PATCH v3 04/10] gnu: admin: Add greetd-pam-mount

[muradm]

* gnu/packages/admin.scm (greetd-pam-mount): Add greetd-pam-mount
---
 gnu/packages/admin.scm | 33 +++++++++++++++++++++++++++++++++
 1 file changed, 33 insertions(+)

diff --git a/gnu/packages/admin.scm b/gnu/packages/admin.scm
index eda269f148..e5ed1785d8 100644
--- a/gnu/packages/admin.scm
+++ b/gnu/packages/admin.scm
@@ -42,6 +42,7 @@
 ;;; Copyright © 2021 David Larsson <david.larsson@selfhosted.xyz>
 ;;; Copyright © 2021 WinterHound <winterhound@yandex.com>
 ;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -4247,6 +4248,38 @@ supports.  It can also mount encrypted LUKS volumes using the password
 supplied by the user when logging in.")
     (license (list license:gpl2+ license:lgpl2.1+))))
 
+(define-public greetd-pam-mount
+  (package
+    (inherit pam-mount)
+    (name "greetd-pam-mount")
+    (arguments
+     (substitute-keyword-arguments (package-arguments pam-mount)
+       ((#:configure-flags flags ''())
+        `(cons* "--with-rundir=/run/greetd" ,flags))
+       ((#:phases phases)
+        `(modify-phases ,phases
+           (add-after 'unpack 'patch-config-file-name
+             (lambda* (#:key inputs #:allow-other-keys)
+               (substitute* "src/pam_mount.c"
+                 ((".*define CONFIGFILE .*$")
+                  "#define CONFIGFILE \"/etc/security/greetd_pam_mount.conf.xml\"\n")
+                 (("pam_mount_config") "greetd_pam_mount_config")
+                 (("pam_mount_system_authtok") "greetd_pam_mount_system_authtok"))))))))
+    (synopsis "pam-mount specifically compiled for use with greetd")
+    (description
+     "Pam-mount is a PAM module that can mount volumes when a user logs in.
+It supports mounting local filesystems of any kind the normal mount utility
+supports.  It can also mount encrypted LUKS volumes using the password
+supplied by the user when logging in.
+
+This package inherits pam-mount in the way that it is compiled specifically
+for use with greetd daemon. It uses different configuration location and
+name space for storing data in PAM.
+
+greetd-pam-mount is used in configuration of greetd to provide
+auto-(mounting/unmounting) of XDG_RUNTIME_DIR in the way that it will not
+interfere with default pam-mount configuration.")))
+
 (define-public jc
   (package
     (name "jc")
-- 
2.32.0

[bug#49969] [PATCH v3 05/10] gnu: desktop: Add seatd-service-type

[muradm]

* gnu/services/desktop.scm: Add seatd-service-type
---
 gnu/services/desktop.scm | 60 +++++++++++++++++++++++++++++++++++++++-
 1 file changed, 59 insertions(+), 1 deletion(-)

diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index 64d0e85301..a63a2936a7 100644
--- a/gnu/services/desktop.scm
+++ b/gnu/services/desktop.scm
@@ -13,6 +13,7 @@
 ;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2020 Reza Alizadeh Majd <r.majd@pantherx.org>
 ;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -39,7 +40,9 @@
   #:use-module (gnu services networking)
   #:use-module (gnu services sound)
   #:use-module ((gnu system file-systems)
-                #:select (%elogind-file-systems file-system))
+                #:select (%control-groups
+                          %elogind-file-systems
+                          file-system))
   #:use-module (gnu system)
   #:use-module (gnu system setuid)
   #:use-module (gnu system shadow)
@@ -154,6 +157,9 @@
             gnome-keyring-configuration?
             gnome-keyring-service-type
 
+            seatd-configuration
+            seatd-service-type
+
             %desktop-services))
 
 ;;; Commentary:
@@ -1182,6 +1188,58 @@ or setting its password with passwd.")))
 (define polkit-wheel-service
   (simple-service 'polkit-wheel polkit-service-type (list polkit-wheel)))
 
+\f
+;;;
+;;; seatd-service-type -- minimal seat management daemon
+;;;
+
+(define-record-type* <seatd-configuration> seatd-configuration
+  make-seatd-configuration
+  seatd-configuration?
+  (seatd seatd-package (default seatd))
+  (user seatd-user (default "root"))
+  (group seatd-group (default "users"))
+  (socket seatd-socket (default "/run/seatd.sock"))
+  (loglevel seatd-loglevel (default "error")))
+
+(define (seatd-shepherd-service config)
+  (list (shepherd-service
+         (documentation "Minimal seat management daemon")
+         (requirement '())
+         ;; TODO: once cgroups is separate dependency
+         ;; here we should depend on it rather than elogind
+         (provision '(seatd elogind))
+         (start #~(make-forkexec-constructor
+                   (list #$(file-append (seatd-package config) "/bin/seatd")
+                         "-u" #$(seatd-user config)
+                         "-g" #$(seatd-group config)
+                         "-s" #$(seatd-socket config))
+                   #:environment-variables
+                   (list (string-append "SEATD_LOGLEVEL="
+                                        #$(seatd-loglevel config)))
+                   #:log-file "/tmp/seatd.log"))
+         (stop #~(make-kill-destructor)))))
+
+(define seatd-environment
+  (match-lambda
+    (($ <seatd-configuration> _ _ _ socket)
+     `(("SEATD_SOCK" . ,socket)))))
+
+(define seatd-service-type
+  (service-type
+   (name 'seatd)
+   (description "Seat management takes care of mediating access
+to shared devices (graphics, input), without requiring the
+applications needing access to be root.")
+   (extensions
+    (list
+     (service-extension session-environment-service-type seatd-environment)
+     ;; TODO: once cgroups is separate dependency
+     ;; we should not mount it here
+     (service-extension file-system-service-type (const %control-groups))
+     (service-extension shepherd-root-service-type seatd-shepherd-service)))
+   (default-value (seatd-configuration))))
+
 \f
 ;;;
 ;;; The default set of desktop services.
-- 
2.32.0

[bug#49969] [PATCH v3 06/10] gnu: desktop: Add greetd-service-type

[muradm]

Currently, only agreety configuration is provided.

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

diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index a63a2936a7..b7ac08cf20 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,12 @@
             seatd-configuration
             seatd-service-type
 
+            greetd-configuration
+            greetd-terminal-configuration
+            greetd-service-type
+            greetd-agreety-tty-session
+            greetd-agreety-tty-xdg-session
+
             %desktop-services))
 
 ;;; Commentary:
@@ -1240,6 +1247,224 @@ applications needing access to be root.")
      (service-extension shepherd-root-service-type seatd-shepherd-service)))
    (default-value (seatd-configuration))))
 
+\f
+;;;
+;;; 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?
+  (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 match))
+          (let*
+              ((username (getenv "USER"))
+               (useruid (passwd:uid (getpwuid username)))
+               (useruid (number->string useruid))
+               (abs-cmd-bin #$(file-append package command-bin)))
+            (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-terminal-configuration>
+  greetd-terminal-configuration make-greetd-terminal-configuration
+  greetd-terminal-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-xdg-session)))
+
+(define (default-config-file-name config)
+  (string-join (list "config-" (greetd-terminal-vt config) ".toml") ""))
+
+(define make-greetd-terminal-default-session-command
+  (match-lambda
+    (($ <greetd-terminal-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 (make-greetd-terminal-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-terminal-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 %default-motd
+  (plain-file "motd" "This is the GNU operating system, welcome!\n\n"))
+
+(define %greetd-accounts
+  (list (user-account
+         (name "greeter")
+         (group "wheel")
+         (supplementary-groups '("users" "tty" "input" "video" "audio"))
+         (system? #t))))
+
+(define %greetd-file-systems
+  (list (file-system
+          (device "none")
+          (mount-point "/run/greetd/pam_mount")
+          (type "tmpfs")
+          (check? #f)
+          (flags '(no-suid no-dev no-exec))
+          (options "mode=0755")
+          (create-mount-point? #t))))
+
+(define %greetd-pam-mount-rules
+  `((debug (@ (enable "0")))
+    (volume (@ (sgrp "users")
+               (fstype "tmpfs")
+               (mountpoint "/run/user/%(USERUID)")
+               (options "noexec,nosuid,nodev,size=1g,mode=0700,uid=%(USERUID),gid=%(USERGID)")))
+    (logout (@ (wait "0")
+               (hup "0")
+               (term "yes")
+               (kill "no")))
+    (mkmountpoint (@ (enable "1") (remove "true")))))
+
+(define-record-type* <greetd-configuration>
+  greetd-configuration make-greetd-configuration
+  greetd-configuration?
+  (motd greetd-motd (default %default-motd))
+  (allow-empty-passwords? greetd-allow-empty-passwords? (default #t))
+  (terminals greetd-terminals (default '())))
+
+(define (make-greetd-pam-mount-conf-file config)
+  (computed-file
+   "greetd_pam_mount.conf.xml"
+   #~(begin
+       (use-modules (sxml simple))
+       (call-with-output-file #$output
+         (lambda (port)
+           (sxml->xml
+            '(*TOP*
+              (*PI* xml "version='1.0' encoding='utf-8'")
+              (pam_mount
+               #$@%greetd-pam-mount-rules
+               (pmvarrun
+                #$(file-append greetd-pam-mount
+                               "/sbin/pmvarrun -u '%(USER)' -o '%(OPERATION)'"))))
+            port))))))
+
+(define (greetd-etc-service config)
+  `(("security/greetd_pam_mount.conf.xml"
+     ,(make-greetd-pam-mount-conf-file config))))
+
+(define (greetd-pam-service config)
+  (define optional-pam-mount
+    (pam-entry
+     (control "optional")
+     (module #~(string-append #$greetd-pam-mount "/lib/security/pam_mount.so"))))
+
+  (list
+   (unix-pam-service "greetd"
+                     #:login-uid? #t
+                     #:allow-empty-passwords?
+                     (greetd-allow-empty-passwords? config)
+                     #:motd
+                     (greetd-motd config))
+   (lambda (pam)
+     (if (member (pam-service-name pam)
+                 '("login" "greetd" "su" "slim" "gdm-password"))
+         (pam-service
+          (inherit pam)
+          (auth (append (pam-service-auth pam)
+                        (list optional-pam-mount)))
+          (session (append (pam-service-session pam)
+                           (list optional-pam-mount))))
+         pam))))
+
+(define (greetd-shepherd-services config)
+  (map
+   (lambda (tc)
+     (let*
+         ((greetd-bin (file-append (greetd-package tc) "/sbin/greetd"))
+          (greetd-conf (make-greetd-terminal-configuration-file tc))
+          (greetd-vt (greetd-terminal-vt tc)))
+       (shepherd-service
+        (documentation "Minimal and flexible login manager daemon")
+        (requirement '(user-processes host-name udev virtual-terminal))
+        (provision (list (symbol-append
+                          'term-tty
+                          (string->symbol (greetd-terminal-vt tc)))))
+        (start #~(make-forkexec-constructor
+                  (list #$greetd-bin "-c" #$greetd-conf)
+                  #:log-file
+                  (string-append "/tmp/greetd." #$greetd-vt ".log")))
+        (stop #~(make-kill-destructor)))))
+   (greetd-terminals config)))
+
+(define greetd-service-type
+  (service-type
+   (name 'greetd)
+   (description "Provides necessary infrastructure for logging into the
+system including @code{greetd} PAM service, @code{pam-mount} module to
+mount/unmount /run/user/<uid> directory for user and @code{greetd}
+login manager daemon.")
+   (extensions
+    (list
+     (service-extension account-service-type (const %greetd-accounts))
+     (service-extension file-system-service-type (const %greetd-file-systems))
+     (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)))
+   (default-value (greetd-configuration))))
+
 \f
 ;;;
 ;;; The default set of desktop services.
-- 
2.32.0

[bug#49969] [PATCH v3 07/10] gnu: base: Add greetd to applied PAM services

[muradm]

* gnu/services/base.scm (pam-limits-service-type): add greetd PAM
service to applicable PAM services
---
 gnu/services/base.scm | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index c784d312b1..446ecc30f8 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -15,6 +15,7 @@
 ;;; Copyright © 2020, 2021 Brice Waegeneire <brice@waegenei.re>
 ;;; Copyright © 2021 qblade <qblade@protonmail.com>
 ;;; Copyright © 2021 Hui Lu <luhuins@163.com>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -1392,7 +1393,7 @@ information on the configuration file syntax."
                               (module "pam_limits.so")
                               (arguments '("conf=/etc/security/limits.conf")))))
              (if (member (pam-service-name pam)
-                         '("login" "su" "slim" "gdm-password" "sddm"))
+                         '("login" "greetd" "su" "slim" "gdm-password" "sddm"))
                  (pam-service
                   (inherit pam)
                   (session (cons pam-limits
-- 
2.32.0

[bug#49969] [PATCH v3 08/10] gnu: pam-mount: Add greetd to applied PAM services

[muradm]

* gnu/services/pam-mount.scm (pam-mount-service-type): add greetd PAM
service to applicable PAM services
---
 gnu/services/pam-mount.scm | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/gnu/services/pam-mount.scm b/gnu/services/pam-mount.scm
index 98611462c2..7b25efeb50 100644
--- a/gnu/services/pam-mount.scm
+++ b/gnu/services/pam-mount.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2019 Guillaume Le Vaillant <glv@posteo.net>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -90,7 +91,7 @@
      (module #~(string-append #$pam-mount "/lib/security/pam_mount.so"))))
   (list (lambda (pam)
           (if (member (pam-service-name pam)
-                      '("login" "su" "slim" "gdm-password"))
+                      '("login" "greetd" "su" "slim" "gdm-password"))
               (pam-service
                (inherit pam)
                (auth (append (pam-service-auth pam)
-- 
2.32.0

[bug#49969] [PATCH v3 09/10] gnu: tests: Add seatd/greetd based minimal desktop system tests

[muradm]

* gnu/tests/desktop.scm (minimal-desktop): seatd/greetd based minimal desktop
---
 gnu/tests/desktop.scm | 191 +++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 190 insertions(+), 1 deletion(-)

diff --git a/gnu/tests/desktop.scm b/gnu/tests/desktop.scm
index 6aa22fd49b..c57c4a4462 100644
--- a/gnu/tests/desktop.scm
+++ b/gnu/tests/desktop.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -19,12 +20,15 @@
 (define-module (gnu tests desktop)
   #:use-module (gnu tests)
   #:use-module (gnu services)
+  #:use-module (gnu services base)
   #:use-module (gnu services dbus)
   #:use-module (gnu services desktop)
+  #:use-module (gnu system)
   #:use-module (gnu system vm)
   #:use-module (guix gexp)
   #:use-module (srfi srfi-1)
-  #:export (%test-elogind))
+  #:export (%test-elogind
+            %test-minimal-desktop))
 
 \f
 ;;;
@@ -103,3 +107,188 @@
                #:imported-modules '((gnu services herd)
                                     (guix combinators)))))
       (run-elogind-test (virtual-machine os))))))
+
+\f
+;;;
+;;; Seatd/greetd based minimal desktop
+;;;
+
+(define %minimal-services
+  (append
+   (list
+    (service seatd-service-type)
+    (service greetd-service-type
+             (greetd-configuration
+              (terminals
+               (list
+                (greetd-terminal-configuration (terminal-vt "1"))
+                (greetd-terminal-configuration (terminal-vt "2"))
+                (greetd-terminal-configuration (terminal-vt "3"))
+                (greetd-terminal-configuration (terminal-vt "4"))
+                (greetd-terminal-configuration (terminal-vt "5"))
+                (greetd-terminal-configuration (terminal-vt "6")))))))
+   (modify-services %base-services
+     (delete login-service-type)
+     (delete mingetty-service-type))))
+
+(define-syntax-rule (minimal-operating-system user-services ...)
+  "Return an operating system that includes USER-SERVICES in addition to
+minimal %BASE-SERVICES."
+  (operating-system (inherit %simple-os)
+                    (services (cons* user-services ... %minimal-services))))
+
+(define (run-minimal-desktop-test os vm)
+  (define test
+    (with-imported-modules '((gnu build marionette)
+                             (guix build syscalls))
+      #~(begin
+          (use-modules (gnu build marionette)
+                       (guix build syscalls)
+                       (srfi srfi-1)
+                       (srfi srfi-64)
+                       (ice-9 pretty-print))
+
+          (define marionette
+            (make-marionette #$vm))
+
+          (define (file-get-all-strings fname)
+            (marionette-eval '(use-modules (rnrs io ports)) marionette)
+            (wait-for-file fname marionette #:read 'get-string-all))
+
+          (define (wait-for-unix-socket-m socket)
+            (wait-for-unix-socket socket marionette))
+
+          (mkdir #$output)
+          (chdir #$output)
+
+          (test-begin "minimal-desktop")
+
+          (test-assert "seatd is ready"
+            (wait-for-unix-socket-m "/run/seatd.sock"))
+
+          (test-equal "login user on tty1"
+            "alice\n"
+            (begin
+              ;; Wait for tty1.
+              (marionette-eval
+               '(begin
+                  (use-modules (gnu services herd))
+                  (start-service 'term-tty1))
+               marionette)
+              (marionette-control "sendkey ctrl-alt-f1" marionette)
+
+              ;; login as root change alice password and exit
+              ;; then login as alice
+              (for-each
+               (lambda (cmd) (marionette-type cmd marionette) (sleep 1))
+               (list
+                "root\n"
+                "\n"
+                "passwd alice\n"
+                "alice\n"
+                "alice\n"
+                "exit\n"
+                "alice\n"
+                "alice\n"
+                "id -un > logged-in\n"))
+
+              (file-get-all-strings "/home/alice/logged-in")))
+
+          (test-equal "validate user environment"
+            '("SEATD_SOCK=/run/seatd.sock"
+              "XDG_RUNTIME_DIR=/run/user/1000"
+              "XDG_SEAT=seat0"
+              "XDG_VTNR=1")
+
+            (begin
+              (marionette-type "env > env\n" marionette)
+              (sleep 1)
+
+              (define user-env (string-tokenize
+                                (file-get-all-strings "/home/alice/env")))
+
+              (define (expected-var var)
+                (any (lambda (s) (string-contains var s))
+                     '("SEATD_SOCK"
+                       "XDG_RUNTIME_DIR"
+                       "XDG_SEAT"
+                       "XDG_VTNR")))
+
+              (sort (filter expected-var user-env) string<?)))
+
+          (test-assert "validate SEATD_SOCK and GREETD_SOCK"
+            (begin
+              (marionette-type "env > env\n" marionette)
+              (sleep 1)
+
+              (define (sock-var? var)
+                (any (lambda (s) (string-contains var s))
+                     '("SEATD_SOCK" "GREETD_SOCK")))
+
+              (define (sock-var-sock var)
+                (car (cdr (string-split var #\=))))
+
+              (let*
+                  ((out (file-get-all-strings "/home/alice/env"))
+                   (out (string-tokenize out))
+                   (out (filter sock-var? out))
+                   (socks (map sock-var-sock out))
+                   (socks (map wait-for-unix-socket-m socks)))
+                (and (= 2 (length socks)) (every identity socks)))))
+
+          (test-assert "greetd is ready"
+            (begin
+              (marionette-type "ps -C greetd -o pid,args --no-headers > ps-greetd\n"
+                               marionette)
+              (sleep 1)
+
+              (define (greetd-daemon? cmd)
+                (string-contains cmd "config"))
+
+              (define (greetd-cmd-to-pid cmd)
+                (car (string-split cmd #\space)))
+
+              (define (greetd-pid-to-sock pid)
+                (string-append "/run/greetd-" pid ".sock"))
+
+              (let* ((out (file-get-all-strings "/home/alice/ps-greetd"))
+                     (out (string-split out #\newline))
+                     (out (map string-trim-both out))
+                     (out (filter greetd-daemon? out))
+                     (pids (map greetd-cmd-to-pid out))
+                     (socks (map greetd-pid-to-sock pids))
+                     (socks (map wait-for-unix-socket-m socks)))
+                (every identity socks))))
+
+          ;; a bit weak, but tests everything at once actually
+          (test-equal "check /run/user/<uid> mounted and writable"
+            "alice\n"
+            (begin
+              (marionette-type "echo alice > /run/user/1000/test\n" marionette)
+              (file-get-all-strings "/run/user/1000/test")))
+
+          (test-assert "screendump"
+            (begin
+              (marionette-control (string-append "screendump " #$output
+                                                 "/tty1.ppm")
+                                  marionette)
+              (file-exists? "tty1.ppm")))
+
+          (test-end)
+          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+  (gexp->derivation "minimal-desktop" test))
+
+(define %test-minimal-desktop
+  (system-test
+   (name "minimal-desktop")
+   (description
+    "Test whether we can log in when seatd and greetd is enabled")
+   (value
+    (let* ((os (marionette-operating-system
+                (minimal-operating-system)
+                #:imported-modules '((gnu services herd)
+                                     (guix combinators))))
+           (vm (virtual-machine os)))
+      (run-minimal-desktop-test (virtualized-operating-system os '())
+                                #~(list #$vm))))))
-- 
2.32.0

[bug#49969] [PATCH v3 10/10] doc: Add desktop seatd-service-type and greetd-service-type

[muradm]

* doc/guix.texi (Desktop Services): Provide documentation for
seatd-service-type and greetd-service-type including configuration
and sample usage.
---
 doc/guix.texi | 183 ++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 183 insertions(+)

diff --git a/doc/guix.texi b/doc/guix.texi
index 78c1c09858..1e5838ce32 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -94,6 +94,7 @@ Copyright @copyright{} 2021 Xinglu Chen@*
 Copyright @copyright{} 2021 Raghav Gururajan@*
 Copyright @copyright{} 2021 Domagoj Stolfa@*
 Copyright @copyright{} 2021 Hui Lu@*
+Copyright @copyright{} 2021 muradm@*
 
 Permission is granted to copy, distribute and/or modify this document
 under the terms of the GNU Free Documentation License, Version 1.3 or
@@ -19694,6 +19695,188 @@ and ``passwd'' is with the value @code{passwd}.
 @end table
 @end deftp
 
+@defvr {Scheme Variable} seatd-service-type
+A minimal seat management daemon, and a universal seat management library.
+
+Seat management takes care of mediating access to shared devices (graphics,
+input), without requiring the applications needing access to be root.
+
+In general should be used as replacement to @code{elogind-service-type}.
+
+@lisp
+(append
+  (list
+   ;; make sure seatd is running
+   (service seatd-service-type)
+
+   (service greetd-service-type
+            (greetd-configuration
+             (terminals
+              (list
+               ;; lets have terminals 1, 2 and 3 run default XDG terminal session
+               (greetd-terminal-configuration (terminal-vt "1"))
+               (greetd-terminal-configuration (terminal-vt "2"))
+               (greetd-terminal-configuration (terminal-vt "3"))
+               ;; and terminals 4, 5 and 6 plain bash terminal session
+               ;; although not so plain, just to illustrate flexibility
+               (greetd-terminal-configuration
+                (terminal-vt "4")
+                (default-session-command greetd-agreety-tty-session))
+               (greetd-terminal-configuration
+                (terminal-vt "5")
+                (default-session-command greetd-agreety-tty-session))
+               (greetd-terminal-configuration
+                (terminal-vt "6")
+                (default-session-command greetd-agreety-tty-session))))))
+
+  ;; normaly one would want %base-services
+  (modify-services %base-services
+    ;; seatd/greetd combination can replace these
+    ;; greetd provides its own PAM service
+    (delete login-service-type)
+    (delete mingetty-service-type)))
+
+@end lisp
+
+@end defvr
+
+@deftp {Data Type} seatd-configuration
+Configuration record for the seatd daemon service.
+
+@table @asis
+@item @code{seatd} (default: @code{seatd})
+The seatd package to use.
+
+@item @code{user} (default: @samp{"root"})
+User to own the seatd socket.
+
+@item @code{group} (default: @samp{"users"})
+Group to own the seatd socket.
+
+@item @code{socket} (default: @samp{"/run/seatd.sock"})
+Where to create the seatd socket.
+
+@item @code{loglevel} (default: @samp{"error"})
+Log level to output logs. Possible values: @samp{"silent"}, @samp{"error"},
+@samp{"info"} and @samp{"debug"}.
+
+@end table
+@end deftp
+
+@defvr {Scheme Variable} greetd-service-type
+greetd is a minimal and flexible login manager daemon that makes no
+assumptions about what you want to launch.
+
+If you can run it from your shell in a TTY, greetd can start it. If it
+can be taught to speak a simple JSON-based IPC protocol, then it can
+be a greeter.
+
+@code{<greetd-service-type>} provides necessary infrastructure for
+logging in users, including:
+
+@itemize @bullet
+@item
+@code{greetd} PAM service
+
+@item
+Special variation of @code{pam-mount} to mount @code{XDG_RUNTIME_DIR}
+
+@end itemize
+
+@end defvr
+
+@deftp {Data Type} greetd-configuration
+Configuration record for the greetd service.
+
+@table @asis
+@item @code{motd}
+A file-like object containing the ``message of the day''.
+
+@item @code{allow-empty-passwords?} (default: @code{#t})
+Allow empty passwords by default so that first-time users can log in when
+the 'root' account has just been created.
+
+@item @code{terminals} (default: @code{'()})
+List of @code{<greetd-terminal-configuration>} per terminal for which
+@code{greetd} should be started.
+
+@end table
+@end deftp
+
+@deftp {Data Type} greetd-terminal-configuration
+Configuration record for per terminal greetd daemon service.
+
+@table @asis
+@item @code{greetd} (default: @code{greetd})
+The greetd package to use.
+
+@item @code{config-file-name}
+Configuration file name to use for greetd daemon. Generally, autogenerated
+derivation based on @code{terminal-vt} value.
+
+@item @code{terminal-vt} (default: @samp{"7"})
+The VT to run on. Use of a specific VT with appropriate conflict avoidance
+is recommended.
+
+@item @code{default-session-user} (default: @samp{"greeter"})
+The user to use for running the greeter.
+
+@item @code{default-session-command} (default: @code{greetd-agreety-tty-xdg-session})
+The command-line to run to start the default session.
+
+Possible values are:
+
+@itemize @bullet
+@item
+@code{greetd-agreety-tty-session} - bash terminal session
+
+@item
+@code{greetd-agreety-tty-xdg-session} - bash terminal session with XDG environment
+
+@item
+@code{greetd-agreety-session} - custom instance of terminal session
+@end itemize
+
+@end table
+@end deftp
+
+@deftp {Data Type} greetd-agreety-session
+Configuration record for the agreety greetd greeter.
+
+@table @asis
+@item @code{package} (default: @code{bash})
+The package of command.
+
+@item @code{command-bin} (default: @samp{"/bin/bash"})
+Path to binary relative to @code{package}.
+
+@item @code{command-args} (default: @code{'("-l")})
+Command arguments to pass to command.
+
+@item @code{extra-env} (default: @code{'()})
+Extra environment variables to set on login.
+
+@item @code{command-generator}
+Function that receives instance of this configuration as an argument and
+returns @code{program-file} that can be used with @code{agreety} greeter.
+
+Both @code{greetd-agreety-tty-session} and @code{greetd-agreety-tty-xdg-session}
+uses @code{greetd-agreety-session} under the hood.
+
+@end table
+@end deftp
+
+@defvr {Scheme Variable} greetd-agreety-tty-session
+Provides instance of @code{greetd-agreety-session} which starts @samp{"bash -l"}
+on login.
+@end defvr
+
+@defvr {Scheme Variable} greetd-agreety-tty-xdg-session
+Provides instance of @code{greetd-agreety-session} which starts @samp{"bash -l"}
+on login. Additionally, will set @code{XDG_SESSION_TYPE} and
+@code{XDG_RUNTIME_DIR} environment variables for session.
+@end defvr
+
 
 @node Sound Services
 @subsection Sound Services
-- 
2.32.0

[bug#49969] [PATCH v3 03/10] gnu: freedesktop: Add greetd 0.7.0

[muradm]

* gnu/packages/freedesktop.scm (greetd): Add greetd 0.7.0
---
 gnu/packages/freedesktop.scm | 86 ++++++++++++++++++++++++++++++++++++
 1 file changed, 86 insertions(+)

diff --git a/gnu/packages/freedesktop.scm b/gnu/packages/freedesktop.scm
index 693a79c738..0be7d0fe4d 100644
--- a/gnu/packages/freedesktop.scm
+++ b/gnu/packages/freedesktop.scm
@@ -24,6 +24,7 @@
 ;;; Copyright © 2020 Raghav Gururajan <raghavgururajan@disroot.org>
 ;;; Copyright © 2021 Brendan Tildesley <mail@brendan.scot>
 ;;; Copyright © 2021 pineapples <guixuser6392@protonmail.com>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -46,6 +47,7 @@
   #:use-module (guix packages)
   #:use-module (guix download)
   #:use-module (guix git-download)
+  #:use-module (guix build-system cargo)
   #:use-module (guix build-system cmake)
   #:use-module (guix build-system gnu)
   #:use-module (guix build-system meson)
@@ -62,6 +64,7 @@
   #:use-module (gnu packages check)
   #:use-module (gnu packages cmake)
   #:use-module (gnu packages compression)
+  #:use-module (gnu packages crates-io)
   #:use-module (gnu packages cryptsetup)
   #:use-module (gnu packages databases)
   #:use-module (gnu packages disk)
@@ -862,6 +865,89 @@ that require it.  It also provides a universal seat management library that
 allows applications to use whatever seat management is available.")
     (license license:expat)))
 
+(define-public greetd
+  (package
+    (name "greetd")
+    (version "0.7.0")
+    (home-page "https://git.sr.ht/~kennylevinsen/greetd")
+    (source (origin
+              (method git-fetch)
+              (uri (git-reference
+                    (url home-page)
+                    (commit version)))
+              (file-name (git-file-name name version))
+              (sha256
+               (base32 "0lmwr5ld9x2wlq00i7mjgm9by8zndiq9girj8g93k0kww9zbgr3g"))))
+    (build-system cargo-build-system)
+    (arguments
+     `(#:cargo-inputs
+       (("rust-nix" ,rust-nix-0.17)
+        ("rust-pam-sys" ,rust-pam-sys-0.5.6)
+        ("rust-rpassword" ,rust-rpassword-4)
+        ("rust-users" ,rust-users-0.9)
+        ("rust-serde" ,rust-serde-1)
+        ("rust-serde-json" ,rust-serde-json-1)
+        ("rust-libc" ,rust-libc-0.2)
+        ("rust-tokio" ,rust-tokio-0.2)
+        ("rust-getopts" ,rust-getopts-0.2)
+        ("rust-thiserror" ,rust-thiserror-1)
+        ("rust-async-trait" ,rust-async-trait-0.1)
+        ("rust-enquote" ,rust-enquote-1))
+       #:phases
+       (modify-phases %standard-phases
+         ;; once https://todo.sr.ht/~kennylevinsen/greetd/25
+         ;; is solved, below patch can be removed
+         (add-after 'unpack 'patch-terminal-switch
+           (lambda* (#:key inputs #:allow-other-keys)
+             (substitute* "greetd/src/server.rs"
+               (("switch: true,")
+                "switch: false,"))))
+         (delete 'package)
+         (add-after 'build 'build-man-pages
+           (lambda* (#:key inputs #:allow-other-keys)
+             (define (scdoc-cmd doc lvl)
+               (system (string-append "scdoc < "
+                                      doc "-" lvl ".scd > "
+                                      doc "." lvl)))
+             (with-directory-excursion "man"
+               (scdoc-cmd "greetd" "1")
+               (scdoc-cmd "greetd" "5")
+               (scdoc-cmd "greetd-ipc" "7")
+               (scdoc-cmd "agreety" "1"))))
+         (replace 'install
+           (lambda* (#:key inputs outputs #:allow-other-keys)
+             (let* ((out (assoc-ref outputs "out"))
+                    (bin (string-append out "/bin"))
+                    (sbin (string-append out "/sbin"))
+                    (share (string-append out "/share"))
+                    (man (string-append share "/man"))
+                    (man1 (string-append man "/man1"))
+                    (man5 (string-append man "/man5"))
+                    (man7 (string-append man "/man7"))
+                    (release "target/release")
+                    (greetd-bin (string-append release "/greetd"))
+                    (agreety-bin (string-append release "/agreety")))
+               (install-file greetd-bin sbin)
+               (install-file agreety-bin bin)
+               (with-directory-excursion "man"
+                 (install-file "greetd.1" man1)
+                 (install-file "greetd.5" man5)
+                 (install-file "greetd-ipc.7" man7)
+                 (install-file "agreety.1" man1))))))))
+    (native-inputs
+     `(("linux-pam" ,linux-pam)
+       ("scdoc" ,scdoc)))
+    (synopsis "minimal and flexible login manager daemon")
+    (description
+     "greetd is a minimal and flexible login manager daemon
+that makes no assumptions about what you want to launch.
+
+If you can run it from your shell in a TTY, greetd can start it.
+
+If it can be taught to speak a simple JSON-based IPC protocol,
+then it can be a greeter.")
+    (license license:gpl3+)))
+
 (define-public packagekit
   (package
     (name "packagekit")
-- 
2.32.0

[bug#49969] [PATCH v4 00/10] gnu: desktop: Add seatd-service-type and greetd-service-type

[muradm]

This patch series introduces two new services;

 - seatd-service-type: simple seat management daemon
 - greetd-service-type: simple login daemon

Both services are very minimalistic in nature. Simple seatd daemon
could be said as replacement for elogind-service-type. greetd daemon
is simple replacement for mingetty.

In addition to the base services, special build of pam-mount module is
included as greetd-pam-mount. It is used to provide
auto-(mounting/unmounting) of XDG_RUNTIME_DIR. Special build is
required to avoid interference with default pam-mount, if used in
the system.

greetd provides agreety terminal greeter out of the box. Current
greetd-service-type includes configuration for greetd-agreety-session
variations, i.e. only terminal are supported at the moment.

Next step would be adding gtkgreet and/or wlgreet alternatives for
graphical greeter.

muradm (10):
  gnu: crates-io: Add rust-enquote 1.0.3
  gnu: crates-io: Add rust-pam-sys 0.5.6
  gnu: freedesktop: Add greetd 0.7.0
  gnu: admin: Add greetd-pam-mount
  gnu: desktop: Add seatd-service-type
  gnu: desktop: Add greetd-service-type
  gnu: base: Add greetd to applied PAM services
  gnu: pam-mount: Add greetd to applied PAM services
  gnu: tests: Add seatd/greetd based minimal desktop system tests
  doc: Add desktop seatd-service-type and greetd-service-type

 doc/guix.texi                | 187 +++++++++++++++++++++++
 gnu/packages/admin.scm       |  33 ++++
 gnu/packages/crates-io.scm   |  49 ++++++
 gnu/packages/freedesktop.scm | 120 +++++++++++++++
 gnu/services/base.scm        |   3 +-
 gnu/services/desktop.scm     | 288 ++++++++++++++++++++++++++++++++++-
 gnu/services/pam-mount.scm   |   3 +-
 gnu/tests/desktop.scm        | 191 ++++++++++++++++++++++-
 8 files changed, 870 insertions(+), 4 deletions(-)

-- 
2.32.0

[bug#49969] [PATCH v4 01/10] gnu: crates-io: Add rust-enquote 1.0.3

[muradm]

* gnu/packages/crates-io.scm (rust-enquote-1): Add rust-enquote 1.0.3
---
 gnu/packages/crates-io.scm | 22 ++++++++++++++++++++++
 1 file changed, 22 insertions(+)

diff --git a/gnu/packages/crates-io.scm b/gnu/packages/crates-io.scm
index 24cc772ba7..6484d4c4fc 100644
--- a/gnu/packages/crates-io.scm
+++ b/gnu/packages/crates-io.scm
@@ -18,6 +18,7 @@
 ;;; Copyright © 2021 Antero Mejr <antero@kodmin.com>
 ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2021 Vinicius Monego <monego@posteo.net>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -56972,3 +56973,24 @@ variant of this library is available separately as @code{im}.")
     (description
       "Generate Rust register maps (`struct`s) from SVD files")
     (license (list license:expat license:asl2.0))))
+
+(define-public rust-enquote-1
+  (package
+    (name "rust-enquote")
+    (version "1.0.3")
+    (home-page "https://github.com/reujab/enquote")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (crate-uri "enquote" version))
+       (file-name
+        (string-append name "-" version ".tar.gz"))
+       (sha256
+        (base32
+         "0vm687r2wwgc3d3l2iqhag9wgkql6k93sdvjxvmfkdpksajpij1f"))))
+    (build-system cargo-build-system)
+    (synopsis
+     "A Rust library quotes, unquotes, and unescapes strings")
+    (description
+     "A Rust library quotes, unquotes, and unescapes strings")
+    (license license:unlicense)))
-- 
2.32.0

[bug#49969] [PATCH v4 02/10] gnu: crates-io: Add rust-pam-sys 0.5.6

[muradm]

* gnu/packages/crates-io.scm (rust-pam-sys): Add rust-pam-sys 0.5.6
---
 gnu/packages/crates-io.scm | 27 +++++++++++++++++++++++++++
 1 file changed, 27 insertions(+)

diff --git a/gnu/packages/crates-io.scm b/gnu/packages/crates-io.scm
index 6484d4c4fc..d91417d76f 100644
--- a/gnu/packages/crates-io.scm
+++ b/gnu/packages/crates-io.scm
@@ -55,6 +55,7 @@
   #:use-module (gnu packages glib)
   #:use-module (gnu packages image)
   #:use-module (gnu packages jemalloc)
+  #:use-module (gnu packages linux)
   #:use-module (gnu packages llvm)
   #:use-module (gnu packages multiprecision)
   #:use-module (gnu packages nettle)
@@ -56994,3 +56995,29 @@ variant of this library is available separately as @code{im}.")
     (description
      "A Rust library quotes, unquotes, and unescapes strings")
     (license license:unlicense)))
+
+(define-public rust-pam-sys-0.5.6
+  (package
+    (name "rust-pam-sys")
+    (version "0.5.6")
+    (home-page "https://github.com/1wilkens/pam-sys")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (crate-uri "pam-sys" version))
+       (file-name
+        (string-append name "-" version ".tar.gz"))
+       (sha256
+        (base32
+         "0d14501d5vybjnzxfjf96321xa5wa36x1xvf02h02zq938qmhj6d"))))
+    (build-system cargo-build-system)
+    (arguments
+     `(#:cargo-inputs
+       (("rust-libc" ,rust-libc-0.2))))
+    (native-inputs
+     `(("linux-pam" ,linux-pam)))
+    (synopsis
+     "Rust FFI wrappers for the Linux Pluggable Authentication Modules (PAM)")
+    (description
+     "Rust FFI wrappers for the Linux Pluggable Authentication Modules (PAM)")
+    (license (list license:expat license:asl2.0))))
-- 
2.32.0

[bug#49969] [PATCH v4 03/10] gnu: freedesktop: Add greetd 0.7.0

[muradm]

* gnu/packages/freedesktop.scm (greetd): Add greetd 0.7.0
---
 gnu/packages/freedesktop.scm | 120 +++++++++++++++++++++++++++++++++++
 1 file changed, 120 insertions(+)

diff --git a/gnu/packages/freedesktop.scm b/gnu/packages/freedesktop.scm
index 693a79c738..ba5f6b0f99 100644
--- a/gnu/packages/freedesktop.scm
+++ b/gnu/packages/freedesktop.scm
@@ -24,6 +24,7 @@
 ;;; Copyright © 2020 Raghav Gururajan <raghavgururajan@disroot.org>
 ;;; Copyright © 2021 Brendan Tildesley <mail@brendan.scot>
 ;;; Copyright © 2021 pineapples <guixuser6392@protonmail.com>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -46,6 +47,7 @@
   #:use-module (guix packages)
   #:use-module (guix download)
   #:use-module (guix git-download)
+  #:use-module (guix build-system cargo)
   #:use-module (guix build-system cmake)
   #:use-module (guix build-system gnu)
   #:use-module (guix build-system meson)
@@ -62,6 +64,7 @@
   #:use-module (gnu packages check)
   #:use-module (gnu packages cmake)
   #:use-module (gnu packages compression)
+  #:use-module (gnu packages crates-io)
   #:use-module (gnu packages cryptsetup)
   #:use-module (gnu packages databases)
   #:use-module (gnu packages disk)
@@ -862,6 +865,123 @@ that require it.  It also provides a universal seat management library that
 allows applications to use whatever seat management is available.")
     (license license:expat)))
 
+(define-public greetd
+  (package
+    (name "greetd")
+    (version "0.7.0")
+    (home-page "https://git.sr.ht/~kennylevinsen/greetd")
+    (source (origin
+              (method git-fetch)
+              (uri (git-reference
+                    (url home-page)
+                    (commit version)))
+              (file-name (git-file-name name version))
+              (sha256
+               (base32 "0lmwr5ld9x2wlq00i7mjgm9by8zndiq9girj8g93k0kww9zbgr3g"))))
+    (build-system cargo-build-system)
+    (arguments
+     `(#:cargo-inputs
+       (("rust-nix" ,rust-nix-0.17)
+        ("rust-pam-sys" ,rust-pam-sys-0.5.6)
+        ("rust-rpassword" ,rust-rpassword-4)
+        ("rust-users" ,rust-users-0.9)
+        ("rust-serde" ,rust-serde-1)
+        ("rust-serde-json" ,rust-serde-json-1)
+        ("rust-libc" ,rust-libc-0.2)
+        ("rust-tokio" ,rust-tokio-0.2)
+        ("rust-getopts" ,rust-getopts-0.2)
+        ("rust-thiserror" ,rust-thiserror-1)
+        ("rust-async-trait" ,rust-async-trait-0.1)
+        ("rust-enquote" ,rust-enquote-1))
+       #:phases
+       (modify-phases %standard-phases
+         ;; issue with terminal activation solved by this feature:
+         ;; https://lists.sr.ht/~kennylevinsen/greetd-devel/patches/24441
+         ;; greetd-next builds from head of #24441
+         ;; below substitute is provided as workaround for tagged version
+         (add-after 'unpack 'patch-terminal-switch
+           (lambda* (#:key inputs #:allow-other-keys)
+             (substitute* "greetd/src/server.rs"
+               (("switch: true,")
+                "switch: false,"))))
+         (delete 'package)
+         (add-after 'build 'build-man-pages
+           (lambda* (#:key inputs #:allow-other-keys)
+             (define (scdoc-cmd doc lvl)
+               (system (string-append "scdoc < "
+                                      doc "-" lvl ".scd > "
+                                      doc "." lvl)))
+             (with-directory-excursion "man"
+               (scdoc-cmd "greetd" "1")
+               (scdoc-cmd "greetd" "5")
+               (scdoc-cmd "greetd-ipc" "7")
+               (scdoc-cmd "agreety" "1"))))
+         (replace 'install
+           (lambda* (#:key inputs outputs #:allow-other-keys)
+             (let* ((out (assoc-ref outputs "out"))
+                    (bin (string-append out "/bin"))
+                    (sbin (string-append out "/sbin"))
+                    (share (string-append out "/share"))
+                    (man (string-append share "/man"))
+                    (man1 (string-append man "/man1"))
+                    (man5 (string-append man "/man5"))
+                    (man7 (string-append man "/man7"))
+                    (release "target/release")
+                    (greetd-bin (string-append release "/greetd"))
+                    (agreety-bin (string-append release "/agreety")))
+               (install-file greetd-bin sbin)
+               (install-file agreety-bin bin)
+               (with-directory-excursion "man"
+                 (install-file "greetd.1" man1)
+                 (install-file "greetd.5" man5)
+                 (install-file "greetd-ipc.7" man7)
+                 (install-file "agreety.1" man1))))))))
+    (native-inputs
+     `(("linux-pam" ,linux-pam)
+       ("scdoc" ,scdoc)))
+    (synopsis "minimal and flexible login manager daemon")
+    (description
+     "greetd is a minimal and flexible login manager daemon
+that makes no assumptions about what you want to launch.
+
+If you can run it from your shell in a TTY, greetd can start it.
+
+If it can be taught to speak a simple JSON-based IPC protocol,
+then it can be a greeter.")
+    (license license:gpl3+)))
+
+(define-public greetd-next
+  (package
+    (inherit greetd)
+    (name "greetd")
+    (version "0.7.0-next")
+    (source (origin
+              (method git-fetch)
+              (uri (git-reference
+                    (url (package-home-page greetd))
+                    (commit "87e92776543c224676d64316f4519b509c21a0d5")))
+              (file-name (git-file-name name version))
+              (sha256
+               (base32 "13dblvhx5vbsx0yqyz2sq1ayffqwadbkn90p52wd5b66ij1z6v1a"))))
+    (arguments
+     (substitute-keyword-arguments (package-arguments greetd)
+       ((#:cargo-inputs inputs)
+        `(("rust-nix" ,rust-nix-0.19)
+           ("rust-pam-sys" ,rust-pam-sys-0.5.6)
+           ("rust-rpassword" ,rust-rpassword-5)
+           ("rust-users" ,rust-users-0.11)
+           ("rust-serde" ,rust-serde-1)
+           ("rust-serde-json" ,rust-serde-json-1)
+           ("rust-libc" ,rust-libc-0.2)
+           ("rust-tokio" ,rust-tokio-1)
+           ("rust-getopts" ,rust-getopts-0.2)
+           ("rust-thiserror" ,rust-thiserror-1)
+           ("rust-async-trait" ,rust-async-trait-0.1)
+           ("rust-enquote" ,rust-enquote-1)))
+       ((#:phases phases)
+        `(modify-phases ,phases
+           (delete 'patch-terminal-switch)))))))
+
 (define-public packagekit
   (package
     (name "packagekit")
-- 
2.32.0

[bug#49969] [PATCH v4 04/10] gnu: admin: Add greetd-pam-mount

[muradm]

* gnu/packages/admin.scm (greetd-pam-mount): Add greetd-pam-mount
---
 gnu/packages/admin.scm | 33 +++++++++++++++++++++++++++++++++
 1 file changed, 33 insertions(+)

diff --git a/gnu/packages/admin.scm b/gnu/packages/admin.scm
index 007f15f9f5..c9bfe0b667 100644
--- a/gnu/packages/admin.scm
+++ b/gnu/packages/admin.scm
@@ -42,6 +42,7 @@
 ;;; Copyright © 2021 David Larsson <david.larsson@selfhosted.xyz>
 ;;; Copyright © 2021 WinterHound <winterhound@yandex.com>
 ;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -4247,6 +4248,38 @@ supports.  It can also mount encrypted LUKS volumes using the password
 supplied by the user when logging in.")
     (license (list license:gpl2+ license:lgpl2.1+))))
 
+(define-public greetd-pam-mount
+  (package
+    (inherit pam-mount)
+    (name "greetd-pam-mount")
+    (arguments
+     (substitute-keyword-arguments (package-arguments pam-mount)
+       ((#:configure-flags flags ''())
+        `(cons* "--with-rundir=/run/greetd" ,flags))
+       ((#:phases phases)
+        `(modify-phases ,phases
+           (add-after 'unpack 'patch-config-file-name
+             (lambda* (#:key inputs #:allow-other-keys)
+               (substitute* "src/pam_mount.c"
+                 ((".*define CONFIGFILE .*$")
+                  "#define CONFIGFILE \"/etc/security/greetd_pam_mount.conf.xml\"\n")
+                 (("pam_mount_config") "greetd_pam_mount_config")
+                 (("pam_mount_system_authtok") "greetd_pam_mount_system_authtok"))))))))
+    (synopsis "pam-mount specifically compiled for use with greetd")
+    (description
+     "Pam-mount is a PAM module that can mount volumes when a user logs in.
+It supports mounting local filesystems of any kind the normal mount utility
+supports.  It can also mount encrypted LUKS volumes using the password
+supplied by the user when logging in.
+
+This package inherits pam-mount in the way that it is compiled specifically
+for use with greetd daemon. It uses different configuration location and
+name space for storing data in PAM.
+
+greetd-pam-mount is used in configuration of greetd to provide
+auto-(mounting/unmounting) of XDG_RUNTIME_DIR in the way that it will not
+interfere with default pam-mount configuration.")))
+
 (define-public jc
   (package
     (name "jc")
-- 
2.32.0

[bug#49969] [PATCH v4 05/10] gnu: desktop: Add seatd-service-type

[muradm]

* gnu/services/desktop.scm: Add seatd-service-type
---
 gnu/services/desktop.scm | 60 +++++++++++++++++++++++++++++++++++++++-
 1 file changed, 59 insertions(+), 1 deletion(-)

diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index 64d0e85301..c42db5987e 100644
--- a/gnu/services/desktop.scm
+++ b/gnu/services/desktop.scm
@@ -13,6 +13,7 @@
 ;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2020 Reza Alizadeh Majd <r.majd@pantherx.org>
 ;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -39,7 +40,9 @@
   #:use-module (gnu services networking)
   #:use-module (gnu services sound)
   #:use-module ((gnu system file-systems)
-                #:select (%elogind-file-systems file-system))
+                #:select (%control-groups
+                          %elogind-file-systems
+                          file-system))
   #:use-module (gnu system)
   #:use-module (gnu system setuid)
   #:use-module (gnu system shadow)
@@ -154,6 +157,9 @@
             gnome-keyring-configuration?
             gnome-keyring-service-type
 
+            seatd-configuration
+            seatd-service-type
+
             %desktop-services))
 
 ;;; Commentary:
@@ -1182,6 +1188,58 @@ or setting its password with passwd.")))
 (define polkit-wheel-service
   (simple-service 'polkit-wheel polkit-service-type (list polkit-wheel)))
 
+\f
+;;;
+;;; seatd-service-type -- minimal seat management daemon
+;;;
+
+(define-record-type* <seatd-configuration> seatd-configuration
+  make-seatd-configuration
+  seatd-configuration?
+  (seatd seatd-package (default seatd))
+  (user seatd-user (default "root"))
+  (group seatd-group (default "users"))
+  (socket seatd-socket (default "/run/seatd.sock"))
+  (loglevel seatd-loglevel (default "error")))
+
+(define (seatd-shepherd-service config)
+  (list (shepherd-service
+         (documentation "Minimal seat management daemon")
+         (requirement '())
+         ;; TODO: once cgroups is separate dependency
+         ;; here we should depend on it rather than elogind
+         (provision '(seatd elogind))
+         (start #~(make-forkexec-constructor
+                   (list #$(file-append (seatd-package config) "/bin/seatd")
+                         "-u" #$(seatd-user config)
+                         "-g" #$(seatd-group config)
+                         "-s" #$(seatd-socket config))
+                   #:environment-variables
+                   (list (string-append "SEATD_LOGLEVEL="
+                                        #$(seatd-loglevel config)))
+                   #:log-file "/tmp/seatd.log"))
+         (stop #~(make-kill-destructor)))))
+
+(define seatd-environment
+  (match-lambda
+    (($ <seatd-configuration> _ _ _ socket)
+     `(("SEATD_SOCK" . ,socket)))))
+
+(define seatd-service-type
+  (service-type
+   (name 'seatd)
+   (description "Seat management takes care of mediating access
+to shared devices (graphics, input), without requiring the
+applications needing access to be root.")
+   (extensions
+    (list
+     (service-extension session-environment-service-type seatd-environment)
+     ;; TODO: once cgroups is separate dependency we should not mount it here
+     ;; for now it is mounted here, because elogind mounts it
+     (service-extension file-system-service-type (const %control-groups))
+     (service-extension shepherd-root-service-type seatd-shepherd-service)))
+   (default-value (seatd-configuration))))
+
 \f
 ;;;
 ;;; The default set of desktop services.
-- 
2.32.0

[bug#49969] [PATCH v4 06/10] gnu: desktop: Add greetd-service-type

[muradm]

Currently, only agreety configuration is provided.

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

diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index c42db5987e..e37811cf94 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,12 @@
             seatd-configuration
             seatd-service-type
 
+            greetd-configuration
+            greetd-terminal-configuration
+            greetd-service-type
+            greetd-agreety-tty-session
+            greetd-agreety-tty-xdg-session
+
             %desktop-services))
 
 ;;; Commentary:
@@ -1240,6 +1247,227 @@ applications needing access to be root.")
      (service-extension shepherd-root-service-type seatd-shepherd-service)))
    (default-value (seatd-configuration))))
 
+\f
+;;;
+;;; 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?
+  (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 match))
+          (let*
+              ((username (getenv "USER"))
+               (useruid (passwd:uid (getpwuid username)))
+               (useruid (number->string useruid))
+               (abs-cmd-bin #$(file-append package command-bin)))
+            (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-terminal-configuration>
+  greetd-terminal-configuration make-greetd-terminal-configuration
+  greetd-terminal-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"))
+  (terminal-switch greetd-terminal-switch (default #f))
+  (default-session-user greetd-default-session-user (default "greeter"))
+  (default-session-command greetd-default-session-command
+    (default greetd-agreety-tty-xdg-session)))
+
+(define (default-config-file-name config)
+  (string-join (list "config-" (greetd-terminal-vt config) ".toml") ""))
+
+(define make-greetd-terminal-default-session-command
+  (match-lambda
+    (($ <greetd-terminal-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 (make-greetd-terminal-configuration-file config)
+  (let*
+      ((config-file-name (greetd-config-file-name config))
+       (terminal-vt (greetd-terminal-vt config))
+       (terminal-switch (greetd-terminal-switch config))
+       (default-session-user (greetd-default-session-user config))
+       (default-session-command (make-greetd-terminal-default-session-command config)))
+    (mixed-text-file
+     config-file-name
+     "[terminal]\n"
+     "vt = " terminal-vt "\n"
+     "switch = " (if terminal-switch "true" "false") "\n"
+     "[default_session]\n"
+     "user = " default-session-user "\n"
+     "command = " default-session-command "\n")))
+
+(define %default-motd
+  (plain-file "motd" "This is the GNU operating system, welcome!\n\n"))
+
+(define %greetd-accounts
+  (list (user-account
+         (name "greeter")
+         (group "wheel")
+         (supplementary-groups '("users" "tty" "input" "video" "audio"))
+         (system? #t))))
+
+(define %greetd-file-systems
+  (list (file-system
+          (device "none")
+          (mount-point "/run/greetd/pam_mount")
+          (type "tmpfs")
+          (check? #f)
+          (flags '(no-suid no-dev no-exec))
+          (options "mode=0755")
+          (create-mount-point? #t))))
+
+(define %greetd-pam-mount-rules
+  `((debug (@ (enable "0")))
+    (volume (@ (sgrp "users")
+               (fstype "tmpfs")
+               (mountpoint "/run/user/%(USERUID)")
+               (options "noexec,nosuid,nodev,size=1g,mode=0700,uid=%(USERUID),gid=%(USERGID)")))
+    (logout (@ (wait "0")
+               (hup "0")
+               (term "yes")
+               (kill "no")))
+    (mkmountpoint (@ (enable "1") (remove "true")))))
+
+(define-record-type* <greetd-configuration>
+  greetd-configuration make-greetd-configuration
+  greetd-configuration?
+  (motd greetd-motd (default %default-motd))
+  (allow-empty-passwords? greetd-allow-empty-passwords? (default #t))
+  (terminals greetd-terminals (default '())))
+
+(define (make-greetd-pam-mount-conf-file config)
+  (computed-file
+   "greetd_pam_mount.conf.xml"
+   #~(begin
+       (use-modules (sxml simple))
+       (call-with-output-file #$output
+         (lambda (port)
+           (sxml->xml
+            '(*TOP*
+              (*PI* xml "version='1.0' encoding='utf-8'")
+              (pam_mount
+               #$@%greetd-pam-mount-rules
+               (pmvarrun
+                #$(file-append greetd-pam-mount
+                               "/sbin/pmvarrun -u '%(USER)' -o '%(OPERATION)'"))))
+            port))))))
+
+(define (greetd-etc-service config)
+  `(("security/greetd_pam_mount.conf.xml"
+     ,(make-greetd-pam-mount-conf-file config))))
+
+(define (greetd-pam-service config)
+  (define optional-pam-mount
+    (pam-entry
+     (control "optional")
+     (module #~(string-append #$greetd-pam-mount "/lib/security/pam_mount.so"))))
+
+  (list
+   (unix-pam-service "greetd"
+                     #:login-uid? #t
+                     #:allow-empty-passwords?
+                     (greetd-allow-empty-passwords? config)
+                     #:motd
+                     (greetd-motd config))
+   (lambda (pam)
+     (if (member (pam-service-name pam)
+                 '("login" "greetd" "su" "slim" "gdm-password"))
+         (pam-service
+          (inherit pam)
+          (auth (append (pam-service-auth pam)
+                        (list optional-pam-mount)))
+          (session (append (pam-service-session pam)
+                           (list optional-pam-mount))))
+         pam))))
+
+(define (greetd-shepherd-services config)
+  (map
+   (lambda (tc)
+     (let*
+         ((greetd-bin (file-append (greetd-package tc) "/sbin/greetd"))
+          (greetd-conf (make-greetd-terminal-configuration-file tc))
+          (greetd-vt (greetd-terminal-vt tc)))
+       (shepherd-service
+        (documentation "Minimal and flexible login manager daemon")
+        (requirement '(user-processes host-name udev virtual-terminal))
+        (provision (list (symbol-append
+                          'term-tty
+                          (string->symbol (greetd-terminal-vt tc)))))
+        (start #~(make-forkexec-constructor
+                  (list #$greetd-bin "-c" #$greetd-conf)
+                  #:log-file
+                  (string-append "/tmp/greetd." #$greetd-vt ".log")))
+        (stop #~(make-kill-destructor)))))
+   (greetd-terminals config)))
+
+(define greetd-service-type
+  (service-type
+   (name 'greetd)
+   (description "Provides necessary infrastructure for logging into the
+system including @code{greetd} PAM service, @code{pam-mount} module to
+mount/unmount /run/user/<uid> directory for user and @code{greetd}
+login manager daemon.")
+   (extensions
+    (list
+     (service-extension account-service-type (const %greetd-accounts))
+     (service-extension file-system-service-type (const %greetd-file-systems))
+     (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)))
+   (default-value (greetd-configuration))))
+
 \f
 ;;;
 ;;; The default set of desktop services.
-- 
2.32.0

[bug#49969] [PATCH v4 07/10] gnu: base: Add greetd to applied PAM services

[muradm]

* gnu/services/base.scm (pam-limits-service-type): add greetd PAM
service to applicable PAM services
---
 gnu/services/base.scm | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index c784d312b1..446ecc30f8 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -15,6 +15,7 @@
 ;;; Copyright © 2020, 2021 Brice Waegeneire <brice@waegenei.re>
 ;;; Copyright © 2021 qblade <qblade@protonmail.com>
 ;;; Copyright © 2021 Hui Lu <luhuins@163.com>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -1392,7 +1393,7 @@ information on the configuration file syntax."
                               (module "pam_limits.so")
                               (arguments '("conf=/etc/security/limits.conf")))))
              (if (member (pam-service-name pam)
-                         '("login" "su" "slim" "gdm-password" "sddm"))
+                         '("login" "greetd" "su" "slim" "gdm-password" "sddm"))
                  (pam-service
                   (inherit pam)
                   (session (cons pam-limits
-- 
2.32.0

[bug#49969] [PATCH v4 08/10] gnu: pam-mount: Add greetd to applied PAM services

[muradm]

* gnu/services/pam-mount.scm (pam-mount-service-type): add greetd PAM
service to applicable PAM services
---
 gnu/services/pam-mount.scm | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/gnu/services/pam-mount.scm b/gnu/services/pam-mount.scm
index 98611462c2..7b25efeb50 100644
--- a/gnu/services/pam-mount.scm
+++ b/gnu/services/pam-mount.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2019 Guillaume Le Vaillant <glv@posteo.net>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -90,7 +91,7 @@
      (module #~(string-append #$pam-mount "/lib/security/pam_mount.so"))))
   (list (lambda (pam)
           (if (member (pam-service-name pam)
-                      '("login" "su" "slim" "gdm-password"))
+                      '("login" "greetd" "su" "slim" "gdm-password"))
               (pam-service
                (inherit pam)
                (auth (append (pam-service-auth pam)
-- 
2.32.0

[bug#49969] [PATCH v4 09/10] gnu: tests: Add seatd/greetd based minimal desktop system tests

[muradm]

* gnu/tests/desktop.scm (minimal-desktop): seatd/greetd based
minimal desktop
---
 gnu/tests/desktop.scm | 191 +++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 190 insertions(+), 1 deletion(-)

diff --git a/gnu/tests/desktop.scm b/gnu/tests/desktop.scm
index 6aa22fd49b..2517eb7b30 100644
--- a/gnu/tests/desktop.scm
+++ b/gnu/tests/desktop.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -19,12 +20,15 @@
 (define-module (gnu tests desktop)
   #:use-module (gnu tests)
   #:use-module (gnu services)
+  #:use-module (gnu services base)
   #:use-module (gnu services dbus)
   #:use-module (gnu services desktop)
+  #:use-module (gnu system)
   #:use-module (gnu system vm)
   #:use-module (guix gexp)
   #:use-module (srfi srfi-1)
-  #:export (%test-elogind))
+  #:export (%test-elogind
+            %test-minimal-desktop))
 
 \f
 ;;;
@@ -103,3 +107,188 @@
                #:imported-modules '((gnu services herd)
                                     (guix combinators)))))
       (run-elogind-test (virtual-machine os))))))
+
+\f
+;;;
+;;; Seatd/greetd based minimal desktop
+;;;
+
+(define %minimal-services
+  (append
+   (list
+    (service seatd-service-type)
+    (service greetd-service-type
+             (greetd-configuration
+              (terminals
+               (list
+                (greetd-terminal-configuration (terminal-vt "1") (terminal-switch #t))
+                (greetd-terminal-configuration (terminal-vt "2"))
+                (greetd-terminal-configuration (terminal-vt "3"))
+                (greetd-terminal-configuration (terminal-vt "4"))
+                (greetd-terminal-configuration (terminal-vt "5"))
+                (greetd-terminal-configuration (terminal-vt "6")))))))
+   (modify-services %base-services
+     (delete login-service-type)
+     (delete mingetty-service-type))))
+
+(define-syntax-rule (minimal-operating-system user-services ...)
+  "Return an operating system that includes USER-SERVICES in addition to
+minimal %BASE-SERVICES."
+  (operating-system (inherit %simple-os)
+                    (services (cons* user-services ... %minimal-services))))
+
+(define (run-minimal-desktop-test os vm)
+  (define test
+    (with-imported-modules '((gnu build marionette)
+                             (guix build syscalls))
+      #~(begin
+          (use-modules (gnu build marionette)
+                       (guix build syscalls)
+                       (srfi srfi-1)
+                       (srfi srfi-64)
+                       (ice-9 pretty-print))
+
+          (define marionette
+            (make-marionette #$vm))
+
+          (define (file-get-all-strings fname)
+            (marionette-eval '(use-modules (rnrs io ports)) marionette)
+            (wait-for-file fname marionette #:read 'get-string-all))
+
+          (define (wait-for-unix-socket-m socket)
+            (wait-for-unix-socket socket marionette))
+
+          (mkdir #$output)
+          (chdir #$output)
+
+          (test-begin "minimal-desktop")
+
+          (test-assert "seatd is ready"
+            (wait-for-unix-socket-m "/run/seatd.sock"))
+
+          (test-equal "login user on tty1"
+            "alice\n"
+            (begin
+              ;; Wait for tty1.
+              (marionette-eval
+               '(begin
+                  (use-modules (gnu services herd))
+                  (start-service 'term-tty1))
+               marionette)
+              (marionette-control "sendkey ctrl-alt-f1" marionette)
+
+              ;; login as root change alice password and exit
+              ;; then login as alice
+              (for-each
+               (lambda (cmd) (marionette-type cmd marionette) (sleep 1))
+               (list
+                "root\n"
+                "\n"
+                "passwd alice\n"
+                "alice\n"
+                "alice\n"
+                "exit\n"
+                "alice\n"
+                "alice\n"
+                "id -un > logged-in\n"))
+
+              (file-get-all-strings "/home/alice/logged-in")))
+
+          (test-equal "validate user environment"
+            '("SEATD_SOCK=/run/seatd.sock"
+              "XDG_RUNTIME_DIR=/run/user/1000"
+              "XDG_SEAT=seat0"
+              "XDG_VTNR=1")
+
+            (begin
+              (marionette-type "env > env\n" marionette)
+              (sleep 1)
+
+              (define user-env (string-tokenize
+                                (file-get-all-strings "/home/alice/env")))
+
+              (define (expected-var var)
+                (any (lambda (s) (string-contains var s))
+                     '("SEATD_SOCK"
+                       "XDG_RUNTIME_DIR"
+                       "XDG_SEAT"
+                       "XDG_VTNR")))
+
+              (sort (filter expected-var user-env) string<?)))
+
+          (test-assert "validate SEATD_SOCK and GREETD_SOCK"
+            (begin
+              (marionette-type "env > env\n" marionette)
+              (sleep 1)
+
+              (define (sock-var? var)
+                (any (lambda (s) (string-contains var s))
+                     '("SEATD_SOCK" "GREETD_SOCK")))
+
+              (define (sock-var-sock var)
+                (car (cdr (string-split var #\=))))
+
+              (let*
+                  ((out (file-get-all-strings "/home/alice/env"))
+                   (out (string-tokenize out))
+                   (out (filter sock-var? out))
+                   (socks (map sock-var-sock out))
+                   (socks (map wait-for-unix-socket-m socks)))
+                (and (= 2 (length socks)) (every identity socks)))))
+
+          (test-assert "greetd is ready"
+            (begin
+              (marionette-type "ps -C greetd -o pid,args --no-headers > ps-greetd\n"
+                               marionette)
+              (sleep 1)
+
+              (define (greetd-daemon? cmd)
+                (string-contains cmd "config"))
+
+              (define (greetd-cmd-to-pid cmd)
+                (car (string-split cmd #\space)))
+
+              (define (greetd-pid-to-sock pid)
+                (string-append "/run/greetd-" pid ".sock"))
+
+              (let* ((out (file-get-all-strings "/home/alice/ps-greetd"))
+                     (out (string-split out #\newline))
+                     (out (map string-trim-both out))
+                     (out (filter greetd-daemon? out))
+                     (pids (map greetd-cmd-to-pid out))
+                     (socks (map greetd-pid-to-sock pids))
+                     (socks (map wait-for-unix-socket-m socks)))
+                (every identity socks))))
+
+          ;; a bit weak, but tests everything at once actually
+          (test-equal "check /run/user/<uid> mounted and writable"
+            "alice\n"
+            (begin
+              (marionette-type "echo alice > /run/user/1000/test\n" marionette)
+              (file-get-all-strings "/run/user/1000/test")))
+
+          (test-assert "screendump"
+            (begin
+              (marionette-control (string-append "screendump " #$output
+                                                 "/tty1.ppm")
+                                  marionette)
+              (file-exists? "tty1.ppm")))
+
+          (test-end)
+          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+  (gexp->derivation "minimal-desktop" test))
+
+(define %test-minimal-desktop
+  (system-test
+   (name "minimal-desktop")
+   (description
+    "Test whether we can log in when seatd and greetd is enabled")
+   (value
+    (let* ((os (marionette-operating-system
+                (minimal-operating-system)
+                #:imported-modules '((gnu services herd)
+                                     (guix combinators))))
+           (vm (virtual-machine os)))
+      (run-minimal-desktop-test (virtualized-operating-system os '())
+                                #~(list #$vm))))))
-- 
2.32.0

[bug#49969] [PATCH v4 10/10] doc: Add desktop seatd-service-type and greetd-service-type

[muradm]

* doc/guix.texi (Desktop Services): Provide documentation for
seatd-service-type and greetd-service-type including configuration
and sample usage.
---
 doc/guix.texi | 187 ++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 187 insertions(+)

diff --git a/doc/guix.texi b/doc/guix.texi
index 17ecc3ad0f..01a895fe62 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -94,6 +94,7 @@ Copyright @copyright{} 2021 Xinglu Chen@*
 Copyright @copyright{} 2021 Raghav Gururajan@*
 Copyright @copyright{} 2021 Domagoj Stolfa@*
 Copyright @copyright{} 2021 Hui Lu@*
+Copyright @copyright{} 2021 muradm@*
 
 Permission is granted to copy, distribute and/or modify this document
 under the terms of the GNU Free Documentation License, Version 1.3 or
@@ -19702,6 +19703,192 @@ and ``passwd'' is with the value @code{passwd}.
 @end table
 @end deftp
 
+@defvr {Scheme Variable} seatd-service-type
+A minimal seat management daemon, and a universal seat management library.
+
+Seat management takes care of mediating access to shared devices (graphics,
+input), without requiring the applications needing access to be root.
+
+In general should be used as replacement to @code{elogind-service-type}.
+
+@lisp
+(append
+  (list
+   ;; make sure seatd is running
+   (service seatd-service-type)
+
+   (service greetd-service-type
+            (greetd-configuration
+             (terminals
+              (list
+               ;; lets have terminals 1, 2 and 3 run default XDG terminal session
+               ;; also ask terminal 1 to become active
+               (greetd-terminal-configuration (terminal-vt "1") (terminal-switch #t))
+               (greetd-terminal-configuration (terminal-vt "2"))
+               (greetd-terminal-configuration (terminal-vt "3"))
+               ;; and terminals 4, 5 and 6 plain bash terminal session
+               ;; although not so plain, just to illustrate flexibility
+               (greetd-terminal-configuration
+                (terminal-vt "4")
+                (default-session-command greetd-agreety-tty-session))
+               (greetd-terminal-configuration
+                (terminal-vt "5")
+                (default-session-command greetd-agreety-tty-session))
+               (greetd-terminal-configuration
+                (terminal-vt "6")
+                (default-session-command greetd-agreety-tty-session))))))
+
+  ;; normaly one would want %base-services
+  (modify-services %base-services
+    ;; seatd/greetd combination can replace these
+    ;; greetd provides its own PAM service
+    (delete login-service-type)
+    (delete mingetty-service-type)))
+
+@end lisp
+
+@end defvr
+
+@deftp {Data Type} seatd-configuration
+Configuration record for the seatd daemon service.
+
+@table @asis
+@item @code{seatd} (default: @code{seatd})
+The seatd package to use.
+
+@item @code{user} (default: @samp{"root"})
+User to own the seatd socket.
+
+@item @code{group} (default: @samp{"users"})
+Group to own the seatd socket.
+
+@item @code{socket} (default: @samp{"/run/seatd.sock"})
+Where to create the seatd socket.
+
+@item @code{loglevel} (default: @samp{"error"})
+Log level to output logs. Possible values: @samp{"silent"}, @samp{"error"},
+@samp{"info"} and @samp{"debug"}.
+
+@end table
+@end deftp
+
+@defvr {Scheme Variable} greetd-service-type
+greetd is a minimal and flexible login manager daemon that makes no
+assumptions about what you want to launch.
+
+If you can run it from your shell in a TTY, greetd can start it. If it
+can be taught to speak a simple JSON-based IPC protocol, then it can
+be a greeter.
+
+@code{<greetd-service-type>} provides necessary infrastructure for
+logging in users, including:
+
+@itemize @bullet
+@item
+@code{greetd} PAM service
+
+@item
+Special variation of @code{pam-mount} to mount @code{XDG_RUNTIME_DIR}
+
+@end itemize
+
+@end defvr
+
+@deftp {Data Type} greetd-configuration
+Configuration record for the greetd service.
+
+@table @asis
+@item @code{motd}
+A file-like object containing the ``message of the day''.
+
+@item @code{allow-empty-passwords?} (default: @code{#t})
+Allow empty passwords by default so that first-time users can log in when
+the 'root' account has just been created.
+
+@item @code{terminals} (default: @code{'()})
+List of @code{<greetd-terminal-configuration>} per terminal for which
+@code{greetd} should be started.
+
+@end table
+@end deftp
+
+@deftp {Data Type} greetd-terminal-configuration
+Configuration record for per terminal greetd daemon service.
+
+@table @asis
+@item @code{greetd} (default: @code{greetd})
+The greetd package to use.
+
+@item @code{config-file-name}
+Configuration file name to use for greetd daemon. Generally, autogenerated
+derivation based on @code{terminal-vt} value.
+
+@item @code{terminal-vt} (default: @samp{"7"})
+The VT to run on. Use of a specific VT with appropriate conflict avoidance
+is recommended.
+
+@item @code{terminal-switch} (default: @code{#f})
+Make this terminal active on start of @code{greetd}.
+
+@item @code{default-session-user} (default: @samp{"greeter"})
+The user to use for running the greeter.
+
+@item @code{default-session-command} (default: @code{greetd-agreety-tty-xdg-session})
+The command-line to run to start the default session.
+
+Possible values are:
+
+@itemize @bullet
+@item
+@code{greetd-agreety-tty-session} - bash terminal session
+
+@item
+@code{greetd-agreety-tty-xdg-session} - bash terminal session with XDG environment
+
+@item
+@code{greetd-agreety-session} - custom instance of terminal session
+@end itemize
+
+@end table
+@end deftp
+
+@deftp {Data Type} greetd-agreety-session
+Configuration record for the agreety greetd greeter.
+
+@table @asis
+@item @code{package} (default: @code{bash})
+The package of command.
+
+@item @code{command-bin} (default: @samp{"/bin/bash"})
+Path to binary relative to @code{package}.
+
+@item @code{command-args} (default: @code{'("-l")})
+Command arguments to pass to command.
+
+@item @code{extra-env} (default: @code{'()})
+Extra environment variables to set on login.
+
+@item @code{command-generator}
+Function that receives instance of this configuration as an argument and
+returns @code{program-file} that can be used with @code{agreety} greeter.
+
+Both @code{greetd-agreety-tty-session} and @code{greetd-agreety-tty-xdg-session}
+uses @code{greetd-agreety-session} under the hood.
+
+@end table
+@end deftp
+
+@defvr {Scheme Variable} greetd-agreety-tty-session
+Provides instance of @code{greetd-agreety-session} which starts @samp{"bash -l"}
+on login.
+@end defvr
+
+@defvr {Scheme Variable} greetd-agreety-tty-xdg-session
+Provides instance of @code{greetd-agreety-session} which starts @samp{"bash -l"}
+on login. Additionally, will set @code{XDG_SESSION_TYPE} and
+@code{XDG_RUNTIME_DIR} environment variables for session.
+@end defvr
+
 
 @node Sound Services
 @subsection Sound Services
-- 
2.32.0

[bug#49969] [PATCH v5 00/10] gnu: desktop: Add seatd-service-type and greetd-service-type

[muradm]

This patch series introduces two new services;

 - seatd-service-type: simple seat management daemon
 - greetd-service-type: simple login daemon

Both services are very minimalistic in nature. Simple seatd daemon
could be said as replacement for elogind-service-type. greetd daemon
is simple replacement for mingetty.

In addition to the base services, special build of pam-mount module is
included as greetd-pam-mount. It is used to provide
auto-(mounting/unmounting) of XDG_RUNTIME_DIR. Special build is
required to avoid interference with default pam-mount, if used in
the system.

greetd provides agreety terminal greeter out of the box. Current
greetd-service-type includes configuration for greetd-agreety-session
variations, i.e. only terminal are supported at the moment.

Next step would be adding gtkgreet and/or wlgreet alternatives for
graphical greeter.

muradm (10):
  gnu: crates-io: Add rust-enquote 1.0.3
  gnu: crates-io: Add rust-pam-sys 0.5.6
  gnu: freedesktop: Add greetd 0.7.0
  gnu: admin: Add greetd-pam-mount
  gnu: desktop: Add seatd-service-type
  gnu: desktop: Add greetd-service-type
  gnu: base: Add greetd to applied PAM services
  gnu: pam-mount: Add greetd to applied PAM services
  gnu: tests: Add seatd/greetd based minimal desktop system tests
  doc: Add desktop seatd-service-type and greetd-service-type

 doc/guix.texi                | 187 +++++++++++++++++++++++
 gnu/packages/admin.scm       |  33 ++++
 gnu/packages/crates-io.scm   |  49 ++++++
 gnu/packages/freedesktop.scm | 120 +++++++++++++++
 gnu/services/base.scm        |   3 +-
 gnu/services/desktop.scm     | 289 ++++++++++++++++++++++++++++++++++-
 gnu/services/pam-mount.scm   |   3 +-
 gnu/tests/desktop.scm        | 190 ++++++++++++++++++++++-
 8 files changed, 870 insertions(+), 4 deletions(-)

-- 
2.32.0

[bug#49969] [PATCH v5 01/10] gnu: crates-io: Add rust-enquote 1.0.3

[muradm]

* gnu/packages/crates-io.scm (rust-enquote-1): Add rust-enquote 1.0.3
---
 gnu/packages/crates-io.scm | 22 ++++++++++++++++++++++
 1 file changed, 22 insertions(+)

diff --git a/gnu/packages/crates-io.scm b/gnu/packages/crates-io.scm
index 24cc772ba7..6484d4c4fc 100644
--- a/gnu/packages/crates-io.scm
+++ b/gnu/packages/crates-io.scm
@@ -18,6 +18,7 @@
 ;;; Copyright © 2021 Antero Mejr <antero@kodmin.com>
 ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2021 Vinicius Monego <monego@posteo.net>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -56972,3 +56973,24 @@ variant of this library is available separately as @code{im}.")
     (description
       "Generate Rust register maps (`struct`s) from SVD files")
     (license (list license:expat license:asl2.0))))
+
+(define-public rust-enquote-1
+  (package
+    (name "rust-enquote")
+    (version "1.0.3")
+    (home-page "https://github.com/reujab/enquote")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (crate-uri "enquote" version))
+       (file-name
+        (string-append name "-" version ".tar.gz"))
+       (sha256
+        (base32
+         "0vm687r2wwgc3d3l2iqhag9wgkql6k93sdvjxvmfkdpksajpij1f"))))
+    (build-system cargo-build-system)
+    (synopsis
+     "A Rust library quotes, unquotes, and unescapes strings")
+    (description
+     "A Rust library quotes, unquotes, and unescapes strings")
+    (license license:unlicense)))
-- 
2.32.0

[bug#49969] [PATCH v5 02/10] gnu: crates-io: Add rust-pam-sys 0.5.6

[muradm]

* gnu/packages/crates-io.scm (rust-pam-sys): Add rust-pam-sys 0.5.6
---
 gnu/packages/crates-io.scm | 27 +++++++++++++++++++++++++++
 1 file changed, 27 insertions(+)

diff --git a/gnu/packages/crates-io.scm b/gnu/packages/crates-io.scm
index 6484d4c4fc..d91417d76f 100644
--- a/gnu/packages/crates-io.scm
+++ b/gnu/packages/crates-io.scm
@@ -55,6 +55,7 @@
   #:use-module (gnu packages glib)
   #:use-module (gnu packages image)
   #:use-module (gnu packages jemalloc)
+  #:use-module (gnu packages linux)
   #:use-module (gnu packages llvm)
   #:use-module (gnu packages multiprecision)
   #:use-module (gnu packages nettle)
@@ -56994,3 +56995,29 @@ variant of this library is available separately as @code{im}.")
     (description
      "A Rust library quotes, unquotes, and unescapes strings")
     (license license:unlicense)))
+
+(define-public rust-pam-sys-0.5.6
+  (package
+    (name "rust-pam-sys")
+    (version "0.5.6")
+    (home-page "https://github.com/1wilkens/pam-sys")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (crate-uri "pam-sys" version))
+       (file-name
+        (string-append name "-" version ".tar.gz"))
+       (sha256
+        (base32
+         "0d14501d5vybjnzxfjf96321xa5wa36x1xvf02h02zq938qmhj6d"))))
+    (build-system cargo-build-system)
+    (arguments
+     `(#:cargo-inputs
+       (("rust-libc" ,rust-libc-0.2))))
+    (native-inputs
+     `(("linux-pam" ,linux-pam)))
+    (synopsis
+     "Rust FFI wrappers for the Linux Pluggable Authentication Modules (PAM)")
+    (description
+     "Rust FFI wrappers for the Linux Pluggable Authentication Modules (PAM)")
+    (license (list license:expat license:asl2.0))))
-- 
2.32.0

[bug#49969] [PATCH v5 03/10] gnu: freedesktop: Add greetd 0.7.0

[muradm]

Also adds greetd-next which is built from master that includes
configurable terminal switch flag, required for smooth operation.
See https://lists.sr.ht/~kennylevinsen/greetd-devel/patches/24441
for more details.

* gnu/packages/freedesktop.scm (greetd): Add greetd 0.7.0
---
 gnu/packages/freedesktop.scm | 120 +++++++++++++++++++++++++++++++++++
 1 file changed, 120 insertions(+)

diff --git a/gnu/packages/freedesktop.scm b/gnu/packages/freedesktop.scm
index 693a79c738..aa83eb0a37 100644
--- a/gnu/packages/freedesktop.scm
+++ b/gnu/packages/freedesktop.scm
@@ -24,6 +24,7 @@
 ;;; Copyright © 2020 Raghav Gururajan <raghavgururajan@disroot.org>
 ;;; Copyright © 2021 Brendan Tildesley <mail@brendan.scot>
 ;;; Copyright © 2021 pineapples <guixuser6392@protonmail.com>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -46,6 +47,7 @@
   #:use-module (guix packages)
   #:use-module (guix download)
   #:use-module (guix git-download)
+  #:use-module (guix build-system cargo)
   #:use-module (guix build-system cmake)
   #:use-module (guix build-system gnu)
   #:use-module (guix build-system meson)
@@ -62,6 +64,7 @@
   #:use-module (gnu packages check)
   #:use-module (gnu packages cmake)
   #:use-module (gnu packages compression)
+  #:use-module (gnu packages crates-io)
   #:use-module (gnu packages cryptsetup)
   #:use-module (gnu packages databases)
   #:use-module (gnu packages disk)
@@ -862,6 +865,123 @@ that require it.  It also provides a universal seat management library that
 allows applications to use whatever seat management is available.")
     (license license:expat)))
 
+(define-public greetd
+  (package
+    (name "greetd")
+    (version "0.7.0")
+    (home-page "https://git.sr.ht/~kennylevinsen/greetd")
+    (source (origin
+              (method git-fetch)
+              (uri (git-reference
+                    (url home-page)
+                    (commit version)))
+              (file-name (git-file-name name version))
+              (sha256
+               (base32 "0lmwr5ld9x2wlq00i7mjgm9by8zndiq9girj8g93k0kww9zbgr3g"))))
+    (build-system cargo-build-system)
+    (arguments
+     `(#:cargo-inputs
+       (("rust-nix" ,rust-nix-0.17)
+        ("rust-pam-sys" ,rust-pam-sys-0.5.6)
+        ("rust-rpassword" ,rust-rpassword-4)
+        ("rust-users" ,rust-users-0.9)
+        ("rust-serde" ,rust-serde-1)
+        ("rust-serde-json" ,rust-serde-json-1)
+        ("rust-libc" ,rust-libc-0.2)
+        ("rust-tokio" ,rust-tokio-0.2)
+        ("rust-getopts" ,rust-getopts-0.2)
+        ("rust-thiserror" ,rust-thiserror-1)
+        ("rust-async-trait" ,rust-async-trait-0.1)
+        ("rust-enquote" ,rust-enquote-1))
+       #:phases
+       (modify-phases %standard-phases
+         ;; issue with terminal activation solved by this feature:
+         ;; https://lists.sr.ht/~kennylevinsen/greetd-devel/patches/24441
+         ;; greetd-next builds from head of #24441
+         ;; below substitute is provided as workaround for tagged version
+         (add-after 'unpack 'patch-terminal-switch
+           (lambda* (#:key inputs #:allow-other-keys)
+             (substitute* "greetd/src/server.rs"
+               (("switch: true,")
+                "switch: false,"))))
+         (delete 'package)
+         (add-after 'build 'build-man-pages
+           (lambda* (#:key inputs #:allow-other-keys)
+             (define (scdoc-cmd doc lvl)
+               (system (string-append "scdoc < "
+                                      doc "-" lvl ".scd > "
+                                      doc "." lvl)))
+             (with-directory-excursion "man"
+               (scdoc-cmd "greetd" "1")
+               (scdoc-cmd "greetd" "5")
+               (scdoc-cmd "greetd-ipc" "7")
+               (scdoc-cmd "agreety" "1"))))
+         (replace 'install
+           (lambda* (#:key inputs outputs #:allow-other-keys)
+             (let* ((out (assoc-ref outputs "out"))
+                    (bin (string-append out "/bin"))
+                    (sbin (string-append out "/sbin"))
+                    (share (string-append out "/share"))
+                    (man (string-append share "/man"))
+                    (man1 (string-append man "/man1"))
+                    (man5 (string-append man "/man5"))
+                    (man7 (string-append man "/man7"))
+                    (release "target/release")
+                    (greetd-bin (string-append release "/greetd"))
+                    (agreety-bin (string-append release "/agreety")))
+               (install-file greetd-bin sbin)
+               (install-file agreety-bin bin)
+               (with-directory-excursion "man"
+                 (install-file "greetd.1" man1)
+                 (install-file "greetd.5" man5)
+                 (install-file "greetd-ipc.7" man7)
+                 (install-file "agreety.1" man1))))))))
+    (native-inputs
+     `(("linux-pam" ,linux-pam)
+       ("scdoc" ,scdoc)))
+    (synopsis "minimal and flexible login manager daemon")
+    (description
+     "greetd is a minimal and flexible login manager daemon
+that makes no assumptions about what you want to launch.
+
+If you can run it from your shell in a TTY, greetd can start it.
+
+If it can be taught to speak a simple JSON-based IPC protocol,
+then it can be a greeter.")
+    (license license:gpl3+)))
+
+(define-public greetd-next
+  (package
+    (inherit greetd)
+    (name "greetd-next")
+    (version "0.7.0-87e9277")
+    (source (origin
+              (method git-fetch)
+              (uri (git-reference
+                    (url (package-home-page greetd))
+                    (commit "87e92776543c224676d64316f4519b509c21a0d5")))
+              (file-name (git-file-name name version))
+              (sha256
+               (base32 "13dblvhx5vbsx0yqyz2sq1ayffqwadbkn90p52wd5b66ij1z6v1a"))))
+    (arguments
+     (substitute-keyword-arguments (package-arguments greetd)
+       ((#:cargo-inputs inputs)
+        `(("rust-nix" ,rust-nix-0.19)
+           ("rust-pam-sys" ,rust-pam-sys-0.5.6)
+           ("rust-rpassword" ,rust-rpassword-5)
+           ("rust-users" ,rust-users-0.11)
+           ("rust-serde" ,rust-serde-1)
+           ("rust-serde-json" ,rust-serde-json-1)
+           ("rust-libc" ,rust-libc-0.2)
+           ("rust-tokio" ,rust-tokio-1)
+           ("rust-getopts" ,rust-getopts-0.2)
+           ("rust-thiserror" ,rust-thiserror-1)
+           ("rust-async-trait" ,rust-async-trait-0.1)
+           ("rust-enquote" ,rust-enquote-1)))
+       ((#:phases phases)
+        `(modify-phases ,phases
+           (delete 'patch-terminal-switch)))))))
+
 (define-public packagekit
   (package
     (name "packagekit")
-- 
2.32.0

[bug#49969] [PATCH v5 04/10] gnu: admin: Add greetd-pam-mount

[muradm]

* gnu/packages/admin.scm (greetd-pam-mount): Add greetd-pam-mount
---
 gnu/packages/admin.scm | 33 +++++++++++++++++++++++++++++++++
 1 file changed, 33 insertions(+)

diff --git a/gnu/packages/admin.scm b/gnu/packages/admin.scm
index 007f15f9f5..c9bfe0b667 100644
--- a/gnu/packages/admin.scm
+++ b/gnu/packages/admin.scm
@@ -42,6 +42,7 @@
 ;;; Copyright © 2021 David Larsson <david.larsson@selfhosted.xyz>
 ;;; Copyright © 2021 WinterHound <winterhound@yandex.com>
 ;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -4247,6 +4248,38 @@ supports.  It can also mount encrypted LUKS volumes using the password
 supplied by the user when logging in.")
     (license (list license:gpl2+ license:lgpl2.1+))))
 
+(define-public greetd-pam-mount
+  (package
+    (inherit pam-mount)
+    (name "greetd-pam-mount")
+    (arguments
+     (substitute-keyword-arguments (package-arguments pam-mount)
+       ((#:configure-flags flags ''())
+        `(cons* "--with-rundir=/run/greetd" ,flags))
+       ((#:phases phases)
+        `(modify-phases ,phases
+           (add-after 'unpack 'patch-config-file-name
+             (lambda* (#:key inputs #:allow-other-keys)
+               (substitute* "src/pam_mount.c"
+                 ((".*define CONFIGFILE .*$")
+                  "#define CONFIGFILE \"/etc/security/greetd_pam_mount.conf.xml\"\n")
+                 (("pam_mount_config") "greetd_pam_mount_config")
+                 (("pam_mount_system_authtok") "greetd_pam_mount_system_authtok"))))))))
+    (synopsis "pam-mount specifically compiled for use with greetd")
+    (description
+     "Pam-mount is a PAM module that can mount volumes when a user logs in.
+It supports mounting local filesystems of any kind the normal mount utility
+supports.  It can also mount encrypted LUKS volumes using the password
+supplied by the user when logging in.
+
+This package inherits pam-mount in the way that it is compiled specifically
+for use with greetd daemon. It uses different configuration location and
+name space for storing data in PAM.
+
+greetd-pam-mount is used in configuration of greetd to provide
+auto-(mounting/unmounting) of XDG_RUNTIME_DIR in the way that it will not
+interfere with default pam-mount configuration.")))
+
 (define-public jc
   (package
     (name "jc")
-- 
2.32.0

[bug#49969] [PATCH v5 05/10] gnu: desktop: Add seatd-service-type

[muradm]

* gnu/services/desktop.scm: Add seatd-service-type
---
 gnu/services/desktop.scm | 60 +++++++++++++++++++++++++++++++++++++++-
 1 file changed, 59 insertions(+), 1 deletion(-)

diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index 64d0e85301..c42db5987e 100644
--- a/gnu/services/desktop.scm
+++ b/gnu/services/desktop.scm
@@ -13,6 +13,7 @@
 ;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2020 Reza Alizadeh Majd <r.majd@pantherx.org>
 ;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -39,7 +40,9 @@
   #:use-module (gnu services networking)
   #:use-module (gnu services sound)
   #:use-module ((gnu system file-systems)
-                #:select (%elogind-file-systems file-system))
+                #:select (%control-groups
+                          %elogind-file-systems
+                          file-system))
   #:use-module (gnu system)
   #:use-module (gnu system setuid)
   #:use-module (gnu system shadow)
@@ -154,6 +157,9 @@
             gnome-keyring-configuration?
             gnome-keyring-service-type
 
+            seatd-configuration
+            seatd-service-type
+
             %desktop-services))
 
 ;;; Commentary:
@@ -1182,6 +1188,58 @@ or setting its password with passwd.")))
 (define polkit-wheel-service
   (simple-service 'polkit-wheel polkit-service-type (list polkit-wheel)))
 
+\f
+;;;
+;;; seatd-service-type -- minimal seat management daemon
+;;;
+
+(define-record-type* <seatd-configuration> seatd-configuration
+  make-seatd-configuration
+  seatd-configuration?
+  (seatd seatd-package (default seatd))
+  (user seatd-user (default "root"))
+  (group seatd-group (default "users"))
+  (socket seatd-socket (default "/run/seatd.sock"))
+  (loglevel seatd-loglevel (default "error")))
+
+(define (seatd-shepherd-service config)
+  (list (shepherd-service
+         (documentation "Minimal seat management daemon")
+         (requirement '())
+         ;; TODO: once cgroups is separate dependency
+         ;; here we should depend on it rather than elogind
+         (provision '(seatd elogind))
+         (start #~(make-forkexec-constructor
+                   (list #$(file-append (seatd-package config) "/bin/seatd")
+                         "-u" #$(seatd-user config)
+                         "-g" #$(seatd-group config)
+                         "-s" #$(seatd-socket config))
+                   #:environment-variables
+                   (list (string-append "SEATD_LOGLEVEL="
+                                        #$(seatd-loglevel config)))
+                   #:log-file "/tmp/seatd.log"))
+         (stop #~(make-kill-destructor)))))
+
+(define seatd-environment
+  (match-lambda
+    (($ <seatd-configuration> _ _ _ socket)
+     `(("SEATD_SOCK" . ,socket)))))
+
+(define seatd-service-type
+  (service-type
+   (name 'seatd)
+   (description "Seat management takes care of mediating access
+to shared devices (graphics, input), without requiring the
+applications needing access to be root.")
+   (extensions
+    (list
+     (service-extension session-environment-service-type seatd-environment)
+     ;; TODO: once cgroups is separate dependency we should not mount it here
+     ;; for now it is mounted here, because elogind mounts it
+     (service-extension file-system-service-type (const %control-groups))
+     (service-extension shepherd-root-service-type seatd-shepherd-service)))
+   (default-value (seatd-configuration))))
+
 \f
 ;;;
 ;;; The default set of desktop services.
-- 
2.32.0

[bug#49969] [PATCH v5 06/10] gnu: desktop: Add greetd-service-type

[muradm]

Currently, only agreety configuration is provided.

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

diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index c42db5987e..1f4838d4d8 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,12 @@
             seatd-configuration
             seatd-service-type
 
+            greetd-configuration
+            greetd-terminal-configuration
+            greetd-service-type
+            greetd-agreety-tty-session
+            greetd-agreety-tty-xdg-session
+
             %desktop-services))
 
 ;;; Commentary:
@@ -1240,6 +1247,228 @@ applications needing access to be root.")
      (service-extension shepherd-root-service-type seatd-shepherd-service)))
    (default-value (seatd-configuration))))
 
+\f
+;;;
+;;; 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?
+  (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 match))
+          (let*
+              ((username (getenv "USER"))
+               (useruid (passwd:uid (getpwuid username)))
+               (useruid (number->string useruid))
+               (abs-cmd-bin #$(file-append package command-bin)))
+            (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-terminal-configuration>
+  greetd-terminal-configuration make-greetd-terminal-configuration
+  greetd-terminal-configuration?
+  (greetd greetd-package (default greetd-next))
+  (config-file-name greetd-config-file-name (thunked)
+                    (default (default-config-file-name this-record)))
+  (terminal-vt greetd-terminal-vt (default "7"))
+  (terminal-switch greetd-terminal-switch (default #f))
+  (default-session-user greetd-default-session-user (default "greeter"))
+  (default-session-command greetd-default-session-command
+    (default greetd-agreety-tty-xdg-session)))
+
+(define (default-config-file-name config)
+  (string-join (list "config-" (greetd-terminal-vt config) ".toml") ""))
+
+(define make-greetd-terminal-default-session-command
+  (match-lambda
+    (($ <greetd-terminal-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 (make-greetd-terminal-configuration-file config)
+  (let*
+      ((config-file-name (greetd-config-file-name config))
+       (terminal-vt (greetd-terminal-vt config))
+       (terminal-switch (greetd-terminal-switch config))
+       (default-session-user (greetd-default-session-user config))
+       (default-session-command (make-greetd-terminal-default-session-command config)))
+    (mixed-text-file
+     config-file-name
+     "[terminal]\n"
+     "vt = " terminal-vt "\n"
+     "switch = " (if terminal-switch "true" "false") "\n"
+     "[default_session]\n"
+     "user = " default-session-user "\n"
+     "command = " default-session-command "\n")))
+
+(define %default-motd
+  (plain-file "motd" "This is the GNU operating system, welcome!\n\n"))
+
+(define %greetd-accounts
+  (list (user-account
+         (name "greeter")
+         (group "wheel")
+         (supplementary-groups '("users" "tty" "input" "video" "audio"))
+         (system? #t))))
+
+(define %greetd-file-systems
+  (list (file-system
+          (device "none")
+          (mount-point "/run/greetd/pam_mount")
+          (type "tmpfs")
+          (check? #f)
+          (flags '(no-suid no-dev no-exec))
+          (options "mode=0755")
+          (create-mount-point? #t))))
+
+(define %greetd-pam-mount-rules
+  `((debug (@ (enable "0")))
+    (volume (@ (sgrp "users")
+               (fstype "tmpfs")
+               (mountpoint "/run/user/%(USERUID)")
+               (options "noexec,nosuid,nodev,size=1g,mode=0700,uid=%(USERUID),gid=%(USERGID)")))
+    (logout (@ (wait "0")
+               (hup "0")
+               (term "yes")
+               (kill "no")))
+    (mkmountpoint (@ (enable "1") (remove "true")))))
+
+(define-record-type* <greetd-configuration>
+  greetd-configuration make-greetd-configuration
+  greetd-configuration?
+  (motd greetd-motd (default %default-motd))
+  (allow-empty-passwords? greetd-allow-empty-passwords? (default #t))
+  (terminals greetd-terminals (default '())))
+
+(define (make-greetd-pam-mount-conf-file config)
+  (computed-file
+   "greetd_pam_mount.conf.xml"
+   #~(begin
+       (use-modules (sxml simple))
+       (call-with-output-file #$output
+         (lambda (port)
+           (sxml->xml
+            '(*TOP*
+              (*PI* xml "version='1.0' encoding='utf-8'")
+              (pam_mount
+               #$@%greetd-pam-mount-rules
+               (pmvarrun
+                #$(file-append greetd-pam-mount
+                               "/sbin/pmvarrun -u '%(USER)' -o '%(OPERATION)'"))))
+            port))))))
+
+(define (greetd-etc-service config)
+  `(("security/greetd_pam_mount.conf.xml"
+     ,(make-greetd-pam-mount-conf-file config))))
+
+(define (greetd-pam-service config)
+  (define optional-pam-mount
+    (pam-entry
+     (control "optional")
+     (module #~(string-append #$greetd-pam-mount "/lib/security/pam_mount.so"))
+     (arguments '("disable_interactive"))))
+
+  (list
+   (unix-pam-service "greetd"
+                     #:login-uid? #t
+                     #:allow-empty-passwords?
+                     (greetd-allow-empty-passwords? config)
+                     #:motd
+                     (greetd-motd config))
+   (lambda (pam)
+     (if (member (pam-service-name pam)
+                 '("login" "greetd" "su" "slim" "gdm-password"))
+         (pam-service
+          (inherit pam)
+          (auth (append (pam-service-auth pam)
+                        (list optional-pam-mount)))
+          (session (append (pam-service-session pam)
+                           (list optional-pam-mount))))
+         pam))))
+
+(define (greetd-shepherd-services config)
+  (map
+   (lambda (tc)
+     (let*
+         ((greetd-bin (file-append (greetd-package tc) "/sbin/greetd"))
+          (greetd-conf (make-greetd-terminal-configuration-file tc))
+          (greetd-vt (greetd-terminal-vt tc)))
+       (shepherd-service
+        (documentation "Minimal and flexible login manager daemon")
+        (requirement '(user-processes host-name udev virtual-terminal))
+        (provision (list (symbol-append
+                          'term-tty
+                          (string->symbol (greetd-terminal-vt tc)))))
+        (start #~(make-forkexec-constructor
+                  (list #$greetd-bin "-c" #$greetd-conf)
+                  #:log-file
+                  (string-append "/tmp/greetd." #$greetd-vt ".log")))
+        (stop #~(make-kill-destructor)))))
+   (greetd-terminals config)))
+
+(define greetd-service-type
+  (service-type
+   (name 'greetd)
+   (description "Provides necessary infrastructure for logging into the
+system including @code{greetd} PAM service, @code{pam-mount} module to
+mount/unmount /run/user/<uid> directory for user and @code{greetd}
+login manager daemon.")
+   (extensions
+    (list
+     (service-extension account-service-type (const %greetd-accounts))
+     (service-extension file-system-service-type (const %greetd-file-systems))
+     (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)))
+   (default-value (greetd-configuration))))
+
 \f
 ;;;
 ;;; The default set of desktop services.
-- 
2.32.0

[bug#49969] [PATCH v5 07/10] gnu: base: Add greetd to applied PAM services

[muradm]

* gnu/services/base.scm (pam-limits-service-type): add greetd PAM
service to applicable PAM services
---
 gnu/services/base.scm | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index c784d312b1..446ecc30f8 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -15,6 +15,7 @@
 ;;; Copyright © 2020, 2021 Brice Waegeneire <brice@waegenei.re>
 ;;; Copyright © 2021 qblade <qblade@protonmail.com>
 ;;; Copyright © 2021 Hui Lu <luhuins@163.com>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -1392,7 +1393,7 @@ information on the configuration file syntax."
                               (module "pam_limits.so")
                               (arguments '("conf=/etc/security/limits.conf")))))
              (if (member (pam-service-name pam)
-                         '("login" "su" "slim" "gdm-password" "sddm"))
+                         '("login" "greetd" "su" "slim" "gdm-password" "sddm"))
                  (pam-service
                   (inherit pam)
                   (session (cons pam-limits
-- 
2.32.0

[bug#49969] [PATCH v5 08/10] gnu: pam-mount: Add greetd to applied PAM services

[muradm]

* gnu/services/pam-mount.scm (pam-mount-service-type): add greetd PAM
service to applicable PAM services
---
 gnu/services/pam-mount.scm | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/gnu/services/pam-mount.scm b/gnu/services/pam-mount.scm
index 98611462c2..7b25efeb50 100644
--- a/gnu/services/pam-mount.scm
+++ b/gnu/services/pam-mount.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2019 Guillaume Le Vaillant <glv@posteo.net>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -90,7 +91,7 @@
      (module #~(string-append #$pam-mount "/lib/security/pam_mount.so"))))
   (list (lambda (pam)
           (if (member (pam-service-name pam)
-                      '("login" "su" "slim" "gdm-password"))
+                      '("login" "greetd" "su" "slim" "gdm-password"))
               (pam-service
                (inherit pam)
                (auth (append (pam-service-auth pam)
-- 
2.32.0

[bug#49969] [PATCH v5 09/10] gnu: tests: Add seatd/greetd based minimal desktop system tests

[muradm]

* gnu/tests/desktop.scm (minimal-desktop): seatd/greetd based
minimal desktop
---
 gnu/tests/desktop.scm | 190 +++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 189 insertions(+), 1 deletion(-)

diff --git a/gnu/tests/desktop.scm b/gnu/tests/desktop.scm
index 6aa22fd49b..463fe7e08f 100644
--- a/gnu/tests/desktop.scm
+++ b/gnu/tests/desktop.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -19,12 +20,15 @@
 (define-module (gnu tests desktop)
   #:use-module (gnu tests)
   #:use-module (gnu services)
+  #:use-module (gnu services base)
   #:use-module (gnu services dbus)
   #:use-module (gnu services desktop)
+  #:use-module (gnu system)
   #:use-module (gnu system vm)
   #:use-module (guix gexp)
   #:use-module (srfi srfi-1)
-  #:export (%test-elogind))
+  #:export (%test-elogind
+            %test-minimal-desktop))
 
 \f
 ;;;
@@ -103,3 +107,187 @@
                #:imported-modules '((gnu services herd)
                                     (guix combinators)))))
       (run-elogind-test (virtual-machine os))))))
+
+\f
+;;;
+;;; Seatd/greetd based minimal desktop
+;;;
+
+(define %minimal-services
+  (append
+   (list
+    (service seatd-service-type)
+    (service greetd-service-type
+             (greetd-configuration
+              (terminals
+               (list
+                (greetd-terminal-configuration (terminal-vt "1") (terminal-switch #t))
+                (greetd-terminal-configuration (terminal-vt "2"))
+                (greetd-terminal-configuration (terminal-vt "3"))
+                (greetd-terminal-configuration (terminal-vt "4"))
+                (greetd-terminal-configuration (terminal-vt "5"))
+                (greetd-terminal-configuration (terminal-vt "6")))))))
+   (modify-services %base-services
+     (delete login-service-type)
+     (delete mingetty-service-type))))
+
+(define-syntax-rule (minimal-operating-system user-services ...)
+  "Return an operating system that includes USER-SERVICES in addition to
+minimal %BASE-SERVICES."
+  (operating-system (inherit %simple-os)
+                    (services (cons* user-services ... %minimal-services))))
+
+(define (run-minimal-desktop-test os vm)
+  (define test
+    (with-imported-modules '((gnu build marionette)
+                             (guix build syscalls))
+      #~(begin
+          (use-modules (gnu build marionette)
+                       (guix build syscalls)
+                       (srfi srfi-1)
+                       (srfi srfi-64)
+                       (ice-9 pretty-print))
+
+          (define marionette
+            (make-marionette #$vm))
+
+          (define (file-get-all-strings fname)
+            (marionette-eval '(use-modules (rnrs io ports)) marionette)
+            (wait-for-file fname marionette #:read 'get-string-all))
+
+          (define (wait-for-unix-socket-m socket)
+            (wait-for-unix-socket socket marionette))
+
+          (mkdir #$output)
+          (chdir #$output)
+
+          (test-begin "minimal-desktop")
+
+          (test-assert "seatd is ready"
+            (wait-for-unix-socket-m "/run/seatd.sock"))
+
+          (test-equal "login user on tty1"
+            "alice\n"
+            (begin
+              ;; Wait for tty1.
+              (marionette-eval
+               '(begin
+                  (use-modules (gnu services herd))
+                  (start-service 'term-tty1))
+               marionette)
+              (marionette-control "sendkey ctrl-alt-f1" marionette)
+
+              ;; login as root change alice password and exit
+              ;; then login as alice
+              (for-each
+               (lambda (cmd) (marionette-type cmd marionette) (sleep 1))
+               (list
+                "root\n"
+                "passwd alice\n"
+                "alice\n"
+                "alice\n"
+                "exit\n"
+                "alice\n"
+                "alice\n"
+                "id -un > logged-in\n"))
+
+              (file-get-all-strings "/home/alice/logged-in")))
+
+          (test-equal "validate user environment"
+            '("SEATD_SOCK=/run/seatd.sock"
+              "XDG_RUNTIME_DIR=/run/user/1000"
+              "XDG_SEAT=seat0"
+              "XDG_VTNR=1")
+
+            (begin
+              (marionette-type "env > env\n" marionette)
+              (sleep 1)
+
+              (define user-env (string-tokenize
+                                (file-get-all-strings "/home/alice/env")))
+
+              (define (expected-var var)
+                (any (lambda (s) (string-contains var s))
+                     '("SEATD_SOCK"
+                       "XDG_RUNTIME_DIR"
+                       "XDG_SEAT"
+                       "XDG_VTNR")))
+
+              (sort (filter expected-var user-env) string<?)))
+
+          (test-assert "validate SEATD_SOCK and GREETD_SOCK"
+            (begin
+              (marionette-type "env > env\n" marionette)
+              (sleep 1)
+
+              (define (sock-var? var)
+                (any (lambda (s) (string-contains var s))
+                     '("SEATD_SOCK" "GREETD_SOCK")))
+
+              (define (sock-var-sock var)
+                (car (cdr (string-split var #\=))))
+
+              (let*
+                  ((out (file-get-all-strings "/home/alice/env"))
+                   (out (string-tokenize out))
+                   (out (filter sock-var? out))
+                   (socks (map sock-var-sock out))
+                   (socks (map wait-for-unix-socket-m socks)))
+                (and (= 2 (length socks)) (every identity socks)))))
+
+          (test-assert "greetd is ready"
+            (begin
+              (marionette-type "ps -C greetd -o pid,args --no-headers > ps-greetd\n"
+                               marionette)
+              (sleep 1)
+
+              (define (greetd-daemon? cmd)
+                (string-contains cmd "config"))
+
+              (define (greetd-cmd-to-pid cmd)
+                (car (string-split cmd #\space)))
+
+              (define (greetd-pid-to-sock pid)
+                (string-append "/run/greetd-" pid ".sock"))
+
+              (let* ((out (file-get-all-strings "/home/alice/ps-greetd"))
+                     (out (string-split out #\newline))
+                     (out (map string-trim-both out))
+                     (out (filter greetd-daemon? out))
+                     (pids (map greetd-cmd-to-pid out))
+                     (socks (map greetd-pid-to-sock pids))
+                     (socks (map wait-for-unix-socket-m socks)))
+                (every identity socks))))
+
+          ;; a bit weak, but tests everything at once actually
+          (test-equal "check /run/user/<uid> mounted and writable"
+            "alice\n"
+            (begin
+              (marionette-type "echo alice > /run/user/1000/test\n" marionette)
+              (file-get-all-strings "/run/user/1000/test")))
+
+          (test-assert "screendump"
+            (begin
+              (marionette-control (string-append "screendump " #$output
+                                                 "/tty1.ppm")
+                                  marionette)
+              (file-exists? "tty1.ppm")))
+
+          (test-end)
+          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+  (gexp->derivation "minimal-desktop" test))
+
+(define %test-minimal-desktop
+  (system-test
+   (name "minimal-desktop")
+   (description
+    "Test whether we can log in when seatd and greetd is enabled")
+   (value
+    (let* ((os (marionette-operating-system
+                (minimal-operating-system)
+                #:imported-modules '((gnu services herd)
+                                     (guix combinators))))
+           (vm (virtual-machine os)))
+      (run-minimal-desktop-test (virtualized-operating-system os '())
+                                #~(list #$vm))))))
-- 
2.32.0

[bug#49969] [PATCH v5 10/10] doc: Add desktop seatd-service-type and greetd-service-type

[muradm]

* doc/guix.texi (Desktop Services): Provide documentation for
seatd-service-type and greetd-service-type including configuration
and sample usage.
---
 doc/guix.texi | 187 ++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 187 insertions(+)

diff --git a/doc/guix.texi b/doc/guix.texi
index 2b8448c856..1590c29f9b 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -96,6 +96,7 @@ Copyright @copyright{} 2021 Domagoj Stolfa@*
 Copyright @copyright{} 2021 Hui Lu@*
 Copyright @copyright{} 2021 pukkamustard@*
 Copyright @copyright{} 2021 Alice Brenon@*
+Copyright @copyright{} 2021 muradm@*
 
 Permission is granted to copy, distribute and/or modify this document
 under the terms of the GNU Free Documentation License, Version 1.3 or
@@ -19767,6 +19768,192 @@ and ``passwd'' is with the value @code{passwd}.
 @end table
 @end deftp
 
+@defvr {Scheme Variable} seatd-service-type
+A minimal seat management daemon, and a universal seat management library.
+
+Seat management takes care of mediating access to shared devices (graphics,
+input), without requiring the applications needing access to be root.
+
+In general should be used as replacement to @code{elogind-service-type}.
+
+@lisp
+(append
+  (list
+   ;; make sure seatd is running
+   (service seatd-service-type)
+
+   (service greetd-service-type
+            (greetd-configuration
+             (terminals
+              (list
+               ;; lets have terminals 1, 2 and 3 run default XDG terminal session
+               ;; also ask terminal 1 to become active
+               (greetd-terminal-configuration (terminal-vt "1") (terminal-switch #t))
+               (greetd-terminal-configuration (terminal-vt "2"))
+               (greetd-terminal-configuration (terminal-vt "3"))
+               ;; and terminals 4, 5 and 6 plain bash terminal session
+               ;; although not so plain, just to illustrate flexibility
+               (greetd-terminal-configuration
+                (terminal-vt "4")
+                (default-session-command greetd-agreety-tty-session))
+               (greetd-terminal-configuration
+                (terminal-vt "5")
+                (default-session-command greetd-agreety-tty-session))
+               (greetd-terminal-configuration
+                (terminal-vt "6")
+                (default-session-command greetd-agreety-tty-session))))))
+
+  ;; normaly one would want %base-services
+  (modify-services %base-services
+    ;; seatd/greetd combination can replace these
+    ;; greetd provides its own PAM service
+    (delete login-service-type)
+    (delete mingetty-service-type)))
+
+@end lisp
+
+@end defvr
+
+@deftp {Data Type} seatd-configuration
+Configuration record for the seatd daemon service.
+
+@table @asis
+@item @code{seatd} (default: @code{seatd})
+The seatd package to use.
+
+@item @code{user} (default: @samp{"root"})
+User to own the seatd socket.
+
+@item @code{group} (default: @samp{"users"})
+Group to own the seatd socket.
+
+@item @code{socket} (default: @samp{"/run/seatd.sock"})
+Where to create the seatd socket.
+
+@item @code{loglevel} (default: @samp{"error"})
+Log level to output logs. Possible values: @samp{"silent"}, @samp{"error"},
+@samp{"info"} and @samp{"debug"}.
+
+@end table
+@end deftp
+
+@defvr {Scheme Variable} greetd-service-type
+greetd is a minimal and flexible login manager daemon that makes no
+assumptions about what you want to launch.
+
+If you can run it from your shell in a TTY, greetd can start it. If it
+can be taught to speak a simple JSON-based IPC protocol, then it can
+be a greeter.
+
+@code{<greetd-service-type>} provides necessary infrastructure for
+logging in users, including:
+
+@itemize @bullet
+@item
+@code{greetd} PAM service
+
+@item
+Special variation of @code{pam-mount} to mount @code{XDG_RUNTIME_DIR}
+
+@end itemize
+
+@end defvr
+
+@deftp {Data Type} greetd-configuration
+Configuration record for the greetd service.
+
+@table @asis
+@item @code{motd}
+A file-like object containing the ``message of the day''.
+
+@item @code{allow-empty-passwords?} (default: @code{#t})
+Allow empty passwords by default so that first-time users can log in when
+the 'root' account has just been created.
+
+@item @code{terminals} (default: @code{'()})
+List of @code{<greetd-terminal-configuration>} per terminal for which
+@code{greetd} should be started.
+
+@end table
+@end deftp
+
+@deftp {Data Type} greetd-terminal-configuration
+Configuration record for per terminal greetd daemon service.
+
+@table @asis
+@item @code{greetd} (default: @code{greetd})
+The greetd package to use.
+
+@item @code{config-file-name}
+Configuration file name to use for greetd daemon. Generally, autogenerated
+derivation based on @code{terminal-vt} value.
+
+@item @code{terminal-vt} (default: @samp{"7"})
+The VT to run on. Use of a specific VT with appropriate conflict avoidance
+is recommended.
+
+@item @code{terminal-switch} (default: @code{#f})
+Make this terminal active on start of @code{greetd}.
+
+@item @code{default-session-user} (default: @samp{"greeter"})
+The user to use for running the greeter.
+
+@item @code{default-session-command} (default: @code{greetd-agreety-tty-xdg-session})
+The command-line to run to start the default session.
+
+Possible values are:
+
+@itemize @bullet
+@item
+@code{greetd-agreety-tty-session} - bash terminal session
+
+@item
+@code{greetd-agreety-tty-xdg-session} - bash terminal session with XDG environment
+
+@item
+@code{greetd-agreety-session} - custom instance of terminal session
+@end itemize
+
+@end table
+@end deftp
+
+@deftp {Data Type} greetd-agreety-session
+Configuration record for the agreety greetd greeter.
+
+@table @asis
+@item @code{package} (default: @code{bash})
+The package of command.
+
+@item @code{command-bin} (default: @samp{"/bin/bash"})
+Path to binary relative to @code{package}.
+
+@item @code{command-args} (default: @code{'("-l")})
+Command arguments to pass to command.
+
+@item @code{extra-env} (default: @code{'()})
+Extra environment variables to set on login.
+
+@item @code{command-generator}
+Function that receives instance of this configuration as an argument and
+returns @code{program-file} that can be used with @code{agreety} greeter.
+
+Both @code{greetd-agreety-tty-session} and @code{greetd-agreety-tty-xdg-session}
+uses @code{greetd-agreety-session} under the hood.
+
+@end table
+@end deftp
+
+@defvr {Scheme Variable} greetd-agreety-tty-session
+Provides instance of @code{greetd-agreety-session} which starts @samp{"bash -l"}
+on login.
+@end defvr
+
+@defvr {Scheme Variable} greetd-agreety-tty-xdg-session
+Provides instance of @code{greetd-agreety-session} which starts @samp{"bash -l"}
+on login. Additionally, will set @code{XDG_SESSION_TYPE} and
+@code{XDG_RUNTIME_DIR} environment variables for session.
+@end defvr
+
 
 @node Sound Services
 @subsection Sound Services
-- 
2.32.0

[bug#49969] [PATCH v6 0/8] gnu: Add seatd-service-type and greetd-service-type.

[muradm]

In this version:
 - libseat and seatd are split into separate packages
 - libseat and seatd now live in (gnu packages admin)
 - original seatd is removed from (gnu packages freedesktop)
 - greetd is updated to 0.8.0 and moved to (gnu packages admin)
 - greetd default-session-command configurations is greatly simplified.
 - greetd-service-type is now live in (gnu services base)
 - documentation is splitted and included in commits of each service

muradm (8):
  gnu: crates-io: Add rust-enquote-1 1.0.3.
  gnu: crates-io: Add rust-pam-sys 0.5.6.
  gnu: admin: Add greetd 0.8.0.
  gnu: admin: Add greetd-pam-mount.
  gnu: base: Add greetd-service-type.
  gnu: admin: Add libseat 0.5.0 and move seatd.
  gnu: desktop: Add seatd-service-type.
  gnu: tests: Add seatd/greetd based minimal desktop system tests.

 doc/guix.texi                | 175 ++++++++++++++++++++++++++++
 gnu/packages/admin.scm       | 164 ++++++++++++++++++++++++++
 gnu/packages/crates-io.scm   |  49 ++++++++
 gnu/packages/freedesktop.scm |  30 -----
 gnu/services/base.scm        | 218 ++++++++++++++++++++++++++++++++++-
 gnu/services/desktop.scm     |  60 +++++++++-
 gnu/services/pam-mount.scm   |   2 +-
 gnu/tests/desktop.scm        | 212 +++++++++++++++++++++++++++++++++-
 8 files changed, 876 insertions(+), 34 deletions(-)

-- 
2.33.0

[bug#49969] [PATCH v6 1/8] gnu: crates-io: Add rust-enquote-1 1.0.3.

[muradm]

* gnu/packages/crates-io.scm (rust-enquote-1): New variable
---
 gnu/packages/crates-io.scm | 22 ++++++++++++++++++++++
 1 file changed, 22 insertions(+)

diff --git a/gnu/packages/crates-io.scm b/gnu/packages/crates-io.scm
index aee7a6f756..7c915df487 100644
--- a/gnu/packages/crates-io.scm
+++ b/gnu/packages/crates-io.scm
@@ -18,6 +18,7 @@
 ;;; Copyright © 2021 Antero Mejr <antero@kodmin.com>
 ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2021 Vinicius Monego <monego@posteo.net>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -57383,3 +57384,24 @@ variant of this library is available separately as @code{im}.")
     (description
       "Generate Rust register maps (`struct`s) from SVD files")
     (license (list license:expat license:asl2.0))))
+
+(define-public rust-enquote-1
+  (package
+    (name "rust-enquote")
+    (version "1.0.3")
+    (home-page "https://github.com/reujab/enquote")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (crate-uri "enquote" version))
+       (file-name
+        (string-append name "-" version ".tar.gz"))
+       (sha256
+        (base32
+         "0vm687r2wwgc3d3l2iqhag9wgkql6k93sdvjxvmfkdpksajpij1f"))))
+    (build-system cargo-build-system)
+    (synopsis
+     "A Rust library quotes, unquotes, and unescapes strings")
+    (description
+     "A Rust library quotes, unquotes, and unescapes strings")
+    (license license:unlicense)))
-- 
2.33.0

[bug#49969] [PATCH v6 2/8] gnu: crates-io: Add rust-pam-sys 0.5.6.

[muradm]

* gnu/packages/crates-io.scm (rust-pam-sys-0): New variable
---
 gnu/packages/crates-io.scm | 27 +++++++++++++++++++++++++++
 1 file changed, 27 insertions(+)

diff --git a/gnu/packages/crates-io.scm b/gnu/packages/crates-io.scm
index 7c915df487..6f962dec9e 100644
--- a/gnu/packages/crates-io.scm
+++ b/gnu/packages/crates-io.scm
@@ -55,6 +55,7 @@
   #:use-module (gnu packages glib)
   #:use-module (gnu packages image)
   #:use-module (gnu packages jemalloc)
+  #:use-module (gnu packages linux)
   #:use-module (gnu packages llvm)
   #:use-module (gnu packages multiprecision)
   #:use-module (gnu packages nettle)
@@ -57405,3 +57406,29 @@ variant of this library is available separately as @code{im}.")
     (description
      "A Rust library quotes, unquotes, and unescapes strings")
     (license license:unlicense)))
+
+(define-public rust-pam-sys-0
+  (package
+    (name "rust-pam-sys")
+    (version "0.5.6")
+    (home-page "https://github.com/1wilkens/pam-sys")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (crate-uri "pam-sys" version))
+       (file-name
+        (string-append name "-" version ".tar.gz"))
+       (sha256
+        (base32
+         "0d14501d5vybjnzxfjf96321xa5wa36x1xvf02h02zq938qmhj6d"))))
+    (build-system cargo-build-system)
+    (arguments
+     `(#:cargo-inputs
+       (("rust-libc" ,rust-libc-0.2))))
+    (native-inputs
+     `(("linux-pam" ,linux-pam)))
+    (synopsis
+     "Rust FFI wrappers for the Linux Pluggable Authentication Modules (PAM)")
+    (description
+     "Rust FFI wrappers for the Linux Pluggable Authentication Modules (PAM)")
+    (license (list license:expat license:asl2.0))))
-- 
2.33.0

[bug#49969] [PATCH v6 3/8] gnu: admin: Add greetd 0.8.0.

[muradm]

* gnu/packages/admin.scm (greetd): New variable
---
 gnu/packages/admin.scm | 79 ++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 79 insertions(+)

diff --git a/gnu/packages/admin.scm b/gnu/packages/admin.scm
index db820b28c1..de59c793cc 100644
--- a/gnu/packages/admin.scm
+++ b/gnu/packages/admin.scm
@@ -44,6 +44,7 @@
 ;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
 ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -61,6 +62,7 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu packages admin)
+  #:use-module (guix build-system cargo)
   #:use-module (guix build-system cmake)
   #:use-module (guix build-system emacs)
   #:use-module (guix build-system glib-or-gtk)
@@ -87,6 +89,7 @@
   #:use-module (gnu packages c)
   #:use-module (gnu packages check)
   #:use-module (gnu packages compression)
+  #:use-module (gnu packages crates-io)
   #:use-module (gnu packages cross-base)
   #:use-module (gnu packages crypto)
   #:use-module (gnu packages cryptsetup)
@@ -4799,3 +4802,79 @@ setup, maintenance, supervision, or any long-running processes.")
       (description "Utility to convert @code{lsof} output to a graph showing
 FIFO and UNIX interprocess communication.")
       (license license:bsd-2))))
+
+(define-public greetd
+  (package
+    (name "greetd")
+    (version "0.8.0")
+    (home-page "https://git.sr.ht/~kennylevinsen/greetd")
+    (source (origin
+              (method git-fetch)
+              (uri (git-reference
+                    (url home-page)
+                    (commit version)))
+              (file-name (git-file-name name version))
+              (sha256
+               (base32 "0x5c3jkw09kvj2grcxm899y2n6ws8p990cyp9cs0fy6lm4fzlh6v"))))
+    (build-system cargo-build-system)
+    (arguments
+     `(#:cargo-inputs
+       (("rust-nix" ,rust-nix-0.19)
+        ("rust-pam-sys" ,rust-pam-sys-0)
+        ("rust-rpassword" ,rust-rpassword-5)
+        ("rust-users" ,rust-users-0.11)
+        ("rust-serde" ,rust-serde-1)
+        ("rust-serde-json" ,rust-serde-json-1)
+        ("rust-libc" ,rust-libc-0.2)
+        ("rust-tokio" ,rust-tokio-1)
+        ("rust-getopts" ,rust-getopts-0.2)
+        ("rust-thiserror" ,rust-thiserror-1)
+        ("rust-async-trait" ,rust-async-trait-0.1)
+        ("rust-enquote" ,rust-enquote-1))
+       #:phases
+       (modify-phases %standard-phases
+         (delete 'package)
+         (add-after 'build 'build-man-pages
+           (lambda* (#:key inputs #:allow-other-keys)
+             (define (scdoc-cmd doc lvl)
+               (system (string-append "scdoc < "
+                                      doc "-" lvl ".scd > "
+                                      doc "." lvl)))
+             (with-directory-excursion "man"
+               (scdoc-cmd "greetd" "1")
+               (scdoc-cmd "greetd" "5")
+               (scdoc-cmd "greetd-ipc" "7")
+               (scdoc-cmd "agreety" "1"))))
+         (replace 'install
+           (lambda* (#:key inputs outputs #:allow-other-keys)
+             (let* ((out (assoc-ref outputs "out"))
+                    (bin (string-append out "/bin"))
+                    (sbin (string-append out "/sbin"))
+                    (share (string-append out "/share"))
+                    (man (string-append share "/man"))
+                    (man1 (string-append man "/man1"))
+                    (man5 (string-append man "/man5"))
+                    (man7 (string-append man "/man7"))
+                    (release "target/release")
+                    (greetd-bin (string-append release "/greetd"))
+                    (agreety-bin (string-append release "/agreety")))
+               (install-file greetd-bin sbin)
+               (install-file agreety-bin bin)
+               (with-directory-excursion "man"
+                 (install-file "greetd.1" man1)
+                 (install-file "greetd.5" man5)
+                 (install-file "greetd-ipc.7" man7)
+                 (install-file "agreety.1" man1))))))))
+    (native-inputs
+     `(("linux-pam" ,linux-pam)
+       ("scdoc" ,scdoc)))
+    (synopsis "minimal and flexible login manager daemon")
+    (description
+     "greetd is a minimal and flexible login manager daemon
+that makes no assumptions about what you want to launch.
+
+If you can run it from your shell in a TTY, greetd can start it.
+
+If it can be taught to speak a simple JSON-based IPC protocol,
+then it can be a greeter.")
+    (license license:gpl3+)))
-- 
2.33.0

[bug#49969] [PATCH v6 4/8] gnu: admin: Add greetd-pam-mount.

[muradm]

* gnu/packages/admin.scm (greetd-pam-mount): New variable
---
 gnu/packages/admin.scm | 32 ++++++++++++++++++++++++++++++++
 1 file changed, 32 insertions(+)

diff --git a/gnu/packages/admin.scm b/gnu/packages/admin.scm
index de59c793cc..90cc1d62da 100644
--- a/gnu/packages/admin.scm
+++ b/gnu/packages/admin.scm
@@ -4878,3 +4878,35 @@ If you can run it from your shell in a TTY, greetd can start it.
 If it can be taught to speak a simple JSON-based IPC protocol,
 then it can be a greeter.")
     (license license:gpl3+)))
+
+(define-public greetd-pam-mount
+  (package
+    (inherit pam-mount)
+    (name "greetd-pam-mount")
+    (arguments
+     (substitute-keyword-arguments (package-arguments pam-mount)
+       ((#:configure-flags flags ''())
+        `(cons* "--with-rundir=/run/greetd" ,flags))
+       ((#:phases phases)
+        `(modify-phases ,phases
+           (add-after 'unpack 'patch-config-file-name
+             (lambda* (#:key inputs #:allow-other-keys)
+               (substitute* "src/pam_mount.c"
+                 ((".*define CONFIGFILE .*$")
+                  "#define CONFIGFILE \"/etc/security/greetd_pam_mount.conf.xml\"\n")
+                 (("pam_mount_config") "greetd_pam_mount_config")
+                 (("pam_mount_system_authtok") "greetd_pam_mount_system_authtok"))))))))
+    (synopsis "pam-mount specifically compiled for use with greetd")
+    (description
+     "Pam-mount is a PAM module that can mount volumes when a user logs in.
+It supports mounting local filesystems of any kind the normal mount utility
+supports.  It can also mount encrypted LUKS volumes using the password
+supplied by the user when logging in.
+
+This package inherits pam-mount in the way that it is compiled specifically
+for use with greetd daemon. It uses different configuration location and
+name space for storing data in PAM.
+
+greetd-pam-mount is used in configuration of greetd to provide
+auto-(mounting/unmounting) of XDG_RUNTIME_DIR in the way that it will not
+interfere with default pam-mount configuration.")))
-- 
2.33.0

[bug#49969] [PATCH v6 5/8] gnu: base: Add greetd-service-type.

[muradm]

Currently, only agreety greeter and its configuration is provided.

* gnu/services/base.scm (greetd-service-type): New variable
* gnu/services/base.scm (pam-limits-service-type): Should be
aware of greetd PAM service
* gnu/services/pam-mount.scm (pam-mount-pam-service): Should be
aware of greetd PAM service.
---
 doc/guix.texi              | 133 ++++++++++++++++++++++
 gnu/services/base.scm      | 218 ++++++++++++++++++++++++++++++++++++-
 gnu/services/pam-mount.scm |   2 +-
 3 files changed, 351 insertions(+), 2 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 36a0c7f5ec..79bf291ec4 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -96,6 +96,7 @@ Copyright @copyright{} 2021 Domagoj Stolfa@*
 Copyright @copyright{} 2021 Hui Lu@*
 Copyright @copyright{} 2021 pukkamustard@*
 Copyright @copyright{} 2021 Alice Brenon@*
+Copyright @copyright{} 2021 muradm@*
 
 Permission is granted to copy, distribute and/or modify this document
 under the terms of the GNU Free Documentation License, Version 1.3 or
@@ -15953,6 +15954,138 @@ about the Pluggable Authentication Module (PAM) limits, refer to the
 @samp{pam_limits} man page from the @code{linux-pam} package.
 @end deffn
 
+@defvr {Scheme Variable} greetd-service-type
+@uref{https://git.sr.ht/~kennylevinsen/greetd, @code{greetd}} is a minimal and
+flexible login manager daemon, that makes no assumptions about what you
+want to launch.
+
+If you can run it from your shell in a TTY, greetd can start it. If it
+can be taught to speak a simple JSON-based IPC protocol, then it can be
+a geeter.
+
+@code{greetd-service-type} provides necessary infrastructure for logging
+in users, including:
+
+@itemize @bullet
+@item
+@code{greetd} PAM service
+
+@item
+Special variation of @code{pam-mount} to mount @code{XDG_RUNTIME_DIR}
+@end itemize
+
+Here is example of switching from @code{mingetty-service-type} to
+@code{greetd-service-type}, and how different terminals could be:
+
+@lisp
+  (append
+   (modify-services %base-services
+     ;; greetd-service-type provides "greetd" PAM service
+     (delete login-service-type)
+     ;; and can be used in place of mingetty-service-type
+     (delete mingetty-service-type))
+   (list
+    (service greetd-service-type
+             (greetd-configuration
+              (terminals
+               (list
+                ;; we can make any terminal active by default
+                (greetd-terminal-configuration (terminal-vt "1") (terminal-switch #t))
+                ;; we can make environment without XDG_RUNTIME_DIR set
+                ;; even provide our own environment variables
+                (greetd-terminal-configuration
+                 (terminal-vt "2")
+                 (default-session-command
+                   (greetd-agreety-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")))))
+                ;; we can use any other executable command as greeter
+                (greetd-terminal-configuration
+                 (terminal-vt "4")
+                 (default-session-command (program-file "my-noop-greeter" #~(exit))))
+                (greetd-terminal-configuration (terminal-vt "5"))
+                (greetd-terminal-configuration (terminal-vt "6"))))))
+    ;; mingetty-service-type can be used in parallel
+    ;; if needed to do so, do not (delete login-service-type)
+    ;; as illustrated above
+    #| (service mingetty-service-type (mingetty-configuration (tty "tty8"))) |#))
+@end lisp
+@end defvr
+
+@deftp {Data Type} greetd-configuration
+Configuration record for the @code{greetd-service-type}.
+@table @asis
+
+@item @code{motd}
+A file-like object containing the ``message of the day''.
+
+@item @code{allow-empty-passwords?} (default: @code{#t})
+Allow empty passwords by default so that first-time users can log in when
+the 'root' account has just been created.
+
+@item @code{terminals} (default: @code{'()})
+List of @code{greetd-terminal-configuration} per terminal for which
+@code{greetd} should be started.
+@end table
+@end deftp
+
+@deftp {Data Type} greetd-terminal-configuration
+Configuration record for per terminal greetd daemon service.
+
+@table @asis
+@item @code{greetd} (default: @code{greetd})
+The greetd package to use.
+
+@item @code{config-file-name}
+Configuration file name to use for greetd daemon. Generally, autogenerated
+derivation based on @code{terminal-vt} value.
+
+@item @code{terminal-vt} (default: @samp{"7"})
+The VT to run on. Use of a specific VT with appropriate conflict avoidance
+is recommended.
+
+@item @code{terminal-switch} (default: @code{#f})
+Make this terminal active on start of @code{greetd}.
+
+@item @code{default-session-user} (default: @samp{"greeter"})
+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
+@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.
+
+@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.
+
+@item @code{command-args} (default: @code{'("-l")})
+Command arguments to pass to command.
+
+@item @code{extra-env} (default: @code{'()})
+Extra environment variables to set on login.
+
+@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
+are set right after mentioned variables, so that they can be overriden.
+
+@end table
+@end deftp
+
 @node Scheduled Job Execution
 @subsection Scheduled Job Execution
 
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 50865055fe..fe2c4d6fe5 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -16,6 +16,7 @@
 ;;; Copyright © 2021 qblade <qblade@protonmail.com>
 ;;; Copyright © 2021 Hui Lu <luhuins@163.com>
 ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -186,6 +187,11 @@
 
             references-file
 
+            greetd-service-type
+            greetd-configuration
+            greetd-terminal-configuration
+            greetd-agreety-session
+
             %base-services))
 
 ;;; Commentary:
@@ -1401,7 +1407,7 @@ information on the configuration file syntax."
                               (module "pam_limits.so")
                               (arguments '("conf=/etc/security/limits.conf")))))
              (if (member (pam-service-name pam)
-                         '("login" "su" "slim" "gdm-password" "sddm"))
+                         '("login" "greetd" "su" "slim" "gdm-password" "sddm"))
                  (pam-service
                   (inherit pam)
                   (session (cons pam-limits
@@ -2462,6 +2468,216 @@ to handle."
                                            (requirement requirement)
                                            (name-servers name-servers)))))
 
+\f
+;;;
+;;; 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
+  (match-lambda
+    (($ <greetd-agreety-session> _ 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 #$@args)))))))
+
+(define greetd-agreety-tty-xdg-session-command
+  (match-lambda
+    (($ <greetd-agreety-session> _ 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 #$@args)))))))
+
+(define (make-greetd-agreety-session-command config command)
+  (let ((agreety (file-append (greetd-agreety config) "/bin/agreety")))
+    (program-file
+     "agreety-command"
+     #~(execl #$agreety #$agreety "-c" #$command))))
+
+(define (make-greetd-default-session-command config-or-command)
+  (cond ((greetd-agreety-session? config-or-command)
+         (cond ((greetd-agreety-xdg-env? config-or-command)
+                (make-greetd-agreety-session-command
+                 config-or-command
+                 (greetd-agreety-tty-xdg-session-command config-or-command)))
+               (#t
+                (make-greetd-agreety-session-command
+                 config-or-command
+                 (greetd-agreety-tty-session-command config-or-command)))))
+        (#t config-or-command)))
+
+(define-record-type* <greetd-terminal-configuration>
+  greetd-terminal-configuration make-greetd-terminal-configuration
+  greetd-terminal-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"))
+  (terminal-switch greetd-terminal-switch (default #f))
+  (default-session-user greetd-default-session-user (default "greeter"))
+  (default-session-command greetd-default-session-command
+    (default (greetd-agreety-session))
+    (sanitize make-greetd-default-session-command)))
+
+(define (default-config-file-name config)
+  (string-join (list "config-" (greetd-terminal-vt config) ".toml") ""))
+
+(define (make-greetd-terminal-configuration-file config)
+  (let*
+      ((config-file-name (greetd-config-file-name config))
+       (terminal-vt (greetd-terminal-vt config))
+       (terminal-switch (greetd-terminal-switch config))
+       (default-session-user (greetd-default-session-user config))
+       (default-session-command (greetd-default-session-command config)))
+    (mixed-text-file
+     config-file-name
+     "[terminal]\n"
+     "vt = " terminal-vt "\n"
+     "switch = " (if terminal-switch "true" "false") "\n"
+     "[default_session]\n"
+     "user = " default-session-user "\n"
+     "command = " default-session-command "\n")))
+
+(define %greetd-accounts
+  (list (user-account
+         (name "greeter")
+         (group "wheel")
+         (supplementary-groups '("users" "tty" "input" "video" "audio"))
+         (system? #t))))
+
+(define %greetd-file-systems
+  (list (file-system
+          (device "none")
+          (mount-point "/run/greetd/pam_mount")
+          (type "tmpfs")
+          (check? #f)
+          (flags '(no-suid no-dev no-exec))
+          (options "mode=0755")
+          (create-mount-point? #t))))
+
+(define %greetd-pam-mount-rules
+  `((debug (@ (enable "0")))
+    (volume (@ (sgrp "users")
+               (fstype "tmpfs")
+               (mountpoint "/run/user/%(USERUID)")
+               (options "noexec,nosuid,nodev,size=1g,mode=0700,uid=%(USERUID),gid=%(USERGID)")))
+    (logout (@ (wait "0")
+               (hup "0")
+               (term "yes")
+               (kill "no")))
+    (mkmountpoint (@ (enable "1") (remove "true")))))
+
+(define-record-type* <greetd-configuration>
+  greetd-configuration make-greetd-configuration
+  greetd-configuration?
+  (motd greetd-motd (default %default-motd))
+  (allow-empty-passwords? greetd-allow-empty-passwords? (default #t))
+  (terminals greetd-terminals (default '())))
+
+(define (make-greetd-pam-mount-conf-file config)
+  (computed-file
+   "greetd_pam_mount.conf.xml"
+   #~(begin
+       (use-modules (sxml simple))
+       (call-with-output-file #$output
+         (lambda (port)
+           (sxml->xml
+            '(*TOP*
+              (*PI* xml "version='1.0' encoding='utf-8'")
+              (pam_mount
+               #$@%greetd-pam-mount-rules
+               (pmvarrun
+                #$(file-append greetd-pam-mount
+                               "/sbin/pmvarrun -u '%(USER)' -o '%(OPERATION)'"))))
+            port))))))
+
+(define (greetd-etc-service config)
+  `(("security/greetd_pam_mount.conf.xml"
+     ,(make-greetd-pam-mount-conf-file config))))
+
+(define (greetd-pam-service config)
+  (define optional-pam-mount
+    (pam-entry
+     (control "optional")
+     (module #~(string-append #$greetd-pam-mount "/lib/security/pam_mount.so"))
+     (arguments '("disable_interactive"))))
+
+  (list
+   (unix-pam-service "greetd"
+                     #:login-uid? #t
+                     #:allow-empty-passwords?
+                     (greetd-allow-empty-passwords? config)
+                     #:motd
+                     (greetd-motd config))
+   (lambda (pam)
+     (if (member (pam-service-name pam)
+                 '("login" "greetd" "su" "slim" "gdm-password"))
+         (pam-service
+          (inherit pam)
+          (auth (append (pam-service-auth pam)
+                        (list optional-pam-mount)))
+          (session (append (pam-service-session pam)
+                           (list optional-pam-mount))))
+         pam))))
+
+(define (greetd-shepherd-services config)
+  (map
+   (lambda (tc)
+     (let*
+         ((greetd-bin (file-append (greetd-package tc) "/sbin/greetd"))
+          (greetd-conf (make-greetd-terminal-configuration-file tc))
+          (greetd-vt (greetd-terminal-vt tc)))
+       (shepherd-service
+        (documentation "Minimal and flexible login manager daemon")
+        (requirement '(user-processes host-name udev virtual-terminal))
+        (provision (list (symbol-append
+                          'term-tty
+                          (string->symbol (greetd-terminal-vt tc)))))
+        (start #~(make-forkexec-constructor
+                  (list #$greetd-bin "-c" #$greetd-conf)
+                  #:log-file
+                  (string-append "/tmp/greetd." #$greetd-vt ".log")))
+        (stop #~(make-kill-destructor)))))
+   (greetd-terminals config)))
+
+(define greetd-service-type
+  (service-type
+   (name 'greetd)
+   (description "Provides necessary infrastructure for logging into the
+system including @code{greetd} PAM service, @code{pam-mount} module to
+mount/unmount /run/user/<uid> directory for user and @code{greetd}
+login manager daemon.")
+   (extensions
+    (list
+     (service-extension account-service-type (const %greetd-accounts))
+     (service-extension file-system-service-type (const %greetd-file-systems))
+     (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)))
+   (default-value (greetd-configuration))))
+
 \f
 (define %base-services
   ;; Convenience variable holding the basic services.
diff --git a/gnu/services/pam-mount.scm b/gnu/services/pam-mount.scm
index 98611462c2..d6c65e3760 100644
--- a/gnu/services/pam-mount.scm
+++ b/gnu/services/pam-mount.scm
@@ -90,7 +90,7 @@
      (module #~(string-append #$pam-mount "/lib/security/pam_mount.so"))))
   (list (lambda (pam)
           (if (member (pam-service-name pam)
-                      '("login" "su" "slim" "gdm-password"))
+                      '("login" "greetd" "su" "slim" "gdm-password"))
               (pam-service
                (inherit pam)
                (auth (append (pam-service-auth pam)
-- 
2.33.0

[bug#49969] [PATCH v6 6/8] gnu: admin: Add libseat 0.5.0 and move seatd.

[muradm]

* gnu/packages/admin.scm (libseat): New variable
* gnu/packages/admin.scm (seatd): New variable
* gnu/packages/freedesktop.scm (seatd): Removed variable
---
 gnu/packages/admin.scm       | 53 ++++++++++++++++++++++++++++++++++++
 gnu/packages/freedesktop.scm | 30 --------------------
 2 files changed, 53 insertions(+), 30 deletions(-)

diff --git a/gnu/packages/admin.scm b/gnu/packages/admin.scm
index 90cc1d62da..3a8efa50fe 100644
--- a/gnu/packages/admin.scm
+++ b/gnu/packages/admin.scm
@@ -98,6 +98,7 @@
   #:use-module (gnu packages elf)
   #:use-module (gnu packages file)
   #:use-module (gnu packages flex)
+  #:use-module (gnu packages freedesktop)
   #:use-module (gnu packages gawk)
   #:use-module (gnu packages gettext)
   #:use-module (gnu packages gl)
@@ -4803,6 +4804,58 @@ setup, maintenance, supervision, or any long-running processes.")
 FIFO and UNIX interprocess communication.")
       (license license:bsd-2))))
 
+(define-public libseat
+  (package
+    (name "libseat")
+    (version "0.5.0")
+    (source (origin
+              (method git-fetch)
+              (uri (git-reference
+                    (url "https://git.sr.ht/~kennylevinsen/seatd")
+                    (commit version)))
+              (file-name (git-file-name name version))
+              (sha256
+               (base32
+                "1kglq8v4rnr3415mfaghyv2s2f8mxsy5s881gmm2908ig4n4j297"))))
+    (build-system meson-build-system)
+    (arguments
+     `(#:configure-flags '("-Dlibseat-logind=enabled"
+                           "-Dserver=disabled")))
+    (native-inputs
+     `(("pkg-config" ,pkg-config)))
+    (inputs
+     `(("elogind" ,elogind)))
+    (home-page "https://sr.ht/~kennylevinsen/seatd")
+    (synopsis "Seat management library")
+    (description
+     "This package provides a universal seat management library that
+allows applications to use whatever seat management is available.")
+    (license license:expat)))
+
+(define-public seatd
+  (package
+    (inherit libseat)
+    (name "seatd")
+    (arguments
+     `(#:configure-flags '("-Dlibseat-logind=disabled"
+                           "-Dlibseat-seatd=disabled")
+       #:phases
+       (modify-phases %standard-phases
+         (add-after 'install 'remove-libs
+           (lambda* (#:key outputs #:allow-other-keys)
+             (with-directory-excursion (assoc-ref outputs "out")
+               (for-each delete-file-recursively '("lib" "include"))))))))
+    (native-inputs
+     `(("pkg-config" ,pkg-config)
+       ("scdoc" ,scdoc)))
+    (inputs '())
+    (synopsis "Seat management daemon")
+    (description
+     "This package provides a minimal seat management daemon whose task is to
+mediate access to shared devices, such as graphics and input, for applications
+that require it.")
+    (license license:expat)))
+
 (define-public greetd
   (package
     (name "greetd")
diff --git a/gnu/packages/freedesktop.scm b/gnu/packages/freedesktop.scm
index 086707d51a..76a16454b1 100644
--- a/gnu/packages/freedesktop.scm
+++ b/gnu/packages/freedesktop.scm
@@ -833,36 +833,6 @@ GNOME Shell.  The @command{localectl} command-line tool allows you to interact
 with localed.  This package is extracted from the broader systemd package.")
     (license license:lgpl2.1+)))
 
-(define-public seatd
-  (package
-    (name "seatd")
-    (version "0.5.0")
-    (source (origin
-              (method git-fetch)
-              (uri (git-reference
-                    (url "https://git.sr.ht/~kennylevinsen/seatd")
-                    (commit version)))
-              (file-name (git-file-name name version))
-              (sha256
-               (base32
-                "1kglq8v4rnr3415mfaghyv2s2f8mxsy5s881gmm2908ig4n4j297"))))
-    (build-system meson-build-system)
-    (arguments
-     `(#:configure-flags '("-Dlogind=enabled")))
-    (native-inputs
-     `(("pkg-config" ,pkg-config)
-       ("scdoc" ,scdoc)))
-    (inputs
-     `(("elogind" ,elogind)))
-    (home-page "https://sr.ht/~kennylevinsen/seatd")
-    (synopsis "Seat management daemon and library")
-    (description
-     "This package provides a minimal seat management daemon whose task is to
-mediate access to shared devices, such as graphics and input, for applications
-that require it.  It also provides a universal seat management library that
-allows applications to use whatever seat management is available.")
-    (license license:expat)))
-
 (define-public packagekit
   (package
     (name "packagekit")
-- 
2.33.0

[bug#49969] [PATCH v6 7/8] gnu: desktop: Add seatd-service-type.

[muradm]

* gnu/services/desktop.scm (seatd-service-type): New variable
---
 doc/guix.texi            | 42 ++++++++++++++++++++++++++++
 gnu/services/desktop.scm | 60 +++++++++++++++++++++++++++++++++++++++-
 2 files changed, 101 insertions(+), 1 deletion(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 79bf291ec4..9c40342f9f 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -19901,6 +19901,48 @@ and ``passwd'' is with the value @code{passwd}.
 @end table
 @end deftp
 
+@defvr {Scheme Variable} seatd-service-type
+@uref{https://sr.ht/~kennylevinsen/seatd/, seatd} is a minimal seat
+management daemon.
+
+Seat management takes care of mediating access to shared devices (graphics,
+input), without requiring the applications needing access to be root.
+
+@lisp
+(append
+  (list
+   ;; make sure seatd is running
+   (service seatd-service-type))
+
+  ;; normally one would want %base-services
+  %base-services)
+
+@end lisp
+@end defvr
+
+@deftp {Data Type} seatd-configuration
+Configuration record for the seatd daemon service.
+
+@table @asis
+@item @code{seatd} (default: @code{seatd})
+The seatd package to use.
+
+@item @code{user} (default: @samp{"root"})
+User to own the seatd socket.
+
+@item @code{group} (default: @samp{"users"})
+Group to own the seatd socket.
+
+@item @code{socket} (default: @samp{"/run/seatd.sock"})
+Where to create the seatd socket.
+
+@item @code{loglevel} (default: @samp{"error"})
+Log level to output logs. Possible values: @samp{"silent"}, @samp{"error"},
+@samp{"info"} and @samp{"debug"}.
+
+@end table
+@end deftp
+
 
 @node Sound Services
 @subsection Sound Services
diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index 64d0e85301..c42db5987e 100644
--- a/gnu/services/desktop.scm
+++ b/gnu/services/desktop.scm
@@ -13,6 +13,7 @@
 ;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2020 Reza Alizadeh Majd <r.majd@pantherx.org>
 ;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -39,7 +40,9 @@
   #:use-module (gnu services networking)
   #:use-module (gnu services sound)
   #:use-module ((gnu system file-systems)
-                #:select (%elogind-file-systems file-system))
+                #:select (%control-groups
+                          %elogind-file-systems
+                          file-system))
   #:use-module (gnu system)
   #:use-module (gnu system setuid)
   #:use-module (gnu system shadow)
@@ -154,6 +157,9 @@
             gnome-keyring-configuration?
             gnome-keyring-service-type
 
+            seatd-configuration
+            seatd-service-type
+
             %desktop-services))
 
 ;;; Commentary:
@@ -1182,6 +1188,58 @@ or setting its password with passwd.")))
 (define polkit-wheel-service
   (simple-service 'polkit-wheel polkit-service-type (list polkit-wheel)))
 
+\f
+;;;
+;;; seatd-service-type -- minimal seat management daemon
+;;;
+
+(define-record-type* <seatd-configuration> seatd-configuration
+  make-seatd-configuration
+  seatd-configuration?
+  (seatd seatd-package (default seatd))
+  (user seatd-user (default "root"))
+  (group seatd-group (default "users"))
+  (socket seatd-socket (default "/run/seatd.sock"))
+  (loglevel seatd-loglevel (default "error")))
+
+(define (seatd-shepherd-service config)
+  (list (shepherd-service
+         (documentation "Minimal seat management daemon")
+         (requirement '())
+         ;; TODO: once cgroups is separate dependency
+         ;; here we should depend on it rather than elogind
+         (provision '(seatd elogind))
+         (start #~(make-forkexec-constructor
+                   (list #$(file-append (seatd-package config) "/bin/seatd")
+                         "-u" #$(seatd-user config)
+                         "-g" #$(seatd-group config)
+                         "-s" #$(seatd-socket config))
+                   #:environment-variables
+                   (list (string-append "SEATD_LOGLEVEL="
+                                        #$(seatd-loglevel config)))
+                   #:log-file "/tmp/seatd.log"))
+         (stop #~(make-kill-destructor)))))
+
+(define seatd-environment
+  (match-lambda
+    (($ <seatd-configuration> _ _ _ socket)
+     `(("SEATD_SOCK" . ,socket)))))
+
+(define seatd-service-type
+  (service-type
+   (name 'seatd)
+   (description "Seat management takes care of mediating access
+to shared devices (graphics, input), without requiring the
+applications needing access to be root.")
+   (extensions
+    (list
+     (service-extension session-environment-service-type seatd-environment)
+     ;; TODO: once cgroups is separate dependency we should not mount it here
+     ;; for now it is mounted here, because elogind mounts it
+     (service-extension file-system-service-type (const %control-groups))
+     (service-extension shepherd-root-service-type seatd-shepherd-service)))
+   (default-value (seatd-configuration))))
+
 \f
 ;;;
 ;;; The default set of desktop services.
-- 
2.33.0

[bug#49969] [PATCH v6 8/8] gnu: tests: Add seatd/greetd based minimal desktop system tests.

[muradm]

* gnu/tests/desktop.scm (minimal-desktop): seatd/greetd based
minimal desktop
---
 gnu/tests/desktop.scm | 212 +++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 211 insertions(+), 1 deletion(-)

diff --git a/gnu/tests/desktop.scm b/gnu/tests/desktop.scm
index 6aa22fd49b..50aa859869 100644
--- a/gnu/tests/desktop.scm
+++ b/gnu/tests/desktop.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -18,13 +19,17 @@
 
 (define-module (gnu tests desktop)
   #:use-module (gnu tests)
+  #:use-module (gnu packages shells)
   #:use-module (gnu services)
+  #:use-module (gnu services base)
   #:use-module (gnu services dbus)
   #:use-module (gnu services desktop)
+  #:use-module (gnu system)
   #:use-module (gnu system vm)
   #:use-module (guix gexp)
   #:use-module (srfi srfi-1)
-  #:export (%test-elogind))
+  #:export (%test-elogind
+            %test-minimal-desktop))
 
 \f
 ;;;
@@ -103,3 +108,208 @@
                #:imported-modules '((gnu services herd)
                                     (guix combinators)))))
       (run-elogind-test (virtual-machine os))))))
+
+\f
+;;;
+;;; Seatd/greetd based minimal desktop
+;;;
+
+(define %minimal-services
+  (append
+   (modify-services %base-services
+     ;; greetd-service-type provides "greetd" PAM service
+     (delete login-service-type)
+     ;; and can be used in place of mingetty-service-type
+     (delete mingetty-service-type))
+   (list
+    (service seatd-service-type)
+    (service greetd-service-type
+             (greetd-configuration
+              (terminals
+               (list
+                ;; we can make any terminal active by default
+                (greetd-terminal-configuration (terminal-vt "1") (terminal-switch #t))
+                ;; we can make environment without XDG_RUNTIME_DIR set
+                ;; even provide our own environment variables
+                (greetd-terminal-configuration
+                 (terminal-vt "2")
+                 (default-session-command
+                   (greetd-agreety-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")))))
+                ;; we can use any other executable command as greeter
+                (greetd-terminal-configuration
+                 (terminal-vt "4")
+                 (default-session-command (program-file "my-noop-greeter" #~(exit))))
+                (greetd-terminal-configuration (terminal-vt "5"))
+                (greetd-terminal-configuration (terminal-vt "6"))))))
+    ;; mingetty-service-type can be used in parallel
+    ;; if needed to do so, do not (delete login-service-type)
+    ;; as illustrated above
+    #| (service mingetty-service-type (mingetty-configuration (tty "tty8"))) |#)))
+
+(define-syntax-rule (minimal-operating-system user-services ...)
+  "Return an operating system that includes USER-SERVICES in addition to
+minimal %BASE-SERVICES."
+  (operating-system (inherit %simple-os)
+                    (services (cons* user-services ... %minimal-services))))
+
+(define (run-minimal-desktop-test os vm)
+  (define test
+    (with-imported-modules '((gnu build marionette)
+                             (guix build syscalls))
+      #~(begin
+          (use-modules (gnu build marionette)
+                       (guix build syscalls)
+                       (srfi srfi-1)
+                       (srfi srfi-64)
+                       (ice-9 pretty-print))
+
+          (define marionette
+            (make-marionette #$vm))
+
+          (define (file-get-all-strings fname)
+            (marionette-eval '(use-modules (rnrs io ports)) marionette)
+            (wait-for-file fname marionette #:read 'get-string-all))
+
+          (define (wait-for-unix-socket-m socket)
+            (wait-for-unix-socket socket marionette))
+
+          (mkdir #$output)
+          (chdir #$output)
+
+          (test-begin "minimal-desktop")
+
+          (test-assert "seatd is ready"
+            (wait-for-unix-socket-m "/run/seatd.sock"))
+
+          (test-equal "login user on tty1"
+            "alice\n"
+            (begin
+              ;; Wait for tty1.
+              (marionette-eval
+               '(begin
+                  (use-modules (gnu services herd))
+                  (start-service 'term-tty1))
+               marionette)
+              (marionette-control "sendkey ctrl-alt-f1" marionette)
+
+              ;; login as root change alice password and exit
+              ;; then login as alice
+              (for-each
+               (lambda (cmd) (marionette-type cmd marionette) (sleep 1))
+               (list
+                "root\n"
+                "passwd alice\n"
+                "alice\n"
+                "alice\n"
+                "exit\n"
+                "alice\n"
+                "alice\n"
+                "id -un > logged-in\n"))
+
+              (file-get-all-strings "/home/alice/logged-in")))
+
+          (test-equal "validate user environment"
+            '("SEATD_SOCK=/run/seatd.sock"
+              "XDG_RUNTIME_DIR=/run/user/1000"
+              "XDG_SEAT=seat0"
+              "XDG_VTNR=1")
+
+            (begin
+              (marionette-type "env > env\n" marionette)
+              (sleep 1)
+
+              (define user-env (string-tokenize
+                                (file-get-all-strings "/home/alice/env")))
+
+              (define (expected-var var)
+                (any (lambda (s) (string-contains var s))
+                     '("SEATD_SOCK"
+                       "XDG_RUNTIME_DIR"
+                       "XDG_SEAT"
+                       "XDG_VTNR")))
+
+              (sort (filter expected-var user-env) string<?)))
+
+          (test-assert "validate SEATD_SOCK and GREETD_SOCK"
+            (begin
+              (marionette-type "env > env\n" marionette)
+              (sleep 1)
+
+              (define (sock-var? var)
+                (any (lambda (s) (string-contains var s))
+                     '("SEATD_SOCK" "GREETD_SOCK")))
+
+              (define (sock-var-sock var)
+                (car (cdr (string-split var #\=))))
+
+              (let*
+                  ((out (file-get-all-strings "/home/alice/env"))
+                   (out (string-tokenize out))
+                   (out (filter sock-var? out))
+                   (socks (map sock-var-sock out))
+                   (socks (map wait-for-unix-socket-m socks)))
+                (and (= 2 (length socks)) (every identity socks)))))
+
+          (test-assert "greetd is ready"
+            (begin
+              (marionette-type "ps -C greetd -o pid,args --no-headers > ps-greetd\n"
+                               marionette)
+              (sleep 1)
+
+              (define (greetd-daemon? cmd)
+                (string-contains cmd "config"))
+
+              (define (greetd-cmd-to-pid cmd)
+                (car (string-split cmd #\space)))
+
+              (define (greetd-pid-to-sock pid)
+                (string-append "/run/greetd-" pid ".sock"))
+
+              (let* ((out (file-get-all-strings "/home/alice/ps-greetd"))
+                     (out (string-split out #\newline))
+                     (out (map string-trim-both out))
+                     (out (filter greetd-daemon? out))
+                     (pids (map greetd-cmd-to-pid out))
+                     (socks (map greetd-pid-to-sock pids))
+                     (socks (map wait-for-unix-socket-m socks)))
+                (every identity socks))))
+
+          ;; a bit weak, but tests everything at once actually
+          (test-equal "check /run/user/<uid> mounted and writable"
+            "alice\n"
+            (begin
+              (marionette-type "echo alice > /run/user/1000/test\n" marionette)
+              (file-get-all-strings "/run/user/1000/test")))
+
+          (test-assert "screendump"
+            (begin
+              (marionette-control (string-append "screendump " #$output
+                                                 "/tty1.ppm")
+                                  marionette)
+              (file-exists? "tty1.ppm")))
+
+          (test-end)
+          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+  (gexp->derivation "minimal-desktop" test))
+
+(define %test-minimal-desktop
+  (system-test
+   (name "minimal-desktop")
+   (description
+    "Test whether we can log in when seatd and greetd is enabled")
+   (value
+    (let* ((os (marionette-operating-system
+                (minimal-operating-system)
+                #:imported-modules '((gnu services herd)
+                                     (guix combinators))))
+           (vm (virtual-machine os)))
+      (run-minimal-desktop-test (virtualized-operating-system os '())
+                                #~(list #$vm))))))
-- 
2.33.0

[bug#49969] [PATCH v7 0/7] gnu: Add greetd-service-type and seatd-service-type.

[muradm]

In this version:
 - updating libseat and seatd to 0.6.1

muradm (7):
  gnu: crates-io: Add rust-enquote 1.0.3 and rust-pam-sys 0.5.6.
  gnu: admin: Add greetd 0.8.0.
  gnu: admin: Add greetd-pam-mount.
  gnu: base: Add greetd-service-type.
  gnu: admin: Add libseat 0.6.1 and move seatd.
  gnu: desktop: Add seatd-service-type.
  gnu: tests: Add seatd/greetd based minimal desktop system tests.

 doc/guix.texi                | 175 ++++++++++++++++++++++++++++
 gnu/packages/admin.scm       | 164 ++++++++++++++++++++++++++
 gnu/packages/crates-io.scm   |  49 ++++++++
 gnu/packages/freedesktop.scm |  30 -----
 gnu/services/base.scm        | 218 ++++++++++++++++++++++++++++++++++-
 gnu/services/desktop.scm     |  60 +++++++++-
 gnu/services/pam-mount.scm   |   2 +-
 gnu/tests/desktop.scm        | 212 +++++++++++++++++++++++++++++++++-
 8 files changed, 876 insertions(+), 34 deletions(-)

-- 
2.33.0

[bug#49969] [PATCH v7 1/7] gnu: crates-io: Add rust-enquote 1.0.3 and rust-pam-sys 0.5.6.

[muradm]

* gnu/packages/crates-io.scm (rust-enquote-1): New variable
* gnu/packages/crates-io.scm (rust-pam-sys-0.5): New variable
---
 gnu/packages/crates-io.scm | 49 ++++++++++++++++++++++++++++++++++++++
 1 file changed, 49 insertions(+)

diff --git a/gnu/packages/crates-io.scm b/gnu/packages/crates-io.scm
index 2b91d4b871..83a8642448 100644
--- a/gnu/packages/crates-io.scm
+++ b/gnu/packages/crates-io.scm
@@ -19,6 +19,7 @@
 ;;; Copyright © 2021 Antero Mejr <antero@kodmin.com>
 ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2021 Vinicius Monego <monego@posteo.net>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -55,6 +56,7 @@
   #:use-module (gnu packages glib)
   #:use-module (gnu packages image)
   #:use-module (gnu packages jemalloc)
+  #:use-module (gnu packages linux)
   #:use-module (gnu packages llvm)
   #:use-module (gnu packages multiprecision)
   #:use-module (gnu packages nettle)
@@ -57376,3 +57378,50 @@ variant of this library is available separately as @code{im}.")
     (description
       "Generate Rust register maps (`struct`s) from SVD files")
     (license (list license:expat license:asl2.0))))
+
+(define-public rust-enquote-1
+  (package
+    (name "rust-enquote")
+    (version "1.0.3")
+    (home-page "https://github.com/reujab/enquote")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (crate-uri "enquote" version))
+       (file-name
+        (string-append name "-" version ".tar.gz"))
+       (sha256
+        (base32
+         "0vm687r2wwgc3d3l2iqhag9wgkql6k93sdvjxvmfkdpksajpij1f"))))
+    (build-system cargo-build-system)
+    (synopsis
+     "A Rust library quotes, unquotes, and unescapes strings")
+    (description
+     "A Rust library quotes, unquotes, and unescapes strings")
+    (license license:unlicense)))
+
+(define-public rust-pam-sys-0.5
+  (package
+    (name "rust-pam-sys")
+    (version "0.5.6")
+    (home-page "https://github.com/1wilkens/pam-sys")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (crate-uri "pam-sys" version))
+       (file-name
+        (string-append name "-" version ".tar.gz"))
+       (sha256
+        (base32
+         "0d14501d5vybjnzxfjf96321xa5wa36x1xvf02h02zq938qmhj6d"))))
+    (build-system cargo-build-system)
+    (arguments
+     `(#:cargo-inputs
+       (("rust-libc" ,rust-libc-0.2))))
+    (native-inputs
+     `(("linux-pam" ,linux-pam)))
+    (synopsis
+     "Rust FFI wrappers for the Linux Pluggable Authentication Modules (PAM)")
+    (description
+     "Rust FFI wrappers for the Linux Pluggable Authentication Modules (PAM)")
+    (license (list license:expat license:asl2.0))))
-- 
2.33.0

[bug#49969] [PATCH v7 2/7] gnu: admin: Add greetd 0.8.0.

[muradm]

* gnu/packages/admin.scm (greetd): New variable
---
 gnu/packages/admin.scm | 79 ++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 79 insertions(+)

diff --git a/gnu/packages/admin.scm b/gnu/packages/admin.scm
index 8d6ae9eb1f..bef0ca3745 100644
--- a/gnu/packages/admin.scm
+++ b/gnu/packages/admin.scm
@@ -45,6 +45,7 @@
 ;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
 ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -62,6 +63,7 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu packages admin)
+  #:use-module (guix build-system cargo)
   #:use-module (guix build-system cmake)
   #:use-module (guix build-system emacs)
   #:use-module (guix build-system glib-or-gtk)
@@ -88,6 +90,7 @@
   #:use-module (gnu packages c)
   #:use-module (gnu packages check)
   #:use-module (gnu packages compression)
+  #:use-module (gnu packages crates-io)
   #:use-module (gnu packages cross-base)
   #:use-module (gnu packages crypto)
   #:use-module (gnu packages cryptsetup)
@@ -4813,3 +4816,79 @@ setup, maintenance, supervision, or any long-running processes.")
       (description "Utility to convert @code{lsof} output to a graph showing
 FIFO and UNIX interprocess communication.")
       (license license:bsd-2))))
+
+(define-public greetd
+  (package
+    (name "greetd")
+    (version "0.8.0")
+    (home-page "https://git.sr.ht/~kennylevinsen/greetd")
+    (source (origin
+              (method git-fetch)
+              (uri (git-reference
+                    (url home-page)
+                    (commit version)))
+              (file-name (git-file-name name version))
+              (sha256
+               (base32 "0x5c3jkw09kvj2grcxm899y2n6ws8p990cyp9cs0fy6lm4fzlh6v"))))
+    (build-system cargo-build-system)
+    (arguments
+     `(#:cargo-inputs
+       (("rust-nix" ,rust-nix-0.19)
+        ("rust-pam-sys" ,rust-pam-sys-0.5)
+        ("rust-rpassword" ,rust-rpassword-5)
+        ("rust-users" ,rust-users-0.11)
+        ("rust-serde" ,rust-serde-1)
+        ("rust-serde-json" ,rust-serde-json-1)
+        ("rust-libc" ,rust-libc-0.2)
+        ("rust-tokio" ,rust-tokio-1)
+        ("rust-getopts" ,rust-getopts-0.2)
+        ("rust-thiserror" ,rust-thiserror-1)
+        ("rust-async-trait" ,rust-async-trait-0.1)
+        ("rust-enquote" ,rust-enquote-1))
+       #:phases
+       (modify-phases %standard-phases
+         (delete 'package)
+         (add-after 'build 'build-man-pages
+           (lambda* (#:key inputs #:allow-other-keys)
+             (define (scdoc-cmd doc lvl)
+               (system (string-append "scdoc < "
+                                      doc "-" lvl ".scd > "
+                                      doc "." lvl)))
+             (with-directory-excursion "man"
+               (scdoc-cmd "greetd" "1")
+               (scdoc-cmd "greetd" "5")
+               (scdoc-cmd "greetd-ipc" "7")
+               (scdoc-cmd "agreety" "1"))))
+         (replace 'install
+           (lambda* (#:key inputs outputs #:allow-other-keys)
+             (let* ((out (assoc-ref outputs "out"))
+                    (bin (string-append out "/bin"))
+                    (sbin (string-append out "/sbin"))
+                    (share (string-append out "/share"))
+                    (man (string-append share "/man"))
+                    (man1 (string-append man "/man1"))
+                    (man5 (string-append man "/man5"))
+                    (man7 (string-append man "/man7"))
+                    (release "target/release")
+                    (greetd-bin (string-append release "/greetd"))
+                    (agreety-bin (string-append release "/agreety")))
+               (install-file greetd-bin sbin)
+               (install-file agreety-bin bin)
+               (with-directory-excursion "man"
+                 (install-file "greetd.1" man1)
+                 (install-file "greetd.5" man5)
+                 (install-file "greetd-ipc.7" man7)
+                 (install-file "agreety.1" man1))))))))
+    (native-inputs
+     `(("linux-pam" ,linux-pam)
+       ("scdoc" ,scdoc)))
+    (synopsis "minimal and flexible login manager daemon")
+    (description
+     "greetd is a minimal and flexible login manager daemon
+that makes no assumptions about what you want to launch.
+
+If you can run it from your shell in a TTY, greetd can start it.
+
+If it can be taught to speak a simple JSON-based IPC protocol,
+then it can be a greeter.")
+    (license license:gpl3+)))
-- 
2.33.0

[bug#49969] [PATCH v7 3/7] gnu: admin: Add greetd-pam-mount.

[muradm]

* gnu/packages/admin.scm (greetd-pam-mount): New variable
---
 gnu/packages/admin.scm | 32 ++++++++++++++++++++++++++++++++
 1 file changed, 32 insertions(+)

diff --git a/gnu/packages/admin.scm b/gnu/packages/admin.scm
index bef0ca3745..e46d21844b 100644
--- a/gnu/packages/admin.scm
+++ b/gnu/packages/admin.scm
@@ -4892,3 +4892,35 @@ If you can run it from your shell in a TTY, greetd can start it.
 If it can be taught to speak a simple JSON-based IPC protocol,
 then it can be a greeter.")
     (license license:gpl3+)))
+
+(define-public greetd-pam-mount
+  (package
+    (inherit pam-mount)
+    (name "greetd-pam-mount")
+    (arguments
+     (substitute-keyword-arguments (package-arguments pam-mount)
+       ((#:configure-flags flags ''())
+        `(cons* "--with-rundir=/run/greetd" ,flags))
+       ((#:phases phases)
+        `(modify-phases ,phases
+           (add-after 'unpack 'patch-config-file-name
+             (lambda* (#:key inputs #:allow-other-keys)
+               (substitute* "src/pam_mount.c"
+                 ((".*define CONFIGFILE .*$")
+                  "#define CONFIGFILE \"/etc/security/greetd_pam_mount.conf.xml\"\n")
+                 (("pam_mount_config") "greetd_pam_mount_config")
+                 (("pam_mount_system_authtok") "greetd_pam_mount_system_authtok"))))))))
+    (synopsis "pam-mount specifically compiled for use with greetd")
+    (description
+     "Pam-mount is a PAM module that can mount volumes when a user logs in.
+It supports mounting local filesystems of any kind the normal mount utility
+supports.  It can also mount encrypted LUKS volumes using the password
+supplied by the user when logging in.
+
+This package inherits pam-mount in the way that it is compiled specifically
+for use with greetd daemon. It uses different configuration location and
+name space for storing data in PAM.
+
+greetd-pam-mount is used in configuration of greetd to provide
+auto-(mounting/unmounting) of XDG_RUNTIME_DIR in the way that it will not
+interfere with default pam-mount configuration.")))
-- 
2.33.0

[bug#49969] [PATCH v7 4/7] gnu: base: Add greetd-service-type.

[muradm]

* gnu/services/base.scm (greetd-service-type): New variable
* gnu/services/base.scm (greetd-configuration): New data type
* gnu/services/base.scm (greetd-terminal-configuration): New data type
* gnu/services/base.scm (greetd-agreety-session): New data type
* gnu/services/base.scm (pam-limits-service-type): Shoul be aware of
greetd PAM service
* gnu/services/pam-mount.scm (pam-mount-pam-service): Shoul be aware
of greetd PAM service
---
 doc/guix.texi              | 133 ++++++++++++++++++++++
 gnu/services/base.scm      | 218 ++++++++++++++++++++++++++++++++++++-
 gnu/services/pam-mount.scm |   2 +-
 3 files changed, 351 insertions(+), 2 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 964ef6d5f4..c641ffc453 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -96,6 +96,7 @@ Copyright @copyright{} 2021 Domagoj Stolfa@*
 Copyright @copyright{} 2021 Hui Lu@*
 Copyright @copyright{} 2021 pukkamustard@*
 Copyright @copyright{} 2021 Alice Brenon@*
+Copyright @copyright{} 2021 muradm@*
 
 Permission is granted to copy, distribute and/or modify this document
 under the terms of the GNU Free Documentation License, Version 1.3 or
@@ -16156,6 +16157,138 @@ about the Pluggable Authentication Module (PAM) limits, refer to the
 @samp{pam_limits} man page from the @code{linux-pam} package.
 @end deffn
 
+@defvr {Scheme Variable} greetd-service-type
+@uref{https://git.sr.ht/~kennylevinsen/greetd, @code{greetd}} is a minimal and
+flexible login manager daemon, that makes no assumptions about what you
+want to launch.
+
+If you can run it from your shell in a TTY, greetd can start it. If it
+can be taught to speak a simple JSON-based IPC protocol, then it can be
+a geeter.
+
+@code{greetd-service-type} provides necessary infrastructure for logging
+in users, including:
+
+@itemize @bullet
+@item
+@code{greetd} PAM service
+
+@item
+Special variation of @code{pam-mount} to mount @code{XDG_RUNTIME_DIR}
+@end itemize
+
+Here is example of switching from @code{mingetty-service-type} to
+@code{greetd-service-type}, and how different terminals could be:
+
+@lisp
+  (append
+   (modify-services %base-services
+     ;; greetd-service-type provides "greetd" PAM service
+     (delete login-service-type)
+     ;; and can be used in place of mingetty-service-type
+     (delete mingetty-service-type))
+   (list
+    (service greetd-service-type
+             (greetd-configuration
+              (terminals
+               (list
+                ;; we can make any terminal active by default
+                (greetd-terminal-configuration (terminal-vt "1") (terminal-switch #t))
+                ;; we can make environment without XDG_RUNTIME_DIR set
+                ;; even provide our own environment variables
+                (greetd-terminal-configuration
+                 (terminal-vt "2")
+                 (default-session-command
+                   (greetd-agreety-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")))))
+                ;; we can use any other executable command as greeter
+                (greetd-terminal-configuration
+                 (terminal-vt "4")
+                 (default-session-command (program-file "my-noop-greeter" #~(exit))))
+                (greetd-terminal-configuration (terminal-vt "5"))
+                (greetd-terminal-configuration (terminal-vt "6"))))))
+    ;; mingetty-service-type can be used in parallel
+    ;; if needed to do so, do not (delete login-service-type)
+    ;; as illustrated above
+    #| (service mingetty-service-type (mingetty-configuration (tty "tty8"))) |#))
+@end lisp
+@end defvr
+
+@deftp {Data Type} greetd-configuration
+Configuration record for the @code{greetd-service-type}.
+@table @asis
+
+@item @code{motd}
+A file-like object containing the ``message of the day''.
+
+@item @code{allow-empty-passwords?} (default: @code{#t})
+Allow empty passwords by default so that first-time users can log in when
+the 'root' account has just been created.
+
+@item @code{terminals} (default: @code{'()})
+List of @code{greetd-terminal-configuration} per terminal for which
+@code{greetd} should be started.
+@end table
+@end deftp
+
+@deftp {Data Type} greetd-terminal-configuration
+Configuration record for per terminal greetd daemon service.
+
+@table @asis
+@item @code{greetd} (default: @code{greetd})
+The greetd package to use.
+
+@item @code{config-file-name}
+Configuration file name to use for greetd daemon. Generally, autogenerated
+derivation based on @code{terminal-vt} value.
+
+@item @code{terminal-vt} (default: @samp{"7"})
+The VT to run on. Use of a specific VT with appropriate conflict avoidance
+is recommended.
+
+@item @code{terminal-switch} (default: @code{#f})
+Make this terminal active on start of @code{greetd}.
+
+@item @code{default-session-user} (default: @samp{"greeter"})
+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
+@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.
+
+@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.
+
+@item @code{command-args} (default: @code{'("-l")})
+Command arguments to pass to command.
+
+@item @code{extra-env} (default: @code{'()})
+Extra environment variables to set on login.
+
+@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
+are set right after mentioned variables, so that they can be overriden.
+
+@end table
+@end deftp
+
 @node Scheduled Job Execution
 @subsection Scheduled Job Execution
 
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 50865055fe..fe2c4d6fe5 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -16,6 +16,7 @@
 ;;; Copyright © 2021 qblade <qblade@protonmail.com>
 ;;; Copyright © 2021 Hui Lu <luhuins@163.com>
 ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -186,6 +187,11 @@
 
             references-file
 
+            greetd-service-type
+            greetd-configuration
+            greetd-terminal-configuration
+            greetd-agreety-session
+
             %base-services))
 
 ;;; Commentary:
@@ -1401,7 +1407,7 @@ information on the configuration file syntax."
                               (module "pam_limits.so")
                               (arguments '("conf=/etc/security/limits.conf")))))
              (if (member (pam-service-name pam)
-                         '("login" "su" "slim" "gdm-password" "sddm"))
+                         '("login" "greetd" "su" "slim" "gdm-password" "sddm"))
                  (pam-service
                   (inherit pam)
                   (session (cons pam-limits
@@ -2462,6 +2468,216 @@ to handle."
                                            (requirement requirement)
                                            (name-servers name-servers)))))
 
+\f
+;;;
+;;; 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
+  (match-lambda
+    (($ <greetd-agreety-session> _ 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 #$@args)))))))
+
+(define greetd-agreety-tty-xdg-session-command
+  (match-lambda
+    (($ <greetd-agreety-session> _ 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 #$@args)))))))
+
+(define (make-greetd-agreety-session-command config command)
+  (let ((agreety (file-append (greetd-agreety config) "/bin/agreety")))
+    (program-file
+     "agreety-command"
+     #~(execl #$agreety #$agreety "-c" #$command))))
+
+(define (make-greetd-default-session-command config-or-command)
+  (cond ((greetd-agreety-session? config-or-command)
+         (cond ((greetd-agreety-xdg-env? config-or-command)
+                (make-greetd-agreety-session-command
+                 config-or-command
+                 (greetd-agreety-tty-xdg-session-command config-or-command)))
+               (#t
+                (make-greetd-agreety-session-command
+                 config-or-command
+                 (greetd-agreety-tty-session-command config-or-command)))))
+        (#t config-or-command)))
+
+(define-record-type* <greetd-terminal-configuration>
+  greetd-terminal-configuration make-greetd-terminal-configuration
+  greetd-terminal-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"))
+  (terminal-switch greetd-terminal-switch (default #f))
+  (default-session-user greetd-default-session-user (default "greeter"))
+  (default-session-command greetd-default-session-command
+    (default (greetd-agreety-session))
+    (sanitize make-greetd-default-session-command)))
+
+(define (default-config-file-name config)
+  (string-join (list "config-" (greetd-terminal-vt config) ".toml") ""))
+
+(define (make-greetd-terminal-configuration-file config)
+  (let*
+      ((config-file-name (greetd-config-file-name config))
+       (terminal-vt (greetd-terminal-vt config))
+       (terminal-switch (greetd-terminal-switch config))
+       (default-session-user (greetd-default-session-user config))
+       (default-session-command (greetd-default-session-command config)))
+    (mixed-text-file
+     config-file-name
+     "[terminal]\n"
+     "vt = " terminal-vt "\n"
+     "switch = " (if terminal-switch "true" "false") "\n"
+     "[default_session]\n"
+     "user = " default-session-user "\n"
+     "command = " default-session-command "\n")))
+
+(define %greetd-accounts
+  (list (user-account
+         (name "greeter")
+         (group "wheel")
+         (supplementary-groups '("users" "tty" "input" "video" "audio"))
+         (system? #t))))
+
+(define %greetd-file-systems
+  (list (file-system
+          (device "none")
+          (mount-point "/run/greetd/pam_mount")
+          (type "tmpfs")
+          (check? #f)
+          (flags '(no-suid no-dev no-exec))
+          (options "mode=0755")
+          (create-mount-point? #t))))
+
+(define %greetd-pam-mount-rules
+  `((debug (@ (enable "0")))
+    (volume (@ (sgrp "users")
+               (fstype "tmpfs")
+               (mountpoint "/run/user/%(USERUID)")
+               (options "noexec,nosuid,nodev,size=1g,mode=0700,uid=%(USERUID),gid=%(USERGID)")))
+    (logout (@ (wait "0")
+               (hup "0")
+               (term "yes")
+               (kill "no")))
+    (mkmountpoint (@ (enable "1") (remove "true")))))
+
+(define-record-type* <greetd-configuration>
+  greetd-configuration make-greetd-configuration
+  greetd-configuration?
+  (motd greetd-motd (default %default-motd))
+  (allow-empty-passwords? greetd-allow-empty-passwords? (default #t))
+  (terminals greetd-terminals (default '())))
+
+(define (make-greetd-pam-mount-conf-file config)
+  (computed-file
+   "greetd_pam_mount.conf.xml"
+   #~(begin
+       (use-modules (sxml simple))
+       (call-with-output-file #$output
+         (lambda (port)
+           (sxml->xml
+            '(*TOP*
+              (*PI* xml "version='1.0' encoding='utf-8'")
+              (pam_mount
+               #$@%greetd-pam-mount-rules
+               (pmvarrun
+                #$(file-append greetd-pam-mount
+                               "/sbin/pmvarrun -u '%(USER)' -o '%(OPERATION)'"))))
+            port))))))
+
+(define (greetd-etc-service config)
+  `(("security/greetd_pam_mount.conf.xml"
+     ,(make-greetd-pam-mount-conf-file config))))
+
+(define (greetd-pam-service config)
+  (define optional-pam-mount
+    (pam-entry
+     (control "optional")
+     (module #~(string-append #$greetd-pam-mount "/lib/security/pam_mount.so"))
+     (arguments '("disable_interactive"))))
+
+  (list
+   (unix-pam-service "greetd"
+                     #:login-uid? #t
+                     #:allow-empty-passwords?
+                     (greetd-allow-empty-passwords? config)
+                     #:motd
+                     (greetd-motd config))
+   (lambda (pam)
+     (if (member (pam-service-name pam)
+                 '("login" "greetd" "su" "slim" "gdm-password"))
+         (pam-service
+          (inherit pam)
+          (auth (append (pam-service-auth pam)
+                        (list optional-pam-mount)))
+          (session (append (pam-service-session pam)
+                           (list optional-pam-mount))))
+         pam))))
+
+(define (greetd-shepherd-services config)
+  (map
+   (lambda (tc)
+     (let*
+         ((greetd-bin (file-append (greetd-package tc) "/sbin/greetd"))
+          (greetd-conf (make-greetd-terminal-configuration-file tc))
+          (greetd-vt (greetd-terminal-vt tc)))
+       (shepherd-service
+        (documentation "Minimal and flexible login manager daemon")
+        (requirement '(user-processes host-name udev virtual-terminal))
+        (provision (list (symbol-append
+                          'term-tty
+                          (string->symbol (greetd-terminal-vt tc)))))
+        (start #~(make-forkexec-constructor
+                  (list #$greetd-bin "-c" #$greetd-conf)
+                  #:log-file
+                  (string-append "/tmp/greetd." #$greetd-vt ".log")))
+        (stop #~(make-kill-destructor)))))
+   (greetd-terminals config)))
+
+(define greetd-service-type
+  (service-type
+   (name 'greetd)
+   (description "Provides necessary infrastructure for logging into the
+system including @code{greetd} PAM service, @code{pam-mount} module to
+mount/unmount /run/user/<uid> directory for user and @code{greetd}
+login manager daemon.")
+   (extensions
+    (list
+     (service-extension account-service-type (const %greetd-accounts))
+     (service-extension file-system-service-type (const %greetd-file-systems))
+     (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)))
+   (default-value (greetd-configuration))))
+
 \f
 (define %base-services
   ;; Convenience variable holding the basic services.
diff --git a/gnu/services/pam-mount.scm b/gnu/services/pam-mount.scm
index 98611462c2..d6c65e3760 100644
--- a/gnu/services/pam-mount.scm
+++ b/gnu/services/pam-mount.scm
@@ -90,7 +90,7 @@
      (module #~(string-append #$pam-mount "/lib/security/pam_mount.so"))))
   (list (lambda (pam)
           (if (member (pam-service-name pam)
-                      '("login" "su" "slim" "gdm-password"))
+                      '("login" "greetd" "su" "slim" "gdm-password"))
               (pam-service
                (inherit pam)
                (auth (append (pam-service-auth pam)
-- 
2.33.0

[bug#49969] [PATCH v7 5/7] gnu: admin: Add libseat 0.6.1 and move seatd.

[muradm]

* gnu/packages/admin.scm (libseat): New variable
* gnu/packages/admin.scm (seatd): New variable
* gnu/packages/freedesktop.scm (seatd): Remove variable
---
 gnu/packages/admin.scm       | 53 ++++++++++++++++++++++++++++++++++++
 gnu/packages/freedesktop.scm | 30 --------------------
 2 files changed, 53 insertions(+), 30 deletions(-)

diff --git a/gnu/packages/admin.scm b/gnu/packages/admin.scm
index e46d21844b..83902a9bce 100644
--- a/gnu/packages/admin.scm
+++ b/gnu/packages/admin.scm
@@ -45,6 +45,7 @@
 ;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
 ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
+;;; Copyright © 2021 pineapples <guixuser6392@protonmail.com>
 ;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -99,6 +100,7 @@
   #:use-module (gnu packages elf)
   #:use-module (gnu packages file)
   #:use-module (gnu packages flex)
+  #:use-module (gnu packages freedesktop)
   #:use-module (gnu packages gawk)
   #:use-module (gnu packages gettext)
   #:use-module (gnu packages gl)
@@ -4817,6 +4819,57 @@ setup, maintenance, supervision, or any long-running processes.")
 FIFO and UNIX interprocess communication.")
       (license license:bsd-2))))
 
+(define-public libseat
+  (package
+    (name "libseat")
+    (version "0.6.1")
+    (source (origin
+              (method git-fetch)
+              (uri (git-reference
+                    (url "https://git.sr.ht/~kennylevinsen/seatd")
+                    (commit version)))
+              (file-name (git-file-name name version))
+              (sha256
+               (base32
+                "0fkfnxqz5g2kidhdh7rsa20d8j0pd4fnnz63ddn3n5mlgqckj06s"))))
+    (build-system meson-build-system)
+    (arguments
+     `(#:configure-flags '("-Dlibseat-logind=elogind"
+                           "-Dserver=disabled")))
+    (native-inputs
+     `(("pkg-config" ,pkg-config)))
+    (propagated-inputs
+     `(("elogind" ,elogind)))
+    (home-page "https://sr.ht/~kennylevinsen/seatd")
+    (synopsis "Seat management library")
+    (description
+     "This package provides a universal seat management library that
+allows applications to use whatever seat management is available.")
+    (license license:expat)))
+
+(define-public seatd
+  (package
+    (inherit libseat)
+    (name "seatd")
+    (arguments
+     `(#:configure-flags '("-Dlibseat-logind=elogind")
+       #:phases
+       (modify-phases %standard-phases
+         (add-after 'install 'remove-libs
+           (lambda* (#:key outputs #:allow-other-keys)
+             (with-directory-excursion (assoc-ref outputs "out")
+               (for-each delete-file-recursively '("lib" "include"))))))))
+    (native-inputs
+     `(("pkg-config" ,pkg-config)
+       ("scdoc" ,scdoc)))
+    (inputs '())
+    (synopsis "Seat management daemon")
+    (description
+     "This package provides a minimal seat management daemon whose task is to
+mediate access to shared devices, such as graphics and input, for applications
+that require it.")
+    (license license:expat)))
+
 (define-public greetd
   (package
     (name "greetd")
diff --git a/gnu/packages/freedesktop.scm b/gnu/packages/freedesktop.scm
index 85d9697460..d7b411b5d1 100644
--- a/gnu/packages/freedesktop.scm
+++ b/gnu/packages/freedesktop.scm
@@ -834,36 +834,6 @@ GNOME Shell.  The @command{localectl} command-line tool allows you to interact
 with localed.  This package is extracted from the broader systemd package.")
     (license license:lgpl2.1+)))
 
-(define-public seatd
-  (package
-    (name "seatd")
-    (version "0.5.0")
-    (source (origin
-              (method git-fetch)
-              (uri (git-reference
-                    (url "https://git.sr.ht/~kennylevinsen/seatd")
-                    (commit version)))
-              (file-name (git-file-name name version))
-              (sha256
-               (base32
-                "1kglq8v4rnr3415mfaghyv2s2f8mxsy5s881gmm2908ig4n4j297"))))
-    (build-system meson-build-system)
-    (arguments
-     `(#:configure-flags '("-Dlogind=enabled")))
-    (native-inputs
-     `(("pkg-config" ,pkg-config)
-       ("scdoc" ,scdoc)))
-    (inputs
-     `(("elogind" ,elogind)))
-    (home-page "https://sr.ht/~kennylevinsen/seatd")
-    (synopsis "Seat management daemon and library")
-    (description
-     "This package provides a minimal seat management daemon whose task is to
-mediate access to shared devices, such as graphics and input, for applications
-that require it.  It also provides a universal seat management library that
-allows applications to use whatever seat management is available.")
-    (license license:expat)))
-
 (define-public packagekit
   (package
     (name "packagekit")
-- 
2.33.0

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

[muradm]

* gnu/services/desktop.scm (seatd-service-type): New variable
* gnu/services/desktop.scm (seatd-configuration): New data type
---
 doc/guix.texi            | 42 ++++++++++++++++++++++++++++
 gnu/services/desktop.scm | 60 +++++++++++++++++++++++++++++++++++++++-
 2 files changed, 101 insertions(+), 1 deletion(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index c641ffc453..764355c69f 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -20110,6 +20110,48 @@ and ``passwd'' is with the value @code{passwd}.
 @end table
 @end deftp
 
+@defvr {Scheme Variable} seatd-service-type
+@uref{https://sr.ht/~kennylevinsen/seatd/, seatd} is a minimal seat
+management daemon.
+
+Seat management takes care of mediating access to shared devices (graphics,
+input), without requiring the applications needing access to be root.
+
+@lisp
+(append
+  (list
+   ;; make sure seatd is running
+   (service seatd-service-type))
+
+  ;; normally one would want %base-services
+  %base-services)
+
+@end lisp
+@end defvr
+
+@deftp {Data Type} seatd-configuration
+Configuration record for the seatd daemon service.
+
+@table @asis
+@item @code{seatd} (default: @code{seatd})
+The seatd package to use.
+
+@item @code{user} (default: @samp{"root"})
+User to own the seatd socket.
+
+@item @code{group} (default: @samp{"users"})
+Group to own the seatd socket.
+
+@item @code{socket} (default: @samp{"/run/seatd.sock"})
+Where to create the seatd socket.
+
+@item @code{loglevel} (default: @samp{"error"})
+Log level to output logs. Possible values: @samp{"silent"}, @samp{"error"},
+@samp{"info"} and @samp{"debug"}.
+
+@end table
+@end deftp
+
 
 @node Sound Services
 @subsection Sound Services
diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index 64d0e85301..c42db5987e 100644
--- a/gnu/services/desktop.scm
+++ b/gnu/services/desktop.scm
@@ -13,6 +13,7 @@
 ;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2020 Reza Alizadeh Majd <r.majd@pantherx.org>
 ;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -39,7 +40,9 @@
   #:use-module (gnu services networking)
   #:use-module (gnu services sound)
   #:use-module ((gnu system file-systems)
-                #:select (%elogind-file-systems file-system))
+                #:select (%control-groups
+                          %elogind-file-systems
+                          file-system))
   #:use-module (gnu system)
   #:use-module (gnu system setuid)
   #:use-module (gnu system shadow)
@@ -154,6 +157,9 @@
             gnome-keyring-configuration?
             gnome-keyring-service-type
 
+            seatd-configuration
+            seatd-service-type
+
             %desktop-services))
 
 ;;; Commentary:
@@ -1182,6 +1188,58 @@ or setting its password with passwd.")))
 (define polkit-wheel-service
   (simple-service 'polkit-wheel polkit-service-type (list polkit-wheel)))
 
+\f
+;;;
+;;; seatd-service-type -- minimal seat management daemon
+;;;
+
+(define-record-type* <seatd-configuration> seatd-configuration
+  make-seatd-configuration
+  seatd-configuration?
+  (seatd seatd-package (default seatd))
+  (user seatd-user (default "root"))
+  (group seatd-group (default "users"))
+  (socket seatd-socket (default "/run/seatd.sock"))
+  (loglevel seatd-loglevel (default "error")))
+
+(define (seatd-shepherd-service config)
+  (list (shepherd-service
+         (documentation "Minimal seat management daemon")
+         (requirement '())
+         ;; TODO: once cgroups is separate dependency
+         ;; here we should depend on it rather than elogind
+         (provision '(seatd elogind))
+         (start #~(make-forkexec-constructor
+                   (list #$(file-append (seatd-package config) "/bin/seatd")
+                         "-u" #$(seatd-user config)
+                         "-g" #$(seatd-group config)
+                         "-s" #$(seatd-socket config))
+                   #:environment-variables
+                   (list (string-append "SEATD_LOGLEVEL="
+                                        #$(seatd-loglevel config)))
+                   #:log-file "/tmp/seatd.log"))
+         (stop #~(make-kill-destructor)))))
+
+(define seatd-environment
+  (match-lambda
+    (($ <seatd-configuration> _ _ _ socket)
+     `(("SEATD_SOCK" . ,socket)))))
+
+(define seatd-service-type
+  (service-type
+   (name 'seatd)
+   (description "Seat management takes care of mediating access
+to shared devices (graphics, input), without requiring the
+applications needing access to be root.")
+   (extensions
+    (list
+     (service-extension session-environment-service-type seatd-environment)
+     ;; TODO: once cgroups is separate dependency we should not mount it here
+     ;; for now it is mounted here, because elogind mounts it
+     (service-extension file-system-service-type (const %control-groups))
+     (service-extension shepherd-root-service-type seatd-shepherd-service)))
+   (default-value (seatd-configuration))))
+
 \f
 ;;;
 ;;; The default set of desktop services.
-- 
2.33.0

[bug#49969] [PATCH v7 7/7] gnu: tests: Add seatd/greetd based minimal desktop system tests.

[muradm]

* gnu/tests/desktop.scm (minimal-desktop): seatd/greetd based
minimal desktop test
---
 gnu/tests/desktop.scm | 212 +++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 211 insertions(+), 1 deletion(-)

diff --git a/gnu/tests/desktop.scm b/gnu/tests/desktop.scm
index 6aa22fd49b..50aa859869 100644
--- a/gnu/tests/desktop.scm
+++ b/gnu/tests/desktop.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -18,13 +19,17 @@
 
 (define-module (gnu tests desktop)
   #:use-module (gnu tests)
+  #:use-module (gnu packages shells)
   #:use-module (gnu services)
+  #:use-module (gnu services base)
   #:use-module (gnu services dbus)
   #:use-module (gnu services desktop)
+  #:use-module (gnu system)
   #:use-module (gnu system vm)
   #:use-module (guix gexp)
   #:use-module (srfi srfi-1)
-  #:export (%test-elogind))
+  #:export (%test-elogind
+            %test-minimal-desktop))
 
 \f
 ;;;
@@ -103,3 +108,208 @@
                #:imported-modules '((gnu services herd)
                                     (guix combinators)))))
       (run-elogind-test (virtual-machine os))))))
+
+\f
+;;;
+;;; Seatd/greetd based minimal desktop
+;;;
+
+(define %minimal-services
+  (append
+   (modify-services %base-services
+     ;; greetd-service-type provides "greetd" PAM service
+     (delete login-service-type)
+     ;; and can be used in place of mingetty-service-type
+     (delete mingetty-service-type))
+   (list
+    (service seatd-service-type)
+    (service greetd-service-type
+             (greetd-configuration
+              (terminals
+               (list
+                ;; we can make any terminal active by default
+                (greetd-terminal-configuration (terminal-vt "1") (terminal-switch #t))
+                ;; we can make environment without XDG_RUNTIME_DIR set
+                ;; even provide our own environment variables
+                (greetd-terminal-configuration
+                 (terminal-vt "2")
+                 (default-session-command
+                   (greetd-agreety-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")))))
+                ;; we can use any other executable command as greeter
+                (greetd-terminal-configuration
+                 (terminal-vt "4")
+                 (default-session-command (program-file "my-noop-greeter" #~(exit))))
+                (greetd-terminal-configuration (terminal-vt "5"))
+                (greetd-terminal-configuration (terminal-vt "6"))))))
+    ;; mingetty-service-type can be used in parallel
+    ;; if needed to do so, do not (delete login-service-type)
+    ;; as illustrated above
+    #| (service mingetty-service-type (mingetty-configuration (tty "tty8"))) |#)))
+
+(define-syntax-rule (minimal-operating-system user-services ...)
+  "Return an operating system that includes USER-SERVICES in addition to
+minimal %BASE-SERVICES."
+  (operating-system (inherit %simple-os)
+                    (services (cons* user-services ... %minimal-services))))
+
+(define (run-minimal-desktop-test os vm)
+  (define test
+    (with-imported-modules '((gnu build marionette)
+                             (guix build syscalls))
+      #~(begin
+          (use-modules (gnu build marionette)
+                       (guix build syscalls)
+                       (srfi srfi-1)
+                       (srfi srfi-64)
+                       (ice-9 pretty-print))
+
+          (define marionette
+            (make-marionette #$vm))
+
+          (define (file-get-all-strings fname)
+            (marionette-eval '(use-modules (rnrs io ports)) marionette)
+            (wait-for-file fname marionette #:read 'get-string-all))
+
+          (define (wait-for-unix-socket-m socket)
+            (wait-for-unix-socket socket marionette))
+
+          (mkdir #$output)
+          (chdir #$output)
+
+          (test-begin "minimal-desktop")
+
+          (test-assert "seatd is ready"
+            (wait-for-unix-socket-m "/run/seatd.sock"))
+
+          (test-equal "login user on tty1"
+            "alice\n"
+            (begin
+              ;; Wait for tty1.
+              (marionette-eval
+               '(begin
+                  (use-modules (gnu services herd))
+                  (start-service 'term-tty1))
+               marionette)
+              (marionette-control "sendkey ctrl-alt-f1" marionette)
+
+              ;; login as root change alice password and exit
+              ;; then login as alice
+              (for-each
+               (lambda (cmd) (marionette-type cmd marionette) (sleep 1))
+               (list
+                "root\n"
+                "passwd alice\n"
+                "alice\n"
+                "alice\n"
+                "exit\n"
+                "alice\n"
+                "alice\n"
+                "id -un > logged-in\n"))
+
+              (file-get-all-strings "/home/alice/logged-in")))
+
+          (test-equal "validate user environment"
+            '("SEATD_SOCK=/run/seatd.sock"
+              "XDG_RUNTIME_DIR=/run/user/1000"
+              "XDG_SEAT=seat0"
+              "XDG_VTNR=1")
+
+            (begin
+              (marionette-type "env > env\n" marionette)
+              (sleep 1)
+
+              (define user-env (string-tokenize
+                                (file-get-all-strings "/home/alice/env")))
+
+              (define (expected-var var)
+                (any (lambda (s) (string-contains var s))
+                     '("SEATD_SOCK"
+                       "XDG_RUNTIME_DIR"
+                       "XDG_SEAT"
+                       "XDG_VTNR")))
+
+              (sort (filter expected-var user-env) string<?)))
+
+          (test-assert "validate SEATD_SOCK and GREETD_SOCK"
+            (begin
+              (marionette-type "env > env\n" marionette)
+              (sleep 1)
+
+              (define (sock-var? var)
+                (any (lambda (s) (string-contains var s))
+                     '("SEATD_SOCK" "GREETD_SOCK")))
+
+              (define (sock-var-sock var)
+                (car (cdr (string-split var #\=))))
+
+              (let*
+                  ((out (file-get-all-strings "/home/alice/env"))
+                   (out (string-tokenize out))
+                   (out (filter sock-var? out))
+                   (socks (map sock-var-sock out))
+                   (socks (map wait-for-unix-socket-m socks)))
+                (and (= 2 (length socks)) (every identity socks)))))
+
+          (test-assert "greetd is ready"
+            (begin
+              (marionette-type "ps -C greetd -o pid,args --no-headers > ps-greetd\n"
+                               marionette)
+              (sleep 1)
+
+              (define (greetd-daemon? cmd)
+                (string-contains cmd "config"))
+
+              (define (greetd-cmd-to-pid cmd)
+                (car (string-split cmd #\space)))
+
+              (define (greetd-pid-to-sock pid)
+                (string-append "/run/greetd-" pid ".sock"))
+
+              (let* ((out (file-get-all-strings "/home/alice/ps-greetd"))
+                     (out (string-split out #\newline))
+                     (out (map string-trim-both out))
+                     (out (filter greetd-daemon? out))
+                     (pids (map greetd-cmd-to-pid out))
+                     (socks (map greetd-pid-to-sock pids))
+                     (socks (map wait-for-unix-socket-m socks)))
+                (every identity socks))))
+
+          ;; a bit weak, but tests everything at once actually
+          (test-equal "check /run/user/<uid> mounted and writable"
+            "alice\n"
+            (begin
+              (marionette-type "echo alice > /run/user/1000/test\n" marionette)
+              (file-get-all-strings "/run/user/1000/test")))
+
+          (test-assert "screendump"
+            (begin
+              (marionette-control (string-append "screendump " #$output
+                                                 "/tty1.ppm")
+                                  marionette)
+              (file-exists? "tty1.ppm")))
+
+          (test-end)
+          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+  (gexp->derivation "minimal-desktop" test))
+
+(define %test-minimal-desktop
+  (system-test
+   (name "minimal-desktop")
+   (description
+    "Test whether we can log in when seatd and greetd is enabled")
+   (value
+    (let* ((os (marionette-operating-system
+                (minimal-operating-system)
+                #:imported-modules '((gnu services herd)
+                                     (guix combinators))))
+           (vm (virtual-machine os)))
+      (run-minimal-desktop-test (virtualized-operating-system os '())
+                                #~(list #$vm))))))
-- 
2.33.0

[bug#49969] [PATCH v8 0/7] Update libseat and seatd to 0.6.2.

[muradm]

After new release of libseat/seatd, vulnerability detected and fixed.

muradm (7):
  gnu: crates-io: Add rust-enquote 1.0.3 and rust-pam-sys 0.5.6.
  gnu: admin: Add greetd 0.8.0.
  gnu: admin: Add greetd-pam-mount.
  gnu: base: Add greetd-service-type.
  gnu: admin: Add libseat 0.6.2 and move seatd.
  gnu: desktop: Add seatd-service-type.
  gnu: tests: Add seatd/greetd based minimal desktop system tests.

 doc/guix.texi                | 175 ++++++++++++++++++++++++++++
 gnu/packages/admin.scm       | 164 ++++++++++++++++++++++++++
 gnu/packages/crates-io.scm   |  49 ++++++++
 gnu/packages/freedesktop.scm |  30 -----
 gnu/services/base.scm        | 218 ++++++++++++++++++++++++++++++++++-
 gnu/services/desktop.scm     |  60 +++++++++-
 gnu/services/pam-mount.scm   |   2 +-
 gnu/tests/desktop.scm        | 212 +++++++++++++++++++++++++++++++++-
 8 files changed, 876 insertions(+), 34 deletions(-)

-- 
2.33.0

[bug#49969] [PATCH v8 1/7] gnu: crates-io: Add rust-enquote 1.0.3 and rust-pam-sys 0.5.6.

[muradm]

* gnu/packages/crates-io.scm (rust-enquote-1): New variable
* gnu/packages/crates-io.scm (rust-pam-sys-0.5): New variable
---
 gnu/packages/crates-io.scm | 49 ++++++++++++++++++++++++++++++++++++++
 1 file changed, 49 insertions(+)

diff --git a/gnu/packages/crates-io.scm b/gnu/packages/crates-io.scm
index 2b91d4b871..83a8642448 100644
--- a/gnu/packages/crates-io.scm
+++ b/gnu/packages/crates-io.scm
@@ -19,6 +19,7 @@
 ;;; Copyright © 2021 Antero Mejr <antero@kodmin.com>
 ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2021 Vinicius Monego <monego@posteo.net>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -55,6 +56,7 @@
   #:use-module (gnu packages glib)
   #:use-module (gnu packages image)
   #:use-module (gnu packages jemalloc)
+  #:use-module (gnu packages linux)
   #:use-module (gnu packages llvm)
   #:use-module (gnu packages multiprecision)
   #:use-module (gnu packages nettle)
@@ -57376,3 +57378,50 @@ variant of this library is available separately as @code{im}.")
     (description
       "Generate Rust register maps (`struct`s) from SVD files")
     (license (list license:expat license:asl2.0))))
+
+(define-public rust-enquote-1
+  (package
+    (name "rust-enquote")
+    (version "1.0.3")
+    (home-page "https://github.com/reujab/enquote")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (crate-uri "enquote" version))
+       (file-name
+        (string-append name "-" version ".tar.gz"))
+       (sha256
+        (base32
+         "0vm687r2wwgc3d3l2iqhag9wgkql6k93sdvjxvmfkdpksajpij1f"))))
+    (build-system cargo-build-system)
+    (synopsis
+     "A Rust library quotes, unquotes, and unescapes strings")
+    (description
+     "A Rust library quotes, unquotes, and unescapes strings")
+    (license license:unlicense)))
+
+(define-public rust-pam-sys-0.5
+  (package
+    (name "rust-pam-sys")
+    (version "0.5.6")
+    (home-page "https://github.com/1wilkens/pam-sys")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (crate-uri "pam-sys" version))
+       (file-name
+        (string-append name "-" version ".tar.gz"))
+       (sha256
+        (base32
+         "0d14501d5vybjnzxfjf96321xa5wa36x1xvf02h02zq938qmhj6d"))))
+    (build-system cargo-build-system)
+    (arguments
+     `(#:cargo-inputs
+       (("rust-libc" ,rust-libc-0.2))))
+    (native-inputs
+     `(("linux-pam" ,linux-pam)))
+    (synopsis
+     "Rust FFI wrappers for the Linux Pluggable Authentication Modules (PAM)")
+    (description
+     "Rust FFI wrappers for the Linux Pluggable Authentication Modules (PAM)")
+    (license (list license:expat license:asl2.0))))
-- 
2.33.0

[bug#49969] [PATCH v8 2/7] gnu: admin: Add greetd 0.8.0.

[muradm]

* gnu/packages/admin.scm (greetd): New variable
---
 gnu/packages/admin.scm | 79 ++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 79 insertions(+)

diff --git a/gnu/packages/admin.scm b/gnu/packages/admin.scm
index 8d6ae9eb1f..bef0ca3745 100644
--- a/gnu/packages/admin.scm
+++ b/gnu/packages/admin.scm
@@ -45,6 +45,7 @@
 ;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
 ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -62,6 +63,7 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu packages admin)
+  #:use-module (guix build-system cargo)
   #:use-module (guix build-system cmake)
   #:use-module (guix build-system emacs)
   #:use-module (guix build-system glib-or-gtk)
@@ -88,6 +90,7 @@
   #:use-module (gnu packages c)
   #:use-module (gnu packages check)
   #:use-module (gnu packages compression)
+  #:use-module (gnu packages crates-io)
   #:use-module (gnu packages cross-base)
   #:use-module (gnu packages crypto)
   #:use-module (gnu packages cryptsetup)
@@ -4813,3 +4816,79 @@ setup, maintenance, supervision, or any long-running processes.")
       (description "Utility to convert @code{lsof} output to a graph showing
 FIFO and UNIX interprocess communication.")
       (license license:bsd-2))))
+
+(define-public greetd
+  (package
+    (name "greetd")
+    (version "0.8.0")
+    (home-page "https://git.sr.ht/~kennylevinsen/greetd")
+    (source (origin
+              (method git-fetch)
+              (uri (git-reference
+                    (url home-page)
+                    (commit version)))
+              (file-name (git-file-name name version))
+              (sha256
+               (base32 "0x5c3jkw09kvj2grcxm899y2n6ws8p990cyp9cs0fy6lm4fzlh6v"))))
+    (build-system cargo-build-system)
+    (arguments
+     `(#:cargo-inputs
+       (("rust-nix" ,rust-nix-0.19)
+        ("rust-pam-sys" ,rust-pam-sys-0.5)
+        ("rust-rpassword" ,rust-rpassword-5)
+        ("rust-users" ,rust-users-0.11)
+        ("rust-serde" ,rust-serde-1)
+        ("rust-serde-json" ,rust-serde-json-1)
+        ("rust-libc" ,rust-libc-0.2)
+        ("rust-tokio" ,rust-tokio-1)
+        ("rust-getopts" ,rust-getopts-0.2)
+        ("rust-thiserror" ,rust-thiserror-1)
+        ("rust-async-trait" ,rust-async-trait-0.1)
+        ("rust-enquote" ,rust-enquote-1))
+       #:phases
+       (modify-phases %standard-phases
+         (delete 'package)
+         (add-after 'build 'build-man-pages
+           (lambda* (#:key inputs #:allow-other-keys)
+             (define (scdoc-cmd doc lvl)
+               (system (string-append "scdoc < "
+                                      doc "-" lvl ".scd > "
+                                      doc "." lvl)))
+             (with-directory-excursion "man"
+               (scdoc-cmd "greetd" "1")
+               (scdoc-cmd "greetd" "5")
+               (scdoc-cmd "greetd-ipc" "7")
+               (scdoc-cmd "agreety" "1"))))
+         (replace 'install
+           (lambda* (#:key inputs outputs #:allow-other-keys)
+             (let* ((out (assoc-ref outputs "out"))
+                    (bin (string-append out "/bin"))
+                    (sbin (string-append out "/sbin"))
+                    (share (string-append out "/share"))
+                    (man (string-append share "/man"))
+                    (man1 (string-append man "/man1"))
+                    (man5 (string-append man "/man5"))
+                    (man7 (string-append man "/man7"))
+                    (release "target/release")
+                    (greetd-bin (string-append release "/greetd"))
+                    (agreety-bin (string-append release "/agreety")))
+               (install-file greetd-bin sbin)
+               (install-file agreety-bin bin)
+               (with-directory-excursion "man"
+                 (install-file "greetd.1" man1)
+                 (install-file "greetd.5" man5)
+                 (install-file "greetd-ipc.7" man7)
+                 (install-file "agreety.1" man1))))))))
+    (native-inputs
+     `(("linux-pam" ,linux-pam)
+       ("scdoc" ,scdoc)))
+    (synopsis "minimal and flexible login manager daemon")
+    (description
+     "greetd is a minimal and flexible login manager daemon
+that makes no assumptions about what you want to launch.
+
+If you can run it from your shell in a TTY, greetd can start it.
+
+If it can be taught to speak a simple JSON-based IPC protocol,
+then it can be a greeter.")
+    (license license:gpl3+)))
-- 
2.33.0

[bug#49969] [PATCH v8 3/7] gnu: admin: Add greetd-pam-mount.

[muradm]

* gnu/packages/admin.scm (greetd-pam-mount): New variable
---
 gnu/packages/admin.scm | 32 ++++++++++++++++++++++++++++++++
 1 file changed, 32 insertions(+)

diff --git a/gnu/packages/admin.scm b/gnu/packages/admin.scm
index bef0ca3745..e46d21844b 100644
--- a/gnu/packages/admin.scm
+++ b/gnu/packages/admin.scm
@@ -4892,3 +4892,35 @@ If you can run it from your shell in a TTY, greetd can start it.
 If it can be taught to speak a simple JSON-based IPC protocol,
 then it can be a greeter.")
     (license license:gpl3+)))
+
+(define-public greetd-pam-mount
+  (package
+    (inherit pam-mount)
+    (name "greetd-pam-mount")
+    (arguments
+     (substitute-keyword-arguments (package-arguments pam-mount)
+       ((#:configure-flags flags ''())
+        `(cons* "--with-rundir=/run/greetd" ,flags))
+       ((#:phases phases)
+        `(modify-phases ,phases
+           (add-after 'unpack 'patch-config-file-name
+             (lambda* (#:key inputs #:allow-other-keys)
+               (substitute* "src/pam_mount.c"
+                 ((".*define CONFIGFILE .*$")
+                  "#define CONFIGFILE \"/etc/security/greetd_pam_mount.conf.xml\"\n")
+                 (("pam_mount_config") "greetd_pam_mount_config")
+                 (("pam_mount_system_authtok") "greetd_pam_mount_system_authtok"))))))))
+    (synopsis "pam-mount specifically compiled for use with greetd")
+    (description
+     "Pam-mount is a PAM module that can mount volumes when a user logs in.
+It supports mounting local filesystems of any kind the normal mount utility
+supports.  It can also mount encrypted LUKS volumes using the password
+supplied by the user when logging in.
+
+This package inherits pam-mount in the way that it is compiled specifically
+for use with greetd daemon. It uses different configuration location and
+name space for storing data in PAM.
+
+greetd-pam-mount is used in configuration of greetd to provide
+auto-(mounting/unmounting) of XDG_RUNTIME_DIR in the way that it will not
+interfere with default pam-mount configuration.")))
-- 
2.33.0

[bug#49969] [PATCH v8 4/7] gnu: base: Add greetd-service-type.

[muradm]

* gnu/services/base.scm (greetd-service-type): New variable
* gnu/services/base.scm (greetd-configuration): New data type
* gnu/services/base.scm (greetd-terminal-configuration): New data type
* gnu/services/base.scm (greetd-agreety-session): New data type
* gnu/services/base.scm (pam-limits-service-type): Shoul be aware of
greetd PAM service
* gnu/services/pam-mount.scm (pam-mount-pam-service): Shoul be aware
of greetd PAM service
---
 doc/guix.texi              | 133 ++++++++++++++++++++++
 gnu/services/base.scm      | 218 ++++++++++++++++++++++++++++++++++++-
 gnu/services/pam-mount.scm |   2 +-
 3 files changed, 351 insertions(+), 2 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 964ef6d5f4..c641ffc453 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -96,6 +96,7 @@ Copyright @copyright{} 2021 Domagoj Stolfa@*
 Copyright @copyright{} 2021 Hui Lu@*
 Copyright @copyright{} 2021 pukkamustard@*
 Copyright @copyright{} 2021 Alice Brenon@*
+Copyright @copyright{} 2021 muradm@*
 
 Permission is granted to copy, distribute and/or modify this document
 under the terms of the GNU Free Documentation License, Version 1.3 or
@@ -16156,6 +16157,138 @@ about the Pluggable Authentication Module (PAM) limits, refer to the
 @samp{pam_limits} man page from the @code{linux-pam} package.
 @end deffn
 
+@defvr {Scheme Variable} greetd-service-type
+@uref{https://git.sr.ht/~kennylevinsen/greetd, @code{greetd}} is a minimal and
+flexible login manager daemon, that makes no assumptions about what you
+want to launch.
+
+If you can run it from your shell in a TTY, greetd can start it. If it
+can be taught to speak a simple JSON-based IPC protocol, then it can be
+a geeter.
+
+@code{greetd-service-type} provides necessary infrastructure for logging
+in users, including:
+
+@itemize @bullet
+@item
+@code{greetd} PAM service
+
+@item
+Special variation of @code{pam-mount} to mount @code{XDG_RUNTIME_DIR}
+@end itemize
+
+Here is example of switching from @code{mingetty-service-type} to
+@code{greetd-service-type}, and how different terminals could be:
+
+@lisp
+  (append
+   (modify-services %base-services
+     ;; greetd-service-type provides "greetd" PAM service
+     (delete login-service-type)
+     ;; and can be used in place of mingetty-service-type
+     (delete mingetty-service-type))
+   (list
+    (service greetd-service-type
+             (greetd-configuration
+              (terminals
+               (list
+                ;; we can make any terminal active by default
+                (greetd-terminal-configuration (terminal-vt "1") (terminal-switch #t))
+                ;; we can make environment without XDG_RUNTIME_DIR set
+                ;; even provide our own environment variables
+                (greetd-terminal-configuration
+                 (terminal-vt "2")
+                 (default-session-command
+                   (greetd-agreety-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")))))
+                ;; we can use any other executable command as greeter
+                (greetd-terminal-configuration
+                 (terminal-vt "4")
+                 (default-session-command (program-file "my-noop-greeter" #~(exit))))
+                (greetd-terminal-configuration (terminal-vt "5"))
+                (greetd-terminal-configuration (terminal-vt "6"))))))
+    ;; mingetty-service-type can be used in parallel
+    ;; if needed to do so, do not (delete login-service-type)
+    ;; as illustrated above
+    #| (service mingetty-service-type (mingetty-configuration (tty "tty8"))) |#))
+@end lisp
+@end defvr
+
+@deftp {Data Type} greetd-configuration
+Configuration record for the @code{greetd-service-type}.
+@table @asis
+
+@item @code{motd}
+A file-like object containing the ``message of the day''.
+
+@item @code{allow-empty-passwords?} (default: @code{#t})
+Allow empty passwords by default so that first-time users can log in when
+the 'root' account has just been created.
+
+@item @code{terminals} (default: @code{'()})
+List of @code{greetd-terminal-configuration} per terminal for which
+@code{greetd} should be started.
+@end table
+@end deftp
+
+@deftp {Data Type} greetd-terminal-configuration
+Configuration record for per terminal greetd daemon service.
+
+@table @asis
+@item @code{greetd} (default: @code{greetd})
+The greetd package to use.
+
+@item @code{config-file-name}
+Configuration file name to use for greetd daemon. Generally, autogenerated
+derivation based on @code{terminal-vt} value.
+
+@item @code{terminal-vt} (default: @samp{"7"})
+The VT to run on. Use of a specific VT with appropriate conflict avoidance
+is recommended.
+
+@item @code{terminal-switch} (default: @code{#f})
+Make this terminal active on start of @code{greetd}.
+
+@item @code{default-session-user} (default: @samp{"greeter"})
+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
+@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.
+
+@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.
+
+@item @code{command-args} (default: @code{'("-l")})
+Command arguments to pass to command.
+
+@item @code{extra-env} (default: @code{'()})
+Extra environment variables to set on login.
+
+@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
+are set right after mentioned variables, so that they can be overriden.
+
+@end table
+@end deftp
+
 @node Scheduled Job Execution
 @subsection Scheduled Job Execution
 
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 50865055fe..fe2c4d6fe5 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -16,6 +16,7 @@
 ;;; Copyright © 2021 qblade <qblade@protonmail.com>
 ;;; Copyright © 2021 Hui Lu <luhuins@163.com>
 ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -186,6 +187,11 @@
 
             references-file
 
+            greetd-service-type
+            greetd-configuration
+            greetd-terminal-configuration
+            greetd-agreety-session
+
             %base-services))
 
 ;;; Commentary:
@@ -1401,7 +1407,7 @@ information on the configuration file syntax."
                               (module "pam_limits.so")
                               (arguments '("conf=/etc/security/limits.conf")))))
              (if (member (pam-service-name pam)
-                         '("login" "su" "slim" "gdm-password" "sddm"))
+                         '("login" "greetd" "su" "slim" "gdm-password" "sddm"))
                  (pam-service
                   (inherit pam)
                   (session (cons pam-limits
@@ -2462,6 +2468,216 @@ to handle."
                                            (requirement requirement)
                                            (name-servers name-servers)))))
 
+\f
+;;;
+;;; 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
+  (match-lambda
+    (($ <greetd-agreety-session> _ 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 #$@args)))))))
+
+(define greetd-agreety-tty-xdg-session-command
+  (match-lambda
+    (($ <greetd-agreety-session> _ 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 #$@args)))))))
+
+(define (make-greetd-agreety-session-command config command)
+  (let ((agreety (file-append (greetd-agreety config) "/bin/agreety")))
+    (program-file
+     "agreety-command"
+     #~(execl #$agreety #$agreety "-c" #$command))))
+
+(define (make-greetd-default-session-command config-or-command)
+  (cond ((greetd-agreety-session? config-or-command)
+         (cond ((greetd-agreety-xdg-env? config-or-command)
+                (make-greetd-agreety-session-command
+                 config-or-command
+                 (greetd-agreety-tty-xdg-session-command config-or-command)))
+               (#t
+                (make-greetd-agreety-session-command
+                 config-or-command
+                 (greetd-agreety-tty-session-command config-or-command)))))
+        (#t config-or-command)))
+
+(define-record-type* <greetd-terminal-configuration>
+  greetd-terminal-configuration make-greetd-terminal-configuration
+  greetd-terminal-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"))
+  (terminal-switch greetd-terminal-switch (default #f))
+  (default-session-user greetd-default-session-user (default "greeter"))
+  (default-session-command greetd-default-session-command
+    (default (greetd-agreety-session))
+    (sanitize make-greetd-default-session-command)))
+
+(define (default-config-file-name config)
+  (string-join (list "config-" (greetd-terminal-vt config) ".toml") ""))
+
+(define (make-greetd-terminal-configuration-file config)
+  (let*
+      ((config-file-name (greetd-config-file-name config))
+       (terminal-vt (greetd-terminal-vt config))
+       (terminal-switch (greetd-terminal-switch config))
+       (default-session-user (greetd-default-session-user config))
+       (default-session-command (greetd-default-session-command config)))
+    (mixed-text-file
+     config-file-name
+     "[terminal]\n"
+     "vt = " terminal-vt "\n"
+     "switch = " (if terminal-switch "true" "false") "\n"
+     "[default_session]\n"
+     "user = " default-session-user "\n"
+     "command = " default-session-command "\n")))
+
+(define %greetd-accounts
+  (list (user-account
+         (name "greeter")
+         (group "wheel")
+         (supplementary-groups '("users" "tty" "input" "video" "audio"))
+         (system? #t))))
+
+(define %greetd-file-systems
+  (list (file-system
+          (device "none")
+          (mount-point "/run/greetd/pam_mount")
+          (type "tmpfs")
+          (check? #f)
+          (flags '(no-suid no-dev no-exec))
+          (options "mode=0755")
+          (create-mount-point? #t))))
+
+(define %greetd-pam-mount-rules
+  `((debug (@ (enable "0")))
+    (volume (@ (sgrp "users")
+               (fstype "tmpfs")
+               (mountpoint "/run/user/%(USERUID)")
+               (options "noexec,nosuid,nodev,size=1g,mode=0700,uid=%(USERUID),gid=%(USERGID)")))
+    (logout (@ (wait "0")
+               (hup "0")
+               (term "yes")
+               (kill "no")))
+    (mkmountpoint (@ (enable "1") (remove "true")))))
+
+(define-record-type* <greetd-configuration>
+  greetd-configuration make-greetd-configuration
+  greetd-configuration?
+  (motd greetd-motd (default %default-motd))
+  (allow-empty-passwords? greetd-allow-empty-passwords? (default #t))
+  (terminals greetd-terminals (default '())))
+
+(define (make-greetd-pam-mount-conf-file config)
+  (computed-file
+   "greetd_pam_mount.conf.xml"
+   #~(begin
+       (use-modules (sxml simple))
+       (call-with-output-file #$output
+         (lambda (port)
+           (sxml->xml
+            '(*TOP*
+              (*PI* xml "version='1.0' encoding='utf-8'")
+              (pam_mount
+               #$@%greetd-pam-mount-rules
+               (pmvarrun
+                #$(file-append greetd-pam-mount
+                               "/sbin/pmvarrun -u '%(USER)' -o '%(OPERATION)'"))))
+            port))))))
+
+(define (greetd-etc-service config)
+  `(("security/greetd_pam_mount.conf.xml"
+     ,(make-greetd-pam-mount-conf-file config))))
+
+(define (greetd-pam-service config)
+  (define optional-pam-mount
+    (pam-entry
+     (control "optional")
+     (module #~(string-append #$greetd-pam-mount "/lib/security/pam_mount.so"))
+     (arguments '("disable_interactive"))))
+
+  (list
+   (unix-pam-service "greetd"
+                     #:login-uid? #t
+                     #:allow-empty-passwords?
+                     (greetd-allow-empty-passwords? config)
+                     #:motd
+                     (greetd-motd config))
+   (lambda (pam)
+     (if (member (pam-service-name pam)
+                 '("login" "greetd" "su" "slim" "gdm-password"))
+         (pam-service
+          (inherit pam)
+          (auth (append (pam-service-auth pam)
+                        (list optional-pam-mount)))
+          (session (append (pam-service-session pam)
+                           (list optional-pam-mount))))
+         pam))))
+
+(define (greetd-shepherd-services config)
+  (map
+   (lambda (tc)
+     (let*
+         ((greetd-bin (file-append (greetd-package tc) "/sbin/greetd"))
+          (greetd-conf (make-greetd-terminal-configuration-file tc))
+          (greetd-vt (greetd-terminal-vt tc)))
+       (shepherd-service
+        (documentation "Minimal and flexible login manager daemon")
+        (requirement '(user-processes host-name udev virtual-terminal))
+        (provision (list (symbol-append
+                          'term-tty
+                          (string->symbol (greetd-terminal-vt tc)))))
+        (start #~(make-forkexec-constructor
+                  (list #$greetd-bin "-c" #$greetd-conf)
+                  #:log-file
+                  (string-append "/tmp/greetd." #$greetd-vt ".log")))
+        (stop #~(make-kill-destructor)))))
+   (greetd-terminals config)))
+
+(define greetd-service-type
+  (service-type
+   (name 'greetd)
+   (description "Provides necessary infrastructure for logging into the
+system including @code{greetd} PAM service, @code{pam-mount} module to
+mount/unmount /run/user/<uid> directory for user and @code{greetd}
+login manager daemon.")
+   (extensions
+    (list
+     (service-extension account-service-type (const %greetd-accounts))
+     (service-extension file-system-service-type (const %greetd-file-systems))
+     (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)))
+   (default-value (greetd-configuration))))
+
 \f
 (define %base-services
   ;; Convenience variable holding the basic services.
diff --git a/gnu/services/pam-mount.scm b/gnu/services/pam-mount.scm
index 98611462c2..d6c65e3760 100644
--- a/gnu/services/pam-mount.scm
+++ b/gnu/services/pam-mount.scm
@@ -90,7 +90,7 @@
      (module #~(string-append #$pam-mount "/lib/security/pam_mount.so"))))
   (list (lambda (pam)
           (if (member (pam-service-name pam)
-                      '("login" "su" "slim" "gdm-password"))
+                      '("login" "greetd" "su" "slim" "gdm-password"))
               (pam-service
                (inherit pam)
                (auth (append (pam-service-auth pam)
-- 
2.33.0

[bug#49969] [PATCH v8 5/7] gnu: admin: Add libseat 0.6.2 and move seatd.

[muradm]

* gnu/packages/admin.scm (libseat): New variable
* gnu/packages/admin.scm (seatd): New variable
* gnu/packages/freedesktop.scm (seatd): Remove variable
---
 gnu/packages/admin.scm       | 53 ++++++++++++++++++++++++++++++++++++
 gnu/packages/freedesktop.scm | 30 --------------------
 2 files changed, 53 insertions(+), 30 deletions(-)

diff --git a/gnu/packages/admin.scm b/gnu/packages/admin.scm
index e46d21844b..c5b719996f 100644
--- a/gnu/packages/admin.scm
+++ b/gnu/packages/admin.scm
@@ -45,6 +45,7 @@
 ;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
 ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
+;;; Copyright © 2021 pineapples <guixuser6392@protonmail.com>
 ;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -99,6 +100,7 @@
   #:use-module (gnu packages elf)
   #:use-module (gnu packages file)
   #:use-module (gnu packages flex)
+  #:use-module (gnu packages freedesktop)
   #:use-module (gnu packages gawk)
   #:use-module (gnu packages gettext)
   #:use-module (gnu packages gl)
@@ -4817,6 +4819,57 @@ setup, maintenance, supervision, or any long-running processes.")
 FIFO and UNIX interprocess communication.")
       (license license:bsd-2))))
 
+(define-public libseat
+  (package
+    (name "libseat")
+    (version "0.6.2")
+    (source (origin
+              (method git-fetch)
+              (uri (git-reference
+                    (url "https://git.sr.ht/~kennylevinsen/seatd")
+                    (commit version)))
+              (file-name (git-file-name name version))
+              (sha256
+               (base32
+                "0c07i1nq0k60xmcsnr37ryqs7nzbg4qfq6fzbnzwbh1yhr8kypcm"))))
+    (build-system meson-build-system)
+    (arguments
+     `(#:configure-flags '("-Dlibseat-logind=elogind"
+                           "-Dserver=disabled")))
+    (native-inputs
+     `(("pkg-config" ,pkg-config)))
+    (propagated-inputs
+     `(("elogind" ,elogind)))
+    (home-page "https://sr.ht/~kennylevinsen/seatd")
+    (synopsis "Seat management library")
+    (description
+     "This package provides a universal seat management library that
+allows applications to use whatever seat management is available.")
+    (license license:expat)))
+
+(define-public seatd
+  (package
+    (inherit libseat)
+    (name "seatd")
+    (arguments
+     `(#:configure-flags '("-Dlibseat-logind=elogind")
+       #:phases
+       (modify-phases %standard-phases
+         (add-after 'install 'remove-libs
+           (lambda* (#:key outputs #:allow-other-keys)
+             (with-directory-excursion (assoc-ref outputs "out")
+               (for-each delete-file-recursively '("lib" "include"))))))))
+    (native-inputs
+     `(("pkg-config" ,pkg-config)
+       ("scdoc" ,scdoc)))
+    (inputs '())
+    (synopsis "Seat management daemon")
+    (description
+     "This package provides a minimal seat management daemon whose task is to
+mediate access to shared devices, such as graphics and input, for applications
+that require it.")
+    (license license:expat)))
+
 (define-public greetd
   (package
     (name "greetd")
diff --git a/gnu/packages/freedesktop.scm b/gnu/packages/freedesktop.scm
index 85d9697460..d7b411b5d1 100644
--- a/gnu/packages/freedesktop.scm
+++ b/gnu/packages/freedesktop.scm
@@ -834,36 +834,6 @@ GNOME Shell.  The @command{localectl} command-line tool allows you to interact
 with localed.  This package is extracted from the broader systemd package.")
     (license license:lgpl2.1+)))
 
-(define-public seatd
-  (package
-    (name "seatd")
-    (version "0.5.0")
-    (source (origin
-              (method git-fetch)
-              (uri (git-reference
-                    (url "https://git.sr.ht/~kennylevinsen/seatd")
-                    (commit version)))
-              (file-name (git-file-name name version))
-              (sha256
-               (base32
-                "1kglq8v4rnr3415mfaghyv2s2f8mxsy5s881gmm2908ig4n4j297"))))
-    (build-system meson-build-system)
-    (arguments
-     `(#:configure-flags '("-Dlogind=enabled")))
-    (native-inputs
-     `(("pkg-config" ,pkg-config)
-       ("scdoc" ,scdoc)))
-    (inputs
-     `(("elogind" ,elogind)))
-    (home-page "https://sr.ht/~kennylevinsen/seatd")
-    (synopsis "Seat management daemon and library")
-    (description
-     "This package provides a minimal seat management daemon whose task is to
-mediate access to shared devices, such as graphics and input, for applications
-that require it.  It also provides a universal seat management library that
-allows applications to use whatever seat management is available.")
-    (license license:expat)))
-
 (define-public packagekit
   (package
     (name "packagekit")
-- 
2.33.0

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

[muradm]

* gnu/services/desktop.scm (seatd-service-type): New variable
* gnu/services/desktop.scm (seatd-configuration): New data type
---
 doc/guix.texi            | 42 ++++++++++++++++++++++++++++
 gnu/services/desktop.scm | 60 +++++++++++++++++++++++++++++++++++++++-
 2 files changed, 101 insertions(+), 1 deletion(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index c641ffc453..764355c69f 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -20110,6 +20110,48 @@ and ``passwd'' is with the value @code{passwd}.
 @end table
 @end deftp
 
+@defvr {Scheme Variable} seatd-service-type
+@uref{https://sr.ht/~kennylevinsen/seatd/, seatd} is a minimal seat
+management daemon.
+
+Seat management takes care of mediating access to shared devices (graphics,
+input), without requiring the applications needing access to be root.
+
+@lisp
+(append
+  (list
+   ;; make sure seatd is running
+   (service seatd-service-type))
+
+  ;; normally one would want %base-services
+  %base-services)
+
+@end lisp
+@end defvr
+
+@deftp {Data Type} seatd-configuration
+Configuration record for the seatd daemon service.
+
+@table @asis
+@item @code{seatd} (default: @code{seatd})
+The seatd package to use.
+
+@item @code{user} (default: @samp{"root"})
+User to own the seatd socket.
+
+@item @code{group} (default: @samp{"users"})
+Group to own the seatd socket.
+
+@item @code{socket} (default: @samp{"/run/seatd.sock"})
+Where to create the seatd socket.
+
+@item @code{loglevel} (default: @samp{"error"})
+Log level to output logs. Possible values: @samp{"silent"}, @samp{"error"},
+@samp{"info"} and @samp{"debug"}.
+
+@end table
+@end deftp
+
 
 @node Sound Services
 @subsection Sound Services
diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index 64d0e85301..c42db5987e 100644
--- a/gnu/services/desktop.scm
+++ b/gnu/services/desktop.scm
@@ -13,6 +13,7 @@
 ;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2020 Reza Alizadeh Majd <r.majd@pantherx.org>
 ;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -39,7 +40,9 @@
   #:use-module (gnu services networking)
   #:use-module (gnu services sound)
   #:use-module ((gnu system file-systems)
-                #:select (%elogind-file-systems file-system))
+                #:select (%control-groups
+                          %elogind-file-systems
+                          file-system))
   #:use-module (gnu system)
   #:use-module (gnu system setuid)
   #:use-module (gnu system shadow)
@@ -154,6 +157,9 @@
             gnome-keyring-configuration?
             gnome-keyring-service-type
 
+            seatd-configuration
+            seatd-service-type
+
             %desktop-services))
 
 ;;; Commentary:
@@ -1182,6 +1188,58 @@ or setting its password with passwd.")))
 (define polkit-wheel-service
   (simple-service 'polkit-wheel polkit-service-type (list polkit-wheel)))
 
+\f
+;;;
+;;; seatd-service-type -- minimal seat management daemon
+;;;
+
+(define-record-type* <seatd-configuration> seatd-configuration
+  make-seatd-configuration
+  seatd-configuration?
+  (seatd seatd-package (default seatd))
+  (user seatd-user (default "root"))
+  (group seatd-group (default "users"))
+  (socket seatd-socket (default "/run/seatd.sock"))
+  (loglevel seatd-loglevel (default "error")))
+
+(define (seatd-shepherd-service config)
+  (list (shepherd-service
+         (documentation "Minimal seat management daemon")
+         (requirement '())
+         ;; TODO: once cgroups is separate dependency
+         ;; here we should depend on it rather than elogind
+         (provision '(seatd elogind))
+         (start #~(make-forkexec-constructor
+                   (list #$(file-append (seatd-package config) "/bin/seatd")
+                         "-u" #$(seatd-user config)
+                         "-g" #$(seatd-group config)
+                         "-s" #$(seatd-socket config))
+                   #:environment-variables
+                   (list (string-append "SEATD_LOGLEVEL="
+                                        #$(seatd-loglevel config)))
+                   #:log-file "/tmp/seatd.log"))
+         (stop #~(make-kill-destructor)))))
+
+(define seatd-environment
+  (match-lambda
+    (($ <seatd-configuration> _ _ _ socket)
+     `(("SEATD_SOCK" . ,socket)))))
+
+(define seatd-service-type
+  (service-type
+   (name 'seatd)
+   (description "Seat management takes care of mediating access
+to shared devices (graphics, input), without requiring the
+applications needing access to be root.")
+   (extensions
+    (list
+     (service-extension session-environment-service-type seatd-environment)
+     ;; TODO: once cgroups is separate dependency we should not mount it here
+     ;; for now it is mounted here, because elogind mounts it
+     (service-extension file-system-service-type (const %control-groups))
+     (service-extension shepherd-root-service-type seatd-shepherd-service)))
+   (default-value (seatd-configuration))))
+
 \f
 ;;;
 ;;; The default set of desktop services.
-- 
2.33.0

[bug#49969] [PATCH v8 7/7] gnu: tests: Add seatd/greetd based minimal desktop system tests.

[muradm]

* gnu/tests/desktop.scm (minimal-desktop): seatd/greetd based
minimal desktop test
---
 gnu/tests/desktop.scm | 212 +++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 211 insertions(+), 1 deletion(-)

diff --git a/gnu/tests/desktop.scm b/gnu/tests/desktop.scm
index 6aa22fd49b..50aa859869 100644
--- a/gnu/tests/desktop.scm
+++ b/gnu/tests/desktop.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -18,13 +19,17 @@
 
 (define-module (gnu tests desktop)
   #:use-module (gnu tests)
+  #:use-module (gnu packages shells)
   #:use-module (gnu services)
+  #:use-module (gnu services base)
   #:use-module (gnu services dbus)
   #:use-module (gnu services desktop)
+  #:use-module (gnu system)
   #:use-module (gnu system vm)
   #:use-module (guix gexp)
   #:use-module (srfi srfi-1)
-  #:export (%test-elogind))
+  #:export (%test-elogind
+            %test-minimal-desktop))
 
 \f
 ;;;
@@ -103,3 +108,208 @@
                #:imported-modules '((gnu services herd)
                                     (guix combinators)))))
       (run-elogind-test (virtual-machine os))))))
+
+\f
+;;;
+;;; Seatd/greetd based minimal desktop
+;;;
+
+(define %minimal-services
+  (append
+   (modify-services %base-services
+     ;; greetd-service-type provides "greetd" PAM service
+     (delete login-service-type)
+     ;; and can be used in place of mingetty-service-type
+     (delete mingetty-service-type))
+   (list
+    (service seatd-service-type)
+    (service greetd-service-type
+             (greetd-configuration
+              (terminals
+               (list
+                ;; we can make any terminal active by default
+                (greetd-terminal-configuration (terminal-vt "1") (terminal-switch #t))
+                ;; we can make environment without XDG_RUNTIME_DIR set
+                ;; even provide our own environment variables
+                (greetd-terminal-configuration
+                 (terminal-vt "2")
+                 (default-session-command
+                   (greetd-agreety-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")))))
+                ;; we can use any other executable command as greeter
+                (greetd-terminal-configuration
+                 (terminal-vt "4")
+                 (default-session-command (program-file "my-noop-greeter" #~(exit))))
+                (greetd-terminal-configuration (terminal-vt "5"))
+                (greetd-terminal-configuration (terminal-vt "6"))))))
+    ;; mingetty-service-type can be used in parallel
+    ;; if needed to do so, do not (delete login-service-type)
+    ;; as illustrated above
+    #| (service mingetty-service-type (mingetty-configuration (tty "tty8"))) |#)))
+
+(define-syntax-rule (minimal-operating-system user-services ...)
+  "Return an operating system that includes USER-SERVICES in addition to
+minimal %BASE-SERVICES."
+  (operating-system (inherit %simple-os)
+                    (services (cons* user-services ... %minimal-services))))
+
+(define (run-minimal-desktop-test os vm)
+  (define test
+    (with-imported-modules '((gnu build marionette)
+                             (guix build syscalls))
+      #~(begin
+          (use-modules (gnu build marionette)
+                       (guix build syscalls)
+                       (srfi srfi-1)
+                       (srfi srfi-64)
+                       (ice-9 pretty-print))
+
+          (define marionette
+            (make-marionette #$vm))
+
+          (define (file-get-all-strings fname)
+            (marionette-eval '(use-modules (rnrs io ports)) marionette)
+            (wait-for-file fname marionette #:read 'get-string-all))
+
+          (define (wait-for-unix-socket-m socket)
+            (wait-for-unix-socket socket marionette))
+
+          (mkdir #$output)
+          (chdir #$output)
+
+          (test-begin "minimal-desktop")
+
+          (test-assert "seatd is ready"
+            (wait-for-unix-socket-m "/run/seatd.sock"))
+
+          (test-equal "login user on tty1"
+            "alice\n"
+            (begin
+              ;; Wait for tty1.
+              (marionette-eval
+               '(begin
+                  (use-modules (gnu services herd))
+                  (start-service 'term-tty1))
+               marionette)
+              (marionette-control "sendkey ctrl-alt-f1" marionette)
+
+              ;; login as root change alice password and exit
+              ;; then login as alice
+              (for-each
+               (lambda (cmd) (marionette-type cmd marionette) (sleep 1))
+               (list
+                "root\n"
+                "passwd alice\n"
+                "alice\n"
+                "alice\n"
+                "exit\n"
+                "alice\n"
+                "alice\n"
+                "id -un > logged-in\n"))
+
+              (file-get-all-strings "/home/alice/logged-in")))
+
+          (test-equal "validate user environment"
+            '("SEATD_SOCK=/run/seatd.sock"
+              "XDG_RUNTIME_DIR=/run/user/1000"
+              "XDG_SEAT=seat0"
+              "XDG_VTNR=1")
+
+            (begin
+              (marionette-type "env > env\n" marionette)
+              (sleep 1)
+
+              (define user-env (string-tokenize
+                                (file-get-all-strings "/home/alice/env")))
+
+              (define (expected-var var)
+                (any (lambda (s) (string-contains var s))
+                     '("SEATD_SOCK"
+                       "XDG_RUNTIME_DIR"
+                       "XDG_SEAT"
+                       "XDG_VTNR")))
+
+              (sort (filter expected-var user-env) string<?)))
+
+          (test-assert "validate SEATD_SOCK and GREETD_SOCK"
+            (begin
+              (marionette-type "env > env\n" marionette)
+              (sleep 1)
+
+              (define (sock-var? var)
+                (any (lambda (s) (string-contains var s))
+                     '("SEATD_SOCK" "GREETD_SOCK")))
+
+              (define (sock-var-sock var)
+                (car (cdr (string-split var #\=))))
+
+              (let*
+                  ((out (file-get-all-strings "/home/alice/env"))
+                   (out (string-tokenize out))
+                   (out (filter sock-var? out))
+                   (socks (map sock-var-sock out))
+                   (socks (map wait-for-unix-socket-m socks)))
+                (and (= 2 (length socks)) (every identity socks)))))
+
+          (test-assert "greetd is ready"
+            (begin
+              (marionette-type "ps -C greetd -o pid,args --no-headers > ps-greetd\n"
+                               marionette)
+              (sleep 1)
+
+              (define (greetd-daemon? cmd)
+                (string-contains cmd "config"))
+
+              (define (greetd-cmd-to-pid cmd)
+                (car (string-split cmd #\space)))
+
+              (define (greetd-pid-to-sock pid)
+                (string-append "/run/greetd-" pid ".sock"))
+
+              (let* ((out (file-get-all-strings "/home/alice/ps-greetd"))
+                     (out (string-split out #\newline))
+                     (out (map string-trim-both out))
+                     (out (filter greetd-daemon? out))
+                     (pids (map greetd-cmd-to-pid out))
+                     (socks (map greetd-pid-to-sock pids))
+                     (socks (map wait-for-unix-socket-m socks)))
+                (every identity socks))))
+
+          ;; a bit weak, but tests everything at once actually
+          (test-equal "check /run/user/<uid> mounted and writable"
+            "alice\n"
+            (begin
+              (marionette-type "echo alice > /run/user/1000/test\n" marionette)
+              (file-get-all-strings "/run/user/1000/test")))
+
+          (test-assert "screendump"
+            (begin
+              (marionette-control (string-append "screendump " #$output
+                                                 "/tty1.ppm")
+                                  marionette)
+              (file-exists? "tty1.ppm")))
+
+          (test-end)
+          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+  (gexp->derivation "minimal-desktop" test))
+
+(define %test-minimal-desktop
+  (system-test
+   (name "minimal-desktop")
+   (description
+    "Test whether we can log in when seatd and greetd is enabled")
+   (value
+    (let* ((os (marionette-operating-system
+                (minimal-operating-system)
+                #:imported-modules '((gnu services herd)
+                                     (guix combinators))))
+           (vm (virtual-machine os)))
+      (run-minimal-desktop-test (virtualized-operating-system os '())
+                                #~(list #$vm))))))
-- 
2.33.0

[bug#49969] [PATCH v8 5/7] gnu: admin: Add libseat 0.6.2 and move seatd.

[Leo Famulari]

On Thu, Sep 16, 2021 at 10:47:26PM +0300, muradm wrote:
> * gnu/packages/admin.scm (libseat): New variable
> * gnu/packages/admin.scm (seatd): New variable
> * gnu/packages/freedesktop.scm (seatd): Remove variable

Thanks for working on these patches!

I just applied them to the current master branch and tried building all
the new packages, but libseat fails to build like this:

------
starting phase `configure'
The Meson build system
Version: 0.53.2
Source dir: /tmp/guix-build-libseat-0.6.2.drv-0/source
Build dir: /tmp/guix-build-libseat-0.6.2.drv-0/build
Build type: native build

meson.build:1:0: ERROR: Meson version is 0.53.2 but project requires >=0.56.0

A full log can be found at /tmp/guix-build-libseat-0.6.2.drv-0/build/meson-logs/meson-log.txt
command "meson" "--prefix=/gnu/store/4dazksqkz5yn77570jc2cmnlyfc9gikv-libseat-0.6.2" "--buildtype=debugoptimized" "-Dc_link_args=-Wl,-rpath=/gnu/store/4dazksqkz5yn77570jc2cmnlyfc9gikv-libseat-0.6.2/lib" "-Dcpp_link_args=-Wl,-rpath=/gnu/store/4dazksqkz5yn77570jc2cmnlyfc9gikv-libseat-0.6.2/lib" "-Dlibseat-logind=elogind" "-Dserver=disabled" "/tmp/guix-build-libseat-0.6.2.drv-0/source" failed with status 1
builder for `/gnu/store/l2rf97zgwwp7ccvl1wn9g7qm0w7aj4d1-libseat-0.6.2.drv' failed with exit code 1
build of /gnu/store/l2rf97zgwwp7ccvl1wn9g7qm0w7aj4d1-libseat-0.6.2.drv failed
View build log at '/var/log/guix/drvs/l2/rf97zgwwp7ccvl1wn9g7qm0w7aj4d1-libseat-0.6.2.drv.bz2'.
guix build: error: build of `/gnu/store/l2rf97zgwwp7ccvl1wn9g7qm0w7aj4d1-libseat-0.6.2.drv' failed
------

Sorry if I forgot about how to apply the patch series... does it need to
go on another branch besides master?

[bug#49969] [PATCH v8 5/7] gnu: admin: Add libseat 0.6.2 and move seatd.

[muradm]

Hi,

Ah yes, on master you will need to set:

    (arguments
     `(#:meson ,meson-next

I was testing the patches on both core-updates-frozen and master. 
For me both
braches was applicable without change. Except on master, meson 
should be next.
Sorry for forgetting that.

Thanks in advance,
muradm

Leo Famulari <leo@famulari.name> writes:

> On Thu, Sep 16, 2021 at 10:47:26PM +0300, muradm wrote:
>> * gnu/packages/admin.scm (libseat): New variable
>> * gnu/packages/admin.scm (seatd): New variable
>> * gnu/packages/freedesktop.scm (seatd): Remove variable
>
> Thanks for working on these patches!
>
> I just applied them to the current master branch and tried 
> building all
> the new packages, but libseat fails to build like this:
>
> ------
> starting phase `configure'
> The Meson build system
> Version: 0.53.2
> Source dir: /tmp/guix-build-libseat-0.6.2.drv-0/source
> Build dir: /tmp/guix-build-libseat-0.6.2.drv-0/build
> Build type: native build
>
> meson.build:1:0: ERROR: Meson version is 0.53.2 but project 
> requires >=0.56.0
>
> A full log can be found at
> /tmp/guix-build-libseat-0.6.2.drv-0/build/meson-logs/meson-log.txt
> command "meson"
> "--prefix=/gnu/store/4dazksqkz5yn77570jc2cmnlyfc9gikv-libseat-0.6.2"
> "--buildtype=debugoptimized"
> "-Dc_link_args=-Wl,-rpath=/gnu/store/4dazksqkz5yn77570jc2cmnlyfc9gikv-libseat-0.6.2/lib"
> "-Dcpp_link_args=-Wl,-rpath=/gnu/store/4dazksqkz5yn77570jc2cmnlyfc9gikv-libseat-0.6.2/lib"
> "-Dlibseat-logind=elogind" "-Dserver=disabled"
> "/tmp/guix-build-libseat-0.6.2.drv-0/source" failed with status 
> 1
> builder for
> `/gnu/store/l2rf97zgwwp7ccvl1wn9g7qm0w7aj4d1-libseat-0.6.2.drv' 
> failed
> with exit code 1
> build of 
> /gnu/store/l2rf97zgwwp7ccvl1wn9g7qm0w7aj4d1-libseat-0.6.2.drv 
> failed
> View build log at
> '/var/log/guix/drvs/l2/rf97zgwwp7ccvl1wn9g7qm0w7aj4d1-libseat-0.6.2.drv.bz2'.
> guix build: error: build of
> `/gnu/store/l2rf97zgwwp7ccvl1wn9g7qm0w7aj4d1-libseat-0.6.2.drv' 
> failed
> ------
>
> Sorry if I forgot about how to apply the patch series... does it 
> need to
> go on another branch besides master?

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

[norgli via Guix-patches via]

[-- Attachment #1: Type: text/plain, Size: 294 bytes --]

Hello,
I would be looking to use this, seems unfortunate the merge has halted at a very advanced point -- any chance it gets picked up again? :)
Would be trying to package the QtGreet application that i use on my other system/partition, if it was.
Thanks,
Florian
(@florhizom:matrix.org on irc)

[-- Attachment #2: Type: text/html, Size: 332 bytes --]

[bug#49969] [PATCH v9 1/7] gnu: crates-io: Add rust-enquote 1.1.0 and rust-pam-sys 0.5.6.

[Hilton Chain via Guix-patches via]

* gnu/packages/crates-io.scm (rust-enquote-1): New variable
* gnu/packages/crates-io.scm (rust-pam-sys-0.5): New variable

Signed-off-by: Hilton Chain <hako@ultrarare.space>
---
 gnu/packages/crates-io.scm | 40 ++++++++++++++++++++++++++++++++++++++
 1 file changed, 40 insertions(+)

diff --git a/gnu/packages/crates-io.scm b/gnu/packages/crates-io.scm
index 86313f5e4fd3..9374601bb4f3 100644
--- a/gnu/packages/crates-io.scm
+++ b/gnu/packages/crates-io.scm
@@ -19,6 +19,7 @@
 ;;; Copyright © 2021 Antero Mejr <antero@kodmin.com>
 ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2021 Vinicius Monego <monego@posteo.net>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;; Copyright © 2021, 2022 Petr Hodina <phodina@protonmail.com>
 ;;; Copyright © 2021, 2022 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2021 Jacob Hrbek <kreyren@rixotstudio.cz>
@@ -73053,3 +73054,42 @@ (define-public rust-shell2batch-0.4
 and automatically convert it to a windows batch file, this library provides a
 way to convert simple shell commands to windows batch commands.")
     (license license:asl2.0)))
+
+(define-public rust-enquote-1
+  (package
+    (name "rust-enquote")
+    (version "1.1.0")
+    (home-page "https://github.com/reujab/enquote")
+    (source (origin
+              (method url-fetch)
+              (uri (crate-uri "enquote" version))
+              (file-name (string-append name "-" version ".tar.gz"))
+              (sha256
+               (base32
+                "0clrjghlfkkb7sndabs5wch0fz2nif6nj4b117s8kqxx3nqnrhq6"))))
+    (build-system cargo-build-system)
+    (synopsis "Rust library that quotes, unquotes, and unescapes strings")
+    (description "A Rust library quotes, unquotes, and unescapes strings")
+    (license license:unlicense)))
+
+(define-public rust-pam-sys-0.5
+  (package
+    (name "rust-pam-sys")
+    (version "0.5.6")
+    (home-page "https://github.com/1wilkens/pam-sys")
+    (source (origin
+              (method url-fetch)
+              (uri (crate-uri "pam-sys" version))
+              (file-name (string-append name "-" version ".tar.gz"))
+              (sha256
+               (base32
+                "0d14501d5vybjnzxfjf96321xa5wa36x1xvf02h02zq938qmhj6d"))))
+    (build-system cargo-build-system)
+    (arguments
+     `(#:cargo-inputs (("rust-libc" ,rust-libc-0.2))))
+    (native-inputs `(("linux-pam" ,linux-pam)))
+    (synopsis
+     "Rust FFI wrappers for the Linux Pluggable Authentication Modules (PAM)")
+    (description
+     "Rust FFI wrappers for the Linux Pluggable Authentication Modules (PAM)")
+    (license (list license:expat license:asl2.0))))
-- 
2.36.1

[bug#49969] [PATCH 2/7] gnu: admin: Add greetd 0.8.0.

[Hilton Chain via Guix-patches via]

* gnu/packages/admin.scm (greetd): New variable

Signed-off-by: Hilton Chain <hako@ultrarare.space>
---
 gnu/packages/admin.scm | 80 ++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 80 insertions(+)

diff --git a/gnu/packages/admin.scm b/gnu/packages/admin.scm
index 92ee007729ee..d94b113d4e24 100644
--- a/gnu/packages/admin.scm
+++ b/gnu/packages/admin.scm
@@ -45,6 +45,7 @@
 ;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
 ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;; Copyright © 2021 Petr Hodina <phodina@protonmail.com>
 ;;; Copyright © 2021 Artyom V. Poptsov <poptsov.artyom@gmail.com>
 ;;; Copyright © 2022 Wamm K. D. <jaft.r@outlook.com>
@@ -65,6 +66,7 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu packages admin)
+  #:use-module (guix build-system cargo)
   #:use-module (guix build-system cmake)
   #:use-module (guix build-system emacs)
   #:use-module (guix build-system glib-or-gtk)
@@ -92,6 +94,7 @@ (define-module (gnu packages admin)
   #:use-module (gnu packages c)
   #:use-module (gnu packages check)
   #:use-module (gnu packages compression)
+  #:use-module (gnu packages crates-io)
   #:use-module (gnu packages cross-base)
   #:use-module (gnu packages crypto)
   #:use-module (gnu packages cryptsetup)
@@ -100,6 +103,7 @@ (define-module (gnu packages admin)
   #:use-module (gnu packages elf)
   #:use-module (gnu packages file)
   #:use-module (gnu packages flex)
+  #:use-module (gnu packages freedesktop)
   #:use-module (gnu packages gawk)
   #:use-module (gnu packages gettext)
   #:use-module (gnu packages gl)
@@ -4972,4 +4976,80 @@ (define-public udpcast
     (home-page "https://www.udpcast.linux.lu")
     (license license:gpl2+)))
 
+(define-public greetd
+  (package
+    (name "greetd")
+    (version "0.8.0")
+    (home-page "https://git.sr.ht/~kennylevinsen/greetd")
+    (source (origin
+              (method git-fetch)
+              (uri (git-reference
+                    (url home-page)
+                    (commit version)))
+              (file-name (git-file-name name version))
+              (sha256
+               (base32
+                "0x5c3jkw09kvj2grcxm899y2n6ws8p990cyp9cs0fy6lm4fzlh6v"))))
+    (build-system cargo-build-system)
+    (arguments
+     `(#:cargo-inputs (("rust-nix" ,rust-nix-0.19) ("rust-pam-sys" ,rust-pam-sys-0.5)
+                       ("rust-rpassword" ,rust-rpassword-5)
+                       ("rust-users" ,rust-users-0.11)
+                       ("rust-serde" ,rust-serde-1)
+                       ("rust-serde-json" ,rust-serde-json-1)
+                       ("rust-libc" ,rust-libc-0.2)
+                       ("rust-tokio" ,rust-tokio-1)
+                       ("rust-getopts" ,rust-getopts-0.2)
+                       ("rust-thiserror" ,rust-thiserror-1)
+                       ("rust-async-trait" ,rust-async-trait-0.1)
+                       ("rust-enquote" ,rust-enquote-1))
+       #:phases
+       (modify-phases %standard-phases
+         (delete 'package)
+         (add-after 'build 'build-man-pages
+           (lambda* (#:key inputs #:allow-other-keys)
+             (define (scdoc-cmd doc lvl)
+               (system (string-append "scdoc < "
+                                      doc
+                                      "-"
+                                      lvl
+                                      ".scd > "
+                                      doc
+                                      "."
+                                      lvl)))
+             (with-directory-excursion "man"
+                                       (scdoc-cmd "greetd" "1")
+                                       (scdoc-cmd "greetd" "5")
+                                       (scdoc-cmd "greetd-ipc" "7")
+                                       (scdoc-cmd "agreety" "1"))))
+         (replace 'install
+           (lambda* (#:key inputs outputs #:allow-other-keys)
+             (let* ((out (assoc-ref outputs "out")) (bin (string-append out
+                                                          "/bin"))
+                    (sbin (string-append out "/sbin"))
+                    (share (string-append out "/share"))
+                    (man (string-append share "/man"))
+                    (man1 (string-append man "/man1"))
+                    (man5 (string-append man "/man5"))
+                    (man7 (string-append man "/man7"))
+                    (release "target/release")
+                    (greetd-bin (string-append release "/greetd"))
+                    (agreety-bin (string-append release "/agreety")))
+               (install-file greetd-bin sbin)
+               (install-file agreety-bin bin)
+               (with-directory-excursion "man"
+                                         (install-file "greetd.1" man1)
+                                         (install-file "greetd.5" man5)
+                                         (install-file "greetd-ipc.7" man7)
+                                         (install-file "agreety.1" man1))))))))
+    (native-inputs `(("linux-pam" ,linux-pam) ("scdoc" ,scdoc)))
+    (synopsis "Minimal and flexible login manager daemon")
+    (description
+     "greetd is a minimal and flexible login manager daemon
+that makes no assumptions about what you want to launch.
 
+If you can run it from your shell in a TTY, greetd can start it.
+
+If it can be taught to speak a simple JSON-based IPC protocol,
+then it can be a greeter.")
+    (license license:gpl3+)))
-- 
2.36.1

[bug#49969] [PATCH v9 3/7] gnu: admin: Add greetd-pam-mount.

[Hilton Chain via Guix-patches via]

* gnu/packages/admin.scm (greetd-pam-mount): New variable

Signed-off-by: Hilton Chain <hako@ultrarare.space>
---
 gnu/packages/admin.scm | 32 ++++++++++++++++++++++++++++++++
 1 file changed, 32 insertions(+)

diff --git a/gnu/packages/admin.scm b/gnu/packages/admin.scm
index d94b113d4e24..7095259ff9b0 100644
--- a/gnu/packages/admin.scm
+++ b/gnu/packages/admin.scm
@@ -5053,3 +5053,35 @@ (define-public greetd
 If it can be taught to speak a simple JSON-based IPC protocol,
 then it can be a greeter.")
     (license license:gpl3+)))
+
+(define-public greetd-pam-mount
+  (package
+    (inherit pam-mount)
+    (name "greetd-pam-mount")
+    (arguments
+     (substitute-keyword-arguments (package-arguments pam-mount)
+       ((#:configure-flags flags ''())
+        `(cons* "--with-rundir=/run/greetd" ,flags))
+       ((#:phases phases)
+        `(modify-phases ,phases
+           (add-after 'unpack 'patch-config-file-name
+             (lambda* (#:key inputs #:allow-other-keys)
+               (substitute* "src/pam_mount.c"
+                 ((".*define CONFIGFILE .*$")
+                  "#define CONFIGFILE \"/etc/security/greetd_pam_mount.conf.xml\"\n")
+                 (("pam_mount_config") "greetd_pam_mount_config")
+                 (("pam_mount_system_authtok") "greetd_pam_mount_system_authtok"))))))))
+    (synopsis "pam-mount specifically compiled for use with greetd")
+    (description
+     "Pam-mount is a PAM module that can mount volumes when a user logs in.
+It supports mounting local filesystems of any kind the normal mount utility
+supports.  It can also mount encrypted LUKS volumes using the password
+supplied by the user when logging in.
+
+This package inherits pam-mount in the way that it is compiled specifically
+for use with greetd daemon. It uses different configuration location and
+name space for storing data in PAM.
+
+greetd-pam-mount is used in configuration of greetd to provide
+auto-(mounting/unmounting) of XDG_RUNTIME_DIR in the way that it will not
+interfere with default pam-mount configuration.")))
-- 
2.36.1

[bug#49969] [PATCH v9 4/7] gnu: base: Add greetd-service-type.

[Hilton Chain via Guix-patches via]

* gnu/services/base.scm (greetd-service-type): New variable
* gnu/services/base.scm (greetd-configuration): New data type
* gnu/services/base.scm (greetd-terminal-configuration): New data type
* gnu/services/base.scm (greetd-agreety-session): New data type
* gnu/services/base.scm (pam-limits-service-type): Shoul be aware of
greetd PAM service
* gnu/services/pam-mount.scm (pam-mount-pam-service): Shoul be aware
of greetd PAM service

Signed-off-by: Hilton Chain <hako@ultrarare.space>
---
 doc/guix.texi              | 133 ++++++++++++++++++++++
 gnu/services/base.scm      | 218 ++++++++++++++++++++++++++++++++++++-
 gnu/services/pam-mount.scm |   2 +-
 3 files changed, 351 insertions(+), 2 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 2bfff7c2ff9e..825c7d93c577 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -96,6 +96,7 @@
 Copyright @copyright{} 2021 Hui Lu@*
 Copyright @copyright{} 2021 pukkamustard@*
 Copyright @copyright{} 2021 Alice Brenon@*
+Copyright @copyright{} 2021 muradm@*
 Copyright @copyright{} 2021 Josselin Poiret@*
 Copyright @copyright{} 2021 Andrew Tropin@*
 Copyright @copyright{} 2021 Sarah Morgensen@*
@@ -18018,6 +18019,138 @@ Base Services
 @samp{pam_limits} man page from the @code{linux-pam} package.
 @end deffn
 
+@defvr {Scheme Variable} greetd-service-type
+@uref{https://git.sr.ht/~kennylevinsen/greetd, @code{greetd}} is a minimal and
+flexible login manager daemon, that makes no assumptions about what you
+want to launch.
+
+If you can run it from your shell in a TTY, greetd can start it. If it
+can be taught to speak a simple JSON-based IPC protocol, then it can be
+a geeter.
+
+@code{greetd-service-type} provides necessary infrastructure for logging
+in users, including:
+
+@itemize @bullet
+@item
+@code{greetd} PAM service
+
+@item
+Special variation of @code{pam-mount} to mount @code{XDG_RUNTIME_DIR}
+@end itemize
+
+Here is example of switching from @code{mingetty-service-type} to
+@code{greetd-service-type}, and how different terminals could be:
+
+@lisp
+  (append
+   (modify-services %base-services
+     ;; greetd-service-type provides "greetd" PAM service
+     (delete login-service-type)
+     ;; and can be used in place of mingetty-service-type
+     (delete mingetty-service-type))
+   (list
+    (service greetd-service-type
+             (greetd-configuration
+              (terminals
+               (list
+                ;; we can make any terminal active by default
+                (greetd-terminal-configuration (terminal-vt "1") (terminal-switch #t))
+                ;; we can make environment without XDG_RUNTIME_DIR set
+                ;; even provide our own environment variables
+                (greetd-terminal-configuration
+                 (terminal-vt "2")
+                 (default-session-command
+                   (greetd-agreety-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")))))
+                ;; we can use any other executable command as greeter
+                (greetd-terminal-configuration
+                 (terminal-vt "4")
+                 (default-session-command (program-file "my-noop-greeter" #~(exit))))
+                (greetd-terminal-configuration (terminal-vt "5"))
+                (greetd-terminal-configuration (terminal-vt "6"))))))
+    ;; mingetty-service-type can be used in parallel
+    ;; if needed to do so, do not (delete login-service-type)
+    ;; as illustrated above
+    #| (service mingetty-service-type (mingetty-configuration (tty "tty8"))) |#))
+@end lisp
+@end defvr
+
+@deftp {Data Type} greetd-configuration
+Configuration record for the @code{greetd-service-type}.
+@table @asis
+
+@item @code{motd}
+A file-like object containing the ``message of the day''.
+
+@item @code{allow-empty-passwords?} (default: @code{#t})
+Allow empty passwords by default so that first-time users can log in when
+the 'root' account has just been created.
+
+@item @code{terminals} (default: @code{'()})
+List of @code{greetd-terminal-configuration} per terminal for which
+@code{greetd} should be started.
+@end table
+@end deftp
+
+@deftp {Data Type} greetd-terminal-configuration
+Configuration record for per terminal greetd daemon service.
+
+@table @asis
+@item @code{greetd} (default: @code{greetd})
+The greetd package to use.
+
+@item @code{config-file-name}
+Configuration file name to use for greetd daemon. Generally, autogenerated
+derivation based on @code{terminal-vt} value.
+
+@item @code{terminal-vt} (default: @samp{"7"})
+The VT to run on. Use of a specific VT with appropriate conflict avoidance
+is recommended.
+
+@item @code{terminal-switch} (default: @code{#f})
+Make this terminal active on start of @code{greetd}.
+
+@item @code{default-session-user} (default: @samp{"greeter"})
+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
+@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.
+
+@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.
+
+@item @code{command-args} (default: @code{'("-l")})
+Command arguments to pass to command.
+
+@item @code{extra-env} (default: @code{'()})
+Extra environment variables to set on login.
+
+@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
+are set right after mentioned variables, so that they can be overriden.
+
+@end table
+@end deftp
+
 @node Scheduled Job Execution
 @subsection Scheduled Job Execution
 
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 3fb92e6da071..3a5c85ce61fd 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -15,6 +15,7 @@
 ;;; Copyright © 2020, 2021 Brice Waegeneire <brice@waegenei.re>
 ;;; Copyright © 2021 qblade <qblade@protonmail.com>
 ;;; Copyright © 2021 Hui Lu <luhuins@163.com>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;; Copyright © 2021, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2022 Guillaume Le Vaillant <glv@posteo.net>
 ;;;
@@ -219,6 +220,11 @@ (define-module (gnu services base)
             pam-limits-service-type
             pam-limits-service
 
+            greetd-service-type
+            greetd-configuration
+            greetd-terminal-configuration
+            greetd-agreety-session
+
             %base-services))
 
 ;;; Commentary:
@@ -1438,7 +1444,7 @@ (define pam-limits-service-type
                               (module "pam_limits.so")
                               (arguments '("conf=/etc/security/limits.conf")))))
              (if (member (pam-service-name pam)
-                         '("login" "su" "slim" "gdm-password" "sddm"))
+                         '("login" "greetd" "su" "slim" "gdm-password" "sddm"))
                  (pam-service
                   (inherit pam)
                   (session (cons pam-limits
@@ -2773,6 +2779,216 @@ (define %qemu-static-networking
    (provision '(networking))
    (name-servers '("10.0.2.3"))))
 
+\f
+;;;
+;;; 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
+  (match-lambda
+    (($ <greetd-agreety-session> _ 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 #$@args)))))))
+
+(define greetd-agreety-tty-xdg-session-command
+  (match-lambda
+    (($ <greetd-agreety-session> _ 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 #$@args)))))))
+
+(define (make-greetd-agreety-session-command config command)
+  (let ((agreety (file-append (greetd-agreety config) "/bin/agreety")))
+    (program-file
+     "agreety-command"
+     #~(execl #$agreety #$agreety "-c" #$command))))
+
+(define (make-greetd-default-session-command config-or-command)
+  (cond ((greetd-agreety-session? config-or-command)
+         (cond ((greetd-agreety-xdg-env? config-or-command)
+                (make-greetd-agreety-session-command
+                 config-or-command
+                 (greetd-agreety-tty-xdg-session-command config-or-command)))
+               (#t
+                (make-greetd-agreety-session-command
+                 config-or-command
+                 (greetd-agreety-tty-session-command config-or-command)))))
+        (#t config-or-command)))
+
+(define-record-type* <greetd-terminal-configuration>
+  greetd-terminal-configuration make-greetd-terminal-configuration
+  greetd-terminal-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"))
+  (terminal-switch greetd-terminal-switch (default #f))
+  (default-session-user greetd-default-session-user (default "greeter"))
+  (default-session-command greetd-default-session-command
+    (default (greetd-agreety-session))
+    (sanitize make-greetd-default-session-command)))
+
+(define (default-config-file-name config)
+  (string-join (list "config-" (greetd-terminal-vt config) ".toml") ""))
+
+(define (make-greetd-terminal-configuration-file config)
+  (let*
+      ((config-file-name (greetd-config-file-name config))
+       (terminal-vt (greetd-terminal-vt config))
+       (terminal-switch (greetd-terminal-switch config))
+       (default-session-user (greetd-default-session-user config))
+       (default-session-command (greetd-default-session-command config)))
+    (mixed-text-file
+     config-file-name
+     "[terminal]\n"
+     "vt = " terminal-vt "\n"
+     "switch = " (if terminal-switch "true" "false") "\n"
+     "[default_session]\n"
+     "user = " default-session-user "\n"
+     "command = " default-session-command "\n")))
+
+(define %greetd-accounts
+  (list (user-account
+         (name "greeter")
+         (group "wheel")
+         (supplementary-groups '("users" "tty" "input" "video" "audio"))
+         (system? #t))))
+
+(define %greetd-file-systems
+  (list (file-system
+          (device "none")
+          (mount-point "/run/greetd/pam_mount")
+          (type "tmpfs")
+          (check? #f)
+          (flags '(no-suid no-dev no-exec))
+          (options "mode=0755")
+          (create-mount-point? #t))))
+
+(define %greetd-pam-mount-rules
+  `((debug (@ (enable "0")))
+    (volume (@ (sgrp "users")
+               (fstype "tmpfs")
+               (mountpoint "/run/user/%(USERUID)")
+               (options "noexec,nosuid,nodev,size=1g,mode=0700,uid=%(USERUID),gid=%(USERGID)")))
+    (logout (@ (wait "0")
+               (hup "0")
+               (term "yes")
+               (kill "no")))
+    (mkmountpoint (@ (enable "1") (remove "true")))))
+
+(define-record-type* <greetd-configuration>
+  greetd-configuration make-greetd-configuration
+  greetd-configuration?
+  (motd greetd-motd (default %default-motd))
+  (allow-empty-passwords? greetd-allow-empty-passwords? (default #t))
+  (terminals greetd-terminals (default '())))
+
+(define (make-greetd-pam-mount-conf-file config)
+  (computed-file
+   "greetd_pam_mount.conf.xml"
+   #~(begin
+       (use-modules (sxml simple))
+       (call-with-output-file #$output
+         (lambda (port)
+           (sxml->xml
+            '(*TOP*
+              (*PI* xml "version='1.0' encoding='utf-8'")
+              (pam_mount
+               #$@%greetd-pam-mount-rules
+               (pmvarrun
+                #$(file-append greetd-pam-mount
+                               "/sbin/pmvarrun -u '%(USER)' -o '%(OPERATION)'"))))
+            port))))))
+
+(define (greetd-etc-service config)
+  `(("security/greetd_pam_mount.conf.xml"
+     ,(make-greetd-pam-mount-conf-file config))))
+
+(define (greetd-pam-service config)
+  (define optional-pam-mount
+    (pam-entry
+     (control "optional")
+     (module #~(string-append #$greetd-pam-mount "/lib/security/pam_mount.so"))
+     (arguments '("disable_interactive"))))
+
+  (list
+   (unix-pam-service "greetd"
+                     #:login-uid? #t
+                     #:allow-empty-passwords?
+                     (greetd-allow-empty-passwords? config)
+                     #:motd
+                     (greetd-motd config))
+   (lambda (pam)
+     (if (member (pam-service-name pam)
+                 '("login" "greetd" "su" "slim" "gdm-password"))
+         (pam-service
+          (inherit pam)
+          (auth (append (pam-service-auth pam)
+                        (list optional-pam-mount)))
+          (session (append (pam-service-session pam)
+                           (list optional-pam-mount))))
+         pam))))
+
+(define (greetd-shepherd-services config)
+  (map
+   (lambda (tc)
+     (let*
+         ((greetd-bin (file-append (greetd-package tc) "/sbin/greetd"))
+          (greetd-conf (make-greetd-terminal-configuration-file tc))
+          (greetd-vt (greetd-terminal-vt tc)))
+       (shepherd-service
+        (documentation "Minimal and flexible login manager daemon")
+        (requirement '(user-processes host-name udev virtual-terminal))
+        (provision (list (symbol-append
+                          'term-tty
+                          (string->symbol (greetd-terminal-vt tc)))))
+        (start #~(make-forkexec-constructor
+                  (list #$greetd-bin "-c" #$greetd-conf)
+                  #:log-file
+                  (string-append "/tmp/greetd." #$greetd-vt ".log")))
+        (stop #~(make-kill-destructor)))))
+   (greetd-terminals config)))
+
+(define greetd-service-type
+  (service-type
+   (name 'greetd)
+   (description "Provides necessary infrastructure for logging into the
+system including @code{greetd} PAM service, @code{pam-mount} module to
+mount/unmount /run/user/<uid> directory for user and @code{greetd}
+login manager daemon.")
+   (extensions
+    (list
+     (service-extension account-service-type (const %greetd-accounts))
+     (service-extension file-system-service-type (const %greetd-file-systems))
+     (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)))
+   (default-value (greetd-configuration))))
+
 \f
 (define %base-services
   ;; Convenience variable holding the basic services.
diff --git a/gnu/services/pam-mount.scm b/gnu/services/pam-mount.scm
index 33649b0f7c64..e60781d05bbe 100644
--- a/gnu/services/pam-mount.scm
+++ b/gnu/services/pam-mount.scm
@@ -90,7 +90,7 @@ (define (pam-mount-pam-service config)
      (module #~(string-append #$pam-mount "/lib/security/pam_mount.so"))))
   (list (lambda (pam)
           (if (member (pam-service-name pam)
-                      '("login" "su" "slim" "gdm-password" "sddm"))
+                      '("login" "greetd" "su" "slim" "gdm-password" "sddm"))
               (pam-service
                (inherit pam)
                (auth (append (pam-service-auth pam)
-- 
2.36.1

[bug#49969] [PATCH v9 5/7] gnu: admin: Add libseat 0.7.0 and move seatd.

[Hilton Chain via Guix-patches via]

* gnu/packages/admin.scm (libseat): New variable
* gnu/packages/admin.scm (seatd): New variable
* gnu/packages/freedesktop.scm (seatd): Remove variable

Signed-off-by: Hilton Chain <hako@ultrarare.space>
---
 gnu/packages/admin.scm       | 51 ++++++++++++++++++++++++++++++++++++
 gnu/packages/freedesktop.scm | 29 --------------------
 2 files changed, 51 insertions(+), 29 deletions(-)

diff --git a/gnu/packages/admin.scm b/gnu/packages/admin.scm
index 7095259ff9b0..774ad88274b2 100644
--- a/gnu/packages/admin.scm
+++ b/gnu/packages/admin.scm
@@ -46,6 +46,7 @@
 ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
 ;;; Copyright © 2021 muradm <mail@muradm.net>
+;;; Copyright © 2021 pineapples <guixuser6392@protonmail.com>
 ;;; Copyright © 2021 Petr Hodina <phodina@protonmail.com>
 ;;; Copyright © 2021 Artyom V. Poptsov <poptsov.artyom@gmail.com>
 ;;; Copyright © 2022 Wamm K. D. <jaft.r@outlook.com>
@@ -4976,6 +4977,56 @@ (define-public udpcast
     (home-page "https://www.udpcast.linux.lu")
     (license license:gpl2+)))
 
+(define-public libseat
+  (package
+    (name "libseat")
+    (version "0.7.0")
+    (source (origin
+              (method git-fetch)
+              (uri (git-reference
+                    (url "https://git.sr.ht/~kennylevinsen/seatd")
+                    (commit version)))
+              (file-name (git-file-name name version))
+              (sha256
+               (base32
+                "10f8387yy5as547xjjhl0cna6iywdgjmw0iq2nvcs8q6vlpnik4v"))))
+    (build-system meson-build-system)
+    (arguments
+     `(#:configure-flags '("-Dlibseat-logind=elogind"
+                           "-Dserver=disabled")))
+    (native-inputs
+     `(("pkg-config" ,pkg-config)))
+    (propagated-inputs
+     `(("elogind" ,elogind)))
+    (home-page "https://sr.ht/~kennylevinsen/seatd")
+    (synopsis "Seat management library")
+    (description
+     "This package provides a universal seat management library that
+allows applications to use whatever seat management is available.")
+    (license license:expat)))
+
+(define-public seatd
+  (package
+    (inherit libseat)
+    (name "seatd")
+    (arguments
+     `(#:configure-flags '("-Dlibseat-logind=elogind")
+       #:phases
+       (modify-phases %standard-phases
+         (add-after 'install 'remove-libs
+           (lambda* (#:key outputs #:allow-other-keys)
+             (with-directory-excursion (assoc-ref outputs "out")
+                                       (for-each delete-file-recursively
+                                                 '("lib" "include"))))))))
+    (native-inputs `(("pkg-config" ,pkg-config) ("scdoc" ,scdoc)))
+    (inputs '())
+    (synopsis "Seat management daemon")
+    (description
+     "This package provides a minimal seat management daemon whose task is to
+mediate access to shared devices, such as graphics and input, for applications
+that require it.")
+    (license license:expat)))
+
 (define-public greetd
   (package
     (name "greetd")
diff --git a/gnu/packages/freedesktop.scm b/gnu/packages/freedesktop.scm
index fc2c45c1f137..309876867a16 100644
--- a/gnu/packages/freedesktop.scm
+++ b/gnu/packages/freedesktop.scm
@@ -849,35 +849,6 @@ (define-public localed
 with localed.  This package is extracted from the broader systemd package.")
     (license license:lgpl2.1+)))
 
-(define-public seatd
-  (package
-    (name "seatd")
-    (version "0.5.0")
-    (source (origin
-              (method git-fetch)
-              (uri (git-reference
-                    (url "https://git.sr.ht/~kennylevinsen/seatd")
-                    (commit version)))
-              (file-name (git-file-name name version))
-              (sha256
-               (base32
-                "1kglq8v4rnr3415mfaghyv2s2f8mxsy5s881gmm2908ig4n4j297"))))
-    (build-system meson-build-system)
-    (arguments
-     `(#:configure-flags '("-Dlogind=enabled")))
-    (native-inputs
-     (list pkg-config scdoc))
-    (propagated-inputs
-     (list elogind))
-    (home-page "https://sr.ht/~kennylevinsen/seatd")
-    (synopsis "Seat management daemon and library")
-    (description
-     "This package provides a minimal seat management daemon whose task is to
-mediate access to shared devices, such as graphics and input, for applications
-that require it.  It also provides a universal seat management library that
-allows applications to use whatever seat management is available.")
-    (license license:expat)))
-
 (define-public packagekit
   (package
     (name "packagekit")
-- 
2.36.1

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

[Hilton Chain via Guix-patches via]

* gnu/services/desktop.scm (seatd-service-type): New variable
* gnu/services/desktop.scm (seatd-configuration): New data type

Signed-off-by: Hilton Chain <hako@ultrarare.space>
---
 doc/guix.texi            | 42 ++++++++++++++++++++++++++++
 gnu/services/desktop.scm | 59 +++++++++++++++++++++++++++++++++++++++-
 2 files changed, 100 insertions(+), 1 deletion(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 825c7d93c577..3f8e61a2b16e 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -22656,6 +22656,48 @@ Desktop Services
 @end table
 @end deftp
 
+@defvr {Scheme Variable} seatd-service-type
+@uref{https://sr.ht/~kennylevinsen/seatd/, seatd} is a minimal seat
+management daemon.
+
+Seat management takes care of mediating access to shared devices (graphics,
+input), without requiring the applications needing access to be root.
+
+@lisp
+(append
+  (list
+   ;; make sure seatd is running
+   (service seatd-service-type))
+
+  ;; normally one would want %base-services
+  %base-services)
+
+@end lisp
+@end defvr
+
+@deftp {Data Type} seatd-configuration
+Configuration record for the seatd daemon service.
+
+@table @asis
+@item @code{seatd} (default: @code{seatd})
+The seatd package to use.
+
+@item @code{user} (default: @samp{"root"})
+User to own the seatd socket.
+
+@item @code{group} (default: @samp{"users"})
+Group to own the seatd socket.
+
+@item @code{socket} (default: @samp{"/run/seatd.sock"})
+Where to create the seatd socket.
+
+@item @code{loglevel} (default: @samp{"error"})
+Log level to output logs. Possible values: @samp{"silent"}, @samp{"error"},
+@samp{"info"} and @samp{"debug"}.
+
+@end table
+@end deftp
+
 @node Sound Services
 @subsection Sound Services
 
diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index 0499071436af..1ba91002e444 100644
--- a/gnu/services/desktop.scm
+++ b/gnu/services/desktop.scm
@@ -13,6 +13,7 @@
 ;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2020 Reza Alizadeh Majd <r.majd@pantherx.org>
 ;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -39,7 +40,9 @@ (define-module (gnu services desktop)
   #:use-module (gnu services networking)
   #:use-module (gnu services sound)
   #:use-module ((gnu system file-systems)
-                #:select (%elogind-file-systems file-system))
+                #:select (%control-groups
+                          %elogind-file-systems
+                          file-system))
   #:autoload   (gnu services sddm) (sddm-service-type)
   #:use-module (gnu system)
   #:use-module (gnu system setuid)
@@ -157,6 +160,9 @@ (define-module (gnu services desktop)
             gnome-keyring-configuration?
             gnome-keyring-service-type
 
+            seatd-configuration
+            seatd-service-type
+
             %desktop-services))
 
 ;;; Commentary:
@@ -1630,6 +1636,57 @@ (define polkit-wheel
 (define polkit-wheel-service
   (simple-service 'polkit-wheel polkit-service-type (list polkit-wheel)))
 
+\f
+;;;
+;;; seatd-service-type -- minimal seat management daemon
+;;;
+
+(define-record-type* <seatd-configuration> seatd-configuration
+  make-seatd-configuration
+  seatd-configuration?
+  (seatd seatd-package (default seatd))
+  (user seatd-user (default "root"))
+  (group seatd-group (default "users"))
+  (socket seatd-socket (default "/run/seatd.sock"))
+  (loglevel seatd-loglevel (default "error")))
+
+(define (seatd-shepherd-service config)
+  (list (shepherd-service
+         (documentation "Minimal seat management daemon")
+         (requirement '())
+         ;; TODO: once cgroups is separate dependency
+         ;; here we should depend on it rather than elogind
+         (provision '(seatd elogind))
+         (start #~(make-forkexec-constructor
+                   (list #$(file-append (seatd-package config) "/bin/seatd")
+                         "-u" #$(seatd-user config)
+                         "-g" #$(seatd-group config))
+                   #:environment-variables
+                   (list (string-append "SEATD_LOGLEVEL="
+                                        #$(seatd-loglevel config)))
+                   #:log-file "/tmp/seatd.log"))
+         (stop #~(make-kill-destructor)))))
+
+(define seatd-environment
+  (match-lambda
+    (($ <seatd-configuration> _ _ _ socket)
+     `(("SEATD_SOCK" . ,socket)))))
+
+(define seatd-service-type
+  (service-type
+   (name 'seatd)
+   (description "Seat management takes care of mediating access
+to shared devices (graphics, input), without requiring the
+applications needing access to be root.")
+   (extensions
+    (list
+     (service-extension session-environment-service-type seatd-environment)
+     ;; TODO: once cgroups is separate dependency we should not mount it here
+     ;; for now it is mounted here, because elogind mounts it
+     (service-extension file-system-service-type (const %control-groups))
+     (service-extension shepherd-root-service-type seatd-shepherd-service)))
+   (default-value (seatd-configuration))))
+
 \f
 ;;;
 ;;; The default set of desktop services.
-- 
2.36.1

[bug#49969] [PATCH v9 7/7] gnu: tests: Add seatd/greetd based minimal desktop system tests.

[Hilton Chain via Guix-patches via]

* gnu/tests/desktop.scm (minimal-desktop): seatd/greetd based
minimal desktop test

Signed-off-by: Hilton Chain <hako@ultrarare.space>
---
 gnu/tests/desktop.scm | 212 +++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 211 insertions(+), 1 deletion(-)

diff --git a/gnu/tests/desktop.scm b/gnu/tests/desktop.scm
index 57069c0edee5..7cc837f42e72 100644
--- a/gnu/tests/desktop.scm
+++ b/gnu/tests/desktop.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -18,13 +19,17 @@
 
 (define-module (gnu tests desktop)
   #:use-module (gnu tests)
+  #:use-module (gnu packages shells)
   #:use-module (gnu services)
+  #:use-module (gnu services base)
   #:use-module (gnu services dbus)
   #:use-module (gnu services desktop)
+  #:use-module (gnu system)
   #:use-module (gnu system vm)
   #:use-module (guix gexp)
   #:use-module (srfi srfi-1)
-  #:export (%test-elogind))
+  #:export (%test-elogind
+            %test-minimal-desktop))
 
 \f
 ;;;
@@ -100,3 +105,208 @@ (define %test-elogind
                #:imported-modules '((gnu services herd)
                                     (guix combinators)))))
       (run-elogind-test (virtual-machine os))))))
+
+\f
+;;;
+;;; Seatd/greetd based minimal desktop
+;;;
+
+(define %minimal-services
+  (append
+   (modify-services %base-services
+     ;; greetd-service-type provides "greetd" PAM service
+     (delete login-service-type)
+     ;; and can be used in place of mingetty-service-type
+     (delete mingetty-service-type))
+   (list
+    (service seatd-service-type)
+    (service greetd-service-type
+             (greetd-configuration
+              (terminals
+               (list
+                ;; we can make any terminal active by default
+                (greetd-terminal-configuration (terminal-vt "1") (terminal-switch #t))
+                ;; we can make environment without XDG_RUNTIME_DIR set
+                ;; even provide our own environment variables
+                (greetd-terminal-configuration
+                 (terminal-vt "2")
+                 (default-session-command
+                   (greetd-agreety-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")))))
+                ;; we can use any other executable command as greeter
+                (greetd-terminal-configuration
+                 (terminal-vt "4")
+                 (default-session-command (program-file "my-noop-greeter" #~(exit))))
+                (greetd-terminal-configuration (terminal-vt "5"))
+                (greetd-terminal-configuration (terminal-vt "6"))))))
+    ;; mingetty-service-type can be used in parallel
+    ;; if needed to do so, do not (delete login-service-type)
+    ;; as illustrated above
+    #| (service mingetty-service-type (mingetty-configuration (tty "tty8"))) |#)))
+
+(define-syntax-rule (minimal-operating-system user-services ...)
+  "Return an operating system that includes USER-SERVICES in addition to
+minimal %BASE-SERVICES."
+  (operating-system (inherit %simple-os)
+                    (services (cons* user-services ... %minimal-services))))
+
+(define (run-minimal-desktop-test os vm)
+  (define test
+    (with-imported-modules '((gnu build marionette)
+                             (guix build syscalls))
+      #~(begin
+          (use-modules (gnu build marionette)
+                       (guix build syscalls)
+                       (srfi srfi-1)
+                       (srfi srfi-64)
+                       (ice-9 pretty-print))
+
+          (define marionette
+            (make-marionette #$vm))
+
+          (define (file-get-all-strings fname)
+            (marionette-eval '(use-modules (rnrs io ports)) marionette)
+            (wait-for-file fname marionette #:read 'get-string-all))
+
+          (define (wait-for-unix-socket-m socket)
+            (wait-for-unix-socket socket marionette))
+
+          (mkdir #$output)
+          (chdir #$output)
+
+          (test-begin "minimal-desktop")
+
+          (test-assert "seatd is ready"
+            (wait-for-unix-socket-m "/run/seatd.sock"))
+
+          (test-equal "login user on tty1"
+            "alice\n"
+            (begin
+              ;; Wait for tty1.
+              (marionette-eval
+               '(begin
+                  (use-modules (gnu services herd))
+                  (start-service 'term-tty1))
+               marionette)
+              (marionette-control "sendkey ctrl-alt-f1" marionette)
+
+              ;; login as root change alice password and exit
+              ;; then login as alice
+              (for-each
+               (lambda (cmd) (marionette-type cmd marionette) (sleep 1))
+               (list
+                "root\n"
+                "passwd alice\n"
+                "alice\n"
+                "alice\n"
+                "exit\n"
+                "alice\n"
+                "alice\n"
+                "id -un > logged-in\n"))
+
+              (file-get-all-strings "/home/alice/logged-in")))
+
+          (test-equal "validate user environment"
+            '("SEATD_SOCK=/run/seatd.sock"
+              "XDG_RUNTIME_DIR=/run/user/1000"
+              "XDG_SEAT=seat0"
+              "XDG_VTNR=1")
+
+            (begin
+              (marionette-type "env > env\n" marionette)
+              (sleep 1)
+
+              (define user-env (string-tokenize
+                                (file-get-all-strings "/home/alice/env")))
+
+              (define (expected-var var)
+                (any (lambda (s) (string-contains var s))
+                     '("SEATD_SOCK"
+                       "XDG_RUNTIME_DIR"
+                       "XDG_SEAT"
+                       "XDG_VTNR")))
+
+              (sort (filter expected-var user-env) string<?)))
+
+          (test-assert "validate SEATD_SOCK and GREETD_SOCK"
+            (begin
+              (marionette-type "env > env\n" marionette)
+              (sleep 1)
+
+              (define (sock-var? var)
+                (any (lambda (s) (string-contains var s))
+                     '("SEATD_SOCK" "GREETD_SOCK")))
+
+              (define (sock-var-sock var)
+                (car (cdr (string-split var #\=))))
+
+              (let*
+                  ((out (file-get-all-strings "/home/alice/env"))
+                   (out (string-tokenize out))
+                   (out (filter sock-var? out))
+                   (socks (map sock-var-sock out))
+                   (socks (map wait-for-unix-socket-m socks)))
+                (and (= 2 (length socks)) (every identity socks)))))
+
+          (test-assert "greetd is ready"
+            (begin
+              (marionette-type "ps -C greetd -o pid,args --no-headers > ps-greetd\n"
+                               marionette)
+              (sleep 1)
+
+              (define (greetd-daemon? cmd)
+                (string-contains cmd "config"))
+
+              (define (greetd-cmd-to-pid cmd)
+                (car (string-split cmd #\space)))
+
+              (define (greetd-pid-to-sock pid)
+                (string-append "/run/greetd-" pid ".sock"))
+
+              (let* ((out (file-get-all-strings "/home/alice/ps-greetd"))
+                     (out (string-split out #\newline))
+                     (out (map string-trim-both out))
+                     (out (filter greetd-daemon? out))
+                     (pids (map greetd-cmd-to-pid out))
+                     (socks (map greetd-pid-to-sock pids))
+                     (socks (map wait-for-unix-socket-m socks)))
+                (every identity socks))))
+
+          ;; a bit weak, but tests everything at once actually
+          (test-equal "check /run/user/<uid> mounted and writable"
+            "alice\n"
+            (begin
+              (marionette-type "echo alice > /run/user/1000/test\n" marionette)
+              (file-get-all-strings "/run/user/1000/test")))
+
+          (test-assert "screendump"
+            (begin
+              (marionette-control (string-append "screendump " #$output
+                                                 "/tty1.ppm")
+                                  marionette)
+              (file-exists? "tty1.ppm")))
+
+          (test-end)
+          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+  (gexp->derivation "minimal-desktop" test))
+
+(define %test-minimal-desktop
+  (system-test
+   (name "minimal-desktop")
+   (description
+    "Test whether we can log in when seatd and greetd is enabled")
+   (value
+    (let* ((os (marionette-operating-system
+                (minimal-operating-system)
+                #:imported-modules '((gnu services herd)
+                                     (guix combinators))))
+           (vm (virtual-machine os)))
+      (run-minimal-desktop-test (virtualized-operating-system os '())
+                                #~(list #$vm))))))
-- 
2.36.1

[bug#49969] [PATCH v9 4/7] gnu: base: Add greetd-service-type.

[Lars-Dominik Braun]

Hi,

overall this works quite well for me, thanks!

A few comments:

> +                  #:log-file
> +                  (string-append "/tmp/greetd." #$greetd-vt ".log")))
Why log to /tmp and not /var/log here?

> +                   #:log-file "/tmp/seatd.log"))
Same.

> * gnu/packages/admin.scm (libseat): New variable
> * gnu/packages/admin.scm (seatd): New variable
> * gnu/packages/freedesktop.scm (seatd): Remove variable
(gnu packages wm) references seatd, but does not use (gnu packages admin),
thus `guix pull` fails.

Cheers,
Lars

[bug#49969] [PATCH v10 0/7] Re: [bug#49969] [PATCH v9 4/7] gnu: base: Add greetd-service-type.

[muradm]

Hi,

Updating patch set with:
* dependency versions
* log files are now pointing to /var/log/*
* wlroots should depend on libseat from new location
* some minor formatting and fixes compared to v9

muradm (7):
  gnu: crates-io: Add rust-enquote 1.1.0 and rust-pam-sys 0.5.6.
  gnu: admin: Add greetd 0.8.0.
  gnu: admin: Add greetd-pam-mount.
  gnu: base: Add greetd-service-type.
  gnu: admin: Add libseat 0.8.0 and move seatd.
  gnu: desktop: Add seatd-service-type.
  gnu: tests: Add seatd/greetd based minimal desktop system tests.

 doc/guix.texi                | 183 ++++++++++++++++++++++++++++
 gnu/packages/admin.scm       | 162 +++++++++++++++++++++++++
 gnu/packages/crates-io.scm   |  40 +++++++
 gnu/packages/freedesktop.scm |  29 -----
 gnu/packages/wm.scm          |   4 +-
 gnu/services/base.scm        | 223 ++++++++++++++++++++++++++++++++++-
 gnu/services/desktop.scm     |  62 +++++++++-
 gnu/services/pam-mount.scm   |   2 +-
 gnu/tests/desktop.scm        | 212 ++++++++++++++++++++++++++++++++-
 9 files changed, 883 insertions(+), 34 deletions(-)

-- 
2.36.1

[bug#49969] [PATCH v10 1/7] gnu: crates-io: Add rust-enquote 1.1.0 and rust-pam-sys 0.5.6.

[muradm]

* gnu/packages/crates-io.scm (rust-enquote-1): New variable
* gnu/packages/crates-io.scm (rust-pam-sys-0.5): New variable
---
 gnu/packages/crates-io.scm | 40 ++++++++++++++++++++++++++++++++++++++
 1 file changed, 40 insertions(+)

diff --git a/gnu/packages/crates-io.scm b/gnu/packages/crates-io.scm
index 86313f5e4f..9374601bb4 100644
--- a/gnu/packages/crates-io.scm
+++ b/gnu/packages/crates-io.scm
@@ -19,6 +19,7 @@
 ;;; Copyright © 2021 Antero Mejr <antero@kodmin.com>
 ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2021 Vinicius Monego <monego@posteo.net>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;; Copyright © 2021, 2022 Petr Hodina <phodina@protonmail.com>
 ;;; Copyright © 2021, 2022 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2021 Jacob Hrbek <kreyren@rixotstudio.cz>
@@ -73053,3 +73054,42 @@ (define-public rust-shell2batch-0.4
 and automatically convert it to a windows batch file, this library provides a
 way to convert simple shell commands to windows batch commands.")
     (license license:asl2.0)))
+
+(define-public rust-enquote-1
+  (package
+    (name "rust-enquote")
+    (version "1.1.0")
+    (home-page "https://github.com/reujab/enquote")
+    (source (origin
+              (method url-fetch)
+              (uri (crate-uri "enquote" version))
+              (file-name (string-append name "-" version ".tar.gz"))
+              (sha256
+               (base32
+                "0clrjghlfkkb7sndabs5wch0fz2nif6nj4b117s8kqxx3nqnrhq6"))))
+    (build-system cargo-build-system)
+    (synopsis "Rust library that quotes, unquotes, and unescapes strings")
+    (description "A Rust library quotes, unquotes, and unescapes strings")
+    (license license:unlicense)))
+
+(define-public rust-pam-sys-0.5
+  (package
+    (name "rust-pam-sys")
+    (version "0.5.6")
+    (home-page "https://github.com/1wilkens/pam-sys")
+    (source (origin
+              (method url-fetch)
+              (uri (crate-uri "pam-sys" version))
+              (file-name (string-append name "-" version ".tar.gz"))
+              (sha256
+               (base32
+                "0d14501d5vybjnzxfjf96321xa5wa36x1xvf02h02zq938qmhj6d"))))
+    (build-system cargo-build-system)
+    (arguments
+     `(#:cargo-inputs (("rust-libc" ,rust-libc-0.2))))
+    (native-inputs `(("linux-pam" ,linux-pam)))
+    (synopsis
+     "Rust FFI wrappers for the Linux Pluggable Authentication Modules (PAM)")
+    (description
+     "Rust FFI wrappers for the Linux Pluggable Authentication Modules (PAM)")
+    (license (list license:expat license:asl2.0))))
-- 
2.36.1

[bug#49969] [PATCH v10 2/7] gnu: admin: Add greetd 0.8.0.

[muradm]

* gnu/packages/admin.scm (greetd): New variable
---
 gnu/packages/admin.scm | 77 ++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 77 insertions(+)

diff --git a/gnu/packages/admin.scm b/gnu/packages/admin.scm
index 6acfff8881..73d70744e1 100644
--- a/gnu/packages/admin.scm
+++ b/gnu/packages/admin.scm
@@ -45,6 +45,7 @@
 ;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
 ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;; Copyright © 2021 Petr Hodina <phodina@protonmail.com>
 ;;; Copyright © 2021 Artyom V. Poptsov <poptsov.artyom@gmail.com>
 ;;; Copyright © 2022 Wamm K. D. <jaft.r@outlook.com>
@@ -66,6 +67,7 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu packages admin)
+  #:use-module (guix build-system cargo)
   #:use-module (guix build-system cmake)
   #:use-module (guix build-system emacs)
   #:use-module (guix build-system glib-or-gtk)
@@ -93,6 +95,7 @@ (define-module (gnu packages admin)
   #:use-module (gnu packages c)
   #:use-module (gnu packages check)
   #:use-module (gnu packages compression)
+  #:use-module (gnu packages crates-io)
   #:use-module (gnu packages cross-base)
   #:use-module (gnu packages crypto)
   #:use-module (gnu packages cryptsetup)
@@ -4987,4 +4990,78 @@ (define-public udpcast
     (home-page "https://www.udpcast.linux.lu")
     (license license:gpl2+)))
 
+(define-public greetd
+  (package
+    (name "greetd")
+    (version "0.8.0")
+    (home-page "https://git.sr.ht/~kennylevinsen/greetd")
+    (source (origin
+              (method git-fetch)
+              (uri (git-reference
+                    (url home-page)
+                    (commit version)))
+              (file-name (git-file-name name version))
+              (sha256
+               (base32 "0x5c3jkw09kvj2grcxm899y2n6ws8p990cyp9cs0fy6lm4fzlh6v"))))
+    (build-system cargo-build-system)
+    (arguments
+     `(#:cargo-inputs
+       (("rust-nix" ,rust-nix-0.19)
+        ("rust-pam-sys" ,rust-pam-sys-0.5)
+        ("rust-rpassword" ,rust-rpassword-5)
+        ("rust-users" ,rust-users-0.11)
+        ("rust-serde" ,rust-serde-1)
+        ("rust-serde-json" ,rust-serde-json-1)
+        ("rust-libc" ,rust-libc-0.2)
+        ("rust-tokio" ,rust-tokio-1)
+        ("rust-getopts" ,rust-getopts-0.2)
+        ("rust-thiserror" ,rust-thiserror-1)
+        ("rust-async-trait" ,rust-async-trait-0.1)
+        ("rust-enquote" ,rust-enquote-1))
+       #:phases
+       (modify-phases %standard-phases
+         (delete 'package)
+         (add-after 'build 'build-man-pages
+           (lambda* (#:key inputs #:allow-other-keys)
+             (define (scdoc-cmd doc lvl)
+               (system (string-append "scdoc < "
+                                      doc "-" lvl ".scd > "
+                                      doc "." lvl)))
+             (with-directory-excursion "man"
+               (scdoc-cmd "greetd" "1")
+               (scdoc-cmd "greetd" "5")
+               (scdoc-cmd "greetd-ipc" "7")
+               (scdoc-cmd "agreety" "1"))))
+         (replace 'install
+           (lambda* (#:key inputs outputs #:allow-other-keys)
+             (let* ((out (assoc-ref outputs "out"))
+                    (bin (string-append out "/bin"))
+                    (sbin (string-append out "/sbin"))
+                    (share (string-append out "/share"))
+                    (man (string-append share "/man"))
+                    (man1 (string-append man "/man1"))
+                    (man5 (string-append man "/man5"))
+                    (man7 (string-append man "/man7"))
+                    (release "target/release")
+                    (greetd-bin (string-append release "/greetd"))
+                    (agreety-bin (string-append release "/agreety")))
+               (install-file greetd-bin sbin)
+               (install-file agreety-bin bin)
+               (with-directory-excursion "man"
+                 (install-file "greetd.1" man1)
+                 (install-file "greetd.5" man5)
+                 (install-file "greetd-ipc.7" man7)
+                 (install-file "agreety.1" man1))))))))
+    (native-inputs
+     `(("linux-pam" ,linux-pam)
+       ("scdoc" ,scdoc)))
+    (synopsis "minimal and flexible login manager daemon")
+    (description
+     "greetd is a minimal and flexible login manager daemon
+that makes no assumptions about what you want to launch.
 
+If you can run it from your shell in a TTY, greetd can start it.
+
+If it can be taught to speak a simple JSON-based IPC protocol,
+then it can be a greeter.")
+    (license license:gpl3+)))
-- 
2.36.1

[bug#49969] [PATCH v10 3/7] gnu: admin: Add greetd-pam-mount.

[muradm]

* gnu/packages/admin.scm (greetd-pam-mount): New variable
---
 gnu/packages/admin.scm | 32 ++++++++++++++++++++++++++++++++
 1 file changed, 32 insertions(+)

diff --git a/gnu/packages/admin.scm b/gnu/packages/admin.scm
index 73d70744e1..d6e1d819ab 100644
--- a/gnu/packages/admin.scm
+++ b/gnu/packages/admin.scm
@@ -5065,3 +5065,35 @@ (define (scdoc-cmd doc lvl)
 If it can be taught to speak a simple JSON-based IPC protocol,
 then it can be a greeter.")
     (license license:gpl3+)))
+
+(define-public greetd-pam-mount
+  (package
+    (inherit pam-mount)
+    (name "greetd-pam-mount")
+    (arguments
+     (substitute-keyword-arguments (package-arguments pam-mount)
+       ((#:configure-flags flags ''())
+        #~(cons* "--with-rundir=/run/greetd" #$flags))
+       ((#:phases phases)
+        #~(modify-phases #$phases
+           (add-after 'unpack 'patch-config-file-name
+             (lambda* (#:key inputs #:allow-other-keys)
+               (substitute* "src/pam_mount.c"
+                 ((".*define CONFIGFILE .*$")
+                  "#define CONFIGFILE \"/etc/security/greetd_pam_mount.conf.xml\"\n")
+                 (("pam_mount_config") "greetd_pam_mount_config")
+                 (("pam_mount_system_authtok") "greetd_pam_mount_system_authtok"))))))))
+    (synopsis "pam-mount specifically compiled for use with greetd")
+    (description
+     "Pam-mount is a PAM module that can mount volumes when a user logs in.
+It supports mounting local filesystems of any kind the normal mount utility
+supports.  It can also mount encrypted LUKS volumes using the password
+supplied by the user when logging in.
+
+This package inherits pam-mount in the way that it is compiled specifically
+for use with greetd daemon. It uses different configuration location and
+name space for storing data in PAM.
+
+greetd-pam-mount is used in configuration of greetd to provide
+auto-(mounting/unmounting) of XDG_RUNTIME_DIR in the way that it will not
+interfere with default pam-mount configuration.")))
-- 
2.36.1

[bug#49969] [PATCH v10 4/7] gnu: base: Add greetd-service-type.

[muradm]

* gnu/services/base.scm (greetd-service-type): New variable
* gnu/services/base.scm (greetd-configuration): New data type
* gnu/services/base.scm (greetd-terminal-configuration): New data type
* gnu/services/base.scm (greetd-agreety-session): New data type
* gnu/services/base.scm (pam-limits-service-type): Shoul be aware of
greetd PAM service
* gnu/services/pam-mount.scm (pam-mount-pam-service): Shoul be aware
of greetd PAM service
---
 doc/guix.texi              | 137 +++++++++++++++++++++++
 gnu/services/base.scm      | 223 ++++++++++++++++++++++++++++++++++++-
 gnu/services/pam-mount.scm |   2 +-
 3 files changed, 360 insertions(+), 2 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index ea133d519a..997b93c831 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -96,6 +96,7 @@ Copyright @copyright{} 2021 Domagoj Stolfa@*
 Copyright @copyright{} 2021 Hui Lu@*
 Copyright @copyright{} 2021 pukkamustard@*
 Copyright @copyright{} 2021 Alice Brenon@*
+Copyright @copyright{} 2021 muradm@*
 Copyright @copyright{} 2021 Josselin Poiret@*
 Copyright @copyright{} 2021 Andrew Tropin@*
 Copyright @copyright{} 2021 Sarah Morgensen@*
@@ -18019,6 +18020,142 @@ about the Pluggable Authentication Module (PAM) limits, refer to the
 @samp{pam_limits} man page from the @code{linux-pam} package.
 @end deffn
 
+@defvr {Scheme Variable} greetd-service-type
+@uref{https://git.sr.ht/~kennylevinsen/greetd, @code{greetd}} is a minimal and
+flexible login manager daemon, that makes no assumptions about what you
+want to launch.
+
+If you can run it from your shell in a TTY, greetd can start it. If it
+can be taught to speak a simple JSON-based IPC protocol, then it can be
+a geeter.
+
+@code{greetd-service-type} provides necessary infrastructure for logging
+in users, including:
+
+@itemize @bullet
+@item
+@code{greetd} PAM service
+
+@item
+Special variation of @code{pam-mount} to mount @code{XDG_RUNTIME_DIR}
+@end itemize
+
+Here is example of switching from @code{mingetty-service-type} to
+@code{greetd-service-type}, and how different terminals could be:
+
+@lisp
+  (append
+   (modify-services %base-services
+     ;; greetd-service-type provides "greetd" PAM service
+     (delete login-service-type)
+     ;; and can be used in place of mingetty-service-type
+     (delete mingetty-service-type))
+   (list
+    (service greetd-service-type
+             (greetd-configuration
+              (terminals
+               (list
+                ;; we can make any terminal active by default
+                (greetd-terminal-configuration (terminal-vt "1") (terminal-switch #t))
+                ;; we can make environment without XDG_RUNTIME_DIR set
+                ;; even provide our own environment variables
+                (greetd-terminal-configuration
+                 (terminal-vt "2")
+                 (default-session-command
+                   (greetd-agreety-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")))))
+                ;; we can use any other executable command as greeter
+                (greetd-terminal-configuration
+                 (terminal-vt "4")
+                 (default-session-command (program-file "my-noop-greeter" #~(exit))))
+                (greetd-terminal-configuration (terminal-vt "5"))
+                (greetd-terminal-configuration (terminal-vt "6"))))))
+    ;; mingetty-service-type can be used in parallel
+    ;; if needed to do so, do not (delete login-service-type)
+    ;; as illustrated above
+    #| (service mingetty-service-type (mingetty-configuration (tty "tty8"))) |#))
+@end lisp
+@end defvr
+
+@deftp {Data Type} greetd-configuration
+Configuration record for the @code{greetd-service-type}.
+@table @asis
+
+@item @code{motd}
+A file-like object containing the ``message of the day''.
+
+@item @code{allow-empty-passwords?} (default: @code{#t})
+Allow empty passwords by default so that first-time users can log in when
+the 'root' account has just been created.
+
+@item @code{terminals} (default: @code{'()})
+List of @code{greetd-terminal-configuration} per terminal for which
+@code{greetd} should be started.
+@end table
+@end deftp
+
+@deftp {Data Type} greetd-terminal-configuration
+Configuration record for per terminal greetd daemon service.
+
+@table @asis
+@item @code{greetd} (default: @code{greetd})
+The greetd package to use.
+
+@item @code{config-file-name}
+Configuration file name to use for greetd daemon. Generally, autogenerated
+derivation based on @code{terminal-vt} value.
+
+@item @code{log-file-name}
+Log file name to use for greetd daemon. Generally, autogenerated
+name based on @code{terminal-vt} value.
+
+@item @code{terminal-vt} (default: @samp{"7"})
+The VT to run on. Use of a specific VT with appropriate conflict avoidance
+is recommended.
+
+@item @code{terminal-switch} (default: @code{#f})
+Make this terminal active on start of @code{greetd}.
+
+@item @code{default-session-user} (default: @samp{"greeter"})
+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
+@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.
+
+@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.
+
+@item @code{command-args} (default: @code{'("-l")})
+Command arguments to pass to command.
+
+@item @code{extra-env} (default: @code{'()})
+Extra environment variables to set on login.
+
+@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
+are set right after mentioned variables, so that they can be overriden.
+
+@end table
+@end deftp
+
 @node Scheduled Job Execution
 @subsection Scheduled Job Execution
 
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 6865d03f25..0e7bfe7f5a 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -16,6 +16,7 @@
 ;;; Copyright © 2021 qblade <qblade@protonmail.com>
 ;;; Copyright © 2021 Hui Lu <luhuins@163.com>
 ;;; Copyright © 2021, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;; Copyright © 2022 Guillaume Le Vaillant <glv@posteo.net>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -219,6 +220,11 @@ (define-module (gnu services base)
             pam-limits-service-type
             pam-limits-service
 
+            greetd-service-type
+            greetd-configuration
+            greetd-terminal-configuration
+            greetd-agreety-session
+
             %base-services))
 
 ;;; Commentary:
@@ -1439,7 +1445,7 @@ (define pam-limits-service-type
                               (module "pam_limits.so")
                               (arguments '("conf=/etc/security/limits.conf")))))
              (if (member (pam-service-name pam)
-                         '("login" "su" "slim" "gdm-password" "sddm"
+                         '("login" "greetd" "su" "slim" "gdm-password" "sddm"
                            "sudo" "sshd"))
                  (pam-service
                   (inherit pam)
@@ -2775,6 +2781,221 @@ (define %qemu-static-networking
    (provision '(networking))
    (name-servers '("10.0.2.3"))))
 
+\f
+;;;
+;;; 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
+  (match-lambda
+    (($ <greetd-agreety-session> _ 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 #$@args)))))))
+
+(define greetd-agreety-tty-xdg-session-command
+  (match-lambda
+    (($ <greetd-agreety-session> _ 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 #$@args)))))))
+
+(define (make-greetd-agreety-session-command config command)
+  (let ((agreety (file-append (greetd-agreety config) "/bin/agreety")))
+    (program-file
+     "agreety-command"
+     #~(execl #$agreety #$agreety "-c" #$command))))
+
+(define (make-greetd-default-session-command config-or-command)
+  (cond ((greetd-agreety-session? config-or-command)
+         (cond ((greetd-agreety-xdg-env? config-or-command)
+                (make-greetd-agreety-session-command
+                 config-or-command
+                 (greetd-agreety-tty-xdg-session-command config-or-command)))
+               (#t
+                (make-greetd-agreety-session-command
+                 config-or-command
+                 (greetd-agreety-tty-session-command config-or-command)))))
+        (#t config-or-command)))
+
+(define-record-type* <greetd-terminal-configuration>
+  greetd-terminal-configuration make-greetd-terminal-configuration
+  greetd-terminal-configuration?
+  (greetd greetd-package (default greetd))
+  (config-file-name greetd-config-file-name (thunked)
+                    (default (default-config-file-name this-record)))
+  (log-file-name greetd-log-file-name (thunked)
+                 (default (default-log-file-name this-record)))
+  (terminal-vt greetd-terminal-vt (default "7"))
+  (terminal-switch greetd-terminal-switch (default #f))
+  (default-session-user greetd-default-session-user (default "greeter"))
+  (default-session-command greetd-default-session-command
+    (default (greetd-agreety-session))
+    (sanitize make-greetd-default-session-command)))
+
+(define (default-config-file-name config)
+  (string-join (list "config-" (greetd-terminal-vt config) ".toml") ""))
+
+(define (default-log-file-name config)
+  (string-join (list "/var/log/greetd-" (greetd-terminal-vt config) ".log") ""))
+
+(define (make-greetd-terminal-configuration-file config)
+  (let*
+      ((config-file-name (greetd-config-file-name config))
+       (terminal-vt (greetd-terminal-vt config))
+       (terminal-switch (greetd-terminal-switch config))
+       (default-session-user (greetd-default-session-user config))
+       (default-session-command (greetd-default-session-command config)))
+    (mixed-text-file
+     config-file-name
+     "[terminal]\n"
+     "vt = " terminal-vt "\n"
+     "switch = " (if terminal-switch "true" "false") "\n"
+     "[default_session]\n"
+     "user = " default-session-user "\n"
+     "command = " default-session-command "\n")))
+
+(define %greetd-accounts
+  (list (user-account
+         (name "greeter")
+         (group "wheel")
+         (supplementary-groups '("users" "tty" "input" "video" "audio"))
+         (system? #t))))
+
+(define %greetd-file-systems
+  (list (file-system
+          (device "none")
+          (mount-point "/run/greetd/pam_mount")
+          (type "tmpfs")
+          (check? #f)
+          (flags '(no-suid no-dev no-exec))
+          (options "mode=0755")
+          (create-mount-point? #t))))
+
+(define %greetd-pam-mount-rules
+  `((debug (@ (enable "0")))
+    (volume (@ (sgrp "users")
+               (fstype "tmpfs")
+               (mountpoint "/run/user/%(USERUID)")
+               (options "noexec,nosuid,nodev,size=1g,mode=0700,uid=%(USERUID),gid=%(USERGID)")))
+    (logout (@ (wait "0")
+               (hup "0")
+               (term "yes")
+               (kill "no")))
+    (mkmountpoint (@ (enable "1") (remove "true")))))
+
+(define-record-type* <greetd-configuration>
+  greetd-configuration make-greetd-configuration
+  greetd-configuration?
+  (motd greetd-motd (default %default-motd))
+  (allow-empty-passwords? greetd-allow-empty-passwords? (default #t))
+  (terminals greetd-terminals (default '())))
+
+(define (make-greetd-pam-mount-conf-file config)
+  (computed-file
+   "greetd_pam_mount.conf.xml"
+   #~(begin
+       (use-modules (sxml simple))
+       (call-with-output-file #$output
+         (lambda (port)
+           (sxml->xml
+            '(*TOP*
+              (*PI* xml "version='1.0' encoding='utf-8'")
+              (pam_mount
+               #$@%greetd-pam-mount-rules
+               (pmvarrun
+                #$(file-append greetd-pam-mount
+                               "/sbin/pmvarrun -u '%(USER)' -o '%(OPERATION)'"))))
+            port))))))
+
+(define (greetd-etc-service config)
+  `(("security/greetd_pam_mount.conf.xml"
+     ,(make-greetd-pam-mount-conf-file config))))
+
+(define (greetd-pam-service config)
+  (define optional-pam-mount
+    (pam-entry
+     (control "optional")
+     (module #~(string-append #$greetd-pam-mount "/lib/security/pam_mount.so"))
+     (arguments '("disable_interactive"))))
+
+  (list
+   (unix-pam-service "greetd"
+                     #:login-uid? #t
+                     #:allow-empty-passwords?
+                     (greetd-allow-empty-passwords? config)
+                     #:motd
+                     (greetd-motd config))
+   (lambda (pam)
+     (if (member (pam-service-name pam)
+                 '("login" "greetd" "su" "slim" "gdm-password"))
+         (pam-service
+          (inherit pam)
+          (auth (append (pam-service-auth pam)
+                        (list optional-pam-mount)))
+          (session (append (pam-service-session pam)
+                           (list optional-pam-mount))))
+         pam))))
+
+(define (greetd-shepherd-services config)
+  (map
+   (lambda (tc)
+     (let*
+         ((greetd-bin (file-append (greetd-package tc) "/sbin/greetd"))
+          (greetd-conf (make-greetd-terminal-configuration-file tc))
+          (greetd-log (greetd-log-file-name tc))
+          (greetd-vt (greetd-terminal-vt tc)))
+       (shepherd-service
+        (documentation "Minimal and flexible login manager daemon")
+        (requirement '(user-processes host-name udev virtual-terminal))
+        (provision (list (symbol-append
+                          'term-tty
+                          (string->symbol (greetd-terminal-vt tc)))))
+        (start #~(make-forkexec-constructor
+                  (list #$greetd-bin "-c" #$greetd-conf)
+                  #:log-file #$greetd-log))
+        (stop #~(make-kill-destructor)))))
+   (greetd-terminals config)))
+
+(define greetd-service-type
+  (service-type
+   (name 'greetd)
+   (description "Provides necessary infrastructure for logging into the
+system including @code{greetd} PAM service, @code{pam-mount} module to
+mount/unmount /run/user/<uid> directory for user and @code{greetd}
+login manager daemon.")
+   (extensions
+    (list
+     (service-extension account-service-type (const %greetd-accounts))
+     (service-extension file-system-service-type (const %greetd-file-systems))
+     (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)))
+   (default-value (greetd-configuration))))
+
 \f
 (define %base-services
   ;; Convenience variable holding the basic services.
diff --git a/gnu/services/pam-mount.scm b/gnu/services/pam-mount.scm
index 33649b0f7c..e60781d05b 100644
--- a/gnu/services/pam-mount.scm
+++ b/gnu/services/pam-mount.scm
@@ -90,7 +90,7 @@ (define optional-pam-mount
      (module #~(string-append #$pam-mount "/lib/security/pam_mount.so"))))
   (list (lambda (pam)
           (if (member (pam-service-name pam)
-                      '("login" "su" "slim" "gdm-password" "sddm"))
+                      '("login" "greetd" "su" "slim" "gdm-password" "sddm"))
               (pam-service
                (inherit pam)
                (auth (append (pam-service-auth pam)
-- 
2.36.1

[bug#49969] [PATCH v10 5/7] gnu: admin: Add libseat 0.8.0 and move seatd.

[muradm]

* gnu/packages/admin.scm (libseat): New variable
* gnu/packages/admin.scm (seatd): New variable
* gnu/packages/freedesktop.scm (seatd): Remove variable
* gnu/packages/wm.scm (wlroots): Replace seatd input with libseat
---
 gnu/packages/admin.scm       | 53 ++++++++++++++++++++++++++++++++++++
 gnu/packages/freedesktop.scm | 29 --------------------
 gnu/packages/wm.scm          |  4 ++-
 3 files changed, 56 insertions(+), 30 deletions(-)

diff --git a/gnu/packages/admin.scm b/gnu/packages/admin.scm
index d6e1d819ab..eb6450b4da 100644
--- a/gnu/packages/admin.scm
+++ b/gnu/packages/admin.scm
@@ -46,6 +46,7 @@
 ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
 ;;; Copyright © 2021 muradm <mail@muradm.net>
+;;; Copyright © 2021 pineapples <guixuser6392@protonmail.com>
 ;;; Copyright © 2021 Petr Hodina <phodina@protonmail.com>
 ;;; Copyright © 2021 Artyom V. Poptsov <poptsov.artyom@gmail.com>
 ;;; Copyright © 2022 Wamm K. D. <jaft.r@outlook.com>
@@ -104,6 +105,7 @@ (define-module (gnu packages admin)
   #:use-module (gnu packages elf)
   #:use-module (gnu packages file)
   #:use-module (gnu packages flex)
+  #:use-module (gnu packages freedesktop)
   #:use-module (gnu packages gawk)
   #:use-module (gnu packages gettext)
   #:use-module (gnu packages gl)
@@ -5097,3 +5099,54 @@ (define-public greetd-pam-mount
 greetd-pam-mount is used in configuration of greetd to provide
 auto-(mounting/unmounting) of XDG_RUNTIME_DIR in the way that it will not
 interfere with default pam-mount configuration.")))
+
+(define-public libseat
+  (package
+    (name "libseat")
+    (version "0.7.0")
+    (source (origin
+              (method git-fetch)
+              (uri (git-reference
+                    (url "https://git.sr.ht/~kennylevinsen/seatd")
+                    (commit version)))
+              (file-name (git-file-name name version))
+              (sha256
+               (base32
+                "10f8387yy5as547xjjhl0cna6iywdgjmw0iq2nvcs8q6vlpnik4v"))))
+    (build-system meson-build-system)
+    (arguments
+     `(#:configure-flags '("-Dlibseat-logind=elogind"
+                           "-Dserver=disabled")))
+    (native-inputs
+     `(("pkg-config" ,pkg-config)))
+    (propagated-inputs
+     `(("elogind" ,elogind)))
+    (home-page "https://sr.ht/~kennylevinsen/seatd")
+    (synopsis "Seat management library")
+    (description
+     "This package provides a universal seat management library that
+allows applications to use whatever seat management is available.")
+    (license license:expat)))
+
+(define-public seatd
+  (package
+    (inherit libseat)
+    (name "seatd")
+    (arguments
+     `(#:configure-flags '("-Dlibseat-logind=elogind")
+       #:phases
+       (modify-phases %standard-phases
+         (add-after 'install 'remove-libs
+           (lambda* (#:key outputs #:allow-other-keys)
+             (with-directory-excursion (assoc-ref outputs "out")
+               (for-each delete-file-recursively '("lib" "include"))))))))
+    (native-inputs
+     `(("pkg-config" ,pkg-config)
+       ("scdoc" ,scdoc)))
+    (inputs '())
+    (synopsis "Seat management daemon")
+    (description
+     "This package provides a minimal seat management daemon whose task is to
+mediate access to shared devices, such as graphics and input, for applications
+that require it.")
+    (license license:expat)))
diff --git a/gnu/packages/freedesktop.scm b/gnu/packages/freedesktop.scm
index fc2c45c1f1..309876867a 100644
--- a/gnu/packages/freedesktop.scm
+++ b/gnu/packages/freedesktop.scm
@@ -849,35 +849,6 @@ (define (source-file regexp)
 with localed.  This package is extracted from the broader systemd package.")
     (license license:lgpl2.1+)))
 
-(define-public seatd
-  (package
-    (name "seatd")
-    (version "0.5.0")
-    (source (origin
-              (method git-fetch)
-              (uri (git-reference
-                    (url "https://git.sr.ht/~kennylevinsen/seatd")
-                    (commit version)))
-              (file-name (git-file-name name version))
-              (sha256
-               (base32
-                "1kglq8v4rnr3415mfaghyv2s2f8mxsy5s881gmm2908ig4n4j297"))))
-    (build-system meson-build-system)
-    (arguments
-     `(#:configure-flags '("-Dlogind=enabled")))
-    (native-inputs
-     (list pkg-config scdoc))
-    (propagated-inputs
-     (list elogind))
-    (home-page "https://sr.ht/~kennylevinsen/seatd")
-    (synopsis "Seat management daemon and library")
-    (description
-     "This package provides a minimal seat management daemon whose task is to
-mediate access to shared devices, such as graphics and input, for applications
-that require it.  It also provides a universal seat management library that
-allows applications to use whatever seat management is available.")
-    (license license:expat)))
-
 (define-public packagekit
   (package
     (name "packagekit")
diff --git a/gnu/packages/wm.scm b/gnu/packages/wm.scm
index 123e6ca7e7..24d95ba86c 100644
--- a/gnu/packages/wm.scm
+++ b/gnu/packages/wm.scm
@@ -54,6 +54,7 @@
 ;;; Copyright © 2022 Daniel Meißner <daniel.meissner-i4k@ruhr-uni-bochum.de>
 ;;; Copyright © 2022 Pier-Hugues Pellerin <ph@heykimo.com>
 ;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2022 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -88,6 +89,7 @@ (define-module (gnu packages wm)
   #:use-module (guix utils)
   #:use-module (gnu packages)
   #:use-module (gnu packages bash)
+  #:use-module (gnu packages admin)
   #:use-module (gnu packages autotools)
   #:use-module (gnu packages base)
   #:use-module (gnu packages bison)
@@ -1537,7 +1539,7 @@ (define-public wlroots
            libxkbcommon
            mesa
            pixman
-           seatd
+           libseat
            wayland
            wayland-protocols
            xcb-util-errors
-- 
2.36.1

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

[muradm]

* gnu/services/desktop.scm (seatd-service-type): New variable
* gnu/services/desktop.scm (seatd-configuration): New data type

fix seatd path
---
 doc/guix.texi            | 46 +++++++++++++++++++++++++++++
 gnu/services/desktop.scm | 62 +++++++++++++++++++++++++++++++++++++++-
 2 files changed, 107 insertions(+), 1 deletion(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 997b93c831..799ea932d7 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -22661,6 +22661,52 @@ and ``passwd'' is with the value @code{passwd}.
 @end table
 @end deftp
 
+@defvr {Scheme Variable} seatd-service-type
+@uref{https://sr.ht/~kennylevinsen/seatd/, seatd} is a minimal seat
+management daemon.
+
+Seat management takes care of mediating access to shared devices (graphics,
+input), without requiring the applications needing access to be root.
+
+@lisp
+(append
+  (list
+   ;; make sure seatd is running
+   (service seatd-service-type))
+
+  ;; normally one would want %base-services
+  %base-services)
+
+@end lisp
+@end defvr
+
+@deftp {Data Type} seatd-configuration
+Configuration record for the seatd daemon service.
+
+@table @asis
+@item @code{seatd} (default: @code{seatd})
+The seatd package to use.
+
+@item @code{user} (default: @samp{"root"})
+User to own the seatd socket.
+
+@item @code{group} (default: @samp{"users"})
+Group to own the seatd socket.
+
+@item @code{socket} (default: @samp{"/run/seatd.sock"})
+Where to create the seatd socket.
+
+@item @code{logfile} (default: @samp{"/var/log/seatd.log"})
+Log file to write to.
+
+@item @code{loglevel} (default: @samp{"error"})
+Log level to output logs. Possible values: @samp{"silent"}, @samp{"error"},
+@samp{"info"} and @samp{"debug"}.
+
+@end table
+@end deftp
+
+
 @node Sound Services
 @subsection Sound Services
 
diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index 0499071436..29a3722f1b 100644
--- a/gnu/services/desktop.scm
+++ b/gnu/services/desktop.scm
@@ -13,6 +13,7 @@
 ;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2020 Reza Alizadeh Majd <r.majd@pantherx.org>
 ;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -39,7 +40,9 @@ (define-module (gnu services desktop)
   #:use-module (gnu services networking)
   #:use-module (gnu services sound)
   #:use-module ((gnu system file-systems)
-                #:select (%elogind-file-systems file-system))
+                #:select (%control-groups
+                          %elogind-file-systems
+                          file-system))
   #:autoload   (gnu services sddm) (sddm-service-type)
   #:use-module (gnu system)
   #:use-module (gnu system setuid)
@@ -157,6 +160,9 @@ (define-module (gnu services desktop)
             gnome-keyring-configuration?
             gnome-keyring-service-type
 
+            seatd-configuration
+            seatd-service-type
+
             %desktop-services))
 
 ;;; Commentary:
@@ -1630,6 +1636,60 @@ (define polkit-wheel
 (define polkit-wheel-service
   (simple-service 'polkit-wheel polkit-service-type (list polkit-wheel)))
 
+\f
+;;;
+;;; seatd-service-type -- minimal seat management daemon
+;;;
+
+(define-record-type* <seatd-configuration> seatd-configuration
+  make-seatd-configuration
+  seatd-configuration?
+  (seatd seatd-package (default seatd))
+  (user seatd-user (default "root"))
+  (group seatd-group (default "users"))
+  (socket seatd-socket (default "/run/seatd.sock"))
+  (logfile seatd-logfile (default "/var/log/seatd.log"))
+  (loglevel seatd-loglevel (default "info")))
+
+(define (seatd-shepherd-service config)
+  (list (shepherd-service
+         (documentation "Minimal seat management daemon")
+         (requirement '())
+         ;; TODO: once cgroups is separate dependency
+         ;; here we should depend on it rather than elogind
+         (provision '(seatd elogind))
+         (start #~(make-forkexec-constructor
+                   (list #$(file-append (seatd-package config) "/bin/seatd")
+                         "-u" #$(seatd-user config)
+                         "-g" #$(seatd-group config))
+                   #:environment-variables
+                   (list (string-append "SEATD_LOGLEVEL="
+                                        #$(seatd-loglevel config))
+                         (string-append "SEATD_DEFAULTPATH="
+                                        #$(seatd-socket config)))
+                   #:log-file #$(seatd-logfile config)))
+         (stop #~(make-kill-destructor)))))
+
+(define seatd-environment
+  (match-lambda
+    (($ <seatd-configuration> _ _ _ socket)
+     `(("SEATD_SOCK" . ,socket)))))
+
+(define seatd-service-type
+  (service-type
+   (name 'seatd)
+   (description "Seat management takes care of mediating access
+to shared devices (graphics, input), without requiring the
+applications needing access to be root.")
+   (extensions
+    (list
+     (service-extension session-environment-service-type seatd-environment)
+     ;; TODO: once cgroups is separate dependency we should not mount it here
+     ;; for now it is mounted here, because elogind mounts it
+     (service-extension file-system-service-type (const %control-groups))
+     (service-extension shepherd-root-service-type seatd-shepherd-service)))
+   (default-value (seatd-configuration))))
+
 \f
 ;;;
 ;;; The default set of desktop services.
-- 
2.36.1

[bug#49969] [PATCH v10 7/7] gnu: tests: Add seatd/greetd based minimal desktop system tests.

[muradm]

* gnu/tests/desktop.scm (minimal-desktop): seatd/greetd based
minimal desktop test
---
 gnu/tests/desktop.scm | 212 +++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 211 insertions(+), 1 deletion(-)

diff --git a/gnu/tests/desktop.scm b/gnu/tests/desktop.scm
index 57069c0ede..7cc837f42e 100644
--- a/gnu/tests/desktop.scm
+++ b/gnu/tests/desktop.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -18,13 +19,17 @@
 
 (define-module (gnu tests desktop)
   #:use-module (gnu tests)
+  #:use-module (gnu packages shells)
   #:use-module (gnu services)
+  #:use-module (gnu services base)
   #:use-module (gnu services dbus)
   #:use-module (gnu services desktop)
+  #:use-module (gnu system)
   #:use-module (gnu system vm)
   #:use-module (guix gexp)
   #:use-module (srfi srfi-1)
-  #:export (%test-elogind))
+  #:export (%test-elogind
+            %test-minimal-desktop))
 
 \f
 ;;;
@@ -100,3 +105,208 @@ (define %test-elogind
                #:imported-modules '((gnu services herd)
                                     (guix combinators)))))
       (run-elogind-test (virtual-machine os))))))
+
+\f
+;;;
+;;; Seatd/greetd based minimal desktop
+;;;
+
+(define %minimal-services
+  (append
+   (modify-services %base-services
+     ;; greetd-service-type provides "greetd" PAM service
+     (delete login-service-type)
+     ;; and can be used in place of mingetty-service-type
+     (delete mingetty-service-type))
+   (list
+    (service seatd-service-type)
+    (service greetd-service-type
+             (greetd-configuration
+              (terminals
+               (list
+                ;; we can make any terminal active by default
+                (greetd-terminal-configuration (terminal-vt "1") (terminal-switch #t))
+                ;; we can make environment without XDG_RUNTIME_DIR set
+                ;; even provide our own environment variables
+                (greetd-terminal-configuration
+                 (terminal-vt "2")
+                 (default-session-command
+                   (greetd-agreety-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")))))
+                ;; we can use any other executable command as greeter
+                (greetd-terminal-configuration
+                 (terminal-vt "4")
+                 (default-session-command (program-file "my-noop-greeter" #~(exit))))
+                (greetd-terminal-configuration (terminal-vt "5"))
+                (greetd-terminal-configuration (terminal-vt "6"))))))
+    ;; mingetty-service-type can be used in parallel
+    ;; if needed to do so, do not (delete login-service-type)
+    ;; as illustrated above
+    #| (service mingetty-service-type (mingetty-configuration (tty "tty8"))) |#)))
+
+(define-syntax-rule (minimal-operating-system user-services ...)
+  "Return an operating system that includes USER-SERVICES in addition to
+minimal %BASE-SERVICES."
+  (operating-system (inherit %simple-os)
+                    (services (cons* user-services ... %minimal-services))))
+
+(define (run-minimal-desktop-test os vm)
+  (define test
+    (with-imported-modules '((gnu build marionette)
+                             (guix build syscalls))
+      #~(begin
+          (use-modules (gnu build marionette)
+                       (guix build syscalls)
+                       (srfi srfi-1)
+                       (srfi srfi-64)
+                       (ice-9 pretty-print))
+
+          (define marionette
+            (make-marionette #$vm))
+
+          (define (file-get-all-strings fname)
+            (marionette-eval '(use-modules (rnrs io ports)) marionette)
+            (wait-for-file fname marionette #:read 'get-string-all))
+
+          (define (wait-for-unix-socket-m socket)
+            (wait-for-unix-socket socket marionette))
+
+          (mkdir #$output)
+          (chdir #$output)
+
+          (test-begin "minimal-desktop")
+
+          (test-assert "seatd is ready"
+            (wait-for-unix-socket-m "/run/seatd.sock"))
+
+          (test-equal "login user on tty1"
+            "alice\n"
+            (begin
+              ;; Wait for tty1.
+              (marionette-eval
+               '(begin
+                  (use-modules (gnu services herd))
+                  (start-service 'term-tty1))
+               marionette)
+              (marionette-control "sendkey ctrl-alt-f1" marionette)
+
+              ;; login as root change alice password and exit
+              ;; then login as alice
+              (for-each
+               (lambda (cmd) (marionette-type cmd marionette) (sleep 1))
+               (list
+                "root\n"
+                "passwd alice\n"
+                "alice\n"
+                "alice\n"
+                "exit\n"
+                "alice\n"
+                "alice\n"
+                "id -un > logged-in\n"))
+
+              (file-get-all-strings "/home/alice/logged-in")))
+
+          (test-equal "validate user environment"
+            '("SEATD_SOCK=/run/seatd.sock"
+              "XDG_RUNTIME_DIR=/run/user/1000"
+              "XDG_SEAT=seat0"
+              "XDG_VTNR=1")
+
+            (begin
+              (marionette-type "env > env\n" marionette)
+              (sleep 1)
+
+              (define user-env (string-tokenize
+                                (file-get-all-strings "/home/alice/env")))
+
+              (define (expected-var var)
+                (any (lambda (s) (string-contains var s))
+                     '("SEATD_SOCK"
+                       "XDG_RUNTIME_DIR"
+                       "XDG_SEAT"
+                       "XDG_VTNR")))
+
+              (sort (filter expected-var user-env) string<?)))
+
+          (test-assert "validate SEATD_SOCK and GREETD_SOCK"
+            (begin
+              (marionette-type "env > env\n" marionette)
+              (sleep 1)
+
+              (define (sock-var? var)
+                (any (lambda (s) (string-contains var s))
+                     '("SEATD_SOCK" "GREETD_SOCK")))
+
+              (define (sock-var-sock var)
+                (car (cdr (string-split var #\=))))
+
+              (let*
+                  ((out (file-get-all-strings "/home/alice/env"))
+                   (out (string-tokenize out))
+                   (out (filter sock-var? out))
+                   (socks (map sock-var-sock out))
+                   (socks (map wait-for-unix-socket-m socks)))
+                (and (= 2 (length socks)) (every identity socks)))))
+
+          (test-assert "greetd is ready"
+            (begin
+              (marionette-type "ps -C greetd -o pid,args --no-headers > ps-greetd\n"
+                               marionette)
+              (sleep 1)
+
+              (define (greetd-daemon? cmd)
+                (string-contains cmd "config"))
+
+              (define (greetd-cmd-to-pid cmd)
+                (car (string-split cmd #\space)))
+
+              (define (greetd-pid-to-sock pid)
+                (string-append "/run/greetd-" pid ".sock"))
+
+              (let* ((out (file-get-all-strings "/home/alice/ps-greetd"))
+                     (out (string-split out #\newline))
+                     (out (map string-trim-both out))
+                     (out (filter greetd-daemon? out))
+                     (pids (map greetd-cmd-to-pid out))
+                     (socks (map greetd-pid-to-sock pids))
+                     (socks (map wait-for-unix-socket-m socks)))
+                (every identity socks))))
+
+          ;; a bit weak, but tests everything at once actually
+          (test-equal "check /run/user/<uid> mounted and writable"
+            "alice\n"
+            (begin
+              (marionette-type "echo alice > /run/user/1000/test\n" marionette)
+              (file-get-all-strings "/run/user/1000/test")))
+
+          (test-assert "screendump"
+            (begin
+              (marionette-control (string-append "screendump " #$output
+                                                 "/tty1.ppm")
+                                  marionette)
+              (file-exists? "tty1.ppm")))
+
+          (test-end)
+          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+  (gexp->derivation "minimal-desktop" test))
+
+(define %test-minimal-desktop
+  (system-test
+   (name "minimal-desktop")
+   (description
+    "Test whether we can log in when seatd and greetd is enabled")
+   (value
+    (let* ((os (marionette-operating-system
+                (minimal-operating-system)
+                #:imported-modules '((gnu services herd)
+                                     (guix combinators))))
+           (vm (virtual-machine os)))
+      (run-minimal-desktop-test (virtualized-operating-system os '())
+                                #~(list #$vm))))))
-- 
2.36.1

[bug#49969] [PATCH v10 1/7] gnu: crates-io: Add rust-enquote 1.1.0 and rust-pam-sys 0.5.6.

[Maxime Devos]

[-- Attachment #1: Type: text/plain, Size: 709 bytes --]

* gnu/packages/crates-io.scm (rust-enquote-1): New variable
* gnu/packages/crates-io.scm (rust-pam-sys-0.5): New variable

Only a single independent change per patch.

muradm schreef op ma 13-06-2022 om 11:45 [+0300]:
> +    (native-inputs `(("linux-pam" ,linux-pam)))

Most likely not a native input but a non-native input that needs to be
cross-compiled when rust-pam-sys is cross-compiled.

> +    (synopsis
> +     "Rust FFI wrappers for the Linux Pluggable Authentication Modules (PAM)")
> +    (description
> +     "Rust FFI wrappers for the Linux Pluggable Authentication Modules (PAM)")

Description is missing, this just repeats the synopsis.

Greetings,
Maxime.

[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]

[bug#49969] [PATCH v11 0/8] Re: [bug#49969] [PATCH v10 1/7] gnu: crates-io: Add rust-enquote 1.1.0 and rust-pam-sys 0.5.6.

[muradm]

Fixing as suggested:
* splitting rust packages to commit per package
* linux-pam should be in 'inputs
* varying description

Thanks in advance,
muradm

muradm (8):
  gnu: crates-io: Add rust-enquote 1.1.0.
  gnu: crates-io: Add rust-pam-sys 0.5.6.
  gnu: admin: Add greetd 0.8.0.
  gnu: admin: Add greetd-pam-mount.
  gnu: base: Add greetd-service-type.
  gnu: admin: Add libseat 0.8.0 and move seatd.
  gnu: desktop: Add seatd-service-type.
  gnu: tests: Add seatd/greetd based minimal desktop system tests.

 doc/guix.texi                | 183 ++++++++++++++++++++++++++++
 gnu/packages/admin.scm       | 162 +++++++++++++++++++++++++
 gnu/packages/crates-io.scm   |  40 +++++++
 gnu/packages/freedesktop.scm |  29 -----
 gnu/packages/wm.scm          |   4 +-
 gnu/services/base.scm        | 223 ++++++++++++++++++++++++++++++++++-
 gnu/services/desktop.scm     |  62 +++++++++-
 gnu/services/pam-mount.scm   |   2 +-
 gnu/tests/desktop.scm        | 212 ++++++++++++++++++++++++++++++++-
 9 files changed, 883 insertions(+), 34 deletions(-)

-- 
2.36.1

[bug#49969] [PATCH v11 1/8] gnu: crates-io: Add rust-enquote 1.1.0.

[muradm]

* gnu/packages/crates-io.scm (rust-enquote-1): New variable
---
 gnu/packages/crates-io.scm | 18 ++++++++++++++++++
 1 file changed, 18 insertions(+)

diff --git a/gnu/packages/crates-io.scm b/gnu/packages/crates-io.scm
index 86313f5e4f..a4d381899e 100644
--- a/gnu/packages/crates-io.scm
+++ b/gnu/packages/crates-io.scm
@@ -19,6 +19,7 @@
 ;;; Copyright © 2021 Antero Mejr <antero@kodmin.com>
 ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2021 Vinicius Monego <monego@posteo.net>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;; Copyright © 2021, 2022 Petr Hodina <phodina@protonmail.com>
 ;;; Copyright © 2021, 2022 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2021 Jacob Hrbek <kreyren@rixotstudio.cz>
@@ -73053,3 +73054,20 @@ (define-public rust-shell2batch-0.4
 and automatically convert it to a windows batch file, this library provides a
 way to convert simple shell commands to windows batch commands.")
     (license license:asl2.0)))
+
+(define-public rust-enquote-1
+  (package
+    (name "rust-enquote")
+    (version "1.1.0")
+    (home-page "https://github.com/reujab/enquote")
+    (source (origin
+              (method url-fetch)
+              (uri (crate-uri "enquote" version))
+              (file-name (string-append name "-" version ".tar.gz"))
+              (sha256
+               (base32
+                "0clrjghlfkkb7sndabs5wch0fz2nif6nj4b117s8kqxx3nqnrhq6"))))
+    (build-system cargo-build-system)
+    (synopsis "Rust library that quotes, unquotes, and unescapes strings")
+    (description "A Rust library quotes, unquotes, and unescapes strings")
+    (license license:unlicense)))
-- 
2.36.1

[bug#49969] [PATCH v11 2/8] gnu: crates-io: Add rust-pam-sys 0.5.6.

[muradm]

* gnu/packages/crates-io.scm (rust-pam-sys-0.5): New variable
---
 gnu/packages/crates-io.scm | 22 ++++++++++++++++++++++
 1 file changed, 22 insertions(+)

diff --git a/gnu/packages/crates-io.scm b/gnu/packages/crates-io.scm
index a4d381899e..f93b9b0eea 100644
--- a/gnu/packages/crates-io.scm
+++ b/gnu/packages/crates-io.scm
@@ -73071,3 +73071,25 @@ (define-public rust-enquote-1
     (synopsis "Rust library that quotes, unquotes, and unescapes strings")
     (description "A Rust library quotes, unquotes, and unescapes strings")
     (license license:unlicense)))
+
+(define-public rust-pam-sys-0.5
+  (package
+    (name "rust-pam-sys")
+    (version "0.5.6")
+    (home-page "https://github.com/1wilkens/pam-sys")
+    (source (origin
+              (method url-fetch)
+              (uri (crate-uri "pam-sys" version))
+              (file-name (string-append name "-" version ".tar.gz"))
+              (sha256
+               (base32
+                "0d14501d5vybjnzxfjf96321xa5wa36x1xvf02h02zq938qmhj6d"))))
+    (build-system cargo-build-system)
+    (arguments
+     `(#:cargo-inputs (("rust-libc" ,rust-libc-0.2))))
+    (inputs `(("linux-pam" ,linux-pam)))
+    (synopsis
+     "Rust FFI wrappers for the Linux Pluggable Authentication Modules (PAM)")
+    (description
+     "This crate uses bindgen to generate the raw FFI definitions for PAM. For a rustified API consider using pam.")
+    (license (list license:expat license:asl2.0))))
-- 
2.36.1

[bug#49969] [PATCH v11 3/8] gnu: admin: Add greetd 0.8.0.

[muradm]

* gnu/packages/admin.scm (greetd): New variable
---
 gnu/packages/admin.scm | 77 ++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 77 insertions(+)

diff --git a/gnu/packages/admin.scm b/gnu/packages/admin.scm
index 6acfff8881..73d70744e1 100644
--- a/gnu/packages/admin.scm
+++ b/gnu/packages/admin.scm
@@ -45,6 +45,7 @@
 ;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
 ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;; Copyright © 2021 Petr Hodina <phodina@protonmail.com>
 ;;; Copyright © 2021 Artyom V. Poptsov <poptsov.artyom@gmail.com>
 ;;; Copyright © 2022 Wamm K. D. <jaft.r@outlook.com>
@@ -66,6 +67,7 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu packages admin)
+  #:use-module (guix build-system cargo)
   #:use-module (guix build-system cmake)
   #:use-module (guix build-system emacs)
   #:use-module (guix build-system glib-or-gtk)
@@ -93,6 +95,7 @@ (define-module (gnu packages admin)
   #:use-module (gnu packages c)
   #:use-module (gnu packages check)
   #:use-module (gnu packages compression)
+  #:use-module (gnu packages crates-io)
   #:use-module (gnu packages cross-base)
   #:use-module (gnu packages crypto)
   #:use-module (gnu packages cryptsetup)
@@ -4987,4 +4990,78 @@ (define-public udpcast
     (home-page "https://www.udpcast.linux.lu")
     (license license:gpl2+)))
 
+(define-public greetd
+  (package
+    (name "greetd")
+    (version "0.8.0")
+    (home-page "https://git.sr.ht/~kennylevinsen/greetd")
+    (source (origin
+              (method git-fetch)
+              (uri (git-reference
+                    (url home-page)
+                    (commit version)))
+              (file-name (git-file-name name version))
+              (sha256
+               (base32 "0x5c3jkw09kvj2grcxm899y2n6ws8p990cyp9cs0fy6lm4fzlh6v"))))
+    (build-system cargo-build-system)
+    (arguments
+     `(#:cargo-inputs
+       (("rust-nix" ,rust-nix-0.19)
+        ("rust-pam-sys" ,rust-pam-sys-0.5)
+        ("rust-rpassword" ,rust-rpassword-5)
+        ("rust-users" ,rust-users-0.11)
+        ("rust-serde" ,rust-serde-1)
+        ("rust-serde-json" ,rust-serde-json-1)
+        ("rust-libc" ,rust-libc-0.2)
+        ("rust-tokio" ,rust-tokio-1)
+        ("rust-getopts" ,rust-getopts-0.2)
+        ("rust-thiserror" ,rust-thiserror-1)
+        ("rust-async-trait" ,rust-async-trait-0.1)
+        ("rust-enquote" ,rust-enquote-1))
+       #:phases
+       (modify-phases %standard-phases
+         (delete 'package)
+         (add-after 'build 'build-man-pages
+           (lambda* (#:key inputs #:allow-other-keys)
+             (define (scdoc-cmd doc lvl)
+               (system (string-append "scdoc < "
+                                      doc "-" lvl ".scd > "
+                                      doc "." lvl)))
+             (with-directory-excursion "man"
+               (scdoc-cmd "greetd" "1")
+               (scdoc-cmd "greetd" "5")
+               (scdoc-cmd "greetd-ipc" "7")
+               (scdoc-cmd "agreety" "1"))))
+         (replace 'install
+           (lambda* (#:key inputs outputs #:allow-other-keys)
+             (let* ((out (assoc-ref outputs "out"))
+                    (bin (string-append out "/bin"))
+                    (sbin (string-append out "/sbin"))
+                    (share (string-append out "/share"))
+                    (man (string-append share "/man"))
+                    (man1 (string-append man "/man1"))
+                    (man5 (string-append man "/man5"))
+                    (man7 (string-append man "/man7"))
+                    (release "target/release")
+                    (greetd-bin (string-append release "/greetd"))
+                    (agreety-bin (string-append release "/agreety")))
+               (install-file greetd-bin sbin)
+               (install-file agreety-bin bin)
+               (with-directory-excursion "man"
+                 (install-file "greetd.1" man1)
+                 (install-file "greetd.5" man5)
+                 (install-file "greetd-ipc.7" man7)
+                 (install-file "agreety.1" man1))))))))
+    (native-inputs
+     `(("linux-pam" ,linux-pam)
+       ("scdoc" ,scdoc)))
+    (synopsis "minimal and flexible login manager daemon")
+    (description
+     "greetd is a minimal and flexible login manager daemon
+that makes no assumptions about what you want to launch.
 
+If you can run it from your shell in a TTY, greetd can start it.
+
+If it can be taught to speak a simple JSON-based IPC protocol,
+then it can be a greeter.")
+    (license license:gpl3+)))
-- 
2.36.1

[bug#49969] [PATCH v11 4/8] gnu: admin: Add greetd-pam-mount.

[muradm]

* gnu/packages/admin.scm (greetd-pam-mount): New variable
---
 gnu/packages/admin.scm | 32 ++++++++++++++++++++++++++++++++
 1 file changed, 32 insertions(+)

diff --git a/gnu/packages/admin.scm b/gnu/packages/admin.scm
index 73d70744e1..d6e1d819ab 100644
--- a/gnu/packages/admin.scm
+++ b/gnu/packages/admin.scm
@@ -5065,3 +5065,35 @@ (define (scdoc-cmd doc lvl)
 If it can be taught to speak a simple JSON-based IPC protocol,
 then it can be a greeter.")
     (license license:gpl3+)))
+
+(define-public greetd-pam-mount
+  (package
+    (inherit pam-mount)
+    (name "greetd-pam-mount")
+    (arguments
+     (substitute-keyword-arguments (package-arguments pam-mount)
+       ((#:configure-flags flags ''())
+        #~(cons* "--with-rundir=/run/greetd" #$flags))
+       ((#:phases phases)
+        #~(modify-phases #$phases
+           (add-after 'unpack 'patch-config-file-name
+             (lambda* (#:key inputs #:allow-other-keys)
+               (substitute* "src/pam_mount.c"
+                 ((".*define CONFIGFILE .*$")
+                  "#define CONFIGFILE \"/etc/security/greetd_pam_mount.conf.xml\"\n")
+                 (("pam_mount_config") "greetd_pam_mount_config")
+                 (("pam_mount_system_authtok") "greetd_pam_mount_system_authtok"))))))))
+    (synopsis "pam-mount specifically compiled for use with greetd")
+    (description
+     "Pam-mount is a PAM module that can mount volumes when a user logs in.
+It supports mounting local filesystems of any kind the normal mount utility
+supports.  It can also mount encrypted LUKS volumes using the password
+supplied by the user when logging in.
+
+This package inherits pam-mount in the way that it is compiled specifically
+for use with greetd daemon. It uses different configuration location and
+name space for storing data in PAM.
+
+greetd-pam-mount is used in configuration of greetd to provide
+auto-(mounting/unmounting) of XDG_RUNTIME_DIR in the way that it will not
+interfere with default pam-mount configuration.")))
-- 
2.36.1

[bug#49969] [PATCH v11 5/8] gnu: base: Add greetd-service-type.

[muradm]

* gnu/services/base.scm (greetd-service-type): New variable
* gnu/services/base.scm (greetd-configuration): New data type
* gnu/services/base.scm (greetd-terminal-configuration): New data type
* gnu/services/base.scm (greetd-agreety-session): New data type
* gnu/services/base.scm (pam-limits-service-type): Shoul be aware of
greetd PAM service
* gnu/services/pam-mount.scm (pam-mount-pam-service): Shoul be aware
of greetd PAM service
---
 doc/guix.texi              | 137 +++++++++++++++++++++++
 gnu/services/base.scm      | 223 ++++++++++++++++++++++++++++++++++++-
 gnu/services/pam-mount.scm |   2 +-
 3 files changed, 360 insertions(+), 2 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index ea133d519a..997b93c831 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -96,6 +96,7 @@ Copyright @copyright{} 2021 Domagoj Stolfa@*
 Copyright @copyright{} 2021 Hui Lu@*
 Copyright @copyright{} 2021 pukkamustard@*
 Copyright @copyright{} 2021 Alice Brenon@*
+Copyright @copyright{} 2021 muradm@*
 Copyright @copyright{} 2021 Josselin Poiret@*
 Copyright @copyright{} 2021 Andrew Tropin@*
 Copyright @copyright{} 2021 Sarah Morgensen@*
@@ -18019,6 +18020,142 @@ about the Pluggable Authentication Module (PAM) limits, refer to the
 @samp{pam_limits} man page from the @code{linux-pam} package.
 @end deffn
 
+@defvr {Scheme Variable} greetd-service-type
+@uref{https://git.sr.ht/~kennylevinsen/greetd, @code{greetd}} is a minimal and
+flexible login manager daemon, that makes no assumptions about what you
+want to launch.
+
+If you can run it from your shell in a TTY, greetd can start it. If it
+can be taught to speak a simple JSON-based IPC protocol, then it can be
+a geeter.
+
+@code{greetd-service-type} provides necessary infrastructure for logging
+in users, including:
+
+@itemize @bullet
+@item
+@code{greetd} PAM service
+
+@item
+Special variation of @code{pam-mount} to mount @code{XDG_RUNTIME_DIR}
+@end itemize
+
+Here is example of switching from @code{mingetty-service-type} to
+@code{greetd-service-type}, and how different terminals could be:
+
+@lisp
+  (append
+   (modify-services %base-services
+     ;; greetd-service-type provides "greetd" PAM service
+     (delete login-service-type)
+     ;; and can be used in place of mingetty-service-type
+     (delete mingetty-service-type))
+   (list
+    (service greetd-service-type
+             (greetd-configuration
+              (terminals
+               (list
+                ;; we can make any terminal active by default
+                (greetd-terminal-configuration (terminal-vt "1") (terminal-switch #t))
+                ;; we can make environment without XDG_RUNTIME_DIR set
+                ;; even provide our own environment variables
+                (greetd-terminal-configuration
+                 (terminal-vt "2")
+                 (default-session-command
+                   (greetd-agreety-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")))))
+                ;; we can use any other executable command as greeter
+                (greetd-terminal-configuration
+                 (terminal-vt "4")
+                 (default-session-command (program-file "my-noop-greeter" #~(exit))))
+                (greetd-terminal-configuration (terminal-vt "5"))
+                (greetd-terminal-configuration (terminal-vt "6"))))))
+    ;; mingetty-service-type can be used in parallel
+    ;; if needed to do so, do not (delete login-service-type)
+    ;; as illustrated above
+    #| (service mingetty-service-type (mingetty-configuration (tty "tty8"))) |#))
+@end lisp
+@end defvr
+
+@deftp {Data Type} greetd-configuration
+Configuration record for the @code{greetd-service-type}.
+@table @asis
+
+@item @code{motd}
+A file-like object containing the ``message of the day''.
+
+@item @code{allow-empty-passwords?} (default: @code{#t})
+Allow empty passwords by default so that first-time users can log in when
+the 'root' account has just been created.
+
+@item @code{terminals} (default: @code{'()})
+List of @code{greetd-terminal-configuration} per terminal for which
+@code{greetd} should be started.
+@end table
+@end deftp
+
+@deftp {Data Type} greetd-terminal-configuration
+Configuration record for per terminal greetd daemon service.
+
+@table @asis
+@item @code{greetd} (default: @code{greetd})
+The greetd package to use.
+
+@item @code{config-file-name}
+Configuration file name to use for greetd daemon. Generally, autogenerated
+derivation based on @code{terminal-vt} value.
+
+@item @code{log-file-name}
+Log file name to use for greetd daemon. Generally, autogenerated
+name based on @code{terminal-vt} value.
+
+@item @code{terminal-vt} (default: @samp{"7"})
+The VT to run on. Use of a specific VT with appropriate conflict avoidance
+is recommended.
+
+@item @code{terminal-switch} (default: @code{#f})
+Make this terminal active on start of @code{greetd}.
+
+@item @code{default-session-user} (default: @samp{"greeter"})
+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
+@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.
+
+@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.
+
+@item @code{command-args} (default: @code{'("-l")})
+Command arguments to pass to command.
+
+@item @code{extra-env} (default: @code{'()})
+Extra environment variables to set on login.
+
+@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
+are set right after mentioned variables, so that they can be overriden.
+
+@end table
+@end deftp
+
 @node Scheduled Job Execution
 @subsection Scheduled Job Execution
 
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 6865d03f25..0e7bfe7f5a 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -16,6 +16,7 @@
 ;;; Copyright © 2021 qblade <qblade@protonmail.com>
 ;;; Copyright © 2021 Hui Lu <luhuins@163.com>
 ;;; Copyright © 2021, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;; Copyright © 2022 Guillaume Le Vaillant <glv@posteo.net>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -219,6 +220,11 @@ (define-module (gnu services base)
             pam-limits-service-type
             pam-limits-service
 
+            greetd-service-type
+            greetd-configuration
+            greetd-terminal-configuration
+            greetd-agreety-session
+
             %base-services))
 
 ;;; Commentary:
@@ -1439,7 +1445,7 @@ (define pam-limits-service-type
                               (module "pam_limits.so")
                               (arguments '("conf=/etc/security/limits.conf")))))
              (if (member (pam-service-name pam)
-                         '("login" "su" "slim" "gdm-password" "sddm"
+                         '("login" "greetd" "su" "slim" "gdm-password" "sddm"
                            "sudo" "sshd"))
                  (pam-service
                   (inherit pam)
@@ -2775,6 +2781,221 @@ (define %qemu-static-networking
    (provision '(networking))
    (name-servers '("10.0.2.3"))))
 
+\f
+;;;
+;;; 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
+  (match-lambda
+    (($ <greetd-agreety-session> _ 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 #$@args)))))))
+
+(define greetd-agreety-tty-xdg-session-command
+  (match-lambda
+    (($ <greetd-agreety-session> _ 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 #$@args)))))))
+
+(define (make-greetd-agreety-session-command config command)
+  (let ((agreety (file-append (greetd-agreety config) "/bin/agreety")))
+    (program-file
+     "agreety-command"
+     #~(execl #$agreety #$agreety "-c" #$command))))
+
+(define (make-greetd-default-session-command config-or-command)
+  (cond ((greetd-agreety-session? config-or-command)
+         (cond ((greetd-agreety-xdg-env? config-or-command)
+                (make-greetd-agreety-session-command
+                 config-or-command
+                 (greetd-agreety-tty-xdg-session-command config-or-command)))
+               (#t
+                (make-greetd-agreety-session-command
+                 config-or-command
+                 (greetd-agreety-tty-session-command config-or-command)))))
+        (#t config-or-command)))
+
+(define-record-type* <greetd-terminal-configuration>
+  greetd-terminal-configuration make-greetd-terminal-configuration
+  greetd-terminal-configuration?
+  (greetd greetd-package (default greetd))
+  (config-file-name greetd-config-file-name (thunked)
+                    (default (default-config-file-name this-record)))
+  (log-file-name greetd-log-file-name (thunked)
+                 (default (default-log-file-name this-record)))
+  (terminal-vt greetd-terminal-vt (default "7"))
+  (terminal-switch greetd-terminal-switch (default #f))
+  (default-session-user greetd-default-session-user (default "greeter"))
+  (default-session-command greetd-default-session-command
+    (default (greetd-agreety-session))
+    (sanitize make-greetd-default-session-command)))
+
+(define (default-config-file-name config)
+  (string-join (list "config-" (greetd-terminal-vt config) ".toml") ""))
+
+(define (default-log-file-name config)
+  (string-join (list "/var/log/greetd-" (greetd-terminal-vt config) ".log") ""))
+
+(define (make-greetd-terminal-configuration-file config)
+  (let*
+      ((config-file-name (greetd-config-file-name config))
+       (terminal-vt (greetd-terminal-vt config))
+       (terminal-switch (greetd-terminal-switch config))
+       (default-session-user (greetd-default-session-user config))
+       (default-session-command (greetd-default-session-command config)))
+    (mixed-text-file
+     config-file-name
+     "[terminal]\n"
+     "vt = " terminal-vt "\n"
+     "switch = " (if terminal-switch "true" "false") "\n"
+     "[default_session]\n"
+     "user = " default-session-user "\n"
+     "command = " default-session-command "\n")))
+
+(define %greetd-accounts
+  (list (user-account
+         (name "greeter")
+         (group "wheel")
+         (supplementary-groups '("users" "tty" "input" "video" "audio"))
+         (system? #t))))
+
+(define %greetd-file-systems
+  (list (file-system
+          (device "none")
+          (mount-point "/run/greetd/pam_mount")
+          (type "tmpfs")
+          (check? #f)
+          (flags '(no-suid no-dev no-exec))
+          (options "mode=0755")
+          (create-mount-point? #t))))
+
+(define %greetd-pam-mount-rules
+  `((debug (@ (enable "0")))
+    (volume (@ (sgrp "users")
+               (fstype "tmpfs")
+               (mountpoint "/run/user/%(USERUID)")
+               (options "noexec,nosuid,nodev,size=1g,mode=0700,uid=%(USERUID),gid=%(USERGID)")))
+    (logout (@ (wait "0")
+               (hup "0")
+               (term "yes")
+               (kill "no")))
+    (mkmountpoint (@ (enable "1") (remove "true")))))
+
+(define-record-type* <greetd-configuration>
+  greetd-configuration make-greetd-configuration
+  greetd-configuration?
+  (motd greetd-motd (default %default-motd))
+  (allow-empty-passwords? greetd-allow-empty-passwords? (default #t))
+  (terminals greetd-terminals (default '())))
+
+(define (make-greetd-pam-mount-conf-file config)
+  (computed-file
+   "greetd_pam_mount.conf.xml"
+   #~(begin
+       (use-modules (sxml simple))
+       (call-with-output-file #$output
+         (lambda (port)
+           (sxml->xml
+            '(*TOP*
+              (*PI* xml "version='1.0' encoding='utf-8'")
+              (pam_mount
+               #$@%greetd-pam-mount-rules
+               (pmvarrun
+                #$(file-append greetd-pam-mount
+                               "/sbin/pmvarrun -u '%(USER)' -o '%(OPERATION)'"))))
+            port))))))
+
+(define (greetd-etc-service config)
+  `(("security/greetd_pam_mount.conf.xml"
+     ,(make-greetd-pam-mount-conf-file config))))
+
+(define (greetd-pam-service config)
+  (define optional-pam-mount
+    (pam-entry
+     (control "optional")
+     (module #~(string-append #$greetd-pam-mount "/lib/security/pam_mount.so"))
+     (arguments '("disable_interactive"))))
+
+  (list
+   (unix-pam-service "greetd"
+                     #:login-uid? #t
+                     #:allow-empty-passwords?
+                     (greetd-allow-empty-passwords? config)
+                     #:motd
+                     (greetd-motd config))
+   (lambda (pam)
+     (if (member (pam-service-name pam)
+                 '("login" "greetd" "su" "slim" "gdm-password"))
+         (pam-service
+          (inherit pam)
+          (auth (append (pam-service-auth pam)
+                        (list optional-pam-mount)))
+          (session (append (pam-service-session pam)
+                           (list optional-pam-mount))))
+         pam))))
+
+(define (greetd-shepherd-services config)
+  (map
+   (lambda (tc)
+     (let*
+         ((greetd-bin (file-append (greetd-package tc) "/sbin/greetd"))
+          (greetd-conf (make-greetd-terminal-configuration-file tc))
+          (greetd-log (greetd-log-file-name tc))
+          (greetd-vt (greetd-terminal-vt tc)))
+       (shepherd-service
+        (documentation "Minimal and flexible login manager daemon")
+        (requirement '(user-processes host-name udev virtual-terminal))
+        (provision (list (symbol-append
+                          'term-tty
+                          (string->symbol (greetd-terminal-vt tc)))))
+        (start #~(make-forkexec-constructor
+                  (list #$greetd-bin "-c" #$greetd-conf)
+                  #:log-file #$greetd-log))
+        (stop #~(make-kill-destructor)))))
+   (greetd-terminals config)))
+
+(define greetd-service-type
+  (service-type
+   (name 'greetd)
+   (description "Provides necessary infrastructure for logging into the
+system including @code{greetd} PAM service, @code{pam-mount} module to
+mount/unmount /run/user/<uid> directory for user and @code{greetd}
+login manager daemon.")
+   (extensions
+    (list
+     (service-extension account-service-type (const %greetd-accounts))
+     (service-extension file-system-service-type (const %greetd-file-systems))
+     (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)))
+   (default-value (greetd-configuration))))
+
 \f
 (define %base-services
   ;; Convenience variable holding the basic services.
diff --git a/gnu/services/pam-mount.scm b/gnu/services/pam-mount.scm
index 33649b0f7c..e60781d05b 100644
--- a/gnu/services/pam-mount.scm
+++ b/gnu/services/pam-mount.scm
@@ -90,7 +90,7 @@ (define optional-pam-mount
      (module #~(string-append #$pam-mount "/lib/security/pam_mount.so"))))
   (list (lambda (pam)
           (if (member (pam-service-name pam)
-                      '("login" "su" "slim" "gdm-password" "sddm"))
+                      '("login" "greetd" "su" "slim" "gdm-password" "sddm"))
               (pam-service
                (inherit pam)
                (auth (append (pam-service-auth pam)
-- 
2.36.1

[bug#49969] [PATCH v11 6/8] gnu: admin: Add libseat 0.8.0 and move seatd.

[muradm]

* gnu/packages/admin.scm (libseat): New variable
* gnu/packages/admin.scm (seatd): New variable
* gnu/packages/freedesktop.scm (seatd): Remove variable
* gnu/packages/wm.scm (wlroots): Replace seatd input with libseat
---
 gnu/packages/admin.scm       | 53 ++++++++++++++++++++++++++++++++++++
 gnu/packages/freedesktop.scm | 29 --------------------
 gnu/packages/wm.scm          |  4 ++-
 3 files changed, 56 insertions(+), 30 deletions(-)

diff --git a/gnu/packages/admin.scm b/gnu/packages/admin.scm
index d6e1d819ab..eb6450b4da 100644
--- a/gnu/packages/admin.scm
+++ b/gnu/packages/admin.scm
@@ -46,6 +46,7 @@
 ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
 ;;; Copyright © 2021 muradm <mail@muradm.net>
+;;; Copyright © 2021 pineapples <guixuser6392@protonmail.com>
 ;;; Copyright © 2021 Petr Hodina <phodina@protonmail.com>
 ;;; Copyright © 2021 Artyom V. Poptsov <poptsov.artyom@gmail.com>
 ;;; Copyright © 2022 Wamm K. D. <jaft.r@outlook.com>
@@ -104,6 +105,7 @@ (define-module (gnu packages admin)
   #:use-module (gnu packages elf)
   #:use-module (gnu packages file)
   #:use-module (gnu packages flex)
+  #:use-module (gnu packages freedesktop)
   #:use-module (gnu packages gawk)
   #:use-module (gnu packages gettext)
   #:use-module (gnu packages gl)
@@ -5097,3 +5099,54 @@ (define-public greetd-pam-mount
 greetd-pam-mount is used in configuration of greetd to provide
 auto-(mounting/unmounting) of XDG_RUNTIME_DIR in the way that it will not
 interfere with default pam-mount configuration.")))
+
+(define-public libseat
+  (package
+    (name "libseat")
+    (version "0.7.0")
+    (source (origin
+              (method git-fetch)
+              (uri (git-reference
+                    (url "https://git.sr.ht/~kennylevinsen/seatd")
+                    (commit version)))
+              (file-name (git-file-name name version))
+              (sha256
+               (base32
+                "10f8387yy5as547xjjhl0cna6iywdgjmw0iq2nvcs8q6vlpnik4v"))))
+    (build-system meson-build-system)
+    (arguments
+     `(#:configure-flags '("-Dlibseat-logind=elogind"
+                           "-Dserver=disabled")))
+    (native-inputs
+     `(("pkg-config" ,pkg-config)))
+    (propagated-inputs
+     `(("elogind" ,elogind)))
+    (home-page "https://sr.ht/~kennylevinsen/seatd")
+    (synopsis "Seat management library")
+    (description
+     "This package provides a universal seat management library that
+allows applications to use whatever seat management is available.")
+    (license license:expat)))
+
+(define-public seatd
+  (package
+    (inherit libseat)
+    (name "seatd")
+    (arguments
+     `(#:configure-flags '("-Dlibseat-logind=elogind")
+       #:phases
+       (modify-phases %standard-phases
+         (add-after 'install 'remove-libs
+           (lambda* (#:key outputs #:allow-other-keys)
+             (with-directory-excursion (assoc-ref outputs "out")
+               (for-each delete-file-recursively '("lib" "include"))))))))
+    (native-inputs
+     `(("pkg-config" ,pkg-config)
+       ("scdoc" ,scdoc)))
+    (inputs '())
+    (synopsis "Seat management daemon")
+    (description
+     "This package provides a minimal seat management daemon whose task is to
+mediate access to shared devices, such as graphics and input, for applications
+that require it.")
+    (license license:expat)))
diff --git a/gnu/packages/freedesktop.scm b/gnu/packages/freedesktop.scm
index fc2c45c1f1..309876867a 100644
--- a/gnu/packages/freedesktop.scm
+++ b/gnu/packages/freedesktop.scm
@@ -849,35 +849,6 @@ (define (source-file regexp)
 with localed.  This package is extracted from the broader systemd package.")
     (license license:lgpl2.1+)))
 
-(define-public seatd
-  (package
-    (name "seatd")
-    (version "0.5.0")
-    (source (origin
-              (method git-fetch)
-              (uri (git-reference
-                    (url "https://git.sr.ht/~kennylevinsen/seatd")
-                    (commit version)))
-              (file-name (git-file-name name version))
-              (sha256
-               (base32
-                "1kglq8v4rnr3415mfaghyv2s2f8mxsy5s881gmm2908ig4n4j297"))))
-    (build-system meson-build-system)
-    (arguments
-     `(#:configure-flags '("-Dlogind=enabled")))
-    (native-inputs
-     (list pkg-config scdoc))
-    (propagated-inputs
-     (list elogind))
-    (home-page "https://sr.ht/~kennylevinsen/seatd")
-    (synopsis "Seat management daemon and library")
-    (description
-     "This package provides a minimal seat management daemon whose task is to
-mediate access to shared devices, such as graphics and input, for applications
-that require it.  It also provides a universal seat management library that
-allows applications to use whatever seat management is available.")
-    (license license:expat)))
-
 (define-public packagekit
   (package
     (name "packagekit")
diff --git a/gnu/packages/wm.scm b/gnu/packages/wm.scm
index 123e6ca7e7..24d95ba86c 100644
--- a/gnu/packages/wm.scm
+++ b/gnu/packages/wm.scm
@@ -54,6 +54,7 @@
 ;;; Copyright © 2022 Daniel Meißner <daniel.meissner-i4k@ruhr-uni-bochum.de>
 ;;; Copyright © 2022 Pier-Hugues Pellerin <ph@heykimo.com>
 ;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2022 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -88,6 +89,7 @@ (define-module (gnu packages wm)
   #:use-module (guix utils)
   #:use-module (gnu packages)
   #:use-module (gnu packages bash)
+  #:use-module (gnu packages admin)
   #:use-module (gnu packages autotools)
   #:use-module (gnu packages base)
   #:use-module (gnu packages bison)
@@ -1537,7 +1539,7 @@ (define-public wlroots
            libxkbcommon
            mesa
            pixman
-           seatd
+           libseat
            wayland
            wayland-protocols
            xcb-util-errors
-- 
2.36.1

[bug#49969] [PATCH v11 7/8] gnu: desktop: Add seatd-service-type.

[muradm]

* gnu/services/desktop.scm (seatd-service-type): New variable
* gnu/services/desktop.scm (seatd-configuration): New data type

fix seatd path
---
 doc/guix.texi            | 46 +++++++++++++++++++++++++++++
 gnu/services/desktop.scm | 62 +++++++++++++++++++++++++++++++++++++++-
 2 files changed, 107 insertions(+), 1 deletion(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 997b93c831..799ea932d7 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -22661,6 +22661,52 @@ and ``passwd'' is with the value @code{passwd}.
 @end table
 @end deftp
 
+@defvr {Scheme Variable} seatd-service-type
+@uref{https://sr.ht/~kennylevinsen/seatd/, seatd} is a minimal seat
+management daemon.
+
+Seat management takes care of mediating access to shared devices (graphics,
+input), without requiring the applications needing access to be root.
+
+@lisp
+(append
+  (list
+   ;; make sure seatd is running
+   (service seatd-service-type))
+
+  ;; normally one would want %base-services
+  %base-services)
+
+@end lisp
+@end defvr
+
+@deftp {Data Type} seatd-configuration
+Configuration record for the seatd daemon service.
+
+@table @asis
+@item @code{seatd} (default: @code{seatd})
+The seatd package to use.
+
+@item @code{user} (default: @samp{"root"})
+User to own the seatd socket.
+
+@item @code{group} (default: @samp{"users"})
+Group to own the seatd socket.
+
+@item @code{socket} (default: @samp{"/run/seatd.sock"})
+Where to create the seatd socket.
+
+@item @code{logfile} (default: @samp{"/var/log/seatd.log"})
+Log file to write to.
+
+@item @code{loglevel} (default: @samp{"error"})
+Log level to output logs. Possible values: @samp{"silent"}, @samp{"error"},
+@samp{"info"} and @samp{"debug"}.
+
+@end table
+@end deftp
+
+
 @node Sound Services
 @subsection Sound Services
 
diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index 0499071436..29a3722f1b 100644
--- a/gnu/services/desktop.scm
+++ b/gnu/services/desktop.scm
@@ -13,6 +13,7 @@
 ;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2020 Reza Alizadeh Majd <r.majd@pantherx.org>
 ;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -39,7 +40,9 @@ (define-module (gnu services desktop)
   #:use-module (gnu services networking)
   #:use-module (gnu services sound)
   #:use-module ((gnu system file-systems)
-                #:select (%elogind-file-systems file-system))
+                #:select (%control-groups
+                          %elogind-file-systems
+                          file-system))
   #:autoload   (gnu services sddm) (sddm-service-type)
   #:use-module (gnu system)
   #:use-module (gnu system setuid)
@@ -157,6 +160,9 @@ (define-module (gnu services desktop)
             gnome-keyring-configuration?
             gnome-keyring-service-type
 
+            seatd-configuration
+            seatd-service-type
+
             %desktop-services))
 
 ;;; Commentary:
@@ -1630,6 +1636,60 @@ (define polkit-wheel
 (define polkit-wheel-service
   (simple-service 'polkit-wheel polkit-service-type (list polkit-wheel)))
 
+\f
+;;;
+;;; seatd-service-type -- minimal seat management daemon
+;;;
+
+(define-record-type* <seatd-configuration> seatd-configuration
+  make-seatd-configuration
+  seatd-configuration?
+  (seatd seatd-package (default seatd))
+  (user seatd-user (default "root"))
+  (group seatd-group (default "users"))
+  (socket seatd-socket (default "/run/seatd.sock"))
+  (logfile seatd-logfile (default "/var/log/seatd.log"))
+  (loglevel seatd-loglevel (default "info")))
+
+(define (seatd-shepherd-service config)
+  (list (shepherd-service
+         (documentation "Minimal seat management daemon")
+         (requirement '())
+         ;; TODO: once cgroups is separate dependency
+         ;; here we should depend on it rather than elogind
+         (provision '(seatd elogind))
+         (start #~(make-forkexec-constructor
+                   (list #$(file-append (seatd-package config) "/bin/seatd")
+                         "-u" #$(seatd-user config)
+                         "-g" #$(seatd-group config))
+                   #:environment-variables
+                   (list (string-append "SEATD_LOGLEVEL="
+                                        #$(seatd-loglevel config))
+                         (string-append "SEATD_DEFAULTPATH="
+                                        #$(seatd-socket config)))
+                   #:log-file #$(seatd-logfile config)))
+         (stop #~(make-kill-destructor)))))
+
+(define seatd-environment
+  (match-lambda
+    (($ <seatd-configuration> _ _ _ socket)
+     `(("SEATD_SOCK" . ,socket)))))
+
+(define seatd-service-type
+  (service-type
+   (name 'seatd)
+   (description "Seat management takes care of mediating access
+to shared devices (graphics, input), without requiring the
+applications needing access to be root.")
+   (extensions
+    (list
+     (service-extension session-environment-service-type seatd-environment)
+     ;; TODO: once cgroups is separate dependency we should not mount it here
+     ;; for now it is mounted here, because elogind mounts it
+     (service-extension file-system-service-type (const %control-groups))
+     (service-extension shepherd-root-service-type seatd-shepherd-service)))
+   (default-value (seatd-configuration))))
+
 \f
 ;;;
 ;;; The default set of desktop services.
-- 
2.36.1

[bug#49969] [PATCH v11 8/8] gnu: tests: Add seatd/greetd based minimal desktop system tests.

[muradm]

* gnu/tests/desktop.scm (minimal-desktop): seatd/greetd based
minimal desktop test
---
 gnu/tests/desktop.scm | 212 +++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 211 insertions(+), 1 deletion(-)

diff --git a/gnu/tests/desktop.scm b/gnu/tests/desktop.scm
index 57069c0ede..7cc837f42e 100644
--- a/gnu/tests/desktop.scm
+++ b/gnu/tests/desktop.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -18,13 +19,17 @@
 
 (define-module (gnu tests desktop)
   #:use-module (gnu tests)
+  #:use-module (gnu packages shells)
   #:use-module (gnu services)
+  #:use-module (gnu services base)
   #:use-module (gnu services dbus)
   #:use-module (gnu services desktop)
+  #:use-module (gnu system)
   #:use-module (gnu system vm)
   #:use-module (guix gexp)
   #:use-module (srfi srfi-1)
-  #:export (%test-elogind))
+  #:export (%test-elogind
+            %test-minimal-desktop))
 
 \f
 ;;;
@@ -100,3 +105,208 @@ (define %test-elogind
                #:imported-modules '((gnu services herd)
                                     (guix combinators)))))
       (run-elogind-test (virtual-machine os))))))
+
+\f
+;;;
+;;; Seatd/greetd based minimal desktop
+;;;
+
+(define %minimal-services
+  (append
+   (modify-services %base-services
+     ;; greetd-service-type provides "greetd" PAM service
+     (delete login-service-type)
+     ;; and can be used in place of mingetty-service-type
+     (delete mingetty-service-type))
+   (list
+    (service seatd-service-type)
+    (service greetd-service-type
+             (greetd-configuration
+              (terminals
+               (list
+                ;; we can make any terminal active by default
+                (greetd-terminal-configuration (terminal-vt "1") (terminal-switch #t))
+                ;; we can make environment without XDG_RUNTIME_DIR set
+                ;; even provide our own environment variables
+                (greetd-terminal-configuration
+                 (terminal-vt "2")
+                 (default-session-command
+                   (greetd-agreety-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")))))
+                ;; we can use any other executable command as greeter
+                (greetd-terminal-configuration
+                 (terminal-vt "4")
+                 (default-session-command (program-file "my-noop-greeter" #~(exit))))
+                (greetd-terminal-configuration (terminal-vt "5"))
+                (greetd-terminal-configuration (terminal-vt "6"))))))
+    ;; mingetty-service-type can be used in parallel
+    ;; if needed to do so, do not (delete login-service-type)
+    ;; as illustrated above
+    #| (service mingetty-service-type (mingetty-configuration (tty "tty8"))) |#)))
+
+(define-syntax-rule (minimal-operating-system user-services ...)
+  "Return an operating system that includes USER-SERVICES in addition to
+minimal %BASE-SERVICES."
+  (operating-system (inherit %simple-os)
+                    (services (cons* user-services ... %minimal-services))))
+
+(define (run-minimal-desktop-test os vm)
+  (define test
+    (with-imported-modules '((gnu build marionette)
+                             (guix build syscalls))
+      #~(begin
+          (use-modules (gnu build marionette)
+                       (guix build syscalls)
+                       (srfi srfi-1)
+                       (srfi srfi-64)
+                       (ice-9 pretty-print))
+
+          (define marionette
+            (make-marionette #$vm))
+
+          (define (file-get-all-strings fname)
+            (marionette-eval '(use-modules (rnrs io ports)) marionette)
+            (wait-for-file fname marionette #:read 'get-string-all))
+
+          (define (wait-for-unix-socket-m socket)
+            (wait-for-unix-socket socket marionette))
+
+          (mkdir #$output)
+          (chdir #$output)
+
+          (test-begin "minimal-desktop")
+
+          (test-assert "seatd is ready"
+            (wait-for-unix-socket-m "/run/seatd.sock"))
+
+          (test-equal "login user on tty1"
+            "alice\n"
+            (begin
+              ;; Wait for tty1.
+              (marionette-eval
+               '(begin
+                  (use-modules (gnu services herd))
+                  (start-service 'term-tty1))
+               marionette)
+              (marionette-control "sendkey ctrl-alt-f1" marionette)
+
+              ;; login as root change alice password and exit
+              ;; then login as alice
+              (for-each
+               (lambda (cmd) (marionette-type cmd marionette) (sleep 1))
+               (list
+                "root\n"
+                "passwd alice\n"
+                "alice\n"
+                "alice\n"
+                "exit\n"
+                "alice\n"
+                "alice\n"
+                "id -un > logged-in\n"))
+
+              (file-get-all-strings "/home/alice/logged-in")))
+
+          (test-equal "validate user environment"
+            '("SEATD_SOCK=/run/seatd.sock"
+              "XDG_RUNTIME_DIR=/run/user/1000"
+              "XDG_SEAT=seat0"
+              "XDG_VTNR=1")
+
+            (begin
+              (marionette-type "env > env\n" marionette)
+              (sleep 1)
+
+              (define user-env (string-tokenize
+                                (file-get-all-strings "/home/alice/env")))
+
+              (define (expected-var var)
+                (any (lambda (s) (string-contains var s))
+                     '("SEATD_SOCK"
+                       "XDG_RUNTIME_DIR"
+                       "XDG_SEAT"
+                       "XDG_VTNR")))
+
+              (sort (filter expected-var user-env) string<?)))
+
+          (test-assert "validate SEATD_SOCK and GREETD_SOCK"
+            (begin
+              (marionette-type "env > env\n" marionette)
+              (sleep 1)
+
+              (define (sock-var? var)
+                (any (lambda (s) (string-contains var s))
+                     '("SEATD_SOCK" "GREETD_SOCK")))
+
+              (define (sock-var-sock var)
+                (car (cdr (string-split var #\=))))
+
+              (let*
+                  ((out (file-get-all-strings "/home/alice/env"))
+                   (out (string-tokenize out))
+                   (out (filter sock-var? out))
+                   (socks (map sock-var-sock out))
+                   (socks (map wait-for-unix-socket-m socks)))
+                (and (= 2 (length socks)) (every identity socks)))))
+
+          (test-assert "greetd is ready"
+            (begin
+              (marionette-type "ps -C greetd -o pid,args --no-headers > ps-greetd\n"
+                               marionette)
+              (sleep 1)
+
+              (define (greetd-daemon? cmd)
+                (string-contains cmd "config"))
+
+              (define (greetd-cmd-to-pid cmd)
+                (car (string-split cmd #\space)))
+
+              (define (greetd-pid-to-sock pid)
+                (string-append "/run/greetd-" pid ".sock"))
+
+              (let* ((out (file-get-all-strings "/home/alice/ps-greetd"))
+                     (out (string-split out #\newline))
+                     (out (map string-trim-both out))
+                     (out (filter greetd-daemon? out))
+                     (pids (map greetd-cmd-to-pid out))
+                     (socks (map greetd-pid-to-sock pids))
+                     (socks (map wait-for-unix-socket-m socks)))
+                (every identity socks))))
+
+          ;; a bit weak, but tests everything at once actually
+          (test-equal "check /run/user/<uid> mounted and writable"
+            "alice\n"
+            (begin
+              (marionette-type "echo alice > /run/user/1000/test\n" marionette)
+              (file-get-all-strings "/run/user/1000/test")))
+
+          (test-assert "screendump"
+            (begin
+              (marionette-control (string-append "screendump " #$output
+                                                 "/tty1.ppm")
+                                  marionette)
+              (file-exists? "tty1.ppm")))
+
+          (test-end)
+          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+  (gexp->derivation "minimal-desktop" test))
+
+(define %test-minimal-desktop
+  (system-test
+   (name "minimal-desktop")
+   (description
+    "Test whether we can log in when seatd and greetd is enabled")
+   (value
+    (let* ((os (marionette-operating-system
+                (minimal-operating-system)
+                #:imported-modules '((gnu services herd)
+                                     (guix combinators))))
+           (vm (virtual-machine os)))
+      (run-minimal-desktop-test (virtualized-operating-system os '())
+                                #~(list #$vm))))))
-- 
2.36.1

[bug#49969] [PATCH v11 7/8] gnu: desktop: Add seatd-service-type.

[Tom Fitzhenry]

muradm <mail@muradm.net> writes:

> * gnu/services/desktop.scm (seatd-service-type): New variable

I've tested this on my aarch64 RockPro64 and used it to log into Sway
from TTY. Worked for me, thanks!

[bug#49969] [PATCH v11 0/8] Re: [bug#49969] [PATCH v10 1/7] gnu: crates-io: Add rust-enquote 1.1.0 and rust-pam-sys 0.5.6.

[muradm]

[-- Attachment #1: Type: text/plain, Size: 1234 bytes --]


Hi, is there anything else needed to be updated for merging?

Thanks in advance,
muradm

muradm <mail@muradm.net> writes:

> Fixing as suggested:
> * splitting rust packages to commit per package
> * linux-pam should be in 'inputs
> * varying description
>
> Thanks in advance,
> muradm
>
> muradm (8):
>   gnu: crates-io: Add rust-enquote 1.1.0.
>   gnu: crates-io: Add rust-pam-sys 0.5.6.
>   gnu: admin: Add greetd 0.8.0.
>   gnu: admin: Add greetd-pam-mount.
>   gnu: base: Add greetd-service-type.
>   gnu: admin: Add libseat 0.8.0 and move seatd.
>   gnu: desktop: Add seatd-service-type.
>   gnu: tests: Add seatd/greetd based minimal desktop system 
>   tests.
>
>  doc/guix.texi                | 183 ++++++++++++++++++++++++++++
>  gnu/packages/admin.scm       | 162 +++++++++++++++++++++++++
>  gnu/packages/crates-io.scm   |  40 +++++++
>  gnu/packages/freedesktop.scm |  29 -----
>  gnu/packages/wm.scm          |   4 +-
>  gnu/services/base.scm        | 223 
>  ++++++++++++++++++++++++++++++++++-
>  gnu/services/desktop.scm     |  62 +++++++++-
>  gnu/services/pam-mount.scm   |   2 +-
>  gnu/tests/desktop.scm        | 212 
>  ++++++++++++++++++++++++++++++++-
>  9 files changed, 883 insertions(+), 34 deletions(-)


[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 832 bytes --]

[bug#49969] [PATCH v11 0/8] Re: [bug#49969] [PATCH v10 1/7] gnu: crates-io: Add rust-enquote 1.1.0 and rust-pam-sys 0.5.6.

[Lars-Dominik Braun]

Hi,

> Hi, is there anything else needed to be updated for merging?
any chance of getting that system test working? It currently backtraces for me:

---snip---
Backtrace:
           4 (primitive-load "/gnu/store/wwbnxhlshbw39amrwcwbq4i8rkw?")
In ice-9/eval.scm:
   191:35  3 (_ #f)
   196:35  2 (_ #f)
    263:9  1 (_ #(#(#<directory (guile-user) 7ffff1fd3c80>) #f))
    155:9  0 (_ _)

ice-9/eval.scm:155:9: In procedure struct-vtable: Wrong type argument in position 1 (expecting struct): #f
---snap---

Lars

[bug#49969] [PATCH v12 0/8] with fixed tests

[muradm]

system test now ends as required

muradm (8):
  gnu: crates-io: Add rust-enquote 1.1.0.
  gnu: crates-io: Add rust-pam-sys 0.5.6.
  gnu: admin: Add greetd 0.8.0.
  gnu: admin: Add greetd-pam-mount.
  gnu: base: Add greetd-service-type.
  gnu: admin: Add libseat 0.8.0 and move seatd.
  gnu: desktop: Add seatd-service-type.
  gnu: tests: Add seatd/greetd based minimal desktop system tests.

 doc/guix.texi                | 183 ++++++++++++++++++++++++++++
 gnu/packages/admin.scm       | 162 +++++++++++++++++++++++++
 gnu/packages/crates-io.scm   |  40 +++++++
 gnu/packages/freedesktop.scm |  29 -----
 gnu/packages/wm.scm          |   4 +-
 gnu/services/base.scm        | 223 ++++++++++++++++++++++++++++++++++-
 gnu/services/desktop.scm     |  62 +++++++++-
 gnu/services/pam-mount.scm   |   2 +-
 gnu/tests/desktop.scm        | 212 ++++++++++++++++++++++++++++++++-
 9 files changed, 883 insertions(+), 34 deletions(-)

-- 
2.36.1

[bug#49969] [PATCH v12 1/8] gnu: crates-io: Add rust-enquote 1.1.0.

[muradm]

* gnu/packages/crates-io.scm (rust-enquote-1): New variable
---
 gnu/packages/crates-io.scm | 18 ++++++++++++++++++
 1 file changed, 18 insertions(+)

diff --git a/gnu/packages/crates-io.scm b/gnu/packages/crates-io.scm
index 86313f5e4f..a4d381899e 100644
--- a/gnu/packages/crates-io.scm
+++ b/gnu/packages/crates-io.scm
@@ -19,6 +19,7 @@
 ;;; Copyright © 2021 Antero Mejr <antero@kodmin.com>
 ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2021 Vinicius Monego <monego@posteo.net>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;; Copyright © 2021, 2022 Petr Hodina <phodina@protonmail.com>
 ;;; Copyright © 2021, 2022 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2021 Jacob Hrbek <kreyren@rixotstudio.cz>
@@ -73053,3 +73054,20 @@ (define-public rust-shell2batch-0.4
 and automatically convert it to a windows batch file, this library provides a
 way to convert simple shell commands to windows batch commands.")
     (license license:asl2.0)))
+
+(define-public rust-enquote-1
+  (package
+    (name "rust-enquote")
+    (version "1.1.0")
+    (home-page "https://github.com/reujab/enquote")
+    (source (origin
+              (method url-fetch)
+              (uri (crate-uri "enquote" version))
+              (file-name (string-append name "-" version ".tar.gz"))
+              (sha256
+               (base32
+                "0clrjghlfkkb7sndabs5wch0fz2nif6nj4b117s8kqxx3nqnrhq6"))))
+    (build-system cargo-build-system)
+    (synopsis "Rust library that quotes, unquotes, and unescapes strings")
+    (description "A Rust library quotes, unquotes, and unescapes strings")
+    (license license:unlicense)))
-- 
2.36.1

[bug#49969] [PATCH v12 2/8] gnu: crates-io: Add rust-pam-sys 0.5.6.

[muradm]

* gnu/packages/crates-io.scm (rust-pam-sys-0.5): New variable
---
 gnu/packages/crates-io.scm | 22 ++++++++++++++++++++++
 1 file changed, 22 insertions(+)

diff --git a/gnu/packages/crates-io.scm b/gnu/packages/crates-io.scm
index a4d381899e..f93b9b0eea 100644
--- a/gnu/packages/crates-io.scm
+++ b/gnu/packages/crates-io.scm
@@ -73071,3 +73071,25 @@ (define-public rust-enquote-1
     (synopsis "Rust library that quotes, unquotes, and unescapes strings")
     (description "A Rust library quotes, unquotes, and unescapes strings")
     (license license:unlicense)))
+
+(define-public rust-pam-sys-0.5
+  (package
+    (name "rust-pam-sys")
+    (version "0.5.6")
+    (home-page "https://github.com/1wilkens/pam-sys")
+    (source (origin
+              (method url-fetch)
+              (uri (crate-uri "pam-sys" version))
+              (file-name (string-append name "-" version ".tar.gz"))
+              (sha256
+               (base32
+                "0d14501d5vybjnzxfjf96321xa5wa36x1xvf02h02zq938qmhj6d"))))
+    (build-system cargo-build-system)
+    (arguments
+     `(#:cargo-inputs (("rust-libc" ,rust-libc-0.2))))
+    (inputs `(("linux-pam" ,linux-pam)))
+    (synopsis
+     "Rust FFI wrappers for the Linux Pluggable Authentication Modules (PAM)")
+    (description
+     "This crate uses bindgen to generate the raw FFI definitions for PAM. For a rustified API consider using pam.")
+    (license (list license:expat license:asl2.0))))
-- 
2.36.1

[bug#49969] [PATCH v12 3/8] gnu: admin: Add greetd 0.8.0.

[muradm]

* gnu/packages/admin.scm (greetd): New variable
---
 gnu/packages/admin.scm | 77 ++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 77 insertions(+)

diff --git a/gnu/packages/admin.scm b/gnu/packages/admin.scm
index 6acfff8881..73d70744e1 100644
--- a/gnu/packages/admin.scm
+++ b/gnu/packages/admin.scm
@@ -45,6 +45,7 @@
 ;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
 ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;; Copyright © 2021 Petr Hodina <phodina@protonmail.com>
 ;;; Copyright © 2021 Artyom V. Poptsov <poptsov.artyom@gmail.com>
 ;;; Copyright © 2022 Wamm K. D. <jaft.r@outlook.com>
@@ -66,6 +67,7 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu packages admin)
+  #:use-module (guix build-system cargo)
   #:use-module (guix build-system cmake)
   #:use-module (guix build-system emacs)
   #:use-module (guix build-system glib-or-gtk)
@@ -93,6 +95,7 @@ (define-module (gnu packages admin)
   #:use-module (gnu packages c)
   #:use-module (gnu packages check)
   #:use-module (gnu packages compression)
+  #:use-module (gnu packages crates-io)
   #:use-module (gnu packages cross-base)
   #:use-module (gnu packages crypto)
   #:use-module (gnu packages cryptsetup)
@@ -4987,4 +4990,78 @@ (define-public udpcast
     (home-page "https://www.udpcast.linux.lu")
     (license license:gpl2+)))
 
+(define-public greetd
+  (package
+    (name "greetd")
+    (version "0.8.0")
+    (home-page "https://git.sr.ht/~kennylevinsen/greetd")
+    (source (origin
+              (method git-fetch)
+              (uri (git-reference
+                    (url home-page)
+                    (commit version)))
+              (file-name (git-file-name name version))
+              (sha256
+               (base32 "0x5c3jkw09kvj2grcxm899y2n6ws8p990cyp9cs0fy6lm4fzlh6v"))))
+    (build-system cargo-build-system)
+    (arguments
+     `(#:cargo-inputs
+       (("rust-nix" ,rust-nix-0.19)
+        ("rust-pam-sys" ,rust-pam-sys-0.5)
+        ("rust-rpassword" ,rust-rpassword-5)
+        ("rust-users" ,rust-users-0.11)
+        ("rust-serde" ,rust-serde-1)
+        ("rust-serde-json" ,rust-serde-json-1)
+        ("rust-libc" ,rust-libc-0.2)
+        ("rust-tokio" ,rust-tokio-1)
+        ("rust-getopts" ,rust-getopts-0.2)
+        ("rust-thiserror" ,rust-thiserror-1)
+        ("rust-async-trait" ,rust-async-trait-0.1)
+        ("rust-enquote" ,rust-enquote-1))
+       #:phases
+       (modify-phases %standard-phases
+         (delete 'package)
+         (add-after 'build 'build-man-pages
+           (lambda* (#:key inputs #:allow-other-keys)
+             (define (scdoc-cmd doc lvl)
+               (system (string-append "scdoc < "
+                                      doc "-" lvl ".scd > "
+                                      doc "." lvl)))
+             (with-directory-excursion "man"
+               (scdoc-cmd "greetd" "1")
+               (scdoc-cmd "greetd" "5")
+               (scdoc-cmd "greetd-ipc" "7")
+               (scdoc-cmd "agreety" "1"))))
+         (replace 'install
+           (lambda* (#:key inputs outputs #:allow-other-keys)
+             (let* ((out (assoc-ref outputs "out"))
+                    (bin (string-append out "/bin"))
+                    (sbin (string-append out "/sbin"))
+                    (share (string-append out "/share"))
+                    (man (string-append share "/man"))
+                    (man1 (string-append man "/man1"))
+                    (man5 (string-append man "/man5"))
+                    (man7 (string-append man "/man7"))
+                    (release "target/release")
+                    (greetd-bin (string-append release "/greetd"))
+                    (agreety-bin (string-append release "/agreety")))
+               (install-file greetd-bin sbin)
+               (install-file agreety-bin bin)
+               (with-directory-excursion "man"
+                 (install-file "greetd.1" man1)
+                 (install-file "greetd.5" man5)
+                 (install-file "greetd-ipc.7" man7)
+                 (install-file "agreety.1" man1))))))))
+    (native-inputs
+     `(("linux-pam" ,linux-pam)
+       ("scdoc" ,scdoc)))
+    (synopsis "minimal and flexible login manager daemon")
+    (description
+     "greetd is a minimal and flexible login manager daemon
+that makes no assumptions about what you want to launch.
 
+If you can run it from your shell in a TTY, greetd can start it.
+
+If it can be taught to speak a simple JSON-based IPC protocol,
+then it can be a greeter.")
+    (license license:gpl3+)))
-- 
2.36.1

[bug#49969] [PATCH v12 4/8] gnu: admin: Add greetd-pam-mount.

[muradm]

* gnu/packages/admin.scm (greetd-pam-mount): New variable
---
 gnu/packages/admin.scm | 32 ++++++++++++++++++++++++++++++++
 1 file changed, 32 insertions(+)

diff --git a/gnu/packages/admin.scm b/gnu/packages/admin.scm
index 73d70744e1..d6e1d819ab 100644
--- a/gnu/packages/admin.scm
+++ b/gnu/packages/admin.scm
@@ -5065,3 +5065,35 @@ (define (scdoc-cmd doc lvl)
 If it can be taught to speak a simple JSON-based IPC protocol,
 then it can be a greeter.")
     (license license:gpl3+)))
+
+(define-public greetd-pam-mount
+  (package
+    (inherit pam-mount)
+    (name "greetd-pam-mount")
+    (arguments
+     (substitute-keyword-arguments (package-arguments pam-mount)
+       ((#:configure-flags flags ''())
+        #~(cons* "--with-rundir=/run/greetd" #$flags))
+       ((#:phases phases)
+        #~(modify-phases #$phases
+           (add-after 'unpack 'patch-config-file-name
+             (lambda* (#:key inputs #:allow-other-keys)
+               (substitute* "src/pam_mount.c"
+                 ((".*define CONFIGFILE .*$")
+                  "#define CONFIGFILE \"/etc/security/greetd_pam_mount.conf.xml\"\n")
+                 (("pam_mount_config") "greetd_pam_mount_config")
+                 (("pam_mount_system_authtok") "greetd_pam_mount_system_authtok"))))))))
+    (synopsis "pam-mount specifically compiled for use with greetd")
+    (description
+     "Pam-mount is a PAM module that can mount volumes when a user logs in.
+It supports mounting local filesystems of any kind the normal mount utility
+supports.  It can also mount encrypted LUKS volumes using the password
+supplied by the user when logging in.
+
+This package inherits pam-mount in the way that it is compiled specifically
+for use with greetd daemon. It uses different configuration location and
+name space for storing data in PAM.
+
+greetd-pam-mount is used in configuration of greetd to provide
+auto-(mounting/unmounting) of XDG_RUNTIME_DIR in the way that it will not
+interfere with default pam-mount configuration.")))
-- 
2.36.1

[bug#49969] [PATCH v12 5/8] gnu: base: Add greetd-service-type.

[muradm]

* gnu/services/base.scm (greetd-service-type): New variable
* gnu/services/base.scm (greetd-configuration): New data type
* gnu/services/base.scm (greetd-terminal-configuration): New data type
* gnu/services/base.scm (greetd-agreety-session): New data type
* gnu/services/base.scm (pam-limits-service-type): Shoul be aware of
greetd PAM service
* gnu/services/pam-mount.scm (pam-mount-pam-service): Shoul be aware
of greetd PAM service
---
 doc/guix.texi              | 137 +++++++++++++++++++++++
 gnu/services/base.scm      | 223 ++++++++++++++++++++++++++++++++++++-
 gnu/services/pam-mount.scm |   2 +-
 3 files changed, 360 insertions(+), 2 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index ea133d519a..997b93c831 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -96,6 +96,7 @@ Copyright @copyright{} 2021 Domagoj Stolfa@*
 Copyright @copyright{} 2021 Hui Lu@*
 Copyright @copyright{} 2021 pukkamustard@*
 Copyright @copyright{} 2021 Alice Brenon@*
+Copyright @copyright{} 2021 muradm@*
 Copyright @copyright{} 2021 Josselin Poiret@*
 Copyright @copyright{} 2021 Andrew Tropin@*
 Copyright @copyright{} 2021 Sarah Morgensen@*
@@ -18019,6 +18020,142 @@ about the Pluggable Authentication Module (PAM) limits, refer to the
 @samp{pam_limits} man page from the @code{linux-pam} package.
 @end deffn
 
+@defvr {Scheme Variable} greetd-service-type
+@uref{https://git.sr.ht/~kennylevinsen/greetd, @code{greetd}} is a minimal and
+flexible login manager daemon, that makes no assumptions about what you
+want to launch.
+
+If you can run it from your shell in a TTY, greetd can start it. If it
+can be taught to speak a simple JSON-based IPC protocol, then it can be
+a geeter.
+
+@code{greetd-service-type} provides necessary infrastructure for logging
+in users, including:
+
+@itemize @bullet
+@item
+@code{greetd} PAM service
+
+@item
+Special variation of @code{pam-mount} to mount @code{XDG_RUNTIME_DIR}
+@end itemize
+
+Here is example of switching from @code{mingetty-service-type} to
+@code{greetd-service-type}, and how different terminals could be:
+
+@lisp
+  (append
+   (modify-services %base-services
+     ;; greetd-service-type provides "greetd" PAM service
+     (delete login-service-type)
+     ;; and can be used in place of mingetty-service-type
+     (delete mingetty-service-type))
+   (list
+    (service greetd-service-type
+             (greetd-configuration
+              (terminals
+               (list
+                ;; we can make any terminal active by default
+                (greetd-terminal-configuration (terminal-vt "1") (terminal-switch #t))
+                ;; we can make environment without XDG_RUNTIME_DIR set
+                ;; even provide our own environment variables
+                (greetd-terminal-configuration
+                 (terminal-vt "2")
+                 (default-session-command
+                   (greetd-agreety-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")))))
+                ;; we can use any other executable command as greeter
+                (greetd-terminal-configuration
+                 (terminal-vt "4")
+                 (default-session-command (program-file "my-noop-greeter" #~(exit))))
+                (greetd-terminal-configuration (terminal-vt "5"))
+                (greetd-terminal-configuration (terminal-vt "6"))))))
+    ;; mingetty-service-type can be used in parallel
+    ;; if needed to do so, do not (delete login-service-type)
+    ;; as illustrated above
+    #| (service mingetty-service-type (mingetty-configuration (tty "tty8"))) |#))
+@end lisp
+@end defvr
+
+@deftp {Data Type} greetd-configuration
+Configuration record for the @code{greetd-service-type}.
+@table @asis
+
+@item @code{motd}
+A file-like object containing the ``message of the day''.
+
+@item @code{allow-empty-passwords?} (default: @code{#t})
+Allow empty passwords by default so that first-time users can log in when
+the 'root' account has just been created.
+
+@item @code{terminals} (default: @code{'()})
+List of @code{greetd-terminal-configuration} per terminal for which
+@code{greetd} should be started.
+@end table
+@end deftp
+
+@deftp {Data Type} greetd-terminal-configuration
+Configuration record for per terminal greetd daemon service.
+
+@table @asis
+@item @code{greetd} (default: @code{greetd})
+The greetd package to use.
+
+@item @code{config-file-name}
+Configuration file name to use for greetd daemon. Generally, autogenerated
+derivation based on @code{terminal-vt} value.
+
+@item @code{log-file-name}
+Log file name to use for greetd daemon. Generally, autogenerated
+name based on @code{terminal-vt} value.
+
+@item @code{terminal-vt} (default: @samp{"7"})
+The VT to run on. Use of a specific VT with appropriate conflict avoidance
+is recommended.
+
+@item @code{terminal-switch} (default: @code{#f})
+Make this terminal active on start of @code{greetd}.
+
+@item @code{default-session-user} (default: @samp{"greeter"})
+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
+@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.
+
+@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.
+
+@item @code{command-args} (default: @code{'("-l")})
+Command arguments to pass to command.
+
+@item @code{extra-env} (default: @code{'()})
+Extra environment variables to set on login.
+
+@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
+are set right after mentioned variables, so that they can be overriden.
+
+@end table
+@end deftp
+
 @node Scheduled Job Execution
 @subsection Scheduled Job Execution
 
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 6865d03f25..0e7bfe7f5a 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -16,6 +16,7 @@
 ;;; Copyright © 2021 qblade <qblade@protonmail.com>
 ;;; Copyright © 2021 Hui Lu <luhuins@163.com>
 ;;; Copyright © 2021, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;; Copyright © 2022 Guillaume Le Vaillant <glv@posteo.net>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -219,6 +220,11 @@ (define-module (gnu services base)
             pam-limits-service-type
             pam-limits-service
 
+            greetd-service-type
+            greetd-configuration
+            greetd-terminal-configuration
+            greetd-agreety-session
+
             %base-services))
 
 ;;; Commentary:
@@ -1439,7 +1445,7 @@ (define pam-limits-service-type
                               (module "pam_limits.so")
                               (arguments '("conf=/etc/security/limits.conf")))))
              (if (member (pam-service-name pam)
-                         '("login" "su" "slim" "gdm-password" "sddm"
+                         '("login" "greetd" "su" "slim" "gdm-password" "sddm"
                            "sudo" "sshd"))
                  (pam-service
                   (inherit pam)
@@ -2775,6 +2781,221 @@ (define %qemu-static-networking
    (provision '(networking))
    (name-servers '("10.0.2.3"))))
 
+\f
+;;;
+;;; 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
+  (match-lambda
+    (($ <greetd-agreety-session> _ 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 #$@args)))))))
+
+(define greetd-agreety-tty-xdg-session-command
+  (match-lambda
+    (($ <greetd-agreety-session> _ 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 #$@args)))))))
+
+(define (make-greetd-agreety-session-command config command)
+  (let ((agreety (file-append (greetd-agreety config) "/bin/agreety")))
+    (program-file
+     "agreety-command"
+     #~(execl #$agreety #$agreety "-c" #$command))))
+
+(define (make-greetd-default-session-command config-or-command)
+  (cond ((greetd-agreety-session? config-or-command)
+         (cond ((greetd-agreety-xdg-env? config-or-command)
+                (make-greetd-agreety-session-command
+                 config-or-command
+                 (greetd-agreety-tty-xdg-session-command config-or-command)))
+               (#t
+                (make-greetd-agreety-session-command
+                 config-or-command
+                 (greetd-agreety-tty-session-command config-or-command)))))
+        (#t config-or-command)))
+
+(define-record-type* <greetd-terminal-configuration>
+  greetd-terminal-configuration make-greetd-terminal-configuration
+  greetd-terminal-configuration?
+  (greetd greetd-package (default greetd))
+  (config-file-name greetd-config-file-name (thunked)
+                    (default (default-config-file-name this-record)))
+  (log-file-name greetd-log-file-name (thunked)
+                 (default (default-log-file-name this-record)))
+  (terminal-vt greetd-terminal-vt (default "7"))
+  (terminal-switch greetd-terminal-switch (default #f))
+  (default-session-user greetd-default-session-user (default "greeter"))
+  (default-session-command greetd-default-session-command
+    (default (greetd-agreety-session))
+    (sanitize make-greetd-default-session-command)))
+
+(define (default-config-file-name config)
+  (string-join (list "config-" (greetd-terminal-vt config) ".toml") ""))
+
+(define (default-log-file-name config)
+  (string-join (list "/var/log/greetd-" (greetd-terminal-vt config) ".log") ""))
+
+(define (make-greetd-terminal-configuration-file config)
+  (let*
+      ((config-file-name (greetd-config-file-name config))
+       (terminal-vt (greetd-terminal-vt config))
+       (terminal-switch (greetd-terminal-switch config))
+       (default-session-user (greetd-default-session-user config))
+       (default-session-command (greetd-default-session-command config)))
+    (mixed-text-file
+     config-file-name
+     "[terminal]\n"
+     "vt = " terminal-vt "\n"
+     "switch = " (if terminal-switch "true" "false") "\n"
+     "[default_session]\n"
+     "user = " default-session-user "\n"
+     "command = " default-session-command "\n")))
+
+(define %greetd-accounts
+  (list (user-account
+         (name "greeter")
+         (group "wheel")
+         (supplementary-groups '("users" "tty" "input" "video" "audio"))
+         (system? #t))))
+
+(define %greetd-file-systems
+  (list (file-system
+          (device "none")
+          (mount-point "/run/greetd/pam_mount")
+          (type "tmpfs")
+          (check? #f)
+          (flags '(no-suid no-dev no-exec))
+          (options "mode=0755")
+          (create-mount-point? #t))))
+
+(define %greetd-pam-mount-rules
+  `((debug (@ (enable "0")))
+    (volume (@ (sgrp "users")
+               (fstype "tmpfs")
+               (mountpoint "/run/user/%(USERUID)")
+               (options "noexec,nosuid,nodev,size=1g,mode=0700,uid=%(USERUID),gid=%(USERGID)")))
+    (logout (@ (wait "0")
+               (hup "0")
+               (term "yes")
+               (kill "no")))
+    (mkmountpoint (@ (enable "1") (remove "true")))))
+
+(define-record-type* <greetd-configuration>
+  greetd-configuration make-greetd-configuration
+  greetd-configuration?
+  (motd greetd-motd (default %default-motd))
+  (allow-empty-passwords? greetd-allow-empty-passwords? (default #t))
+  (terminals greetd-terminals (default '())))
+
+(define (make-greetd-pam-mount-conf-file config)
+  (computed-file
+   "greetd_pam_mount.conf.xml"
+   #~(begin
+       (use-modules (sxml simple))
+       (call-with-output-file #$output
+         (lambda (port)
+           (sxml->xml
+            '(*TOP*
+              (*PI* xml "version='1.0' encoding='utf-8'")
+              (pam_mount
+               #$@%greetd-pam-mount-rules
+               (pmvarrun
+                #$(file-append greetd-pam-mount
+                               "/sbin/pmvarrun -u '%(USER)' -o '%(OPERATION)'"))))
+            port))))))
+
+(define (greetd-etc-service config)
+  `(("security/greetd_pam_mount.conf.xml"
+     ,(make-greetd-pam-mount-conf-file config))))
+
+(define (greetd-pam-service config)
+  (define optional-pam-mount
+    (pam-entry
+     (control "optional")
+     (module #~(string-append #$greetd-pam-mount "/lib/security/pam_mount.so"))
+     (arguments '("disable_interactive"))))
+
+  (list
+   (unix-pam-service "greetd"
+                     #:login-uid? #t
+                     #:allow-empty-passwords?
+                     (greetd-allow-empty-passwords? config)
+                     #:motd
+                     (greetd-motd config))
+   (lambda (pam)
+     (if (member (pam-service-name pam)
+                 '("login" "greetd" "su" "slim" "gdm-password"))
+         (pam-service
+          (inherit pam)
+          (auth (append (pam-service-auth pam)
+                        (list optional-pam-mount)))
+          (session (append (pam-service-session pam)
+                           (list optional-pam-mount))))
+         pam))))
+
+(define (greetd-shepherd-services config)
+  (map
+   (lambda (tc)
+     (let*
+         ((greetd-bin (file-append (greetd-package tc) "/sbin/greetd"))
+          (greetd-conf (make-greetd-terminal-configuration-file tc))
+          (greetd-log (greetd-log-file-name tc))
+          (greetd-vt (greetd-terminal-vt tc)))
+       (shepherd-service
+        (documentation "Minimal and flexible login manager daemon")
+        (requirement '(user-processes host-name udev virtual-terminal))
+        (provision (list (symbol-append
+                          'term-tty
+                          (string->symbol (greetd-terminal-vt tc)))))
+        (start #~(make-forkexec-constructor
+                  (list #$greetd-bin "-c" #$greetd-conf)
+                  #:log-file #$greetd-log))
+        (stop #~(make-kill-destructor)))))
+   (greetd-terminals config)))
+
+(define greetd-service-type
+  (service-type
+   (name 'greetd)
+   (description "Provides necessary infrastructure for logging into the
+system including @code{greetd} PAM service, @code{pam-mount} module to
+mount/unmount /run/user/<uid> directory for user and @code{greetd}
+login manager daemon.")
+   (extensions
+    (list
+     (service-extension account-service-type (const %greetd-accounts))
+     (service-extension file-system-service-type (const %greetd-file-systems))
+     (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)))
+   (default-value (greetd-configuration))))
+
 \f
 (define %base-services
   ;; Convenience variable holding the basic services.
diff --git a/gnu/services/pam-mount.scm b/gnu/services/pam-mount.scm
index 33649b0f7c..e60781d05b 100644
--- a/gnu/services/pam-mount.scm
+++ b/gnu/services/pam-mount.scm
@@ -90,7 +90,7 @@ (define optional-pam-mount
      (module #~(string-append #$pam-mount "/lib/security/pam_mount.so"))))
   (list (lambda (pam)
           (if (member (pam-service-name pam)
-                      '("login" "su" "slim" "gdm-password" "sddm"))
+                      '("login" "greetd" "su" "slim" "gdm-password" "sddm"))
               (pam-service
                (inherit pam)
                (auth (append (pam-service-auth pam)
-- 
2.36.1

[bug#49969] [PATCH v12 6/8] gnu: admin: Add libseat 0.8.0 and move seatd.

[muradm]

* gnu/packages/admin.scm (libseat): New variable
* gnu/packages/admin.scm (seatd): New variable
* gnu/packages/freedesktop.scm (seatd): Remove variable
* gnu/packages/wm.scm (wlroots): Replace seatd input with libseat
---
 gnu/packages/admin.scm       | 53 ++++++++++++++++++++++++++++++++++++
 gnu/packages/freedesktop.scm | 29 --------------------
 gnu/packages/wm.scm          |  4 ++-
 3 files changed, 56 insertions(+), 30 deletions(-)

diff --git a/gnu/packages/admin.scm b/gnu/packages/admin.scm
index d6e1d819ab..eb6450b4da 100644
--- a/gnu/packages/admin.scm
+++ b/gnu/packages/admin.scm
@@ -46,6 +46,7 @@
 ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
 ;;; Copyright © 2021 muradm <mail@muradm.net>
+;;; Copyright © 2021 pineapples <guixuser6392@protonmail.com>
 ;;; Copyright © 2021 Petr Hodina <phodina@protonmail.com>
 ;;; Copyright © 2021 Artyom V. Poptsov <poptsov.artyom@gmail.com>
 ;;; Copyright © 2022 Wamm K. D. <jaft.r@outlook.com>
@@ -104,6 +105,7 @@ (define-module (gnu packages admin)
   #:use-module (gnu packages elf)
   #:use-module (gnu packages file)
   #:use-module (gnu packages flex)
+  #:use-module (gnu packages freedesktop)
   #:use-module (gnu packages gawk)
   #:use-module (gnu packages gettext)
   #:use-module (gnu packages gl)
@@ -5097,3 +5099,54 @@ (define-public greetd-pam-mount
 greetd-pam-mount is used in configuration of greetd to provide
 auto-(mounting/unmounting) of XDG_RUNTIME_DIR in the way that it will not
 interfere with default pam-mount configuration.")))
+
+(define-public libseat
+  (package
+    (name "libseat")
+    (version "0.7.0")
+    (source (origin
+              (method git-fetch)
+              (uri (git-reference
+                    (url "https://git.sr.ht/~kennylevinsen/seatd")
+                    (commit version)))
+              (file-name (git-file-name name version))
+              (sha256
+               (base32
+                "10f8387yy5as547xjjhl0cna6iywdgjmw0iq2nvcs8q6vlpnik4v"))))
+    (build-system meson-build-system)
+    (arguments
+     `(#:configure-flags '("-Dlibseat-logind=elogind"
+                           "-Dserver=disabled")))
+    (native-inputs
+     `(("pkg-config" ,pkg-config)))
+    (propagated-inputs
+     `(("elogind" ,elogind)))
+    (home-page "https://sr.ht/~kennylevinsen/seatd")
+    (synopsis "Seat management library")
+    (description
+     "This package provides a universal seat management library that
+allows applications to use whatever seat management is available.")
+    (license license:expat)))
+
+(define-public seatd
+  (package
+    (inherit libseat)
+    (name "seatd")
+    (arguments
+     `(#:configure-flags '("-Dlibseat-logind=elogind")
+       #:phases
+       (modify-phases %standard-phases
+         (add-after 'install 'remove-libs
+           (lambda* (#:key outputs #:allow-other-keys)
+             (with-directory-excursion (assoc-ref outputs "out")
+               (for-each delete-file-recursively '("lib" "include"))))))))
+    (native-inputs
+     `(("pkg-config" ,pkg-config)
+       ("scdoc" ,scdoc)))
+    (inputs '())
+    (synopsis "Seat management daemon")
+    (description
+     "This package provides a minimal seat management daemon whose task is to
+mediate access to shared devices, such as graphics and input, for applications
+that require it.")
+    (license license:expat)))
diff --git a/gnu/packages/freedesktop.scm b/gnu/packages/freedesktop.scm
index fc2c45c1f1..309876867a 100644
--- a/gnu/packages/freedesktop.scm
+++ b/gnu/packages/freedesktop.scm
@@ -849,35 +849,6 @@ (define (source-file regexp)
 with localed.  This package is extracted from the broader systemd package.")
     (license license:lgpl2.1+)))
 
-(define-public seatd
-  (package
-    (name "seatd")
-    (version "0.5.0")
-    (source (origin
-              (method git-fetch)
-              (uri (git-reference
-                    (url "https://git.sr.ht/~kennylevinsen/seatd")
-                    (commit version)))
-              (file-name (git-file-name name version))
-              (sha256
-               (base32
-                "1kglq8v4rnr3415mfaghyv2s2f8mxsy5s881gmm2908ig4n4j297"))))
-    (build-system meson-build-system)
-    (arguments
-     `(#:configure-flags '("-Dlogind=enabled")))
-    (native-inputs
-     (list pkg-config scdoc))
-    (propagated-inputs
-     (list elogind))
-    (home-page "https://sr.ht/~kennylevinsen/seatd")
-    (synopsis "Seat management daemon and library")
-    (description
-     "This package provides a minimal seat management daemon whose task is to
-mediate access to shared devices, such as graphics and input, for applications
-that require it.  It also provides a universal seat management library that
-allows applications to use whatever seat management is available.")
-    (license license:expat)))
-
 (define-public packagekit
   (package
     (name "packagekit")
diff --git a/gnu/packages/wm.scm b/gnu/packages/wm.scm
index 123e6ca7e7..24d95ba86c 100644
--- a/gnu/packages/wm.scm
+++ b/gnu/packages/wm.scm
@@ -54,6 +54,7 @@
 ;;; Copyright © 2022 Daniel Meißner <daniel.meissner-i4k@ruhr-uni-bochum.de>
 ;;; Copyright © 2022 Pier-Hugues Pellerin <ph@heykimo.com>
 ;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2022 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -88,6 +89,7 @@ (define-module (gnu packages wm)
   #:use-module (guix utils)
   #:use-module (gnu packages)
   #:use-module (gnu packages bash)
+  #:use-module (gnu packages admin)
   #:use-module (gnu packages autotools)
   #:use-module (gnu packages base)
   #:use-module (gnu packages bison)
@@ -1537,7 +1539,7 @@ (define-public wlroots
            libxkbcommon
            mesa
            pixman
-           seatd
+           libseat
            wayland
            wayland-protocols
            xcb-util-errors
-- 
2.36.1

[bug#49969] [PATCH v12 7/8] gnu: desktop: Add seatd-service-type.

[muradm]

* gnu/services/desktop.scm (seatd-service-type): New variable
* gnu/services/desktop.scm (seatd-configuration): New data type

fix seatd path
---
 doc/guix.texi            | 46 +++++++++++++++++++++++++++++
 gnu/services/desktop.scm | 62 +++++++++++++++++++++++++++++++++++++++-
 2 files changed, 107 insertions(+), 1 deletion(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 997b93c831..799ea932d7 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -22661,6 +22661,52 @@ and ``passwd'' is with the value @code{passwd}.
 @end table
 @end deftp
 
+@defvr {Scheme Variable} seatd-service-type
+@uref{https://sr.ht/~kennylevinsen/seatd/, seatd} is a minimal seat
+management daemon.
+
+Seat management takes care of mediating access to shared devices (graphics,
+input), without requiring the applications needing access to be root.
+
+@lisp
+(append
+  (list
+   ;; make sure seatd is running
+   (service seatd-service-type))
+
+  ;; normally one would want %base-services
+  %base-services)
+
+@end lisp
+@end defvr
+
+@deftp {Data Type} seatd-configuration
+Configuration record for the seatd daemon service.
+
+@table @asis
+@item @code{seatd} (default: @code{seatd})
+The seatd package to use.
+
+@item @code{user} (default: @samp{"root"})
+User to own the seatd socket.
+
+@item @code{group} (default: @samp{"users"})
+Group to own the seatd socket.
+
+@item @code{socket} (default: @samp{"/run/seatd.sock"})
+Where to create the seatd socket.
+
+@item @code{logfile} (default: @samp{"/var/log/seatd.log"})
+Log file to write to.
+
+@item @code{loglevel} (default: @samp{"error"})
+Log level to output logs. Possible values: @samp{"silent"}, @samp{"error"},
+@samp{"info"} and @samp{"debug"}.
+
+@end table
+@end deftp
+
+
 @node Sound Services
 @subsection Sound Services
 
diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index 0499071436..29a3722f1b 100644
--- a/gnu/services/desktop.scm
+++ b/gnu/services/desktop.scm
@@ -13,6 +13,7 @@
 ;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2020 Reza Alizadeh Majd <r.majd@pantherx.org>
 ;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -39,7 +40,9 @@ (define-module (gnu services desktop)
   #:use-module (gnu services networking)
   #:use-module (gnu services sound)
   #:use-module ((gnu system file-systems)
-                #:select (%elogind-file-systems file-system))
+                #:select (%control-groups
+                          %elogind-file-systems
+                          file-system))
   #:autoload   (gnu services sddm) (sddm-service-type)
   #:use-module (gnu system)
   #:use-module (gnu system setuid)
@@ -157,6 +160,9 @@ (define-module (gnu services desktop)
             gnome-keyring-configuration?
             gnome-keyring-service-type
 
+            seatd-configuration
+            seatd-service-type
+
             %desktop-services))
 
 ;;; Commentary:
@@ -1630,6 +1636,60 @@ (define polkit-wheel
 (define polkit-wheel-service
   (simple-service 'polkit-wheel polkit-service-type (list polkit-wheel)))
 
+\f
+;;;
+;;; seatd-service-type -- minimal seat management daemon
+;;;
+
+(define-record-type* <seatd-configuration> seatd-configuration
+  make-seatd-configuration
+  seatd-configuration?
+  (seatd seatd-package (default seatd))
+  (user seatd-user (default "root"))
+  (group seatd-group (default "users"))
+  (socket seatd-socket (default "/run/seatd.sock"))
+  (logfile seatd-logfile (default "/var/log/seatd.log"))
+  (loglevel seatd-loglevel (default "info")))
+
+(define (seatd-shepherd-service config)
+  (list (shepherd-service
+         (documentation "Minimal seat management daemon")
+         (requirement '())
+         ;; TODO: once cgroups is separate dependency
+         ;; here we should depend on it rather than elogind
+         (provision '(seatd elogind))
+         (start #~(make-forkexec-constructor
+                   (list #$(file-append (seatd-package config) "/bin/seatd")
+                         "-u" #$(seatd-user config)
+                         "-g" #$(seatd-group config))
+                   #:environment-variables
+                   (list (string-append "SEATD_LOGLEVEL="
+                                        #$(seatd-loglevel config))
+                         (string-append "SEATD_DEFAULTPATH="
+                                        #$(seatd-socket config)))
+                   #:log-file #$(seatd-logfile config)))
+         (stop #~(make-kill-destructor)))))
+
+(define seatd-environment
+  (match-lambda
+    (($ <seatd-configuration> _ _ _ socket)
+     `(("SEATD_SOCK" . ,socket)))))
+
+(define seatd-service-type
+  (service-type
+   (name 'seatd)
+   (description "Seat management takes care of mediating access
+to shared devices (graphics, input), without requiring the
+applications needing access to be root.")
+   (extensions
+    (list
+     (service-extension session-environment-service-type seatd-environment)
+     ;; TODO: once cgroups is separate dependency we should not mount it here
+     ;; for now it is mounted here, because elogind mounts it
+     (service-extension file-system-service-type (const %control-groups))
+     (service-extension shepherd-root-service-type seatd-shepherd-service)))
+   (default-value (seatd-configuration))))
+
 \f
 ;;;
 ;;; The default set of desktop services.
-- 
2.36.1

[bug#49969] [PATCH v12 8/8] gnu: tests: Add seatd/greetd based minimal desktop system tests.

[muradm]

* gnu/tests/desktop.scm (minimal-desktop): seatd/greetd based
minimal desktop test

fix tests
---
 gnu/tests/desktop.scm | 212 +++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 211 insertions(+), 1 deletion(-)

diff --git a/gnu/tests/desktop.scm b/gnu/tests/desktop.scm
index 57069c0ede..25971f9225 100644
--- a/gnu/tests/desktop.scm
+++ b/gnu/tests/desktop.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -18,13 +19,17 @@
 
 (define-module (gnu tests desktop)
   #:use-module (gnu tests)
+  #:use-module (gnu packages shells)
   #:use-module (gnu services)
+  #:use-module (gnu services base)
   #:use-module (gnu services dbus)
   #:use-module (gnu services desktop)
+  #:use-module (gnu system)
   #:use-module (gnu system vm)
   #:use-module (guix gexp)
   #:use-module (srfi srfi-1)
-  #:export (%test-elogind))
+  #:export (%test-elogind
+            %test-minimal-desktop))
 
 \f
 ;;;
@@ -100,3 +105,208 @@ (define %test-elogind
                #:imported-modules '((gnu services herd)
                                     (guix combinators)))))
       (run-elogind-test (virtual-machine os))))))
+
+\f
+;;;
+;;; Seatd/greetd based minimal desktop
+;;;
+
+(define %minimal-services
+  (append
+   (modify-services %base-services
+     ;; greetd-service-type provides "greetd" PAM service
+     (delete login-service-type)
+     ;; and can be used in place of mingetty-service-type
+     (delete mingetty-service-type))
+   (list
+    (service seatd-service-type)
+    (service greetd-service-type
+             (greetd-configuration
+              (terminals
+               (list
+                ;; we can make any terminal active by default
+                (greetd-terminal-configuration (terminal-vt "1") (terminal-switch #t))
+                ;; we can make environment without XDG_RUNTIME_DIR set
+                ;; even provide our own environment variables
+                (greetd-terminal-configuration
+                 (terminal-vt "2")
+                 (default-session-command
+                   (greetd-agreety-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")))))
+                ;; we can use any other executable command as greeter
+                (greetd-terminal-configuration
+                 (terminal-vt "4")
+                 (default-session-command (program-file "my-noop-greeter" #~(exit))))
+                (greetd-terminal-configuration (terminal-vt "5"))
+                (greetd-terminal-configuration (terminal-vt "6"))))))
+    ;; mingetty-service-type can be used in parallel
+    ;; if needed to do so, do not (delete login-service-type)
+    ;; as illustrated above
+    #| (service mingetty-service-type (mingetty-configuration (tty "tty8"))) |#)))
+
+(define-syntax-rule (minimal-operating-system user-services ...)
+  "Return an operating system that includes USER-SERVICES in addition to
+minimal %BASE-SERVICES."
+  (operating-system (inherit %simple-os)
+                    (services (cons* user-services ... %minimal-services))))
+
+(define (run-minimal-desktop-test os vm)
+  (define test
+    (with-imported-modules '((gnu build marionette)
+                             (guix build syscalls))
+      #~(begin
+          (use-modules (gnu build marionette)
+                       (guix build syscalls)
+                       (srfi srfi-1)
+                       (srfi srfi-64)
+                       (ice-9 pretty-print))
+
+          (define marionette
+            (make-marionette #$vm))
+
+          (define (file-get-all-strings fname)
+            (marionette-eval '(use-modules (rnrs io ports)) marionette)
+            (wait-for-file fname marionette #:read 'get-string-all))
+
+          (define (wait-for-unix-socket-m socket)
+            (wait-for-unix-socket socket marionette))
+
+          (mkdir #$output)
+          (chdir #$output)
+
+          (test-runner-current (system-test-runner #$output))
+          (test-begin "minimal-desktop")
+
+          (test-assert "seatd is ready"
+            (wait-for-unix-socket-m "/run/seatd.sock"))
+
+          (test-equal "login user on tty1"
+            "alice\n"
+            (begin
+              ;; Wait for tty1.
+              (marionette-eval
+               '(begin
+                  (use-modules (gnu services herd))
+                  (start-service 'term-tty1))
+               marionette)
+              (marionette-control "sendkey ctrl-alt-f1" marionette)
+
+              ;; login as root change alice password and exit
+              ;; then login as alice
+              (for-each
+               (lambda (cmd) (marionette-type cmd marionette) (sleep 1))
+               (list
+                "root\n"
+                "passwd alice\n"
+                "alice\n"
+                "alice\n"
+                "exit\n"
+                "alice\n"
+                "alice\n"
+                "id -un > logged-in\n"))
+
+              (file-get-all-strings "/home/alice/logged-in")))
+
+          (test-equal "validate user environment"
+            '("SEATD_SOCK=/run/seatd.sock"
+              "XDG_RUNTIME_DIR=/run/user/1000"
+              "XDG_SEAT=seat0"
+              "XDG_VTNR=1")
+
+            (begin
+              (marionette-type "env > env\n" marionette)
+              (sleep 1)
+
+              (define user-env (string-tokenize
+                                (file-get-all-strings "/home/alice/env")))
+
+              (define (expected-var var)
+                (any (lambda (s) (string-contains var s))
+                     '("SEATD_SOCK"
+                       "XDG_RUNTIME_DIR"
+                       "XDG_SEAT"
+                       "XDG_VTNR")))
+
+              (sort (filter expected-var user-env) string<?)))
+
+          (test-assert "validate SEATD_SOCK and GREETD_SOCK"
+            (begin
+              (marionette-type "env > env\n" marionette)
+              (sleep 1)
+
+              (define (sock-var? var)
+                (any (lambda (s) (string-contains var s))
+                     '("SEATD_SOCK" "GREETD_SOCK")))
+
+              (define (sock-var-sock var)
+                (car (cdr (string-split var #\=))))
+
+              (let*
+                  ((out (file-get-all-strings "/home/alice/env"))
+                   (out (string-tokenize out))
+                   (out (filter sock-var? out))
+                   (socks (map sock-var-sock out))
+                   (socks (map wait-for-unix-socket-m socks)))
+                (and (= 2 (length socks)) (every identity socks)))))
+
+          (test-assert "greetd is ready"
+            (begin
+              (marionette-type "ps -C greetd -o pid,args --no-headers > ps-greetd\n"
+                               marionette)
+              (sleep 1)
+
+              (define (greetd-daemon? cmd)
+                (string-contains cmd "config"))
+
+              (define (greetd-cmd-to-pid cmd)
+                (car (string-split cmd #\space)))
+
+              (define (greetd-pid-to-sock pid)
+                (string-append "/run/greetd-" pid ".sock"))
+
+              (let* ((out (file-get-all-strings "/home/alice/ps-greetd"))
+                     (out (string-split out #\newline))
+                     (out (map string-trim-both out))
+                     (out (filter greetd-daemon? out))
+                     (pids (map greetd-cmd-to-pid out))
+                     (socks (map greetd-pid-to-sock pids))
+                     (socks (map wait-for-unix-socket-m socks)))
+                (every identity socks))))
+
+          ;; a bit weak, but tests everything at once actually
+          (test-equal "check /run/user/<uid> mounted and writable"
+            "alice\n"
+            (begin
+              (marionette-type "echo alice > /run/user/1000/test\n" marionette)
+              (file-get-all-strings "/run/user/1000/test")))
+
+          (test-assert "screendump"
+            (begin
+              (marionette-control (string-append "screendump " #$output
+                                                 "/tty1.ppm")
+                                  marionette)
+              (file-exists? "tty1.ppm")))
+
+          (test-end))))
+
+  (gexp->derivation "minimal-desktop" test))
+
+(define %test-minimal-desktop
+  (system-test
+   (name "minimal-desktop")
+   (description
+    "Test whether we can log in when seatd and greetd is enabled")
+   (value
+    (let* ((os (marionette-operating-system
+                (minimal-operating-system)
+                #:imported-modules '((gnu services herd)
+                                     (guix combinators))))
+           (vm (virtual-machine os)))
+      (run-minimal-desktop-test (virtualized-operating-system os '())
+                                #~(list #$vm))))))
-- 
2.36.1

[bug#49969] [PATCH v12 0/8] with fixed tests

[muradm]

[-- Attachment #1: Type: text/plain, Size: 1105 bytes --]


Hi, is there anything else needed to be updated for merging?

Thanks in advance,
Muradm

muradm <mail@muradm.net> writes:

> system test now ends as required
>
> muradm (8):
>   gnu: crates-io: Add rust-enquote 1.1.0.
>   gnu: crates-io: Add rust-pam-sys 0.5.6.
>   gnu: admin: Add greetd 0.8.0.
>   gnu: admin: Add greetd-pam-mount.
>   gnu: base: Add greetd-service-type.
>   gnu: admin: Add libseat 0.8.0 and move seatd.
>   gnu: desktop: Add seatd-service-type.
>   gnu: tests: Add seatd/greetd based minimal desktop system 
>   tests.
>
>  doc/guix.texi                | 183 ++++++++++++++++++++++++++++
>  gnu/packages/admin.scm       | 162 +++++++++++++++++++++++++
>  gnu/packages/crates-io.scm   |  40 +++++++
>  gnu/packages/freedesktop.scm |  29 -----
>  gnu/packages/wm.scm          |   4 +-
>  gnu/services/base.scm        | 223 
>  ++++++++++++++++++++++++++++++++++-
>  gnu/services/desktop.scm     |  62 +++++++++-
>  gnu/services/pam-mount.scm   |   2 +-
>  gnu/tests/desktop.scm        | 212 
>  ++++++++++++++++++++++++++++++++-
>  9 files changed, 883 insertions(+), 34 deletions(-)


[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 832 bytes --]

bug#49969: [PATCH v12 0/8] with fixed tests

[Lars-Dominik Braun]

Hi,

> Hi, is there anything else needed to be updated for merging?
looks good to me. Merged.

d6dda325c10a4aa8605fefa3906066ce792c2e81 gnu: desktop: Add seatd-service-type.
167b8f29b3679a23bb20f5ed4181738c389d9d89 gnu: admin: Add libseat 0.8.0 and move seatd.
530e0f02606a0e04818bdd792bb5239f7ee9e637 gnu: base: Add greetd-service-type.
32ca068cb9f98698bd1c29b980ecd4ae36caf795 gnu: admin: Add greetd-pam-mount.
c08d56a161d1308e7c021acec3a57c3f559137de gnu: admin: Add greetd 0.8.0.
7943f9f170f099b3cae78cc897d4ac68649d03ee gnu: crates-io: Add rust-pam-sys 0.5.6.
7f7a075c3debc92168db7dbdf9a2a1ef3156b0ea gnu: crates-io: Add rust-enquote 1.1.0.

Cheers,
Lars