gnu/services/desktop.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 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 ;;; Copyright © 2017 Maxim Cournoyer <maxim.cournoyer@gmail.com>
   7 ;;; Copyright © 2017 ng0 <ng0@n0.is>
   8 ;;; Copyright © 2018 Efraim Flashner <efraim@flashner.co.il>
   9 ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
  10 ;;; Copyright © 2017, 2019 Christopher Baines <mail@cbaines.net>
  11 ;;; Copyright © 2019 Tim Gesthuizen <tim.gesthuizen@yahoo.de>
  12 ;;;
  13 ;;; This file is part of GNU Guix.
  14 ;;;
  15 ;;; GNU Guix is free software; you can redistribute it and/or modify it
  16 ;;; under the terms of the GNU General Public License as published by
  17 ;;; the Free Software Foundation; either version 3 of the License, or (at
  18 ;;; your option) any later version.
  19 ;;;
  20 ;;; GNU Guix is distributed in the hope that it will be useful, but
  21 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  22 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  23 ;;; GNU General Public License for more details.
  24 ;;;
  25 ;;; You should have received a copy of the GNU General Public License
  26 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  27
  28 (define-module (gnu services desktop)
  29   #:use-module (gnu services)
  30   #:use-module (gnu services shepherd)
  31   #:use-module (gnu services base)
  32   #:use-module (gnu services dbus)
  33   #:use-module (gnu services avahi)
  34   #:use-module (gnu services xorg)
  35   #:use-module (gnu services networking)
  36   #:use-module (gnu services sound)
  37   #:use-module ((gnu system file-systems)
  38                 #:select (%elogind-file-systems))
  39   #:use-module (gnu system)
  40   #:use-module (gnu system shadow)
  41   #:use-module (gnu system pam)
  42   #:use-module (gnu packages glib)
  43   #:use-module (gnu packages admin)
  44   #:use-module (gnu packages cups)
  45   #:use-module (gnu packages freedesktop)
  46   #:use-module (gnu packages gnome)
  47   #:use-module (gnu packages xfce)
  48   #:use-module (gnu packages avahi)
  49   #:use-module (gnu packages xdisorg)
  50   #:use-module (gnu packages suckless)
  51   #:use-module (gnu packages linux)
  52   #:use-module (gnu packages libusb)
  53   #:use-module (gnu packages mate)
  54   #:use-module (gnu packages enlightenment)
  55   #:use-module (guix deprecation)
  56   #:use-module (guix records)
  57   #:use-module (guix packages)
  58   #:use-module (guix store)
  59   #:use-module (guix utils)
  60   #:use-module (guix gexp)
  61   #:use-module (srfi srfi-1)
  62   #:use-module (ice-9 match)
  63   #:export (<upower-configuration>
  64             upower-configuration
  65             upower-configuration?
  66             upower-configuration-upower
  67             upower-configuration-watts-up-pro?
  68             upower-configuration-poll-batteries?
  69             upower-configuration-ignore-lid?
  70             upower-configuration-use-percentage-for-policy?
  71             upower-configuration-percentage-low
  72             upower-configuration-percentage-critical
  73             upower-configuration-percentage-action
  74             upower-configuration-time-low
  75             upower-configuration-time-critical
  76             upower-configuration-time-action
  77             upower-configuration-critical-power-action
  78
  79             upower-service
  80             upower-service-type
  81
  82             udisks-configuration
  83             udisks-configuration?
  84             udisks-service
  85             udisks-service-type
  86
  87             colord-service-type
  88             colord-service
  89
  90             geoclue-application
  91             geoclue-configuration
  92             geoclue-configuration?
  93             %standard-geoclue-applications
  94             geoclue-service
  95             geoclue-service-type
  96
  97             bluetooth-service-type
  98             bluetooth-configuration
  99             bluetooth-configuration?
 100             bluetooth-service
 101
 102             elogind-configuration
 103             elogind-configuration?
 104             elogind-service
 105             elogind-service-type
 106
 107             accountsservice-service-type
 108             accountsservice-service
 109
 110             cups-pk-helper-service-type
 111
 112             gnome-desktop-configuration
 113             gnome-desktop-configuration?
 114             gnome-desktop-service
 115             gnome-desktop-service-type
 116
 117             mate-desktop-configuration
 118             mate-desktop-configuration?
 119             mate-desktop-service
 120             mate-desktop-service-type
 121
 122             xfce-desktop-configuration
 123             xfce-desktop-configuration?
 124             xfce-desktop-service
 125             xfce-desktop-service-type
 126
 127             x11-socket-directory-service
 128
 129             enlightenment-desktop-configuration
 130             enlightenment-desktop-configuration?
 131             enlightenment-desktop-service-type
 132
 133             inputattach-configuration
 134             inputattach-configuration?
 135             inputattach-service-type
 136
 137             %desktop-services))
 138
 139 ;;; Commentary:
 140 ;;;
 141 ;;; This module contains service definitions for a "desktop" environment.
 142 ;;;
 143 ;;; Code:
 144
 145 \f
 146 ;;;
 147 ;;; Helpers.
 148 ;;;
 149
 150 (define (bool value)
 151   (if value "true\n" "false\n"))
 152
 153 (define (package-direct-input-selector input)
 154   (lambda (package)
 155     (match (assoc-ref (package-direct-inputs package) input)
 156       ((package . _) package))))
 157
 158
 159 \f
 160 ;;;
 161 ;;; Upower D-Bus service.
 162 ;;;
 163
 164 (define-record-type* <upower-configuration>
 165   upower-configuration make-upower-configuration
 166   upower-configuration?
 167   (upower                     upower-configuration-upower
 168                               (default upower))
 169   (watts-up-pro?              upower-configuration-watts-up-pro?
 170                               (default #f))
 171   (poll-batteries?            upower-configuration-poll-batteries?
 172                               (default #t))
 173   (ignore-lid?                upower-configuration-ignore-lid?
 174                               (default #f))
 175   (use-percentage-for-policy? upower-configuration-use-percentage-for-policy?
 176                               (default #f))
 177   (percentage-low             upower-configuration-percentage-low
 178                               (default 10))
 179   (percentage-critical        upower-configuration-percentage-critical
 180                               (default 3))
 181   (percentage-action          upower-configuration-percentage-action
 182                               (default 2))
 183   (time-low                   upower-configuration-time-low
 184                               (default 1200))
 185   (time-critical              upower-configuration-time-critical
 186                               (default 300))
 187   (time-action                upower-configuration-time-action
 188                               (default 120))
 189   (critical-power-action      upower-configuration-critical-power-action
 190                               (default 'hybrid-sleep)))
 191
 192 (define* upower-configuration-file
 193   ;; Return an upower-daemon configuration file.
 194   (match-lambda
 195     (($ <upower-configuration> upower
 196         watts-up-pro? poll-batteries? ignore-lid? use-percentage-for-policy?
 197         percentage-low percentage-critical percentage-action time-low
 198         time-critical time-action critical-power-action)
 199      (plain-file "UPower.conf"
 200                  (string-append
 201                   "[UPower]\n"
 202                   "EnableWattsUpPro=" (bool watts-up-pro?)
 203                   "NoPollBatteries=" (bool (not poll-batteries?))
 204                   "IgnoreLid=" (bool ignore-lid?)
 205                   "UsePercentageForPolicy=" (bool use-percentage-for-policy?)
 206                   "PercentageLow=" (number->string percentage-low) "\n"
 207                   "PercentageCritical=" (number->string percentage-critical) "\n"
 208                   "PercentageAction=" (number->string percentage-action) "\n"
 209                   "TimeLow=" (number->string time-low) "\n"
 210                   "TimeCritical=" (number->string time-critical) "\n"
 211                   "TimeAction=" (number->string time-action) "\n"
 212                   "CriticalPowerAction=" (match critical-power-action
 213                                            ('hybrid-sleep "HybridSleep")
 214                                            ('hibernate "Hibernate")
 215                                            ('power-off "PowerOff"))
 216                   "\n")))))
 217
 218 (define %upower-activation
 219   #~(begin
 220       (use-modules (guix build utils))
 221       (mkdir-p "/var/lib/upower")))
 222
 223 (define (upower-dbus-service config)
 224   (list (wrapped-dbus-service (upower-configuration-upower config)
 225                               "libexec/upowerd"
 226                               `(("UPOWER_CONF_FILE_NAME"
 227                                  ,(upower-configuration-file config))))))
 228
 229 (define (upower-shepherd-service config)
 230   "Return a shepherd service for UPower with CONFIG."
 231   (let ((upower (upower-configuration-upower config))
 232         (config (upower-configuration-file config)))
 233     (list (shepherd-service
 234            (documentation "Run the UPower power and battery monitor.")
 235            (provision '(upower-daemon))
 236            (requirement '(dbus-system udev))
 237
 238            (start #~(make-forkexec-constructor
 239                      (list (string-append #$upower "/libexec/upowerd"))
 240                      #:environment-variables
 241                      (list (string-append "UPOWER_CONF_FILE_NAME="
 242                                           #$config))))
 243            (stop #~(make-kill-destructor))))))
 244
 245 (define upower-service-type
 246   (let ((upower-package (compose list upower-configuration-upower)))
 247     (service-type (name 'upower)
 248                   (description
 249                    "Run @command{upowerd}}, a system-wide monitor for power
 250 consumption and battery levels, with the given configuration settings.  It
 251 implements the @code{org.freedesktop.UPower} D-Bus interface, and is notably
 252 used by GNOME.")
 253                   (extensions
 254                    (list (service-extension dbus-root-service-type
 255                                             upower-dbus-service)
 256                          (service-extension shepherd-root-service-type
 257                                             upower-shepherd-service)
 258                          (service-extension activation-service-type
 259                                             (const %upower-activation))
 260                          (service-extension udev-service-type
 261                                             upower-package)
 262
 263                          ;; Make the 'upower' command visible.
 264                          (service-extension profile-service-type
 265                                             upower-package)))
 266                   (default-value (upower-configuration)))))
 267
 268 (define-deprecated (upower-service #:key (upower upower)
 269                                    (watts-up-pro? #f)
 270                                    (poll-batteries? #t)
 271                                    (ignore-lid? #f)
 272                                    (use-percentage-for-policy? #f)
 273                                    (percentage-low 10)
 274                                    (percentage-critical 3)
 275                                    (percentage-action 2)
 276                                    (time-low 1200)
 277                                    (time-critical 300)
 278                                    (time-action 120)
 279                                    (critical-power-action 'hybrid-sleep))
 280   upower-service-type
 281   "Return a service that runs @uref{http://upower.freedesktop.org/,
 282 @command{upowerd}}, a system-wide monitor for power consumption and battery
 283 levels, with the given configuration settings.  It implements the
 284 @code{org.freedesktop.UPower} D-Bus interface, and is notably used by GNOME."
 285   (let ((config (upower-configuration
 286                  (watts-up-pro? watts-up-pro?)
 287                  (poll-batteries? poll-batteries?)
 288                  (ignore-lid? ignore-lid?)
 289                  (use-percentage-for-policy? use-percentage-for-policy?)
 290                  (percentage-low percentage-low)
 291                  (percentage-critical percentage-critical)
 292                  (percentage-action percentage-action)
 293                  (time-low time-low)
 294                  (time-critical time-critical)
 295                  (time-action time-action)
 296                  (critical-power-action critical-power-action))))
 297     (service upower-service-type config)))
 298
 299 \f
 300 ;;;
 301 ;;; GeoClue D-Bus service.
 302 ;;;
 303
 304 ;; TODO: Export.
 305 (define-record-type* <geoclue-configuration>
 306   geoclue-configuration make-geoclue-configuration
 307   geoclue-configuration?
 308   (geoclue geoclue-configuration-geoclue
 309            (default geoclue))
 310   (whitelist geoclue-configuration-whitelist)
 311   (wifi-geolocation-url geoclue-configuration-wifi-geolocation-url)
 312   (submit-data? geoclue-configuration-submit-data?)
 313   (wifi-submission-url geoclue-configuration-wifi-submission-url)
 314   (submission-nick geoclue-configuration-submission-nick)
 315   (applications geoclue-configuration-applications))
 316
 317 (define* (geoclue-application name #:key (allowed? #t) system? (users '()))
 318   "Configure default GeoClue access permissions for an application.  NAME is
 319 the Desktop ID of the application, without the .desktop part.  If ALLOWED? is
 320 true, the application will have access to location information by default.
 321 The boolean SYSTEM? value indicates that an application is a system component
 322 or not.  Finally USERS is a list of UIDs of all users for which this
 323 application is allowed location info access.  An empty users list means all
 324 users are allowed."
 325   (string-append
 326    "[" name "]\n"
 327    "allowed=" (bool allowed?)
 328    "system=" (bool system?)
 329    "users=" (string-join users ";") "\n"))
 330
 331 (define %standard-geoclue-applications
 332   (list (geoclue-application "gnome-datetime-panel" #:system? #t)
 333         (geoclue-application "epiphany" #:system? #f)
 334         (geoclue-application "firefox" #:system? #f)))
 335
 336 (define* (geoclue-configuration-file config)
 337   "Return a geoclue configuration file."
 338   (plain-file "geoclue.conf"
 339               (string-append
 340                "[agent]\n"
 341                "whitelist="
 342                (string-join (geoclue-configuration-whitelist config)
 343                             ";") "\n"
 344                "[wifi]\n"
 345                "url=" (geoclue-configuration-wifi-geolocation-url config) "\n"
 346                "submit-data=" (bool (geoclue-configuration-submit-data? config))
 347                "submission-url="
 348                (geoclue-configuration-wifi-submission-url config) "\n"
 349                "submission-nick="
 350                (geoclue-configuration-submission-nick config)
 351                "\n"
 352                (string-join (geoclue-configuration-applications config)
 353                             "\n"))))
 354
 355 (define (geoclue-dbus-service config)
 356   (list (wrapped-dbus-service (geoclue-configuration-geoclue config)
 357                               "libexec/geoclue"
 358                               `(("GEOCLUE_CONFIG_FILE"
 359                                  ,(geoclue-configuration-file config))))))
 360
 361 (define %geoclue-accounts
 362   (list (user-group (name "geoclue") (system? #t))
 363         (user-account
 364          (name "geoclue")
 365          (group "geoclue")
 366          (system? #t)
 367          (comment "GeoClue daemon user")
 368          (home-directory "/var/empty")
 369          (shell "/run/current-system/profile/sbin/nologin"))))
 370
 371 (define geoclue-service-type
 372   (service-type (name 'geoclue)
 373                 (extensions
 374                  (list (service-extension dbus-root-service-type
 375                                           geoclue-dbus-service)
 376                        (service-extension account-service-type
 377                                           (const %geoclue-accounts))))))
 378
 379 (define* (geoclue-service #:key (geoclue geoclue)
 380                           (whitelist '())
 381                           (wifi-geolocation-url
 382                            ;; Mozilla geolocation service:
 383                            "https://location.services.mozilla.com/v1/geolocate?key=geoclue")
 384                           (submit-data? #f)
 385                           (wifi-submission-url
 386                            "https://location.services.mozilla.com/v1/submit?key=geoclue")
 387                           (submission-nick "geoclue")
 388                           (applications %standard-geoclue-applications))
 389   "Return a service that runs the @command{geoclue} location service.  This
 390 service provides a D-Bus interface to allow applications to request access to
 391 a user's physical location, and optionally to add information to online
 392 location databases.  By default, only the GNOME date-time panel and the Icecat
 393 and Epiphany web browsers are able to ask for the user's location, and in the
 394 case of Icecat and Epiphany, both will ask the user for permission first.  See
 395 @uref{https://wiki.freedesktop.org/www/Software/GeoClue/, the geoclue web
 396 site} for more information."
 397   (service geoclue-service-type
 398            (geoclue-configuration
 399             (geoclue geoclue)
 400             (whitelist whitelist)
 401             (wifi-geolocation-url wifi-geolocation-url)
 402             (submit-data? submit-data?)
 403             (wifi-submission-url wifi-submission-url)
 404             (submission-nick submission-nick)
 405             (applications applications))))
 406
 407 \f
 408 ;;;
 409 ;;; Bluetooth.
 410 ;;;
 411
 412 (define-record-type* <bluetooth-configuration>
 413   bluetooth-configuration make-bluetooth-configuration
 414   bluetooth-configuration?
 415   (bluez bluetooth-configuration-bluez (default bluez))
 416   (auto-enable? bluetooth-configuration-auto-enable? (default #f)))
 417
 418 (define (bluetooth-configuration-file config)
 419   "Return a configuration file for the systemd bluetooth service, as a string."
 420   (string-append
 421    "[Policy]\n"
 422    "AutoEnable=" (bool (bluetooth-configuration-auto-enable?
 423                         config))))
 424
 425 (define (bluetooth-directory config)
 426   (computed-file "etc-bluetooth"
 427                  #~(begin
 428                      (mkdir #$output)
 429                      (chdir #$output)
 430                      (call-with-output-file "main.conf"
 431                        (lambda (port)
 432                          (display #$(bluetooth-configuration-file config)
 433                                   port))))))
 434
 435 (define (bluetooth-shepherd-service config)
 436   "Return a shepherd service for @command{bluetoothd}."
 437   (shepherd-service
 438    (provision '(bluetooth))
 439    (requirement '(dbus-system udev))
 440    (documentation "Run the bluetoothd daemon.")
 441    (start #~(make-forkexec-constructor
 442              (string-append #$(bluetooth-configuration-bluez config)
 443                             "/libexec/bluetooth/bluetoothd")))
 444    (stop #~(make-kill-destructor))))
 445
 446 (define bluetooth-service-type
 447   (service-type
 448    (name 'bluetooth)
 449    (extensions
 450     (list (service-extension dbus-root-service-type
 451                              (compose list bluetooth-configuration-bluez))
 452           (service-extension udev-service-type
 453                              (compose list bluetooth-configuration-bluez))
 454           (service-extension etc-service-type
 455                              (lambda (config)
 456                                `(("bluetooth"
 457                                   ,(bluetooth-directory config)))))
 458           (service-extension shepherd-root-service-type
 459                              (compose list bluetooth-shepherd-service))))
 460    (description "Run the @command{bluetoothd} daemon, which manages all the
 461 Bluetooth devices and provides a number of D-Bus interfaces.")))
 462
 463 (define* (bluetooth-service #:key (bluez bluez) (auto-enable? #f))
 464   "Return a service that runs the @command{bluetoothd} daemon, which manages
 465 all the Bluetooth devices and provides a number of D-Bus interfaces.  When
 466 AUTO-ENABLE? is true, the bluetooth controller is powered automatically at
 467 boot.
 468
 469 Users need to be in the @code{lp} group to access the D-Bus service.
 470 "
 471   (service bluetooth-service-type
 472            (bluetooth-configuration
 473             (bluez bluez)
 474             (auto-enable? auto-enable?))))
 475
 476 \f
 477 ;;;
 478 ;;; Colord D-Bus service.
 479 ;;;
 480
 481 (define %colord-activation
 482   #~(begin
 483       (use-modules (guix build utils))
 484       (mkdir-p "/var/lib/colord")
 485       (let ((user (getpwnam "colord")))
 486         (chown "/var/lib/colord"
 487                (passwd:uid user) (passwd:gid user)))))
 488
 489 (define %colord-accounts
 490   (list (user-group (name "colord") (system? #t))
 491         (user-account
 492          (name "colord")
 493          (group "colord")
 494          (system? #t)
 495          (comment "colord daemon user")
 496          (home-directory "/var/empty")
 497          (shell (file-append shadow "/sbin/nologin")))))
 498
 499 (define colord-service-type
 500   (service-type (name 'colord)
 501                 (extensions
 502                  (list (service-extension account-service-type
 503                                           (const %colord-accounts))
 504                        (service-extension activation-service-type
 505                                           (const %colord-activation))
 506
 507                        ;; Colord is a D-Bus service that dbus-daemon can
 508                        ;; activate.
 509                        (service-extension dbus-root-service-type list)
 510
 511                        ;; Colord provides "color device" rules for udev.
 512                        (service-extension udev-service-type list)
 513
 514                        ;; It provides polkit "actions".
 515                        (service-extension polkit-service-type list)))
 516                 (description
 517                  "Run @command{colord}, a system service with a D-Bus
 518 interface to manage the color profiles of input and output devices such as
 519 screens and scanners.")))
 520
 521 (define* (colord-service #:key (colord colord))
 522   "Return a service that runs @command{colord}, a system service with a D-Bus
 523 interface to manage the color profiles of input and output devices such as
 524 screens and scanners.  It is notably used by the GNOME Color Manager graphical
 525 tool.  See @uref{http://www.freedesktop.org/software/colord/, the colord web
 526 site} for more information."
 527   (service colord-service-type colord))
 528
 529 \f
 530 ;;;
 531 ;;; UDisks.
 532 ;;;
 533
 534 (define-record-type* <udisks-configuration>
 535   udisks-configuration make-udisks-configuration
 536   udisks-configuration?
 537   (udisks   udisks-configuration-udisks
 538             (default udisks)))
 539
 540 (define %udisks-activation
 541   (with-imported-modules '((guix build utils))
 542     #~(begin
 543         (use-modules (guix build utils))
 544
 545         (let ((run-dir "/var/run/udisks2"))
 546           (mkdir-p run-dir)
 547           (chmod run-dir #o700)))))
 548
 549 (define udisks-service-type
 550   (let ((udisks-package (lambda (config)
 551                           (list (udisks-configuration-udisks config)))))
 552     (service-type (name 'udisks)
 553                   (extensions
 554                    (list (service-extension polkit-service-type
 555                                             udisks-package)
 556                          (service-extension dbus-root-service-type
 557                                             udisks-package)
 558                          (service-extension udev-service-type
 559                                             udisks-package)
 560                          (service-extension activation-service-type
 561                                             (const %udisks-activation))
 562
 563                          ;; Profile 'udisksctl' & co. in the system profile.
 564                          (service-extension profile-service-type
 565                                             udisks-package))))))
 566
 567 (define* (udisks-service #:key (udisks udisks))
 568   "Return a service for @uref{http://udisks.freedesktop.org/docs/latest/,
 569 UDisks}, a @dfn{disk management} daemon that provides user interfaces with
 570 notifications and ways to mount/unmount disks.  Programs that talk to UDisks
 571 include the @command{udisksctl} command, part of UDisks, and GNOME Disks."
 572   (service udisks-service-type
 573            (udisks-configuration (udisks udisks))))
 574
 575 \f
 576 ;;;
 577 ;;; Elogind login and seat management service.
 578 ;;;
 579
 580 (define-record-type* <elogind-configuration> elogind-configuration
 581   make-elogind-configuration
 582   elogind-configuration
 583   (elogind                         elogind-package
 584                                    (default elogind))
 585   (kill-user-processes?            elogind-kill-user-processes?
 586                                    (default #f))
 587   (kill-only-users                 elogind-kill-only-users
 588                                    (default '()))
 589   (kill-exclude-users              elogind-kill-exclude-users
 590                                    (default '("root")))
 591   (inhibit-delay-max-seconds       elogind-inhibit-delay-max-seconds
 592                                    (default 5))
 593   (handle-power-key                elogind-handle-power-key
 594                                    (default 'poweroff))
 595   (handle-suspend-key              elogind-handle-suspend-key
 596                                    (default 'suspend))
 597   (handle-hibernate-key            elogind-handle-hibernate-key
 598                                    ;; (default 'hibernate)
 599                                    ;; XXX Ignore it for now, since we don't
 600                                    ;; yet handle resume-from-hibernation in
 601                                    ;; our initrd.
 602                                    (default 'ignore))
 603   (handle-lid-switch               elogind-handle-lid-switch
 604                                    (default 'suspend))
 605   (handle-lid-switch-docked        elogind-handle-lid-switch-docked
 606                                    (default 'ignore))
 607   (power-key-ignore-inhibited?     elogind-power-key-ignore-inhibited?
 608                                    (default #f))
 609   (suspend-key-ignore-inhibited?   elogind-suspend-key-ignore-inhibited?
 610                                    (default #f))
 611   (hibernate-key-ignore-inhibited? elogind-hibernate-key-ignore-inhibited?
 612                                    (default #f))
 613   (lid-switch-ignore-inhibited?    elogind-lid-switch-ignore-inhibited?
 614                                    (default #t))
 615   (holdoff-timeout-seconds         elogind-holdoff-timeout-seconds
 616                                    (default 30))
 617   (idle-action                     elogind-idle-action
 618                                    (default 'ignore))
 619   (idle-action-seconds             elogind-idle-action-seconds
 620                                    (default (* 30 60)))
 621   (runtime-directory-size-percent  elogind-runtime-directory-size-percent
 622                                    (default 10))
 623   (runtime-directory-size          elogind-runtime-directory-size
 624                                    (default #f))
 625   (remove-ipc?                     elogind-remove-ipc?
 626                                    (default #t))
 627
 628   (suspend-state                   elogind-suspend-state
 629                                    (default '("mem" "standby" "freeze")))
 630   (suspend-mode                    elogind-suspend-mode
 631                                    (default '()))
 632   (hibernate-state                 elogind-hibernate-state
 633                                    (default '("disk")))
 634   (hibernate-mode                  elogind-hibernate-mode
 635                                    (default '("platform" "shutdown")))
 636   (hybrid-sleep-state              elogind-hybrid-sleep-state
 637                                    (default '("disk")))
 638   (hybrid-sleep-mode               elogind-hybrid-sleep-mode
 639                                    (default
 640                                      '("suspend" "platform" "shutdown"))))
 641
 642 (define (elogind-configuration-file config)
 643   (define (yesno x)
 644     (match x
 645       (#t "yes")
 646       (#f "no")
 647       (_ (error "expected #t or #f, instead got:" x))))
 648   (define char-set:user-name
 649     (string->char-set "abcdefghijklmnopqrstuvwxyz0123456789_-"))
 650   (define (valid-list? l pred)
 651     (and-map (lambda (x) (string-every pred x)) l))
 652   (define (user-name-list users)
 653     (unless (valid-list? users char-set:user-name)
 654       (error "invalid user list" users))
 655     (string-join users " "))
 656   (define (enum val allowed)
 657     (unless (memq val allowed)
 658       (error "invalid value" val allowed))
 659     (symbol->string val))
 660   (define (non-negative-integer x)
 661     (unless (exact-integer? x) (error "not an integer" x))
 662     (when (negative? x) (error "negative number not allowed" x))
 663     (number->string x))
 664   (define handle-actions
 665     '(ignore poweroff reboot halt kexec suspend hibernate hybrid-sleep lock))
 666   (define (handle-action x)
 667     (enum x handle-actions))
 668   (define (sleep-list tokens)
 669     (unless (valid-list? tokens char-set:user-name)
 670       (error "invalid sleep list" tokens))
 671     (string-join tokens " "))
 672   (define-syntax ini-file-clause
 673     (syntax-rules ()
 674       ((_ config (prop (parser getter)))
 675        (string-append prop "=" (parser (getter config)) "\n"))
 676       ((_ config str)
 677        (string-append str "\n"))))
 678   (define-syntax-rule (ini-file config file clause ...)
 679     (plain-file file (string-append (ini-file-clause config clause) ...)))
 680   (ini-file
 681    config "logind.conf"
 682    "[Login]"
 683    ("KillUserProcesses" (yesno elogind-kill-user-processes?))
 684    ("KillOnlyUsers" (user-name-list elogind-kill-only-users))
 685    ("KillExcludeUsers" (user-name-list elogind-kill-exclude-users))
 686    ("InhibitDelayMaxSec" (non-negative-integer elogind-inhibit-delay-max-seconds))
 687    ("HandlePowerKey" (handle-action elogind-handle-power-key))
 688    ("HandleSuspendKey" (handle-action elogind-handle-suspend-key))
 689    ("HandleHibernateKey" (handle-action elogind-handle-hibernate-key))
 690    ("HandleLidSwitch" (handle-action elogind-handle-lid-switch))
 691    ("HandleLidSwitchDocked" (handle-action elogind-handle-lid-switch-docked))
 692    ("PowerKeyIgnoreInhibited" (yesno elogind-power-key-ignore-inhibited?))
 693    ("SuspendKeyIgnoreInhibited" (yesno elogind-suspend-key-ignore-inhibited?))
 694    ("HibernateKeyIgnoreInhibited" (yesno elogind-hibernate-key-ignore-inhibited?))
 695    ("LidSwitchIgnoreInhibited" (yesno elogind-lid-switch-ignore-inhibited?))
 696    ("HoldoffTimeoutSec" (non-negative-integer elogind-holdoff-timeout-seconds))
 697    ("IdleAction" (handle-action elogind-idle-action))
 698    ("IdleActionSec" (non-negative-integer elogind-idle-action-seconds))
 699    ("RuntimeDirectorySize"
 700     (identity
 701      (lambda (config)
 702        (match (elogind-runtime-directory-size-percent config)
 703          (#f (non-negative-integer (elogind-runtime-directory-size config)))
 704          (percent (string-append (non-negative-integer percent) "%"))))))
 705    ("RemoveIPC" (yesno elogind-remove-ipc?))
 706    "[Sleep]"
 707    ("SuspendState" (sleep-list elogind-suspend-state))
 708    ("SuspendMode" (sleep-list elogind-suspend-mode))
 709    ("HibernateState" (sleep-list elogind-hibernate-state))
 710    ("HibernateMode" (sleep-list elogind-hibernate-mode))
 711    ("HybridSleepState" (sleep-list elogind-hybrid-sleep-state))
 712    ("HybridSleepMode" (sleep-list elogind-hybrid-sleep-mode))))
 713
 714 (define (elogind-dbus-service config)
 715   (list (wrapped-dbus-service (elogind-package config)
 716                               "libexec/elogind/elogind"
 717                               `(("ELOGIND_CONF_FILE"
 718                                  ,(elogind-configuration-file config))))))
 719
 720 (define (pam-extension-procedure config)
 721   "Return an extension for PAM-ROOT-SERVICE-TYPE that ensures that all the PAM
 722 services use 'pam_elogind.so', a module that allows elogind to keep track of
 723 logged-in users (run 'loginctl' to see elogind's world view of users and
 724 seats.)"
 725   (define pam-elogind
 726     (pam-entry
 727      (control "required")
 728      (module (file-append (elogind-package config)
 729                           "/lib/security/pam_elogind.so"))))
 730
 731   (list (lambda (pam)
 732           (pam-service
 733            (inherit pam)
 734            (session (cons pam-elogind (pam-service-session pam)))))))
 735
 736 (define (elogind-shepherd-service config)
 737   "Return a Shepherd service to start elogind according to @var{config}."
 738   (list (shepherd-service
 739          (requirement '(dbus-system))
 740          (provision '(elogind))
 741          (start #~(make-forkexec-constructor
 742                    (list #$(file-append (elogind-package config)
 743                                         "/libexec/elogind/elogind"))
 744                    #:environment-variables
 745                    (list (string-append "ELOGIND_CONF_FILE="
 746                                         #$(elogind-configuration-file
 747                                            config)))))
 748          (stop #~(make-kill-destructor)))))
 749
 750 (define elogind-service-type
 751   (service-type (name 'elogind)
 752                 (extensions
 753                  (list (service-extension dbus-root-service-type
 754                                           elogind-dbus-service)
 755                        (service-extension udev-service-type
 756                                           (compose list elogind-package))
 757                        (service-extension polkit-service-type
 758                                           (compose list elogind-package))
 759
 760                        ;; Start elogind from the Shepherd rather than waiting
 761                        ;; for bus activation.  This ensures that it can handle
 762                        ;; events like lid close, etc.
 763                        (service-extension shepherd-root-service-type
 764                                           elogind-shepherd-service)
 765
 766                        ;; Provide the 'loginctl' command.
 767                        (service-extension profile-service-type
 768                                           (compose list elogind-package))
 769
 770                        ;; Extend PAM with pam_elogind.so.
 771                        (service-extension pam-root-service-type
 772                                           pam-extension-procedure)
 773
 774                        ;; We need /run/user, /run/systemd, etc.
 775                        (service-extension file-system-service-type
 776                                           (const %elogind-file-systems))))
 777                 (default-value (elogind-configuration))))
 778
 779 (define* (elogind-service #:key (config (elogind-configuration)))
 780   "Return a service that runs the @command{elogind} login and seat management
 781 service.  The @command{elogind} service integrates with PAM to allow other
 782 system components to know the set of logged-in users as well as their session
 783 types (graphical, console, remote, etc.).  It can also clean up after users
 784 when they log out."
 785   (service elogind-service-type config))
 786
 787 \f
 788 ;;;
 789 ;;; AccountsService service.
 790 ;;;
 791
 792 (define %accountsservice-activation
 793   #~(begin
 794       (use-modules (guix build utils))
 795       (mkdir-p "/var/lib/AccountsService")))
 796
 797 (define accountsservice-service-type
 798   (service-type (name 'accountsservice)
 799                 (extensions
 800                  (list (service-extension activation-service-type
 801                                           (const %accountsservice-activation))
 802                        (service-extension dbus-root-service-type list)
 803                        (service-extension polkit-service-type list)))))
 804
 805 (define* (accountsservice-service #:key (accountsservice accountsservice))
 806   "Return a service that runs AccountsService, a system service that
 807 can list available accounts, change their passwords, and so on.
 808 AccountsService integrates with PolicyKit to enable unprivileged users to
 809 acquire the capability to modify their system configuration.
 810 @uref{https://www.freedesktop.org/wiki/Software/AccountsService/, the
 811 accountsservice web site} for more information."
 812   (service accountsservice-service-type accountsservice))
 813
 814 \f
 815 ;;;
 816 ;;; cups-pk-helper service.
 817 ;;;
 818
 819 (define cups-pk-helper-service-type
 820   (service-type
 821    (name 'cups-pk-helper)
 822    (description
 823     "PolicyKit helper to configure CUPS with fine-grained privileges.")
 824    (extensions
 825     (list (service-extension dbus-root-service-type list)
 826           (service-extension polkit-service-type list)))
 827    (default-value cups-pk-helper)))
 828
 829 \f
 830 ;;;
 831 ;;; GNOME desktop service.
 832 ;;;
 833
 834 (define-record-type* <gnome-desktop-configuration> gnome-desktop-configuration
 835   make-gnome-desktop-configuration
 836   gnome-desktop-configuration
 837   (gnome-package gnome-package (default gnome)))
 838
 839 (define (gnome-polkit-settings config)
 840   "Return the list of GNOME dependencies that provide polkit actions and
 841 rules."
 842   (let ((gnome (gnome-package config)))
 843     (map (lambda (name)
 844            ((package-direct-input-selector name) gnome))
 845          '("gnome-settings-daemon"
 846            "gnome-control-center"
 847            "gnome-system-monitor"
 848            "gvfs"))))
 849
 850 (define gnome-desktop-service-type
 851   (service-type
 852    (name 'gnome-desktop)
 853    (extensions
 854     (list (service-extension polkit-service-type
 855                              gnome-polkit-settings)
 856           (service-extension profile-service-type
 857                              (compose list
 858                                       gnome-package))))
 859    (default-value (gnome-desktop-configuration))
 860    (description "Run the GNOME desktop environment.")))
 861
 862 (define-deprecated (gnome-desktop-service #:key (config
 863                                                  (gnome-desktop-configuration)))
 864   gnome-desktop-service-type
 865   "Return a service that adds the @code{gnome} package to the system profile,
 866 and extends polkit with the actions from @code{gnome-settings-daemon}."
 867   (service gnome-desktop-service-type config))
 868
 869 ;; MATE Desktop service.
 870 ;; TODO: Add mate-screensaver.
 871
 872 (define-record-type* <mate-desktop-configuration> mate-desktop-configuration
 873   make-mate-desktop-configuration
 874   mate-desktop-configuration
 875   (mate-package mate-package (default mate)))
 876
 877 (define mate-desktop-service-type
 878   (service-type
 879    (name 'mate-desktop)
 880    (extensions
 881     (list (service-extension polkit-service-type
 882                              (compose list
 883                                       (package-direct-input-selector
 884                                        "mate-settings-daemon")
 885                                       mate-package))
 886           (service-extension profile-service-type
 887                              (compose list
 888                                       mate-package))))
 889    (default-value (mate-desktop-configuration))
 890    (description "Run the MATE desktop environment.")))
 891
 892 (define-deprecated (mate-desktop-service #:key
 893                                          (config
 894                                           (mate-desktop-configuration)))
 895   mate-desktop-service-type
 896   "Return a service that adds the @code{mate} package to the system profile,
 897 and extends polkit with the actions from @code{mate-settings-daemon}."
 898   (service mate-desktop-service-type config))
 899
 900 \f
 901 ;;;
 902 ;;; XFCE desktop service.
 903 ;;;
 904
 905 (define-record-type* <xfce-desktop-configuration> xfce-desktop-configuration
 906   make-xfce-desktop-configuration
 907   xfce-desktop-configuration
 908   (xfce xfce-package (default xfce)))
 909
 910 (define xfce-desktop-service-type
 911   (service-type
 912    (name 'xfce-desktop)
 913    (extensions
 914     (list (service-extension polkit-service-type
 915                              (compose list
 916                                       (package-direct-input-selector
 917                                        "thunar")
 918                                       xfce-package))
 919           (service-extension profile-service-type
 920                              (compose list xfce-package))))
 921    (default-value (xfce-desktop-configuration))
 922    (description "Run the Xfce desktop environment.")))
 923
 924 (define-deprecated (xfce-desktop-service #:key (config
 925                                                 (xfce-desktop-configuration)))
 926   xfce-desktop-service-type
 927   "Return a service that adds the @code{xfce} package to the system profile,
 928 and extends polkit with the ability for @code{thunar} to manipulate the file
 929 system as root from within a user session, after the user has authenticated
 930 with the administrator's password."
 931   (service xfce-desktop-service-type config))
 932
 933 \f
 934 ;;;
 935 ;;; X11 socket directory service
 936 ;;;
 937
 938 (define x11-socket-directory-service
 939   ;; Return a service that creates /tmp/.X11-unix.  When using X11, libxcb
 940   ;; takes care of creating that directory.  However, when using XWayland, we
 941   ;; need to create beforehand.  Thus, create it unconditionally here.
 942   (simple-service 'x11-socket-directory
 943                   activation-service-type
 944                   (with-imported-modules '((guix build utils))
 945                     #~(begin
 946                         (use-modules (guix build utils))
 947                         (let ((directory "/tmp/.X11-unix"))
 948                           (mkdir-p directory)
 949                           (chmod directory #o777))))))
 950 \f
 951 ;;;
 952 ;;; Enlightenment desktop service.
 953 ;;;
 954
 955 (define-record-type* <enlightenment-desktop-configuration>
 956   enlightenment-desktop-configuration make-enlightenment-desktop-configuration
 957   enlightenment-desktop-configuration?
 958   ;; <package>
 959   (enlightenment        enlightenment-package
 960                         (default enlightenment)))
 961
 962 (define (enlightenment-setuid-programs enlightenment-desktop-configuration)
 963   (match-record enlightenment-desktop-configuration
 964                 <enlightenment-desktop-configuration>
 965                 (enlightenment)
 966     (list (file-append enlightenment
 967                        "/lib/enlightenment/utils/enlightenment_sys")
 968           (file-append enlightenment
 969                        "/lib/enlightenment/utils/enlightenment_backlight")
 970           ;; TODO: Move this binary to a screen-locker service.
 971           (file-append enlightenment
 972                        "/lib/enlightenment/utils/enlightenment_ckpasswd")
 973           (file-append enlightenment
 974                        (string-append
 975                          "/lib/enlightenment/modules/cpufreq/"
 976                          (match (string-tokenize (%current-system)
 977                                                  (char-set-complement (char-set #\-)))
 978                                 ((arch "linux") (string-append "linux-gnu-" arch))
 979                                 ((arch "gnu")   (string-append "gnu-" arch)))
 980                          "-"
 981                          (version-major+minor (package-version enlightenment))
 982                          "/freqset")))))
 983
 984 (define enlightenment-desktop-service-type
 985   (service-type
 986    (name 'enlightenment-desktop)
 987    (extensions
 988     (list (service-extension dbus-root-service-type
 989                              (compose list
 990                                       (package-direct-input-selector
 991                                        "efl")
 992                                       enlightenment-package))
 993           (service-extension setuid-program-service-type
 994                              enlightenment-setuid-programs)
 995           (service-extension profile-service-type
 996                              (compose list
 997                                       enlightenment-package))))
 998    (default-value (enlightenment-desktop-configuration))
 999    (description
1000     "Return a service that adds the @code{enlightenment} package to the system
1001 profile, and extends dbus with the ability for @code{efl} to generate
1002 thumbnails and makes setuid the programs which enlightenment needs to function
1003 as expected.")))
1004
1005 \f
1006 ;;;
1007 ;;; inputattach-service-type
1008 ;;;
1009
1010 (define-record-type* <inputattach-configuration>
1011   inputattach-configuration
1012   make-inputattach-configuration
1013   inputattach-configuration?
1014   (device-type inputattach-configuration-device-type
1015                (default "wacom"))
1016   (device inputattach-configuration-device
1017           (default "/dev/ttyS0"))
1018   (log-file inputattach-configuration-log-file
1019             (default #f)))
1020
1021 (define inputattach-shepherd-service
1022   (match-lambda
1023     (($ <inputattach-configuration> type device log-file)
1024      (list (shepherd-service
1025             (provision '(inputattach))
1026             (requirement '(udev))
1027             (documentation "inputattach daemon")
1028             (start #~(make-forkexec-constructor
1029                       (list (string-append #$inputattach
1030                                            "/bin/inputattach")
1031                             (string-append "--" #$type)
1032                             #$device)
1033                       #:log-file #$log-file))
1034             (stop #~(make-kill-destructor)))))))
1035
1036 (define inputattach-service-type
1037   (service-type
1038    (name 'inputattach)
1039    (extensions
1040     (list (service-extension shepherd-root-service-type
1041                              inputattach-shepherd-service)))
1042    (default-value (inputattach-configuration))
1043    (description "Return a service that runs inputattach on a device and
1044 dispatches events from it.")))
1045
1046 \f
1047 ;;;
1048 ;;; The default set of desktop services.
1049 ;;;
1050
1051 (define %desktop-services
1052   ;; List of services typically useful for a "desktop" use case.
1053   (cons* (service gdm-service-type)
1054
1055          ;; Screen lockers are a pretty useful thing and these are small.
1056          (screen-locker-service slock)
1057          (screen-locker-service xlockmore "xlock")
1058
1059          ;; Add udev rules for MTP devices so that non-root users can access
1060          ;; them.
1061          (simple-service 'mtp udev-service-type (list libmtp))
1062
1063          ;; NetworkManager and its applet.
1064          (service network-manager-service-type)
1065          (service wpa-supplicant-service-type)    ;needed by NetworkManager
1066          (simple-service 'network-manager-applet
1067                          profile-service-type
1068                          (list network-manager-applet))
1069          (service modem-manager-service-type)
1070
1071          ;; The D-Bus clique.
1072          (service avahi-service-type)
1073          (udisks-service)
1074          (service upower-service-type)
1075          (accountsservice-service)
1076          (service cups-pk-helper-service-type)
1077          (colord-service)
1078          (geoclue-service)
1079          (service polkit-service-type)
1080          (elogind-service)
1081          (dbus-service)
1082
1083          (service ntp-service-type)
1084
1085          x11-socket-directory-service
1086
1087          (service alsa-service-type)
1088
1089          %base-services))
1090
1091 ;;; desktop.scm ends here