services: urandom-seed: Credit the entropy added to the PRNG.
[jackhill/guix/guix.git] / gnu / services / desktop.scm
index df6764d..a32756e 100644 (file)
@@ -4,10 +4,11 @@
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2016 Sou Bunnbu <iyzsong@gmail.com>
 ;;; Copyright © 2017 Maxim Cournoyer <maxim.cournoyer@gmail.com>
-;;; Copyright © 2017 Nils Gillmann <ng0@n0.is>
+;;; Copyright © 2017 ng0 <ng0@n0.is>
 ;;; Copyright © 2018 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2017, 2019 Christopher Baines <mail@cbaines.net>
+;;; Copyright © 2019 Tim Gesthuizen <tim.gesthuizen@yahoo.de>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -51,6 +52,7 @@
   #:use-module (gnu packages libusb)
   #:use-module (gnu packages mate)
   #:use-module (gnu packages enlightenment)
+  #:use-module (guix deprecation)
   #:use-module (guix records)
   #:use-module (guix packages)
   #:use-module (guix store)
@@ -82,6 +84,7 @@
             udisks-service
             udisks-service-type
 
+            colord-service-type
             colord-service
 
             geoclue-application
@@ -91,6 +94,9 @@
             geoclue-service
             geoclue-service-type
 
+            bluetooth-service-type
+            bluetooth-configuration
+            bluetooth-configuration?
             bluetooth-service
 
             elogind-configuration
             accountsservice-service-type
             accountsservice-service
 
+            cups-pk-helper-service-type
+
             gnome-desktop-configuration
             gnome-desktop-configuration?
             gnome-desktop-service
             enlightenment-desktop-configuration?
             enlightenment-desktop-service-type
 
+            inputattach-configuration
+            inputattach-configuration?
+            inputattach-service-type
+
             %desktop-services))
 
 ;;; Commentary:
       ((package . _) package))))
 
 
