gnu: Add GeoClue desktop service.

* gnu/services/desktop.scm (bool): New top-level helper.
  (upower-configuration-file): Use top-level `bool'.
  (geoclue-application): New public function.
  (%standard-geoclue-applications): New public variable.
  (geoclue-service): New public variable.
  (%desktop-services): Add GeoClue.  Add a comment about activation.
* doc/guix.texi (Desktop Services): Document the GeoClue service.

Signed-off-by: Ludovic Courtès <ludo@gnu.org>

2 files changed, 150 insertions, 7 deletions

diff --git a/doc/guix.texi b/doc/guix.texi
index 6875f22e86..f05376efcf 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -5867,9 +5867,10 @@ adds or adjust services for a typical ``desktop'' setup.
 In particular, it adds a graphical login manager (@pxref{X Window,
 @code{slim-service}}), a network management tool (@pxref{Networking
 Services, @code{wicd-service}}), energy and color management services,
-an NTP client (@pxref{Networking Services}), the Avahi
-daemon, and has the name service switch service configured to be able to
-use @code{nss-mdns} (@pxref{Name Service Switch, mDNS}).
+the GeoClue location service, an NTP client (@pxref{Networking
+Services}), the Avahi daemon, and has the name service switch service
+configured to be able to use @code{nss-mdns} (@pxref{Name Service
+Switch, mDNS}).
 @end defvr
 
 The @var{%desktop-services} variable can be used as the @code{services}
@@ -5921,6 +5922,41 @@ tool.  See @uref{http://www.freedesktop.org/software/colord/, the colord web
 site} for more information.
 @end deffn
 
+@deffn {Scheme Procedure} geoclue-application name [#:allowed? #t] [#:system? #f] [#:users '()]
+Return an configuration allowing an application to access GeoClue
+location data.  @var{name} is the Desktop ID of the application, without
+the @code{.desktop} part.  If @var{allowed?} is true, the application
+will have access to location information by default.  The boolean
+@var{system?}  value indicates that an application is a system component
+or not.  Finally @var{users} is a list of UIDs of all users for which
+this application is allowed location info access.  An empty users list
+means that all users are allowed.
+@end deffn
+
+@defvr {Scheme Variable} %standard-geoclue-applications
+The standard list of well-known GeoClue application configurations,
+granting authority to GNOME's date-and-time utility to ask for the
+current location in order to set the time zone, and allowing the Firefox
+(IceCat) and Epiphany web browsers to request location information.
+Firefox and Epiphany both query the user before allowing a web page to
+know the user's location.
+@end defvr
+
+@deffn {Monadic Procedure} geoclue-service [#:colord @var{colord}] @
+                         [#:whitelist '()] @
+                         [#:wifi-geolocation-url "https://location.services.mozilla.com/v1/geolocate?key=geoclue"] @
+                         [#:submit-data? #f]
+                         [#:wifi-submission-url "https://location.services.mozilla.com/v1/submit?key=geoclue"] @
+                         [#:submission-nick "geoclue"] @
+                         [#:applications %standard-geoclue-applications]
+Return a service that runs the GeoClue location service.  This service
+provides a D-Bus interface to allow applications to request access to a
+user's physical location, and optionally to add information to online
+location databases.  See
+@uref{https://wiki.freedesktop.org/www/Software/GeoClue/, the GeoClue
+web site} for more information.
+@end deffn
+
 @node Database Services
 @subsubsection Database Services
 
diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index 7ed62d07b5..4e4b49df3e 100644
--- a/gnu/services/desktop.scm
+++ b/gnu/services/desktop.scm
@@ -36,6 +36,9 @@
   #:export (dbus-service
             upower-service
             colord-service
+            geoclue-application
+            %standard-geoclue-applications
+            geoclue-service
             %desktop-services))
 
 ;;; Commentary:
@@ -46,6 +49,14 @@
 
 
 ;;;
+;;; Helpers.
+;;;
+
+(define (bool value)
+  (if value "true\n" "false\n"))
+
+
+;;;
 ;;; D-Bus.
 ;;;
 
@@ -154,9 +165,6 @@ and policy files.  For example, to allow avahi-daemon to use the system bus,
                                     time-critical time-action
                                     critical-power-action)
   "Return an upower-daemon configuration file."
-  (define (bool value)
-    (if value "true\n" "false\n"))
-
   (text-file "UPower.conf"
              (string-append
               "[UPower]\n"
@@ -274,6 +282,100 @@ site} for more information."
                             (shell
                              #~(string-append #$shadow "/sbin/nologin")))))))))
 
+
+;;;
+;;; GeoClue D-Bus service.
+;;;
+
+(define* (geoclue-application name #:key (allowed? #t) system? (users '()))
+  "Configure default GeoClue access permissions for an application.  NAME is
+the Desktop ID of the application, without the .desktop part.  If ALLOWED? is
+true, the application will have access to location information by default.
+The boolean SYSTEM? value indicates that an application is a system component
+or not.  Finally USERS is a list of UIDs of all users for which this
+application is allowed location info access.  An empty users list means all
+users are allowed."
+  (string-append
+   "[" name "]\n"
+   "allowed=" (bool allowed?)
+   "system=" (bool system?)
+   "users=" (string-join users ";") "\n"))
+
+(define %standard-geoclue-applications
+  (list (geoclue-application "gnome-datetime-panel" #:system? #t)
+        (geoclue-application "epiphany" #:system? #f)
+        (geoclue-application "firefox" #:system? #f)))
+
+(define* (geoclue-configuration-file #:key whitelist wifi-geolocation-url
+                                     submit-data?
+                                     wifi-submission-url submission-nick
+                                     applications)
+  "Return a geoclue configuration file."
+  (text-file "geoclue.conf"
+             (string-append
+              "[agent]\n"
+              "whitelist=" (string-join whitelist ";") "\n"
+              "[wifi]\n"
+              "url=" wifi-geolocation-url "\n"
+              "submit-data=" (bool submit-data?)
+              "submission-url=" wifi-submission-url "\n"
+              "submission-nick=" submission-nick "\n"
+              (string-join applications "\n"))))
+
+(define* (geoclue-service #:key (geoclue geoclue)
+                          (whitelist '())
+                          (wifi-geolocation-url
+                           ;; Mozilla geolocation service:
+                           "https://location.services.mozilla.com/v1/geolocate?key=geoclue")
+                          (submit-data? #f)
+                          (wifi-submission-url
+                           "https://location.services.mozilla.com/v1/submit?key=geoclue")
+                          (submission-nick "geoclue")
+                          (applications %standard-geoclue-applications))
+  "Return a service that runs the @command{geoclue} location service.  This
+service provides a D-Bus interface to allow applications to request access to
+a user's physical location, and optionally to add information to online
+location databases.  By default, only the GNOME date-time panel and the Icecat
+and Epiphany web browsers are able to ask for the user's location, and in the
+case of Icecat and Epiphany, both will ask the user for permission first.  See
+@uref{https://wiki.freedesktop.org/www/Software/GeoClue/, the geoclue web
+site} for more information."
+  (mlet %store-monad ((config (geoclue-configuration-file
+                               #:whitelist whitelist
+                               #:wifi-geolocation-url wifi-geolocation-url
+                               #:submit-data? submit-data?
+                               #:wifi-submission-url wifi-submission-url
+                               #:submission-nick submission-nick
+                               #:applications applications)))
+    (return
+     (service
+      (documentation "Run the GeoClue location service.")
+      (provision '(geoclue-daemon))
+      (requirement '(dbus-system))
+
+      (start #~(make-forkexec-constructor
+                (list (string-append #$geoclue "/libexec/geoclue"))
+                #:user "geoclue"
+                #:environment-variables
+                (list (string-append "GEOCLUE_CONFIG_FILE=" #$config))))
+      (stop #~(make-kill-destructor))
+
+      (user-groups (list (user-group
+                          (name "geoclue")
+                          (system? #t))))
+      (user-accounts (list (user-account
+                            (name "geoclue")
+                            (group "geoclue")
+                            (system? #t)
+                            (comment "GeoClue daemon user")
+                            (home-directory "/var/empty")
+                            (shell
+                             "/run/current-system/profile/sbin/nologin"))))))))
+
+
+;;;
+;;; The default set of desktop services.
+;;;
 (define %desktop-services
   ;; List of services typically useful for a "desktop" use case.
   (cons* (slim-service)
@@ -281,8 +383,13 @@ site} for more information."
          (avahi-service)
          (wicd-service)
          (upower-service)
+         ;; FIXME: The colord and geoclue services could all be bus-activated
+         ;; by default, so they don't run at program startup.  However, user
+         ;; creation and /var/lib.colord creation happen at service activation
+         ;; time, so we currently add them to the set of default services.
          (colord-service)
-         (dbus-service (list avahi wicd upower colord))
+         (geoclue-service)
+         (dbus-service (list avahi wicd upower colord geoclue))
 
          (ntp-service)