gnu/services/desktop.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
   3 ;;; Copyright © 2015 Andy Wingo <wingo@igalia.com>
   4 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
   5 ;;;
   6 ;;; This file is part of GNU Guix.
   7 ;;;
   8 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   9 ;;; under the terms of the GNU General Public License as published by
  10 ;;; the Free Software Foundation; either version 3 of the License, or (at
  11 ;;; your option) any later version.
  12 ;;;
  13 ;;; GNU Guix is distributed in the hope that it will be useful, but
  14 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;;; GNU General Public License for more details.
  17 ;;;
  18 ;;; You should have received a copy of the GNU General Public License
  19 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  20
  21 (define-module (gnu services desktop)
  22   #:use-module (gnu services)
  23   #:use-module (gnu services dmd)
  24   #:use-module (gnu services base)
  25   #:use-module (gnu services dbus)
  26   #:use-module (gnu services avahi)
  27   #:use-module (gnu services xorg)
  28   #:use-module (gnu services networking)
  29   #:use-module (gnu system shadow)
  30   #:use-module (gnu system linux) ; unix-pam-service
  31   #:use-module (gnu packages glib)
  32   #:use-module (gnu packages admin)
  33   #:use-module (gnu packages freedesktop)
  34   #:use-module (gnu packages gnome)
  35   #:use-module (gnu packages avahi)
  36   #:use-module (gnu packages polkit)
  37   #:use-module (guix records)
  38   #:use-module (guix packages)
  39   #:use-module (guix store)
  40   #:use-module (guix gexp)
  41   #:use-module (srfi srfi-1)
  42   #:use-module (ice-9 match)
  43   #:export (upower-service
  44             colord-service
  45             geoclue-application
  46             %standard-geoclue-applications
  47             geoclue-service
  48             polkit-service
  49             elogind-configuration
  50             elogind-service
  51             %desktop-services))
  52
  53 ;;; Commentary:
  54 ;;;
  55 ;;; This module contains service definitions for a "desktop" environment.
  56 ;;;
  57 ;;; Code:
  58
  59 \f
  60 ;;;
  61 ;;; Helpers.
  62 ;;;
  63
  64 (define (bool value)
  65   (if value "true\n" "false\n"))
  66
  67
  68 (define (wrapped-dbus-service service program variable value)
  69   "Return a wrapper for @var{service}, a package containing a D-Bus service,
  70 where @var{program} is wrapped such that environment variable @var{variable}
  71 is set to @var{value} when the bus daemon launches it."
  72   (define wrapper
  73     (program-file (string-append (package-name service) "-program-wrapper")
  74                   #~(begin
  75                       (setenv #$variable #$value)
  76                       (apply execl (string-append #$service "/" #$program)
  77                              (string-append #$service "/" #$program)
  78                              (cdr (command-line))))))
  79
  80   (computed-file (string-append (package-name service) "-wrapper")
  81                  #~(begin
  82                      (use-modules (guix build utils))
  83
  84                      (define service-directory
  85                        "/share/dbus-1/system-services")
  86
  87                      (mkdir-p (dirname (string-append #$output
  88                                                       service-directory)))
  89                      (copy-recursively (string-append #$service
  90                                                       service-directory)
  91                                        (string-append #$output
  92                                                       service-directory))
  93                      (symlink (string-append #$service "/etc") ;for etc/dbus-1
  94                               (string-append #$output "/etc"))
  95
  96                      (for-each (lambda (file)
  97                                  (substitute* file
  98                                    (("Exec[[:blank:]]*=[[:blank:]]*([[:graph:]]+)(.*)$"
  99                                      _ original-program arguments)
 100                                     (string-append "Exec=" #$wrapper arguments
 101                                                    "\n"))))
 102                                (find-files #$output "\\.service$")))
 103                  #:modules '((guix build utils))))
 104
 105 \f
 106 ;;;
 107 ;;; Upower D-Bus service.
 108 ;;;
 109
 110 ;; TODO: Export.
 111 (define-record-type* <upower-configuration>
 112   upower-configuration make-upower-configuration
 113   upower-configuration?
 114   (upower        upower-configuration-upower
 115                  (default upower))
 116   (watts-up-pro? upower-configuration-watts-up-pro?)
 117   (poll-batteries? upower-configuration-poll-batteries?)
 118   (ignore-lid? upower-configuration-ignore-lid?)
 119   (use-percentage-for-policy? upower-configuration-use-percentage-for-policy?)
 120   (percentage-low upower-configuration-percentage-low)
 121   (percentage-critical upower-configuration-percentage-critical)
 122   (percentage-action upower-configuration-percentage-action)
 123   (time-low upower-configuration-time-low)
 124   (time-critical upower-configuration-time-critical)
 125   (time-action upower-configuration-time-action)
 126   (critical-power-action upower-configuration-critical-power-action))
 127
 128 (define* upower-configuration-file
 129   ;; Return an upower-daemon configuration file.
 130   (match-lambda
 131     (($ <upower-configuration> upower
 132         watts-up-pro? poll-batteries? ignore-lid? use-percentage-for-policy?
 133         percentage-low percentage-critical percentage-action time-low
 134         time-critical time-action critical-power-action)
 135      (plain-file "UPower.conf"
 136                  (string-append
 137                   "[UPower]\n"
 138                   "EnableWattsUpPro=" (bool watts-up-pro?)
 139                   "NoPollBatteries=" (bool (not poll-batteries?))
 140                   "IgnoreLid=" (bool ignore-lid?)
 141                   "UsePercentageForPolicy=" (bool use-percentage-for-policy?)
 142                   "PercentageLow=" (number->string percentage-low) "\n"
 143                   "PercentageCritical=" (number->string percentage-critical) "\n"
 144                   "PercentageAction=" (number->string percentage-action) "\n"
 145                   "TimeLow=" (number->string time-low) "\n"
 146                   "TimeCritical=" (number->string time-critical) "\n"
 147                   "TimeAction=" (number->string time-action) "\n"
 148                   "CriticalPowerAction=" (match critical-power-action
 149                                            ('hybrid-sleep "HybridSleep")
 150                                            ('hibernate "Hibernate")
 151                                            ('power-off "PowerOff"))
 152                   "\n")))))
 153
 154 (define %upower-activation
 155   #~(begin
 156       (use-modules (guix build utils))
 157       (mkdir-p "/var/lib/upower")))
 158
 159 (define (upower-dbus-service config)
 160   (list (wrapped-dbus-service (upower-configuration-upower config)
 161                               "libexec/upowerd"
 162                               "UPOWER_CONF_FILE_NAME"
 163                               (upower-configuration-file config))))
 164
 165 (define (upower-dmd-service config)
 166   "Return a dmd service for UPower with CONFIG."
 167   (let ((upower (upower-configuration-upower config))
 168         (config (upower-configuration-file config)))
 169     (list (dmd-service
 170            (documentation "Run the UPower power and battery monitor.")
 171            (provision '(upower-daemon))
 172            (requirement '(dbus-system udev))
 173
 174            (start #~(make-forkexec-constructor
 175                      (list (string-append #$upower "/libexec/upowerd"))
 176                      #:environment-variables
 177                      (list (string-append "UPOWER_CONF_FILE_NAME="
 178                                           #$config))))
 179            (stop #~(make-kill-destructor))))))
 180
 181 (define upower-service-type
 182   (service-type (name 'upower)
 183                 (extensions
 184                  (list (service-extension dbus-root-service-type
 185                                           upower-dbus-service)
 186                        (service-extension dmd-root-service-type
 187                                           upower-dmd-service)
 188                        (service-extension activation-service-type
 189                                           (const %upower-activation))
 190                        (service-extension udev-service-type
 191                                           (compose
 192                                            list
 193                                            upower-configuration-upower))))))
 194
 195 (define* (upower-service #:key (upower upower)
 196                          (watts-up-pro? #f)
 197                          (poll-batteries? #t)
 198                          (ignore-lid? #f)
 199                          (use-percentage-for-policy? #f)
 200                          (percentage-low 10)
 201                          (percentage-critical 3)
 202                          (percentage-action 2)
 203                          (time-low 1200)
 204                          (time-critical 300)
 205                          (time-action 120)
 206                          (critical-power-action 'hybrid-sleep))
 207   "Return a service that runs @uref{http://upower.freedesktop.org/,
 208 @command{upowerd}}, a system-wide monitor for power consumption and battery
 209 levels, with the given configuration settings.  It implements the
 210 @code{org.freedesktop.UPower} D-Bus interface, and is notably used by GNOME."
 211   (let ((config (upower-configuration
 212                  (watts-up-pro? watts-up-pro?)
 213                  (poll-batteries? poll-batteries?)
 214                  (ignore-lid? ignore-lid?)
 215                  (use-percentage-for-policy? use-percentage-for-policy?)
 216                  (percentage-low percentage-low)
 217                  (percentage-critical percentage-critical)
 218                  (percentage-action percentage-action)
 219                  (time-low time-low)
 220                  (time-critical time-critical)
 221                  (time-action time-action)
 222                  (critical-power-action critical-power-action))))
 223     (service upower-service-type config)))
 224
 225 \f
 226 ;;;
 227 ;;; Colord D-Bus service.
 228 ;;;
 229
 230 (define %colord-activation
 231   #~(begin
 232       (use-modules (guix build utils))
 233       (mkdir-p "/var/lib/colord")
 234       (let ((user (getpwnam "colord")))
 235         (chown "/var/lib/colord"
 236                (passwd:uid user) (passwd:gid user)))))
 237
 238 (define %colord-accounts
 239   (list (user-group (name "colord") (system? #t))
 240         (user-account
 241          (name "colord")
 242          (group "colord")
 243          (system? #t)
 244          (comment "colord daemon user")
 245          (home-directory "/var/empty")
 246          (shell #~(string-append #$shadow "/sbin/nologin")))))
 247
 248 (define (colord-dmd-service colord)
 249   "Return a dmd service for COLORD."
 250   ;; TODO: Remove when D-Bus activation works.
 251   (list (dmd-service
 252          (documentation "Run the colord color management service.")
 253          (provision '(colord-daemon))
 254          (requirement '(dbus-system udev))
 255          (start #~(make-forkexec-constructor
 256                    (list (string-append #$colord "/libexec/colord"))))
 257          (stop #~(make-kill-destructor)))))
 258
 259 (define colord-service-type
 260   (service-type (name 'colord)
 261                 (extensions
 262                  (list (service-extension account-service-type
 263                                           (const %colord-accounts))
 264                        (service-extension activation-service-type
 265                                           (const %colord-activation))
 266                        (service-extension dmd-root-service-type
 267                                           colord-dmd-service)
 268
 269                        ;; Colord is a D-Bus service that dbus-daemon can
 270                        ;; activate.
 271                        (service-extension dbus-root-service-type list)
 272
 273                        ;; Colord provides "color device" rules for udev.
 274                        (service-extension udev-service-type list)))))
 275
 276 (define* (colord-service #:key (colord colord))
 277   "Return a service that runs @command{colord}, a system service with a D-Bus
 278 interface to manage the color profiles of input and output devices such as
 279 screens and scanners.  It is notably used by the GNOME Color Manager graphical
 280 tool.  See @uref{http://www.freedesktop.org/software/colord/, the colord web
 281 site} for more information."
 282   (service colord-service-type colord))
 283
 284 \f
 285 ;;;
 286 ;;; GeoClue D-Bus service.
 287 ;;;
 288
 289 ;; TODO: Export.
 290 (define-record-type* <geoclue-configuration>
 291   geoclue-configuration make-geoclue-configuration
 292   geoclue-configuration?
 293   (geoclue geoclue-configuration-geoclue
 294            (default geoclue))
 295   (whitelist geoclue-configuration-whitelist)
 296   (wifi-geolocation-url geoclue-configuration-wifi-geolocation-url)
 297   (submit-data? geoclue-configuration-submit-data?)
 298   (wifi-submission-url geoclue-configuration-wifi-submission-url)
 299   (submission-nick geoclue-configuration-submission-nick)
 300   (applications geoclue-configuration-applications))
 301
 302 (define* (geoclue-application name #:key (allowed? #t) system? (users '()))
 303   "Configure default GeoClue access permissions for an application.  NAME is
 304 the Desktop ID of the application, without the .desktop part.  If ALLOWED? is
 305 true, the application will have access to location information by default.
 306 The boolean SYSTEM? value indicates that an application is a system component
 307 or not.  Finally USERS is a list of UIDs of all users for which this
 308 application is allowed location info access.  An empty users list means all
 309 users are allowed."
 310   (string-append
 311    "[" name "]\n"
 312    "allowed=" (bool allowed?)
 313    "system=" (bool system?)
 314    "users=" (string-join users ";") "\n"))
 315
 316 (define %standard-geoclue-applications
 317   (list (geoclue-application "gnome-datetime-panel" #:system? #t)
 318         (geoclue-application "epiphany" #:system? #f)
 319         (geoclue-application "firefox" #:system? #f)))
 320
 321 (define* (geoclue-configuration-file config)
 322   "Return a geoclue configuration file."
 323   (plain-file "geoclue.conf"
 324               (string-append
 325                "[agent]\n"
 326                "whitelist="
 327                (string-join (geoclue-configuration-whitelist config)
 328                             ";") "\n"
 329                "[wifi]\n"
 330                "url=" (geoclue-configuration-wifi-geolocation-url config) "\n"
 331                "submit-data=" (bool (geoclue-configuration-submit-data? config))
 332                "submission-url="
 333                (geoclue-configuration-wifi-submission-url config) "\n"
 334                "submission-nick="
 335                (geoclue-configuration-submission-nick config)
 336                "\n"
 337                (string-join (geoclue-configuration-applications config)
 338                             "\n"))))
 339
 340 (define (geoclue-dbus-service config)
 341   (list (wrapped-dbus-service (geoclue-configuration-geoclue config)
 342                               "libexec/geoclue"
 343                               "GEOCLUE_CONFIG_FILE"
 344                               (geoclue-configuration-file config))))
 345
 346 (define (geoclue-dmd-service config)
 347   "Return a GeoClue dmd service for CONFIG."
 348   ;; TODO: Remove when D-Bus activation works.
 349   (let ((geoclue (geoclue-configuration-geoclue config))
 350         (config  (geoclue-configuration-file config)))
 351     (list (dmd-service
 352            (documentation "Run the GeoClue location service.")
 353            (provision '(geoclue-daemon))
 354            (requirement '(dbus-system))
 355
 356            (start #~(make-forkexec-constructor
 357                      (list (string-append #$geoclue "/libexec/geoclue"))
 358                      #:user "geoclue"
 359                      #:environment-variables
 360                      (list (string-append "GEOCLUE_CONFIG_FILE=" #$config))))
 361            (stop #~(make-kill-destructor))))))
 362
 363 (define %geoclue-accounts
 364   (list (user-group (name "geoclue") (system? #t))
 365         (user-account
 366          (name "geoclue")
 367          (group "geoclue")
 368          (system? #t)
 369          (comment "GeoClue daemon user")
 370          (home-directory "/var/empty")
 371          (shell "/run/current-system/profile/sbin/nologin"))))
 372
 373 (define geoclue-service-type
 374   (service-type (name 'geoclue)
 375                 (extensions
 376                  (list (service-extension dbus-root-service-type
 377                                           geoclue-dbus-service)
 378                        (service-extension dmd-root-service-type
 379                                           geoclue-dmd-service)
 380                        (service-extension account-service-type
 381                                           (const %geoclue-accounts))))))
 382
 383 (define* (geoclue-service #:key (geoclue geoclue)
 384                           (whitelist '())
 385                           (wifi-geolocation-url
 386                            ;; Mozilla geolocation service:
 387                            "https://location.services.mozilla.com/v1/geolocate?key=geoclue")
 388                           (submit-data? #f)
 389                           (wifi-submission-url
 390                            "https://location.services.mozilla.com/v1/submit?key=geoclue")
 391                           (submission-nick "geoclue")
 392                           (applications %standard-geoclue-applications))
 393   "Return a service that runs the @command{geoclue} location service.  This
 394 service provides a D-Bus interface to allow applications to request access to
 395 a user's physical location, and optionally to add information to online
 396 location databases.  By default, only the GNOME date-time panel and the Icecat
 397 and Epiphany web browsers are able to ask for the user's location, and in the
 398 case of Icecat and Epiphany, both will ask the user for permission first.  See
 399 @uref{https://wiki.freedesktop.org/www/Software/GeoClue/, the geoclue web
 400 site} for more information."
 401   (service geoclue-service-type
 402            (geoclue-configuration
 403             (geoclue geoclue)
 404             (whitelist whitelist)
 405             (wifi-geolocation-url wifi-geolocation-url)
 406             (submit-data? submit-data?)
 407             (wifi-submission-url wifi-submission-url)
 408             (submission-nick submission-nick)
 409             (applications applications))))
 410
 411 \f
 412 ;;;
 413 ;;; Polkit privilege management service.
 414 ;;;
 415
 416 (define %polkit-accounts
 417   (list (user-group (name "polkitd") (system? #t))
 418         (user-account
 419          (name "polkitd")
 420          (group "polkitd")
 421          (system? #t)
 422          (comment "Polkit daemon user")
 423          (home-directory "/var/empty")
 424          (shell "/run/current-system/profile/sbin/nologin"))))
 425
 426 (define %polkit-pam-services
 427   (list (unix-pam-service "polkitd")))
 428
 429 (define (polkit-dmd-service polkit)
 430   "Return the <dmd-service> for POLKIT."
 431   ;; TODO: Remove when D-Bus activation works.
 432   (list (dmd-service
 433          (documentation "Run the polkit privilege management service.")
 434          (provision '(polkit-daemon))
 435          (requirement '(dbus-system))
 436
 437          (start #~(make-forkexec-constructor
 438                    (list (string-append #$polkit "/lib/polkit-1/polkitd"))))
 439          (stop #~(make-kill-destructor)))))
 440
 441 (define polkit-service-type
 442   ;; TODO: Make it extensible so it can collect policy files from other
 443   ;; services.
 444   (service-type (name 'polkit)
 445                 (extensions
 446                  (list (service-extension account-service-type
 447                                           (const %polkit-accounts))
 448                        (service-extension pam-root-service-type
 449                                           (const %polkit-pam-services))
 450                        (service-extension dbus-root-service-type
 451                                           list)
 452                        (service-extension dmd-root-service-type
 453                                           polkit-dmd-service)))))
 454
 455 (define* (polkit-service #:key (polkit polkit))
 456   "Return a service that runs the @command{polkit} privilege management
 457 service.  By querying the @command{polkit} service, a privileged system
 458 component can know when it should grant additional capabilities to ordinary
 459 users.  For example, an ordinary user can be granted the capability to suspend
 460 the system if the user is logged in locally."
 461   (service polkit-service-type polkit))
 462
 463 \f
 464 ;;;
 465 ;;; Elogind login and seat management service.
 466 ;;;
 467
 468 (define-record-type* <elogind-configuration> elogind-configuration
 469   make-elogind-configuration
 470   elogind-configuration
 471   (elogind                         elogind-package
 472                                    (default elogind))
 473   (kill-user-processes?            elogind-kill-user-processes?
 474                                    (default #f))
 475   (kill-only-users                 elogind-kill-only-users
 476                                    (default '()))
 477   (kill-exclude-users              elogind-kill-exclude-users
 478                                    (default '("root")))
 479   (inhibit-delay-max-seconds       elogind-inhibit-delay-max-seconds
 480                                    (default 5))
 481   (handle-power-key                elogind-handle-power-key
 482                                    (default 'poweroff))
 483   (handle-suspend-key              elogind-handle-suspend-key
 484                                    (default 'suspend))
 485   (handle-hibernate-key            elogind-handle-hibernate-key
 486                                    ;; (default 'hibernate)
 487                                    ;; XXX Ignore it for now, since we don't
 488                                    ;; yet handle resume-from-hibernation in
 489                                    ;; our initrd.
 490                                    (default 'ignore))
 491   (handle-lid-switch               elogind-handle-lid-switch
 492                                    (default 'suspend))
 493   (handle-lid-switch-docked        elogind-handle-lid-switch-docked
 494                                    (default 'ignore))
 495   (power-key-ignore-inhibited?     elogind-power-key-ignore-inhibited?
 496                                    (default #f))
 497   (suspend-key-ignore-inhibited?   elogind-suspend-key-ignore-inhibited?
 498                                    (default #f))
 499   (hibernate-key-ignore-inhibited? elogind-hibernate-key-ignore-inhibited?
 500                                    (default #f))
 501   (lid-switch-ignore-inhibited?    elogind-lid-switch-ignore-inhibited?
 502                                    (default #t))
 503   (holdoff-timeout-seconds         elogind-holdoff-timeout-seconds
 504                                    (default 30))
 505   (idle-action                     elogind-idle-action
 506                                    (default 'ignore))
 507   (idle-action-seconds             elogind-idle-action-seconds
 508                                    (default (* 30 60)))
 509   (runtime-directory-size-percent  elogind-runtime-directory-size-percent
 510                                    (default 10))
 511   (runtime-directory-size          elogind-runtime-directory-size
 512                                    (default #f))
 513   (remove-ipc?                     elogind-remove-ipc?
 514                                    (default #t))
 515
 516   (suspend-state                   elogind-suspend-state
 517                                    (default '("mem" "standby" "freeze")))
 518   (suspend-mode                    elogind-suspend-mode
 519                                    (default '()))
 520   (hibernate-state                 elogind-hibernate-state
 521                                    (default '("disk")))
 522   (hibernate-mode                  elogind-hibernate-mode
 523                                    (default '("platform" "shutdown")))
 524   (hybrid-sleep-state              elogind-hybrid-sleep-state
 525                                    (default '("disk")))
 526   (hybrid-sleep-mode               elogind-hybrid-sleep-mode
 527                                    (default
 528                                      '("suspend" "platform" "shutdown"))))
 529
 530 (define (elogind-configuration-file config)
 531   (define (yesno x)
 532     (match x
 533       (#t "yes")
 534       (#f "no")
 535       (_ (error "expected #t or #f, instead got:" x))))
 536   (define char-set:user-name
 537     (string->char-set "abcdefghijklmnopqrstuvwxyz0123456789_-"))
 538   (define (valid-list? l pred)
 539     (and-map (lambda (x) (string-every pred x)) l))
 540   (define (user-name-list users)
 541     (unless (valid-list? users char-set:user-name)
 542       (error "invalid user list" users))
 543     (string-join users " "))
 544   (define (enum val allowed)
 545     (unless (memq val allowed)
 546       (error "invalid value" val allowed))
 547     (symbol->string val))
 548   (define (non-negative-integer x)
 549     (unless (exact-integer? x) (error "not an integer" x))
 550     (when (negative? x) (error "negative number not allowed" x))
 551     (number->string x))
 552   (define handle-actions
 553     '(ignore poweroff reboot halt kexec suspend hibernate hybrid-sleep lock))
 554   (define (handle-action x)
 555     (enum x handle-actions))
 556   (define (sleep-list tokens)
 557     (unless (valid-list? tokens char-set:user-name)
 558       (error "invalid sleep list" tokens))
 559     (string-join tokens " "))
 560   (define-syntax ini-file-clause
 561     (syntax-rules ()
 562       ((_ config (prop (parser getter)))
 563        (string-append prop "=" (parser (getter config)) "\n"))
 564       ((_ config str)
 565        (string-append str "\n"))))
 566   (define-syntax-rule (ini-file config file clause ...)
 567     (plain-file file (string-append (ini-file-clause config clause) ...)))
 568   (ini-file
 569    config "logind.conf"
 570    "[Login]"
 571    ("KillUserProcesses" (yesno elogind-kill-user-processes?))
 572    ("KillOnlyUsers" (user-name-list elogind-kill-only-users))
 573    ("KillExcludeUsers" (user-name-list elogind-kill-exclude-users))
 574    ("InhibitDelayMaxSecs" (non-negative-integer elogind-inhibit-delay-max-seconds))
 575    ("HandlePowerKey" (handle-action elogind-handle-power-key))
 576    ("HandleSuspendKey" (handle-action elogind-handle-suspend-key))
 577    ("HandleHibernateKey" (handle-action elogind-handle-hibernate-key))
 578    ("HandleLidSwitch" (handle-action elogind-handle-lid-switch))
 579    ("HandleLidSwitchDocked" (handle-action elogind-handle-lid-switch-docked))
 580    ("PowerKeyIgnoreInhibited" (yesno elogind-power-key-ignore-inhibited?))
 581    ("SuspendKeyIgnoreInhibited" (yesno elogind-suspend-key-ignore-inhibited?))
 582    ("HibernateKeyIgnoreInhibited" (yesno elogind-hibernate-key-ignore-inhibited?))
 583    ("LidSwitchIgnoreInhibited" (yesno elogind-lid-switch-ignore-inhibited?))
 584    ("HoldoffTimeoutSecs" (non-negative-integer elogind-holdoff-timeout-seconds))
 585    ("IdleAction" (handle-action elogind-idle-action))
 586    ("IdleActionSeconds" (non-negative-integer elogind-idle-action-seconds))
 587    ("RuntimeDirectorySize"
 588     (identity
 589      (lambda (config)
 590        (match (elogind-runtime-directory-size-percent config)
 591          (#f (non-negative-integer (elogind-runtime-directory-size config)))
 592          (percent (string-append (non-negative-integer percent) "%"))))))
 593    ("RemoveIpc" (yesno elogind-remove-ipc?))
 594    "[Sleep]"
 595    ("SuspendState" (sleep-list elogind-suspend-state))
 596    ("SuspendMode" (sleep-list elogind-suspend-mode))
 597    ("HibernateState" (sleep-list elogind-hibernate-state))
 598    ("HibernateMode" (sleep-list elogind-hibernate-mode))
 599    ("HybridSleepState" (sleep-list elogind-hybrid-sleep-state))
 600    ("HybridSleepMode" (sleep-list elogind-hybrid-sleep-mode))))
 601
 602 (define (elogind-dmd-service config)
 603   "Return a dmd service for elogind, using @var{config}."
 604   (let ((config-file (elogind-configuration-file config))
 605         (elogind     (elogind-package config)))
 606     (list (dmd-service
 607            (documentation "Run the elogind login and seat management service.")
 608            (provision '(elogind))
 609            (requirement '(dbus-system))
 610
 611            (start #~(make-forkexec-constructor
 612                      (list (string-append #$elogind "/libexec/elogind/elogind"))
 613                      #:environment-variables
 614                      (list (string-append "ELOGIND_CONF_FILE=" #$config-file))))
 615            (stop #~(make-kill-destructor))))))
 616
 617 (define elogind-service-type
 618   (service-type (name 'elogind)
 619                 (extensions
 620                  (list (service-extension dmd-root-service-type
 621                                           elogind-dmd-service)
 622                        (service-extension dbus-root-service-type
 623                                           (compose list elogind-package))
 624                        (service-extension udev-service-type
 625                                           (compose list elogind-package))
 626                        ;; TODO: Extend polkit(?) and PAM.
 627                        ))))
 628
 629 (define* (elogind-service #:key (config (elogind-configuration)))
 630   "Return a service that runs the @command{elogind} login and seat management
 631 service.  The @command{elogind} service integrates with PAM to allow other
 632 system components to know the set of logged-in users as well as their session
 633 types (graphical, console, remote, etc.).  It can also clean up after users
 634 when they log out."
 635   (service elogind-service-type config))
 636
 637 \f
 638 ;;;
 639 ;;; The default set of desktop services.
 640 ;;;
 641
 642 (define %desktop-services
 643   ;; List of services typically useful for a "desktop" use case.
 644   (cons* (slim-service)
 645
 646          ;; The D-Bus clique.
 647          (avahi-service)
 648          (wicd-service)
 649          (upower-service)
 650          (colord-service)
 651          (geoclue-service)
 652          (polkit-service)
 653          (elogind-service)
 654          (dbus-service)
 655
 656          (ntp-service)
 657
 658          %base-services))
 659
 660 ;;; desktop.scm ends here