Package: guix-patches;
Reported by: muradm <mail <at> muradm.net>
Date: Mon, 9 Aug 2021 19:04:01 UTC
Severity: normal
Tags: patch
Done: Lars-Dominik Braun <lars <at> 6xq.net>
Bug is archived. No further changes may be made.
View this message in rfc822 format
From: muradm <mail <at> muradm.net> To: 49969 <at> debbugs.gnu.org Cc: muradm <mail <at> muradm.net> Subject: [bug#49969] [PATCH 5/7] gnu: desktop: Add seatd-service-type 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 <me <at> tobias.gr>
;;; Copyright © 2020 Reza Alizadeh Majd <r.majd <at> pantherx.org>
;;; Copyright © 2021 Brice Waegeneire <brice <at> waegenei.re>
+;;; Copyright © 2021 muradm <mail <at> 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)))
+
+;;;
+;;; 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
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.