aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2019-04-02 21:36:26 +0200
committerLudovic Courtès <ludo@gnu.org>2019-04-05 15:39:35 +0200
commitb68f65007f50175a68cd174ad7c1036cf622556d (patch)
treea59158b7e4542d19a3eff8b1eb81975bc04df47f
parent208946e1f3ac76bf64ce625e059614c87f9cee4c (diff)
downloadpatches-b68f65007f50175a68cd174ad7c1036cf622556d.tar
patches-b68f65007f50175a68cd174ad7c1036cf622556d.tar.gz
services: dbus: Add 'wrapped-dbus-service'.
* gnu/services/desktop.scm (wrapped-dbus-service): Move to... * gnu/services/dbus.scm (wrapped-dbus-service): ... here. New procedure.
-rw-r--r--gnu/services/dbus.scm42
-rw-r--r--gnu/services/desktop.scm40
2 files changed, 42 insertions, 40 deletions
diff --git a/gnu/services/dbus.scm b/gnu/services/dbus.scm
index 606ee0c2f5..3d2dbb903c 100644
--- a/gnu/services/dbus.scm
+++ b/gnu/services/dbus.scm
@@ -26,6 +26,7 @@
#:use-module (gnu packages polkit)
#:use-module (gnu packages admin)
#:use-module (guix gexp)
+ #:use-module ((guix packages) #:select (package-name))
#:use-module (guix records)
#:use-module (srfi srfi-1)
#:use-module (ice-9 match)
@@ -33,6 +34,7 @@
dbus-configuration?
dbus-root-service-type
dbus-service
+ wrapped-dbus-service
polkit-service-type
polkit-service))
@@ -229,6 +231,46 @@ and policy files. For example, to allow avahi-daemon to use the system bus,
(dbus-configuration (dbus dbus)
(services services))))
+(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))
+
;;;
;;; Polkit privilege management service.
diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index dcab950822..230aeb324c 100644
--- a/gnu/services/desktop.scm
+++ b/gnu/services/desktop.scm
@@ -150,46 +150,6 @@
((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))
-
;;;
;;; Upower D-Bus service.