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