diff options
| -rw-r--r-- | doc/misc/dbus.texi | 54 | ||||
| -rw-r--r-- | etc/NEWS | 8 | ||||
| -rw-r--r-- | lisp/net/dbus.el | 75 | ||||
| -rw-r--r-- | src/dbusbind.c | 24 | ||||
| -rw-r--r-- | test/lisp/net/dbus-tests.el | 77 |
5 files changed, 203 insertions, 35 deletions
diff --git a/doc/misc/dbus.texi b/doc/misc/dbus.texi index 8764fcade90..d63e26755d9 100644 --- a/doc/misc/dbus.texi +++ b/doc/misc/dbus.texi @@ -1340,9 +1340,20 @@ keyword @code{:session}. D-Bus object path, @var{service} is registered at. @var{interface} is an interface offered by @var{service}. It must provide @var{method}. -@var{handler} is a Lisp function, which is called when the -corresponding return message arrives. If @var{handler} is @code{nil}, -no return message will be expected. +@var{handler} is a Lisp function, which is called when the corresponding +return message has arrived. It uses the returned values from the +@var{method} call as arguments. These are the same arguments which are +returned when @code{dbus-call-method} is invoked instead, +@pxref{Synchronous Methods}. If @var{handler} is @code{nil}, no return +message will be expected. + +@var{handler} can also be the cons cell @code{(@var{handler} +. @var{error-handler})}. In this case, @var{error-handler} will be +called in case an error is returned from D-Bus. It uses the returned +D-Bus error as argument. + +Neither the return value of @var{handler} nor the return value of +@var{error-handler} is used. If the parameter @code{:timeout} is given, the following integer @var{timeout} specifies the maximum number of milliseconds before a @@ -1366,19 +1377,40 @@ arguments. They are converted into D-Bus types as described in If @var{handler} is a Lisp function, the function returns a key into the hash table @code{dbus-registered-objects-table}. The corresponding entry in the hash table is removed, when the return -message arrives, and @var{handler} is called. Example: +message arrives, and @var{handler} is called. Examples: + +The return value of @samp{org.freedesktop.portal.Settings.ReadOne} is a variant. @lisp (dbus-call-method-asynchronously - :system "org.freedesktop.Hal" - "/org/freedesktop/Hal/devices/computer" - "org.freedesktop.Hal.Device" "GetPropertyString" - (lambda (msg) (message "%s" msg)) - "system.kernel.machine") + :session "org.freedesktop.portal.Desktop" + "/org/freedesktop/portal/desktop" + "org.freedesktop.portal.Settings" "ReadOne" + '((lambda (msg) (message "Method handler %s" msg)) . + (lambda (err) (message "Error handler %s" err))) + "org.freedesktop.appearance" "color-scheme") + +@print{} Method handler (0) + +@result{} (:serial :session 4) +@end lisp + +There does not exist a method @samp{org.freedesktop.portal.Settings.ReadTwo}. + +@lisp +(dbus-call-method-asynchronously + :session "org.freedesktop.portal.Desktop" + "/org/freedesktop/portal/desktop" + "org.freedesktop.portal.Settings" "ReadTwo" + '((lambda (msg) (message "Method handler %s" msg)) . + (lambda (err) (message "Error handler %s" err))) + "org.freedesktop.appearance" "color-scheme") -@print{} i686 +@print{} Error handler + (dbus-error "org.freedesktop.DBus.Error.UnknownMethod + No such method "ReadTwo") -@result{} (:serial :system 2) +@result{} (:serial :session 5) @end lisp @end defun @@ -69,6 +69,14 @@ Emacs 30. It allows Lisp programs that present completion candidates ("completion frontends") to provide additional information which can be used to adjust or optimize completion candidates computation. +** D-Bus + ++++ +*** Support error handler in asynchronous method calls. +The HANDLER argument of 'dbus-call-method-asynchronously' can be a cons +cell '(HANDLER . ERROR-HANDLER)'. ERROR-HANDLER is invoked if the +method call returns with a D-Bus error; the error is passed as argument. + * Changes in Emacs 32.1 on Non-Free Operating Systems diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el index 0c748e76fcf..3a5cf48b92f 100644 --- a/lisp/net/dbus.el +++ b/lisp/net/dbus.el @@ -445,8 +445,17 @@ object path SERVICE is registered at. INTERFACE is an interface offered by SERVICE. It must provide METHOD. HANDLER is a Lisp function, which is called when the corresponding -return message has arrived. If HANDLER is nil, no return message -will be expected. +return message has arrived. It uses the returned values from the METHOD +call as arguments. These are the same arguments which are returned when +`dbus-call-method' is invoked instead. If HANDLER is nil, no return +message will be expected. + +HANDLER can also be the cons cell `(HANDLER . ERROR-HANDLER)'. In this +case, ERROR-HANDLER will be called in case an error is returned from +D-Bus. It uses the returned D-Bus error as argument. + +Neither the return value of HANDLER nor the return value of +ERROR-HANDLER is used. If the parameter `:timeout' is given, the following integer TIMEOUT specifies the maximum number of milliseconds before the @@ -477,18 +486,37 @@ about type keywords, see Info node `(dbus)Type Conversion'. If HANDLER is a Lisp function, the function returns a key into the hash table `dbus-registered-objects-table'. The corresponding entry in the hash table is removed, when the return message arrives, -and HANDLER is called. +and HANDLER is called. Examples: -Example: +The return value of \"org.freedesktop.portal.Settings.ReadOne\" is a variant. \(dbus-call-method-asynchronously - :system \"org.freedesktop.Hal\" \"/org/freedesktop/Hal/devices/computer\" - \"org.freedesktop.Hal.Device\" \"GetPropertyString\" #\\='message - \"system.kernel.machine\") + :session \"org.freedesktop.portal.Desktop\" + \"/org/freedesktop/portal/desktop\" + \"org.freedesktop.portal.Settings\" \"ReadOne\" + \\='((lambda (msg) (message \"Method handler %s\" msg)) . + (lambda (err) (message \"Error handler %s\" err))) + \"org.freedesktop.appearance\" \"color-scheme\") + + -| Method handler (0) - -| i686 + => (:serial :session 4) - => (:serial :system 2)" +There does not exist a method \"org.freedesktop.portal.Settings.ReadTwo\". + +\(dbus-call-method-asynchronously + :session \"org.freedesktop.portal.Desktop\" + \"/org/freedesktop/portal/desktop\" + \"org.freedesktop.portal.Settings\" \"ReadTwo\" + \\='((lambda (msg) (message \"Method handler %s\" msg)) . + (lambda (err) (message \"Error handler %s\" err))) + \"org.freedesktop.appearance\" \"color-scheme\") + + -| Error handler + (dbus-error org.freedesktop.DBus.Error.UnknownMethod + No such method \"ReadTwo\") + + => (:serial :session 5)" (or (featurep 'dbusbind) (signal 'dbus-error (list "Emacs not compiled with dbus support"))) @@ -504,6 +532,7 @@ Example: (or (stringp method) (signal 'wrong-type-argument (list 'stringp method))) (or (null handler) (functionp handler) + (and (listp handler) (functionp (car handler)) (functionp (cdr handler))) (signal 'wrong-type-argument (list 'functionp handler))) (apply #'dbus-message-internal dbus-message-type-method-call @@ -1111,9 +1140,11 @@ INTERFACE and MEMBER denote the message which has been sent. When TYPE is `dbus-message-type-error', MEMBER is the error name. HANDLER is the function which has been registered for this -message. ARGS are the typed arguments as returned from the -message. They are passed to HANDLER without type information, -when it is called during event handling in `dbus-handle-event'. +message. It can also be a cons cell (HANDLER . ERROR-HANDLER). + +ARGS are the typed arguments as returned from the message. They are +passed to HANDLER without type information, when it is called during +event handling in `dbus-handle-event'. This function signals a `dbus-error' if the event is not well formed." @@ -1150,7 +1181,10 @@ formed." (or (= dbus-message-type-method-return (nth 2 event)) (stringp (nth 8 event))) ;; Handler. - (functionp (nth 9 event)) + (or (functionp (nth 9 event)) + (and (consp (nth 9 event)) + (functionp (car (nth 9 event))) + (functionp (cdr (nth 9 event))))) ;; Arguments. (listp (nthcdr 10 event))) (signal 'dbus-error (list "Not a valid D-Bus event" event)))) @@ -1207,10 +1241,17 @@ If the HANDLER returns a `dbus-error', it is propagated as return message." (setq result (dbus-ignore-errors (apply (nth 9 event) args))) ;; Error messages must be propagated. The error name is in ;; the member slot. - (when (= dbus-message-type-error (nth 2 event)) - (signal 'dbus-error (cons (nth 8 event) args))) - ;; Apply the handler. - (setq result (apply (nth 9 event) args)) + (let* ((handler (nth 9 event)) + (error-handler (if (functionp handler) #'signal + (prog1 (cdr handler) + (setq handler (car handler)))))) + (setq result + (if (= dbus-message-type-error (nth 2 event)) + (funcall + error-handler + (cons 'dbus-error (cons (nth 8 event) args))) + ;; Apply the handler. + (apply handler args)))) ;; Return an (error) message when it is a message call. (when (= dbus-message-type-method-call (nth 2 event)) (dbus-ignore-errors diff --git a/src/dbusbind.c b/src/dbusbind.c index 95fedeb166b..7039eac3dbe 100644 --- a/src/dbusbind.c +++ b/src/dbusbind.c @@ -1411,7 +1411,11 @@ usage: (dbus-message-internal &rest REST) */) XD_DBUS_VALIDATE_PATH (path); XD_DBUS_VALIDATE_INTERFACE (interface); XD_DBUS_VALIDATE_MEMBER (member); - if (!NILP (handler) && !FUNCTIONP (handler)) + if (!NILP (handler) + && !(FUNCTIONP (handler) + || (CONSP (handler) + && FUNCTIONP (CAR_SAFE (handler)) + && FUNCTIONP (CDR_SAFE (handler))))) wrong_type_argument (Qinvalid_function, handler); } @@ -1562,6 +1566,12 @@ usage: (dbus-message-internal &rest REST) */) if (mtype != DBUS_MESSAGE_TYPE_METHOD_CALL) XD_SIGNAL1 (build_string (":keep-fd is only supported on method calls")); + /* This is because the error handler and the keepfd path use + the same slot in Vdbus_registered_objects_table. */ + if (CONSP (handler)) + XD_SIGNAL1 + (build_string + (":keep-fd cannot be used when there is an error handler")); /* Ignore this keyword if unsupported. */ #ifdef DBUS_TYPE_UNIX_FD @@ -1842,9 +1852,6 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus) /* Remove the entry. */ Fremhash (key, Vdbus_registered_objects_table); - /* Store the event. */ - 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) @@ -1857,8 +1864,12 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus) Fcons (Fcons (CAR_SAFE (CDR_SAFE (CAR_SAFE (args))), CDR_SAFE (value)), xd_registered_fds); + value = CAR_SAFE (value); } #endif + + /* Store the event. */ + xd_store_event (value, args, event_args); } else /* DBUS_MESSAGE_TYPE_METHOD_CALL, DBUS_MESSAGE_TYPE_SIGNAL. */ @@ -2141,8 +2152,9 @@ 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'. +`:monitor'), or a list (ACCESS EMITS-SIGNAL VALUE) for TYPE `:property'. +For type `:message', the handler slot can also be a cons cell (HANDLER +. ERROR-HANDLER) or (HANDLER . KEEP-FD-PATH). For entries of type `:signal' or `:monitor', there is also a fifth element RULE, which keeps the match string the signal or monitor is diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el index 3d0ab522d3f..c8ff2941f3c 100644 --- a/test/lisp/net/dbus-tests.el +++ b/test/lisp/net/dbus-tests.el @@ -842,6 +842,73 @@ Returns the respective error." dbus--test-interface "Foo" :authorizable t "foo") :type 'dbus-error))) +(defvar dbus--test-method-another-handler nil) +(defun dbus--test-method-another-handler (&rest args) + "Method handler for `dbus-test04-call-method-error-handler'." + (should args) + (setq dbus--test-method-another-handler t)) + +(defvar dbus--test-method-error-handler nil) +(defun dbus--test-method-error-handler (&rest args) + "Error handler for `dbus-test04-call-method-error-handler'." + (should (eq 'dbus-error (caar args))) + (setq dbus--test-method-error-handler t)) + +(ert-deftest dbus-test04-call-method-error-handler () + "Verify `dbus-call-method-asynchronously' error handler." + :tags '(:expensive-test) + (skip-unless dbus--test-enabled-session-bus) + (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service)) + (dbus-register-service :session dbus--test-service) + + (unwind-protect + (let ((method "Method") + (method-handler #'dbus--test-method-handler) + (handler #'dbus--test-method-another-handler) + (error-handler #'dbus--test-method-error-handler) + ;dbus-debug ; There would be errors otherwise. + registered) + + ;; Register. + (should + (equal + (setq + registered + (dbus-register-method + :session dbus--test-service dbus--test-path + dbus--test-interface method method-handler)) + `((:method :session ,dbus--test-interface ,method) + (,dbus--test-service ,dbus--test-path ,method-handler)))) + + ;; Call HANDLER. + (setq dbus--test-method-another-handler nil) + (dbus-call-method-asynchronously + :session dbus--test-service dbus--test-path + dbus--test-interface method `(,handler . ,error-handler) "foo") + (with-timeout (1 (dbus--test-timeout-handler)) + (while (not dbus--test-method-another-handler) + (read-event nil nil 0.1))) + (should dbus--test-method-another-handler) + + ;; Call ERROR-HANDLER. + (setq dbus--test-method-error-handler nil) + (dbus-call-method-asynchronously + :session dbus--test-service dbus--test-path + dbus--test-interface method `(,handler . ,error-handler) + "foo" "foo" "foo") + (with-timeout (1 (dbus--test-timeout-handler)) + (while (not dbus--test-method-error-handler) + (read-event nil nil 0.1))) + (should dbus--test-method-error-handler) + + ;; Unregister method. + (should (dbus-unregister-object registered)) + (should-not (dbus-unregister-object registered))) + + ;; Cleanup. + (ignore-errors (kill-buffer "*Warnings*")) + (dbus-unregister-service :session dbus--test-service))) + (defvar dbus--test-event-expected nil "The expected event in `dbus--test-signal-handler'.") @@ -2416,7 +2483,15 @@ The argument EXPECTED-ARGS is a list of expected arguments for the method." ;; Closing them again is a noop. (should-not (dbus--fd-close lock1)) - (should-not (dbus--fd-close lock2)))) + (should-not (dbus--fd-close lock2)) + + ;; `:keep-fd' cannot be used together with an error handler. + (should-error + (dbus-call-method-asynchronously + :system dbus--test-systemd-service dbus--test-systemd-path + dbus--test-systemd-manager-interface "Inhibit" + '(ignore . ignore) :keep-fd what who why mode) + :type 'dbus-error))) (ert-deftest dbus-test10-open-close-fd () "Check D-Bus open/close a file descriptor." |