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.master
parent
208946e1f3
commit
b68f65007f
|
@ -26,6 +26,7 @@
|
||||||
#:use-module (gnu packages polkit)
|
#:use-module (gnu packages polkit)
|
||||||
#:use-module (gnu packages admin)
|
#:use-module (gnu packages admin)
|
||||||
#:use-module (guix gexp)
|
#:use-module (guix gexp)
|
||||||
|
#:use-module ((guix packages) #:select (package-name))
|
||||||
#:use-module (guix records)
|
#:use-module (guix records)
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
|
@ -33,6 +34,7 @@
|
||||||
dbus-configuration?
|
dbus-configuration?
|
||||||
dbus-root-service-type
|
dbus-root-service-type
|
||||||
dbus-service
|
dbus-service
|
||||||
|
wrapped-dbus-service
|
||||||
|
|
||||||
polkit-service-type
|
polkit-service-type
|
||||||
polkit-service))
|
polkit-service))
|
||||||
|
@ -229,6 +231,46 @@ and policy files. For example, to allow avahi-daemon to use the system bus,
|
||||||
(dbus-configuration (dbus dbus)
|
(dbus-configuration (dbus dbus)
|
||||||
(services services))))
|
(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.
|
;;; Polkit privilege management service.
|
||||||
|
|
|
@ -150,46 +150,6 @@
|
||||||
((package . _) package))))
|
((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.
|
;;; Upower D-Bus service.
|
||||||
|
|
Reference in New Issue