gnu/services/desktop.scm

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