aboutsummaryrefslogtreecommitdiff
path: root/gnu/services/desktop.scm
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/services/desktop.scm')
-rw-r--r--gnu/services/desktop.scm238
1 files changed, 228 insertions, 10 deletions
diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index 4e4b49df3e..b91bdd8ad3 100644
--- a/gnu/services/desktop.scm
+++ b/gnu/services/desktop.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Andy Wingo <wingo@igalia.com>
+;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -24,12 +25,18 @@
#:use-module (gnu services xorg)
#:use-module (gnu services networking)
#:use-module (gnu system shadow)
+ #:use-module (gnu system linux) ; unix-pam-service
#:use-module (gnu packages glib)
#:use-module (gnu packages admin)
+ #:use-module (gnu packages freedesktop)
#:use-module (gnu packages gnome)
#:use-module (gnu packages avahi)
#:use-module (gnu packages wicd)
+ #:use-module (gnu packages polkit)
+ #:use-module ((gnu packages linux)
+ #:select (lvm2 fuse alsa-utils crda))
#:use-module (guix monads)
+ #:use-module (guix records)
#:use-module (guix store)
#:use-module (guix gexp)
#:use-module (ice-9 match)
@@ -39,6 +46,9 @@
geoclue-application
%standard-geoclue-applications
geoclue-service
+ polkit-service
+ elogind-configuration
+ elogind-service
%desktop-services))
;;; Commentary:
@@ -374,6 +384,199 @@ site} for more information."
;;;
+;;; Polkit privilege management service.
+;;;
+
+(define* (polkit-service #:key (polkit polkit))
+ "Return a service that runs the @command{polkit} privilege management
+service. By querying the @command{polkit} service, a privileged system
+component can know when it should grant additional capabilities to ordinary
+users. For example, an ordinary user can be granted the capability to suspend
+the system if the user is logged in locally."
+ (with-monad %store-monad
+ (return
+ (service
+ (documentation "Run the polkit privilege management service.")
+ (provision '(polkit-daemon))
+ (requirement '(dbus-system))
+
+ (start #~(make-forkexec-constructor
+ (list (string-append #$polkit "/lib/polkit-1/polkitd"))))
+ (stop #~(make-kill-destructor))
+
+ (user-groups (list (user-group
+ (name "polkitd")
+ (system? #t))))
+ (user-accounts (list (user-account
+ (name "polkitd")
+ (group "polkitd")
+ (system? #t)
+ (comment "Polkit daemon user")
+ (home-directory "/var/empty")
+ (shell
+ "/run/current-system/profile/sbin/nologin"))))
+
+ (pam-services (list (unix-pam-service "polkit-1")))))))
+
+
+;;;
+;;; Elogind login and seat management service.
+;;;
+
+(define-record-type* <elogind-configuration> elogind-configuration
+ make-elogind-configuration
+ elogind-configuration
+ (kill-user-processes? elogind-kill-user-processes?
+ (default #f))
+ (kill-only-users elogind-kill-only-users
+ (default '()))
+ (kill-exclude-users elogind-kill-exclude-users
+ (default '("root")))
+ (inhibit-delay-max-seconds elogind-inhibit-delay-max-seconds
+ (default 5))
+ (handle-power-key elogind-handle-power-key
+ (default 'poweroff))
+ (handle-suspend-key elogind-handle-suspend-key
+ (default 'suspend))
+ (handle-hibernate-key elogind-handle-hibernate-key
+ ;; (default 'hibernate)
+ ;; XXX Ignore it for now, since we don't
+ ;; yet handle resume-from-hibernation in
+ ;; our initrd.
+ (default 'ignore))
+ (handle-lid-switch elogind-handle-lid-switch
+ (default 'suspend))
+ (handle-lid-switch-docked elogind-handle-lid-switch-docked
+ (default 'ignore))
+ (power-key-ignore-inhibited? elogind-power-key-ignore-inhibited?
+ (default #f))
+ (suspend-key-ignore-inhibited? elogind-suspend-key-ignore-inhibited?
+ (default #f))
+ (hibernate-key-ignore-inhibited? elogind-hibernate-key-ignore-inhibited?
+ (default #f))
+ (lid-switch-ignore-inhibited? elogind-lid-switch-ignore-inhibited?
+ (default #t))
+ (holdoff-timeout-seconds elogind-holdoff-timeout-seconds
+ (default 30))
+ (idle-action elogind-idle-action
+ (default 'ignore))
+ (idle-action-seconds elogind-idle-action-seconds
+ (default (* 30 60)))
+ (runtime-directory-size-percent elogind-runtime-directory-size-percent
+ (default 10))
+ (runtime-directory-size elogind-runtime-directory-size
+ (default #f))
+ (remove-ipc? elogind-remove-ipc?
+ (default #t))
+
+ (suspend-state elogind-suspend-state
+ (default '("mem" "standby" "freeze")))
+ (suspend-mode elogind-suspend-mode
+ (default '()))
+ (hibernate-state elogind-hibernate-state
+ (default '("disk")))
+ (hibernate-mode elogind-hibernate-mode
+ (default '("platform" "shutdown")))
+ (hybrid-sleep-state elogind-hybrid-sleep-state
+ (default '("disk")))
+ (hybrid-sleep-mode elogind-hybrid-sleep-mode
+ (default
+ '("suspend" "platform" "shutdown"))))
+
+(define (elogind-configuration-file config)
+ (define (yesno x)
+ (match x
+ (#t "yes")
+ (#f "no")
+ (_ (error "expected #t or #f, instead got:" x))))
+ (define char-set:user-name
+ (string->char-set "abcdefghijklmnopqrstuvwxyz0123456789_-"))
+ (define (valid-list? l pred)
+ (and-map (lambda (x) (string-every pred x)) l))
+ (define (user-name-list users)
+ (unless (valid-list? users char-set:user-name)
+ (error "invalid user list" users))
+ (string-join users " "))
+ (define (enum val allowed)
+ (unless (memq val allowed)
+ (error "invalid value" val allowed))
+ (symbol->string val))
+ (define (non-negative-integer x)
+ (unless (exact-integer? x) (error "not an integer" x))
+ (when (negative? x) (error "negative number not allowed" x))
+ (number->string x))
+ (define handle-actions
+ '(ignore poweroff reboot halt kexec suspend hibernate hybrid-sleep lock))
+ (define (handle-action x)
+ (enum x handle-actions))
+ (define (sleep-list tokens)
+ (unless (valid-list? tokens char-set:user-name)
+ (error "invalid sleep list" tokens))
+ (string-join tokens " "))
+ (define-syntax ini-file-clause
+ (syntax-rules ()
+ ((_ config (prop (parser getter)))
+ (string-append prop "=" (parser (getter config)) "\n"))
+ ((_ config str)
+ (string-append str "\n"))))
+ (define-syntax-rule (ini-file config file clause ...)
+ (text-file file (string-append (ini-file-clause config clause) ...)))
+ (ini-file
+ config "logind.conf"
+ "[Login]"
+ ("KillUserProcesses" (yesno elogind-kill-user-processes?))
+ ("KillOnlyUsers" (user-name-list elogind-kill-only-users))
+ ("KillExcludeUsers" (user-name-list elogind-kill-exclude-users))
+ ("InhibitDelayMaxSecs" (non-negative-integer elogind-inhibit-delay-max-seconds))
+ ("HandlePowerKey" (handle-action elogind-handle-power-key))
+ ("HandleSuspendKey" (handle-action elogind-handle-suspend-key))
+ ("HandleHibernateKey" (handle-action elogind-handle-hibernate-key))
+ ("HandleLidSwitch" (handle-action elogind-handle-lid-switch))
+ ("HandleLidSwitchDocked" (handle-action elogind-handle-lid-switch-docked))
+ ("PowerKeyIgnoreInhibited" (yesno elogind-power-key-ignore-inhibited?))
+ ("SuspendKeyIgnoreInhibited" (yesno elogind-suspend-key-ignore-inhibited?))
+ ("HibernateKeyIgnoreInhibited" (yesno elogind-hibernate-key-ignore-inhibited?))
+ ("LidSwitchIgnoreInhibited" (yesno elogind-lid-switch-ignore-inhibited?))
+ ("HoldoffTimeoutSecs" (non-negative-integer elogind-holdoff-timeout-seconds))
+ ("IdleAction" (handle-action elogind-idle-action))
+ ("IdleActionSeconds" (non-negative-integer elogind-idle-action-seconds))
+ ("RuntimeDirectorySize"
+ (identity
+ (lambda (config)
+ (match (elogind-runtime-directory-size-percent config)
+ (#f (non-negative-integer (elogind-runtime-directory-size config)))
+ (percent (string-append (non-negative-integer percent) "%"))))))
+ ("RemoveIpc" (yesno elogind-remove-ipc?))
+ "[Sleep]"
+ ("SuspendState" (sleep-list elogind-suspend-state))
+ ("SuspendMode" (sleep-list elogind-suspend-mode))
+ ("HibernateState" (sleep-list elogind-hibernate-state))
+ ("HibernateMode" (sleep-list elogind-hibernate-mode))
+ ("HybridSleepState" (sleep-list elogind-hybrid-sleep-state))
+ ("HybridSleepMode" (sleep-list elogind-hybrid-sleep-mode))))
+
+(define* (elogind-service #:key (elogind elogind)
+ (config (elogind-configuration)))
+ "Return a service that runs the @command{elogind} login and seat management
+service. The @command{elogind} service integrates with PAM to allow other
+system components to know the set of logged-in users as well as their session
+types (graphical, console, remote, etc.). It can also clean up after users
+when they log out."
+ (mlet %store-monad ((config-file (elogind-configuration-file config)))
+ (return
+ (service
+ (documentation "Run the elogind login and seat management service.")
+ (provision '(elogind))
+ (requirement '(dbus-system))
+
+ (start #~(make-forkexec-constructor
+ (list (string-append #$elogind "/libexec/elogind/elogind"))
+ #:environment-variables
+ (list (string-append "ELOGIND_CONF_FILE=" #$config-file))))
+ (stop #~(make-kill-destructor))))))
+
+
+;;;
;;; The default set of desktop services.
;;;
(define %desktop-services
@@ -383,23 +586,38 @@ site} for more information."
(avahi-service)
(wicd-service)
(upower-service)
- ;; FIXME: The colord and geoclue services could all be bus-activated
- ;; by default, so they don't run at program startup. However, user
- ;; creation and /var/lib.colord creation happen at service activation
- ;; time, so we currently add them to the set of default services.
+ ;; FIXME: The colord, geoclue, and polkit services could all be
+ ;; bus-activated by default, so they don't run at program startup.
+ ;; However, user creation and /var/lib/colord creation happen at
+ ;; service activation time, so we currently add them to the set of
+ ;; default services.
(colord-service)
(geoclue-service)
- (dbus-service (list avahi wicd upower colord geoclue))
+ (polkit-service)
+ (elogind-service)
+ (dbus-service (list avahi wicd upower colord geoclue polkit elogind))
(ntp-service)
(map (lambda (mservice)
- ;; Provide an nscd ready to use nss-mdns.
(mlet %store-monad ((service mservice))
- (if (memq 'nscd (service-provision service))
- (nscd-service (nscd-configuration)
- #:name-services (list nss-mdns))
- mservice)))
+ (cond
+ ;; Provide an nscd ready to use nss-mdns.
+ ((memq 'nscd (service-provision service))
+ (nscd-service (nscd-configuration)
+ #:name-services (list nss-mdns)))
+
+ ;; Add more rules to udev-service.
+ ;;
+ ;; XXX Keep this in sync with the 'udev-service' call in
+ ;; %base-services. Here we intend only to add 'upower',
+ ;; 'colord', and 'elogind'.
+ ((memq 'udev (service-provision service))
+ (udev-service #:rules
+ (list lvm2 fuse alsa-utils crda
+ upower colord elogind)))
+
+ (else mservice))))
%base-services)))
;;; desktop.scm ends here
generated by cgit v1.2.3 (git 2.25.4) at 2024-11-06 17:47:29 +0000