-(define (wrapped-dbus-service service program variable value)
-  "Return a wrapper for @var{service}, a package containing a D-Bus service,
-where @var{program} is wrapped such that environment variable @var{variable}
-is set to @var{value} when the bus daemon launches it."
-  (define wrapper
-    (program-file (string-append (package-name service) "-program-wrapper")
-                  #~(begin
-                      (setenv #$variable #$value)
-                      (apply execl (string-append #$service "/" #$program)
-                             (string-append #$service "/" #$program)
-                             (cdr (command-line))))))
-
-  (define build
-    (with-imported-modules '((guix build utils))
-      #~(begin
-          (use-modules (guix build utils))
-
-          (define service-directory
-            "/share/dbus-1/system-services")
-
-          (mkdir-p (dirname (string-append #$output
-                                           service-directory)))
-          (copy-recursively (string-append #$service
-                                           service-directory)
-                            (string-append #$output
-                                           service-directory))
-          (symlink (string-append #$service "/etc") ;for etc/dbus-1
-                   (string-append #$output "/etc"))
-
-          (for-each (lambda (file)
-                      (substitute* file
-                        (("Exec[[:blank:]]*=[[:blank:]]*([[:graph:]]+)(.*)$"
-                          _ original-program arguments)
-                         (string-append "Exec=" #$wrapper arguments
-                                        "\n"))))
-                    (find-files #$output "\\.service$")))))
-
-  (computed-file (string-append (package-name service) "-wrapper")
-                 build))
-
 \f
 ;;;
 ;;; Upower D-Bus service.
@@ -251,8 +223,8 @@ is set to @var{value} when the bus daemon launches it."
 (define (upower-dbus-service config)
   (list (wrapped-dbus-service (upower-configuration-upower config)
                               "libexec/upowerd"
-                              "UPOWER_CONF_FILE_NAME"
-                              (upower-configuration-file config))))
+                              `(("UPOWER_CONF_FILE_NAME"
+                                 ,(upower-configuration-file config))))))
 
 (define (upower-shepherd-service config)
   "Return a shepherd service for UPower with CONFIG."
@@ -273,6 +245,11 @@ is set to @var{value} when the bus daemon launches it."
 (define upower-service-type
   (let ((upower-package (compose list upower-configuration-upower)))
     (service-type (name 'upower)
+                  (description
+                   "Run @command{upowerd}}, a system-wide monitor for power
+consumption and battery levels, with the given configuration settings.  It
+implements the @code{org.freedesktop.UPower} D-Bus interface, and is notably
+used by GNOME.")
                   (extensions
                    (list (service-extension dbus-root-service-type
                                             upower-dbus-service)
@@ -285,20 +262,22 @@ is set to @var{value} when the bus daemon launches it."
 
                          ;; Make the 'upower' command visible.
                          (service-extension profile-service-type
-                                            upower-package))))))
-
-(define* (upower-service #:key (upower upower)
-                         (watts-up-pro? #f)
-                         (poll-batteries? #t)
-                         (ignore-lid? #f)
-                         (use-percentage-for-policy? #f)
-                         (percentage-low 10)
-                         (percentage-critical 3)
-                         (percentage-action 2)
-                         (time-low 1200)
-                         (time-critical 300)
-                         (time-action 120)
-                         (critical-power-action 'hybrid-sleep))
+                                            upower-package)))
+                  (default-value (upower-configuration)))))
+
+(define-deprecated (upower-service #:key (upower upower)
+                                   (watts-up-pro? #f)
+                                   (poll-batteries? #t)
+                                   (ignore-lid? #f)
+                                   (use-percentage-for-policy? #f)
+                                   (percentage-low 10)
+                                   (percentage-critical 3)
+                                   (percentage-action 2)
+                                   (time-low 1200)
+                                   (time-critical 300)
+                                   (time-action 120)
+                                   (critical-power-action 'hybrid-sleep))
+  upower-service-type
   "Return a service that runs @uref{http://upower.freedesktop.org/,
 @command{upowerd}}, a system-wide monitor for power consumption and battery
 levels, with the given configuration settings.  It implements the
@@ -376,8 +355,8 @@ users are allowed."
 (define (geoclue-dbus-service config)
   (list (wrapped-dbus-service (geoclue-configuration-geoclue config)
                               "libexec/geoclue"
-                              "GEOCLUE_CONFIG_FILE"
-                              (geoclue-configuration-file config))))
+                              `(("GEOCLUE_CONFIG_FILE"
+                                 ,(geoclue-configuration-file config))))))
 
 (define %geoclue-accounts
   (list (user-group (name "geoclue") (system? #t))
@@ -477,7 +456,9 @@ site} for more information."
                                `(("bluetooth"
                                   ,(bluetooth-directory config)))))
           (service-extension shepherd-root-service-type
-                             (compose list bluetooth-shepherd-service))))))
+                             (compose list bluetooth-shepherd-service))))
+   (description "Run the @command{bluetoothd} daemon, which manages all the
+Bluetooth devices and provides a number of D-Bus interfaces.")))
 
 (define* (bluetooth-service #:key (bluez bluez) (auto-enable? #f))
   "Return a service that runs the @command{bluetoothd} daemon, which manages
@@ -531,7 +512,11 @@ Users need to be in the @code{lp} group to access the D-Bus service.
                        (service-extension udev-service-type list)
 
                        ;; It provides polkit "actions".
-                       (service-extension polkit-service-type list)))))
+                       (service-extension polkit-service-type list)))
+                (description
+                 "Run @command{colord}, a system service with a D-Bus
+interface to manage the color profiles of input and output devices such as
+screens and scanners.")))
 
 (define* (colord-service #:key (colord colord))
   "Return a service that runs @command{colord}, a system service with a D-Bus
@@ -729,8 +714,8 @@ include the @command{udisksctl} command, part of UDisks, and GNOME Disks."
 (define (elogind-dbus-service config)
   (list (wrapped-dbus-service (elogind-package config)
                               "libexec/elogind/elogind"
-                              "ELOGIND_CONF_FILE"
-                              (elogind-configuration-file config))))
+                              `(("ELOGIND_CONF_FILE"
+                                 ,(elogind-configuration-file config))))))
 
 (define (pam-extension-procedure config)
   "Return an extension for PAM-ROOT-SERVICE-TYPE that ensures that all the PAM
@@ -871,9 +856,12 @@ rules."
           (service-extension profile-service-type
                              (compose list
                                       gnome-package))))
+   (default-value (gnome-desktop-configuration))
    (description "Run the GNOME desktop environment.")))
 
-(define* (gnome-desktop-service #:key (config (gnome-desktop-configuration)))
+(define-deprecated (gnome-desktop-service #:key (config
+                                                 (gnome-desktop-configuration)))
+  gnome-desktop-service-type
   "Return a service that adds the @code{gnome} package to the system profile,
 and extends polkit with the actions from @code{gnome-settings-daemon}."
   (service gnome-desktop-service-type config))
@@ -898,9 +886,13 @@ and extends polkit with the actions from @code{gnome-settings-daemon}."
           (service-extension profile-service-type
                              (compose list
                                       mate-package))))
+   (default-value (mate-desktop-configuration))
    (description "Run the MATE desktop environment.")))
 
-(define* (mate-desktop-service #:key (config (mate-desktop-configuration)))
+(define-deprecated (mate-desktop-service #:key
+                                         (config
+                                          (mate-desktop-configuration)))
+  mate-desktop-service-type
   "Return a service that adds the @code{mate} package to the system profile,
 and extends polkit with the actions from @code{mate-settings-daemon}."
   (service mate-desktop-service-type config))
@@ -925,10 +917,13 @@ and extends polkit with the actions from @code{mate-settings-daemon}."
                                        "thunar")
                                       xfce-package))
           (service-extension profile-service-type
-                             (compose list
-                                      xfce-package))))))
+                             (compose list xfce-package))))
+   (default-value (xfce-desktop-configuration))
+   (description "Run the Xfce desktop environment.")))
 
