From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from eggs.gnu.org ([209.51.188.92]:58943) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1hBcS7-0001lo-LP for guix-patches@gnu.org; Wed, 03 Apr 2019 05:45:08 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1hBcS6-0002ZO-8Q for guix-patches@gnu.org; Wed, 03 Apr 2019 05:45:03 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:56788) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1hBcS6-0002ZD-2x for guix-patches@gnu.org; Wed, 03 Apr 2019 05:45:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1hBcS6-00058v-0j for guix-patches@gnu.org; Wed, 03 Apr 2019 05:45:02 -0400 Subject: [bug#35118] [PATCH 1/4] services: dbus: Add 'wrapped-dbus-service'. References: <20190403094154.22664-1-ludo@gnu.org> In-Reply-To: <20190403094154.22664-1-ludo@gnu.org> Resent-Message-ID: From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Date: Wed, 3 Apr 2019 11:44:16 +0200 Message-Id: <20190403094419.22802-1-ludo@gnu.org> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+kyle=kyleam.com@gnu.org Sender: "Guix-patches" To: 35118@debbugs.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)) + ;;; ;;; 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. -- 2.21.0