unofficial mirror of bug-guix@gnu.org 
 help / color / mirror / code / Atom feed
* bug#54786: Installation tests are failing
@ 2022-04-08  9:51 Mathieu Othacehe
  2022-04-08 15:10 ` Mathieu Othacehe
  0 siblings, 1 reply; 20+ messages in thread
From: Mathieu Othacehe @ 2022-04-08  9:51 UTC (permalink / raw)
  To: 54786


Hello,

The installation tests are failing this way:

--8<---------------cut here---------------start------------->8---
conversation expecting pattern ((quote pause))
Apr  7 17:41:58 localhost installer[227]: guix system: error: failed to connect to `/var/guix/daemon-socket/socket': Connection refused 
--8<---------------cut here---------------end--------------->8---

this is right after the 'guix-daemon' service is restarted. It looks
like this regression is introduced by the switch to the new Shepherd
release.

See:
https://ci.guix.gnu.org/build/646754/details
https://ci.guix.gnu.org/build/646759/details
https://ci.guix.gnu.org/build/646766/details
https://ci.guix.gnu.org/build/646773/details

Thanks,

Mathieu





^ permalink raw reply	[flat|nested] 20+ messages in thread

* bug#54786: Installation tests are failing
  2022-04-08  9:51 bug#54786: Installation tests are failing Mathieu Othacehe
@ 2022-04-08 15:10 ` Mathieu Othacehe
  2022-04-28  7:22   ` Mathieu Othacehe
  0 siblings, 1 reply; 20+ messages in thread
From: Mathieu Othacehe @ 2022-04-08 15:10 UTC (permalink / raw)
  To: 54786


The following tests are also failing since the Shepherd upgrade:

* cgit-test (https://ci.guix.gnu.org/build/646812/details)
* tailon-test (https://ci.guix.gnu.org/build/646822/details)
* gitile-test (https://ci.guix.gnu.org/build/646813/details)
* jami-provisioning-test (https://ci.guix.gnu.org/build/646810/details)
* jami-test (https://ci.guix.gnu.org/build/646811/details)

Thanks,

Mathieu




^ permalink raw reply	[flat|nested] 20+ messages in thread

* bug#54786: Installation tests are failing
  2022-04-08 15:10 ` Mathieu Othacehe
@ 2022-04-28  7:22   ` Mathieu Othacehe
  2022-04-28 19:19     ` Ludovic Courtès
  0 siblings, 1 reply; 20+ messages in thread
From: Mathieu Othacehe @ 2022-04-28  7:22 UTC (permalink / raw)
  To: 54786


Hello,

Those tests are still failing. It looks like most of the failures are
caused by daemons started multiple times.

> * cgit-test (https://ci.guix.gnu.org/build/646812/details)

The nginx daemon seems to be started multiple times:

--8<---------------cut here---------------start------------->8---
nginx: [emerg] bind() to 0.0.0.0:19418 failed (98: Address already in use)
nginx: [emerg] bind() to 0.0.0.0:19418 failed (98: Address already in use)



This is the GNU system.  Welcome.
komputilo login: nginx: [emerg] bind() to 0.0.0.0:19418 failed (98: Address already in use)
nginx: [emerg] bind() to 0.0.0.0:19418 failed (98: Address already in use)
nginx: [emerg] bind() to 0.0.0.0:19418 failed (98: Address already in use)
nginx: [emerg] still could not bind()
/gnu/store/01phrvxnxrg1q0gxa35g7f77q06crf6v-shepherd-marionette.scm:1:1718: ERROR:
  1. &action-exception-error:
      service: nginx
      action: start
      key: %exception
      args: ("#<&invoke-error program: \"/gnu/store/815abphg8vr8qkl8ykd8pyxp1v62c9gk-nginx-1.21.6/sbin/nginx\" arguments: (\"-c\" \"/gnu/store/rbjgg41p22lgkjwrc8inrhbmqah54cgq-nginx.conf\" \"-p\" \"/var/run/nginx\") exit-status: 1 term-signal: #f stop-signal: #f>")

Tests failed, dumping log file '/gnu/store/p72g83l9nag6c830pzwgcgpnvnyr53p1-cgit-test/cgit.log'.
--8<---------------cut here---------------end--------------->8---

> * gitile-test (https://ci.guix.gnu.org/build/646813/details)

The nginx daemon seems to be started multiple times:

--8<---------------cut here---------------start------------->8---
nginx: [emerg] bind() to 0.0.0.0:19418 failed (98: Address already in use)
nginx: [emerg] bind() to 0.0.0.0:19418 failed (98: Address already in use)



This is the GNU system.  Welcome.
komputilo login: nginx: [emerg] bind() to 0.0.0.0:19418 failed (98: Address already in use)
nginx: [emerg] bind() to 0.0.0.0:19418 failed (98: Address already in use)
nginx: [emerg] bind() to 0.0.0.0:19418 failed (98: Address already in use)
nginx: [emerg] still could not bind()
/gnu/store/01phrvxnxrg1q0gxa35g7f77q06crf6v-shepherd-marionette.scm:1:1718: ERROR:
  1. &action-exception-error:
      service: nginx
      action: start
      key: %exception
      args: ("#<&invoke-error program: \"/gnu/store/815abphg8vr8qkl8ykd8pyxp1v62c9gk-nginx-1.21.6/sbin/nginx\" arguments: (\"-c\" \"/gnu/store/ayafihmfwg3yw4hp8nw622g2rr9mw7vn-nginx.conf\" \"-p\" \"/var/run/nginx\") exit-status: 1 term-signal: #f stop-signal: #f>")

Tests failed, dumping log file '/gnu/store/ix0hpwpr7b6zh20arig9bpg2lqzysxi7-gitile-test/gitile.log'.
--8<---------------cut here---------------end--------------->8---

> * jami-provisioning-test (https://ci.guix.gnu.org/build/646810/details)
> * jami-test (https://ci.guix.gnu.org/build/646811/details)

Looks like those tests are failing because the daemon is started
multiple times:

--8<---------------cut here---------------start------------->8---
This is the GNU system.  Welcome.
jami login: Jami Daemon 11.0.0, by Savoir-faire Linux 2004-2019
https://jami.net/
[Video support enabled]
[Plugins support enabled]

12:21:08.165         os_core_unix.c !pjlib 2.11 for POSIX initialized
Jami Daemon 11.0.0, by Savoir-faire Linux 2004-2019
https://jami.net/
[Video support enabled]
[Plugins support enabled]

One does not simply initialize the client: Another daemon is detected
/gnu/store/01phrvxnxrg1q0gxa35g7f77q06crf6v-shepherd-marionette.scm:1:1718: ERROR:
  1. &action-exception-error:
      service: jami
      action: start
      key: match-error
      args: ("match" "no matching pattern" #f)
Jami Daemon 11.0.0, by Savoir-faire Linux 2004-2019
https://jami.net/
[Video support enabled]
[Plugins support enabled]

One does not simply initialize the client: Another daemon is detected
/gnu/store/01phrvxnxrg1q0gxa35g7f77q06crf6v-shepherd-marionette.scm:1:1718: ERROR:
  1. &action-exception-error:
      service: jami
      action: start
      key: match-error
      args: ("match" "no matching pattern" #f)
Jami Daemon 11.0.0, by Savoir-faire Linux 2004-2019
https://jami.net/
[Video support enabled]
[Plugins support enabled]

One does not simply initialize the client: Another daemon is detected
/gnu/store/01phrvxnxrg1q0gxa35g7f77q06crf6v-shepherd-marionette.scm:1:1718: ERROR:
  1. &action-exception-error:
      service: jami
      action: start
      key: match-error
      args: ("match" "no matching pattern" #f)
--8<---------------cut here---------------end--------------->8---

Thanks,

Mathieu




^ permalink raw reply	[flat|nested] 20+ messages in thread

* bug#54786: Installation tests are failing
  2022-04-28  7:22   ` Mathieu Othacehe
@ 2022-04-28 19:19     ` Ludovic Courtès
  2022-04-29 19:50       ` Ludovic Courtès
  0 siblings, 1 reply; 20+ messages in thread
From: Ludovic Courtès @ 2022-04-28 19:19 UTC (permalink / raw)
  To: Mathieu Othacehe; +Cc: 54786

Hi!

Mathieu Othacehe <othacehe@gnu.org> skribis:

>> * cgit-test (https://ci.guix.gnu.org/build/646812/details)
>
> The nginx daemon seems to be started multiple times:

I believe this is caused by a change of semantics (really: a bug) in the
shepherd ‘start’ method in 0.9.0.

Previously, ‘start’ would wait until the daemon was started.  If the
service was being started, shepherd wouldn’t reply until it was done
starting it.

In 0.9.0, shepherd replies even while it’s waiting for the service to be
started.  But as a consequence, it lets you start a service that is
already being started, leading to this mess you reported.


The proper fix is to better track the status of each service in
shepherd, and to prevent double-starts.

In the interim, perhaps we can work around that by using a different
check to determine whether the service is running.  For instance,
instead of:

          (test-assert "nginx running"
            (marionette-eval
             '(begin
                (use-modules (gnu services herd))
                (start-service 'nginx))
             marionette))

… we’d write something like:

          (test-assert "nginx running"
            (wait-for-file "/var/run/nginx/pid"))

Thoughts?  I’ll give that a try.

Thanks for the heads-up!

Ludo’.




^ permalink raw reply	[flat|nested] 20+ messages in thread

* bug#54786: Installation tests are failing
  2022-04-28 19:19     ` Ludovic Courtès
@ 2022-04-29 19:50       ` Ludovic Courtès
  2022-04-30 13:02         ` Mathieu Othacehe
  0 siblings, 1 reply; 20+ messages in thread
From: Ludovic Courtès @ 2022-04-29 19:50 UTC (permalink / raw)
  To: Mathieu Othacehe; +Cc: 54786

Ludovic Courtès <ludo@gnu.org> skribis:

> In the interim, perhaps we can work around that by using a different
> check to determine whether the service is running.  For instance,
> instead of:
>
>           (test-assert "nginx running"
>             (marionette-eval
>              '(begin
>                 (use-modules (gnu services herd))
>                 (start-service 'nginx))
>              marionette))
>
> … we’d write something like:
>
>           (test-assert "nginx running"
>             (wait-for-file "/var/run/nginx/pid"))

I pushed something along these lines as
73eeeeafbb0765f76834b53c9fe6cf3c8f740840.

I wasn’t able to fix the tailon test because the ‘tailon’ package
doesn’t build and I failed to address that in a timely fashion.

Ludo’.




^ permalink raw reply	[flat|nested] 20+ messages in thread

* bug#54786: Installation tests are failing
  2022-04-29 19:50       ` Ludovic Courtès
@ 2022-04-30 13:02         ` Mathieu Othacehe
  2022-05-01 13:26           ` Ludovic Courtès
  0 siblings, 1 reply; 20+ messages in thread
From: Mathieu Othacehe @ 2022-04-30 13:02 UTC (permalink / raw)
  To: Ludovic Courtès; +Cc: 54786


Hey Ludo,

> I pushed something along these lines as
> 73eeeeafbb0765f76834b53c9fe6cf3c8f740840.

Thanks for the fix! The jami and jami-provisioning tests are also broken
because of what looks like to be the same issue:

--8<---------------cut here---------------start------------->8---
One does not simply initialize the client: Another daemon is detected
/gnu/store/01phrvxnxrg1q0gxa35g7f77q06crf6v-shepherd-marionette.scm:1:1718: ERROR:
  1. &action-exception-error:
      service: jami
      action: start
      key: match-error
      args: ("match" "no matching pattern" #f)
Jami Daemon 11.0.0, by Savoir-faire Linux 2004-2019
https://jami.net/
[Video support enabled]
[Plugins support enabled]
--8<---------------cut here---------------end--------------->8---

I think we don't have the right approach here: we should check that the
system tests are passing before pushing series and not adapt the tests
afterwards.

Historically this was difficult because the system tests were often in a
semi-broken state. Before the Shepherd update the tests were however all
passing (modulo rare intermittent failures).

As it's not always obvious what's going to break the system tests and
what's not (simple package update can easily break them), it would be
really nice to have mandatory commit verification.

The mumi/cuirass gateway that has already been discussed could really
help us here. If some people are motivated, we could split the work and
introduce such a mechanism.

Thanks,

Mathieu





^ permalink raw reply	[flat|nested] 20+ messages in thread

* bug#54786: Installation tests are failing
  2022-04-30 13:02         ` Mathieu Othacehe
@ 2022-05-01 13:26           ` Ludovic Courtès
  2022-05-25  3:43             ` Maxim Cournoyer
  0 siblings, 1 reply; 20+ messages in thread
From: Ludovic Courtès @ 2022-05-01 13:26 UTC (permalink / raw)
  To: Mathieu Othacehe; +Cc: 54786

Hi,

Mathieu Othacehe <othacehe@gnu.org> skribis:

> Thanks for the fix! The jami and jami-provisioning tests are also broken
> because of what looks like to be the same issue:
>
> One does not simply initialize the client: Another daemon is detected
> /gnu/store/01phrvxnxrg1q0gxa35g7f77q06crf6v-shepherd-marionette.scm:1:1718: ERROR:
>   1. &action-exception-error:
>       service: jami
>       action: start
>       key: match-error
>       args: ("match" "no matching pattern" #f)
> Jami Daemon 11.0.0, by Savoir-faire Linux 2004-2019
> https://jami.net/
> [Video support enabled]
> [Plugins support enabled]

Yes, I noticed that, but I’m not sure how to apply a similar workaround.

> I think we don't have the right approach here: we should check that the
> system tests are passing before pushing series and not adapt the tests
> afterwards.

Yes, apologies for that.

> Historically this was difficult because the system tests were often in a
> semi-broken state. Before the Shepherd update the tests were however all
> passing (modulo rare intermittent failures).
>
> As it's not always obvious what's going to break the system tests and
> what's not (simple package update can easily break them), it would be
> really nice to have mandatory commit verification.
>
> The mumi/cuirass gateway that has already been discussed could really
> help us here. If some people are motivated, we could split the work and
> introduce such a mechanism.

Yes, I agree; an “always green” ‘master’ branch would be great.

Do you have milestones in mind for “commit verification”?

As I see it, the difficulty is that we’ve been looking at a horizon of
features à la GitLab-CI without being quite sure how to get there (apart
from deploying GitLab or a similar tool, that is).

A first step that comes to mind would be an easier way to set up
transient jobsets for a branch (or, ideally, for an issue: the thing
would apply patches and create the branch).

Thoughts?

(Maybe worth moving to guix-devel.)

Ludo’.




^ permalink raw reply	[flat|nested] 20+ messages in thread

* bug#54786: Installation tests are failing
  2022-05-01 13:26           ` Ludovic Courtès
@ 2022-05-25  3:43             ` Maxim Cournoyer
  2022-05-28 21:29               ` Ludovic Courtès
  0 siblings, 1 reply; 20+ messages in thread
From: Maxim Cournoyer @ 2022-05-25  3:43 UTC (permalink / raw)
  To: Ludovic Courtès; +Cc: Mathieu Othacehe, 54786

Hi,

Ludovic Courtès <ludo@gnu.org> writes:

> Hi,
>
> Mathieu Othacehe <othacehe@gnu.org> skribis:
>
>> Thanks for the fix! The jami and jami-provisioning tests are also broken
>> because of what looks like to be the same issue:
>>
>> One does not simply initialize the client: Another daemon is detected
>> /gnu/store/01phrvxnxrg1q0gxa35g7f77q06crf6v-shepherd-marionette.scm:1:1718: ERROR:
>>   1. &action-exception-error:
>>       service: jami
>>       action: start
>>       key: match-error
>>       args: ("match" "no matching pattern" #f)
>> Jami Daemon 11.0.0, by Savoir-faire Linux 2004-2019
>> https://jami.net/
>> [Video support enabled]
>> [Plugins support enabled]
>
> Yes, I noticed that, but I’m not sure how to apply a similar workaround.

I tried fixing that today, but so far I've only managed to understand
what seems to be going wrong, with this (not so great) workflow:

1. Add pk uses in the code.

2. $(./pre-inst-env guix system vm --no-graphic -e '(@@ (gnu tests
telephony) %jami-os)' --no-offload --no-substitutes) -m 512 -nic
user,model=virtio-net-pci,hostfwd=tcp::10022-:22

3. ssh -o UserKnownHostsFile=/dev/null -o StrictHostKeyChecking=no -p
10022 root@localhost

and poke around with 'herd status', read /var/log/messages, experiment
with dbus-send, etc.

This allowed me to find out that (dbus-available-services) appears to be
broken.  I'm not sure why the exceptions are reported so badly by
Shepherd (are exceptions raised with 'error' not handled by Shepherd or
something? -- the with-retries loop should end up printing the caught
exception arguments -- I would also have expected to see the backtrace
somewhere.

Anyway, connecting to another machine that is running the
jami-service-type still (hasn't been reconfigured in a while), I could
see:

--8<---------------cut here---------------start------------->8---
scheme@(guix-user)> ,use (gnu build jami-service)
scheme@(guix-user)> (dbus-available-services)
;;; Failed to autoload fork+exec-command in (shepherd service):
;;; no code for module (fibers)
ice-9/boot-9.scm:1685:16: In procedure raise-exception:
error: fork+exec-command: unbound variable
--8<---------------cut here---------------end--------------->8---

Oh yes, so it now requires guile-fibers.  After installing it:

--8<---------------cut here---------------start------------->8---
scheme@(guix-user)> ,use (gnu build jami-service)
scheme@(guix-user)> (dbus-available-services)
ice-9/boot-9.scm:1685:16: In procedure raise-exception:
No scheduler current; call within run-fibers instead
--8<---------------cut here---------------end--------------->8---

So the users of fork+exec-command (a public API) needs to be adjusted.
I suspect that's the crux of the issue here.  The rest (the jami tests
using Shepherd's start-service to check the service status and causing
multiple starts) should be easy to workaround.

To be continued...

Maxim




^ permalink raw reply	[flat|nested] 20+ messages in thread

* bug#54786: Installation tests are failing
  2022-05-25  3:43             ` Maxim Cournoyer
@ 2022-05-28 21:29               ` Ludovic Courtès
  2022-05-31 16:44                 ` bug#54786: [PATCH] services: jami: Modernize to adjust to Shepherd 0.9+ changes Maxim Cournoyer
  0 siblings, 1 reply; 20+ messages in thread
From: Ludovic Courtès @ 2022-05-28 21:29 UTC (permalink / raw)
  To: Maxim Cournoyer; +Cc: Mathieu Othacehe, 54786

[-- Attachment #1: Type: text/plain, Size: 1450 bytes --]

Hi Maxim,

Maxim Cournoyer <maxim.cournoyer@gmail.com> skribis:

> Ludovic Courtès <ludo@gnu.org> writes:
>
>> Hi,
>>
>> Mathieu Othacehe <othacehe@gnu.org> skribis:
>>
>>> Thanks for the fix! The jami and jami-provisioning tests are also broken
>>> because of what looks like to be the same issue:
>>>
>>> One does not simply initialize the client: Another daemon is detected
>>> /gnu/store/01phrvxnxrg1q0gxa35g7f77q06crf6v-shepherd-marionette.scm:1:1718: ERROR:
>>>   1. &action-exception-error:
>>>       service: jami
>>>       action: start
>>>       key: match-error
>>>       args: ("match" "no matching pattern" #f)
>>> Jami Daemon 11.0.0, by Savoir-faire Linux 2004-2019
>>> https://jami.net/
>>> [Video support enabled]
>>> [Plugins support enabled]
>>
>> Yes, I noticed that, but I’m not sure how to apply a similar workaround.
>
> I tried fixing that today, but so far I've only managed to understand
> what seems to be going wrong, with this (not so great) workflow:

While working on <https://issues.guix.gnu.org/55444>, I figured
‘wait-for-service’ could be useful for system tests that were previously
using ‘start-service’ as a way to wait for a service to be up and
running.

I tried the following change, which should be semantically equivalent to
what was happening with the Shepherd 0.8.  However, it doesn’t seem to
work, for reasons that escape me.

Thoughts?

Ludo’.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Type: text/x-patch, Size: 2012 bytes --]

diff --git a/gnu/tests/telephony.scm b/gnu/tests/telephony.scm
index bc464a431a..c219868859 100644
--- a/gnu/tests/telephony.scm
+++ b/gnu/tests/telephony.scm
@@ -145,11 +145,7 @@ (define marionette
             (marionette-eval
              '(begin
                 (use-modules (gnu services herd))
-                (match (start-service 'jami)
-                  (#f #f)
-                  (('service response-parts ...)
-                   (match (assq-ref response-parts 'running)
-                     ((pid) (number? pid))))))
+                (wait-for-service 'jami #:timeout 60))
              marionette))
 
           (test-assert "service can be stopped"
@@ -158,12 +154,7 @@ (define marionette
                 (use-modules (gnu services herd)
                              (rnrs base))
                 (setenv "PATH" "/run/current-system/profile/bin")
-                (let ((pid (match (start-service 'jami)
-                             (#f #f)
-                             (('service response-parts ...)
-                              (match (assq-ref response-parts 'running)
-                                ((pid) pid))))))
-
+                (let ((pid (wait-for-service 'jami)))
                   (assert (number? pid))
 
                   (match (stop-service 'jami)
@@ -193,14 +184,10 @@ (define pid (match (start-service 'jami)
                 ;; Restart the service.
                 (restart-service 'jami)
 
-                (define new-pid (match (start-service 'jami)
-                                  (#f #f)
-                                  (('service response-parts ...)
-                                   (match (assq-ref response-parts 'running)
-                                     ((pid) pid)))))
+                (define new-pid (wait-for-service 'jami))
                 (assert (number? new-pid))
 
-                (not (eq? pid new-pid)))
+                (not (= pid new-pid)))
              marionette))
 
           (unless #$provisioning? (test-skip 1))

^ permalink raw reply related	[flat|nested] 20+ messages in thread

* bug#54786: [PATCH] services: jami: Modernize to adjust to Shepherd 0.9+ changes.
  2022-05-28 21:29               ` Ludovic Courtès
@ 2022-05-31 16:44                 ` Maxim Cournoyer
  2022-06-01  9:54                   ` bug#54786: Installation tests are failing Ludovic Courtès
  0 siblings, 1 reply; 20+ messages in thread
From: Maxim Cournoyer @ 2022-05-31 16:44 UTC (permalink / raw)
  To: 54786; +Cc: othacehe, ludo, Maxim Cournoyer

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'.
---
 gnu/build/dbus-service.scm | 212 ++++++++++++++++
 gnu/build/jami-service.scm | 390 +++++------------------------
 gnu/local.mk               |   1 +
 gnu/packages/glib.scm      |  19 +-
 gnu/services/telephony.scm | 500 +++++++++++++++++--------------------
 gnu/tests/telephony.scm    | 412 +++++++++++++++---------------
 6 files changed, 726 insertions(+), 808 deletions(-)
 create mode 100644 gnu/build/dbus-service.scm

diff --git a/gnu/build/dbus-service.scm b/gnu/build/dbus-service.scm
new file mode 100644
index 0000000000..d3d8c9f716
--- /dev/null
+++ b/gnu/build/dbus-service.scm
@@ -0,0 +1,212 @@
+;;; 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?
+
+            sleep*
+            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* (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))))))
+
+\f
+;;;
+;;; 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)))
+
+\f
+;;;
+;;; 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:
diff --git a/gnu/build/jami-service.scm b/gnu/build/jami-service.scm
index ddfc8cf937..0ceb03eb02 100644
--- a/gnu/build/jami-service.scm
+++ b/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
-
-            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))
+            username->moderators))
 
 ;;;
 ;;; 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,212 +73,34 @@ (define (account-fingerprint? val)
   (and (string? val)
        (regexp-exec account-fingerprint-rx val)))
 