-(define* (xfce-desktop-service #:key (config (xfce-desktop-configuration)))
+(define-deprecated (xfce-desktop-service #:key (config
+                                                (xfce-desktop-configuration)))
+  xfce-desktop-service-type
   "Return a service that adds the @code{xfce} package to the system profile,
 and extends polkit with the ability for @code{thunar} to manipulate the file
 system as root from within a user session, after the user has authenticated
@@ -968,23 +963,29 @@ with the administrator's password."
   (match-record enlightenment-desktop-configuration
                 <enlightenment-desktop-configuration>
                 (enlightenment)
-    (list (file-append enlightenment
-                       "/lib/enlightenment/utils/enlightenment_sys")
-          (file-append enlightenment
-                       "/lib/enlightenment/utils/enlightenment_backlight")
-          ;; TODO: Move this binary to a screen-locker service.
-          (file-append enlightenment
-                       "/lib/enlightenment/utils/enlightenment_ckpasswd")
-          (file-append enlightenment
-                       (string-append
-                         "/lib/enlightenment/modules/cpufreq/"
-                         (match (string-tokenize (%current-system)
-                                                 (char-set-complement (char-set #\-)))
-                                ((arch "linux") (string-append "linux-gnu-" arch))
-                                ((arch "gnu")   (string-append "gnu-" arch)))
-                         "-"
-                         (version-major+minor (package-version enlightenment))
-                         "/freqset")))))
+    (let ((module-arch (match (string-tokenize (%current-system)
+                                               (char-set-complement (char-set #\-)))
+                              ((arch "linux") (string-append "linux-gnu-" arch))
+                              ((arch "gnu")   (string-append "gnu-" arch)))))
+      (list (file-append enlightenment
+                         "/lib/enlightenment/utils/enlightenment_sys")
+            (file-append enlightenment
+                         "/lib/enlightenment/utils/enlightenment_backlight")
+            ;; TODO: Move this binary to a screen-locker service.
+            (file-append enlightenment
+                         "/lib/enlightenment/utils/enlightenment_ckpasswd")
+            (file-append enlightenment
+                         (string-append
+                           "/lib/enlightenment/modules/cpufreq/"
+                           module-arch "-"
+                           (package-version enlightenment)
+                           "/freqset"))
+            (file-append enlightenment
+                         (string-append
+                           "/lib/enlightenment/modules/sysinfo/"
+                           module-arch "-"
+                           (package-version enlightenment)
+                           "/cpuclock_sysfs"))))))
 
 (define enlightenment-desktop-service-type
   (service-type
@@ -1008,13 +1009,54 @@ thumbnails and makes setuid the programs which enlightenment needs to function
 as expected.")))
 
 \f
+;;;
+;;; inputattach-service-type
+;;;
+
+(define-record-type* <inputattach-configuration>
+  inputattach-configuration
+  make-inputattach-configuration
+  inputattach-configuration?
+  (device-type inputattach-configuration-device-type
+               (default "wacom"))
+  (device inputattach-configuration-device
+          (default "/dev/ttyS0"))
+  (log-file inputattach-configuration-log-file
+            (default #f)))
+
+(define inputattach-shepherd-service
+  (match-lambda
+    (($ <inputattach-configuration> type device log-file)
+     (list (shepherd-service
+            (provision '(inputattach))
+            (requirement '(udev))
+            (documentation "inputattach daemon")
+            (start #~(make-forkexec-constructor
+                      (list (string-append #$inputattach
+                                           "/bin/inputattach")
+                            (string-append "--" #$type)
+                            #$device)
+                      #:log-file #$log-file))
+            (stop #~(make-kill-destructor)))))))
+
+(define inputattach-service-type
+  (service-type
+   (name 'inputattach)
+   (extensions
+    (list (service-extension shepherd-root-service-type
+                             inputattach-shepherd-service)))
+   (default-value (inputattach-configuration))
+   (description "Return a service that runs inputattach on a device and
+dispatches events from it.")))
+
+\f
 ;;;
 ;;; The default set of desktop services.
 ;;;
 
 (define %desktop-services
   ;; List of services typically useful for a "desktop" use case.
-  (cons* (service slim-service-type)
+  (cons* (service gdm-service-type)
 
          ;; Screen lockers are a pretty useful thing and these are small.
          (screen-locker-service slock)
@@ -1024,12 +1066,19 @@ as expected.")))
          ;; them.
          (simple-service 'mtp udev-service-type (list libmtp))
 
-         ;; The D-Bus clique.
+         ;; NetworkManager and its applet.
          (service network-manager-service-type)
          (service wpa-supplicant-service-type)    ;needed by NetworkManager
+         (simple-service 'network-manager-applet
+                         profile-service-type
+                         (list network-manager-applet))
+         (service modem-manager-service-type)
+         (service usb-modeswitch-service-type)
+
+         ;; The D-Bus clique.
          (service avahi-service-type)
          (udisks-service)
-         (upower-service)
+         (service upower-service-type)
          (accountsservice-service)
          (service cups-pk-helper-service-type)
          (colord-service)