Commit 48198420 authored by Daniel Colascione's avatar Daniel Colascione
Browse files

Improve dbus error handling; detect bus failure

parents e48983a6 146a4cf2
2014-02-21 Daniel Colascione <dancol@dancol.org>
* net/dbus.el (dbus-init-bus-1): Declare new subr.
(dbus-init-bus): New function: call into dbus-init-bus-1
and installs a handler for the disconnect signal.
(dbus-call-method): Rewrite to look for result in cons.
(dbus-call-method-handler): Store result in cons.
(dbus-check-event): Recognize events with nil sender as valid.
(dbus-handle-bus-disconnect): New function. React to bus
disconnection signal by synthesizing dbus error for each
pending synchronous or asynchronous call.
(dbus-notice-synchronous-call-errors): New function.
(dbus-handle-event): Raise errors directly only when `dbus-debug'
is true, not all the time.
2014-02-21 Juanma Barranquero <lekktu@gmail.com> 2014-02-21 Juanma Barranquero <lekktu@gmail.com>
* w32-fns.el (w32-enable-italics, w32-charset-to-codepage-alist): * w32-fns.el (w32-enable-italics, w32-charset-to-codepage-alist):
......
...@@ -35,7 +35,7 @@ ...@@ -35,7 +35,7 @@
;; Declare used subroutines and variables. ;; Declare used subroutines and variables.
(declare-function dbus-message-internal "dbusbind.c") (declare-function dbus-message-internal "dbusbind.c")
(declare-function dbus-init-bus "dbusbind.c") (declare-function dbus-init-bus-1 "dbusbind.c")
(defvar dbus-message-type-invalid) (defvar dbus-message-type-invalid)
(defvar dbus-message-type-method-call) (defvar dbus-message-type-method-call)
(defvar dbus-message-type-method-return) (defvar dbus-message-type-method-return)
...@@ -154,7 +154,7 @@ Otherwise, return result of last form in BODY, or all other errors." ...@@ -154,7 +154,7 @@ Otherwise, return result of last form in BODY, or all other errors."
(define-obsolete-variable-alias 'dbus-event-error-hooks (define-obsolete-variable-alias 'dbus-event-error-hooks
'dbus-event-error-functions "24.3") 'dbus-event-error-functions "24.3")
(defvar dbus-event-error-functions nil (defvar dbus-event-error-functions '(dbus-notice-synchronous-call-errors)
"Functions to be called when a D-Bus error happens in the event handler. "Functions to be called when a D-Bus error happens in the event handler.
Every function must accept two arguments, the event and the error variable Every function must accept two arguments, the event and the error variable
caught in `condition-case' by `dbus-error'.") caught in `condition-case' by `dbus-error'.")
...@@ -173,11 +173,23 @@ SERIAL is the serial number of the reply message.") ...@@ -173,11 +173,23 @@ SERIAL is the serial number of the reply message.")
"Handler for reply messages of asynchronous D-Bus message calls. "Handler for reply messages of asynchronous D-Bus message calls.
It calls the function stored in `dbus-registered-objects-table'. It calls the function stored in `dbus-registered-objects-table'.
The result will be made available in `dbus-return-values-table'." The result will be made available in `dbus-return-values-table'."
(puthash (list :serial (let* ((key (list :serial
(dbus-event-bus-name last-input-event) (dbus-event-bus-name last-input-event)
(dbus-event-serial-number last-input-event)) (dbus-event-serial-number last-input-event)))
(if (= (length args) 1) (car args) args) (result (gethash key dbus-return-values-table)))
dbus-return-values-table)) (when (consp result)
(setcar result :complete)
(setcdr result (if (= (length args) 1) (car args) args)))))
(defun dbus-notice-synchronous-call-errors (ev er)
"Detect errors resulting from pending synchronous calls."
(let* ((key (list :serial
(dbus-event-bus-name ev)
(dbus-event-serial-number ev)))
(result (gethash key dbus-return-values-table)))
(when (consp result)
(setcar result :error)
(setcdr result er))))
(defun dbus-call-method (bus service path interface method &rest args) (defun dbus-call-method (bus service path interface method &rest args)
"Call METHOD on the D-Bus BUS. "Call METHOD on the D-Bus BUS.
...@@ -264,7 +276,8 @@ object is returned instead of a list containing this single Lisp object. ...@@ -264,7 +276,8 @@ object is returned instead of a list containing this single Lisp object.
(key (key
(apply (apply
'dbus-message-internal dbus-message-type-method-call 'dbus-message-internal dbus-message-type-method-call
bus service path interface method 'dbus-call-method-handler args))) bus service path interface method 'dbus-call-method-handler args))
(result (cons :pending nil)))
;; Wait until `dbus-call-method-handler' has put the result into ;; Wait until `dbus-call-method-handler' has put the result into
;; `dbus-return-values-table'. If no timeout is given, use the ;; `dbus-return-values-table'. If no timeout is given, use the
...@@ -278,20 +291,23 @@ object is returned instead of a list containing this single Lisp object. ...@@ -278,20 +291,23 @@ object is returned instead of a list containing this single Lisp object.
;; restructuring dbus as a kind of process object. Poll at most ;; restructuring dbus as a kind of process object. Poll at most
;; about once per second for completion. ;; about once per second for completion.
(with-timeout ((if timeout (/ timeout 1000.0) 25)) (puthash key result dbus-return-values-table)
(while (eq (gethash key dbus-return-values-table :ignore) :ignore) (unwind-protect
(let ((event (let ((inhibit-redisplay t) unread-command-events) (progn
(read-event nil nil check-interval)))) (with-timeout ((if timeout (/ timeout 1000.0) 25)
(when event (signal 'dbus-error (list "call timed out")))
(setf unread-command-events (while (eq (car result) :pending)
(nconc unread-command-events (let ((event (let ((inhibit-redisplay t) unread-command-events)
(cons event nil)))) (read-event nil nil check-interval))))
(when (< check-interval 1) (when event
(setf check-interval (* check-interval 1.05)))))) (setf unread-command-events
(nconc unread-command-events
;; Cleanup `dbus-return-values-table'. Return the result. (cons event nil))))
(prog1 (when (< check-interval 1)
(gethash key dbus-return-values-table) (setf check-interval (* check-interval 1.05))))))
(when (eq (car result) :error)
(signal (cadr result) (cddr result)))
(cdr result))
(remhash key dbus-return-values-table)))) (remhash key dbus-return-values-table))))
;; `dbus-call-method' works non-blocking now. ;; `dbus-call-method' works non-blocking now.
...@@ -922,7 +938,8 @@ not well formed." ...@@ -922,7 +938,8 @@ not well formed."
;; Service. ;; Service.
(or (= dbus-message-type-method-return (nth 2 event)) (or (= dbus-message-type-method-return (nth 2 event))
(= dbus-message-type-error (nth 2 event)) (= dbus-message-type-error (nth 2 event))
(stringp (nth 4 event))) (or (stringp (nth 4 event))
(null (nth 4 event))))
;; Object path. ;; Object path.
(or (= dbus-message-type-method-return (nth 2 event)) (or (= dbus-message-type-method-return (nth 2 event))
(= dbus-message-type-error (nth 2 event)) (= dbus-message-type-error (nth 2 event))
...@@ -973,7 +990,7 @@ If the HANDLER returns a `dbus-error', it is propagated as return message." ...@@ -973,7 +990,7 @@ If the HANDLER returns a `dbus-error', it is propagated as return message."
(nth 1 event) (nth 4 event) (nth 3 event) (cadr err)))) (nth 1 event) (nth 4 event) (nth 3 event) (cadr err))))
;; Propagate D-Bus error messages. ;; Propagate D-Bus error messages.
(run-hook-with-args 'dbus-event-error-functions event err) (run-hook-with-args 'dbus-event-error-functions event err)
(when (or dbus-debug (= dbus-message-type-error (nth 2 event))) (when dbus-debug
(signal (car err) (cdr err)))))) (signal (car err) (cdr err))))))
(defun dbus-event-bus-name (event) (defun dbus-event-bus-name (event)
...@@ -1679,6 +1696,64 @@ It will be registered for all objects created by `dbus-register-method'." ...@@ -1679,6 +1696,64 @@ It will be registered for all objects created by `dbus-register-method'."
result) result)
'(:signature "{oa{sa{sv}}}")))))) '(:signature "{oa{sa{sv}}}"))))))
(defun dbus-handle-bus-disconnect ()
"React to a bus disconnection.
BUS is the bus that disconnected. This routine unregisters all
handlers on the given bus and causes all synchronous calls
pending at the time of disconnect to fail."
(let ((bus (dbus-event-bus-name last-input-event))
(keys-to-remove))
(maphash
(lambda (key value)
(when (and (eq (nth 0 key) :serial)
(eq (nth 1 key) bus))
(run-hook-with-args
'dbus-event-error-functions
(list 'dbus-event
bus
dbus-message-type-error
(nth 2 key)
nil
nil
nil
nil
value)
'(dbus-error "Bus disconnected"))
(push key keys-to-remove)))
dbus-registered-objects-table)
(dolist (key keys-to-remove)
(remhash key dbus-registered-objects-table))))
(defun dbus-init-bus (bus &optional private)
"Establish the connection to D-Bus BUS.
BUS can be either the symbol `:system' or the symbol `:session', or it
can be a string denoting the address of the corresponding bus. For
the system and session buses, this function is called when loading
`dbus.el', there is no need to call it again.
The function returns a number, which counts the connections this Emacs
session has established to the BUS under the same unique name (see
`dbus-get-unique-name'). It depends on the libraries Emacs is linked
with, and on the environment Emacs is running. For example, if Emacs
is linked with the gtk toolkit, and it runs in a GTK-aware environment
like Gnome, another connection might already be established.
When PRIVATE is non-nil, a new connection is established instead of
reusing an existing one. It results in a new unique name at the bus.
This can be used, if it is necessary to distinguish from another
connection used in the same Emacs process, like the one established by
GTK+. It should be used with care for at least the `:system' and
`:session' buses, because other Emacs Lisp packages might already use
this connection to those buses.
"
(dbus-init-bus-1 bus private)
(dbus-register-signal bus nil
"/org/freedesktop/DBus/Local"
"org.freedesktop.DBus.Local"
"Disconnected"
#'dbus-handle-bus-disconnect))
;; Initialize `:system' and `:session' buses. This adds their file ;; Initialize `:system' and `:session' buses. This adds their file
;; descriptors to input_wait_mask, in order to detect incoming ;; descriptors to input_wait_mask, in order to detect incoming
......
2014-02-21 Daniel Colascione <dancol@dancol.org>
* dbusbind.c: Rename dbus-init-bus to dbus-init-bus-1.
2014-02-20 Eli Zaretskii <eliz@gnu.org> 2014-02-20 Eli Zaretskii <eliz@gnu.org>
* xdisp.c (init_iterator): Don't dereference a bogus face * xdisp.c (init_iterator): Don't dereference a bogus face
......
...@@ -42,7 +42,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ ...@@ -42,7 +42,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Subroutines. */ /* Subroutines. */
static Lisp_Object Qdbus_init_bus; static Lisp_Object Qdbus_init_bus_1;
static Lisp_Object Qdbus_get_unique_name; static Lisp_Object Qdbus_get_unique_name;
static Lisp_Object Qdbus_message_internal; static Lisp_Object Qdbus_message_internal;
...@@ -1121,9 +1121,12 @@ xd_close_bus (Lisp_Object bus) ...@@ -1121,9 +1121,12 @@ xd_close_bus (Lisp_Object bus)
return; return;
} }
DEFUN ("dbus-init-bus", Fdbus_init_bus, Sdbus_init_bus, 1, 2, 0, DEFUN ("dbus-init-bus-1", Fdbus_init_bus_1, Sdbus_init_bus_1, 1, 2, 0,
doc: /* Establish the connection to D-Bus BUS. doc: /* Establish the connection to D-Bus BUS.
This function is dbus-internal. You almost certainly want to use
dbus-init-bus.
BUS can be either the symbol `:system' or the symbol `:session', or it BUS can be either the symbol `:system' or the symbol `:session', or it
can be a string denoting the address of the corresponding bus. For can be a string denoting the address of the corresponding bus. For
the system and session buses, this function is called when loading the system and session buses, this function is called when loading
...@@ -1742,8 +1745,8 @@ void ...@@ -1742,8 +1745,8 @@ void
syms_of_dbusbind (void) syms_of_dbusbind (void)
{ {
DEFSYM (Qdbus_init_bus, "dbus-init-bus"); DEFSYM (Qdbus_init_bus_1, "dbus-init-bus-1");
defsubr (&Sdbus_init_bus); defsubr (&Sdbus_init_bus_1);
DEFSYM (Qdbus_get_unique_name, "dbus-get-unique-name"); DEFSYM (Qdbus_get_unique_name, "dbus-get-unique-name");
defsubr (&Sdbus_get_unique_name); defsubr (&Sdbus_get_unique_name);
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment