gnu/services/desktop.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2014-2022 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, 2020, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
   7 ;;; Copyright © 2017 Nikita <nikita@n0.is>
   8 ;;; Copyright © 2018, 2020 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 ;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
  14 ;;; Copyright © 2020 Reza Alizadeh Majd <r.majd@pantherx.org>
  15 ;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
  16 ;;; Copyright © 2021, 2022 muradm <mail@muradm.net>
  17 ;;;
  18 ;;; This file is part of GNU Guix.
  19 ;;;
  20 ;;; GNU Guix is free software; you can redistribute it and/or modify it
  21 ;;; under the terms of the GNU General Public License as published by
  22 ;;; the Free Software Foundation; either version 3 of the License, or (at
  23 ;;; your option) any later version.
  24 ;;;
  25 ;;; GNU Guix is distributed in the hope that it will be useful, but
  26 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  27 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  28 ;;; GNU General Public License for more details.
  29 ;;;
  30 ;;; You should have received a copy of the GNU General Public License
  31 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  32
  33 (define-module (gnu services desktop)
  34   #:use-module (gnu services)
  35   #:use-module (gnu services shepherd)
  36   #:use-module (gnu services base)
  37   #:use-module (gnu services dbus)
  38   #:use-module (gnu services avahi)
  39   #:use-module (gnu services xorg)
  40   #:use-module (gnu services networking)
  41   #:use-module (gnu services sound)
  42   #:use-module ((gnu system file-systems)
  43                 #:select (%control-groups
  44                           %elogind-file-systems
  45                           file-system))
  46   #:autoload   (gnu services sddm) (sddm-service-type)
  47   #:use-module (gnu system)
  48   #:use-module (gnu system setuid)
  49   #:use-module (gnu system shadow)
  50   #:use-module (gnu system uuid)
  51   #:use-module (gnu system pam)
  52   #:use-module (gnu packages glib)
  53   #:use-module (gnu packages admin)
  54   #:use-module (gnu packages cups)
  55   #:use-module (gnu packages freedesktop)
  56   #:use-module (gnu packages gnome)
  57   #:use-module (gnu packages xfce)
  58   #:use-module (gnu packages avahi)
  59   #:use-module (gnu packages xdisorg)
  60   #:use-module (gnu packages scanner)
  61   #:use-module (gnu packages suckless)
  62   #:use-module (gnu packages linux)
  63   #:use-module (gnu packages libusb)
  64   #:use-module (gnu packages lxqt)
  65   #:use-module (gnu packages mate)
  66   #:use-module (gnu packages nfs)
  67   #:use-module (gnu packages enlightenment)
  68   #:use-module (guix deprecation)
  69   #:use-module (guix records)
  70   #:use-module (guix packages)
  71   #:use-module (guix store)
  72   #:use-module (guix ui)
  73   #:use-module (guix utils)
  74   #:use-module (guix gexp)
  75   #:use-module (srfi srfi-1)
  76   #:use-module (ice-9 format)
  77   #:use-module (ice-9 match)
  78   #:export (<upower-configuration>
  79             upower-configuration
  80             upower-configuration?
  81             upower-configuration-upower
  82             upower-configuration-watts-up-pro?
  83             upower-configuration-poll-batteries?
  84             upower-configuration-ignore-lid?
  85             upower-configuration-use-percentage-for-policy?
  86             upower-configuration-percentage-low
  87             upower-configuration-percentage-critical
  88             upower-configuration-percentage-action
  89             upower-configuration-time-low
  90             upower-configuration-time-critical
  91             upower-configuration-time-action
  92             upower-configuration-critical-power-action
  93
  94             upower-service-type
  95
  96             udisks-configuration
  97             udisks-configuration?
  98             udisks-service
  99             udisks-service-type
 100
 101             colord-service-type
 102
 103             geoclue-application
 104             geoclue-configuration
 105             geoclue-configuration?
 106             %standard-geoclue-applications
 107             geoclue-service
 108             geoclue-service-type
 109
 110             bluetooth-service-type
 111             bluetooth-configuration
 112             bluetooth-configuration?
 113             bluetooth-service
 114
 115             elogind-configuration
 116             elogind-configuration?
 117             elogind-service
 118             elogind-service-type
 119
 120             %gdm-file-system
 121             gdm-file-system-service
 122
 123             %fontconfig-file-system
 124             fontconfig-file-system-service
 125
 126             accountsservice-service-type
 127             accountsservice-service
 128
 129             cups-pk-helper-service-type
 130             sane-service-type
 131
 132             gnome-desktop-configuration
 133             gnome-desktop-configuration?
 134             gnome-desktop-service
 135             gnome-desktop-service-type
 136
 137             mate-desktop-configuration
 138             mate-desktop-configuration?
 139             mate-desktop-service
 140             mate-desktop-service-type
 141
 142             lxqt-desktop-configuration
 143             lxqt-desktop-configuration?
 144             lxqt-desktop-service-type
 145
 146             xfce-desktop-configuration
 147             xfce-desktop-configuration?
 148             xfce-desktop-service
 149             xfce-desktop-service-type
 150
 151             x11-socket-directory-service
 152
 153             enlightenment-desktop-configuration
 154             enlightenment-desktop-configuration?
 155             enlightenment-desktop-service-type
 156
 157             inputattach-configuration
 158             inputattach-configuration?
 159             inputattach-service-type
 160
 161             polkit-wheel-service
 162
 163             gnome-keyring-configuration
 164             gnome-keyring-configuration?
 165             gnome-keyring-service-type
 166
 167             seatd-configuration
 168             seatd-service-type
 169
 170             %desktop-services))
 171
 172 ;;; Commentary:
 173 ;;;
 174 ;;; This module contains service definitions for a "desktop" environment.
 175 ;;;
 176 ;;; Code:
 177
 178 \f
 179 ;;;
 180 ;;; Helpers.
 181 ;;;
 182
 183 (define (bool value)
 184   (if value "true\n" "false\n"))
 185
 186 (define (package-direct-input-selector input)
 187   (lambda (package)
 188     (match (assoc-ref (package-direct-inputs package) input)
 189       ((package . _) package))))
 190
 191
 192 \f
 193 ;;;
 194 ;;; Upower D-Bus service.
 195 ;;;
 196
 197 (define-record-type* <upower-configuration>
 198   upower-configuration make-upower-configuration
 199   upower-configuration?
 200   (upower                     upower-configuration-upower
 201                               (default upower))
 202   (watts-up-pro?              upower-configuration-watts-up-pro?
 203                               (default #f))
 204   (poll-batteries?            upower-configuration-poll-batteries?
 205                               (default #t))
 206   (ignore-lid?                upower-configuration-ignore-lid?
 207                               (default #f))
 208   (use-percentage-for-policy? upower-configuration-use-percentage-for-policy?
 209                               (default #t))
 210   (percentage-low             upower-configuration-percentage-low
 211                               (default 20))
 212   (percentage-critical        upower-configuration-percentage-critical
 213                               (default 5))
 214   (percentage-action          upower-configuration-percentage-action
 215                               (default 2))
 216   (time-low                   upower-configuration-time-low
 217                               (default 1200))
 218   (time-critical              upower-configuration-time-critical
 219                               (default 300))
 220   (time-action                upower-configuration-time-action
 221                               (default 120))
 222   (critical-power-action      upower-configuration-critical-power-action
 223                               (default 'hybrid-sleep)))
 224
 225 (define* upower-configuration-file
 226   ;; Return an upower-daemon configuration file.
 227   (match-lambda
 228     (($ <upower-configuration> upower
 229         watts-up-pro? poll-batteries? ignore-lid? use-percentage-for-policy?
 230         percentage-low percentage-critical percentage-action time-low
 231         time-critical time-action critical-power-action)
 232      (plain-file "UPower.conf"
 233                  (string-append
 234                   "[UPower]\n"
 235                   "EnableWattsUpPro=" (bool watts-up-pro?)
 236                   "NoPollBatteries=" (bool (not poll-batteries?))
 237                   "IgnoreLid=" (bool ignore-lid?)
 238                   "UsePercentageForPolicy=" (bool use-percentage-for-policy?)
 239                   "PercentageLow=" (number->string percentage-low) "\n"
 240                   "PercentageCritical=" (number->string percentage-critical) "\n"
 241                   "PercentageAction=" (number->string percentage-action) "\n"
 242                   "TimeLow=" (number->string time-low) "\n"
 243                   "TimeCritical=" (number->string time-critical) "\n"
 244                   "TimeAction=" (number->string time-action) "\n"
 245                   "CriticalPowerAction=" (match critical-power-action
 246                                            ('hybrid-sleep "HybridSleep")
 247                                            ('hibernate "Hibernate")
 248                                            ('power-off "PowerOff"))
 249                   "\n")))))
 250
 251 (define %upower-activation
 252   #~(begin
 253       (use-modules (guix build utils))
 254       (mkdir-p "/var/lib/upower")))
 255
 256 (define (upower-dbus-service config)
 257   (list (wrapped-dbus-service (upower-configuration-upower config)
 258                               "libexec/upowerd"
 259                               `(("UPOWER_CONF_FILE_NAME"
 260                                  ,(upower-configuration-file config))))))
 261
 262 (define (upower-shepherd-service config)
 263   "Return a shepherd service for UPower with CONFIG."
 264   (let ((upower (upower-configuration-upower config))
 265         (config (upower-configuration-file config)))
 266     (list (shepherd-service
 267            (documentation "Run the UPower power and battery monitor.")
 268            (provision '(upower-daemon))
 269            (requirement '(dbus-system udev))
 270
 271            (start #~(make-forkexec-constructor
 272                      (list (string-append #$upower "/libexec/upowerd"))
 273                      #:environment-variables
 274                      (list (string-append "UPOWER_CONF_FILE_NAME="
 275                                           #$config))))
 276            (stop #~(make-kill-destructor))))))
 277
 278 (define upower-service-type
 279   (let ((upower-package (compose list upower-configuration-upower)))
 280     (service-type (name 'upower)
 281                   (description
 282                    "Run @command{upowerd}}, a system-wide monitor for power
 283 consumption and battery levels, with the given configuration settings.  It
 284 implements the @code{org.freedesktop.UPower} D-Bus interface, and is notably
 285 used by GNOME.")
 286                   (extensions
 287                    (list (service-extension dbus-root-service-type
 288                                             upower-dbus-service)
 289                          (service-extension shepherd-root-service-type
 290                                             upower-shepherd-service)
 291                          (service-extension activation-service-type
 292                                             (const %upower-activation))
 293                          (service-extension udev-service-type
 294                                             upower-package)
 295
 296                          ;; Make the 'upower' command visible.
 297                          (service-extension profile-service-type
 298                                             upower-package)))
 299                   (default-value (upower-configuration)))))
 300
 301 \f
 302 ;;;
 303 ;;; GeoClue D-Bus service.
 304 ;;;
 305
 306 ;; TODO: Export.
 307 (define-record-type* <geoclue-configuration>
 308   geoclue-configuration make-geoclue-configuration
 309   geoclue-configuration?
 310   (geoclue geoclue-configuration-geoclue
 311            (default geoclue))
 312   (whitelist geoclue-configuration-whitelist)
 313   (wifi-geolocation-url geoclue-configuration-wifi-geolocation-url)
 314   (submit-data? geoclue-configuration-submit-data?)
 315   (wifi-submission-url geoclue-configuration-wifi-submission-url)
 316   (submission-nick geoclue-configuration-submission-nick)
 317   (applications geoclue-configuration-applications))
 318
 319 (define* (geoclue-application name #:key (allowed? #t) system? (users '()))
 320   "Configure default GeoClue access permissions for an application.  NAME is
 321 the Desktop ID of the application, without the .desktop part.  If ALLOWED? is
 322 true, the application will have access to location information by default.
 323 The boolean SYSTEM? value indicates that an application is a system component
 324 or not.  Finally USERS is a list of UIDs of all users for which this
 325 application is allowed location info access.  An empty users list means all
 326 users are allowed."
 327   (string-append
 328    "[" name "]\n"
 329    "allowed=" (bool allowed?)
 330    "system=" (bool system?)
 331    "users=" (string-join users ";") "\n"))
 332
 333 (define %standard-geoclue-applications
 334   (list (geoclue-application "gnome-datetime-panel" #:system? #t)
 335         (geoclue-application "epiphany" #:system? #f)
 336         (geoclue-application "firefox" #:system? #f)))
 337
 338 (define* (geoclue-configuration-file config)
 339   "Return a geoclue configuration file."
 340   (plain-file "geoclue.conf"
 341               (string-append
 342                "[agent]\n"
 343                "whitelist="
 344                (string-join (geoclue-configuration-whitelist config)
 345                             ";") "\n"
 346                "[wifi]\n"
 347                "url=" (geoclue-configuration-wifi-geolocation-url config) "\n"
 348                "submit-data=" (bool (geoclue-configuration-submit-data? config))
 349                "submission-url="
 350                (geoclue-configuration-wifi-submission-url config) "\n"
 351                "submission-nick="
 352                (geoclue-configuration-submission-nick config)
 353                "\n"
 354                (string-join (geoclue-configuration-applications config)
 355                             "\n"))))
 356
 357 (define (geoclue-dbus-service config)
 358   (list (wrapped-dbus-service (geoclue-configuration-geoclue config)
 359                               "libexec/geoclue"
 360                               `(("GEOCLUE_CONFIG_FILE"
 361                                  ,(geoclue-configuration-file config))))))
 362
 363 (define %geoclue-accounts
 364   (list (user-group (name "geoclue") (system? #t))
 365         (user-account
 366          (name "geoclue")
 367          (group "geoclue")
 368          (system? #t)
 369          (comment "GeoClue daemon user")
 370          (home-directory "/var/empty")
 371          (shell "/run/current-system/profile/sbin/nologin"))))
 372
 373 (define geoclue-service-type
 374   (service-type (name 'geoclue)
 375                 (extensions
 376                  (list (service-extension dbus-root-service-type
 377                                           geoclue-dbus-service)
 378                        (service-extension account-service-type
 379                                           (const %geoclue-accounts))))
 380                 (description "Run the @command{geoclue} location service.
 381 This service provides a D-Bus interface to allow applications to request
 382 access to a user's physical location, and optionally to add information to
 383 online location databases.")))
 384
 385 (define* (geoclue-service #:key (geoclue geoclue)
 386                           (whitelist '())
 387                           (wifi-geolocation-url
 388                            ;; Mozilla geolocation service:
 389                            "https://location.services.mozilla.com/v1/geolocate?key=geoclue")
 390                           (submit-data? #f)
 391                           (wifi-submission-url
 392                            "https://location.services.mozilla.com/v1/submit?key=geoclue")
 393                           (submission-nick "geoclue")
 394                           (applications %standard-geoclue-applications))
 395   "Return a service that runs the @command{geoclue} location service.  This
 396 service provides a D-Bus interface to allow applications to request access to
 397 a user's physical location, and optionally to add information to online
 398 location databases.  By default, only the GNOME date-time panel and the Icecat
 399 and Epiphany web browsers are able to ask for the user's location, and in the
 400 case of Icecat and Epiphany, both will ask the user for permission first.  See
 401 @uref{https://wiki.freedesktop.org/www/Software/GeoClue/, the geoclue web
 402 site} for more information."
 403   (service geoclue-service-type
 404            (geoclue-configuration
 405             (geoclue geoclue)
 406             (whitelist whitelist)
 407             (wifi-geolocation-url wifi-geolocation-url)
 408             (submit-data? submit-data?)
 409             (wifi-submission-url wifi-submission-url)
 410             (submission-nick submission-nick)
 411             (applications applications))))
 412
 413 \f
 414 ;;;
 415 ;;; Bluetooth.
 416 ;;;
 417
 418 (define-record-type* <bluetooth-configuration>
 419   bluetooth-configuration make-bluetooth-configuration
 420   bluetooth-configuration?
 421   (bluez bluetooth-configuration-bluez (default bluez))
 422
 423   ;;; [General]
 424   (name bluetooth-configuration-name (default "BlueZ"))
 425   (class bluetooth-configuration-class (default #x000000))
 426   (discoverable-timeout
 427    bluetooth-configuration-discoverable-timeout (default 180))
 428   (always-pairable? bluetooth-configuration-always-pairable? (default #f))
 429   (pairable-timeout bluetooth-configuration-pairable-timeout (default 0))
 430
 431   ;;; MAYBE: Exclude into separate <device-id> record-type?
 432   (device-id bluetooth-configuration-device-id (default #f))
 433   (reverse-service-discovery?
 434    bluetooth-configuration-reverse-service-discovery (default #t))
 435   (name-resolving? bluetooth-configuration-name-resolving? (default #t))
 436   (debug-keys? bluetooth-configuration-debug-keys? (default #f))
 437
 438   ;;; Possible values:
 439   ;;; 'dual, 'bredr, 'le
 440   (controller-mode bluetooth-configuration-controller-mode (default 'dual))
 441
 442   ;;; Possible values:
 443   ;;; 'off, 'single, 'multiple
 444   (multi-profile bluetooth-configuration-multi-profile (default 'off))
 445   (fast-connectable? bluetooth-configuration-fast-connectable? (default #f))
 446
 447   ;;; Possible values:
 448   ;;; for LE mode: 'off, 'network/on, 'device
 449   ;;; for Dual mode: 'off, 'network/on', 'device, 'limited-network, 'limited-device
 450   ;;; Source: https://git.kernel.org/pub/scm/bluetooth/bluez.git/tree/src/main.conf#n68
 451   (privacy bluetooth-configuration-privacy (default 'off))
 452
 453   ;;; Possible values:
 454   ;;; 'never, 'confirm, 'always
 455   (just-works-repairing
 456    bluetooth-configuration-just-works-repairing (default 'never))
 457   (temporary-timeout bluetooth-configuration-temporary-timeout (default 30))
 458   (refresh-discovery? bluetooth-configuration-refresh-discovery (default #t))
 459
 460   ;;; Possible values: #t, #f, (uuid <uuid>)
 461   ;;; Possible UUIDs:
 462   ;;; d4992530-b9ec-469f-ab01-6c481c47da1c (BlueZ Experimental Debug)
 463   ;;; 671b10b5-42c0-4696-9227-eb28d1b049d6 (BlueZ Experimental Simultaneous Central and Peripheral)
 464   ;;; 15c0a148-c273-11ea-b3de-0242ac130004 (BlueZ Experimental LL privacy)
 465   ;;; 330859bc-7506-492d-9370-9a6f0614037f (BlueZ Experimental Bluetooth Quality Report)
 466   ;;; a6695ace-ee7f-4fb9-881a-5fac66c629af (BlueZ Experimental Offload Codecs)
 467   ;;; Source: https://git.kernel.org/pub/scm/bluetooth/bluez.git/tree/src/main.conf#n110
 468   (experimental bluetooth-configuration-experimental (default #f))
 469   (remote-name-request-retry-delay
 470    bluetooth-configuration-remote-name-request-retry-delay (default 300))
 471
 472   ;;; [BR]
 473   (page-scan-type bluetooth-configuration-page-scan-type (default #f))
 474   (page-scan-interval bluetooth-configuration-page-scan-interval (default #f))
 475   (page-scan-window bluetooth-configuration-page-scan-window (default #f))
 476   (inquiry-scan-type bluetooth-configuration-inquiry-scan-type (default #f))
 477   (inquiry-scan-interval bluetooth-configuration-inquiry-scan-interval (default #f))
 478   (inquiry-scan-window bluetooth-configuration-inquiry-scan-window (default #f))
 479   (link-supervision-timeout bluetooth-configuration-link-supervision-timeout (default #f))
 480   (page-timeout bluetooth-configuration-page-timeout (default #f))
 481   (min-sniff-interval bluetooth-configuration-min-sniff-interval (default #f))
 482   (max-sniff-interval bluetooth-configuration-max-sniff-interval (default #f))
 483
 484   ;;; [LE]
 485   (min-advertisement-interval
 486    bluetooth-configuration-min-advertisement-interval (default #f))
 487   (max-advertisement-interval
 488    bluetooth-configuration-max-advertisement-interval (default #f))
 489   (multi-advertisement-rotation-interval
 490    bluetooth-configuration-multi-advertisement-rotation-interval (default #f))
 491   (scan-interval-auto-connect
 492    bluetooth-configuration-scan-interval-auto-connect (default #f))
 493   (scan-window-auto-connect
 494    bluetooth-configuration-scan-window-auto-connect (default #f))
 495   (scan-interval-suspend
 496    bluetooth-configuration-scan-interval-suspend (default #f))
 497   (scan-window-suspend
 498    bluetooth-configuration-scan-window-suspend (default #f))
 499   (scan-interval-discovery
 500    bluetooth-configuration-scan-interval-discovery (default #f))
 501   (scan-window-discovery
 502    bluetooth-configuration-scan-window-discovery (default #f))
 503   (scan-interval-adv-monitor
 504    bluetooth-configuration-scan-interval-adv-monitor (default #f))
 505   (scan-window-adv-monitor
 506    bluetooth-configuration-scan-window-adv-monitor (default #f))
 507   (scan-interval-connect
 508    bluetooth-configuration-scan-interval-connect (default #f))
 509   (scan-window-connect
 510    bluetooth-configuration-scan-window-connect (default #f))
 511   (min-connection-interval
 512    bluetooth-configuration-min-connection-interval (default #f))
 513   (max-connection-interval
 514    bluetooth-configuration-max-connection-interval (default #f))
 515   (connection-latency
 516    bluetooth-configuration-connection-latency (default #f))
 517   (connection-supervision-timeout
 518    bluetooth-configuration-connection-supervision-timeout (default #f))
 519   (autoconnect-timeout
 520    bluetooth-configuration-autoconnect-timeout (default #f))
 521   (adv-mon-allowlist-scan-duration
 522    bluetooth-configuration-adv-mon-allowlist-scan-duration (default 300))
 523   (adv-mon-no-filter-scan-duration
 524    bluetooth-configuration-adv-mon-no-filter-scan-duration (default 500))
 525   (enable-adv-mon-interleave-scan?
 526    bluetooth-configuration-enable-adv-mon-interleave-scan (default #t))
 527
 528   ;;; [GATT]
 529   ;;; Possible values: 'yes, 'no, 'always
 530   (cache bluetooth-configuration-cache (default 'always))
 531
 532   ;;; Possible values: 7 ... 16, 0 (don't care)
 533   (key-size bluetooth-configuration-key-size (default 0))
 534
 535   ;;; Possible values: 23 ... 517
 536   (exchange-mtu bluetooth-configuration-exchange-mtu (default 517))
 537
 538   ;;; Possible values: 1 ... 5
 539   (att-channels bluetooth-configuration-att-channels (default 3))
 540
 541   ;;; [AVDTP]
 542   ;;; Possible values: 'basic, 'ertm
 543   (session-mode bluetooth-configuration-session-mode (default 'basic))
 544
 545   ;;; Possible values: 'basic, 'streaming
 546   (stream-mode bluetooth-configuration-stream-mode (default 'basic))
 547
 548   ;;; [Policy]
 549   (reconnect-uuids bluetooth-configuration-reconnect-uuids (default '()))
 550   (reconnect-attempts bluetooth-configuration-reconnect-attempts (default 7))
 551   (reconnect-intervals bluetooth-configuration-reconnect-intervals
 552                        (default (list 1 2 4 8 16 32 64)))
 553   (auto-enable? bluetooth-configuration-auto-enable? (default #f))
 554   (resume-delay bluetooth-configuration-resume-delay (default 2))
 555
 556   ;;; [AdvMon]
 557   ;;; Possible values:
 558   ;;; "0x00", "0xFF",
 559   ;;; "N = 0x00" ... "N = 0xFF"
 560   ;;; Source: https://git.kernel.org/pub/scm/bluetooth/bluez.git/tree/src/main.conf#n286
 561   (rssi-sampling-period bluetooth-configuration-rssi-sampling-period
 562                         (default #xFF)))
 563
 564 (define (bluetooth-configuration-file config)
 565   "Return a configuration file for the systemd bluetooth service, as a string."
 566   (string-append
 567    "[General]"
 568    "\nName = " (bluetooth-configuration-name config)
 569    "\nClass = " (string-append
 570                  "0x"
 571                  (format #f "~6,'0x" (bluetooth-configuration-class config)))
 572    "\nDiscoverableTimeout = " (number->string
 573                                (bluetooth-configuration-discoverable-timeout
 574                                 config))
 575    "\nAlwaysPairable = " (bool (bluetooth-configuration-always-pairable?
 576                                 config))
 577    "\nPairableTimeout = " (number->string
 578                            (bluetooth-configuration-pairable-timeout
 579                             config))
 580    (if (bluetooth-configuration-device-id config)
 581        (string-append "\nDeviceID = " (bluetooth-configuration-device-id config))
 582        "")
 583    "\nReverseServiceDiscovery = " (bool
 584                                    (bluetooth-configuration-reverse-service-discovery
 585                                     config))
 586    "\nNameResolving = " (bool (bluetooth-configuration-name-resolving? config))
 587    "\nDebugKeys = " (bool (bluetooth-configuration-debug-keys? config))
 588    "\nControllerMode = " (symbol->string
 589                           (bluetooth-configuration-controller-mode config))
 590    "\nMultiProfile = " (symbol->string (bluetooth-configuration-multi-profile
 591                                         config))
 592    "\nFastConnectable = " (bool (bluetooth-configuration-fast-connectable? config))
 593    "\nPrivacy = " (symbol->string (bluetooth-configuration-privacy config))
 594    "\nJustWorksRepairing = " (symbol->string
 595                               (bluetooth-configuration-just-works-repairing config))
 596    "\nTemporaryTimeout = " (number->string
 597                             (bluetooth-configuration-temporary-timeout config))
 598    "\nRefreshDiscovery = " (bool (bluetooth-configuration-refresh-discovery config))
 599    "\nExperimental = " (let ((experimental (bluetooth-configuration-experimental config)))
 600                          (cond ((or (eq? experimental #t)
 601                                     (eq? experimental #f)) (bool experimental))
 602                                ((list? experimental)
 603                                 (string-join (map uuid->string experimental) ","))))
 604    "\nRemoteNameRequestRetryDelay = " (number->string
 605                                        (bluetooth-configuration-remote-name-request-retry-delay
 606                                         config))
 607    "\n[BR]"
 608    (if (bluetooth-configuration-page-scan-type config)
 609        (string-append
 610         "\nPageScanType = "
 611         (number->string (bluetooth-configuration-page-scan-type config)))
 612        "")
 613    (if (bluetooth-configuration-page-scan-interval config)
 614        (string-append
 615         "\nPageScanInterval = "
 616         (number->string (bluetooth-configuration-page-scan-interval config)))
 617        "")
 618    (if (bluetooth-configuration-page-scan-window config)
 619        (string-append
 620         "\nPageScanWindow = "
 621         (number->string (bluetooth-configuration-page-scan-window config)))
 622        "")
 623    (if (bluetooth-configuration-inquiry-scan-type config)
 624        (string-append
 625         "\nInquiryScanType = "
 626         (number->string (bluetooth-configuration-inquiry-scan-type config)))
 627        "")
 628    (if (bluetooth-configuration-inquiry-scan-interval config)
 629        (string-append
 630         "\nInquiryScanInterval = "
 631         (number->string (bluetooth-configuration-inquiry-scan-interval config)))
 632        "")
 633    (if (bluetooth-configuration-inquiry-scan-window config)
 634        (string-append
 635         "\nInquiryScanWindow = "
 636         (number->string (bluetooth-configuration-inquiry-scan-window config)))
 637        "")
 638    (if (bluetooth-configuration-link-supervision-timeout config)
 639        (string-append
 640         "\nLinkSupervisionTimeout = "
 641         (number->string (bluetooth-configuration-link-supervision-timeout config)))
 642        "")
 643    (if (bluetooth-configuration-page-timeout config)
 644        (string-append
 645         "\nPageTimeout = "
 646         (number->string (bluetooth-configuration-page-timeout config)))
 647        "")
 648    (if (bluetooth-configuration-min-sniff-interval config)
 649        (string-append
 650         "\nMinSniffInterval = "
 651         (number->string (bluetooth-configuration-min-sniff-interval config)))
 652        "")
 653    (if (bluetooth-configuration-max-sniff-interval config)
 654        (string-append
 655         "\nMaxSniffInterval = "
 656         (number->string (bluetooth-configuration-max-sniff-interval config)))
 657        "")
 658
 659    "\n[LE]"
 660    (if (bluetooth-configuration-min-advertisement-interval config)
 661        (string-append
 662         "\nMinAdvertisementInterval = "
 663         (number->string (bluetooth-configuration-min-advertisement-interval config)))
 664        "")
 665    (if (bluetooth-configuration-max-advertisement-interval config)
 666        (string-append
 667         "\nMaxAdvertisementInterval = "
 668         (number->string (bluetooth-configuration-max-advertisement-interval config)))
 669        "")
 670    (if (bluetooth-configuration-multi-advertisement-rotation-interval config)
 671        (string-append
 672         "\nMultiAdvertisementRotationInterval = "
 673         (number->string
 674          (bluetooth-configuration-multi-advertisement-rotation-interval config)))
 675        "")
 676    (if (bluetooth-configuration-scan-interval-auto-connect config)
 677        (string-append
 678         "\nScanIntervalAutoConnect = "
 679         (number->string (bluetooth-configuration-scan-interval-auto-connect config)))
 680        "")
 681    (if (bluetooth-configuration-scan-window-auto-connect config)
 682        (string-append
 683         "\nScanWindowAutoConnect = "
 684         (number->string (bluetooth-configuration-scan-window-auto-connect config)))
 685        "")
 686    (if (bluetooth-configuration-scan-interval-suspend config)
 687        (string-append
 688         "\nScanIntervalSuspend = "
 689         (number->string (bluetooth-configuration-scan-interval-suspend config)))
 690        "")
 691    (if (bluetooth-configuration-scan-window-suspend config)
 692        (string-append
 693         "\nScanWindowSuspend = "
 694         (number->string (bluetooth-configuration-scan-window-suspend config)))
 695        "")
 696    (if (bluetooth-configuration-scan-interval-discovery config)
 697        (string-append
 698         "\nScanIntervalDiscovery = "
 699         (number->string (bluetooth-configuration-scan-interval-discovery config)))
 700        "")
 701    (if (bluetooth-configuration-scan-window-discovery config)
 702        (string-append
 703         "\nScanWindowDiscovery = "
 704         (number->string (bluetooth-configuration-scan-window-discovery config)))
 705        "")
 706    (if (bluetooth-configuration-scan-interval-adv-monitor config)
 707        (string-append
 708         "\nScanIntervalAdvMonitor = "
 709         (number->string (bluetooth-configuration-scan-interval-adv-monitor config)))
 710        "")
 711    (if (bluetooth-configuration-scan-window-adv-monitor config)
 712        (string-append
 713         "\nScanWindowAdvMonitor = "
 714         (number->string (bluetooth-configuration-scan-window-adv-monitor config)))
 715        "")
 716    (if (bluetooth-configuration-scan-interval-connect config)
 717        (string-append
 718         "\nScanIntervalConnect = "
 719         (number->string (bluetooth-configuration-scan-interval-connect config)))
 720        "")
 721    (if (bluetooth-configuration-scan-window-connect config)
 722        (string-append
 723         "\nScanWindowConnect = "
 724         (number->string (bluetooth-configuration-scan-window-connect config)))
 725        "")
 726    (if (bluetooth-configuration-min-connection-interval config)
 727        (string-append
 728         "\nMinConnectionInterval = "
 729         (number->string (bluetooth-configuration-min-connection-interval config)))
 730        "")
 731    (if (bluetooth-configuration-max-connection-interval config)
 732        (string-append
 733         "\nMaxConnectionInterval = "
 734         (number->string (bluetooth-configuration-max-connection-interval config)))
 735        "")
 736    (if (bluetooth-configuration-connection-latency config)
 737        (string-append
 738         "\nConnectionLatency = "
 739         (number->string (bluetooth-configuration-connection-latency config)))
 740        "")
 741    (if (bluetooth-configuration-connection-supervision-timeout config)
 742        (string-append
 743         "\nConnectionSupervisionTimeout = "
 744         (number->string (bluetooth-configuration-connection-supervision-timeout config)))
 745        "")
 746    (if (bluetooth-configuration-autoconnect-timeout config)
 747        (string-append
 748         "\nAutoconnecttimeout = "
 749         (number->string (bluetooth-configuration-autoconnect-timeout config)))
 750        "")
 751    "\nAdvMonAllowlistScanDuration = " (number->string
 752                                        (bluetooth-configuration-adv-mon-allowlist-scan-duration
 753                                         config))
 754    "\nAdvMonNoFilterScanDuration = " (number->string
 755                                       (bluetooth-configuration-adv-mon-no-filter-scan-duration
 756                                        config))
 757    "\nEnableAdvMonInterleaveScan = " (number->string
 758                                       (if (eq? #t
 759                                                (bluetooth-configuration-enable-adv-mon-interleave-scan
 760                                                 config))
 761                                           1 0))
 762
 763    "\n[GATT]"
 764    "\nCache = " (symbol->string (bluetooth-configuration-cache config))
 765    "\nKeySize = " (number->string (bluetooth-configuration-key-size config))
 766    "\nExchangeMTU = " (number->string (bluetooth-configuration-exchange-mtu config))
 767    "\nChannels = " (number->string (bluetooth-configuration-att-channels config))
 768
 769    "\n[AVDTP]"
 770    "\nSessionMode = " (symbol->string (bluetooth-configuration-session-mode config))
 771    "\nStreamMode = " (symbol->string (bluetooth-configuration-stream-mode config))
 772
 773    "\n[Policy]"
 774    (let ((uuids (bluetooth-configuration-reconnect-uuids config)))
 775      (if (not (eq? '() uuids))
 776          (string-append
 777           "\nReconnectUUIDs = "
 778           (string-join (map uuid->string uuids) ","))
 779          ""))
 780    "\nReconnectAttempts = " (number->string
 781                              (bluetooth-configuration-reconnect-attempts config))
 782    "\nReconnectIntervals = " (string-join
 783                               (map number->string
 784                                    (bluetooth-configuration-reconnect-intervals
 785                                     config))
 786                               ",")
 787    "\nAutoEnable = " (bool (bluetooth-configuration-auto-enable?
 788                             config))
 789    "\nResumeDelay = " (number->string (bluetooth-configuration-resume-delay config))
 790
 791    "\n[AdvMon]"
 792    "\nRSSISamplingPeriod = " (string-append
 793                               "0x"
 794                               (format #f "~2,'0x"
 795                                       (bluetooth-configuration-rssi-sampling-period config)))))
 796
 797 (define (bluetooth-directory config)
 798   (computed-file "etc-bluetooth"
 799                  #~(begin
 800                      (mkdir #$output)
 801                      (chdir #$output)
 802                      (call-with-output-file "main.conf"
 803                        (lambda (port)
 804                          (display #$(bluetooth-configuration-file config)
 805                                   port))))))
 806
 807 (define (bluetooth-shepherd-service config)
 808   "Return a shepherd service for @command{bluetoothd}."
 809   (shepherd-service
 810    (provision '(bluetooth))
 811    (requirement '(dbus-system udev))
 812    (documentation "Run the bluetoothd daemon.")
 813    (start #~(make-forkexec-constructor
 814              (list #$(file-append (bluetooth-configuration-bluez config)
 815                                   "/libexec/bluetooth/bluetoothd"))))
 816    (stop #~(make-kill-destructor))))
 817
 818 (define bluetooth-service-type
 819   (service-type
 820    (name 'bluetooth)
 821    (extensions
 822     (list (service-extension dbus-root-service-type
 823                              (compose list bluetooth-configuration-bluez))
 824           (service-extension udev-service-type
 825                              (compose list bluetooth-configuration-bluez))
 826           (service-extension etc-service-type
 827                              (lambda (config)
 828                                `(("bluetooth"
 829                                   ,(bluetooth-directory config)))))
 830           (service-extension shepherd-root-service-type
 831                              (compose list bluetooth-shepherd-service))))
 832    (default-value (bluetooth-configuration))
 833    (description "Run the @command{bluetoothd} daemon, which manages all the
 834 Bluetooth devices and provides a number of D-Bus interfaces.")))
 835
 836 (define* (bluetooth-service #:key (bluez bluez) (auto-enable? #f))
 837   "Return a service that runs the @command{bluetoothd} daemon, which manages
 838 all the Bluetooth devices and provides a number of D-Bus interfaces.  When
 839 AUTO-ENABLE? is true, the bluetooth controller is powered automatically at
 840 boot.
 841
 842 Users need to be in the @code{lp} group to access the D-Bus service.
 843 "
 844   (service bluetooth-service-type
 845            (bluetooth-configuration
 846             (bluez bluez)
 847             (auto-enable? auto-enable?))))
 848
 849 \f
 850 ;;;
 851 ;;; Colord D-Bus service.
 852 ;;;
 853
 854 (define %colord-activation
 855   #~(begin
 856       (use-modules (guix build utils))
 857       (mkdir-p "/var/lib/colord")
 858       (let ((user (getpwnam "colord")))
 859         (chown "/var/lib/colord"
 860                (passwd:uid user) (passwd:gid user)))))
 861
 862 (define %colord-accounts
 863   (list (user-group (name "colord") (system? #t))
 864         (user-account
 865          (name "colord")
 866          (group "colord")
 867          (system? #t)
 868          (comment "colord daemon user")
 869          (home-directory "/var/empty")
 870          (shell (file-append shadow "/sbin/nologin")))))
 871
 872 (define colord-service-type
 873   (service-type (name 'colord)
 874                 (extensions
 875                  (list (service-extension account-service-type
 876                                           (const %colord-accounts))
 877                        (service-extension activation-service-type
 878                                           (const %colord-activation))
 879
 880                        ;; Colord is a D-Bus service that dbus-daemon can
 881                        ;; activate.
 882                        (service-extension dbus-root-service-type list)
 883
 884                        ;; Colord provides "color device" rules for udev.
 885                        (service-extension udev-service-type list)
 886
 887                        ;; It provides polkit "actions".
 888                        (service-extension polkit-service-type list)))
 889                 (default-value colord)
 890                 (description
 891                  "Run @command{colord}, a system service with a D-Bus
 892 interface to manage the color profiles of input and output devices such as
 893 screens and scanners.")))
 894
 895 \f
 896 ;;;
 897 ;;; UDisks.
 898 ;;;
 899
 900 (define-record-type* <udisks-configuration>
 901   udisks-configuration make-udisks-configuration
 902   udisks-configuration?
 903   (udisks   udisks-configuration-udisks
 904             (default udisks)))
 905
 906 (define %udisks-activation
 907   (with-imported-modules '((guix build utils))
 908     #~(begin
 909         (use-modules (guix build utils))
 910
 911         (let ((run-dir "/var/run/udisks2"))
 912           (mkdir-p run-dir)
 913           (chmod run-dir #o700)))))
 914
 915 (define udisks-service-type
 916   (let ((udisks-package (lambda (config)
 917                           (list (udisks-configuration-udisks config)))))
 918     (service-type (name 'udisks)
 919                   (extensions
 920                    (list (service-extension polkit-service-type
 921                                             udisks-package)
 922                          (service-extension dbus-root-service-type
 923                                             udisks-package)
 924                          (service-extension udev-service-type
 925                                             udisks-package)
 926                          (service-extension activation-service-type
 927                                             (const %udisks-activation))
 928
 929                          ;; Profile 'udisksctl' & co. in the system profile.
 930                          (service-extension profile-service-type
 931                                             udisks-package)))
 932                   (description "Run UDisks, a @dfn{disk management} daemon
 933 that provides user interfaces with notifications and ways to mount/unmount
 934 disks.  Programs that talk to UDisks include the @command{udisksctl} command,
 935 part of UDisks, and GNOME Disks."))))
 936
 937 (define* (udisks-service #:key (udisks udisks))
 938   "Return a service for @uref{http://udisks.freedesktop.org/docs/latest/,
 939 UDisks}, a @dfn{disk management} daemon that provides user interfaces with
 940 notifications and ways to mount/unmount disks.  Programs that talk to UDisks
 941 include the @command{udisksctl} command, part of UDisks, and GNOME Disks."
 942   (service udisks-service-type
 943            (udisks-configuration (udisks udisks))))
 944
 945 \f
 946 ;;;
 947 ;;; Elogind login and seat management service.
 948 ;;;
 949
 950 (define-record-type* <elogind-configuration> elogind-configuration
 951   make-elogind-configuration
 952   elogind-configuration?
 953   (elogind                          elogind-package
 954                                     (default elogind))
 955   (kill-user-processes?             elogind-kill-user-processes?
 956                                     (default #f))
 957   (kill-only-users                  elogind-kill-only-users
 958                                     (default '()))
 959   (kill-exclude-users               elogind-kill-exclude-users
 960                                     (default '("root")))
 961   (inhibit-delay-max-seconds        elogind-inhibit-delay-max-seconds
 962                                     (default 5))
 963   (handle-power-key                 elogind-handle-power-key
 964                                     (default 'poweroff))
 965   (handle-suspend-key               elogind-handle-suspend-key
 966                                     (default 'suspend))
 967   (handle-hibernate-key             elogind-handle-hibernate-key
 968                                     ;; (default 'hibernate)
 969                                     ;; XXX Ignore it for now, since we don't
 970                                     ;; yet handle resume-from-hibernation in
 971                                     ;; our initrd.
 972                                     (default 'ignore))
 973   (handle-lid-switch                elogind-handle-lid-switch
 974                                     (default 'suspend))
 975   (handle-lid-switch-docked         elogind-handle-lid-switch-docked
 976                                     (default 'ignore))
 977   (handle-lid-switch-external-power elogind-handle-lid-switch-external-power
 978                                     (default *unspecified*))
 979   (power-key-ignore-inhibited?      elogind-power-key-ignore-inhibited?
 980                                     (default #f))
 981   (suspend-key-ignore-inhibited?    elogind-suspend-key-ignore-inhibited?
 982                                     (default #f))
 983   (hibernate-key-ignore-inhibited?  elogind-hibernate-key-ignore-inhibited?
 984                                     (default #f))
 985   (lid-switch-ignore-inhibited?     elogind-lid-switch-ignore-inhibited?
 986                                     (default #t))
 987   (holdoff-timeout-seconds          elogind-holdoff-timeout-seconds
 988                                     (default 30))
 989   (idle-action                      elogind-idle-action
 990                                     (default 'ignore))
 991   (idle-action-seconds              elogind-idle-action-seconds
 992                                     (default (* 30 60)))
 993   (runtime-directory-size-percent   elogind-runtime-directory-size-percent
 994                                     (default 10))
 995   (runtime-directory-size           elogind-runtime-directory-size
 996                                     (default #f))
 997   (remove-ipc?                      elogind-remove-ipc?
 998                                     (default #t))
 999
1000   (suspend-state                    elogind-suspend-state
1001                                     (default '("mem" "standby" "freeze")))
1002   (suspend-mode                     elogind-suspend-mode
1003                                     (default '()))
1004   (hibernate-state                  elogind-hibernate-state
1005                                     (default '("disk")))
1006   (hibernate-mode                   elogind-hibernate-mode
1007                                     (default '("platform" "shutdown")))
1008   (hybrid-sleep-state               elogind-hybrid-sleep-state
1009                                     (default '("disk")))
1010   (hybrid-sleep-mode                elogind-hybrid-sleep-mode
1011                                     (default
1012                                       '("suspend" "platform" "shutdown"))))
1013
1014 (define (elogind-configuration-file config)
1015   (define (yesno x)
1016     (match x
1017       (#t "yes")
1018       (#f "no")
1019       (_ (error "expected #t or #f, instead got:" x))))
1020   (define char-set:user-name
1021     (string->char-set "abcdefghijklmnopqrstuvwxyz0123456789_-"))
1022   (define (valid-list? l pred)
1023     (and-map (lambda (x) (string-every pred x)) l))
1024   (define (user-name-list users)
1025     (unless (valid-list? users char-set:user-name)
1026       (error "invalid user list" users))
1027     (string-join users " "))
1028   (define (enum val allowed)
1029     (unless (memq val allowed)
1030       (error "invalid value" val allowed))
1031     (symbol->string val))
1032   (define (non-negative-integer x)
1033     (unless (exact-integer? x) (error "not an integer" x))
1034     (when (negative? x) (error "negative number not allowed" x))
1035     (number->string x))
1036   (define handle-actions
1037     '(ignore poweroff reboot halt kexec suspend hibernate hybrid-sleep lock))
1038   (define (handle-action x)
1039     (if (unspecified? x)
1040         x                               ;let the unspecified value go through
1041         (enum x handle-actions)))
1042   (define (sleep-list tokens)
1043     (unless (valid-list? tokens char-set:user-name)
1044       (error "invalid sleep list" tokens))
1045     (string-join tokens " "))
1046   (define-syntax ini-file-clause
1047     (syntax-rules ()
1048       ;; Produce an empty line when encountering an unspecified value.  This
1049       ;; is better than an empty string value, which can, in some cases, cause
1050       ;; warnings such as "Failed to parse handle action setting".
1051       ((_ config (prop (parser getter)))
1052        (let ((value (parser (getter config))))
1053          (if (unspecified? value)
1054              ""
1055              (string-append prop "=" value "\n"))))
1056       ((_ config str)
1057        (if (unspecified? str)
1058            ""
1059            (string-append str "\n")))))
1060   (define-syntax-rule (ini-file config file clause ...)
1061     (plain-file file (string-append (ini-file-clause config clause) ...)))
1062   (ini-file
1063    config "logind.conf"
1064    "[Login]"
1065    ("KillUserProcesses" (yesno elogind-kill-user-processes?))
1066    ("KillOnlyUsers" (user-name-list elogind-kill-only-users))
1067    ("KillExcludeUsers" (user-name-list elogind-kill-exclude-users))
1068    ("InhibitDelayMaxSec" (non-negative-integer elogind-inhibit-delay-max-seconds))
1069    ("HandlePowerKey" (handle-action elogind-handle-power-key))
1070    ("HandleSuspendKey" (handle-action elogind-handle-suspend-key))
1071    ("HandleHibernateKey" (handle-action elogind-handle-hibernate-key))
1072    ("HandleLidSwitch" (handle-action elogind-handle-lid-switch))
1073    ("HandleLidSwitchDocked" (handle-action elogind-handle-lid-switch-docked))
1074    ("HandleLidSwitchExternalPower" (handle-action elogind-handle-lid-switch-external-power))
1075    ("PowerKeyIgnoreInhibited" (yesno elogind-power-key-ignore-inhibited?))
1076    ("SuspendKeyIgnoreInhibited" (yesno elogind-suspend-key-ignore-inhibited?))
1077    ("HibernateKeyIgnoreInhibited" (yesno elogind-hibernate-key-ignore-inhibited?))
1078    ("LidSwitchIgnoreInhibited" (yesno elogind-lid-switch-ignore-inhibited?))
1079    ("HoldoffTimeoutSec" (non-negative-integer elogind-holdoff-timeout-seconds))
1080    ("IdleAction" (handle-action elogind-idle-action))
1081    ("IdleActionSec" (non-negative-integer elogind-idle-action-seconds))
1082    ("RuntimeDirectorySize"
1083     (identity
1084      (lambda (config)
1085        (match (elogind-runtime-directory-size-percent config)
1086          (#f (non-negative-integer (elogind-runtime-directory-size config)))
1087          (percent (string-append (non-negative-integer percent) "%"))))))
1088    ("RemoveIPC" (yesno elogind-remove-ipc?))
1089    "[Sleep]"
1090    ("SuspendState" (sleep-list elogind-suspend-state))
1091    ("SuspendMode" (sleep-list elogind-suspend-mode))
1092    ("HibernateState" (sleep-list elogind-hibernate-state))
1093    ("HibernateMode" (sleep-list elogind-hibernate-mode))
1094    ("HybridSleepState" (sleep-list elogind-hybrid-sleep-state))
1095    ("HybridSleepMode" (sleep-list elogind-hybrid-sleep-mode))))
1096
1097 (define (elogind-dbus-service config)
1098   "Return a @file{org.freedesktop.login1.service} file that tells D-Bus how to
1099 \"start\" elogind.  In practice though, our elogind is started when booting by
1100 shepherd.  Thus, the @code{Exec} line of this @file{.service} file does not
1101 explain how to start elogind; instead, it spawns a wrapper that waits for the
1102 @code{elogind} shepherd service.  This avoids a race condition where both
1103 @command{shepherd} and @command{dbus-daemon} would attempt to start elogind."
1104   ;; For more info on the elogind startup race, see
1105   ;; <https://issues.guix.gnu.org/55444>.
1106
1107   (define elogind
1108     (elogind-package config))
1109
1110   (define wrapper
1111     (program-file "elogind-dbus-shepherd-sync"
1112                   (with-imported-modules '((gnu services herd))
1113                     #~(begin
1114                         (use-modules (gnu services herd)
1115                                      (srfi srfi-34))
1116
1117                         (guard (c ((service-not-found-error? c)
1118                                    (format (current-error-port)
1119                                            "no elogind shepherd service~%")
1120                                    (exit 1))
1121                                   ((shepherd-error? c)
1122                                    (format (current-error-port)
1123                                            "elogind shepherd service not \
1124 started~%")
1125                                    (exit 2)))
1126                           (wait-for-service 'elogind))))))
1127
1128   (define build
1129     (with-imported-modules '((guix build utils))
1130       #~(begin
1131           (use-modules (guix build utils)
1132                        (ice-9 match))
1133
1134           (define service-directory
1135             "/share/dbus-1/system-services")
1136
1137           (mkdir-p (dirname (string-append #$output service-directory)))
1138           (copy-recursively (string-append #$elogind service-directory)
1139                             (string-append #$output service-directory))
1140           (symlink (string-append #$elogind "/etc") ;for etc/dbus-1
1141                    (string-append #$output "/etc"))
1142
1143           ;; Replace the "Exec=" line of the 'org.freedesktop.login1.service'
1144           ;; file with one that refers to WRAPPER instead of elogind.
1145           (match (find-files #$output "\\.service$")
1146             ((file)
1147              (substitute* file
1148                (("Exec[[:blank:]]*=.*" _)
1149                 (string-append "Exec=" #$wrapper "\n"))))))))
1150
1151   (list (computed-file "elogind-dbus-service-wrapper" build)))
1152
1153 (define (pam-extension-procedure config)
1154   "Return an extension for PAM-ROOT-SERVICE-TYPE that ensures that all the PAM
1155 services use 'pam_elogind.so', a module that allows elogind to keep track of
1156 logged-in users (run 'loginctl' to see elogind's world view of users and
1157 seats.)"
1158   (define pam-elogind
1159     (pam-entry
1160      (control "required")
1161      (module (file-append (elogind-package config)
1162                           "/lib/security/pam_elogind.so"))))
1163
1164   (list (lambda (pam)
1165           (pam-service
1166            (inherit pam)
1167            (session (cons pam-elogind (pam-service-session pam)))))))
1168
1169 (define (elogind-shepherd-service config)
1170   "Return a Shepherd service to start elogind according to @var{config}."
1171   (list (shepherd-service
1172          (requirement '(dbus-system))
1173          (provision '(elogind))
1174          (start #~(make-forkexec-constructor
1175                    (list #$(file-append (elogind-package config)
1176                                         "/libexec/elogind/elogind"))
1177                    #:environment-variables
1178                    (list (string-append "ELOGIND_CONF_FILE="
1179                                         #$(elogind-configuration-file
1180                                            config)))))
1181          (stop #~(make-kill-destructor)))))
1182
1183 (define elogind-service-type
1184   (service-type (name 'elogind)
1185                 (extensions
1186                  (list (service-extension dbus-root-service-type
1187                                           elogind-dbus-service)
1188                        (service-extension udev-service-type
1189                                           (compose list elogind-package))
1190                        (service-extension polkit-service-type
1191                                           (compose list elogind-package))
1192
1193                        ;; Start elogind from the Shepherd rather than waiting
1194                        ;; for bus activation.  This ensures that it can handle
1195                        ;; events like lid close, etc.
1196                        (service-extension shepherd-root-service-type
1197                                           elogind-shepherd-service)
1198
1199                        ;; Provide the 'loginctl' command.
1200                        (service-extension profile-service-type
1201                                           (compose list elogind-package))
1202
1203                        ;; Extend PAM with pam_elogind.so.
1204                        (service-extension pam-root-service-type
1205                                           pam-extension-procedure)
1206
1207                        ;; We need /run/user, /run/systemd, etc.
1208                        (service-extension file-system-service-type
1209                                           (const %elogind-file-systems))))
1210                 (default-value (elogind-configuration))
1211                 (description "Run the @command{elogind} login and seat
1212 management service.  The @command{elogind} service integrates with PAM to
1213 allow other system components to know the set of logged-in users as well as
1214 their session types (graphical, console, remote, etc.).  It can also clean up
1215 after users when they log out.")))
1216
1217 (define* (elogind-service #:key (config (elogind-configuration)))
1218   "Return a service that runs the @command{elogind} login and seat management
1219 service.  The @command{elogind} service integrates with PAM to allow other
1220 system components to know the set of logged-in users as well as their session
1221 types (graphical, console, remote, etc.).  It can also clean up after users
1222 when they log out."
1223   (service elogind-service-type config))
1224
1225 \f
1226 ;;;
1227 ;;; Fontconfig and other desktop file-systems.
1228 ;;;
1229
1230 (define %fontconfig-file-system
1231   (file-system
1232     (device "none")
1233     (mount-point "/var/cache/fontconfig")
1234     (type "tmpfs")
1235     (flags '(read-only))
1236     (check? #f)))
1237
1238 (define %gdm-file-system
1239   (file-system
1240     (device "none")
1241     (mount-point "/var/lib/gdm")
1242     (type "tmpfs")
1243     (check? #f)))
1244
1245 ;; The global fontconfig cache directory can sometimes contain stale entries,
1246 ;; possibly referencing fonts that have been GC'd, so mount it read-only.
1247 ;; As mentioned https://debbugs.gnu.org/cgi/bugreport.cgi?bug=36924#8 and
1248 ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=38046#10 and elsewhere.
1249 (define fontconfig-file-system-service
1250   (simple-service 'fontconfig-file-system
1251                   file-system-service-type
1252                   (list %fontconfig-file-system)))
1253
1254 ;; Avoid stale caches and stale user IDs being reused between system
1255 ;; reconfigurations, which would crash GDM and render the system unusable.
1256 ;; GDM doesn't require persisting anything valuable there anyway.
1257 (define gdm-file-system-service
1258   (simple-service 'gdm-file-system
1259                   file-system-service-type
1260                   (list %gdm-file-system)))
1261
1262 \f
1263 ;;;
1264 ;;; AccountsService service.
1265 ;;;
1266
1267 (define %accountsservice-activation
1268   #~(begin
1269       (use-modules (guix build utils))
1270       (mkdir-p "/var/lib/AccountsService")))
1271
1272 (define accountsservice-service-type
1273   (service-type (name 'accountsservice)
1274                 (extensions
1275                  (list (service-extension activation-service-type
1276                                           (const %accountsservice-activation))
1277                        (service-extension dbus-root-service-type list)
1278                        (service-extension polkit-service-type list)))
1279                 (default-value accountsservice)
1280                 (description "Run AccountsService, a system service available
1281 over D-Bus that can list available accounts, change their passwords, and so
1282 on.  AccountsService integrates with PolicyKit to enable unprivileged users to
1283 acquire the capability to modify their system configuration.")))
1284
1285 (define* (accountsservice-service #:key (accountsservice accountsservice))
1286   "Return a service that runs AccountsService, a system service that
1287 can list available accounts, change their passwords, and so on.
1288 AccountsService integrates with PolicyKit to enable unprivileged users to
1289 acquire the capability to modify their system configuration.
1290 @uref{https://www.freedesktop.org/wiki/Software/AccountsService/, the
1291 accountsservice web site} for more information."
1292   (service accountsservice-service-type accountsservice))
1293
1294 \f
1295 ;;;
1296 ;;; cups-pk-helper service.
1297 ;;;
1298
1299 (define cups-pk-helper-service-type
1300   (service-type
1301    (name 'cups-pk-helper)
1302    (description
1303     "PolicyKit helper to configure CUPS with fine-grained privileges.")
1304    (extensions
1305     (list (service-extension dbus-root-service-type list)
1306           (service-extension polkit-service-type list)))
1307    (default-value cups-pk-helper)))
1308
1309 \f
1310 ;;;
1311 ;;; Scanner access via SANE.
1312 ;;;
1313
1314 (define %sane-accounts
1315   ;; The '60-libsane.rules' udev rules refers to the "scanner" group.
1316   (list (user-group (name "scanner") (system? #t))))
1317
1318 (define sane-service-type
1319   (service-type
1320    (name 'sane)
1321    (description
1322     "This service provides access to scanners @i{via}
1323 @uref{http://www.sane-project.org, SANE} by installing the necessary udev
1324 rules.")
1325    (default-value sane-backends-minimal)
1326    (extensions
1327     (list (service-extension udev-service-type list)
1328           (service-extension account-service-type
1329                              (const %sane-accounts))))))
1330
1331
1332 \f
1333 ;;;
1334 ;;; GNOME desktop service.
1335 ;;;
1336
1337 (define-record-type* <gnome-desktop-configuration> gnome-desktop-configuration
1338   make-gnome-desktop-configuration
1339   gnome-desktop-configuration?
1340   (gnome gnome-package (default gnome)))
1341
1342 (define (gnome-packages config packages)
1343   "Return the list of GNOME dependencies from CONFIG which names are part of
1344 the given PACKAGES list."
1345   (let ((gnome (gnome-package config)))
1346     (map (lambda (name)
1347            ((package-direct-input-selector name) gnome))
1348          packages)))
1349
1350 (define (gnome-udev-rules config)
1351   "Return the list of GNOME dependencies that provide udev rules."
1352   (gnome-packages config '("gnome-settings-daemon")))
1353
1354 (define (gnome-polkit-settings config)
1355   "Return the list of GNOME dependencies that provide polkit actions and
1356 rules."
1357   (gnome-packages config
1358                   '("gnome-settings-daemon"
1359                     "gnome-control-center"
1360                     "gnome-system-monitor"
1361                     "gvfs")))
1362
1363 (define gnome-desktop-service-type
1364   (service-type
1365    (name 'gnome-desktop)
1366    (extensions
1367     (list (service-extension udev-service-type
1368                              gnome-udev-rules)
1369           (service-extension polkit-service-type
1370                              gnome-polkit-settings)
1371           (service-extension profile-service-type
1372                              (compose list
1373                                       gnome-package))))
1374    (default-value (gnome-desktop-configuration))
1375    (description "Run the GNOME desktop environment.")))
1376
1377 (define-deprecated (gnome-desktop-service #:key (config
1378                                                  (gnome-desktop-configuration)))
1379   gnome-desktop-service-type
1380   "Return a service that adds the @code{gnome} package to the system profile,
1381 and extends polkit with the actions from @code{gnome-settings-daemon}."
1382   (service gnome-desktop-service-type config))
1383
1384 ;; MATE Desktop service.
1385 ;; TODO: Add mate-screensaver.
1386
1387 (define-record-type* <mate-desktop-configuration> mate-desktop-configuration
1388   make-mate-desktop-configuration
1389   mate-desktop-configuration?
1390   (mate-package mate-package (default mate)))
1391
1392 (define (mate-polkit-extension config)
1393   "Return the list of packages for CONFIG's MATE package that extend polkit."
1394   (let ((mate (mate-package config)))
1395     (map (lambda (input)
1396            ((package-direct-input-selector input) mate))
1397          '("mate-system-monitor"                  ;kill, renice processes
1398            "mate-settings-daemon"                 ;date/time settings
1399            "mate-power-manager"                   ;modify brightness
1400            "mate-control-center"                  ;RandR, display properties FIXME
1401            "mate-applets"))))                     ;CPU frequency scaling
1402
1403 (define mate-desktop-service-type
1404   (service-type
1405    (name 'mate-desktop)
1406    (extensions
1407     (list (service-extension polkit-service-type
1408                              mate-polkit-extension)
1409           (service-extension profile-service-type
1410                              (compose list
1411                                       mate-package))))
1412    (default-value (mate-desktop-configuration))
1413    (description "Run the MATE desktop environment.")))
1414
1415 (define-deprecated (mate-desktop-service #:key
1416                                          (config
1417                                           (mate-desktop-configuration)))
1418   mate-desktop-service-type
1419   "Return a service that adds the @code{mate} package to the system profile,
1420 and extends polkit with the actions from @code{mate-settings-daemon}."
1421   (service mate-desktop-service-type config))
1422
1423 \f
1424 ;;;
1425 ;;; XFCE desktop service.
1426 ;;;
1427
1428 (define-record-type* <xfce-desktop-configuration> xfce-desktop-configuration
1429   make-xfce-desktop-configuration
1430   xfce-desktop-configuration?
1431   (xfce xfce-package (default xfce)))
1432
1433 (define (xfce-polkit-settings config)
1434   "Return the list of XFCE dependencies that provide polkit actions and
1435 rules."
1436   (let ((xfce (xfce-package config)))
1437     (map (lambda (name)
1438            ((package-direct-input-selector name) xfce))
1439          '("thunar"
1440            "xfce4-power-manager"))))
1441
1442 (define xfce-desktop-service-type
1443   (service-type
1444    (name 'xfce-desktop)
1445    (extensions
1446     (list (service-extension polkit-service-type
1447                              xfce-polkit-settings)
1448           (service-extension profile-service-type
1449                              (compose list xfce-package))))
1450    (default-value (xfce-desktop-configuration))
1451    (description "Run the Xfce desktop environment.")))
1452
1453 (define-deprecated (xfce-desktop-service #:key (config
1454                                                 (xfce-desktop-configuration)))
1455   xfce-desktop-service-type
1456   "Return a service that adds the @code{xfce} package to the system profile,
1457 and extends polkit with the ability for @code{thunar} to manipulate the file
1458 system as root from within a user session, after the user has authenticated
1459 with the administrator's password."
1460   (service xfce-desktop-service-type config))
1461
1462 +\f
1463 ;;;
1464 ;;; Lxqt desktop service.
1465 ;;;
1466
1467 (define-record-type* <lxqt-desktop-configuration> lxqt-desktop-configuration
1468   make-lxqt-desktop-configuration
1469   lxqt-desktop-configuration?
1470   (lxqt lxqt-package
1471         (default lxqt)))
1472
1473 (define (lxqt-polkit-settings config)
1474   "Return the list of LXQt dependencies that provide polkit actions and
1475 rules."
1476   (let ((lxqt (lxqt-package config)))
1477     (map (lambda (name)
1478            ((package-direct-input-selector name) lxqt))
1479          '("lxqt-admin"))))
1480
1481 (define lxqt-desktop-service-type
1482   (service-type
1483    (name 'lxqt-desktop)
1484    (extensions
1485     (list (service-extension polkit-service-type
1486                              lxqt-polkit-settings)
1487           (service-extension profile-service-type
1488                              (compose list lxqt-package))))
1489    (default-value (lxqt-desktop-configuration))
1490    (description "Run LXQt desktop environment.")))
1491
1492 \f
1493 ;;;
1494 ;;; X11 socket directory service
1495 ;;;
1496
1497 (define x11-socket-directory-service
1498   ;; Return a service that creates /tmp/.X11-unix.  When using X11, libxcb
1499   ;; takes care of creating that directory.  However, when using XWayland, we
1500   ;; need to create beforehand.  Thus, create it unconditionally here.
1501   (simple-service 'x11-socket-directory
1502                   activation-service-type
1503                   (with-imported-modules '((guix build utils))
1504                     #~(begin
1505                         (use-modules (guix build utils))
1506                         (let ((directory "/tmp/.X11-unix"))
1507                           (mkdir-p directory)
1508                           (chmod directory #o1777))))))
1509 \f
1510 ;;;
1511 ;;; Enlightenment desktop service.
1512 ;;;
1513
1514 (define-record-type* <enlightenment-desktop-configuration>
1515   enlightenment-desktop-configuration make-enlightenment-desktop-configuration
1516   enlightenment-desktop-configuration?
1517   ;; <package>
1518   (enlightenment        enlightenment-package
1519                         (default enlightenment)))
1520
1521 (define (enlightenment-setuid-programs enlightenment-desktop-configuration)
1522   (match-record enlightenment-desktop-configuration
1523       <enlightenment-desktop-configuration>
1524     (enlightenment)
1525     (map file-like->setuid-program
1526          (list (file-append enlightenment
1527                             "/lib/enlightenment/utils/enlightenment_sys")
1528                (file-append enlightenment
1529                             "/lib/enlightenment/utils/enlightenment_system")
1530                (file-append enlightenment
1531                             "/lib/enlightenment/utils/enlightenment_ckpasswd")))))
1532
1533 (define enlightenment-desktop-service-type
1534   (service-type
1535    (name 'enlightenment-desktop)
1536    (extensions
1537     (list (service-extension dbus-root-service-type
1538                              (compose list
1539                                       (package-direct-input-selector
1540                                        "efl")
1541                                       enlightenment-package))
1542           (service-extension setuid-program-service-type
1543                              enlightenment-setuid-programs)
1544           (service-extension profile-service-type
1545                              (compose list
1546                                       enlightenment-package))))
1547    (default-value (enlightenment-desktop-configuration))
1548    (description
1549     "Return a service that adds the @code{enlightenment} package to the system
1550 profile, and extends dbus with the ability for @code{efl} to generate
1551 thumbnails and makes setuid the programs which enlightenment needs to function
1552 as expected.")))
1553
1554 \f
1555 ;;;
1556 ;;; inputattach-service-type
1557 ;;;
1558
1559 (define-record-type* <inputattach-configuration>
1560   inputattach-configuration
1561   make-inputattach-configuration
1562   inputattach-configuration?
1563   (device-type inputattach-configuration-device-type
1564                (default "wacom"))
1565   (device inputattach-configuration-device
1566           (default "/dev/ttyS0"))
1567   (baud-rate inputattach-configuration-baud-rate
1568              (default #f))
1569   (log-file inputattach-configuration-log-file
1570             (default #f)))
1571
1572 (define inputattach-shepherd-service
1573   (match-lambda
1574     (($ <inputattach-configuration> type device baud-rate log-file)
1575      (let ((args (append (if baud-rate
1576                              (list "--baud" (number->string baud-rate))
1577                              '())
1578                          (list (string-append "--" type)
1579                                device))))
1580        (list (shepherd-service
1581               (provision '(inputattach))
1582               (requirement '(udev))
1583               (documentation "inputattach daemon")
1584               (start #~(make-forkexec-constructor
1585                         (cons (string-append #$inputattach
1586                                              "/bin/inputattach")
1587                               (quote #$args))
1588                         #:log-file #$log-file))
1589               (stop #~(make-kill-destructor))))))))
1590
1591 (define inputattach-service-type
1592   (service-type
1593    (name 'inputattach)
1594    (extensions
1595     (list (service-extension shepherd-root-service-type
1596                              inputattach-shepherd-service)))
1597    (default-value (inputattach-configuration))
1598    (description "Return a service that runs inputattach on a device and
1599 dispatches events from it.")))
1600
1601 \f
1602 ;;;
1603 ;;; gnome-keyring-service-type
1604 ;;;
1605
1606 (define-record-type* <gnome-keyring-configuration> gnome-keyring-configuration
1607   make-gnome-keyring-configuration
1608   gnome-keyring-configuration?
1609   (keyring gnome-keyring-package (default gnome-keyring))
1610   (pam-services gnome-keyring-pam-services (default '(("gdm-password" . login)
1611                                                       ("passwd" . passwd)))))
1612
1613 (define (pam-gnome-keyring config)
1614   (define (%pam-keyring-entry . arguments)
1615     (pam-entry
1616      (control "optional")
1617      (module (file-append (gnome-keyring-package config)
1618                           "/lib/security/pam_gnome_keyring.so"))
1619      (arguments arguments)))
1620
1621   (list
1622    (lambda (service)
1623      (case (assoc-ref (gnome-keyring-pam-services config)
1624                       (pam-service-name service))
1625        ((login)
1626         (pam-service
1627          (inherit service)
1628          (auth (append (pam-service-auth service)
1629                        (list (%pam-keyring-entry))))
1630          (session (append (pam-service-session service)
1631                           (list (%pam-keyring-entry "auto_start"))))))
1632        ((passwd)
1633         (pam-service
1634          (inherit service)
1635          (password (append (pam-service-password service)
1636                            (list (%pam-keyring-entry))))))
1637        (else service)))))
1638
1639 (define gnome-keyring-service-type
1640   (service-type
1641    (name 'gnome-keyring)
1642    (extensions (list
1643                 (service-extension pam-root-service-type pam-gnome-keyring)))
1644    (default-value (gnome-keyring-configuration))
1645    (description "Return a service, that adds the @code{gnome-keyring} package
1646 to the system profile and extends PAM with entries using
1647 @code{pam_gnome_keyring.so}, unlocking a user's login keyring when they log in
1648 or setting its password with passwd.")))
1649
1650 \f
1651 ;;;
1652 ;;; polkit-wheel-service -- Allow wheel group to perform admin actions
1653 ;;;
1654
1655 (define polkit-wheel
1656   (file-union
1657    "polkit-wheel"
1658    `(("share/polkit-1/rules.d/wheel.rules"
1659       ,(plain-file
1660         "wheel.rules"
1661         "polkit.addAdminRule(function(action, subject) {
1662     return [\"unix-group:wheel\"];
1663 });
1664 ")))))
1665
1666 (define polkit-wheel-service
1667   (simple-service 'polkit-wheel polkit-service-type (list polkit-wheel)))
1668
1669 \f
1670 ;;;
1671 ;;; seatd-service-type -- minimal seat management daemon
1672 ;;;
1673
1674 (define (seatd-group-sanitizer group-or-name)
1675   (match group-or-name
1676     ((? user-group? group) group)
1677     ((? string? group-name) (user-group (name group-name) (system? #t)))
1678     (_ (leave (G_ "seatd: '~a' is not a valid group~%") group-or-name))))
1679
1680 (define-record-type* <seatd-configuration> seatd-configuration
1681   make-seatd-configuration
1682   seatd-configuration?
1683   (seatd seatd-package (default seatd))
1684   (group seatd-group                    ; string | <user-group>
1685          (default "seat")
1686          (sanitize seatd-group-sanitizer))
1687   (socket seatd-socket (default "/run/seatd.sock"))
1688   (logfile seatd-logfile (default "/var/log/seatd.log"))
1689   (loglevel seatd-loglevel (default "info")))
1690
1691 (define (seatd-shepherd-service config)
1692   (list (shepherd-service
1693          (documentation "Minimal seat management daemon")
1694          (requirement '())
1695          ;; TODO: once cgroups is separate dependency
1696          ;; here we should depend on it rather than elogind
1697          (provision '(seatd elogind))
1698          (start #~(make-forkexec-constructor
1699                    (list #$(file-append (seatd-package config) "/bin/seatd")
1700                          "-g" #$(user-group-name (seatd-group config)))
1701                    #:environment-variables
1702                    (list (string-append "SEATD_LOGLEVEL="
1703                                         #$(seatd-loglevel config))
1704                          (string-append "SEATD_DEFAULTPATH="
1705                                         #$(seatd-socket config)))
1706                    #:log-file #$(seatd-logfile config)))
1707          (stop #~(make-kill-destructor)))))
1708
1709 (define seatd-accounts
1710   (match-lambda (($ <seatd-configuration> _ group) (list group))))
1711
1712 (define seatd-environment
1713   (match-lambda
1714     (($ <seatd-configuration> _ _ socket)
1715      `(("SEATD_SOCK" . ,socket)))))
1716
1717 (define seatd-service-type
1718   (service-type
1719    (name 'seatd)
1720    (description "Seat management takes care of mediating access
1721 to shared devices (graphics, input), without requiring the
1722 applications needing access to be root.")
1723    (extensions
1724     (list
1725      (service-extension account-service-type seatd-accounts)
1726      (service-extension session-environment-service-type seatd-environment)
1727      ;; TODO: once cgroups is separate dependency we should not mount it here
1728      ;; for now it is mounted here, because elogind mounts it
1729      (service-extension file-system-service-type (const %control-groups))
1730      (service-extension shepherd-root-service-type seatd-shepherd-service)))
1731    (default-value (seatd-configuration))))
1732
1733 \f
1734 ;;;
1735 ;;; The default set of desktop services.
1736 ;;;
1737
1738 (define* (desktop-services-for-system #:optional
1739                                       (system (or (%current-target-system)
1740                                                   (%current-system))))
1741   ;; List of services typically useful for a "desktop" use case.
1742
1743   ;; Since GDM depends on Rust (gdm -> gnome-shell -> gjs -> mozjs -> rust)
1744   ;; and Rust is currently unavailable on non-x86_64 platforms, default to
1745   ;; SDDM there (FIXME).
1746   (cons* (if (string-prefix? "x86_64" system)
1747              (service gdm-service-type)
1748              (service sddm-service-type))
1749
1750          ;; Screen lockers are a pretty useful thing and these are small.
1751          (screen-locker-service slock)
1752          (screen-locker-service xlockmore "xlock")
1753
1754          ;; Add udev rules for MTP devices so that non-root users can access
1755          ;; them.
1756          (simple-service 'mtp udev-service-type (list libmtp))
1757          ;; Add udev rules for scanners.
1758          (service sane-service-type)
1759          ;; Add polkit rules, so that non-root users in the wheel group can
1760          ;; perform administrative tasks (similar to "sudo").
1761          polkit-wheel-service
1762
1763          ;; Allow desktop users to also mount NTFS and NFS file systems
1764          ;; without root.
1765          (simple-service 'mount-setuid-helpers setuid-program-service-type
1766                          (map (lambda (program)
1767                                 (setuid-program
1768                                  (program program)))
1769                               (list (file-append nfs-utils "/sbin/mount.nfs")
1770                                (file-append ntfs-3g "/sbin/mount.ntfs-3g"))))
1771
1772          ;; This is a volatile read-write file system mounted at /var/lib/gdm,
1773          ;; to avoid GDM stale cache and permission issues.
1774          gdm-file-system-service
1775
1776          ;; The global fontconfig cache directory can sometimes contain
1777          ;; stale entries, possibly referencing fonts that have been GC'd,
1778          ;; so mount it read-only.
1779          fontconfig-file-system-service
1780
1781          ;; NetworkManager and its applet.
1782          (service network-manager-service-type)
1783          (service wpa-supplicant-service-type)    ;needed by NetworkManager
1784          (simple-service 'network-manager-applet
1785                          profile-service-type
1786                          (list network-manager-applet))
1787          (service modem-manager-service-type)
1788          (service usb-modeswitch-service-type)
1789
1790          ;; The D-Bus clique.
1791          (service avahi-service-type)
1792          (udisks-service)
1793          (service upower-service-type)
1794          (accountsservice-service)
1795          (service cups-pk-helper-service-type)
1796          (service colord-service-type)
1797          (geoclue-service)
1798          (service polkit-service-type)
1799          (elogind-service)
1800          (dbus-service)
1801
1802          (service ntp-service-type)
1803
1804          x11-socket-directory-service
1805
1806          (service pulseaudio-service-type)
1807          (service alsa-service-type)
1808
1809          %base-services))
1810
1811 (define-syntax %desktop-services
1812   (identifier-syntax (desktop-services-for-system)))
1813
1814 ;;; desktop.scm ends here