gnu/services/desktop.scm

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