diff --git a/rosenthal/services/desktop.scm b/rosenthal/services/desktop.scm new file mode 100644 index 0000000..edaab6f --- /dev/null +++ b/rosenthal/services/desktop.scm @@ -0,0 +1,87 @@ +;; SPDX-FileCopyrightText: 2014-2022 Ludovic Courtès +;; SPDX-FileCopyrightText: 2015 Andy Wingo +;; SPDX-FileCopyrightText: 2015 Mark H Weaver +;; SPDX-FileCopyrightText: 2016 Sou Bunnbu +;; SPDX-FileCopyrightText: 2017, 2020, 2022 Maxim Cournoyer +;; SPDX-FileCopyrightText: 2017 Nikita +;; SPDX-FileCopyrightText: 2018, 2020 Efraim Flashner +;; SPDX-FileCopyrightText: 2018 Ricardo Wurmus +;; SPDX-FileCopyrightText: 2017, 2019 Christopher Baines +;; SPDX-FileCopyrightText: 2019 Tim Gesthuizen +;; SPDX-FileCopyrightText: 2019 David Wilson +;; SPDX-FileCopyrightText: 2020 Tobias Geerinckx-Rice +;; SPDX-FileCopyrightText: 2020 Reza Alizadeh Majd +;; SPDX-FileCopyrightText: 2021 Brice Waegeneire +;; SPDX-FileCopyrightText: 2021, 2022 muradm +;; +;; SPDX-License-Identifier: GPL-3.0-or-later + +(define-module (rosenthal services desktop) + #:use-module (gnu packages admin) + #:use-module (gnu services) + #:use-module (gnu services shepherd) + #:use-module (gnu system pam) + #:use-module (gnu system shadow) + #:use-module (guix gexp) + #:use-module (guix records) + #:use-module (ice-9 match) + #:export (seatd-configuration + seatd-service-type)) + +;;; +;;; 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 + make-seatd-configuration + seatd-configuration? + (seatd seatd-package (default seatd)) + (group seatd-group ; string | + (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"))) + +(define (seatd-shepherd-service config) + (list (shepherd-service + (documentation "Minimal seat management daemon") + (requirement '()) + (provision '(seatd)) + (start #~(make-forkexec-constructor + (list #$(file-append (seatd-package config) "/bin/seatd") + "-g" #$(user-group-name (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-accounts + (match-lambda (($ _ group) (list group)))) + +(define seatd-environment + (match-lambda + (($ _ _ 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 account-service-type seatd-accounts) + (service-extension session-environment-service-type seatd-environment) + (service-extension shepherd-root-service-type seatd-shepherd-service))) + (default-value (seatd-configuration))))