ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2025-01-11 13:49:23 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

services: dbus: Add 'wrapped-dbus-service'.

Browse source 
* gnu/services/desktop.scm (wrapped-dbus-service): Move to...
* gnu/services/dbus.scm (wrapped-dbus-service): ... here.  New
procedure.
This commit is contained in:
Ludovic Courtès 2019-04-02 21:36:26 +02:00
parent 208946e1f3
commit b68f65007f
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 42 additions and 40 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

42
gnu/services/dbus.scm
View file

@ -26,6 +26,7 @@ (define-module (gnu services dbus)
#: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 @@ (define-module (gnu services dbus)
dbus-configuration?
dbus-root-service-type
dbus-service
wrapped-dbus-service
polkit-service-type
polkit-service))
@ -229,6 +231,46 @@ (define* (dbus-service #:key (dbus dbus) (services '()))
(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.

40
gnu/services/desktop.scm
View file

@ -150,46 +150,6 @@ (define (package-direct-input-selector input)
((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.