services: jami: Modernize to adjust to Shepherd 0.9+ changes.

This partially fixes <https://issues.guix.gnu.org/54786>, allowing the 'jami'
and 'jami-provisioning' system tests to pass again.

In version 0.9.0, Shepherd constructors are now run concurrently, via
cooperative scheduling (Guile Fibers).  The Jami service previously relied on
blocking sleeps while polling for D-Bus services to become ready after forking
a process; this wouldn't work anymore since while blocking the service process
wouldn't be given the chance to finish starting.  The new reliance on Fibers
in Shepherd's fork+exec-command in the helper 'send-dbus' procedure also meant
that it wouldn't work outside of Shepherd anymore.  Finally, the
'start-service' Shepherd procedure used in the test suite would cause the Jami
daemon to be spawned multiple times (a bug introduced in Shepherd 0.9.0).

To fix/simplify these problems, this change does the following:

1. Use the Guile AC/D-Bus library for D-Bus communication, which simplify
things, such as avoiding the need to fork 'dbus-send' processes.

2. The non-blocking 'sleep' version of Fiber is used for the 'with-retries'
waiting syntax.

3. A 'dbus' package variant is used to adjust the session bus configuration,
tailoring it for the use case at hand.

4. Avoid start-service in the tests, preferring 'jami-service-available?' for
now.

* gnu/build/jami-service.scm (parse-dbus-reply, strip-quotes)
(deserialize-item, serialize-boolean, dbus-dict->alist)
(dbus-array->list, parse-account-ids, parse-account-details)
(parse-contacts): Delete procedures.
(%send-dbus-binary, %send-dbus-bus, %send-dbus-user, %send-dbus-group)
(%send-dbus-debug): Delete parameters.
(jami-service-running?): New procedure.
(send-dbus/configuration-manager): Rename to...
(call-configuration-manager-method): ... this.  Turn METHOD into a positional
argument.  Turn ARGUMENTS into an optional argument.  Invoke
`call-dbus-method' instead of `send-dbus', adjusting callers accordingly.
(get-account-ids, id->account-details, id->account-details)
(id->volatile-account-details, username->id, add-account remove-account)
(username->contacts, remove-contact, add-contact, set-account-details)
(set-all-moderators, username->all-moderators?, username->moderators)
(set-moderator): Adjust accordingly.
(with-retries, send-dbus, dbus-available-services)
(dbus-service-available?): Move to ...
* gnu/build/dbus-service.scm: ... this new module.
(send-dbus): Rewrite to use the Guile AC/D-Bus library.
(%dbus-query-timeout, sleep*): New variables.
(%current-dbus-connection): New parameter.
(initialize-dbus-connection!, argument->signature-type)
(call-dbus-method): New procedures.
(dbus-available-services): Adjust accordingly.
* gnu/local.mk (GNU_SYSTEM_MODULES): Register new module.
* gnu/packages/glib.scm (dbus-for-jami): New variable.
* gnu/services/telephony.scm: (jami-configuration)[dbus]: Default to
dbus-for-jami.
(jami-dbus-session-activation): Write a D-Bus daemon configuration file at
'/var/run/jami/session-local.conf'.
(jami-shepherd-services): Add the closure of guile-ac-d-bus and guile-fibers
as extensions.  Adjust imported modules.  Remove no longer used parameters.
<jami-dbus-session>: Use a PID file, avoiding the need for the manual
synchronization.
<jami>:  Set DBUS_SESSION_BUS_ADDRESS environment variable.  Poll using
'jami-service-available?' instead of 'dbus-service-available?'.
* gnu/tests/telephony.scm (run-jami-test): Add needed Guile extensions.  Set
DBUS_SESSION_BUS_ADDRESS environment variable.  Adjust all tests to use
'jami-service-available?' to determine if the service is started rather than
the now problematic Shepherd's 'start-service'.

doc/guix.texi

@@ -25546,7 +25546,7 @@ Available @code{jami-configuration} fields are:
 @item @code{jamid} (default: @code{libjami}) (type: package)
 The Jami daemon package to use.
 
-@item @code{dbus} (default: @code{dbus}) (type: package)
+@item @code{dbus} (default: @code{dbus-for-jami}) (type: package)
 The D-Bus package to use to start the required D-Bus session.
 
 @item @code{nss-certs} (default: @code{nss-certs}) (type: package)

gnu/build/dbus-service.scm

