From edf954714a71ea3c1b8a872df40ed3735dff10f8 Mon Sep 17 00:00:00 2001
From: muradm <mail@muradm.net>
Date: Fri, 22 Jul 2022 07:09:54 +0300
Subject: [PATCH v2] gnu: seatd-service-type: Should use seat group.
To: 56690@debbugs.gnu.org

* gnu/services/desktop.scm (seatd-service-type): Uses "seat" group.
[extensions]: Added account-service-type with seatd-accounts.
(seatd-accounts): Conditionally produces list with "seat" group.
(<seatd-configuration>):
[user] Drop user field, since it is not going to be used.
[group] Change default value to "seat".
[existing-group?] Add field which controls if group should be
created or not.
* doc/guix.texi: Mention that users may need to become members of
"seat" group and update default value for group field. Add
explanation on seatd.sock file. Remove dropped user field.
---
 doc/guix.texi            | 32 ++++++++++++++++++++++++++++----
 gnu/services/desktop.scm | 15 +++++++++++----
 gnu/tests/desktop.scm    |  9 +++++++++
 3 files changed, 48 insertions(+), 8 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 21cee4e369..cb896fedb4 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -23139,6 +23139,29 @@ 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. Then applications dealing
+with seat management (e.g. @code{sway}) connects to @code{seatd} via
+mentioned socket.
+
+When seat mamanagement is provided by @code{seatd}, users that acquire
+resources provided by @code{seatd} should have permissions to access
+its UNIX domain socket. By default, @code{seatd-service-type} provides
+``seat'' group. And user should become its member.
+
+@lisp
+(user-account
+  (name "alice")
+  (group "users")
+  (supplementary-groups '("wheel"   ;allow use of sudo, etc.
+                          "seat"    ;interact with seatd
+                          "audio"   ;sound card
+                          "video"   ;video devices such as webcams
+                          "cdrom")) ;the good ol' CD-ROM
+  (comment "Bob's sister"))
+@end lisp
+
 @end defvr
 
 @deftp {Data Type} seatd-configuration
@@ -23148,12 +23171,13 @@ 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{existing-group?} (default: @samp{#f})
+If group specified in @code{group} field is pre-existing,
+or should be created by @code{seatd-service-type}.
+
 @item @code{socket} (default: @samp{"/run/seatd.sock"})
 Where to create the seatd socket.
 
diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index 29a3722f1b..9a36927b9f 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.
 ;;;
@@ -1645,8 +1645,8 @@ (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 (default "seat"))
+  (existing-group? seatd-existing-group? (default #f))
   (socket seatd-socket (default "/run/seatd.sock"))
   (logfile seatd-logfile (default "/var/log/seatd.log"))
   (loglevel seatd-loglevel (default "info")))
@@ -1660,7 +1660,6 @@ (define (seatd-shepherd-service config)
          (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="
@@ -1670,6 +1669,13 @@ (define (seatd-shepherd-service config)
                    #:log-file #$(seatd-logfile config)))
          (stop #~(make-kill-destructor)))))
 
+(define seatd-accounts
+  (match-lambda
+    (($ <seatd-configuration> _ group existing-group?)
+     `(,@(if existing-group?  '() (list (user-group
+                                         (name group)
+                                         (system? #t))))))))
+
 (define seatd-environment
   (match-lambda
     (($ <seatd-configuration> _ _ _ socket)
@@ -1683,6 +1689,7 @@ (define seatd-service-type
 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 @@ (define (sock-var-sock var)
                    (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"
-- 
2.37.1