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>
This commit is contained in:
Andy Wingo 2015-08-15 21:36:22 +02:00 committed by Ludovic Courtès
parent 4006fd87b5
commit cee32ee4d3
2 changed files with 150 additions and 7 deletions

View file

@ -5867,9 +5867,10 @@ adds or adjust services for a typical ``desktop'' setup.
In particular, it adds a graphical login manager (@pxref{X Window, In particular, it adds a graphical login manager (@pxref{X Window,
@code{slim-service}}), a network management tool (@pxref{Networking @code{slim-service}}), a network management tool (@pxref{Networking
Services, @code{wicd-service}}), energy and color management services, Services, @code{wicd-service}}), energy and color management services,
an NTP client (@pxref{Networking Services}), the Avahi the GeoClue location service, an NTP client (@pxref{Networking
daemon, and has the name service switch service configured to be able to Services}), the Avahi daemon, and has the name service switch service
use @code{nss-mdns} (@pxref{Name Service Switch, mDNS}). configured to be able to use @code{nss-mdns} (@pxref{Name Service
Switch, mDNS}).
@end defvr @end defvr
The @var{%desktop-services} variable can be used as the @code{services} 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. site} for more information.
@end deffn @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 @node Database Services
@subsubsection Database Services @subsubsection Database Services

View file

@ -36,6 +36,9 @@ (define-module (gnu services desktop)
#:export (dbus-service #:export (dbus-service
upower-service upower-service
colord-service colord-service
geoclue-application
%standard-geoclue-applications
geoclue-service
%desktop-services)) %desktop-services))
;;; Commentary: ;;; Commentary:
@ -44,6 +47,14 @@ (define-module (gnu services desktop)
;;; ;;;
;;; Code: ;;; Code:
;;;
;;; Helpers.
;;;
(define (bool value)
(if value "true\n" "false\n"))
;;; ;;;
;;; D-Bus. ;;; D-Bus.
@ -154,9 +165,6 @@ (define* (upower-configuration-file #:key watts-up-pro? poll-batteries?
time-critical time-action time-critical time-action
critical-power-action) critical-power-action)
"Return an upower-daemon configuration file." "Return an upower-daemon configuration file."
(define (bool value)
(if value "true\n" "false\n"))
(text-file "UPower.conf" (text-file "UPower.conf"
(string-append (string-append
"[UPower]\n" "[UPower]\n"
@ -274,6 +282,100 @@ (define* (colord-service #:key (colord colord))
(shell (shell
#~(string-append #$shadow "/sbin/nologin"))))))))) #~(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 (define %desktop-services
;; List of services typically useful for a "desktop" use case. ;; List of services typically useful for a "desktop" use case.
(cons* (slim-service) (cons* (slim-service)
@ -281,8 +383,13 @@ (define %desktop-services
(avahi-service) (avahi-service)
(wicd-service) (wicd-service)
(upower-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) (colord-service)
(dbus-service (list avahi wicd upower colord)) (geoclue-service)
(dbus-service (list avahi wicd upower colord geoclue))
(ntp-service) (ntp-service)