gnu/services/desktop.scm

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