From 89209a83b60c87d97f0c05dbf6cb29ff3cdf3d5a Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sat, 7 Feb 2026 11:32:54 +0100 Subject: [PATCH] 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. --- doc/misc/dbus.texi | 151 ++++++++++++++--------------- etc/NEWS | 24 ++--- lisp/net/dbus.el | 12 ++- src/dbusbind.c | 186 ++++++++++++++++++++---------------- test/lisp/net/dbus-tests.el | 165 ++++++++++++++++++++++---------- 5 files changed, 315 insertions(+), 223 deletions(-) diff --git a/doc/misc/dbus.texi b/doc/misc/dbus.texi index 59685087ae8..5b302c883ad 100644 --- a/doc/misc/dbus.texi +++ b/doc/misc/dbus.texi @@ -64,7 +64,7 @@ another. An overview of D-Bus can be found at * Alternative Buses:: Alternative buses and environments. * Errors and Events:: Errors and events. * Monitoring Messages:: Monitoring messages. -* Inhibitor Locks:: Inhibit system shutdowns and sleep states. +* File Descriptors:: Handle file descriptors. * Index:: Index including concepts, functions, variables. * GNU Free Documentation License:: The license for this documentation. @@ -1212,7 +1212,7 @@ which carries the input parameters to the object owning the method to be called, and a reply message returning the resulting output parameters from the object. -@defun dbus-call-method bus service path interface method &optional :timeout timeout :authorizable auth &rest args +@defun dbus-call-method bus service path interface method &optional :timeout timeout :authorizable auth :keep-fd &rest args @anchor{dbus-call-method} This function calls @var{method} on the D-Bus @var{bus}. @var{bus} is either the keyword @code{:system} or the keyword @code{:session}. @@ -1245,6 +1245,11 @@ running): @result{} "/org/freedesktop/systemd1/job/17508" @end lisp +If the parameter @code{:keep-fd} is given, and the return message has a +first argument with a D-Bus type @code{:unix-fd}, the returned file +descriptor is kept internally, and can be used in a later call of +@code{dbus--close-fd} (@pxref{File Descriptors}). + The remaining arguments @var{args} are passed to @var{method} as arguments. They are converted into D-Bus types as described in @ref{Type Conversion}. @@ -1324,7 +1329,7 @@ emulate the @code{lshal} command on GNU/Linux systems: @cindex method calls, asynchronous @cindex asynchronous method calls -@defun dbus-call-method-asynchronously bus service path interface method handler &optional :timeout timeout :authorizable auth &rest args +@defun dbus-call-method-asynchronously bus service path interface method handler &optional :timeout timeout :authorizable auth :keep-fd &rest args This function calls @var{method} on the D-Bus @var{bus} asynchronously. @var{bus} is either the keyword @code{:system} or the keyword @code{:session}. @@ -1347,6 +1352,11 @@ If the parameter @code{:authorizable} is given and the following @var{auth} is non-@code{nil}, the invoked method may interactively prompt the user for authorization. The default is @code{nil}. +If the parameter @code{:keep-fd} is given, and the return message has a +first argument with a D-Bus type @code{:unix-fd}, the returned file +descriptor is kept internally, and can be used in a later call of +@code{dbus--close-fd} (@pxref{File Descriptors}). + The remaining arguments @var{args} are passed to @var{method} as arguments. They are converted into D-Bus types as described in @ref{Type Conversion}. @@ -2205,109 +2215,90 @@ switches to the monitor buffer. @end deffn -@node Inhibitor Locks -@chapter Inhibit system shutdowns and sleep states +@node File Descriptors +@chapter Handle file descriptors -@uref{https://systemd.io/INHIBITOR_LOCKS/, Systemd} includes a logic to -inhibit system shutdowns and sleep states. It can be controlled by a -D-Bus API@footnote{@uref{https://www.freedesktop.org/software/systemd/man/latest/org.freedesktop.login1.html}}. -Because this API includes handling of file descriptors, not all -functions can be implemented by simple D-Bus method calls. Therefore, -the following functions are provided. +Methods offered by the D-Bus API could return a file descriptor, which +must be handled further. This is indicated by the @code{:keep-fd} +parameter when calling the method (@pxref{dbus-call-method}). -@defun dbus-make-inhibitor-lock what why &optional block -This function creates an inhibitor for system shutdowns and sleep states. - -@var{what} is a colon-separated string of lock types: @samp{shutdown}, -@samp{sleep}, @samp{idle}, @samp{handle-power-key}, -@samp{handle-suspend-key}, @samp{handle-hibernate-key}, -@samp{handle-lid-switch}. Example: @samp{shutdown:idle}. - -@c@var{who} is a descriptive string of who is taking the lock. If it is -@c@code{nil}, it defaults to @samp{Emacs}. - -@var{why} is a descriptive string of why the lock is taken. Example: -@samp{Package Update in Progress}. - -The optional @var{block} is the mode of the inhibitor lock, either -@samp{block} (@var{block} is non-@code{nil}), or @samp{delay}. - -Note, that the @code{who} argument of the inhibitor lock object of the -systemd manager is always set to the string @samp{Emacs}. - -It returns a file descriptor or @code{nil}, if the lock cannot be -acquired. If there is already an inhibitor lock for the triple -@code{(WHAT WHY BLOCK)}, this lock is returned. Example: +For example, @uref{https://systemd.io/INHIBITOR_LOCKS/, Systemd} +includes a logic to inhibit system shutdowns and sleep states. It can +be controlled by a the method @samp{Inhibit} of interface +@samp{org.freedesktop.login1.Manager}@footnote{@uref{https://www.freedesktop.org/software/systemd/man/latest/org.freedesktop.login1.html}}. +This function returns a file descriptor, which must be used to unlock +the locked resource, some of which lock the system. In order to keep +this file descriptor internally, the respective D-Bus method call looks +like (@var{what}, @var{who}, @var{why} and @var{mode} are +method-specific string arguments) @lisp -(dbus-make-inhibitor-lock "sleep" "Test") +(dbus-call-method + :system + "org.freedesktop.login1" "/org/freedesktop/login1" + "org.freedesktop.login1.Manager" "Inhibit" + :keep-fd WHAT WHO WHY MODE) @result{} 25 @end lisp -@end defun -@defun dbus-registered-inhibitor-locks -Return registered inhibitor locks, an alist. -This allows to check, whether other packages of the running Emacs -instance have acquired an inhibitor lock as well. +The inhibition lock is unlocked, when the returned file descriptor is +removed from the file system. This cannot be achieved on Lisp level. +Therefore, there is the function @code{dbus--fd-close} to performs this +task (see below). -An entry in this list is a list @code{(@var{fd} @var{what} @var{why} -@var{block})}. The car of the list is the file descriptor retrieved -from a @code{dbus-make-inhibitor-lock} call. The cdr of the list -represents the three arguments @code{dbus-make-inhibitor-lock} was -called with. Example: +@strong{Note}: When the Emacs process itself dies, all such locks are +released. + +@strong{Note}: The following functions are internal to the D-Bus +implementation of Emacs. Use them with care. + +@defun dbus--fd-open filename +Open @var{filename} and return the respective read-only file descriptor. +This is another function to keep a file descriptor internally. The +returned file descriptor can be closed by @code{dbus--fd-close}. +Example: @lisp -(dbus-registered-inhibitor-locks) +(dbus--fd-open "~/.emacs") -@result{} ((25 "sleep" "Test" nil)) +@result{} 20 @end lisp @end defun -@defun dbus-close-inhibitor-lock lock -Close inhibitor lock file descriptor. - -@var{lock}, a file descriptor, must be the result of a -@code{dbus-make-inhibitor-lock} call. It returns @code{t} in case of -success, or @code{nil} if it isn't be possible to close the lock, or if -the lock is closed already. Example: +@defun dbus--fd-close fd +Close file descriptor @var{fd}. +@var{fd} must be the result of a @code{dbus-call-method} or +@code{dbus--fd-open} call, see @code{dbus--registered-fds}. It returns +@code{t} in case of success, or @code{nil} if it isn’t be possible to +close the file descriptor, or if the file descriptor is closed already. +Example: @lisp -(dbus-close-inhibitor-lock 25) +(dbus--fd-close 25) @result{} t - @end lisp @end defun -A typical scenario for these functions is to register for the -D-Bus signal @samp{org.freedesktop.login1.Manager.PrepareForSleep}: +@defun dbus--registered-fds +Return registered file descriptors, an alist. +The key is an open file descriptor, retrieved via +@code{dbus-call-method} or @code{dbus--open-fd}. The value is a string +@var{object-path} or @var{filename}, which represents the arguments the +function was called with. Those values are not needed for further +operations; they are just shown for information. + +This alist allows to check, whether other packages of the running Emacs +instance have acquired a file descriptor as well. Example: @lisp -(defvar my-inhibitor-lock - (dbus-make-inhibitor-lock "sleep" "Test")) +(dbus--registered-fds) -(defun my-dbus-PrepareForSleep-handler (start) - (if start ;; The system goes down for sleep - (progn - @dots{} - ;; Release inhibitor lock. - (when (natnump my-inhibitor-lock) - (dbus-close-inhibitor-lock my-inhibitor-lock) - (setq my-inhibitor-lock nil))) - ;; Reacquire inhibitor lock. - (setq my-inhibitor-lock - (dbus-make-inhibitor-lock "sleep" "Test")))) - -(dbus-register-signal - :system "org.freedesktop.login1" "/org/freedesktop/login1" - "org.freedesktop.login1.Manager" "PrepareForSleep" - #'my-dbus-PrepareForSleep-handler) - -@result{} ((:signal :system "org.freedesktop.login1.Manager" "PrepareForSleep") - ("org.freedesktop.login1" "/org/freedesktop/login1" - my-dbus-PrepareForSleep-handler)) +@result{} ((20 . "/home/user/.emacs") + (25 . "/org/freedesktop/login1")) @end lisp +@end defun @node Index diff --git a/etc/NEWS b/etc/NEWS index 093e525fa81..1d6929f97e2 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -84,9 +84,9 @@ other directory on your system. You can also invoke the +++ ** 'line-spacing' now supports specifying spacing above the line. -Previously, only spacing below the line could be specified. The variable -can now be set to a cons cell to specify spacing both above and below -the line, which allows for vertically centering text. +Previously, only spacing below the line could be specified. The user +option can now be set to a cons cell to specify spacing both above and +below the line, which allows for vertically centering text. +++ ** 'prettify-symbols-mode' attempts to ignore undisplayable characters. @@ -1410,7 +1410,7 @@ is non-nil, this suffix is fontified using 'font-lock-type-face'. --- *** New user option 'yaml-ts-mode-yamllint-options'. -Additional options for 'yamllint' the command used for Flymake's YAML +Additional options for 'yamllint', the command used for Flymake's YAML support. ** EIEIO @@ -2629,7 +2629,7 @@ When the argument is non-nil, the function switches to a buffer visiting the directory into which the repository was cloned. +++ -*** 'vc-revert' is now bound to '@' in VC-Dir. +*** 'vc-revert' is now bound to '@' in VC Directory. +++ *** 'vc-revert' is now additionally bound to 'C-x v @'. @@ -2771,7 +2771,7 @@ base with the remote branch, including uncommitted changes. ('vc-root-log-outgoing-base') show the corresponding revision logs. These are useful to view all outstanding (unmerged, unpushed) changes on the current branch. They are also available as 'T =', 'T D', 'T l' and -'T L' in VC-Dir buffers. +'T L' in VC Directory buffers. +++ *** New user option 'vc-use-incoming-outgoing-prefixes'. @@ -3858,11 +3858,13 @@ and 'dbus-call-method-asynchronously' to allow the user to interactively authorize the invoked D-Bus method (for example via polkit). +++ -*** New D-Bus functions to support systemd inhibitor locks. -The functions 'dbus-make-inhibitor-lock', 'dbus-close-inhibitor-lock' -and 'dbus-registered-inhibitor-locks' implement acquiring and releasing -systemd inhibitor locks. See the Info node "(dbus) Inhibitor Locks" for -details. +*** Support D-Bus file descriptor manipulation. +A new ':keep-fd' parameter has been added to 'dbus-call-method' and +'dbus-call-method-asynchronously' to instruct D-Bus to keep a file +descriptor, which has been returned by a method call, internally. The +functions 'dbus--fd-open', 'dbus--fd-close' and 'dbus--registered-fds' +implement managing these file descriptors. See the Info node "(dbus) +File Descriptors" for details. ** The customization group 'wp' has been removed. It has been obsolete since Emacs 26.1. Use the group 'text' instead. diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el index 1c8f329fdd7..465de028725 100644 --- a/lisp/net/dbus.el +++ b/lisp/net/dbus.el @@ -319,6 +319,10 @@ If the parameter `:authorizable' is given and the following AUTH is non-nil, the invoked method may interactively prompt the user for authorization. The default is nil. +If the parameter `:keep-fd' is given, and the return message has a first +argument with a D-Bus type `:unix-fd', the returned file desriptor is +kept internally, and can be used in a later `dbus--close-fd' call. + All other arguments ARGS are passed to METHOD as arguments. They are converted into D-Bus types via the following rules: @@ -453,6 +457,10 @@ If the parameter `:authorizable' is given and the following AUTH is non-nil, the invoked method may interactively prompt the user for authorization. The default is nil. +If the parameter `:keep-fd' is given, and the return message has a first +argument with a D-Bus type `:unix-fd', the returned file desriptor is +kept internally, and can be used in a later `dbus--close-fd' call. + All other arguments ARGS are passed to METHOD as arguments. They are converted into D-Bus types via the following rules: @@ -604,6 +612,7 @@ This is an internal function, it shall not be used outside dbus.el." ;;; Hash table of registered functions. +;; Seems to be unused. Dow we want to keep it? (defun dbus-list-hash-table () "Return all registered member registrations to D-Bus. The return value is a list, with elements of kind (KEY . VALUE). @@ -613,7 +622,7 @@ hash table." (maphash (lambda (key value) (push (cons key value) result)) dbus-registered-objects-table) - result)) + (nreverse result))) (defun dbus-setenv (bus variable value) "Set the value of the BUS environment variable named VARIABLE to VALUE. @@ -2098,6 +2107,7 @@ either a method name, a signal name, or an error name." (defun dbus-monitor-goto-serial () "Goto D-Bus message with the same serial number." + (declare (completion ignore)) (interactive) (when (mouse-event-p last-input-event) (mouse-set-point last-input-event)) (when-let* ((point (get-text-property (point) 'dbus-serial))) diff --git a/src/dbusbind.c b/src/dbusbind.c index 3cf3ec9897e..98adebfb2d4 100644 --- a/src/dbusbind.c +++ b/src/dbusbind.c @@ -128,6 +128,8 @@ static bool xd_in_read_queued_messages = 0; #endif /* Check whether TYPE is a basic DBusType. */ +/* TODO: Shouldn't we assume, that recent D-Bus implementations carry + HAVE_DBUS_TYPE_IS_VALID and DBUS_TYPE_UNIX_FD? See configure.ac. */ #ifdef HAVE_DBUS_TYPE_IS_VALID #define XD_BASIC_DBUS_TYPE(type) \ (dbus_type_is_valid (type) && dbus_type_is_basic (type)) @@ -309,6 +311,8 @@ XD_OBJECT_TO_STRING (Lisp_Object object) } \ } while (0) +/* TODO: Shouldn't we assume, that recent D-Bus implementations carry + HAVE_DBUS_VALIDATE_*? See configure.ac. */ #if (HAVE_DBUS_VALIDATE_BUS_NAME || HAVE_DBUS_VALIDATE_PATH \ || HAVE_DBUS_VALIDATE_INTERFACE || HAVE_DBUS_VALIDATE_MEMBER) #define XD_DBUS_VALIDATE_OBJECT(object, func) \ @@ -1034,6 +1038,8 @@ xd_get_connection_address (Lisp_Object bus) } /* Return the file descriptor for WATCH, -1 if not found. */ +/* TODO: Shouldn't we assume, that recent D-Bus implementations carry + HAVE_DBUS_WATCH_GET_UNIX_FD? See configure.ac. */ static int xd_find_watch_fd (DBusWatch *watch) { @@ -1349,6 +1355,7 @@ usage: (dbus-message-internal &rest REST) */) dbus_uint32_t serial = 0; unsigned int ui_serial; int timeout = -1; + dbus_bool_t keepfd = FALSE; ptrdiff_t count, count0; char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH]; @@ -1525,6 +1532,7 @@ usage: (dbus-message-internal &rest REST) */) timeout = min (XFIXNAT (args[count+1]), INT_MAX); count = count + 2; } + /* Check for authorizable parameter. */ else if (EQ (args[count], QCauthorizable)) { @@ -1542,6 +1550,24 @@ usage: (dbus-message-internal &rest REST) */) count = count + 2; } + + /* Check for keepfd parameter. */ + else if (EQ (args[count], QCkeep_fd)) + { + if (mtype != DBUS_MESSAGE_TYPE_METHOD_CALL) + XD_SIGNAL1 + (build_string (":keep-fd is only supported on method calls")); + + /* Ignore this keyword if unsupported. */ +#ifdef DBUS_TYPE_UNIX_FD + keepfd = TRUE; +#else + XD_DEBUG_MESSAGE (":keep-fd not supported"); +#endif + + ++count; + } + else break; } @@ -1595,7 +1621,8 @@ usage: (dbus-message-internal &rest REST) */) result = list3 (QCserial, bus, INT_TO_INTEGER (serial)); /* Create a hash table entry. */ - Fputhash (result, handler, Vdbus_registered_objects_table); + Fputhash (result, keepfd ? Fcons (handler, path) : handler, + Vdbus_registered_objects_table); } else { @@ -1617,106 +1644,81 @@ usage: (dbus-message-internal &rest REST) */) return result; } -/* Alist of registered inhibitor locks for D-Bus. - An entry in this list is a list (FD WHAT WHY BLOCK). - The car of the list is a file descriptor retrieved from a - 'dbus-make-inhibitor-lock` call. The cdr of the list represents the - three arguments 'dbus-make-inhibitor-lock` was called with. */ -static Lisp_Object xd_registered_inhibitor_locks; +/* Alist of registered file descriptors for D-Bus. + The key is an open file descriptor, retrieved via `dbus-call-method' + or `dbus--open-fd'. The value is a string OBJECT-PATH or FILENAME, + which represents the arguments the function was called with. Those + values are not needed for further operations; they are just shown for + information. */ +static Lisp_Object xd_registered_fds; -DEFUN ("dbus-make-inhibitor-lock", Fdbus_make_inhibitor_lock, - Sdbus_make_inhibitor_lock, - 2, 3, 0, - doc: /* Inhibit system shutdowns and sleep states. - -WHAT is a colon-separated string of lock types, i.e. "shutdown", -"sleep", "idle", "handle-power-key", "handle-suspend-key", -"handle-hibernate-key", "handle-lid-switch". Example: "shutdown:idle". - -WHY is a descriptive string of why the lock is taken. Example: "Package -Update in Progress". - -The optional BLOCK is the mode of the inhibitor lock, either "block" -(BLOCK is non-nil), or "delay". - -It returns a file descriptor or nil, if the lock cannot be acquired. If -there is already an inhibitor lock for the triple (WHAT WHY BLOCK), this -lock is returned. - -For details of the arguments, see Info node `(dbus)Inhibitor Locks'. */) - (Lisp_Object what, Lisp_Object why, Lisp_Object block) +DEFUN ("dbus--fd-open", Fdbus__fd_open, Sdbus__fd_open, 1, 1, 0, + doc: /* Open FILENAME and return the respective read-only file descriptor. */) + (Lisp_Object filename) { - CHECK_STRING (what); - CHECK_STRING (why); - if (!NILP (block)) - block = Qt; - Lisp_Object who = build_string ("Emacs"); - Lisp_Object mode = - (NILP (block)) ? build_string ("delay") : build_string ("block"); + CHECK_STRING (filename); + filename = Fexpand_file_name (filename, Qnil); + filename = ENCODE_FILE (filename); /* Check, whether it is registered already. */ - Lisp_Object triple = list3 (what, why, block); - Lisp_Object registered = Frassoc (triple, xd_registered_inhibitor_locks); + Lisp_Object registered = Frassoc (filename, xd_registered_fds); if (!NILP (registered)) return CAR_SAFE (registered); - /* Register lock. */ - Lisp_Object lock = - calln (Qdbus_call_method, QCsystem, - build_string ("org.freedesktop.login1"), - build_string ("/org/freedesktop/login1"), - build_string ("org.freedesktop.login1.Manager"), - build_string ("Inhibit"), what, who, why, mode); + /* Open file descriptor. */ + int fd = emacs_open (SSDATA (filename), O_RDONLY, 0); - xd_registered_inhibitor_locks = - Fcons (Fcons (lock, triple), xd_registered_inhibitor_locks); - return lock; + if (fd <= 0) + XD_SIGNAL2 (build_string ("Cannot open file"), filename); + + /* Register file descriptor. */ + xd_registered_fds = + Fcons (Fcons (INT_TO_INTEGER (fd), filename), xd_registered_fds); + return INT_TO_INTEGER (fd); } -DEFUN ("dbus-close-inhibitor-lock", Fdbus_close_inhibitor_lock, - Sdbus_close_inhibitor_lock, - 1, 1, 0, - doc: /* Close inhibitor lock file descriptor. - -LOCK, a file descriptor, must be the result of a `dbus-make-inhibitor-lock' -call. It returns t in case of success, or nil if it isn't be possible -to close the lock, or if the lock is closed already. - -For details, see Info node `(dbus)Inhibitor Locks'. */) - (Lisp_Object lock) +DEFUN ("dbus--fd-close", Fdbus__fd_close, Sdbus__fd_close, 1, 1, 0, + doc: /* Close file descriptor FD. +FD must be the result of a `dbus-call-method' or `dbus--fd-open' call, +see `dbus--registered-fds'. It returns t in case of success, or nil if +it isn't be possible to close the file descriptor, or if the file +descriptor is closed already. */) + (Lisp_Object fd) { - CHECK_FIXNUM (lock); + CHECK_FIXNUM (fd); /* Check, whether it is registered. */ - Lisp_Object registered = assoc_no_quit (lock, xd_registered_inhibitor_locks); + Lisp_Object registered = assoc_no_quit (fd, xd_registered_fds); if (NILP (registered)) return Qnil; else { - xd_registered_inhibitor_locks = - Fdelete (registered, xd_registered_inhibitor_locks); - return (emacs_close (XFIXNAT (lock)) == 0) ? Qt : Qnil; + xd_registered_fds = Fdelete (registered, xd_registered_fds); + return (emacs_close (XFIXNAT (fd)) == 0) ? Qt : Qnil; } } -DEFUN ("dbus-registered-inhibitor-locks", Fdbus_registered_inhibitor_locks, - Sdbus_registered_inhibitor_locks, +DEFUN ("dbus--registered-fds", Fdbus__registered_fds, Sdbus__registered_fds, 0, 0, 0, - doc: /* Return registered inhibitor locks, an alist. -This allows to check, whether other packages of the running Emacs -instance have acquired an inhibitor lock as well. -An entry in this list is a list (FD WHAT WHY BLOCK). -The car of the list is the file descriptor retrieved from a -'dbus-make-inhibitor-lock` call. The cdr of the list represents the -three arguments 'dbus-make-inhibitor-lock` was called with. */) + doc: /* Return registered file descriptors, an alist. +The key is an open file descriptor, retrieved via `dbus-call-method' or +`dbus--open-fd'. The value is a string OBJECT-PATH or FILENAME, which +represents the arguments the function was called with. Those values are +not needed for further operations; they are just shown for information. + +This alist allows to check, whether other packages of the running Emacs +instance have acquired a file descriptor as well. */) (void) { - /* We return a copy of xd_registered_inhibitor_locks, in order to - protect it against malicious manipulation. */ - Lisp_Object registered = xd_registered_inhibitor_locks; + /* We return a copy of xd_registered_fds, in order to protect it + against malicious manipulation. */ + Lisp_Object registered = xd_registered_fds; Lisp_Object result = Qnil; for (; !NILP (registered); registered = CDR_SAFE (registered)) - result = Fcons (Fcopy_sequence (CAR_SAFE (registered)), result); + { + Lisp_Object tem = CAR_SAFE (registered); + result = Fcons (Fcons (CAR_SAFE (tem), CDR_SAFE (tem)), result); + } return Fnreverse (result); } @@ -1836,7 +1838,22 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus) Fremhash (key, Vdbus_registered_objects_table); /* Store the event. */ - xd_store_event (value, args, event_args); + xd_store_event (CONSP (value) ? CAR_SAFE (value) : value, args, event_args); + +#ifdef DBUS_TYPE_UNIX_FD + /* Check, whether there is a file descriptor to be kept. + value is (handler . path) + args is ((:unix-fd NN) ...) */ + if (CONSP (value) + && CONSP (CAR_SAFE (args)) + && EQ (CAR_SAFE (CAR_SAFE (args)), QCunix_fd)) + { + xd_registered_fds = + Fcons (Fcons (CAR_SAFE (CDR_SAFE (CAR_SAFE (args))), + CDR_SAFE (value)), + xd_registered_fds); + } +#endif } else /* DBUS_MESSAGE_TYPE_METHOD_CALL, DBUS_MESSAGE_TYPE_SIGNAL. */ @@ -1972,7 +1989,7 @@ static void syms_of_dbusbind_for_pdumper (void) { xd_registered_buses = Qnil; - xd_registered_inhibitor_locks = Qnil; + xd_registered_fds = Qnil; } void @@ -1980,9 +1997,9 @@ syms_of_dbusbind (void) { defsubr (&Sdbus__init_bus); defsubr (&Sdbus_get_unique_name); - defsubr (&Sdbus_make_inhibitor_lock); - defsubr (&Sdbus_close_inhibitor_lock); - defsubr (&Sdbus_registered_inhibitor_locks); + defsubr (&Sdbus__fd_open); + defsubr (&Sdbus__fd_close); + defsubr (&Sdbus__registered_fds); DEFSYM (Qdbus_message_internal, "dbus-message-internal"); defsubr (&Sdbus_message_internal); @@ -2007,6 +2024,11 @@ syms_of_dbusbind (void) /* Lisp symbol for method interactive authorization. */ DEFSYM (QCauthorizable, ":authorizable"); + /* Lisp symbol for file descriptor kept. */ +#ifdef DBUS_TYPE_UNIX_FD + DEFSYM (QCkeep_fd, ":keep-fd"); +#endif + /* Lisp symbols of D-Bus types. */ DEFSYM (QCbyte, ":byte"); DEFSYM (QCboolean, ":boolean"); @@ -2143,7 +2165,7 @@ be called when the D-Bus reply message arrives. */); /* Initialize internal objects. */ pdumper_do_now_and_after_load (syms_of_dbusbind_for_pdumper); staticpro (&xd_registered_buses); - staticpro (&xd_registered_inhibitor_locks); + staticpro (&xd_registered_fds); Fprovide (intern_c_string ("dbusbind"), Qnil); } 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)))) + (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-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"))) - - ;; 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)))) + (when (file-directory-p fd-directory) + (should + (file-symlink-p + (expand-file-name (number-to-string lock2) fd-directory)))) - ;; 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")) + ;; 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]."