From 6c2a6033b4bd5f74463cb0121e15b9cb4fc5ff6d Mon Sep 17 00:00:00 2001
From: Vivien Kraus <vivien@planete-kraus.eu>
Date: Wed, 4 Oct 2023 12:47:04 +0200
Subject: [PATCH] gnu: dbus-service: Make the session bus available under
 /run/dbus.

According to https://gitlab.gnome.org/GNOME/glib/-/merge_requests/3101, glib
now searches for the session bus socket in runstatedir. The dbus service must
thus have its socket in /run/dbus.

For interoperability with the dbus standard, /run/dbus is also symlinked to
/var/run/dbus.

* gnu/services/dbus.scm (dbus-activation): Symlink /run/dbus to /var/run/dbus.
(%dbus-accounts): Run dbus in /run/dbus.
(dbus-root-service-type): Save the pid file in /run/dbus.

Signed-off-by: Liliana Marie Prikler <liliana.prikler@gmail.com>
---
 gnu/services/dbus.scm | 37 ++++++++++++++++++++++++++++++++++---
 1 file changed, 34 insertions(+), 3 deletions(-)

diff --git a/gnu/services/dbus.scm b/gnu/services/dbus.scm
index 5a0c634393..1edcc6eb9e 100644
--- a/gnu/services/dbus.scm
+++ b/gnu/services/dbus.scm
@@ -163,7 +163,7 @@ includes the @code{etc/dbus-1/system.d} directories of each package listed in
          (group "messagebus")
          (system? #t)
          (comment "D-Bus system bus user")
-         (home-directory "/var/run/dbus")
+         (home-directory "/run/dbus")
          (shell (file-append shadow "/sbin/nologin")))))
 
 (define dbus-setuid-programs
@@ -186,7 +186,38 @@ includes the @code{etc/dbus-1/system.d} directories of each package listed in
         (let ((user (getpwnam "messagebus")))
           ;; This directory contains the daemon's socket so it must be
           ;; world-readable.
-          (mkdir-p/perms "/var/run/dbus" user #o755))
+          (mkdir-p/perms "/run/dbus" user #o755))
+
+        (catch 'system-error
+          (lambda ()
+            (symlink "/run/dbus" "/var/run/dbus"))
+          (lambda args
+            (let ((errno (system-error-errno args)))
+              (cond
+               ((= errno EEXIST)
+                (let ((existing-name
+                       (false-if-exception
+                        (readlink "/var/run/dbus"))))
+                  (unless (equal? existing-name "/run/dbus")
+                    ;; Move the content of /var/run/dbus to /run/dbus, and
+                    ;; retry.
+                    (let ((dir (opendir "/var/run/dbus")))
+                      (let loop ((next (readdir dir)))
+                        (cond
+                         ((eof-object? next) (closedir dir))
+                         ((member next '("." "..")) (loop (readdir dir)))
+                         (else
+                          (begin
+                            (rename-file (string-append "/var/run/dbus/" next)
+                                         (string-append "/run/dbus/" next))
+                            (loop (readdir dir))))))))
+                      (rmdir "/var/run/dbus")
+                      (symlink "/run/dbus" "/var/run/dbus")))
+               (else
+                (format (current-error-port)
+                        "Failed to symlink /run/dbus to /var/run/dbus: ~s~%"
+                        (strerror errno))
+                (error "cannot create /var/run/dbus"))))))
 
         (unless (file-exists? "/etc/machine-id")
           (format #t "creating /etc/machine-id...~%")
@@ -210,7 +241,7 @@ includes the @code{etc/dbus-1/system.d} directories of each package listed in
                              '(#:environment-variables '("DBUS_VERBOSE=1")
                                #:log-file "/var/log/dbus-daemon.log")
                              '())
-                      #:pid-file "/var/run/dbus/pid"))
+                      #:pid-file "/run/dbus/pid"))
             (stop #~(make-kill-destructor)))))))
 
 (define dbus-root-service-type