gnu/services/desktop.scm

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