gnu/services/desktop.scm

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