From: "Ludovic Courtès" <ludo@gnu.org>
To: 35118@debbugs.gnu.org
Subject: [bug#35118] [PATCH 1/4] services: dbus: Add 'wrapped-dbus-service'.
Date: Wed, 3 Apr 2019 11:44:16 +0200 [thread overview]
Message-ID: <20190403094419.22802-1-ludo@gnu.org> (raw)
In-Reply-To: <20190403094154.22664-1-ludo@gnu.org>
* gnu/services/desktop.scm (wrapped-dbus-service): Move to...
* gnu/services/dbus.scm (wrapped-dbus-service): ... here. New
procedure.
---
gnu/services/dbus.scm | 42 ++++++++++++++++++++++++++++++++++++++++
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))
+
\f
;;;
;;; 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))
-
\f
;;;
;;; Upower D-Bus service.
--
2.21.0
next prev parent reply other threads:[~2019-04-03 9:45 UTC|newest]
Thread overview: 6+ messages / expand[flat|nested] mbox.gz Atom feed top
2019-04-03 9:41 [bug#35118] [PATCH 0/4] Add localed, fixing keyboard layout in GDM Ludovic Courtès
2019-04-03 9:44 ` Ludovic Courtès [this message]
2019-04-03 9:44 ` [bug#35118] [PATCH 2/4] gnu: Add localed, extracted from systemd Ludovic Courtès
2019-04-03 9:44 ` [bug#35118] [PATCH 3/4] services: dbus: 'wrapped-dbus-service' accepts a list of variables Ludovic Courtès
2019-04-03 9:44 ` [bug#35118] [PATCH 4/4] services: Add 'localed' service type and have GDM extend it Ludovic Courtès
2019-04-05 13:47 ` bug#35118: [PATCH 0/4] Add localed, fixing keyboard layout in GDM Ludovic Courtès
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20190403094419.22802-1-ludo@gnu.org \
--to=ludo@gnu.org \
--cc=35118@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).