Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
7
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
emacs
emacs
Commits
48198420
Commit
48198420
authored
Feb 20, 2014
by
Daniel Colascione
Browse files
Options
Browse Files
Download
Plain Diff
Improve dbus error handling; detect bus failure
parents
e48983a6
146a4cf2
Changes
4
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
125 additions
and
28 deletions
+125
-28
lisp/ChangeLog
lisp/ChangeLog
+15
-0
lisp/net/dbus.el
lisp/net/dbus.el
+99
-24
src/ChangeLog
src/ChangeLog
+4
-0
src/dbusbind.c
src/dbusbind.c
+7
-4
No files found.
lisp/ChangeLog
View file @
48198420
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>
* w32-fns.el (w32-enable-italics, w32-charset-to-codepage-alist):
...
...
lisp/net/dbus.el
View file @
48198420
...
...
@@ -35,7 +35,7 @@
;; Declare used subroutines and variables.
(
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-method-call
)
(
defvar
dbus-message-type-method-return
)
...
...
@@ -154,7 +154,7 @@ Otherwise, return result of last form in BODY, or all other errors."
(
define-obsolete-variable-alias
'dbus-event-error-hooks
'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.
Every function must accept two arguments, the event and the error variable
caught in `condition-case' by `dbus-error'."
)
...
...
@@ -173,11 +173,23 @@ SERIAL is the serial number of the reply message.")
"Handler for reply messages of asynchronous D-Bus message calls.
It calls the function stored in `dbus-registered-objects-table'.
The result will be made available in `dbus-return-values-table'."
(
puthash
(
list
:serial
(
dbus-event-bus-name
last-input-event
)
(
dbus-event-serial-number
last-input-event
))
(
if
(
=
(
length
args
)
1
)
(
car
args
)
args
)
dbus-return-values-table
))
(
let*
((
key
(
list
:serial
(
dbus-event-bus-name
last-input-event
)
(
dbus-event-serial-number
last-input-event
)))
(
result
(
gethash
key
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
)
"Call METHOD on the D-Bus BUS.
...
...
@@ -264,7 +276,8 @@ object is returned instead of a list containing this single Lisp object.
(
key
(
apply
'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
;; `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.
;; restructuring dbus as a kind of process object. Poll at most
;; about once per second for completion.
(
with-timeout
((
if
timeout
(
/
timeout
1000.0
)
25
))
(
while
(
eq
(
gethash
key
dbus-return-values-table
:ignore
)
:ignore
)
(
let
((
event
(
let
((
inhibit-redisplay
t
)
unread-command-events
)
(
read-event
nil
nil
check-interval
))))
(
when
event
(
setf
unread-command-events
(
nconc
unread-command-events
(
cons
event
nil
))))
(
when
(
<
check-interval
1
)
(
setf
check-interval
(
*
check-interval
1.05
))))))
;; Cleanup `dbus-return-values-table'. Return the result.
(
prog1
(
gethash
key
dbus-return-values-table
)
(
puthash
key
result
dbus-return-values-table
)
(
unwind-protect
(
progn
(
with-timeout
((
if
timeout
(
/
timeout
1000.0
)
25
)
(
signal
'dbus-error
(
list
"call timed out"
)))
(
while
(
eq
(
car
result
)
:pending
)
(
let
((
event
(
let
((
inhibit-redisplay
t
)
unread-command-events
)
(
read-event
nil
nil
check-interval
))))
(
when
event
(
setf
unread-command-events
(
nconc
unread-command-events
(
cons
event
nil
))))
(
when
(
<
check-interval
1
)
(
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
))))
;; `dbus-call-method' works non-blocking now.
...
...
@@ -922,7 +938,8 @@ not well formed."
;; Service.
(
or
(
=
dbus-message-type-method-return
(
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.
(
or
(
=
dbus-message-type-method-return
(
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."
(
nth
1
event
)
(
nth
4
event
)
(
nth
3
event
)
(
cadr
err
))))
;; Propagate D-Bus error messages.
(
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
))))))
(
defun
dbus-event-bus-name
(
event
)
...
...
@@ -1679,6 +1696,64 @@ It will be registered for all objects created by `dbus-register-method'."
result
)
'
(
: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
;; descriptors to input_wait_mask, in order to detect incoming
...
...
src/ChangeLog
View file @
48198420
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>
* xdisp.c (init_iterator): Don't dereference a bogus face
...
...
src/dbusbind.c
View file @
48198420
...
...
@@ -42,7 +42,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* 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_message_internal
;
...
...
@@ -1121,9 +1121,12 @@ xd_close_bus (Lisp_Object bus)
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.
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
can be a string denoting the address of the corresponding bus. For
the system and session buses, this function is called when loading
...
...
@@ -1742,8 +1745,8 @@ void
syms_of_dbusbind
(
void
)
{
DEFSYM
(
Qdbus_init_bus
,
"dbus-init-bus"
);
defsubr
(
&
Sdbus_init_bus
);
DEFSYM
(
Qdbus_init_bus
_1
,
"dbus-init-bus
-1
"
);
defsubr
(
&
Sdbus_init_bus
_1
);
DEFSYM
(
Qdbus_get_unique_name
,
"dbus-get-unique-name"
);
defsubr
(
&
Sdbus_get_unique_name
);
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment