From 96a8e846061f255b1a394a5854197aa742dfff84 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sun, 4 Oct 2020 18:56:45 +0200 Subject: [PATCH] Make dbus-unregister-object work for monitors * doc/misc/dbus.texi (Monitoring Messages): Rename from "Monitoring Events". (Register Objects, Monitoring Messages): Mention returned object. * lisp/net/dbus.el (dbus-unregister-object): Adapt docstring. (dbus-unregister-object): Delete monitor if needed. (dbus-register-monitor): Return proper object. * src/dbusbind.c (dbus-registered-objects-table): Adapt docstring. * test/lisp/net/dbus-tests.el (dbus--test-signal-handler): Adapt docstring. (dbus-test08-register-monitor): New test. --- doc/misc/dbus.texi | 35 ++++++++++++++++++------------- lisp/net/dbus.el | 12 +++++++---- src/dbusbind.c | 18 +++++++++------- test/lisp/net/dbus-tests.el | 42 ++++++++++++++++++++++++++++++++++++- 4 files changed, 79 insertions(+), 28 deletions(-) diff --git a/doc/misc/dbus.texi b/doc/misc/dbus.texi index 4b2eab4eb76..5a1dd55248d 100644 --- a/doc/misc/dbus.texi +++ b/doc/misc/dbus.texi @@ -63,7 +63,7 @@ another. An overview of D-Bus can be found at * Signals:: Sending and receiving signals. * Alternative Buses:: Alternative buses and environments. * Errors and Events:: Errors and events. -* Monitoring Events:: Monitoring events. +* Monitoring Messages:: Monitoring messages. * Index:: Index including concepts, functions, variables. * GNU Free Documentation License:: The license for this documentation. @@ -1622,7 +1622,9 @@ are constructed incrementally by adding single methods or properties at a time, @var{dont-register-service} can be used to prevent other clients from discovering the still incomplete interface. -@noindent Example: +@code{dbus-register-property} returns a Lisp object, which can be used +as argument in @code{dbus-unregister-object} for removing the +registration for @var{property}. Example: @lisp (dbus-register-property @@ -1687,9 +1689,9 @@ It is also possible to apply the @code{dbus-get-property}, @defun dbus-unregister-object object This function unregisters @var{object} from the D-Bus. @var{object} must be the result of a preceding @code{dbus-register-method}, -@code{dbus-register-property} or @code{dbus-register-signal} call -(@pxref{Signals}). It returns @code{t} if @var{object} has been -unregistered, @code{nil} otherwise. +@code{dbus-register-property}, @code{dbus-register-signal} +(@pxref{Signals}) or @code{dbus-register-monitor} call. It returns +@code{t} if @var{object} has been unregistered, @code{nil} otherwise. When @var{object} identifies the last method or property, which is registered for the respective service, Emacs releases its association @@ -2099,24 +2101,24 @@ D-Bus applications running. They should therefore check carefully, whether a given D-Bus error is related to them. -@node Monitoring Events -@chapter Monitoring events. +@node Monitoring Messages +@chapter Monitoring messages. @cindex monitoring @defun dbus-register-monitor bus &optional handler &key type sender destination path interface member -This function registers @var{handler} for monitor events on the D-Bus -@var{bus}. +This function registers @var{handler} for monitoring messages on the +D-Bus @var{bus}. @var{bus} is either a Lisp keyword, @code{:system} or @code{:session}, or a string denoting the bus address. @findex dbus-monitor-handler -@var{handler} is the function to be called when a monitor event -arrives. It is called with the `args' slot of the monitor event, -which are stripped off the type keywords. If @var{handler} is -@code{nil}, the default handler @code{dbus-monitor-handler} is -applied. This default handler behaves similar to the -@command{dbus-monitor} program. +@var{handler} is the function to be called when a D-Bus event to be +monitored arrives. It is called with the @var{args} slot of the D-Bus +event (@pxref{Errors and Events}), which are stripped off the type +keywords. If @var{handler} is @code{nil}, the default handler +@code{dbus-monitor-handler} is applied. This default handler behaves +similar to the @command{dbus-monitor} program. The other arguments are keyword-value pairs. @code{:type @var{type}} defines the message type to be monitored. If given, it must be equal @@ -2132,6 +2134,9 @@ names. @code{:member @var{member}} is either a method name, a signal name, or an error name. +@code{dbus-register-monitor} returns a Lisp object, which can be used +as argument in @code{dbus-unregister-object} for removing the monitor. + The following form shows all D-Bus events on the session bus in buffer @samp{*D-Bus Monitor*}: diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el index 48712a9c3d8..77ba5266dcb 100644 --- a/lisp/net/dbus.el +++ b/lisp/net/dbus.el @@ -912,8 +912,9 @@ discovering the still incomplete interface." (defun dbus-unregister-object (object) "Unregister OBJECT from D-Bus. OBJECT must be the result of a preceding `dbus-register-method', -`dbus-register-property' or `dbus-register-signal' call. It -returns t if OBJECT has been unregistered, nil otherwise. +`dbus-register-signal', `dbus-register-property' or +`dbus-register-monitor' call. The function returns t if OBJECT +has been unregistered, nil otherwise. When OBJECT identifies the last method or property, which is registered for the respective service, Emacs releases its @@ -951,7 +952,10 @@ association to the service from D-Bus." (when (eq type :signal) (dbus-call-method bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus - "RemoveMatch" (nth 4 elt))))) + "RemoveMatch" (nth 4 elt))) + ;; Delete monitor connection by reestablishing private bus. + (when (eq type :monitor) + (dbus-init-bus bus 'private)))) ;; Check, whether there is still a registered function or property ;; for the given service. If not, unregister the service from the @@ -2037,7 +2041,7 @@ either a method name, a signal name, or an error name." (when dbus-debug (message "%s" dbus-registered-objects-table)) ;; Return the object. - (list key key1))) + (list key (list nil nil handler)))) (defconst dbus-monitor-method-call (propertize "method-call" 'face 'font-lock-function-name-face) diff --git a/src/dbusbind.c b/src/dbusbind.c index cca5f13907d..1ac77313a35 100644 --- a/src/dbusbind.c +++ b/src/dbusbind.c @@ -1937,11 +1937,12 @@ syms_of_dbusbind (void) doc: /* Hash table of registered functions for D-Bus. There are two different uses of the hash table: for accessing -registered interfaces properties, targeted by signals or method calls, -and for calling handlers in case of non-blocking method call returns. +registered interfaces properties, targeted by signals, method calls or +monitors, and for calling handlers in case of non-blocking method call +returns. In the first case, the key in the hash table is the list (TYPE BUS -INTERFACE MEMBER). TYPE is one of the Lisp symbols `:method', +[INTERFACE MEMBER]). TYPE is one of the Lisp symbols `:method', `:signal', `:property' or `:monitor'. BUS is either a Lisp symbol, `:system', `:session', `:system-private' or `:session-private', or a string denoting the bus address. INTERFACE is a string which denotes @@ -1951,17 +1952,18 @@ signal or a property INTERFACE is offering. All arguments can be nil. The value in the hash table is a list of quadruple lists ((UNAME SERVICE PATH OBJECT [RULE]) ...). SERVICE is the service name as registered, UNAME is the corresponding unique name. In case of -registered methods and properties, UNAME is nil. PATH is the object -path of the sending object. All of them can be nil, which means a -wildcard then. +registered methods, properties and monitors, UNAME is nil. PATH is +the object path of the sending object. All of them can be nil, which +means a wildcard then. OBJECT is either the handler to be called when a D-Bus message, which matches the key criteria, arrives (TYPE `:method', `:signal' and `:monitor'), or a list (ACCESS EMITS-SIGNAL VALUE) for TYPE `:property'. -For entries of type `:signal', there is also a fifth element RULE, -which keeps the match string the signal is registered with. +For entries of type `:signal' or `:monitor', there is also a fifth +element RULE, which keeps the match string the signal or monitor is +registered with. In the second case, the key in the hash table is the list (:serial BUS SERIAL). BUS is either a Lisp symbol, `:system' or `:session', or a diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el index 7ebef5d2609..94816bb4929 100644 --- a/test/lisp/net/dbus-tests.el +++ b/test/lisp/net/dbus-tests.el @@ -697,7 +697,7 @@ is in progress." "Received signal value in `dbus--test-signal-handler'.") (defun dbus--test-signal-handler (&rest args) - "Signal handler for `dbus-test*-signal'." + "Signal handler for `dbus-test*-signal' and `dbus-test08-register-monitor'." (setq dbus--test-signal-received args)) (defun dbus--test-timeout-handler (&rest _ignore) @@ -1833,6 +1833,46 @@ The argument EXPECTED-ARGS is a list of expected arguments for the method." ;; Cleanup. (dbus-unregister-service :session dbus--test-service))) +(ert-deftest dbus-test08-register-monitor () + "Check monitor registration." + :tags '(:expensive-test) + (skip-unless dbus--test-enabled-session-bus) + + (unwind-protect + (let (registered) + (should + (equal + (setq registered + (dbus-register-monitor :session #'dbus--test-signal-handler)) + '((:monitor :session-private) + (nil nil dbus--test-signal-handler)))) + + ;; Send a signal, shall be traced. + (setq dbus--test-signal-received nil) + (dbus-send-signal + :session dbus--test-service dbus--test-path + dbus--test-interface "Foo" "foo") + (with-timeout (1 (dbus--test-timeout-handler)) + (while (null dbus--test-signal-received) + (read-event nil nil 0.1))) + + ;; Unregister monitor. + (should (dbus-unregister-object registered)) + (should-not (dbus-unregister-object registered)) + + ;; Send a signal, shall not be traced. + (setq dbus--test-signal-received nil) + (dbus-send-signal + :session dbus--test-service dbus--test-path + dbus--test-interface "Foo" "foo") + (with-timeout (1 (ignore)) + (while (null dbus--test-signal-received) + (read-event nil nil 0.1))) + (should-not dbus--test-signal-received)) + + ;; Cleanup. + (dbus-unregister-service :session dbus--test-service))) + (defun dbus-test-all (&optional interactive) "Run all tests for \\[dbus]." (interactive "p") -- 2.39.5