02/07: gnu: Add elogind service.

[Andy Wingo]

wingo pushed a commit to branch wip-pam-elogind
in repository guix.

commit 36dd8f8b142392626725567216d4bb116d09b214
Author: Andy Wingo <address@hidden>
Date:   Tue Aug 18 11:56:17 2015 +0200

    gnu: Add elogind service.
    
    * gnu/services/desktop.scm (elogind-configuration-file, elogind-service): 
New
      functions.
      (%desktop-services): Add elogind-service.
---
 gnu/services/desktop.scm |  172 +++++++++++++++++++++++++++++++++++++++++++++-
 1 files changed, 171 insertions(+), 1 deletions(-)

diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index 4e4b49d..764954c 100644
--- a/gnu/services/desktop.scm
+++ b/gnu/services/desktop.scm
@@ -26,6 +26,7 @@
   #:use-module (gnu system shadow)
   #: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)
@@ -39,6 +40,7 @@
             geoclue-application
             %standard-geoclue-applications
             geoclue-service
+            elogind-service
             %desktop-services))
 
 ;;; Commentary:
@@ -374,6 +376,173 @@ site} for more information."
 
 
 ;;;
+;;; Elogind login and seat management service.
+;;;
+
+(define (missing-keyword-argument name)
+  (error "missing keyword argument:" name))
+
+(define-syntax-rule (define-with-required-kwargs name (arg ...)
+                      body ...)
+  (define name (lambda* (#:key (arg (missing-keyword-argument 'arg)) ...)
+                 body ...)))
+
+(define-with-required-kwargs elogind-configuration-file
+  (kill-user-processes? kill-only-users kill-exclude-users
+   inhibit-delay-max-seconds
+   handle-power-key handle-suspend-key handle-hibernate-key
+   handle-lid-switch handle-lid-switch-docked
+   power-key-ignore-inhibited? suspend-key-ignore-inhibited?
+   hibernate-key-ignore-inhibited? lid-switch-ignore-inhibited?
+   holdoff-timeout-seconds
+   idle-action idle-action-seconds
+   runtime-directory-size-percent runtime-directory-size
+   remove-ipc?
+   suspend-state suspend-mode
+   hibernate-state hibernate-mode
+   hybrid-sleep-state hybrid-sleep-mode)
+  (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 " "))
+  (text-file
+   "logind.conf"
+   (string-append
+    "[Login]\n"
+    "KillUserProcesses=" (yesno kill-user-processes?) "\n"
+    "KillOnlyUsers=" (user-name-list kill-only-users) "\n"
+    "KillExcludeUsers=" (user-name-list kill-exclude-users) "\n"
+    "InhibitDelayMaxSecs=" (non-negative-integer inhibit-delay-max-seconds) 
"\n"
+    "HandlePowerKey=" (handle-action handle-power-key) "\n"
+    "HandleSuspendKey=" (handle-action handle-suspend-key) "\n"
+    "HandleHibernateKey=" (handle-action handle-hibernate-key) "\n"
+    "HandleLidSwitch=" (handle-action handle-lid-switch) "\n"
+    "HandleLidSwitchDocked=" (handle-action handle-lid-switch-docked) "\n"
+    "PowerKeyIgnoreInhibited=" (yesno power-key-ignore-inhibited?) "\n"
+    "SuspendKeyIgnoreInhibited=" (yesno suspend-key-ignore-inhibited?) "\n"
+    "HibernateKeyIgnoreInhibited=" (yesno hibernate-key-ignore-inhibited?) "\n"
+    "LidSwitchIgnoreInhibited=" (yesno lid-switch-ignore-inhibited?) "\n"
+    "HoldoffTimeoutSecs=" (non-negative-integer holdoff-timeout-seconds) "\n"
+    "IdleAction=" (handle-action idle-action) "\n"
+    "IdleActionSeconds=" (non-negative-integer idle-action-seconds) "\n"
+    "RuntimeDirectorySize="
+    (if runtime-directory-size-percent
+        (string-append
+         (non-negative-integer runtime-directory-size-percent)
+         "%")
+        (non-negative-integer runtime-directory-size)) "\n"
+    "RemoveIpc=" (yesno remove-ipc?) "\n"
+
+    "[Sleep]\n"
+    "SuspendState=" (sleep-list suspend-state) "\n"
+    "SuspendMode=" (sleep-list suspend-mode) "\n"
+    "HibernateState=" (sleep-list hibernate-state) "\n"
+    "HibernateMode=" (sleep-list hibernate-mode) "\n"
+    "HybridSleepState=" (sleep-list hybrid-sleep-state) "\n"
+    "HybridSleepMode=" (sleep-list hybrid-sleep-mode) "\n")))
+
+(define* (elogind-service #:key (elogind elogind)
+                          (kill-user-processes? #f)
+                          (kill-only-users '()) (kill-exclude-users '("root"))
+                          (inhibit-delay-max-seconds 5)
+                          (handle-power-key 'poweroff)
+                          (handle-suspend-key 'suspend)
+                          (handle-hibernate-key 'hibernate)
+                          (handle-lid-switch 'suspend)
+                          (handle-lid-switch-docked 'ignore)
+                          (power-key-ignore-inhibited? #f)
+                          (suspend-key-ignore-inhibited? #f)
+                          (hibernate-key-ignore-inhibited? #f)
+                          (lid-switch-ignore-inhibited? #t)
+                          (holdoff-timeout-seconds 30)
+                          (idle-action 'ignore)
+                          (idle-action-seconds (* 30 60))
+                          (runtime-directory-size-percent 10)
+                          (runtime-directory-size #f)
+                          (remove-ipc? #t)
+
+                          (suspend-state '("mem" "standby" "freeze"))
+                          (suspend-mode '())
+                          (hibernate-state '("disk"))
+                          (hibernate-mode '("platform" "shutdown"))
+                          (hybrid-sleep-state '("disk"))
+                          (hybrid-sleep-mode '("suspend" "platform" 
"shutdown")))
+  "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
+        (elogind-configuration-file
+         #:kill-user-processes? kill-user-processes?
+         #:kill-only-users kill-only-users
+         #:kill-exclude-users kill-exclude-users
+         #:inhibit-delay-max-seconds inhibit-delay-max-seconds
+         #:handle-power-key handle-power-key
+         #:handle-suspend-key handle-suspend-key
+         #:handle-hibernate-key handle-hibernate-key
+         #:handle-lid-switch handle-lid-switch
+         #:handle-lid-switch-docked handle-lid-switch-docked
+         #:power-key-ignore-inhibited? power-key-ignore-inhibited?
+         #:suspend-key-ignore-inhibited? suspend-key-ignore-inhibited?
+         #:hibernate-key-ignore-inhibited? hibernate-key-ignore-inhibited?
+         #:power-key-ignore-inhibited? power-key-ignore-inhibited?
+         #:suspend-key-ignore-inhibited? suspend-key-ignore-inhibited?
+         #:hibernate-key-ignore-inhibited? hibernate-key-ignore-inhibited?
+         #:lid-switch-ignore-inhibited? lid-switch-ignore-inhibited?
+         #:holdoff-timeout-seconds holdoff-timeout-seconds
+         #:idle-action idle-action
+         #:idle-action-seconds idle-action-seconds
+         #:runtime-directory-size-percent runtime-directory-size-percent
+         #:runtime-directory-size runtime-directory-size
+         #:remove-ipc? remove-ipc?
+
+         #:suspend-state suspend-state
+         #:suspend-mode suspend-mode
+         #:hibernate-state hibernate-state
+         #:hibernate-mode hibernate-mode
+         #:hybrid-sleep-state hybrid-sleep-state
+         #:hybrid-sleep-mode hybrid-sleep-mode)))
+    (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))))
+      (stop #~(make-kill-destructor))))))
+
+
+;;;
 ;;; The default set of desktop services.
 ;;;
 (define %desktop-services
@@ -389,7 +558,8 @@ site} for more information."
          ;; time, so we currently add them to the set of default services.
          (colord-service)
          (geoclue-service)
-         (dbus-service (list avahi wicd upower colord geoclue))
+         (elogind-service)
+         (dbus-service (list avahi wicd upower colord geoclue elogind))
 
          (ntp-service)