@@ -0,0 +1,213 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;;
+;;; This module contains procedures to interact with D-Bus via the 'dbus-send'
+;;; command line utility.  Before using any public procedure
+;;;
+;;; Code:
+
+(define-module (gnu build dbus-service)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-19)
+  #:use-module (srfi srfi-26)
+  #:autoload (d-bus protocol connections) (d-bus-conn?
+                                           d-bus-conn-flush
+                                           d-bus-connect
+                                           d-bus-disconnect
+                                           d-bus-session-bus-address
+                                           d-bus-system-bus-address)
+  #:autoload (d-bus protocol messages) (MESSAGE_TYPE_METHOD_CALL
+                                        d-bus-headers-ref
+                                        d-bus-message-body
+                                        d-bus-message-headers
+                                        d-bus-read-message
+                                        d-bus-write-message
+                                        header-PATH
+                                        header-DESTINATION
+                                        header-INTERFACE
+                                        header-MEMBER
+                                        header-SIGNATURE
+                                        make-d-bus-message)
+  #:export (%dbus-query-timeout
+
+            initialize-dbus-connection!
+            %current-dbus-connection
+            send-dbus
+            call-dbus-method
+
+            dbus-available-services
+            dbus-service-available?
+
+            with-retries))
+
+(define %dbus-query-timeout 2)          ;in seconds
+
+;;; Use Fibers' sleep to enable cooperative scheduling in Shepherd >= 0.9.0,
+;;; which is required at least for the Jami service.
+(define sleep*
+  (lambda ()                            ;delay execution
+    (if (resolve-module '(fibers) #f)
+        (module-ref (resolve-interface '(fibers)) 'sleep)
+        (begin
+          (format #f "fibers not available -- blocking 'sleep' in use")
+          sleep))))
+
+;;;
+;;; Utilities.
+;;;
+
+(define-syntax-rule (with-retries n delay body ...)
+  "Retry the code in BODY up to N times until it doesn't raise an exception nor
+return #f, else raise an error.  A delay of DELAY seconds is inserted before
+each retry."
+  (let loop ((attempts 0))
+    (catch #t
+      (lambda ()
+        (let ((result (begin body ...)))
+          (if (not result)
+              (error "failed attempt" attempts)
+              result)))
+      (lambda args
+        (if (< attempts n)
+            (begin
+              ((sleep*) delay)            ;else wait and retry
+              (loop (+ 1 attempts)))
+            (error "maximum number of retry attempts reached"
+                   body ... args))))))
+
+
+;;;
+;;; Low level wrappers above AC/D-Bus.
+;;;
+
+;; The active D-Bus connection (a parameter) used by the other procedures.
+(define %current-dbus-connection (make-parameter #f))
+
+(define* (initialize-dbus-connection!
+          #:key (address (or (d-bus-session-bus-address)
+                             (d-bus-system-bus-address))))
+  "Initialize the D-Bus connection.  ADDRESS should be the address of the D-Bus
+session, e.g. \"unix:path=/var/run/dbus/system_bus_socket\", the default value
+if ADDRESS is not provided and DBUS_SESSION_BUS_ADDRESS is not set.  Return
+the initialized D-Bus connection."
+  ;; Clear current correction if already active.
+  (when (d-bus-conn? (%current-dbus-connection))
+    (d-bus-disconnect (%current-dbus-connection)))
+
+  (let ((connection (d-bus-connect address)))
+    (%current-dbus-connection connection) ;update connection parameter
+    (call-dbus-method "Hello"))           ;initial handshake
+
+  (%current-dbus-connection))
+
+(define* (send-dbus message #:key
+                    (connection (%current-dbus-connection))
+                    timeout)
+  "Send a D-Bus MESSAGE to CONNECTION and return the body of its reply.  Up to
+READ-RETRIES replies are read until a matching reply is found, else an error
+is raised.  MESSAGE is to be constructed with `make-d-bus-message'.  When the
+body contains a single element, it is returned directly, else the body
+elements are returned as a list.  TIMEOUT is a timeout value in seconds."
+  (let ((serial     (d-bus-write-message connection message))
+        (start-time (current-time time-monotonic))
+        (timeout* (or timeout %dbus-query-timeout)))
+    (d-bus-conn-flush connection)
+    (let retry ()
+      (when (> (time-second (time-difference (current-time time-monotonic)
+                                             start-time))
+               timeout*)
+        (error 'dbus "fail to get reply in timeout" timeout*))
+      (let* ((reply (d-bus-read-message connection))
+             (reply-headers (d-bus-message-headers reply))
+             (reply-serial (d-bus-headers-ref reply-headers 'REPLY_SERIAL))
+             (error-name (d-bus-headers-ref reply-headers 'ERROR_NAME))
+             (body (d-bus-message-body reply)))
+        ;; Validate the reply matches the message.
+        (when error-name
+          (error 'dbus "method failed with error" error-name body))
+        ;; Some replies do not include a serial header, such as the for the
+        ;; org.freedesktop.DBus NameAcquired one.
+        (if (and reply-serial (= serial reply-serial))
+            (match body
+              ((x x* ..1)               ;contains 2 ore more elements
+               body)
+              ((x)
+               x)                       ;single element; return it directly
+              (#f #f))
+            (retry))))))
+
+(define (argument->signature-type argument)
+  "Infer the D-Bus signature type from ARGUMENT."
+  ;; XXX: avoid ..1 when using vectors due to a bug (?) in (ice-9 match).
+  (match argument
+    ((? boolean?) "b")
+    ((? string?) "s")
+    (#((? string?) (? string?) ...) "as")
+    (#(((? string?) . (? string?))
+       ((? string?) . (? string?)) ...) "a{ss}")
+    (_ (error 'dbus "no rule to infer type from argument" argument))))
+
+(define* (call-dbus-method method
+                           #:key
+                           (path "/org/freedesktop/DBus")
+                           (destination "org.freedesktop.DBus")
+                           (interface "org.freedesktop.DBus")
+                           (connection (%current-dbus-connection))
+                           arguments
+                           timeout)
+  "Call the D-Bus method specified by METHOD, PATH, DESTINATION and INTERFACE.
+The currently active D-Bus CONNECTION is used unless explicitly provided.
+Method arguments may be provided via ARGUMENTS sent as the message body.
+TIMEOUT limit the maximum time to allow for the reply.  Return the body of the
+reply."
+  (let ((message (make-d-bus-message
+                  MESSAGE_TYPE_METHOD_CALL 0 #f '()
+                  `#(,(header-PATH        path)
+                     ,(header-DESTINATION destination)
+                     ,(header-INTERFACE   interface)
+                     ,(header-MEMBER      method)
+                     ,@(if arguments
+                           (list (header-SIGNATURE
+                                  (string-join
+                                   (map argument->signature-type arguments)
+                                   "")))
+                           '()))
+                  arguments)))
+    (send-dbus message #:connection connection #:timeout timeout)))
+
+
+;;;
+;;; Higher-level, D-Bus procedures.
+;;;
+
+(define (dbus-available-services)
+  "Return the list of available (acquired) D-Bus services."
+  (let ((names (vector->list (call-dbus-method "ListNames"))))
+    ;; Remove entries such as ":1.7".
+    (remove (cut string-prefix? ":" <>) names)))
+
+(define (dbus-service-available? service)
+  "Predicate to check for the D-Bus SERVICE availability."
+  (member service (dbus-available-services)))
+
+;; Local Variables:
+;; eval: (put 'with-retries 'scheme-indent-function 2)
+;; End:

gnu/build/jami-service.scm

@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2021, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -24,16 +24,16 @@
 ;;; Code:
 
 (define-module (gnu build jami-service)
+  #:use-module (gnu build dbus-service)
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
-  #:use-module (ice-9 peg)
   #:use-module (ice-9 rdelim)
   #:use-module (ice-9 regex)
-  #:use-module (rnrs io ports)
-  #:autoload (shepherd service) (fork+exec-command)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
-  #:export (account-fingerprint?
+  #:export (jami-service-available?
+
+            account-fingerprint?
             account-details->recutil
             get-accounts
             get-usernames
@@ -51,43 +51,12 @@ (define-module (gnu build jami-service)
             set-all-moderators
             set-moderator
             username->all-moderators?
-            username->moderators
+            username->moderators))
-
-            dbus-available-services
-            dbus-service-available?
-
-            %send-dbus-binary
-            %send-dbus-bus
-            %send-dbus-user
-            %send-dbus-group
-            %send-dbus-debug
-            send-dbus
-
-            with-retries))
 
 ;;;
 ;;; Utilities.
 ;;;
 
-(define-syntax-rule (with-retries n delay body ...)
-  "Retry the code in BODY up to N times until it doesn't raise an exception
-nor return #f, else raise an error.  A delay of DELAY seconds is inserted
-before each retry."
-  (let loop ((attempts 0))
-    (catch #t
-      (lambda ()
-        (let ((result (begin body ...)))
-          (if (not result)
-              (error "failed attempt" attempts)
-              result)))
-      (lambda args
-        (if (< attempts n)
-            (begin
-              (sleep delay)             ;else wait and retry
-              (loop (+ 1 attempts)))
-            (error "maximum number of retry attempts reached"
-                   body ... args))))))
-
 (define (alist->list alist)
   "Flatten ALIST into a list."
   (append-map (match-lambda
@@ -104,210 +73,32 @@ (define (account-fingerprint? val)
   (and (string? val)
        (regexp-exec account-fingerprint-rx val)))
 
-
-;;;
-;;; D-Bus reply parser.
-;;;
-
-(define (parse-dbus-reply reply)
-  "Return the parse tree of REPLY, a string returned by the 'dbus-send'
-command."
-  ;; Refer to 'man 1 dbus-send' for the grammar reference.  Note that the
-  ;; format of the replies doesn't match the format of the input, which is the
-  ;; one documented, but it gives an idea.  For an even better reference, see
-  ;; the `print_iter' procedure of the 'dbus-print-message.c' file from the
-  ;; 'dbus' package sources.
-  (define-peg-string-patterns
-    "contents <- header (item / container (item / container*)?)
-     item <-- WS type WS value NL
-     container <- array / dict / variant
-     array <-- array-start (item / container)* array-end
-     dict <-- array-start dict-entry* array-end
-     dict-entry <-- dict-entry-start item item dict-entry-end
-     variant <-- variant-start item
-     type <-- 'string' / 'int16' / 'uint16' / 'int32' / 'uint32' / 'int64' /
-              'uint64' / 'double' / 'byte' / 'boolean' / 'objpath'
-     value <-- (!NL .)* NL
-     header < (!NL .)* NL
-     variant-start < WS 'variant'
-     array-start < WS 'array [' NL
-     array-end < WS ']' NL
-     dict-entry-start < WS 'dict entry(' NL
-     dict-entry-end < WS ')' NL
-     DQ < '\"'
-     WS < ' '*
-     NL < '\n'*")
-
-  (peg:tree (match-pattern contents reply)))
-
-(define (strip-quotes text)
-  "Strip the leading and trailing double quotes (\") characters from TEXT."
-  (let* ((text* (if (string-prefix? "\"" text)
-                    (string-drop text 1)
-                    text))
-         (text** (if (string-suffix? "\"" text*)
-                     (string-drop-right text* 1)
-                     text*)))
-    text**))
-
-(define (deserialize-item item)
-  "Return the value described by the ITEM parse tree as a Guile object."
-  ;; Strings are printed wrapped in double quotes (see the print_iter
-  ;; procedure in dbus-print-message.c).
-  (match item
-    (('item ('type "string") ('value value))
-     (strip-quotes value))
-    (('item ('type "boolean") ('value value))
-     (if (string=? "true" value)
-         #t
-         #f))
-    (('item _ ('value value))
-     value)))
-
-(define (serialize-boolean bool)
-  "Return the serialized format expected by dbus-send for BOOL."
-  (format #f "boolean:~:[false~;true~]" bool))
-
-(define (dict->alist dict-parse-tree)
-  "Translate a dict parse tree to an alist."
-  (define (tuples->alist tuples)
-    (map (lambda (x) (apply cons x)) tuples))
-
-  (match dict-parse-tree
-    ('dict
-     '())
-    (('dict ('dict-entry keys values) ...)
-     (let ((keys* (map deserialize-item keys))
-           (values* (map deserialize-item values)))
-       (tuples->alist (zip keys* values*))))))
-
-(define (array->list array-parse-tree)
-  "Translate an array parse tree to a list."
-  (match array-parse-tree
-    ('array
-     '())
-    (('array items ...)
-     (map deserialize-item items))))
-
-
-;;;
-;;; Low-level, D-Bus-related procedures.
-;;;
-
-;;; The following parameters are used in the jami-service-type service
-;;; definition to conveniently customize the behavior of the send-dbus helper,
-;;; even when called indirectly.
-(define %send-dbus-binary (make-parameter "dbus-send"))
-(define %send-dbus-bus (make-parameter #f))
-(define %send-dbus-user (make-parameter #f))
-(define %send-dbus-group (make-parameter #f))
-(define %send-dbus-debug (make-parameter #f))
-
-(define* (send-dbus #:key service path interface method
-                    bus
-                    dbus-send
-                    user group
-                    timeout
-                    arguments)
-  "Return the response of DBUS-SEND, else raise an error.  Unless explicitly
-provided, DBUS-SEND takes the value of the %SEND-DBUS-BINARY parameter.  BUS
-can be used to specify the bus address, such as 'unix:path=/var/run/jami/bus'.
-Alternatively, the %SEND-DBUS-BUS parameter can be used.  ARGUMENTS can be
-used to pass input values to a D-Bus method call.  TIMEOUT is the amount of
-time to wait for a reply in milliseconds before giving up with an error.  USER
-and GROUP allow choosing under which user/group the DBUS-SEND command is
-executed.  Alternatively, the %SEND-DBUS-USER and %SEND-DBUS-GROUP parameters
-can be used instead."
-  (let* ((command `(,(if dbus-send
-                         dbus-send
-                         (%send-dbus-binary))
-                    ,@(if (or bus (%send-dbus-bus))
-                          (list (string-append "--bus="
-                                               (or bus (%send-dbus-bus))))
-                          '())
-                    "--print-reply"
-                    ,@(if timeout
-                          (list (format #f "--reply-timeout=~d" timeout))
-                          '())
-                    ,(string-append "--dest=" service) ;e.g., cx.ring.Ring
-                    ,path            ;e.g., /cx/ring/Ring/ConfigurationManager
-                    ,(string-append interface "." method)
-                    ,@(or arguments '())))
-         (temp-port (mkstemp! (string-copy "/tmp/dbus-send-output-XXXXXXX")))
-         (temp-file (port-filename temp-port)))
-    (dynamic-wind
-      (lambda ()
-        (let* ((uid (or (and=> (or user (%send-dbus-user))
-                               (compose passwd:uid getpwnam)) -1))
-               (gid (or (and=> (or group (%send-dbus-group))
-                               (compose group:gid getgrnam)) -1)))
-          (chown temp-port uid gid)))
-      (lambda ()
-        (let ((pid (fork+exec-command command
-                                      #:user (or user (%send-dbus-user))
-                                      #:group (or group (%send-dbus-group))
-                                      #:log-file temp-file)))
-          (match (waitpid pid)
-            ((_ . status)
-             (let ((exit-status (status:exit-val status))
-                   (output (call-with-port temp-port get-string-all)))
-               (if (= 0 exit-status)
-                   output
-                   (error "the send-dbus command exited with: "
-                          command exit-status output)))))))
-      (lambda ()
-        (false-if-exception (delete-file temp-file))))))
-
-(define (parse-account-ids reply)
-  "Return the Jami account IDs from REPLY, which is assumed to be the output
-of the Jami D-Bus `getAccountList' method."
-  (array->list (parse-dbus-reply reply)))
-
-(define (parse-account-details reply)
-  "Parse REPLY, which is assumed to be the output of the Jami D-Bus
-`getAccountDetails' method, and return its content as an alist."
-  (dict->alist (parse-dbus-reply reply)))
-
-(define (parse-contacts reply)
-  "Parse REPLY, which is assumed to be the output of the Jamid D-Bus
-`getContacts' method, and return its content as an alist."
-  (match (parse-dbus-reply reply)
-    ('array
-     '())
-    (('array dicts ...)
-     (map dict->alist dicts))))
-
-
-;;;
-;;; Higher-level, D-Bus-related procedures.
-;;;
-
 (define (validate-fingerprint fingerprint)
   "Validate that fingerprint is 40 characters long."
   (unless (account-fingerprint? fingerprint)
     (error "Account fingerprint is not valid:" fingerprint)))
 
-(define (dbus-available-services)
+(define (jami-service-available?)
-  "Return the list of available (acquired) D-Bus services."
+  "Whether the Jami D-Bus service was acquired by the D-Bus daemon."
-  (let ((reply (parse-dbus-reply
+  (unless (%current-dbus-connection)
-                (send-dbus #:service "org.freedesktop.DBus"
+    (initialize-dbus-connection!))
-                           #:path "/org/freedesktop/DBus"
+  (dbus-service-available? "cx.ring.Ring"))
-                           #:interface "org.freedesktop.DBus"
-                           #:method "ListNames"))))
-    ;; Remove entries such as ":1.7".
-    (remove (cut string-prefix? ":" <>)
-            (array->list reply))))
 
-(define (dbus-service-available? service)
+
-  "Predicate to check for the D-Bus SERVICE availability."
+;;;
-  (member service (dbus-available-services)))
+;;; Bindings for the Jami D-Bus API.
+;;;
 
-(define* (send-dbus/configuration-manager #:key method arguments timeout)
+(define* (call-configuration-manager-method method #:optional arguments
-  "Query the Jami D-Bus ConfigurationManager service."
+                                            #:key timeout)
-  (send-dbus #:service "cx.ring.Ring"
+  "Query the Jami D-Bus ConfigurationManager interface with METHOD applied to
+ARGUMENTS.  TIMEOUT can optionally be provided as a value in seconds."
+  (unless (%current-dbus-connection)
+    (initialize-dbus-connection!))
+  (call-dbus-method method
                     #:path "/cx/ring/Ring/ConfigurationManager"
+                    #:destination "cx.ring.Ring"
                     #:interface "cx.ring.Ring.ConfigurationManager"
-             #:method method
                     #:arguments arguments
                     #:timeout timeout))
 
@@ -317,22 +108,17 @@ (define* (send-dbus/configuration-manager #:key method arguments timeout)
 (define (get-account-ids)
   "Return the available Jami account identifiers (IDs).  Account IDs are an
 implementation detail used to identify the accounts in Jami."
-  (parse-account-ids
+  (vector->list (call-configuration-manager-method "getAccountList")))
-   (send-dbus/configuration-manager #:method "getAccountList")))
 
 (define (id->account-details id)
   "Retrieve the account data associated with the given account ID."
-  (parse-account-details
+  (vector->list (call-configuration-manager-method "getAccountDetails"
-   (send-dbus/configuration-manager
+                                                   (list id))))
-    #:method "getAccountDetails"
-    #:arguments (list (string-append "string:" id)))))
 
 (define (id->volatile-account-details id)
   "Retrieve the account data associated with the given account ID."
-  (parse-account-details
+  (vector->list (call-configuration-manager-method "getVolatileAccountDetails"
-   (send-dbus/configuration-manager
+                                                   (list id))))
-    #:method "getVolatileAccountDetails"
-    #:arguments (list (string-append "string:" id)))))
 
 (define (id->account id)
   "Retrieve the complete account data associated with the given account ID."
@@ -362,8 +148,8 @@ (define (username->id username)
                        '()))))
            (get-account-ids))))
   (or (assoc-ref %username-to-id-cache username)
-      (let ((message (format #f "Could not retrieve a local account ID\
+      (let ((message (format #f "no account ID for ~:[username~;fingerprint~]"
- for ~:[username~;fingerprint~]" (account-fingerprint? username))))
+                             (account-fingerprint? username))))
         (error message username))))
 
 (define (account->username account)
@@ -400,27 +186,21 @@ (define (add-account archive)
 should *not* be encrypted with a password.  Return the username associated
 with the account."
   (invalidate-username-to-id-cache!)
-  (let ((reply (send-dbus/configuration-manager
+  (let ((id (call-configuration-manager-method
-                #:method "addAccount"
+             "addAccount" (list `#(("Account.archivePath" . ,archive)
-                #:arguments (list (string-append
+                                   ("Account.type" . "RING"))))))
-                                   "dict:string:string:Account.archivePath,"
-                                   archive
-                                   ",Account.type,RING")))))
     ;; The account information takes some time to be populated.
-    (let ((id (deserialize-item (parse-dbus-reply reply))))
     (with-retries 20 1
       (let ((username (id->username id)))
-          (if (string-null? username)
+        (if (and=> username (negate string-null?))
-              #f
+            username
-              username))))))
+            #f)))))
 
 (define (remove-account username)
   "Delete the Jami account associated with USERNAME, the account 40 characters
 fingerprint or a registered username."
   (let ((id (username->id username)))
-    (send-dbus/configuration-manager
+    (call-configuration-manager-method "removeAccount" (list id)))
-     #:method "removeAccount"
-     #:arguments (list (string-append "string:" id))))
   (invalidate-username-to-id-cache!))
 
 (define* (username->contacts username)
@@ -430,15 +210,16 @@ (define* (username->contacts username)
 fingerprint or a registered username.  The contacts returned are represented
 using their 40 characters fingerprint."
   (let* ((id (username->id username))
-         (reply (send-dbus/configuration-manager
+         ;; The contacts are returned as "aa{ss}", that is, an array of arrays
-                 #:method "getContacts"
+         ;; containing (string . string) pairs.
-                 #:arguments (list (string-append "string:" id))))
+         (contacts (map vector->list
-         (all-contacts (parse-contacts reply))
+                        (vector->list (call-configuration-manager-method
+                                       "getContacts" (list id)))))
          (banned? (lambda (contact)
                     (and=> (assoc-ref contact "banned")
                            (cut string=? "true" <>))))
-         (banned (filter banned? all-contacts))
+         (banned (filter banned? contacts))
-         (not-banned (filter (negate banned?) all-contacts))
+         (not-banned (filter (negate banned?) contacts))
          (fingerprint (cut assoc-ref <> "id")))
     (values (map fingerprint not-banned)
             (map fingerprint banned))))
@@ -449,27 +230,20 @@ (define* (remove-contact contact username #:key ban?)
 username).  When BAN? is true, also mark the contact as banned."
   (validate-fingerprint contact)
   (let ((id (username->id username)))
-    (send-dbus/configuration-manager
+    (call-configuration-manager-method "removeContact" (list id contact ban?))))
-     #:method "removeContact"
-     #:arguments (list (string-append "string:" id)
-                       (string-append "string:" contact)
-                       (serialize-boolean ban?)))))
 
 (define (add-contact contact username)
   "Add CONTACT, the 40 characters public key fingerprint of a contact, to the
 account of USERNAME (either a fingerprint or a registered username)."
   (validate-fingerprint contact)
   (let ((id (username->id username)))
-    (send-dbus/configuration-manager
+    (call-configuration-manager-method "addContact" (list id contact))))
-     #:method "addContact"
-     #:arguments (list (string-append "string:" id)
-                       (string-append "string:" contact)))))
 
 (define* (set-account-details details username #:key timeout)
   "Set DETAILS, an alist containing the key value pairs to set for the account
 of USERNAME, a registered username or account fingerprint.  The value of the
 parameters not provided are unchanged.  TIMEOUT is a value in milliseconds to
-pass to the `send-dbus/configuration-manager' procedure."
+pass to the `call-configuration-manager-method' procedure."
   (let* ((id (username->id username))
          (current-details (id->account-details id))
          (updated-details (map (match-lambda
@@ -477,52 +251,29 @@ (define* (set-account-details details username #:key timeout)
                                   (or (and=> (assoc-ref details key)
                                              (cut cons key <>))
                                       (cons key value))))
-                               current-details))
+                               current-details)))
-         ;; dbus-send does not permit sending null strings (it throws a
+    (call-configuration-manager-method
-         ;; "malformed dictionary" error).  Luckily they seem to have the
+     "setAccountDetails" (list id (list->vector updated-details))
-         ;; semantic of "default account value" in Jami; so simply drop them.
+     #:timeout timeout)))
-         (updated-details* (remove (match-lambda
-                                     ((_ . value)
-                                      (string-null? value)))
-                                   updated-details)))
-    (send-dbus/configuration-manager
-     #:timeout timeout
-     #:method "setAccountDetails"
-     #:arguments
-     (list (string-append "string:" id)
-           (string-append "dict:string:string:"
-                          (string-join (alist->list updated-details*)
-                                       ","))))))
 
 (define (set-all-moderators enabled? username)
   "Set the 'AllModerators' property to enabled? for the account of USERNAME, a
 registered username or account fingerprint."
   (let ((id (username->id username)))
-    (send-dbus/configuration-manager
+    (call-configuration-manager-method "setAllModerators" (list id enabled?))))
-     #:method "setAllModerators"
-     #:arguments
-     (list (string-append "string:" id)
-           (serialize-boolean enabled?)))))
 
 (define (username->all-moderators? username)
   "Return the 'AllModerators' property for the account of USERNAME, a
 registered username or account fingerprint."
-  (let* ((id (username->id username))
+  (let ((id (username->id username)))
-         (reply (send-dbus/configuration-manager
+    (call-configuration-manager-method "isAllModerators" (list id))))
-                 #:method "isAllModerators"
-                 #:arguments
-                 (list (string-append "string:" id)))))
-    (deserialize-item (parse-dbus-reply reply))))
 
 (define (username->moderators username)
   "Return the moderators for the account of USERNAME, a registered username or
 account fingerprint."
-  (let* ((id (username->id username))
+  (let* ((id (username->id username)))
-         (reply (send-dbus/configuration-manager
+    (vector->list (call-configuration-manager-method "getDefaultModerators"
-                 #:method "getDefaultModerators"
+                                                     (list id)))))
-                 #:arguments
-                 (list (string-append "string:" id)))))
-    (array->list (parse-dbus-reply reply))))
 
 (define (set-moderator contact enabled? username)
   "Set the moderator flag to ENABLED? for CONTACT, the 40 characters public
@@ -530,11 +281,8 @@ (define (set-moderator contact enabled? username)
 username or account fingerprint."
   (validate-fingerprint contact)
   (let* ((id (username->id username)))
-    (send-dbus/configuration-manager #:method "setDefaultModerator"
+    (call-configuration-manager-method "setDefaultModerator"
-                                     #:arguments
+                                       (list id contact enabled?))))
-                                     (list (string-append "string:" id)
-                                           (string-append "string:" contact)
-                                           (serialize-boolean enabled?)))))
 
 (define (disable-account username)
   "Disable the account known by USERNAME, a registered username or account
@@ -543,7 +291,7 @@ (define (disable-account username)
                        ;; Waiting for the reply on this command takes a very
                        ;; long time that trips the default D-Bus timeout value
                        ;; (25 s), for some reason.
-                        #:timeout 60000))
+                        #:timeout 60))
 
 (define (enable-account username)
   "Enable the account known by USERNAME, a registered username or account
@@ -581,7 +329,3 @@ (define sorted-account-details
               (fold alist-delete account-details first-items))))
 
   (string-join (map pair->recutil-property sorted-account-details) "\n"))
