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.

diff --git a/gnu/services/dbus.scm b/gnu/services/dbus.scm
index 606ee0c..3d2dbb9 100644 (file)
--- 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))
+
 \f
 ;;;
 ;;; Polkit privilege management service.

diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index dcab950..230aeb3 100644 (file)
--- 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))
-
 \f
 ;;;
 ;;; Upower D-Bus service.