Support D-Bus file descriptor manipulation

* doc/misc/dbus.texi (Synchronous Methods): Adapt `dbus-call-method'.
(Asynchronous Methods): Adapt `dbus-call-method-asynchronously'.
(File Descriptors): New chapter, replaces Inhibitor Locks.

* etc/NEWS: Replace "New D-Bus functions to support systemd
inhibitor locks" by "Support D-Bus file descriptor manipulation".
Presentational fixes and improvements.

* lisp/net/dbus.el (dbus-call-method)
(dbus-call-method-asynchronously): Adapt docstring.
(dbus-list-hash-table): Return (nreverse result).
(dbus-monitor-goto-serial): Declare `completion'.

* src/dbusbind.c (Fdbus_message_internal, xd_read_message_1):
Handle `:keep-fd'.
(xd_registered_inhibitor_locks, Fdbus_make_inhibitor_lock)
(Fdbus_close_inhibitor_lock, Fdbus_registered_inhibitor_locks): Delete.
(xd_registered_fds): New variable.
(Fdbus__fd_open, Fdbus__fd_close, Fdbus__registered_fds):
New DEFUNs.  (Bug#79963)
(syms_of_dbusbind_for_pdumper): Initialize `xd_registered_fds'.
(syms_of_dbusbind): Remove subroutines
`Sdbus_make_inhibitor_lock', `Sdbus_close_inhibitor_lock' and
`Sdbus_registered_inhibitor_locks'.  Remove symbol `Qdbus_call_method'.
Declare subroutines `Sdbus__fd_open', `Sdbus__fd_close' and
`Sdbus__registered_fds'.  Declare symbol `QCkeep_fd'.  staticpro
`xd_registered_fds'.

* test/lisp/net/dbus-tests.el (dbus-test10-inhibitor-locks): Delete.
(dbus-test10-keep-fd, dbus-test10-open-close-fd): New tests.

1 files changed, 117 insertions, 50 deletions

diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el
index 53ce1929cad..f4dd9e3796b 100644
--- a/test/lisp/net/dbus-tests.el
+++ b/test/lisp/net/dbus-tests.el
@@ -2308,89 +2308,156 @@ The argument EXPECTED-ARGS is a list of expected arguments for the method."
     ;; Cleanup.
     (dbus-unregister-service :session dbus--test-service)))
 
-(ert-deftest dbus-test10-inhibitor-locks ()
-  "Check `dbus-*-inhibitor-locks'."
+(ert-deftest dbus-test10-keep-fd ()
+  "Check D-Bus `:keep-fd' argument."
   :tags '(:expensive-test)
   (skip-unless dbus--test-enabled-system-bus)
   (skip-unless (dbus-ping :system dbus--test-systemd-service 1000))
 
-  (let (lock1 lock2)
+  (let ((what "sleep")
+        (who "Emacs test user")
+        (why "Test delay")
+        (mode "delay")
+        (fd-directory (format "/proc/%d/fd" (emacs-pid)))
+        lock1 lock2)
     ;; Create inhibitor lock.
-    (setq lock1 (dbus-make-inhibitor-lock "sleep" "Test delay"))
+    (setq lock1
+          (dbus-call-method
+           :system dbus--test-systemd-service dbus--test-systemd-path
+           dbus--test-systemd-manager-interface "Inhibit"
+           what who why mode))
     (should (natnump lock1))
     ;; The lock is reported by systemd.
     (should
      (member
-      (list "sleep" "Emacs" "Test delay" "delay" (user-uid) (emacs-pid))
+      (list what who why mode (user-uid) (emacs-pid))
       (dbus-call-method
        :system dbus--test-systemd-service dbus--test-systemd-path
        dbus--test-systemd-manager-interface "ListInhibitors")))
-    ;; The lock is registered internally.
-    (should
-     (member
-      (list lock1 "sleep" "Test delay" nil)
-      (dbus-registered-inhibitor-locks)))
+    ;; The lock is not registered internally.
+    (should-not (assoc lock1 (dbus--registered-fds)))
     ;; There exist a file descriptor.
-    (when (file-directory-p (format "/proc/%d/fd" (emacs-pid)))
-      (should (file-symlink-p (format "/proc/%d/fd/%d" (emacs-pid) lock1))))
-
-    ;; It is not possible to modify registered inhibitor locks on Lisp level.
-    (setcar (assoc lock1 (dbus-registered-inhibitor-locks)) 'malicious)
-    (should (assoc lock1 (dbus-registered-inhibitor-locks)))
-    (should-not (assoc 'malicious (dbus-registered-inhibitor-locks)))
-
-    ;; Creating it again returns the same inhibitor lock.
-    (should (= lock1 (dbus-make-inhibitor-lock "sleep" "Test delay")))
+    (when (file-directory-p fd-directory)
+      (should
+       (file-symlink-p
+        (expand-file-name (number-to-string lock1) fd-directory))))
 
-    ;; Create another inhibitor lock.
-    (setq lock2 (dbus-make-inhibitor-lock "sleep" "Test block" 'block))
+    ;; Create another inhibitor lock.  Keep the file descriptor.
+    (setq lock2
+          (dbus-call-method
+           :system dbus--test-systemd-service dbus--test-systemd-path
+           dbus--test-systemd-manager-interface "Inhibit" :keep-fd
+           what who why mode))
     (should (natnump lock2))
     (should-not (= lock1 lock2))
     ;; The lock is reported by systemd.
     (should
      (member
-      (list "sleep" "Emacs" "Test block" "block" (user-uid) (emacs-pid))
+      (list what who why mode (user-uid) (emacs-pid))
       (dbus-call-method
        :system dbus--test-systemd-service dbus--test-systemd-path
        dbus--test-systemd-manager-interface "ListInhibitors")))
     ;; The lock is registered internally.
     (should
      (member
-      (list lock2 "sleep" "Test block" t)
-      (dbus-registered-inhibitor-locks)))
+      (cons lock2 dbus--test-systemd-path)
+      (dbus--registered-fds)))
     ;; There exist a file descriptor.
-    (when (file-directory-p (format "/proc/%d/fd" (emacs-pid)))
-      (should (file-symlink-p (format "/proc/%d/fd/%d" (emacs-pid) lock2))))
-
-    ;; Close the first inhibitor lock.
-    (should (dbus-close-inhibitor-lock lock1))
-    ;; The internal registration has gone.
-    (should-not
-     (member
-      (list lock1 "sleep" "Test delay" nil)
-      (dbus-registered-inhibitor-locks)))
-    ;; The file descriptor has been deleted.
-    (when (file-directory-p (format "/proc/%d/fd" (emacs-pid)))
-      (should-not (file-symlink-p (format "/proc/%d/fd/%d" (emacs-pid) lock1))))
-
-    ;; Closing it again is a noop.
-    (should-not (dbus-close-inhibitor-lock lock1))
-
-    ;; Creating it again returns (another?) inhibitor lock.
-    (setq lock1 (dbus-make-inhibitor-lock "sleep" "Test delay"))
+    (when (file-directory-p fd-directory)
+      (should
+       (file-symlink-p
+        (expand-file-name (number-to-string lock2) fd-directory))))
+
+    ;; Create another inhibitor lock via
+    ;; `dbus-call-method-asynchronously'.  Keep the file descriptor.
+    (setq lock1 nil)
+    (dbus-call-method-asynchronously
+     :system dbus--test-systemd-service dbus--test-systemd-path
+     dbus--test-systemd-manager-interface "Inhibit"
+     (lambda (lock) (setq lock1 lock)) :keep-fd
+     what who why mode)
+    (with-timeout (1 (dbus--test-timeout-handler))
+      (while (null lock1) (read-event nil nil 0.1)))
     (should (natnump lock1))
+    (should-not (= lock1 lock2))
     ;; The lock is registered internally.
     (should
      (member
-      (list lock1 "sleep" "Test delay" nil)
-      (dbus-registered-inhibitor-locks)))
+      (cons lock1 dbus--test-systemd-path)
+      (dbus--registered-fds)))
     ;; There exist a file descriptor.
-    (when (file-directory-p (format "/proc/%d/fd" (emacs-pid)))
-      (should (file-symlink-p (format "/proc/%d/fd/%d" (emacs-pid) lock1))))
+    (when (file-directory-p fd-directory)
+      (should
+       (file-symlink-p
+        (expand-file-name (number-to-string lock1) fd-directory))))
+
+    ;; It is not possible to modify registered inhibitor locks on Lisp level.
+    (setcar (assoc lock1 (dbus--registered-fds)) 'malicious)
+    (should (assoc lock1 (dbus--registered-fds)))
+    (should-not (assoc 'malicious (dbus--registered-fds)))
 
     ;; Close the inhibitor locks.
-    (should (dbus-close-inhibitor-lock lock1))
-    (should (dbus-close-inhibitor-lock lock2))))
+    (should (dbus--fd-close lock1))
+    (should (dbus--fd-close lock2))
+    ;; The internal registration has gone.
+    (should-not
+     (member
+      (cons lock1 dbus--test-systemd-path)
+      (dbus--registered-fds)))
+    (should-not
+     (member
+      (cons lock2 dbus--test-systemd-path)
+      (dbus--registered-fds)))
+    ;; The file descriptors have been deleted.
+    (when (file-directory-p fd-directory)
+      (should-not
+       (file-exists-p (expand-file-name (number-to-string lock1) fd-directory)))
+      (should-not
+       (file-exists-p (expand-file-name (number-to-string lock2) fd-directory))))
+
+    ;; Closing them again is a noop.
+    (should-not (dbus--fd-close lock1))
+    (should-not (dbus--fd-close lock2))))
+
+(ert-deftest dbus-test10-open-close-fd ()
+  "Check D-Bus open/close a file descriptor."
+  :tags '(:expensive-test)
+  (skip-unless dbus--test-enabled-system-bus)
+  (skip-unless (dbus-ping :system dbus--test-systemd-service 1000))
+
+  (ert-with-temp-file tmpfile
+    (let ((fd-directory (format "/proc/%d/fd" (emacs-pid)))
+          fd)
+      ;; Create file descriptor.
+      (setq fd (dbus--fd-open tmpfile))
+      (should (natnump fd))
+      ;; The file descriptor is registered internally.
+      (should (member (cons fd tmpfile) (dbus--registered-fds)))
+      ;; There exist a file descriptor file.
+      (when (file-directory-p fd-directory)
+        (should
+         (file-symlink-p (expand-file-name (number-to-string fd) fd-directory)))
+        (should
+         (string-equal
+          (file-truename (expand-file-name (number-to-string fd) fd-directory))
+          tmpfile)))
+
+      ;; It is not possible to modify registered file descriptors on Lisp level.
+      (setcar (assoc fd (dbus--registered-fds)) 'malicious)
+      (should (assoc fd (dbus--registered-fds)))
+      (should-not (assoc 'malicious (dbus--registered-fds)))
+
+      ;; Close the file descriptor.
+      (should (dbus--fd-close fd))
+      ;; The internal registration has gone.
+      (should-not (member (cons fd tmpfile) (dbus--registered-fds)))
+      ;; The file descriptor file has been deleted.
+      (when (file-directory-p fd-directory)
+        (should-not
+         (file-exists-p (expand-file-name (number-to-string fd) fd-directory))))
+
+      ;; Closing it again is a noop.
+      (should-not (dbus--fd-close fd)))))
 
 (defun dbus-test-all (&optional interactive)
   "Run all tests for \\[dbus]."