diff options
| -rw-r--r-- | gnu/services/dbus.scm | 42 | ||||
| -rw-r--r-- | gnu/services/desktop.scm | 40 |
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. |