-\f
-;;;
-;;; 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))))
-
-\f
-;;;
-;;; Low-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)))
 
-;;; 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))))
+(define (jami-service-available?)
+  "Whether the Jami D-Bus service was acquired by the D-Bus daemon."
+  (unless (%current-dbus-connection)
+    (initialize-dbus-connection!))
+  (dbus-service-available? "cx.ring.Ring"))
 
 \f
 ;;;
-;;; Higher-level, D-Bus-related procedures.
+;;; Bindings for the Jami D-Bus API.
 ;;;
 
-(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)
-  "Return the list of available (acquired) D-Bus services."
-  (let ((reply (parse-dbus-reply
-                (send-dbus #:service "org.freedesktop.DBus"
-                           #:path "/org/freedesktop/DBus"
-                           #: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)))
-
-(define* (send-dbus/configuration-manager #:key method arguments timeout)
-  "Query the Jami D-Bus ConfigurationManager service."
-  (send-dbus #:service "cx.ring.Ring"
-             #:path "/cx/ring/Ring/ConfigurationManager"
-             #:interface "cx.ring.Ring.ConfigurationManager"
-             #:method method
-             #:arguments arguments
-             #:timeout timeout))
+(define* (call-configuration-manager-method method #:optional arguments
+                                            #:key timeout)
+  "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"
+                    #:arguments arguments
+                    #:timeout timeout))
 
 ;;; The following methods are for internal use; they make use of the account
 ;;; ID, an implementation detail of Jami the user should not need to be
@@ -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
-   (send-dbus/configuration-manager #:method "getAccountList")))
+  (vector->list (call-configuration-manager-method "getAccountList")))
 
 (define (id->account-details id)
   "Retrieve the account data associated with the given account ID."
-  (parse-account-details
-   (send-dbus/configuration-manager
-    #:method "getAccountDetails"
-    #:arguments (list (string-append "string:" id)))))
+  (vector->list (call-configuration-manager-method "getAccountDetails"
+                                                   (list id))))
 
 (define (id->volatile-account-details id)
   "Retrieve the account data associated with the given account ID."
-  (parse-account-details
-   (send-dbus/configuration-manager
-    #:method "getVolatileAccountDetails"
-    #:arguments (list (string-append "string:" id)))))
+  (vector->list (call-configuration-manager-method "getVolatileAccountDetails"
+                                                   (list 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\
- for ~:[username~;fingerprint~]" (account-fingerprint? username))))
+      (let ((message (format #f "no account ID for ~:[username~;fingerprint~]"
+                             (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
-                #:method "addAccount"
-                #:arguments (list (string-append
-                                   "dict:string:string:Account.archivePath,"
-                                   archive
-                                   ",Account.type,RING")))))
+  (let ((id (call-configuration-manager-method
+             "addAccount" (list `#(("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)
-              #f
-              username))))))
+    (with-retries 20 1
+      (let ((username (id->username id)))
+        (if (and=> username (negate string-null?))
+            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
-     #:method "removeAccount"
-     #:arguments (list (string-append "string:" id))))
+    (call-configuration-manager-method "removeAccount" (list 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
-                 #:method "getContacts"
-                 #:arguments (list (string-append "string:" id))))
-         (all-contacts (parse-contacts reply))
+         ;; The contacts are returned as "aa{ss}", that is, an array of arrays
+         ;; containing (string . string) pairs.
+         (contacts (map vector->list
+                        (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))
-         (not-banned (filter (negate banned?) all-contacts))
+         (banned (filter banned? 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
-     #:method "removeContact"
-     #:arguments (list (string-append "string:" id)
-                       (string-append "string:" contact)
-                       (serialize-boolean ban?)))))
+    (call-configuration-manager-method "removeContact" (list id contact 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
-     #:method "addContact"
-     #:arguments (list (string-append "string:" id)
-                       (string-append "string:" contact)))))
+    (call-configuration-manager-method "addContact" (list id 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))
-         ;; dbus-send does not permit sending null strings (it throws a
-         ;; "malformed dictionary" error).  Luckily they seem to have the
-         ;; semantic of "default account value" in Jami; so simply drop them.
-         (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*)
-                                       ","))))))
+                               current-details)))
+    (call-configuration-manager-method
+     "setAccountDetails" (list id (list->vector updated-details))
+     #:timeout timeout)))
 
 (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
-     #:method "setAllModerators"
-     #:arguments
-     (list (string-append "string:" id)
-           (serialize-boolean enabled?)))))
+    (call-configuration-manager-method "setAllModerators" (list id 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))
-         (reply (send-dbus/configuration-manager
-                 #:method "isAllModerators"
-                 #:arguments
-                 (list (string-append "string:" id)))))
-    (deserialize-item (parse-dbus-reply reply))))
+  (let ((id (username->id username)))
+    (call-configuration-manager-method "isAllModerators" (list id))))
 
 (define (username->moderators username)
   "Return the moderators for the account of USERNAME, a registered username or
 account fingerprint."
-  (let* ((id (username->id username))
-         (reply (send-dbus/configuration-manager
-                 #:method "getDefaultModerators"
-                 #:arguments
-                 (list (string-append "string:" id)))))
-    (array->list (parse-dbus-reply reply))))
+  (let* ((id (username->id username)))
+    (vector->list (call-configuration-manager-method "getDefaultModerators"
+                                                     (list id)))))
 
 (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"
-                                     #:arguments
-                                     (list (string-append "string:" id)
-                                           (string-append "string:" contact)
-                                           (serialize-boolean enabled?)))))
+    (call-configuration-manager-method "setDefaultModerator"
+                                       (list id contact 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:
diff --git a/gnu/local.mk b/gnu/local.mk
index 93b4902151..7d5bef19c9 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -716,6 +716,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			\
diff --git a/gnu/packages/glib.scm b/gnu/packages/glib.scm
index 30e5433776..93526fa29f 100644
--- a/gnu/packages/glib.scm
+++ b/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")
diff --git a/gnu/services/telephony.scm b/gnu/services/telephony.scm
index d8ebc7b39d..3b397054a8 100644
--- a/gnu/services/telephony.scm
+++ b/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,26 +306,27 @@ (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-imported-modules (source-module-closure
-                            '((gnu build jami-service)
-                              (gnu build shepherd)
-                              (gnu system file-systems)))
-
-      (define list-accounts-action
-        (shepherd-action
-         (name 'list-accounts)
-         (documentation "List the available Jami accounts.  Return the account
+    (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 dbus-service)
+                                (gnu build jami-service)
+                                (gnu build shepherd)
+                                (gnu system file-systems)))
+
+        (define list-accounts-action
+          (shepherd-action
+           (name 'list-accounts)
+           (documentation "List the available Jami accounts.  Return the account
 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"))
+           (procedure
+            #~(lambda _
                 ;; Print the accounts summary or long listing, according to
                 ;; user-provided option.
                 (let* ((usernames (get-usernames))
@@ -341,39 +356,31 @@ (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
-         (name 'list-account-details)
-         (documentation "Display the account details of the available Jami
+        (define list-account-details-action
+          (shepherd-action
+           (name 'list-account-details)
+           (documentation "Display the account details of the available Jami
 accounts in the @code{recutils} format.  Return the account 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"))
+           (procedure
+            #~(lambda _
                 (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
-         (name 'list-contacts)
-         (documentation "Display the contacts for each Jami account.  Return
+        (define list-contacts-action
+          (shepherd-action
+           (name 'list-contacts)
+           (documentation "Display the contacts for each Jami account.  Return
 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"))
+           (procedure
+            #~(lambda _
                 (let* ((usernames (get-usernames))
                        (contacts (map-in-order username->contacts usernames)))
                   (for-each (lambda (username contacts)
@@ -381,19 +388,15 @@ (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
-         (name 'list-moderators)
-         (documentation "Display the moderators for each Jami account.  Return
+        (define list-moderators-action
+          (shepherd-action
+           (name 'list-moderators)
+           (documentation "Display the moderators for each Jami account.  Return
 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"))
+           (procedure
+            #~(lambda _
                 (let* ((usernames (get-usernames))
                        (moderators (map-in-order username->moderators
                                                  usernames)))
@@ -406,12 +409,12 @@ (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
-         (name 'add-moderator)
-         (documentation "Add a moderator for a given Jami account.  The
+        (define add-moderator-action
+          (shepherd-action
+           (name 'add-moderator)
+           (documentation "Add a moderator for a given Jami account.  The
 MODERATOR contact must be given as its 40 characters fingerprint, while the
 Jami account can be provided as its registered USERNAME or fingerprint.
 
@@ -420,21 +423,17 @@ (define add-moderator-action
 @end example
 
 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"))
+           (procedure
+            #~(lambda (_ moderator username)
                 (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
-         (name 'ban-contact)
-         (documentation "Ban a contact for a given or all Jami accounts, and
+        (define ban-contact-action
+          (shepherd-action
+           (name 'ban-contact)
+           (documentation "Ban a contact for a given or all Jami accounts, and
 clear their moderator flag.  The CONTACT must be given as its 40 characters
 fingerprint, while the Jami account can be provided as its registered USERNAME
 or fingerprint, or omitted.  When the account is omitted, CONTACT is banned
@@ -443,31 +442,22 @@ (define ban-contact-action
 @example
 herd ban-contact jami 1dbcb0f5f37324228235564b79f2b9737e9a008f [username]
 @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"))
+           (procedure
+            #~(lambda* (_ contact #:optional username)
                 (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
-         (name 'list-banned-contacts)
-         (documentation "List the banned contacts for each accounts.  Return
+        (define list-banned-contacts-action
+          (shepherd-action
+           (name 'list-banned-contacts)
+           (documentation "List the banned contacts for each accounts.  Return
 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"))
-
+           (procedure
+            #~(lambda _
                 (define banned-contacts
                   (let ((usernames (get-usernames)))
                     (map cons usernames
@@ -484,183 +474,157 @@ (define banned-contacts
                                        username)
                                (format #t "~{  - ~a~%~}~%" banned))))
                           banned-contacts)
-                banned-contacts)))))
+                banned-contacts))))
 
-      (define enable-account-action
-        (shepherd-action
-         (name 'enable-account)
-         (documentation "Enable an account.  It takes USERNAME as an argument,
+        (define enable-account-action
+          (shepherd-action
+           (name 'enable-account)
+           (documentation "Enable an account.  It takes USERNAME as an argument,
 either a registered username or the fingerprint of the account.")
-         (procedure
-          #~(lambda (_ username)
-              (parameterize ((%send-dbus-binary #$dbus-send)
-                             (%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
-         (name 'disable-account)
-         (documentation "Disable an account.  It takes USERNAME as an
+           (procedure
+            #~(lambda (_ username)
+                (enable-account username)))))
+
+        (define disable-account-action
+          (shepherd-action
+           (name 'disable-account)
+           (documentation "Disable an account.  It takes USERNAME as an
 argument, either a registered username or the fingerprint of the account.")
-         (procedure
-          #~(lambda (_ username)
-              (parameterize ((%send-dbus-binary #$dbus-send)
-                             (%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 jami-service)
-                        (gnu system file-systems)
-                        ,@%default-modules))
-             ;; The requirement on dbus-system is to ensure other required
-             ;; activation for D-Bus, such as a /etc/machine-id file.
-             (requirement '(dbus-system syslogd))
-             (start
-              #~(lambda args
-                  (define pid
-                    ((make-forkexec-constructor/container
-                      (list #$dbus-daemon "--session"
-                            "--address=unix:path=/var/run/jami/bus"
-                            "--nofork" "--syslog-only" "--nopidfile")
-                      #:mappings (list (file-system-mapping
-                                        (source "/dev/log") ;for syslog
-                                        (target source))
-                                       (file-system-mapping
-                                        (source "/var/run/jami")
-                                        (target source)
-                                        (writable? #t)))
-                      #:user "jami"
-                      #:group "jami"
-                      #:environment-variables
-                      ;; This is so that the cx.ring.Ring service D-Bus
-                      ;; definition is found by dbus-send.
-                      (list (string-append "XDG_DATA_DIRS="
-                                           #$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
-             (documentation "Run the Jami daemon.")
-             (provision '(jami))
-             (actions (list list-accounts-action
-                            list-account-details-action
-                            list-contacts-action
-                            list-moderators-action
-                            add-moderator-action
-                            ban-contact-action
-                            list-banned-contacts-action
-                            enable-account-action
-                            disable-account-action))
-             (requirement '(jami-dbus-session))
-             (modules `((ice-9 format)
-                        (ice-9 ftw)
-                        (ice-9 match)
-                        (ice-9 receive)
-                        (srfi srfi-1)
-                        (srfi srfi-26)
-                        (gnu build jami-service)
-                        (gnu build shepherd)
-                        (gnu system file-systems)
-                        ,@%default-modules))
-             (start
-              #~(lambda args
-                  (define (delete-file-recursively/safe file)
-                    ;; Ensure we're not deleting things outside of
-                    ;; /var/lib/jami.  This prevents a possible attack in case
-                    ;; the daemon is compromised and an attacker gains write
-                    ;; access to /var/lib/jami.
-                    (let ((parent-directory (dirname file)))
-                      (if (eq? 'symlink (stat:type (stat parent-directory)))
-                          (error "abnormality detected; unexpected symlink found at"
-                                 parent-directory)
-                          (delete-file-recursively file))))
-
-                  (when #$declarative-mode?
-                    ;; Clear the Jami configuration and accounts, to enforce the
-                    ;; declared state.
-                    (catch #t
-                      (lambda ()
-                        (for-each (cut delete-file-recursively/safe <>)
-                                  '("/var/lib/jami/.cache/jami"
-                                    "/var/lib/jami/.config/jami"
-                                    "/var/lib/jami/.local/share/jami"
-                                    "/var/lib/jami/accounts")))
-                      (lambda args
-                        #t))
-                    ;; Copy the Jami account archives from somewhere readable
-                    ;; by root to a place only the jami user can read.
-                    (let* ((accounts-dir "/var/lib/jami/accounts/")
-                           (pwd (getpwnam "jami"))
-                           (user (passwd:uid pwd))
-                           (group (passwd:gid pwd)))
-                      (mkdir-p accounts-dir)
-                      (chown accounts-dir user group)
-                      (for-each (lambda (f)
-                                  (let ((dest (string-append accounts-dir
-                                                             (basename f))))
-                                    (copy-file f dest)
-                                    (chown dest user group)))
-                                '#$(and declarative-mode?
-                                        (map jami-account-archive accounts)))))
-
-                  ;; Start the daemon.
-                  (define daemon-pid
-                    ((make-forkexec-constructor/container
-                      '#$(jami-configuration->command-line-arguments config)
-                      #:mappings
-                      (list (file-system-mapping
-                             (source "/dev/log") ;for syslog
-                             (target source))
-                            (file-system-mapping
-                             (source "/var/lib/jami")
-                             (target source)
-                             (writable? #t))
-                            (file-system-mapping
-                             (source "/var/run/jami")
-                             (target source)
-                             (writable? #t))
-                            ;; Expose TLS certificates for GnuTLS.
-                            (file-system-mapping
-                             (source #$(file-append nss-certs "/etc/ssl/certs"))
-                             (target "/etc/ssl/certs")))
-                      #:user "jami"
-                      #:group "jami"
-                      #:environment-variables
-                      (list (string-append "DBUS_SESSION_BUS_ADDRESS="
-                                           "unix:path=/var/run/jami/bus")
-                            ;; Expose TLS certificates for OpenSSL.
-                            "SSL_CERT_DIR=/etc/ssl/certs"))))
-
-                  (parameterize ((%send-dbus-binary #$dbus-send)
-                                 (%send-dbus-bus    "unix:path=/var/run/jami/bus")
-                                 (%send-dbus-user   "jami")
-                                 (%send-dbus-group  "jami"))
+           (procedure
+            #~(lambda (_ username)
+                (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))
+               ;; The requirement on dbus-system is to ensure other required
+               ;; activation for D-Bus, such as a /etc/machine-id file.
+               (requirement '(dbus-system syslogd))
+               (start
+                #~(make-forkexec-constructor/container
+                   (list #$dbus-daemon "--session"
+                         "--address=unix:path=/var/run/jami/bus"
+                         "--syslog-only")
+                   #:pid-file "/var/run/jami/pid"
+                   #:mappings
+                   (list (file-system-mapping
+                          (source "/dev/log") ;for syslog
+                          (target source))
+                         (file-system-mapping
+                          (source "/var/run/jami")
+                          (target source)
+                          (writable? #t)))
+                   #:user "jami"
+                   #:group "jami"
+                   #:environment-variables
+                   ;; This is so that the cx.ring.Ring service D-Bus
+                   ;; definition is found by dbus-daemon.
+                   (list (string-append "XDG_DATA_DIRS=" #$jamid "/share"))))
+               (stop #~(make-kill-destructor)))
+
+              (shepherd-service
+               (documentation "Run the Jami daemon.")
+               (provision '(jami))
+               (actions (list list-accounts-action
+                              list-account-details-action
+                              list-contacts-action
+                              list-moderators-action
+                              add-moderator-action
+                              ban-contact-action
+                              list-banned-contacts-action
+                              enable-account-action
+                              disable-account-action))
+               (requirement '(jami-dbus-session))
+               (modules `((ice-9 format)
+                          (ice-9 ftw)
+                          (ice-9 match)
+                          (ice-9 receive)
+                          (srfi srfi-1)
+                          (srfi srfi-26)
+                          (gnu build dbus-service)
+                          (gnu build jami-service)
+                          (gnu build shepherd)
+                          (gnu system file-systems)
+                          ,@%default-modules))
+               (start
+                #~(lambda args
+                    (define (delete-file-recursively/safe file)
+                      ;; Ensure we're not deleting things outside of
+                      ;; /var/lib/jami.  This prevents a possible attack in case
+                      ;; the daemon is compromised and an attacker gains write
+                      ;; access to /var/lib/jami.
+                      (let ((parent-directory (dirname file)))
+                        (if (eq? 'symlink (stat:type (stat parent-directory)))
+                            (error "abnormality detected; unexpected symlink found at"
+                                   parent-directory)
+                            (delete-file-recursively file))))
+
+                    (when #$declarative-mode?
+                      ;; Clear the Jami configuration and accounts, to enforce the
+                      ;; declared state.
+                      (catch #t
+                        (lambda ()
+                          (for-each (cut delete-file-recursively/safe <>)
+                                    '("/var/lib/jami/.cache/jami"
+                                      "/var/lib/jami/.config/jami"
+                                      "/var/lib/jami/.local/share/jami"
+                                      "/var/lib/jami/accounts")))
+                        (lambda args
+                          #t))
+                      ;; Copy the Jami account archives from somewhere readable
+                      ;; by root to a place only the jami user can read.
+                      (let* ((accounts-dir "/var/lib/jami/accounts/")
+                             (pwd (getpwnam "jami"))
+                             (user (passwd:uid pwd))
+                             (group (passwd:gid pwd)))
+                        (mkdir-p accounts-dir)
+                        (chown accounts-dir user group)
+                        (for-each (lambda (f)
+                                    (let ((dest (string-append accounts-dir
+                                                               (basename f))))
+                                      (copy-file f dest)
+                                      (chown dest user group)))
+                                  '#$(and declarative-mode?
+                                          (map jami-account-archive accounts)))))
+
+                    ;; Start the daemon.
+                    (define daemon-pid
+                      ((make-forkexec-constructor/container
+                        '#$(jami-configuration->command-line-arguments config)
+                        #:mappings
+                        (list (file-system-mapping
+                               (source "/dev/log") ;for syslog
+                               (target source))
+                              (file-system-mapping
+                               (source "/var/lib/jami")
+                               (target source)
+                               (writable? #t))
+                              (file-system-mapping
+                               (source "/var/run/jami")
+                               (target source)
+                               (writable? #t))
+                              ;; Expose TLS certificates for GnuTLS.
+                              (file-system-mapping
+                               (source #$(file-append nss-certs "/etc/ssl/certs"))
+                               (target "/etc/ssl/certs")))
+                        #:user "jami"
+                        #:group "jami"
+                        #:environment-variables
+                        (list (string-append "DBUS_SESSION_BUS_ADDRESS="
+                                             "unix:path=/var/run/jami/bus")
+                              ;; Expose TLS certificates for OpenSSL.
+                              "SSL_CERT_DIR=/etc/ssl/certs"))))
+
+                    (setenv "DBUS_SESSION_BUS_ADDRESS"
+                            "unix:path=/var/run/jami/bus")
 
                     ;; Wait until the service name has been acquired by D-Bus.
-                    (with-retries 20 1
-                      (dbus-service-available? "cx.ring.Ring"))
+                    (with-retries 20 1 (jami-service-available?))
 
                     (when #$declarative-mode?
                       ;; Provision the accounts via the D-Bus API of the daemon.
@@ -717,17 +681,17 @@ (define (archive-name->username archive)
                                  (map-in-order (cut jami-account-moderators <>)
                                                accounts))
                          '#$(and declarative-mode?
-                                 (map-in-order jami-account->alist accounts))))))
-
-                  ;; Finally, return the PID of the daemon process.
-                  daemon-pid))
-             (stop
-              #~(lambda (pid . args)
-                  (kill pid SIGKILL)
-                  ;; Wait for the process to exit; this prevents overlapping
-                  ;; processes when issuing 'herd restart'.
-                  (waitpid pid)
-                  #f)))))))
+                                 (map-in-order jami-account->alist accounts)))))
+
+                    ;; Finally, return the PID of the daemon process.
+                    daemon-pid))
+               (stop
+                #~(lambda (pid . args)
+                    (kill pid SIGKILL)
+                    ;; Wait for the process to exit; this prevents overlapping
+                    ;; processes when issuing 'herd restart'.
+                    (waitpid pid)
+                    #f))))))))
 
 (define jami-service-type
   (service-type
diff --git a/gnu/tests/telephony.scm b/gnu/tests/telephony.scm
index bc464a431a..16ee313f69 100644
--- a/gnu/tests/telephony.scm
+++ b/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,221 +126,204 @@ (define username (assoc-ref %jami-account-content-sexp
                               "Account.username"))
 
   (define test
-    (with-imported-modules (source-module-closure
-                            '((gnu build marionette)
-                              (gnu build jami-service)))
-      #~(begin
-          (use-modules (rnrs base)
-                       (srfi srfi-11)
-                       (srfi srfi-64)
-                       (gnu build marionette)
-                       (gnu build jami-service))
-
-          (define marionette
-            (make-marionette (list #$vm)))
-
-          (test-runner-current (system-test-runner #$output))
-          (test-begin "jami")
-
-          (test-assert "service is running"
-            (marionette-eval
-             '(begin
-                (use-modules (gnu services herd))
-                (match (start-service 'jami)
-                  (#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)
-                             (rnrs base))
-                (setenv "PATH" "/run/current-system/profile/bin")
-                (let ((pid (match (start-service 'jami)
-                             (#f #f)
-                             (('service response-parts ...)
-                              (match (assq-ref response-parts 'running)
-                                ((pid) pid))))))
-
-                  (assert (number? pid))
-
-                  (match (stop-service 'jami)
-                    (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-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)))
+
+            (test-runner-current (system-test-runner #$output))
+            (test-begin "jami")
+
+            (test-assert "service is running"
+              (marionette-eval
+               '(begin
+                  (use-modules (gnu build jami-service))
+                  (jami-service-available?))
+               marionette))
+
+            (test-assert "service can be stopped"
+              (marionette-eval
+               '(begin
+                  (use-modules (gnu build jami-service)
+                               (gnu services herd)
+                               (rnrs base))
+                  (assert (jami-service-available?))
+
+                  (stop-service 'jami)
+
+                  (with-retries 20 1 (not (jami-service-available?))))
+               marionette))
+
+            (test-assert "service can be restarted"
+              (marionette-eval
+               '(begin
+                  (use-modules (gnu build dbus-service)
+                               (gnu build jami-service)
+                               (gnu services herd)
+                               (rnrs base)                               )
+                  ;; Start the service.
+                  (start-service 'jami)
+                  (with-retries 20 1 (jami-service-available?))
+                  ;; Restart the service.
+                  (restart-service 'jami)
+                  (with-retries 20 1 (jami-service-available?)))
+               marionette))
+
+            (unless #$provisioning? (test-skip 1))
+            (test-assert "jami accounts provisioning, account present"
+              (marionette-eval
+               '(begin
+                  (use-modules (gnu build dbus-service)
+                               (gnu services herd)
+                               (rnrs base))
+                  ;; Accounts take some time to appear after being added.
                   (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)
-                             (rnrs base))
-                ;; Start and retrieve the current PID.
-                (define pid (match (start-service 'jami)
-                              (#f #f)
-                              (('service response-parts ...)
-                               (match (assq-ref response-parts 'running)
-                                 ((pid) pid)))))
-                (assert (number? pid))
-
-                ;; Restart the service.
-                (restart-service 'jami)
-
-                (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)
-                             (rnrs base))
-                ;; Accounts take some time to appear after being added.
-                (with-retries 20 1
-                  (with-shepherd-action 'jami ('list-accounts) results
+                    (with-shepherd-action 'jami ('list-accounts) results
+                      (let ((account (assoc-ref (car results) #$username)))
+                        (assert (string=? #$username
+                                          (assoc-ref account
+                                                     "Account.username")))))))
+               marionette))
+
+            (unless #$provisioning? (test-skip 1))
+            (test-assert "jami accounts provisioning, allowed-contacts"
+              (marionette-eval
+               '(begin
+                  (use-modules (gnu services herd)
+                               (rnrs base)
+                               (srfi srfi-1))
+
+                  ;; Public mode is disabled.
+                  (with-shepherd-action 'jami ('list-account-details)
+                                        results
                     (let ((account (assoc-ref (car results) #$username)))
-                      (assert (string=? #$username
+                      (assert (string=? "false"
                                         (assoc-ref account
-                                                   "Account.username")))))))
-             marionette))
-
-          (unless #$provisioning? (test-skip 1))
-          (test-assert "jami accounts provisioning, allowed-contacts"
-            (marionette-eval
-             '(begin
-                (use-modules (gnu services herd)
-                             (rnrs base)
-                             (srfi srfi-1))
-
-                ;; Public mode is disabled.
-                (with-shepherd-action 'jami ('list-account-details)
-                                      results
-                  (let ((account (assoc-ref (car results) #$username)))
-                    (assert (string=? "false"
-                                      (assoc-ref account
-                                                 "DHT.PublicInCalls")))))
-
-                ;; Allowed contacts match those declared in the configuration.
-                (with-shepherd-action 'jami ('list-contacts) results
-                  (let ((contacts (assoc-ref (car results) #$username)))
-                    (assert (lset= string-ci=? contacts '#$%allowed-contacts)))))
-             marionette))
-
-          (unless #$provisioning? (test-skip 1))
-          (test-assert "jami accounts provisioning, moderators"
-            (marionette-eval
-             '(begin
-                (use-modules (gnu services herd)
-                             (rnrs base)
-                             (srfi srfi-1))
-
-                ;; Moderators match those declared in the configuration.
-                (with-shepherd-action 'jami ('list-moderators) results
-                  (let ((moderators (assoc-ref (car results) #$username)))
-                    (assert (lset= string-ci=? moderators '#$%moderators))))
-
-                ;; Moderators can be added via the Shepherd action.
-                (with-shepherd-action 'jami
-                    ('add-moderator "cccccccccccccccccccccccccccccccccccccccc"
-                                    #$username) results
-                  (let ((moderators (car results)))
-                    (assert (lset= string-ci=? moderators
-                                   (cons "cccccccccccccccccccccccccccccccccccccccc"
-                                         '#$%moderators))))))
-             marionette))
-
-          (unless #$provisioning? (test-skip 1))
-          (test-assert "jami service actions, ban/unban contacts"
-            (marionette-eval
-             '(begin
-                (use-modules (gnu services herd)
-                             (rnrs base)
-                             (srfi srfi-1))
-
-                ;; Globally ban a contact.
-                (with-shepherd-action 'jami
-                    ('ban-contact "1dbcb0f5f37324228235564b79f2b9737e9a008f") _
-                  (with-shepherd-action 'jami ('list-banned-contacts) results
-                    (every (match-lambda
-                             ((username . banned-contacts)
-                              (member "1dbcb0f5f37324228235564b79f2b9737e9a008f"
-                                      banned-contacts)))
-                           (car results))))
-
-                ;; Ban a contact for a single account.
-                (with-shepherd-action 'jami
-                    ('ban-contact "dddddddddddddddddddddddddddddddddddddddd"
-                                  #$username) _
-                  (with-shepherd-action 'jami ('list-banned-contacts) results
-                    (every (match-lambda
-                             ((username . banned-contacts)
-                              (let ((found? (member "dddddddddddddddddddddddddddddddddddddddd"
-                                                    banned-contacts)))
-                                (if (string=? #$username username)
-                                    found?
-                                    (not found?)))))
-                           (car results)))))
-             marionette))
-
-          (unless #$provisioning? (test-skip 1))
-          (test-assert "jami service actions, enable/disable accounts"
-            (marionette-eval
-             '(begin
-                (use-modules (gnu services herd)
-                             (rnrs base))
-
-                (with-shepherd-action 'jami
-                    ('disable-account #$username) _
-                  (with-shepherd-action 'jami ('list-accounts) results
-                    (let ((account (assoc-ref (car results) #$username)))
-                      (assert (string= "false"
-                                       (assoc-ref account "Account.enable"))))))
-
-                (with-shepherd-action 'jami
-                    ('enable-account #$username) _
-                  (with-shepherd-action 'jami ('list-accounts) results
-                    (let ((account (assoc-ref (car results) #$username)))
-                      (assert (string= "true"
-                                       (assoc-ref account "Account.enable")))))))
-             marionette))
-
-          (unless #$provisioning? (test-skip 1))
-          (test-assert "jami account parameters"
-            (marionette-eval
-             '(begin
-                (use-modules (gnu services herd)
-                             (rnrs base)
-                             (srfi srfi-1))
-
-                (with-shepherd-action 'jami ('list-account-details) results
-                  (let ((account-details (assoc-ref (car results)
-                                                    #$username)))
-                    (assert (lset<=
-                             equal?
-                             '(("Account.hostname" .
-                                "bootstrap.me;fallback.another.host")
-                               ("Account.peerDiscovery" . "false")
-                               ("Account.rendezVous" . "true")
-                               ("RingNS.uri" . "https://my.name.server"))
-                             account-details)))))
-             marionette))
-
-          (test-end))))
+                                                   "DHT.PublicInCalls")))))
+
+                  ;; Allowed contacts match those declared in the configuration.
+                  (with-shepherd-action 'jami ('list-contacts) results
+                    (let ((contacts (assoc-ref (car results) #$username)))
+                      (assert (lset= string-ci=? contacts '#$%allowed-contacts)))))
+               marionette))
+
+            (unless #$provisioning? (test-skip 1))
+            (test-assert "jami accounts provisioning, moderators"
+              (marionette-eval
+               '(begin
+                  (use-modules (gnu services herd)
+                               (rnrs base)
+                               (srfi srfi-1))
+
+                  ;; Moderators match those declared in the configuration.
+                  (with-shepherd-action 'jami ('list-moderators) results
+                    (let ((moderators (assoc-ref (car results) #$username)))
+                      (assert (lset= string-ci=? moderators '#$%moderators))))
+
+                  ;; Moderators can be added via the Shepherd action.
+                  (with-shepherd-action 'jami
+                      ('add-moderator "cccccccccccccccccccccccccccccccccccccccc"
+                                      #$username) results
+                    (let ((moderators (car results)))
+                      (assert (lset= string-ci=? moderators
+                                     (cons "cccccccccccccccccccccccccccccccccccccccc"
+                                           '#$%moderators))))))
+               marionette))
+
+            (unless #$provisioning? (test-skip 1))
+            (test-assert "jami service actions, ban/unban contacts"
+              (marionette-eval
+               '(begin
+                  (use-modules (gnu services herd)
+                               (rnrs base)
+                               (srfi srfi-1))
+
+                  ;; Globally ban a contact.
+                  (with-shepherd-action 'jami
+                      ('ban-contact "1dbcb0f5f37324228235564b79f2b9737e9a008f") _
+                    (with-shepherd-action 'jami ('list-banned-contacts) results
+                      (every (match-lambda
+                               ((username . banned-contacts)
+                                (member "1dbcb0f5f37324228235564b79f2b9737e9a008f"
+                                        banned-contacts)))
+                             (car results))))
+
+                  ;; Ban a contact for a single account.
+                  (with-shepherd-action 'jami
+                      ('ban-contact "dddddddddddddddddddddddddddddddddddddddd"
+                                    #$username) _
+                    (with-shepherd-action 'jami ('list-banned-contacts) results
+                      (every (match-lambda
+                               ((username . banned-contacts)
+                                (let ((found? (member "dddddddddddddddddddddddddddddddddddddddd"
+                                                      banned-contacts)))
+                                  (if (string=? #$username username)
+                                      found?
+                                      (not found?)))))
+                             (car results)))))
+               marionette))
+
+            (unless #$provisioning? (test-skip 1))
+            (test-assert "jami service actions, enable/disable accounts"
+              (marionette-eval
+               '(begin
+                  (use-modules (gnu services herd)
+                               (rnrs base))
+
+                  (with-shepherd-action 'jami
+                      ('disable-account #$username) _
+                    (with-shepherd-action 'jami ('list-accounts) results
+                      (let ((account (assoc-ref (car results) #$username)))
+                        (assert (string= "false"
+                                         (assoc-ref account "Account.enable"))))))
+
+                  (with-shepherd-action 'jami
+                      ('enable-account #$username) _
+                    (with-shepherd-action 'jami ('list-accounts) results
+                      (let ((account (assoc-ref (car results) #$username)))
+                        (assert (string= "true"
+                                         (assoc-ref account "Account.enable")))))))
+               marionette))
+
+            (unless #$provisioning? (test-skip 1))
+            (test-assert "jami account parameters"
+              (marionette-eval
+               '(begin
+                  (use-modules (gnu services herd)
+                               (rnrs base)
+                               (srfi srfi-1))
+
+                  (with-shepherd-action 'jami ('list-account-details) results
+                    (let ((account-details (assoc-ref (car results)
+                                                      #$username)))
+                      (assert (lset<=
+                               equal?
+                               '(("Account.hostname" .
+                                  "bootstrap.me;fallback.another.host")
+                                 ("Account.peerDiscovery" . "false")
+                                 ("Account.rendezVous" . "true")
+                                 ("RingNS.uri" . "https://my.name.server"))
+                               account-details)))))
+               marionette))
+
+            (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:
-- 
2.36.0





^ permalink raw reply related	[flat|nested] 20+ messages in thread

* bug#54786: Installation tests are failing
  2022-05-31 16:44                 ` bug#54786: [PATCH] services: jami: Modernize to adjust to Shepherd 0.9+ changes Maxim Cournoyer
@ 2022-06-01  9:54                   ` Ludovic Courtès
  2022-06-01 13:10                     ` Maxim Cournoyer
  0 siblings, 1 reply; 20+ messages in thread
From: Ludovic Courtès @ 2022-06-01  9:54 UTC (permalink / raw)
  To: Maxim Cournoyer; +Cc: othacehe, 54786

Hi Maxim,

Maxim Cournoyer <maxim.cournoyer@gmail.com> skribis:

>  gnu/build/dbus-service.scm | 212 ++++++++++++++++
>  gnu/build/jami-service.scm | 390 +++++------------------------
>  gnu/local.mk               |   1 +
>  gnu/packages/glib.scm      |  19 +-
>  gnu/services/telephony.scm | 500 +++++++++++++++++--------------------
>  gnu/tests/telephony.scm    | 412 +++++++++++++++---------------
>  6 files changed, 726 insertions(+), 808 deletions(-)
>  create mode 100644 gnu/build/dbus-service.scm

Before going further, I’d like to understand: this does more than just
fix the Jami system tests, right?

It would have been nice to have surgical changes to “just” fix the
tests, along the lines of <https://issues.guix.gnu.org/54786#9>,
possibly followed by a rework of the whole machinery, if that’s
possible.

Besides, I think we should talk to Jami upstream (which shouldn’t be too
hard :-)).  It doesn’t seem reasonable to me to have 800+ lines of code
in the distro to start one service.  Usually the ‘start’ and ‘stop’
methods are between 2 and 10 lines of code.

What do you think is missing upstream so that starting Jami is simpler?

Thanks,
Ludo’.




^ permalink raw reply	[flat|nested] 20+ messages in thread

* bug#54786: Installation tests are failing
  2022-06-01  9:54                   ` bug#54786: Installation tests are failing Ludovic Courtès
@ 2022-06-01 13:10                     ` Maxim Cournoyer
  2022-06-02 13:13                       ` Ludovic Courtès
  0 siblings, 1 reply; 20+ messages in thread
From: Maxim Cournoyer @ 2022-06-01 13:10 UTC (permalink / raw)
  To: Ludovic Courtès; +Cc: othacehe, 54786

Hi Ludovic,

Ludovic Courtès <ludo@gnu.org> writes:

> Hi Maxim,
>
> Maxim Cournoyer <maxim.cournoyer@gmail.com> skribis:
>
>>  gnu/build/dbus-service.scm | 212 ++++++++++++++++
>>  gnu/build/jami-service.scm | 390 +++++------------------------
>>  gnu/local.mk               |   1 +
>>  gnu/packages/glib.scm      |  19 +-
>>  gnu/services/telephony.scm | 500 +++++++++++++++++--------------------
>>  gnu/tests/telephony.scm    | 412 +++++++++++++++---------------
>>  6 files changed, 726 insertions(+), 808 deletions(-)
>>  create mode 100644 gnu/build/dbus-service.scm
>
> Before going further, I’d like to understand: this does more than just
> fix the Jami system tests, right?
>
> It would have been nice to have surgical changes to “just” fix the
> tests, along the lines of <https://issues.guix.gnu.org/54786#9>,
> possibly followed by a rework of the whole machinery, if that’s
> possible.

It's not really possible unfortunately, because the rework from talking
to the D-Bus API via the 'dbus-send' binary to using Guile AC/D-bus was
needed or at least simplified fixing the issues.  Going back trying to
make it work the way it was would be new work that'd end up being
scrapped anyway with a subsequent commit making use of the Guile D-Bus
library, so I'm not interested in pursuing it.

> Besides, I think we should talk to Jami upstream (which shouldn’t be too
> hard :-)).  It doesn’t seem reasonable to me to have 800+ lines of code
> in the distro to start one service.  Usually the ‘start’ and ‘stop’
> methods are between 2 and 10 lines of code.
>
> What do you think is missing upstream so that starting Jami is
> simpler?

1) Lack of D-Bus support in Shepherd to easily start D-Bus services.
The upstream systemd service definition for the Jami daemon (jamid) is
this:

--8<---------------cut here---------------start------------->8---
# net.jami.daemon.service
[D-BUS Service]
Name=cx.ring.Ring
Exec=@LIBDIR@/jamid
--8<---------------cut here---------------end--------------->8---

But that's nearly not where the complexity of our jami-service-type
lies.  Rather, it's in the following:

2) The lack of a way to declaratively configure Jami and the need to use
D-Bus API to issue commands to Jami non-interactively.  For example, to
have Jami import an account it's necessary to go via either

a) the GUI or
b) the D-Bus API

The Jami service in Guix makes use of b), which introduces the need for
some Scheme bindings wrapping the low-level D-Bus interface.  Perhaps
such bindings could live in Jami itself.

The second point (2) could be addressed upstream, but since it's a
rather niche use case (the common use case is simply running the client
GUI), is already achievable via D-Bus, and would probably require a
considerable amount of work in Jami itself, I think we can keep it as is
for now, as a Guix System exclusive feature ;-).  Note that even if Jami
could be configured via configuration files, we'd still want to be able
to communicate with it via D-Bus to maintain the possible actions
currently available in our Shepherd service (listing/enabling/disable
accounts, etc.), so it'd only really help to reduce the start slot, and
that's it.  We'd still need most of the D-Bus bindings, so it wouldn't
help that much anyway.

I hope that clarifies how our jami-service-type is both complex but also
unique.

Happy video-conferencing!

Maxim




^ permalink raw reply	[flat|nested] 20+ messages in thread

* bug#54786: Installation tests are failing
  2022-06-01 13:10                     ` Maxim Cournoyer
@ 2022-06-02 13:13                       ` Ludovic Courtès
  2022-06-02 17:24                         ` Maxim Cournoyer
  0 siblings, 1 reply; 20+ messages in thread
From: Ludovic Courtès @ 2022-06-02 13:13 UTC (permalink / raw)
  To: Maxim Cournoyer; +Cc: othacehe, 54786

Hi Maxim,

Maxim Cournoyer <maxim.cournoyer@gmail.com> skribis:

> Ludovic Courtès <ludo@gnu.org> writes:

[...]

>> Before going further, I’d like to understand: this does more than just
>> fix the Jami system tests, right?
>>
>> It would have been nice to have surgical changes to “just” fix the
>> tests, along the lines of <https://issues.guix.gnu.org/54786#9>,
>> possibly followed by a rework of the whole machinery, if that’s
>> possible.
>
> It's not really possible unfortunately, because the rework from talking
> to the D-Bus API via the 'dbus-send' binary to using Guile AC/D-bus was
> needed or at least simplified fixing the issues.

So am I right that the “issues” were not specifically related to the
Shepherd 0.9.0 switch, or at least not just to that?  (Just to make sure
I understand the context.)

>> Besides, I think we should talk to Jami upstream (which shouldn’t be too
>> hard :-)).  It doesn’t seem reasonable to me to have 800+ lines of code
>> in the distro to start one service.  Usually the ‘start’ and ‘stop’
>> methods are between 2 and 10 lines of code.
>>
>> What do you think is missing upstream so that starting Jami is
>> simpler?
>
> 1) Lack of D-Bus support in Shepherd to easily start D-Bus services.
> The upstream systemd service definition for the Jami daemon (jamid) is
> this:
>
> # net.jami.daemon.service
> [D-BUS Service]
> Name=cx.ring.Ring
> Exec=@LIBDIR@/jamid
>
> But that's nearly not where the complexity of our jami-service-type
> lies.

But that should be fine: we have dozens of D-Bus services that happily
get started by dbus-daemon.

> Rather, it's in the following:
>
> 2) The lack of a way to declaratively configure Jami and the need to use
> D-Bus API to issue commands to Jami non-interactively.  For example, to
> have Jami import an account it's necessary to go via either
>
> a) the GUI or
> b) the D-Bus API
>
> The Jami service in Guix makes use of b), which introduces the need for
> some Scheme bindings wrapping the low-level D-Bus interface.  Perhaps
> such bindings could live in Jami itself.
>
> The second point (2) could be addressed upstream, but since it's a
> rather niche use case (the common use case is simply running the client
> GUI), is already achievable via D-Bus, and would probably require a
> considerable amount of work in Jami itself, I think we can keep it as is
> for now, as a Guix System exclusive feature ;-).  Note that even if Jami
> could be configured via configuration files, we'd still want to be able
> to communicate with it via D-Bus to maintain the possible actions
> currently available in our Shepherd service (listing/enabling/disable
> accounts, etc.), so it'd only really help to reduce the start slot, and
> that's it.  We'd still need most of the D-Bus bindings, so it wouldn't
> help that much anyway.

Ah I see.

> I hope that clarifies how our jami-service-type is both complex but also
> unique.

Sure, the ability to configure Jami in a declarative and stateless
fashion is a plus, that’s really cool.

Longer-term I think this should go in Jami proper though.  It’s great
that Guix has an edge over the competition :-), but having to maintain
it is less nice.

Also, in more concrete terms: one goal of the least-authority work at
<https://issues.guix.gnu.org/54997> is to remove
‘make-forkexec-constructor/container’ and the whole (gnu build shepherd)
module.  Jami is one of its last remaining users (adjusting it felt like
beyond my abilities, precisely because it’s much more complex than the
other services I adjusted).

Could you take a look at that eventually, once this patch has been
reviewed?

Thanks,
Ludo’.




^ permalink raw reply	[flat|nested] 20+ messages in thread

* bug#54786: Installation tests are failing
  2022-06-02 13:13                       ` Ludovic Courtès
@ 2022-06-02 17:24                         ` Maxim Cournoyer
  2022-06-02 20:43                           ` Ludovic Courtès
  0 siblings, 1 reply; 20+ messages in thread
From: Maxim Cournoyer @ 2022-06-02 17:24 UTC (permalink / raw)
  To: Ludovic Courtès; +Cc: othacehe, 54786

[-- Attachment #1: Type: text/plain, Size: 2386 bytes --]

Hi Ludovic,

Ludovic Courtès <ludo@gnu.org> writes:

> Hi Maxim,
>
> Maxim Cournoyer <maxim.cournoyer@gmail.com> skribis:
>
>> Ludovic Courtès <ludo@gnu.org> writes:
>
> [...]
>
>>> Before going further, I’d like to understand: this does more than just
>>> fix the Jami system tests, right?
>>>
>>> It would have been nice to have surgical changes to “just” fix the
>>> tests, along the lines of <https://issues.guix.gnu.org/54786#9>,
>>> possibly followed by a rework of the whole machinery, if that’s
>>> possible.
>>
>> It's not really possible unfortunately, because the rework from talking
>> to the D-Bus API via the 'dbus-send' binary to using Guile AC/D-bus was
>> needed or at least simplified fixing the issues.
>
> So am I right that the “issues” were not specifically related to the
> Shepherd 0.9.0 switch, or at least not just to that?  (Just to make sure
> I understand the context.)

I tried capturing the issue in the commit message, but I'll provide
another more hands-on view: the Jami service was broken due to changes
in Shepherd 0.9.0 that caused the blocking sleeps + concurrent
make+forkexec-constructor/container and fork+exec-command combination
used to not work anymore.

This problem can be manually observed by spawning a VM with the Jami
service:

$(guix system vm --no-graphic -e '(@@ (gnu tests telephony) %jami-os)') -m 512

Then you'll see the service doesn't even start:

--8<---------------cut here---------------start------------->8---
root@jami ~# herd status
[...]
Stopped:
 - jami
[...]

root@jami ~# pgrep jamid
192

root@jami ~# killall jamid

root@jami ~# herd start jami
Jami Daemon 11.0.0, by Savoir-faire Linux 2004-2019
https://jami.net/
[Video support enabled]
[Plugins support enabled]

12:53:47.144         os_core_unix.c !pjlib 2.11 for POSIX initialized

herd: exception caught while executing 'start' on service 'jami':
Throw to key `match-error' with args `("match" "no matching pattern" #f)'.
--8<---------------cut here---------------end--------------->8---

I've ran this: herd start jami& strace -p1 -f -s800 -o strace.out

Attached is the last 10% of the gzip'd file.  I couldn't explain this
failure very clearly, but when I tried investigating it was failing on
the '(dbus-service-available? "cx.ring.Ring")' call, if I recall
correctly.


[-- Attachment #2: shepherd pid1 strace --]
[-- Type: application/octet-stream, Size: 31449 bytes --]

[-- Attachment #3: Type: text/plain, Size: 3874 bytes --]


[...]

>>> What do you think is missing upstream so that starting Jami is
>>> simpler?
>>
>> 1) Lack of D-Bus support in Shepherd to easily start D-Bus services.
>> The upstream systemd service definition for the Jami daemon (jamid) is
>> this:
>>
>> # net.jami.daemon.service
>> [D-BUS Service]
>> Name=cx.ring.Ring
>> Exec=@LIBDIR@/jamid
>>
>> But that's nearly not where the complexity of our jami-service-type
>> lies.
>
> But that should be fine: we have dozens of D-Bus services that happily
> get started by dbus-daemon.

I guess that works (minus races like we've had with elogind) if the
other services are also D-Bus services sharing the same bus.  But here
the code talking with Jami are in the Shepherd service actions and more
critically in the start slot itself -- so it's important the D-Bus
service has been acquired and ready to service D-Bus calls otherwise
they'd fail (that's what the loop polling for (jami-service-available?)
ensures).

>> Rather, it's in the following:
>>
>> 2) The lack of a way to declaratively configure Jami and the need to use
>> D-Bus API to issue commands to Jami non-interactively.  For example, to
>> have Jami import an account it's necessary to go via either
>>
>> a) the GUI or
>> b) the D-Bus API
>>
>> The Jami service in Guix makes use of b), which introduces the need for
>> some Scheme bindings wrapping the low-level D-Bus interface.  Perhaps
>> such bindings could live in Jami itself.
>>
>> The second point (2) could be addressed upstream, but since it's a
>> rather niche use case (the common use case is simply running the client
>> GUI), is already achievable via D-Bus, and would probably require a
>> considerable amount of work in Jami itself, I think we can keep it as is
>> for now, as a Guix System exclusive feature ;-).  Note that even if Jami
>> could be configured via configuration files, we'd still want to be able
>> to communicate with it via D-Bus to maintain the possible actions
>> currently available in our Shepherd service (listing/enabling/disable
>> accounts, etc.), so it'd only really help to reduce the start slot, and
>> that's it.  We'd still need most of the D-Bus bindings, so it wouldn't
>> help that much anyway.
>
> Ah I see.
>
>> I hope that clarifies how our jami-service-type is both complex but also
>> unique.
>
> Sure, the ability to configure Jami in a declarative and stateless
> fashion is a plus, that’s really cool.
>
> Longer-term I think this should go in Jami proper though.  It’s great
> that Guix has an edge over the competition :-), but having to maintain
> it is less nice.

Perhaps with the Scheme bindings introduced by Olivier for the Jami
tests (that work via an embedded libguile), it could be possible to add
the ability to pass an init script to 'jamid' at launch time, which
would automate importing the account.  Proper 'Scheme' bindings would be
nice though, and I'd like to look into the feasibility to add these via
Swig.  Food for thought.

> Also, in more concrete terms: one goal of the least-authority work at
> <https://issues.guix.gnu.org/54997> is to remove
> ‘make-forkexec-constructor/container’ and the whole (gnu build shepherd)
> module.  Jami is one of its last remaining users (adjusting it felt like
> beyond my abilities, precisely because it’s much more complex than the
> other services I adjusted).
>
> Could you take a look at that eventually, once this patch has been
> reviewed?

I reviewed how that works, and it'd be easy; I just didn't see the
incentive yet (there's no composition needed for the service, and it'd
make the definition slightly less readable).  If you tell me
mark+forkexec-constructor/container is going the way of the Dodo though,
that's a good enough incentive :-).

Thanks for having a look!

Maxim

^ permalink raw reply	[flat|nested] 20+ messages in thread

* bug#54786: Installation tests are failing
  2022-06-02 17:24                         ` Maxim Cournoyer
@ 2022-06-02 20:43                           ` Ludovic Courtès
  2022-06-04  4:37                             ` Maxim Cournoyer
  0 siblings, 1 reply; 20+ messages in thread
From: Ludovic Courtès @ 2022-06-02 20:43 UTC (permalink / raw)
  To: Maxim Cournoyer; +Cc: othacehe, 54786

Howdy!

Maxim Cournoyer <maxim.cournoyer@gmail.com> skribis:

> I tried capturing the issue in the commit message, but I'll provide
> another more hands-on view: the Jami service was broken due to changes
> in Shepherd 0.9.0 that caused the blocking sleeps + concurrent
> make+forkexec-constructor/container and fork+exec-command combination
> used to not work anymore.

OK.  Thanks for sharing the strace log; at first sight I don’t see any
clear clue, but hey, maybe it’s fine to leave that as a mystery since
there’s another solution.

[...]

>> Longer-term I think this should go in Jami proper though.  It’s great
>> that Guix has an edge over the competition :-), but having to maintain
>> it is less nice.
>
> Perhaps with the Scheme bindings introduced by Olivier for the Jami
> tests (that work via an embedded libguile), it could be possible to add
> the ability to pass an init script to 'jamid' at launch time, which
> would automate importing the account.  Proper 'Scheme' bindings would be
> nice though, and I'd like to look into the feasibility to add these via
> Swig.  Food for thought.

Sounds fun.  (BTW, I’d recommend against SWIG: it’s not “pretty”, leaves
a lot of work to do, including wrapping the generated wrappers and
debugging memory management issue.  Using the FFI provides more
flexibility and is much more fun IMO.)

>> Also, in more concrete terms: one goal of the least-authority work at
>> <https://issues.guix.gnu.org/54997> is to remove
>> ‘make-forkexec-constructor/container’ and the whole (gnu build shepherd)
>> module.  Jami is one of its last remaining users (adjusting it felt like
>> beyond my abilities, precisely because it’s much more complex than the
>> other services I adjusted).
>>
>> Could you take a look at that eventually, once this patch has been
>> reviewed?
>
> I reviewed how that works, and it'd be easy; I just didn't see the
> incentive yet (there's no composition needed for the service, and it'd
> make the definition slightly less readable).  If you tell me
> mark+forkexec-constructor/container is going the way of the Dodo though,
> that's a good enough incentive :-).

Awesome.  :-)

Thanks for explaining!

Ludo’.




^ permalink raw reply	[flat|nested] 20+ messages in thread

* bug#54786: Installation tests are failing
  2022-06-02 20:43                           ` Ludovic Courtès
@ 2022-06-04  4:37                             ` Maxim Cournoyer
  2022-06-07 14:00                               ` Ludovic Courtès
  0 siblings, 1 reply; 20+ messages in thread
From: Maxim Cournoyer @ 2022-06-04  4:37 UTC (permalink / raw)
  To: Ludovic Courtès; +Cc: othacehe, 54786

Hi Ludovic!

Ludovic Courtès <ludo@gnu.org> writes:

> Howdy!
>
> Maxim Cournoyer <maxim.cournoyer@gmail.com> skribis:

[...]

>> I reviewed how that works, and it'd be easy; I just didn't see the
>> incentive yet (there's no composition needed for the service, and it'd
>> make the definition slightly less readable).  If you tell me
>> mark+forkexec-constructor/container is going the way of the Dodo though,
>> that's a good enough incentive :-).

That turns out to be bit problematic; dbus-daemon must not run in its
own user namespace (CLONE_NEWUSER) as it wants to validate user/group
IDs.  That's probably the reason it was working with
'make-forkexec-constructor/container', as this was dropping the user and
net namespaces, contrary to least-authority, which uses them all.

The problem then seems to be that since we need CAP_SYS_ADMIN when
dropping the user namespace, as CLONE_NEWUSER is what gives us
superpowers.  Per 'man user_namespaces':

  The child process created by clone(2) with the CLONE_NEWUSER flag starts
  out with a complete set of capabilities in the new user namespace.

Which means that if we combine something like (untested):

--8<---------------cut here---------------start------------->8---
(make-forkexec-constructor
  (least-authority
    (list (file-append coreutils "/bin/true"))
    (mappings (delq 'user %namespaces))
  #:user  "nobody"
  #:group "nobody"))
--8<---------------cut here---------------end--------------->8---

the make-forkexec-constructor will switch to the non-privileged user
before the clone call is made, and it will fail with EPERM.

When using 'make-forkexec-constructor/container', the clone(2) call
happens before switching user, thus as 'root' in Shepherd, which
explains why it works.

I'm not sure how it could be fixed; it seems the user changing business
would need to be handled by the least-authority-wrapper code?  And the
make-forkexec-constructor would probably need to detect that command is
a pola wrapper and then avoid changing the user/group itself to not
interfere.

To be continued!

Maxim




^ permalink raw reply	[flat|nested] 20+ messages in thread

* bug#54786: Installation tests are failing
  2022-06-04  4:37                             ` Maxim Cournoyer
@ 2022-06-07 14:00                               ` Ludovic Courtès
  2022-06-08  0:58                                 ` bokr
  2022-06-11  4:18                                 ` Maxim Cournoyer
  0 siblings, 2 replies; 20+ messages in thread
From: Ludovic Courtès @ 2022-06-07 14:00 UTC (permalink / raw)
  To: Maxim Cournoyer; +Cc: othacehe, 54786

Hi!

Maxim Cournoyer <maxim.cournoyer@gmail.com> skribis:

> Ludovic Courtès <ludo@gnu.org> writes:

[...]

>>> I reviewed how that works, and it'd be easy; I just didn't see the
>>> incentive yet (there's no composition needed for the service, and it'd
>>> make the definition slightly less readable).  If you tell me
>>> mark+forkexec-constructor/container is going the way of the Dodo though,
>>> that's a good enough incentive :-).
>
> That turns out to be bit problematic; dbus-daemon must not run in its
> own user namespace (CLONE_NEWUSER) as it wants to validate user/group
> IDs.  That's probably the reason it was working with
> 'make-forkexec-constructor/container', as this was dropping the user and
> net namespaces, contrary to least-authority, which uses them all.
>
> The problem then seems to be that since we need CAP_SYS_ADMIN when
> dropping the user namespace, as CLONE_NEWUSER is what gives us
> superpowers.  Per 'man user_namespaces':
>
>   The child process created by clone(2) with the CLONE_NEWUSER flag starts
>   out with a complete set of capabilities in the new user namespace.
>
> Which means that if we combine something like (untested):
>
> (make-forkexec-constructor
>   (least-authority
>     (list (file-append coreutils "/bin/true"))
>     (mappings (delq 'user %namespaces))
>   #:user  "nobody"
>   #:group "nobody"))
>
> the make-forkexec-constructor will switch to the non-privileged user
> before the clone call is made, and it will fail with EPERM.
>
> When using 'make-forkexec-constructor/container', the clone(2) call
> happens before switching user, thus as 'root' in Shepherd, which
> explains why it works.

Damnit, that’s right.  For example the result of:

   (lower-object (least-authority-wrapper (file-append coreutils "/bin/uname")
                                          #:namespaces (delq 'user %namespaces)))

won’t run as an unprivileged user:

--8<---------------cut here---------------start------------->8---
$ $(guix build /gnu/store/hy8rd8p8pid67ac27dwm63svl5bqn0a1-pola-wrapper.drv)
substitute: updating substitutes from 'https://ci.guix.gnu.org'... 100.0%
substitute: updating substitutes from 'https://bordeaux.guix.gnu.org'... 100.0%
substitute: updating substitutes from 'https://guix.bordeaux.inria.fr'... 100.0%
The following derivations will be built:
  /gnu/store/hy8rd8p8pid67ac27dwm63svl5bqn0a1-pola-wrapper.drv
  /gnu/store/bd63i07rvvsw7xgsig0cbdsw7fpznd1k-references.drv
building /gnu/store/bd63i07rvvsw7xgsig0cbdsw7fpznd1k-references.drv...
successfully built /gnu/store/bd63i07rvvsw7xgsig0cbdsw7fpznd1k-references.drv
building /gnu/store/hy8rd8p8pid67ac27dwm63svl5bqn0a1-pola-wrapper.drv...
successfully built /gnu/store/hy8rd8p8pid67ac27dwm63svl5bqn0a1-pola-wrapper.drv
Backtrace:
           5 (primitive-load "/gnu/store/ifsh87aifh2k8pqzhkjxncq3vskpwx3l-pola-wrapper")
In ice-9/eval.scm:
   191:35  4 (_ #f)
In gnu/build/linux-container.scm:
    300:8  3 (call-with-temporary-directory #<procedure 7f9aa3a674b0 at gnu/build/linux-container.scm:396:3 (root)>)
   397:16  2 (_ "/tmp/guix-directory.K9gBNH")
    239:7  1 (run-container "/tmp/guix-directory.K9gBNH" (#<<file-system> device: "/gnu/store/jkjs0inmzhj4vsvclbf08nmh0shm7lrf-attr-2.5…> …) …)
In guix/build/syscalls.scm:
  1099:12  0 (_ 1845624849)

guix/build/syscalls.scm:1099:12: In procedure clone: 1845624849: Operation not permitted
--8<---------------cut here---------------end--------------->8---

> I'm not sure how it could be fixed; it seems the user changing business
> would need to be handled by the least-authority-wrapper code?  And the
> make-forkexec-constructor would probably need to detect that command is
> a pola wrapper and then avoid changing the user/group itself to not
> interfere.

I think we would add #:user and #:group to ‘least-authority-wrapper’ and
have it call setuid/setgid.  ‘make-forkexec-constructor’ doesn’t need to
be modified, but the user simply won’t pass #:user and #:group to it.

Thanks,
Ludo’.




^ permalink raw reply	[flat|nested] 20+ messages in thread

* bug#54786: Installation tests are failing
  2022-06-07 14:00                               ` Ludovic Courtès
@ 2022-06-08  0:58                                 ` bokr
  2022-06-11  4:18                                 ` Maxim Cournoyer
  1 sibling, 0 replies; 20+ messages in thread
From: bokr @ 2022-06-08  0:58 UTC (permalink / raw)
  To: Ludovic Courtès; +Cc: othacehe, Maxim Cournoyer, 54786

Hi,

tl;dr: I hope there will be a security team discussing
       whether/how this kind of privileged execution interval
       could be exploited, and how to prevent such.
       
       E.g., could something that stealthily gets put in a finalizer
       for some innocent object be waiting to notice that it is running
       privileged, and do the next step in a dirty-work chain that
       sets things up nicely for e.g. remote DDOS control?

       Or is the independent FLOSS development process
       and its quality control being sabotaged stealthily
       with injections of "innocent mistakes" and
       (ultimately) trivial time-wasting bugs, making FLOSS projects
       look "not ready for production use" ?
       (despite the increasing evidence to the contrary)
              
       BTW, I think a minimalist/MES/RISCV team would be interesting!

       Regards,
       Bengt Richter
       
On +2022-06-07 16:00:54 +0200, Ludovic Courtès wrote:gets\
> Hi!
> 
> Maxim Cournoyer <maxim.cournoyer@gmail.com> skribis:
> 
> > Ludovic Courtès <ludo@gnu.org> writes:
> 
> [...]
> 
> >>> I reviewed how that works, and it'd be easy; I just didn't see the
> >>> incentive yet (there's no composition needed for the service, and it'd
> >>> make the definition slightly less readable).  If you tell me
> >>> mark+forkexec-constructor/container is going the way of the Dodo though,
> >>> that's a good enough incentive :-).
> >
> > That turns out to be bit problematic; dbus-daemon must not run in its
> > own user namespace (CLONE_NEWUSER) as it wants to validate user/group
> > IDs.  That's probably the reason it was working with
> > 'make-forkexec-constructor/container', as this was dropping the user and
> > net namespaces, contrary to least-authority, which uses them all.
> >
> > The problem then seems to be that since we need CAP_SYS_ADMIN when
> > dropping the user namespace, as CLONE_NEWUSER is what gives us
> > superpowers.  Per 'man user_namespaces':
> >
> >   The child process created by clone(2) with the CLONE_NEWUSER flag starts
> >   out with a complete set of capabilities in the new user namespace.
> >
> > Which means that if we combine something like (untested):
> >
> > (make-forkexec-constructor
> >   (least-authority
> >     (list (file-append coreutils "/bin/true"))
> >     (mappings (delq 'user %namespaces))
> >   #:user  "nobody"
> >   #:group "nobody"))
> >
> > the make-forkexec-constructor will switch to the non-privileged user
> > before the clone call is made, and it will fail with EPERM.
> >
> > When using 'make-forkexec-constructor/container', the clone(2) call
> > happens before switching user, thus as 'root' in Shepherd, which
> > explains why it works.
> 
> Damnit, that’s right.  For example the result of:
> 
>    (lower-object (least-authority-wrapper (file-append coreutils "/bin/uname")
>                                           #:namespaces (delq 'user %namespaces)))
> 
> won’t run as an unprivileged user:
> 
> --8<---------------cut here---------------start------------->8---
> $ $(guix build /gnu/store/hy8rd8p8pid67ac27dwm63svl5bqn0a1-pola-wrapper.drv)
> substitute: updating substitutes from 'https://ci.guix.gnu.org'... 100.0%
> substitute: updating substitutes from 'https://bordeaux.guix.gnu.org'... 100.0%
> substitute: updating substitutes from 'https://guix.bordeaux.inria.fr'... 100.0%
> The following derivations will be built:
>   /gnu/store/hy8rd8p8pid67ac27dwm63svl5bqn0a1-pola-wrapper.drv
>   /gnu/store/bd63i07rvvsw7xgsig0cbdsw7fpznd1k-references.drv
> building /gnu/store/bd63i07rvvsw7xgsig0cbdsw7fpznd1k-references.drv...
> successfully built /gnu/store/bd63i07rvvsw7xgsig0cbdsw7fpznd1k-references.drv
> building /gnu/store/hy8rd8p8pid67ac27dwm63svl5bqn0a1-pola-wrapper.drv...
> successfully built /gnu/store/hy8rd8p8pid67ac27dwm63svl5bqn0a1-pola-wrapper.drv
> Backtrace:
>            5 (primitive-load "/gnu/store/ifsh87aifh2k8pqzhkjxncq3vskpwx3l-pola-wrapper")
> In ice-9/eval.scm:
>    191:35  4 (_ #f)
> In gnu/build/linux-container.scm:
>     300:8  3 (call-with-temporary-directory #<procedure 7f9aa3a674b0 at gnu/build/linux-container.scm:396:3 (root)>)
>    397:16  2 (_ "/tmp/guix-directory.K9gBNH")
>     239:7  1 (run-container "/tmp/guix-directory.K9gBNH" (#<<file-system> device: "/gnu/store/jkjs0inmzhj4vsvclbf08nmh0shm7lrf-attr-2.5…> …) …)
> In guix/build/syscalls.scm:
>   1099:12  0 (_ 1845624849)
> 
> guix/build/syscalls.scm:1099:12: In procedure clone: 1845624849: Operation not permitted
> --8<---------------cut here---------------end--------------->8---
> 
> > I'm not sure how it could be fixed; it seems the user changing business
> > would need to be handled by the least-authority-wrapper code?  And the
> > make-forkexec-constructor would probably need to detect that command is
> > a pola wrapper and then avoid changing the user/group itself to not
> > interfere.
> 
> I think we would add #:user and #:group to ‘least-authority-wrapper’ and
> have it call setuid/setgid.  ‘make-forkexec-constructor’ doesn’t need to
> be modified, but the user simply won’t pass #:user and #:group to it.
> 
> Thanks,
> Ludo’.
> 
> 
> 




^ permalink raw reply	[flat|nested] 20+ messages in thread

* bug#54786: Installation tests are failing
  2022-06-07 14:00                               ` Ludovic Courtès
  2022-06-08  0:58                                 ` bokr
@ 2022-06-11  4:18                                 ` Maxim Cournoyer
  2022-08-09 14:20                                   ` Mathieu Othacehe
  1 sibling, 1 reply; 20+ messages in thread
From: Maxim Cournoyer @ 2022-06-11  4:18 UTC (permalink / raw)
  To: Ludovic Courtès; +Cc: othacehe, 54786

Hi Ludo,

Ludovic Courtès <ludo@gnu.org> writes:

[...]

>> When using 'make-forkexec-constructor/container', the clone(2) call
>> happens before switching user, thus as 'root' in Shepherd, which
>> explains why it works.
>
> Damnit, that’s right.  For example the result of:
>
>    (lower-object (least-authority-wrapper (file-append coreutils "/bin/uname")
>                                           #:namespaces (delq 'user %namespaces)))
>
> won’t run as an unprivileged user:

[...]

> I think we would add #:user and #:group to ‘least-authority-wrapper’ and
> have it call setuid/setgid.  ‘make-forkexec-constructor’ doesn’t need to
> be modified, but the user simply won’t pass #:user and #:group to it.

OK!  I'll adjust the jami-service-type when we get around to implement
the above; for now I've pushed my proposed fix which still uses
'make-forkexec-constructor/container' as
85b4dabd94d53f8179f31a42046cd83fc3a352fc.

Thanks,

Maxim




^ permalink raw reply	[flat|nested] 20+ messages in thread

* bug#54786: Installation tests are failing
  2022-06-11  4:18                                 ` Maxim Cournoyer
@ 2022-08-09 14:20                                   ` Mathieu Othacehe
  0 siblings, 0 replies; 20+ messages in thread
From: Mathieu Othacehe @ 2022-08-09 14:20 UTC (permalink / raw)
  To: Maxim Cournoyer; +Cc: 54786-done, Ludovic Courtès


Closing as all the installation tests are now fixed.

Thanks to everyone involved :)

Mathieu




^ permalink raw reply	[flat|nested] 20+ messages in thread

end of thread, other threads:[~2022-08-09 14:21 UTC | newest]

Thread overview: 20+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-04-08  9:51 bug#54786: Installation tests are failing Mathieu Othacehe
2022-04-08 15:10 ` Mathieu Othacehe
2022-04-28  7:22   ` Mathieu Othacehe
2022-04-28 19:19     ` Ludovic Courtès
2022-04-29 19:50       ` Ludovic Courtès
2022-04-30 13:02         ` Mathieu Othacehe
2022-05-01 13:26           ` Ludovic Courtès
2022-05-25  3:43             ` Maxim Cournoyer
2022-05-28 21:29               ` Ludovic Courtès
2022-05-31 16:44                 ` bug#54786: [PATCH] services: jami: Modernize to adjust to Shepherd 0.9+ changes Maxim Cournoyer
2022-06-01  9:54                   ` bug#54786: Installation tests are failing Ludovic Courtès
2022-06-01 13:10                     ` Maxim Cournoyer
2022-06-02 13:13                       ` Ludovic Courtès
2022-06-02 17:24                         ` Maxim Cournoyer
2022-06-02 20:43                           ` Ludovic Courtès
2022-06-04  4:37                             ` Maxim Cournoyer
2022-06-07 14:00                               ` Ludovic Courtès
2022-06-08  0:58                                 ` bokr
2022-06-11  4:18                                 ` Maxim Cournoyer
2022-08-09 14:20                                   ` Mathieu Othacehe

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).