01/02: gnu: seatd-service-type: Use seat group.

[guix-commits]

lilyp pushed a commit to branch master
in repository guix.

commit d1815a68ea48b0015d1beda423d4b2879d29d9ea
Author: muradm <mail@muradm.net>
AuthorDate: Fri Jul 22 07:09:54 2022 +0300

    gnu: seatd-service-type: Use seat group.
    
    * gnu/services/desktop.scm (seatd-group-sanitizer): New variable.
    (<seatd-configuration>)[user]: Removed field.
    [group]: Changed to "seat".  Sanitize via seatd-group-sanitizer.
    (seatd-accounts): New variable.
    (seatd-environment): Adjust to <seatd-configuration> ABI.
    (seatd-service-type)[extensions]: Add account-service-type with 
seatd-accounts.
    * gnu/tests/desktop.scm (run-minimal-desktop-test): Check for correct
    ownership of $SEATD_SOCK.
    * doc/guix.texi ("Desktop Services")[seatd-service-type]: Mention that users
    may need to become members of the "seat" group.
    Update default value for group field.
    Add explanation on seatd.sock file.
    Remove dropped user field.
---
 doc/guix.texi            | 29 +++++++++++++++++++++++++----
 gnu/services/desktop.scm | 23 +++++++++++++++++------
 gnu/tests/desktop.scm    |  9 +++++++++
 3 files changed, 51 insertions(+), 10 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 1e7fff9868..0642b83923 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -23189,6 +23189,30 @@ input), without requiring the applications needing 
access to be root.
   %base-services)
 
 @end lisp
+
+@code{seatd} operates over a UNIX domain socket, with @code{libseat}
+providing the client side of the protocol.  Applications that acquire
+access to the shared resources via @code{seatd} (e.g. @code{sway})
+need to be able to talk to this socket.
+This can be achieved by adding the user they run under to the group
+owning @code{seatd}'s socket (usually ``seat''), like so:
+
+@lisp
+(user-account
+  (name "alice")
+  (group "users")
+  (supplementary-groups '("wheel"   ; allow use of sudo, etc.
+                          "seat"    ; seat management
+                          "audio"   ; sound card
+                          "video"   ; video devices such as webcams
+                          "cdrom")) ; the good ol' CD-ROM
+  (comment "Bob's sister"))
+@end lisp
+
+Depending on your setup, you will have to not only add regular users,
+but also system users to this group.  For instance, some greetd greeters
+require graphics and therefore also need to negotiate with seatd.
+
 @end defvr
 
 @deftp {Data Type} seatd-configuration
@@ -23198,10 +23222,7 @@ Configuration record for the seatd daemon service.
 @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"})
+@item @code{group} (default: @samp{"seat"})
 Group to own the seatd socket.
 
 @item @code{socket} (default: @samp{"/run/seatd.sock"})
diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index f891d1b5cc..f60365abac 100644
--- a/gnu/services/desktop.scm
+++ b/gnu/services/desktop.scm
@@ -13,7 +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>
+;;; Copyright © 2021, 2022 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -69,6 +69,7 @@
   #:use-module (guix records)
   #:use-module (guix packages)
   #:use-module (guix store)
+  #:use-module (guix ui)
   #:use-module (guix utils)
   #:use-module (guix gexp)
   #:use-module (srfi srfi-1)
@@ -1643,12 +1644,19 @@ or setting its password with passwd.")))
 ;;; seatd-service-type -- minimal seat management daemon
 ;;;
 
+(define (seatd-group-sanitizer group-or-name)
+  (match group-or-name
+    ((? user-group? group) group)
+    ((? string? group-name) (user-group (name group-name) (system? #t)))
+    (_ (leave (G_ "seatd: '~a' is not a valid group~%") group-or-name))))
+
 (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"))
+  (group seatd-group                    ; string | <user-group>
+         (default "seat")
+         (sanitize seatd-group-sanitizer))
   (socket seatd-socket (default "/run/seatd.sock"))
   (logfile seatd-logfile (default "/var/log/seatd.log"))
   (loglevel seatd-loglevel (default "info")))
@@ -1662,8 +1670,7 @@ or setting its password with passwd.")))
          (provision '(seatd elogind))
          (start #~(make-forkexec-constructor
                    (list #$(file-append (seatd-package config) "/bin/seatd")
-                         "-u" #$(seatd-user config)
-                         "-g" #$(seatd-group config))
+                         "-g" #$(user-group-name (seatd-group config)))
                    #:environment-variables
                    (list (string-append "SEATD_LOGLEVEL="
                                         #$(seatd-loglevel config))
@@ -1672,9 +1679,12 @@ or setting its password with passwd.")))
                    #:log-file #$(seatd-logfile config)))
          (stop #~(make-kill-destructor)))))
 
+(define seatd-accounts
+  (match-lambda (($ <seatd-configuration> _ group) (list group))))
+
 (define seatd-environment
   (match-lambda
-    (($ <seatd-configuration> _ _ _ socket)
+    (($ <seatd-configuration> _ _ socket)
      `(("SEATD_SOCK" . ,socket)))))
 
 (define seatd-service-type
@@ -1685,6 +1695,7 @@ to shared devices (graphics, input), without requiring the
 applications needing access to be root.")
    (extensions
     (list
+     (service-extension account-service-type seatd-accounts)
      (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
diff --git a/gnu/tests/desktop.scm b/gnu/tests/desktop.scm
index 25971f9225..6fe6ec21be 100644
--- a/gnu/tests/desktop.scm
+++ b/gnu/tests/desktop.scm
@@ -255,6 +255,15 @@ minimal %BASE-SERVICES."
                    (socks (map wait-for-unix-socket-m socks)))
                 (and (= 2 (length socks)) (every identity socks)))))
 
+          (test-equal "seatd.sock ownership"
+            '("root" "seat")
+            `(,(marionette-eval
+                '(passwd:name (getpwuid (stat:uid (stat "/run/seatd.sock"))))
+                marionette)
+              ,(marionette-eval
+                '(group:name (getgrgid (stat:gid (stat "/run/seatd.sock"))))
+                marionette)))
+
           (test-assert "greetd is ready"
             (begin
               (marionette-type "ps -C greetd -o pid,args --no-headers > 
ps-greetd\n"