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