Subject: [PATCH 5/7] gnu: desktop: Add seatd-service-type

From: muradm <[email-masked]>
Date: Mon, 9 Aug 2021 22:18:01 +0300

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 <[email-masked]>
 ;;; Copyright © 2020 Reza Alizadeh Majd <[email-masked]>
 ;;; Copyright © 2021 Brice Waegeneire <[email-masked]>
+;;; Copyright © 2021 muradm <[email-masked]>
 ;;;
 ;;; 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)))
 
+
+;;;
+;;; 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))))
+
 
 ;;;
 ;;; The default set of desktop services.
-- 
2.32.0