-
-;; Local Variables:
-;; eval: (put 'with-retries 'scheme-indent-function 2)
-;; End:

gnu/local.mk

@@ -715,6 +715,7 @@ GNU_SYSTEM_MODULES =				\
   %D%/build/bootloader.scm			\
   %D%/build/chromium-extension.scm		\
   %D%/build/cross-toolchain.scm			\
+  %D%/build/dbus-service.scm			\
   %D%/build/image.scm				\
   %D%/build/jami-service.scm			\
   %D%/build/file-systems.scm			\

gnu/packages/glib.scm

@@ -9,7 +9,7 @@
 ;;; Copyright © 2017 Petter <petter@mykolab.ch>
 ;;; Copyright © 2018, 2019 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2018 Alex Vong <alexvong1995@gmail.com>
-;;; Copyright © 2019, 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2019, 2021, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2019 Giacomo Leidi <goodoldpaul@autistici.org>
 ;;; Copyright © 2019, 2020, 2021 Marius Bakke <marius@gnu.org>
 ;;; Copyright © 2020 Nicolò Balzarotti <nicolo@nixo.xyz>
@@ -176,6 +176,23 @@ (define dbus
 shared NFS home directories.")
     (license license:gpl2+)))                     ; or Academic Free License 2.1
 
+;;; This variant is used for the Jami service: it provides an entry point to
+;;; further customize the configuration of the D-Bus instance run by the
+;;; jami-dbus-session service.
+(define-public dbus-for-jami
+  (hidden-package
+   (package/inherit dbus
+     (name "dbus-for-jami")
+     (arguments
+      (substitute-keyword-arguments (package-arguments dbus)
+        ((#:phases phases)
+         `(modify-phases ,phases
+            (add-after 'unpack 'customize-config
+              (lambda _
+                (substitute* "bus/session.conf.in"
+                  (("@SYSCONFDIR_FROM_PKGDATADIR@/dbus-1/session-local.conf")
+                   "/var/run/jami/session-local.conf")))))))))))
+
 (define glib
   (package
     (name "glib")

gnu/services/telephony.scm

@@ -26,6 +26,7 @@ (define-module (gnu services telephony)
   #:use-module (gnu packages admin)
   #:use-module (gnu packages certs)
   #:use-module (gnu packages glib)
+  #:use-module (gnu packages guile-xyz)
   #:use-module (gnu packages jami)
   #:use-module (gnu packages telephony)
   #:use-module (guix deprecation)
@@ -231,7 +232,7 @@ (define-configuration/no-serialization jami-configuration
    (file-like libjami)
    "The Jami daemon package to use.")
   (dbus
-   (file-like dbus)
+   (file-like dbus-for-jami)
    "The D-Bus package to use to start the required D-Bus session.")
   (nss-certs
    (file-like nss-certs)
@@ -284,7 +285,20 @@ (define (jami-dbus-session-activation config)
     #~(begin
         (use-modules (gnu build activation))
         (let ((user (getpwnam "jami")))
-          (mkdir-p/perms "/var/run/jami" user #o700)))))
+          (mkdir-p/perms "/var/run/jami" user #o700)
+          ;; Customize the D-Bus policy to allow 'root' to access other users'
+          ;; session bus.  Also modify the location of the written PID file,
+          ;; from the default '/var/run/dbus/pid' location.  This file is only
+          ;; honored by the 'dbus-for-jami' package variant.
+          (call-with-output-file "/var/run/jami/session-local.conf"
+            (lambda (port)
+              (format port "\
+<busconfig>
+  <pidfile>/var/run/jami/pid</pidfile>
+  <policy context=\"mandatory\">
+    <allow user=\"root\"/>
+  </policy>
+</busconfig>~%")))))))
 
 (define (jami-shepherd-services config)
   "Return a <shepherd-service> running the Jami daemon."
@@ -292,12 +306,17 @@ (define (jami-shepherd-services config)
          (nss-certs (jami-configuration-nss-certs config))
          (dbus (jami-configuration-dbus config))
          (dbus-daemon (file-append dbus "/bin/dbus-daemon"))
-         (dbus-send (file-append dbus "/bin/dbus-send"))
          (accounts (jami-configuration-accounts config))
          (declarative-mode? (not (eq? 'disabled accounts))))
 
+    (with-extensions (list guile-packrat ;used by guile-ac-d-bus
+                           guile-ac-d-bus
+                           ;; Fibers is needed to provide the non-blocking
+                           ;; variant of the 'sleep' procedure.
+                           guile-fibers)
       (with-imported-modules (source-module-closure
-                            '((gnu build jami-service)
+                              '((gnu build dbus-service)
+                                (gnu build jami-service)
                                 (gnu build shepherd)
                                 (gnu system file-systems)))
 
@@ -308,10 +327,6 @@ (define list-accounts-action
 details alists keyed by their account username.")
            (procedure
             #~(lambda _
-              (parameterize ((%send-dbus-binary #$dbus-send)
-                             (%send-dbus-bus    "unix:path=/var/run/jami/bus")
-                             (%send-dbus-user   "jami")
-                             (%send-dbus-group  "jami"))
                 ;; Print the accounts summary or long listing, according to
                 ;; user-provided option.
                 (let* ((usernames (get-usernames))
@@ -341,7 +356,7 @@ (define disabled?
                       accounts)
                      (display "\n")))
                   ;; Return the account-details-list alist.
-                  (map cons usernames accounts)))))))
+                  (map cons usernames accounts))))))
 
         (define list-account-details-action
           (shepherd-action
@@ -351,17 +366,13 @@ (define list-account-details-action
 keyed by their account username.")
            (procedure
             #~(lambda _
-              (parameterize ((%send-dbus-binary #$dbus-send)
-                             (%send-dbus-bus    "unix:path=/var/run/jami/bus")
-                             (%send-dbus-user   "jami")
-                             (%send-dbus-group  "jami"))
                 (let* ((usernames (get-usernames))
                        (accounts (map-in-order username->account usernames)))
                   (for-each (lambda (account)
                               (display (account-details->recutil account))
                               (display "\n\n"))
                             accounts)
-                  (map cons usernames accounts)))))))
+                  (map cons usernames accounts))))))
 
         (define list-contacts-action
           (shepherd-action
@@ -370,10 +381,6 @@ (define list-contacts-action
 an alist containing the contacts keyed by the account usernames.")
            (procedure
             #~(lambda _
-              (parameterize ((%send-dbus-binary #$dbus-send)
-                             (%send-dbus-bus    "unix:path=/var/run/jami/bus")
-                             (%send-dbus-user   "jami")
-                             (%send-dbus-group  "jami"))
                 (let* ((usernames (get-usernames))
                        (contacts (map-in-order username->contacts usernames)))
                   (for-each (lambda (username contacts)
@@ -381,7 +388,7 @@ (define list-contacts-action
                                       username)
                               (format #t "~{  - ~a~%~}~%" contacts))
                             usernames contacts)
-                  (map cons usernames contacts)))))))
+                  (map cons usernames contacts))))))
 
         (define list-moderators-action
           (shepherd-action
@@ -390,10 +397,6 @@ (define list-moderators-action
 an alist containing the moderators keyed by the account usernames.")
            (procedure
             #~(lambda _
-              (parameterize ((%send-dbus-binary #$dbus-send)
-                             (%send-dbus-bus    "unix:path=/var/run/jami/bus")
-                             (%send-dbus-user   "jami")
-                             (%send-dbus-group  "jami"))
                 (let* ((usernames (get-usernames))
                        (moderators (map-in-order username->moderators
                                                  usernames)))
@@ -406,7 +409,7 @@ (define list-moderators-action
                            (format #t "Moderators for account ~a:~%" username)
                            (format #t "~{  - ~a~%~}~%" moderators))))
                    usernames moderators)
-                  (map cons usernames moderators)))))))
+                  (map cons usernames moderators))))))
 
         (define add-moderator-action
           (shepherd-action
@@ -422,14 +425,10 @@ (define add-moderator-action
 Return the moderators for the account known by USERNAME.")
            (procedure
             #~(lambda (_ moderator username)
-              (parameterize ((%send-dbus-binary #$dbus-send)
-                             (%send-dbus-bus    "unix:path=/var/run/jami/bus")
-                             (%send-dbus-user   "jami")
-                             (%send-dbus-group  "jami"))
                 (set-all-moderators #f username)
                 (add-contact moderator username)
                 (set-moderator moderator #t username)
-                (username->moderators username))))))
+                (username->moderators username)))))
 
         (define ban-contact-action
           (shepherd-action
@@ -445,16 +444,12 @@ (define ban-contact-action
 @end example")
            (procedure
             #~(lambda* (_ contact #:optional username)
-              (parameterize ((%send-dbus-binary #$dbus-send)
-                             (%send-dbus-bus    "unix:path=/var/run/jami/bus")
-                             (%send-dbus-user   "jami")
-                             (%send-dbus-group  "jami"))
                 (let ((usernames (or (and=> username list)
                                      (get-usernames))))
                   (for-each (lambda (username)
                               (set-moderator contact #f username)
                               (remove-contact contact username #:ban? #t))
-                            usernames)))))))
+                            usernames))))))
 
         (define list-banned-contacts-action
           (shepherd-action
@@ -463,11 +458,6 @@ (define list-banned-contacts-action
 an alist of the banned contacts, keyed by the account usernames.")
            (procedure
             #~(lambda _
-              (parameterize ((%send-dbus-binary #$dbus-send)
-                             (%send-dbus-bus    "unix:path=/var/run/jami/bus")
-                             (%send-dbus-user   "jami")
-                             (%send-dbus-group  "jami"))
-
                 (define banned-contacts
                   (let ((usernames (get-usernames)))
                     (map cons usernames
@@ -484,7 +474,7 @@ (define banned-contacts
                                        username)
                                (format #t "~{  - ~a~%~}~%" banned))))
                           banned-contacts)
-                banned-contacts)))))
+                banned-contacts))))
 
         (define enable-account-action
           (shepherd-action
@@ -493,11 +483,7 @@ (define enable-account-action
 either a registered username or the fingerprint of the account.")
            (procedure
             #~(lambda (_ username)
-              (parameterize ((%send-dbus-binary #$dbus-send)
+                (enable-account username)))))
-                             (%send-dbus-bus    "unix:path=/var/run/jami/bus")
-                             (%send-dbus-user   "jami")
-                             (%send-dbus-group  "jami"))
-                (enable-account username))))))
 
         (define disable-account-action
           (shepherd-action
@@ -506,16 +492,13 @@ (define disable-account-action
 argument, either a registered username or the fingerprint of the account.")
            (procedure
             #~(lambda (_ username)
-              (parameterize ((%send-dbus-binary #$dbus-send)
+                (disable-account username)))))
-                             (%send-dbus-bus    "unix:path=/var/run/jami/bus")
-                             (%send-dbus-user   "jami")
-                             (%send-dbus-group  "jami"))
-                (disable-account username))))))
 
         (list (shepherd-service
                (documentation "Run a D-Bus session for the Jami daemon.")
                (provision '(jami-dbus-session))
                (modules `((gnu build shepherd)
+                          (gnu build dbus-service)
                           (gnu build jami-service)
                           (gnu system file-systems)
                           ,@%default-modules))
@@ -523,13 +506,13 @@ (define disable-account-action
                ;; activation for D-Bus, such as a /etc/machine-id file.
                (requirement '(dbus-system syslogd))
                (start
-              #~(lambda args
+                #~(make-forkexec-constructor/container
-                  (define pid
-                    ((make-forkexec-constructor/container
                    (list #$dbus-daemon "--session"
                          "--address=unix:path=/var/run/jami/bus"
-                            "--nofork" "--syslog-only" "--nopidfile")
+                         "--syslog-only")
-                      #:mappings (list (file-system-mapping
+                   #:pid-file "/var/run/jami/pid"
+                   #:mappings
+                   (list (file-system-mapping
                           (source "/dev/log") ;for syslog
                           (target source))
                          (file-system-mapping
@@ -540,25 +523,8 @@ (define pid
                    #:group "jami"
                    #:environment-variables
                    ;; This is so that the cx.ring.Ring service D-Bus
-                      ;; definition is found by dbus-send.
+                   ;; definition is found by dbus-daemon.
-                      (list (string-append "XDG_DATA_DIRS="
+                   (list (string-append "XDG_DATA_DIRS=" #$jamid "/share"))))
-                                           #$jamid "/share")))))
-
-                  ;; XXX: This manual synchronization probably wouldn't be
-                  ;; needed if we were using a PID file, but providing it via a
-                  ;; customized config file with <pidfile> would not override
-                  ;; the one inherited from the base config of D-Bus.
-                  (let ((sock (socket PF_UNIX SOCK_STREAM 0)))
-                    (with-retries 20 1 (catch 'system-error
-                                         (lambda ()
-                                           (connect sock AF_UNIX
-                                                    "/var/run/jami/bus")
-                                           (close-port sock)
-                                           #t)
-                                         (lambda args
-                                           #f))))
-
-                  pid))
                (stop #~(make-kill-destructor)))
 
               (shepherd-service
@@ -580,6 +546,7 @@ (define pid
                           (ice-9 receive)
                           (srfi srfi-1)
                           (srfi srfi-26)
+                          (gnu build dbus-service)
                           (gnu build jami-service)
                           (gnu build shepherd)
                           (gnu system file-systems)
@@ -653,14 +620,11 @@ (define daemon-pid
                               ;; Expose TLS certificates for OpenSSL.
                               "SSL_CERT_DIR=/etc/ssl/certs"))))
 
-                  (parameterize ((%send-dbus-binary #$dbus-send)
+                    (setenv "DBUS_SESSION_BUS_ADDRESS"
-                                 (%send-dbus-bus    "unix:path=/var/run/jami/bus")
+                            "unix:path=/var/run/jami/bus")
-                                 (%send-dbus-user   "jami")
-                                 (%send-dbus-group  "jami"))
 
                     ;; Wait until the service name has been acquired by D-Bus.
-                    (with-retries 20 1
+                    (with-retries 20 1 (jami-service-available?))
-                      (dbus-service-available? "cx.ring.Ring"))
 
                     (when #$declarative-mode?
                       ;; Provision the accounts via the D-Bus API of the daemon.
@@ -717,7 +681,7 @@ (define (archive-name->username archive)
                                  (map-in-order (cut jami-account-moderators <>)
                                                accounts))
                          '#$(and declarative-mode?
-                                 (map-in-order jami-account->alist accounts))))))
+                                 (map-in-order jami-account->alist accounts)))))
 
                     ;; Finally, return the PID of the daemon process.
                     daemon-pid))
@@ -727,7 +691,7 @@ (define (archive-name->username archive)
                     ;; Wait for the process to exit; this prevents overlapping
                     ;; processes when issuing 'herd restart'.
                     (waitpid pid)
-                  #f)))))))
+                    #f))))))))
 
 (define jami-service-type
   (service-type

gnu/tests/telephony.scm

@@ -20,6 +20,7 @@ (define-module (gnu tests telephony)
   #:use-module (gnu)
   #:use-module (gnu packages)
   #:use-module (gnu packages guile)
+  #:use-module (gnu packages guile-xyz)
   #:use-module (gnu tests)
   #:use-module (gnu system vm)
   #:use-module (gnu services)
@@ -125,16 +126,25 @@ (define username (assoc-ref %jami-account-content-sexp
                               "Account.username"))
 
   (define test
+    (with-extensions (list guile-packrat ;used by guile-ac-d-bus
+                           guile-ac-d-bus
+                           ;; Fibers is needed to provide the non-blocking
+                           ;; variant of the 'sleep' procedure.
+                           guile-fibers)
       (with-imported-modules (source-module-closure
                               '((gnu build marionette)
+                                (gnu build dbus-service)
                                 (gnu build jami-service)))
         #~(begin
             (use-modules (rnrs base)
                          (srfi srfi-11)
                          (srfi srfi-64)
                          (gnu build marionette)
+                         (gnu build dbus-service)
                          (gnu build jami-service))
 
+            (setenv "DBUS_SESSION_BUS_ADDRESS" "unix:path=/var/run/jami/bus")
+
             (define marionette
               (make-marionette (list #$vm)))
 
@@ -144,70 +154,44 @@ (define marionette
             (test-assert "service is running"
               (marionette-eval
                '(begin
-                (use-modules (gnu services herd))
+                  (use-modules (gnu build jami-service))
-                (match (start-service 'jami)
+                  (jami-service-available?))
-                  (#f #f)
-                  (('service response-parts ...)
-                   (match (assq-ref response-parts 'running)
-                     ((pid) (number? pid))))))
                marionette))
 
             (test-assert "service can be stopped"
               (marionette-eval
                '(begin
-                (use-modules (gnu services herd)
+                  (use-modules (gnu build jami-service)
+                               (gnu services herd)
                                (rnrs base))
-                (setenv "PATH" "/run/current-system/profile/bin")
+                  (assert (jami-service-available?))
-                (let ((pid (match (start-service 'jami)
-                             (#f #f)
-                             (('service response-parts ...)
-                              (match (assq-ref response-parts 'running)
-                                ((pid) pid))))))
 
-                  (assert (number? pid))
+                  (stop-service 'jami)
 
-                  (match (stop-service 'jami)
+                  (with-retries 20 1 (not (jami-service-available?))))
-                    (services           ;a list of service symbols
-                     (member 'jami services)))
-                  ;; Sometimes, the process still appear in pgrep, even
-                  ;; though we are using waitpid after sending it SIGTERM
-                  ;; in the service; use retries.
-                  (with-retries 20 1
-                    (not (zero? (status:exit-val
-                                 (system* "pgrep" "jamid")))))))
                marionette))
 
             (test-assert "service can be restarted"
               (marionette-eval
                '(begin
-                (use-modules (gnu services herd)
+                  (use-modules (gnu build dbus-service)
-                             (rnrs base))
+                               (gnu build jami-service)
-                ;; Start and retrieve the current PID.
+                               (gnu services herd)
-                (define pid (match (start-service 'jami)
+                               (rnrs base)                               )
-                              (#f #f)
+                  ;; Start the service.
-                              (('service response-parts ...)
+                  (start-service 'jami)
-                               (match (assq-ref response-parts 'running)
+                  (with-retries 20 1 (jami-service-available?))
-                                 ((pid) pid)))))
-                (assert (number? pid))
-
                   ;; Restart the service.
                   (restart-service 'jami)
-
+                  (with-retries 20 1 (jami-service-available?)))
-                (define new-pid (match (start-service 'jami)
-                                  (#f #f)
-                                  (('service response-parts ...)
-                                   (match (assq-ref response-parts 'running)
-                                     ((pid) pid)))))
-                (assert (number? new-pid))
-
-                (not (eq? pid new-pid)))
                marionette))
 
             (unless #$provisioning? (test-skip 1))
             (test-assert "jami accounts provisioning, account present"
               (marionette-eval
                '(begin
-                (use-modules (gnu services herd)
+                  (use-modules (gnu build dbus-service)
+                               (gnu services herd)
                                (rnrs base))
                   ;; Accounts take some time to appear after being added.
                   (with-retries 20 1
@@ -339,7 +323,7 @@ (define new-pid (match (start-service 'jami)
                                account-details)))))
                marionette))
 
-          (test-end))))
+            (test-end)))))
 
   (gexp->derivation (if provisioning?
                         "jami-provisioning-test"
@@ -357,7 +341,3 @@ (define %test-jami-provisioning
    (name "jami-provisioning")
    (description "Provisioning test for the jami service.")
    (value (run-jami-test #:provisioning? #t))))
-
-;; Local Variables:
-;; eval: (put 'with-retries 'scheme-indent-function 2)
-;; End: