gnu: Add openjdk12.
[jackhill/guix/guix.git] / gnu / services / desktop.scm
index 8f8e177..343d507 100644 (file)
@@ -4,7 +4,7 @@
 ;;; 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>
@@ -84,6 +84,7 @@
             udisks-service
             udisks-service-type
 
+            colord-service-type
             colord-service
 
             geoclue-application
@@ -93,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
       ((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.
@@ -257,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."
@@ -389,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))
@@ -490,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
@@ -544,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
@@ -742,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
@@ -884,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))
@@ -942,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
@@ -1072,7 +1050,7 @@ dispatches events from it.")))
 
 (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)
@@ -1082,9 +1060,16 @@ dispatches events from it.")))
          ;; 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)
          (service upower-service-type)