1 ;;; dbus.el --- Elisp bindings for D-Bus.
3 ;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
5 ;; Author: Michael Albinus <michael.albinus@gmx.de>
6 ;; Keywords: comm, hardware
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software: you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
25 ;; This package provides language bindings for the D-Bus API. D-Bus
26 ;; is a message bus system, a simple way for applications to talk to
27 ;; one another. See <http://dbus.freedesktop.org/> for details.
29 ;; Low-level language bindings are implemented in src/dbusbind.c.
31 ;; D-Bus support in the Emacs core can be disabled with configuration
32 ;; option "--without-dbus".
36 ;; Declare used subroutines and variables.
37 (declare-function dbus-message-internal
"dbusbind.c")
38 (declare-function dbus-init-bus
"dbusbind.c")
39 (defvar dbus-message-type-invalid
)
40 (defvar dbus-message-type-method-call
)
41 (defvar dbus-message-type-method-return
)
42 (defvar dbus-message-type-error
)
43 (defvar dbus-message-type-signal
)
45 (defvar dbus-registered-objects-table
)
47 ;; Pacify byte compiler.
48 (eval-when-compile (require 'cl-lib
))
52 (defconst dbus-service-dbus
"org.freedesktop.DBus"
53 "The bus name used to talk to the bus itself.")
55 (defconst dbus-path-dbus
"/org/freedesktop/DBus"
56 "The object path used to talk to the bus itself.")
58 ;; Default D-Bus interfaces.
60 (defconst dbus-interface-dbus
"org.freedesktop.DBus"
61 "The interface exported by the service `dbus-service-dbus'.")
63 (defconst dbus-interface-peer
(concat dbus-interface-dbus
".Peer")
64 "The interface for peer objects.
65 See URL `http://dbus.freedesktop.org/doc/dbus-specification.html#standard-interfaces-peer'.")
67 ;; <interface name="org.freedesktop.DBus.Peer">
68 ;; <method name="Ping">
70 ;; <method name="GetMachineId">
71 ;; <arg name="machine_uuid" type="s" direction="out"/>
75 (defconst dbus-interface-introspectable
76 (concat dbus-interface-dbus
".Introspectable")
77 "The interface supported by introspectable objects.
78 See URL `http://dbus.freedesktop.org/doc/dbus-specification.html#standard-interfaces-introspectable'.")
80 ;; <interface name="org.freedesktop.DBus.Introspectable">
81 ;; <method name="Introspect">
82 ;; <arg name="data" type="s" direction="out"/>
86 (defconst dbus-interface-properties
(concat dbus-interface-dbus
".Properties")
87 "The interface for property objects.
88 See URL `http://dbus.freedesktop.org/doc/dbus-specification.html#standard-interfaces-properties'.")
90 ;; <interface name="org.freedesktop.DBus.Properties">
91 ;; <method name="Get">
92 ;; <arg name="interface" type="s" direction="in"/>
93 ;; <arg name="propname" type="s" direction="in"/>
94 ;; <arg name="value" type="v" direction="out"/>
96 ;; <method name="Set">
97 ;; <arg name="interface" type="s" direction="in"/>
98 ;; <arg name="propname" type="s" direction="in"/>
99 ;; <arg name="value" type="v" direction="in"/>
101 ;; <method name="GetAll">
102 ;; <arg name="interface" type="s" direction="in"/>
103 ;; <arg name="props" type="a{sv}" direction="out"/>
105 ;; <signal name="PropertiesChanged">
106 ;; <arg name="interface" type="s"/>
107 ;; <arg name="changed_properties" type="a{sv}"/>
108 ;; <arg name="invalidated_properties" type="as"/>
112 (defconst dbus-interface-objectmanager
113 (concat dbus-interface-dbus
".ObjectManager")
114 "The object manager interface.
115 See URL `http://dbus.freedesktop.org/doc/dbus-specification.html#standard-interfaces-objectmanager'.")
117 ;; <interface name="org.freedesktop.DBus.ObjectManager">
118 ;; <method name="GetManagedObjects">
119 ;; <arg name="object_paths_interfaces_and_properties"
120 ;; type="a{oa{sa{sv}}}" direction="out"/>
122 ;; <signal name="InterfacesAdded">
123 ;; <arg name="object_path" type="o"/>
124 ;; <arg name="interfaces_and_properties" type="a{sa{sv}}"/>
126 ;; <signal name="InterfacesRemoved">
127 ;; <arg name="object_path" type="o"/>
128 ;; <arg name="interfaces" type="as"/>
133 (defconst dbus-service-emacs
"org.gnu.Emacs"
134 "The well known service name of Emacs.")
136 (defconst dbus-path-emacs
"/org/gnu/Emacs"
137 "The object path namespace used by Emacs.
138 All object paths provided by the service `dbus-service-emacs'
139 shall be subdirectories of this path.")
141 (defconst dbus-interface-emacs
"org.gnu.Emacs"
142 "The interface namespace used by Emacs.")
146 (defmacro dbus-ignore-errors
(&rest body
)
147 "Execute BODY; signal D-Bus error when `dbus-debug' is non-nil.
148 Otherwise, return result of last form in BODY, or all other errors."
149 (declare (indent 0) (debug t
))
152 (dbus-error (when dbus-debug
(signal (car err
) (cdr err
))))))
153 (font-lock-add-keywords 'emacs-lisp-mode
'("\\<dbus-ignore-errors\\>"))
155 (defvar dbus-event-error-hooks nil
156 "Functions to be called when a D-Bus error happens in the event handler.
157 Every function must accept two arguments, the event and the error variable
158 caught in `condition-case' by `dbus-error'.")
161 ;;; Basic D-Bus message functions.
163 (defvar dbus-return-values-table
(make-hash-table :test
'equal
)
164 "Hash table for temporary storing arguments of reply messages.
165 A key in this hash table is a list (:serial BUS SERIAL), like in
166 `dbus-registered-objects-table'. BUS is either a Lisp symbol,
167 `:system' or `:session', or a string denoting the bus address.
168 SERIAL is the serial number of the reply message.")
170 (defun dbus-call-method-handler (&rest args
)
171 "Handler for reply messages of asynchronous D-Bus message calls.
172 It calls the function stored in `dbus-registered-objects-table'.
173 The result will be made available in `dbus-return-values-table'."
174 (puthash (list :serial
175 (dbus-event-bus-name last-input-event
)
176 (dbus-event-serial-number last-input-event
))
177 (if (= (length args
) 1) (car args
) args
)
178 dbus-return-values-table
))
180 (defun dbus-call-method (bus service path interface method
&rest args
)
181 "Call METHOD on the D-Bus BUS.
183 BUS is either a Lisp symbol, `:system' or `:session', or a string
184 denoting the bus address.
186 SERVICE is the D-Bus service name to be used. PATH is the D-Bus
187 object path SERVICE is registered at. INTERFACE is an interface
188 offered by SERVICE. It must provide METHOD.
190 If the parameter `:timeout' is given, the following integer TIMEOUT
191 specifies the maximum number of milliseconds the method call must
192 return. The default value is 25,000. If the method call doesn't
193 return in time, a D-Bus error is raised.
195 All other arguments ARGS are passed to METHOD as arguments. They are
196 converted into D-Bus types via the following rules:
198 t and nil => DBUS_TYPE_BOOLEAN
199 number => DBUS_TYPE_UINT32
200 integer => DBUS_TYPE_INT32
201 float => DBUS_TYPE_DOUBLE
202 string => DBUS_TYPE_STRING
203 list => DBUS_TYPE_ARRAY
205 All arguments can be preceded by a type symbol. For details about
206 type symbols, see Info node `(dbus)Type Conversion'.
208 `dbus-call-method' returns the resulting values of METHOD as a list of
209 Lisp objects. The type conversion happens the other direction as for
210 input arguments. It follows the mapping rules:
212 DBUS_TYPE_BOOLEAN => t or nil
213 DBUS_TYPE_BYTE => number
214 DBUS_TYPE_UINT16 => number
215 DBUS_TYPE_INT16 => integer
216 DBUS_TYPE_UINT32 => number or float
217 DBUS_TYPE_UNIX_FD => number or float
218 DBUS_TYPE_INT32 => integer or float
219 DBUS_TYPE_UINT64 => number or float
220 DBUS_TYPE_INT64 => integer or float
221 DBUS_TYPE_DOUBLE => float
222 DBUS_TYPE_STRING => string
223 DBUS_TYPE_OBJECT_PATH => string
224 DBUS_TYPE_SIGNATURE => string
225 DBUS_TYPE_ARRAY => list
226 DBUS_TYPE_VARIANT => list
227 DBUS_TYPE_STRUCT => list
228 DBUS_TYPE_DICT_ENTRY => list
233 :session \"org.gnome.seahorse\" \"/org/gnome/seahorse/keys/openpgp\"
234 \"org.gnome.seahorse.Keys\" \"GetKeyField\"
235 \"openpgp:657984B8C7A966DD\" \"simple-name\")
237 => (t (\"Philip R. Zimmermann\"))
239 If the result of the METHOD call is just one value, the converted Lisp
240 object is returned instead of a list containing this single Lisp object.
243 :system \"org.freedesktop.Hal\" \"/org/freedesktop/Hal/devices/computer\"
244 \"org.freedesktop.Hal.Device\" \"GetPropertyString\"
245 \"system.kernel.machine\")
249 (or (memq bus
'(:system
:session
)) (stringp bus
)
250 (signal 'wrong-type-argument
(list 'keywordp bus
)))
251 (or (stringp service
)
252 (signal 'wrong-type-argument
(list 'stringp service
)))
254 (signal 'wrong-type-argument
(list 'stringp path
)))
255 (or (stringp interface
)
256 (signal 'wrong-type-argument
(list 'stringp interface
)))
258 (signal 'wrong-type-argument
(list 'stringp method
)))
260 (let ((timeout (plist-get args
:timeout
))
263 'dbus-message-internal dbus-message-type-method-call
264 bus service path interface method
'dbus-call-method-handler args
)))
266 ;; Wait until `dbus-call-method-handler' has put the result into
267 ;; `dbus-return-values-table'. If no timeout is given, use the
268 ;; default 25". Events which are not from D-Bus must be restored.
269 (with-timeout ((if timeout
(/ timeout
1000.0) 25))
270 (while (eq (gethash key dbus-return-values-table
:ignore
) :ignore
)
271 (let ((event (let (unread-command-events) (read-event nil nil
0.1))))
272 (when (and event
(not (ignore-errors (dbus-check-event event
))))
273 (setq unread-command-events
274 (append unread-command-events
(list event
)))))))
276 ;; Cleanup `dbus-return-values-table'. Return the result.
278 (gethash key dbus-return-values-table
)
279 (remhash key dbus-return-values-table
))))
281 ;; `dbus-call-method' works non-blocking now.
282 (defalias 'dbus-call-method-non-blocking
'dbus-call-method
)
283 (make-obsolete 'dbus-call-method-non-blocking
'dbus-call-method
"24.2")
285 (defun dbus-call-method-asynchronously
286 (bus service path interface method handler
&rest args
)
287 "Call METHOD on the D-Bus BUS asynchronously.
289 BUS is either a Lisp symbol, `:system' or `:session', or a string
290 denoting the bus address.
292 SERVICE is the D-Bus service name to be used. PATH is the D-Bus
293 object path SERVICE is registered at. INTERFACE is an interface
294 offered by SERVICE. It must provide METHOD.
296 HANDLER is a Lisp function, which is called when the corresponding
297 return message has arrived. If HANDLER is nil, no return message
300 If the parameter `:timeout' is given, the following integer TIMEOUT
301 specifies the maximum number of milliseconds the method call must
302 return. The default value is 25,000. If the method call doesn't
303 return in time, a D-Bus error is raised.
305 All other arguments ARGS are passed to METHOD as arguments. They are
306 converted into D-Bus types via the following rules:
308 t and nil => DBUS_TYPE_BOOLEAN
309 number => DBUS_TYPE_UINT32
310 integer => DBUS_TYPE_INT32
311 float => DBUS_TYPE_DOUBLE
312 string => DBUS_TYPE_STRING
313 list => DBUS_TYPE_ARRAY
315 All arguments can be preceded by a type symbol. For details about
316 type symbols, see Info node `(dbus)Type Conversion'.
318 If HANDLER is a Lisp function, the function returns a key into the
319 hash table `dbus-registered-objects-table'. The corresponding entry
320 in the hash table is removed, when the return message has been arrived,
321 and HANDLER is called.
325 \(dbus-call-method-asynchronously
326 :system \"org.freedesktop.Hal\" \"/org/freedesktop/Hal/devices/computer\"
327 \"org.freedesktop.Hal.Device\" \"GetPropertyString\" 'message
328 \"system.kernel.machine\")
330 => \(:serial :system 2)
334 (or (memq bus
'(:system
:session
)) (stringp bus
)
335 (signal 'wrong-type-argument
(list 'keywordp bus
)))
336 (or (stringp service
)
337 (signal 'wrong-type-argument
(list 'stringp service
)))
339 (signal 'wrong-type-argument
(list 'stringp path
)))
340 (or (stringp interface
)
341 (signal 'wrong-type-argument
(list 'stringp interface
)))
343 (signal 'wrong-type-argument
(list 'stringp method
)))
344 (or (null handler
) (functionp handler
)
345 (signal 'wrong-type-argument
(list 'functionp handler
)))
347 (apply 'dbus-message-internal dbus-message-type-method-call
348 bus service path interface method handler args
))
350 (defun dbus-send-signal (bus service path interface signal
&rest args
)
351 "Send signal SIGNAL on the D-Bus BUS.
353 BUS is either a Lisp symbol, `:system' or `:session', or a string
354 denoting the bus address. The signal is sent from the D-Bus object
355 Emacs is registered at BUS.
357 SERVICE is the D-Bus name SIGNAL is sent to. It can be either a known
358 name or a unique name. If SERVICE is nil, the signal is sent as
359 broadcast message. PATH is the D-Bus object path SIGNAL is sent from.
360 INTERFACE is an interface available at PATH. It must provide signal
363 All other arguments ARGS are passed to SIGNAL as arguments. They are
364 converted into D-Bus types via the following rules:
366 t and nil => DBUS_TYPE_BOOLEAN
367 number => DBUS_TYPE_UINT32
368 integer => DBUS_TYPE_INT32
369 float => DBUS_TYPE_DOUBLE
370 string => DBUS_TYPE_STRING
371 list => DBUS_TYPE_ARRAY
373 All arguments can be preceded by a type symbol. For details about
374 type symbols, see Info node `(dbus)Type Conversion'.
379 :session nil \"/org/gnu/Emacs\" \"org.gnu.Emacs.FileManager\"
380 \"FileModified\" \"/home/albinus/.emacs\")"
382 (or (memq bus
'(:system
:session
)) (stringp bus
)
383 (signal 'wrong-type-argument
(list 'keywordp bus
)))
384 (or (null service
) (stringp service
)
385 (signal 'wrong-type-argument
(list 'stringp service
)))
387 (signal 'wrong-type-argument
(list 'stringp path
)))
388 (or (stringp interface
)
389 (signal 'wrong-type-argument
(list 'stringp interface
)))
391 (signal 'wrong-type-argument
(list 'stringp signal
)))
393 (apply 'dbus-message-internal dbus-message-type-signal
394 bus service path interface signal args
))
396 (defun dbus-method-return-internal (bus service serial
&rest args
)
397 "Return for message SERIAL on the D-Bus BUS.
398 This is an internal function, it shall not be used outside dbus.el."
400 (or (memq bus
'(:system
:session
)) (stringp bus
)
401 (signal 'wrong-type-argument
(list 'keywordp bus
)))
402 (or (stringp service
)
403 (signal 'wrong-type-argument
(list 'stringp service
)))
405 (signal 'wrong-type-argument
(list 'natnump serial
)))
407 (apply 'dbus-message-internal dbus-message-type-method-return
408 bus service serial args
))
410 (defun dbus-method-error-internal (bus service serial
&rest args
)
411 "Return error message for message SERIAL on the D-Bus BUS.
412 This is an internal function, it shall not be used outside dbus.el."
414 (or (memq bus
'(:system
:session
)) (stringp bus
)
415 (signal 'wrong-type-argument
(list 'keywordp bus
)))
416 (or (stringp service
)
417 (signal 'wrong-type-argument
(list 'stringp service
)))
419 (signal 'wrong-type-argument
(list 'natnump serial
)))
421 (apply 'dbus-message-internal dbus-message-type-error
422 bus service serial args
))
425 ;;; Hash table of registered functions.
427 (defun dbus-list-hash-table ()
428 "Returns all registered member registrations to D-Bus.
429 The return value is a list, with elements of kind (KEY . VALUE).
430 See `dbus-registered-objects-table' for a description of the
434 (lambda (key value
) (add-to-list 'result
(cons key value
) 'append
))
435 dbus-registered-objects-table
)
438 (defun dbus-setenv (bus variable value
)
439 "Set the value of the BUS environment variable named VARIABLE to VALUE.
441 BUS is either a Lisp symbol, `:system' or `:session', or a string
442 denoting the bus address. Both VARIABLE and VALUE should be strings.
444 Normally, services inherit the environment of the BUS daemon. This
445 function adds to or modifies that environment when activating services.
447 Some bus instances, such as `:system', may disable setting the environment."
449 bus dbus-service-dbus dbus-path-dbus
450 dbus-interface-dbus
"UpdateActivationEnvironment"
451 `(:array
(:dict-entry
,variable
,value
))))
453 (defun dbus-register-service (bus service
&rest flags
)
454 "Register known name SERVICE on the D-Bus BUS.
456 BUS is either a Lisp symbol, `:system' or `:session', or a string
457 denoting the bus address.
459 SERVICE is the D-Bus service name that should be registered. It must
462 FLAGS are keywords, which control how the service name is registered.
463 The following keywords are recognized:
465 `:allow-replacement': Allow another service to become the primary
468 `:replace-existing': Request to replace the current primary owner.
470 `:do-not-queue': If we can not become the primary owner do not place
473 The function returns a keyword, indicating the result of the
474 operation. One of the following keywords is returned:
476 `:primary-owner': Service has become the primary owner of the
479 `:in-queue': Service could not become the primary owner and has been
482 `:exists': Service is already in the queue.
484 `:already-owner': Service is already the primary owner."
486 ;; Add ObjectManager handler.
487 (dbus-register-method
488 bus service nil dbus-interface-objectmanager
"GetManagedObjects"
489 'dbus-managed-objects-handler
'dont-register
)
497 (:allow-replacement
1)
498 (:replace-existing
2)
500 (_ (signal 'wrong-type-argument
(list flag
)))))))
501 (setq reply
(dbus-call-method
502 bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
503 "RequestName" service arg
))
509 (_ (signal 'dbus-error
(list "Could not register service" service
))))))
511 (defun dbus-unregister-service (bus service
)
512 "Unregister all objects related to SERVICE from D-Bus BUS.
513 BUS is either a Lisp symbol, `:system' or `:session', or a string
514 denoting the bus address. SERVICE must be a known service name.
516 The function returns a keyword, indicating the result of the
517 operation. One of the following keywords is returned:
519 `:released': Service has become the primary owner of the name.
521 `:non-existent': Service name does not exist on this bus.
523 `:not-owner': We are neither the primary owner nor waiting in the
524 queue of this service."
530 (when (and (equal bus
(cadr key
)) (string-equal service
(cadr elt
)))
532 (puthash key
(delete elt value
) dbus-registered-objects-table
)
533 (remhash key dbus-registered-objects-table
))))))
534 dbus-registered-objects-table
)
535 (let ((reply (dbus-call-method
536 bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
537 "ReleaseName" service
)))
542 (_ (signal 'dbus-error
(list "Could not unregister service" service
))))))
544 (defun dbus-register-signal
545 (bus service path interface signal handler
&rest args
)
546 "Register for a signal on the D-Bus BUS.
548 BUS is either a Lisp symbol, `:system' or `:session', or a string
549 denoting the bus address.
551 SERVICE is the D-Bus service name used by the sending D-Bus object.
552 It can be either a known name or the unique name of the D-Bus object
555 PATH is the D-Bus object path SERVICE is registered. INTERFACE
556 is an interface offered by SERVICE. It must provide SIGNAL.
557 HANDLER is a Lisp function to be called when the signal is
558 received. It must accept as arguments the values SIGNAL is
561 SERVICE, PATH, INTERFACE and SIGNAL can be nil. This is
562 interpreted as a wildcard for the respective argument.
564 The remaining arguments ARGS can be keywords or keyword string pairs.
565 The meaning is as follows:
568 `:pathN' STRING: This stands for the Nth argument of the
569 signal. `:pathN' arguments can be used for object path wildcard
570 matches as specified by D-Bus, while an `:argN' argument
571 requires an exact match.
573 `:arg-namespace' STRING: Register for the signals, which first
574 argument defines the service or interface namespace STRING.
576 `:path-namespace' STRING: Register for the object path namespace
577 STRING. All signals sent from an object path, which has STRING as
578 the preceding string, are matched. This requires PATH to be nil.
580 `:eavesdrop': Register for unicast signals which are not directed
581 to the D-Bus object Emacs is registered at D-Bus BUS, if the
582 security policy of BUS allows this.
586 \(defun my-signal-handler (device)
587 (message \"Device %s added\" device))
589 \(dbus-register-signal
590 :system \"org.freedesktop.Hal\" \"/org/freedesktop/Hal/Manager\"
591 \"org.freedesktop.Hal.Manager\" \"DeviceAdded\" 'my-signal-handler)
593 => \(\(:signal :system \"org.freedesktop.Hal.Manager\" \"DeviceAdded\")
594 \(\"org.freedesktop.Hal\" \"/org/freedesktop/Hal/Manager\" my-signal-handler))
596 `dbus-register-signal' returns an object, which can be used in
597 `dbus-unregister-object' for removing the registration."
600 (rule "type='signal'")
601 uname key key1 value
)
603 ;; Retrieve unique name of service. If service is a known name,
604 ;; we will register for the corresponding unique name, if any.
605 ;; Signals are sent always with the unique name as sender. Note:
606 ;; the unique name of `dbus-service-dbus' is that string itself.
607 (if (and (stringp service
)
608 (not (zerop (length service
)))
609 (not (string-equal service dbus-service-dbus
))
610 (not (string-match "^:" service
)))
611 (setq uname
(dbus-get-name-owner bus service
))
612 (setq uname service
))
614 (setq rule
(concat rule
615 (when uname
(format ",sender='%s'" uname
))
616 (when interface
(format ",interface='%s'" interface
))
617 (when signal
(format ",member='%s'" signal
))
618 (when path
(format ",path='%s'" path
))))
620 ;; Add arguments to the rule.
621 (if (or (stringp (car args
)) (null (car args
)))
622 ;; As backward compatibility option, we allow just strings.
625 (setq rule
(concat rule
(format ",arg%d='%s'" counter arg
)))
626 (if arg
(signal 'wrong-type-argument
(list "Wrong argument" arg
))))
627 (setq counter
(1+ counter
)))
636 ;; `:arg0' .. `:arg63', `:path0' .. `:path63'.
639 "^:\\(arg\\|path\\)\\([[:digit:]]+\\)$"
641 (setq counter
(match-string 2 (symbol-name key
))
644 (unless (and (<= counter
63) (stringp value
))
645 (signal 'wrong-type-argument
646 (list "Wrong argument" key value
)))
650 (if (string-equal (match-string 1 (symbol-name key
)) "path")
653 ;; `:arg-namespace', `:path-namespace'.
656 "^:\\(arg\\|path\\)-namespace$" (symbol-name key
)))
657 (setq args
(cdr args
)
659 (unless (stringp value
)
660 (signal 'wrong-type-argument
661 (list "Wrong argument" key value
)))
664 (if (string-equal (match-string 1 (symbol-name key
)) "path")
665 "path_namespace" "arg0namespace")
670 (t (signal 'wrong-type-argument
(list "Wrong argument" key
)))))
673 ;; Add the rule to the bus.
676 bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
679 (if (not (string-match "eavesdrop" rule
))
680 (signal (car err
) (cdr err
))
681 ;; The D-Bus spec says we shall fall back to a rule without eavesdrop.
682 (when dbus-debug
(message "Removing eavesdrop from rule %s" rule
))
683 (setq rule
(replace-regexp-in-string ",eavesdrop='true'" "" rule
))
685 bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
688 (when dbus-debug
(message "Matching rule \"%s\" created" rule
))
690 ;; Create a hash table entry.
691 (setq key
(list :signal bus interface signal
)
692 key1
(list uname service path handler rule
)
693 value
(gethash key dbus-registered-objects-table
))
694 (unless (member key1 value
)
695 (puthash key
(cons key1 value
) dbus-registered-objects-table
))
697 ;; Return the object.
698 (list key
(list service path handler
))))
700 (defun dbus-register-method
701 (bus service path interface method handler
&optional dont-register-service
)
702 "Register for method METHOD on the D-Bus BUS.
704 BUS is either a Lisp symbol, `:system' or `:session', or a string
705 denoting the bus address.
707 SERVICE is the D-Bus service name of the D-Bus object METHOD is
708 registered for. It must be a known name (See discussion of
709 DONT-REGISTER-SERVICE below).
711 PATH is the D-Bus object path SERVICE is registered (See discussion of
712 DONT-REGISTER-SERVICE below). INTERFACE is the interface offered by
713 SERVICE. It must provide METHOD.
715 HANDLER is a Lisp function to be called when a method call is
716 received. It must accept the input arguments of METHOD. The return
717 value of HANDLER is used for composing the returning D-Bus message.
718 In case HANDLER shall return a reply message with an empty argument
719 list, HANDLER must return the symbol `:ignore'.
721 When DONT-REGISTER-SERVICE is non-nil, the known name SERVICE is not
722 registered. This means that other D-Bus clients have no way of
723 noticing the newly registered method. When interfaces are constructed
724 incrementally by adding single methods or properties at a time,
725 DONT-REGISTER-SERVICE can be used to prevent other clients from
726 discovering the still incomplete interface."
729 (unless (or dont-register-service
730 (member service
(dbus-list-names bus
)))
731 (dbus-register-service bus service
))
733 ;; Create a hash table entry. We use nil for the unique name,
734 ;; because the method might be called from anybody.
735 (let* ((key (list :method bus interface method
))
736 (key1 (list nil service path handler
))
737 (value (gethash key dbus-registered-objects-table
)))
739 (unless (member key1 value
)
740 (puthash key
(cons key1 value
) dbus-registered-objects-table
))
742 ;; Return the object.
743 (list key
(list service path handler
))))
745 (defun dbus-unregister-object (object)
746 "Unregister OBJECT from D-Bus.
747 OBJECT must be the result of a preceding `dbus-register-method',
748 `dbus-register-property' or `dbus-register-signal' call. It
749 returns `t' if OBJECT has been unregistered, `nil' otherwise.
751 When OBJECT identifies the last method or property, which is
752 registered for the respective service, Emacs releases its
753 association to the service from D-Bus."
755 (unless (and (consp object
) (not (null (car object
))) (consp (cdr object
)))
756 (signal 'wrong-type-argument
(list 'D-Bus object
)))
758 ;; Find the corresponding entry in the hash table.
759 (let* ((key (car object
))
762 (value (cadr object
))
763 (service (car value
))
764 (entry (gethash key dbus-registered-objects-table
))
766 ;; key has the structure (TYPE BUS INTERFACE MEMBER).
767 ;; value has the structure (SERVICE PATH [HANDLER]).
768 ;; entry has the structure ((UNAME SERVICE PATH MEMBER [RULE]) ...).
769 ;; MEMBER is either a string (the handler), or a cons cell (a
770 ;; property value). UNAME and property values are not taken into
771 ;; account for comparison.
773 ;; Loop over the registered functions.
777 (butlast (cdr elt
) (- (length (cdr elt
)) (length value
))))
779 ;; Compute new hash value. If it is empty, remove it from the
781 (unless (puthash key
(delete elt entry
) dbus-registered-objects-table
)
782 (remhash key dbus-registered-objects-table
))
783 ;; Remove match rule of signals.
784 (when (eq type
:signal
)
786 bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
787 "RemoveMatch" (nth 4 elt
)))))
789 ;; Check, whether there is still a registered function or property
790 ;; for the given service. If not, unregister the service from the
792 (when (and service
(memq type
'(:method
:property
))
803 (string-equal service
(cadr e
))
804 ;; Non-empty object path.
807 dbus-registered-objects-table
)
809 (dbus-unregister-service bus service
))
814 ;;; D-Bus type conversion.
816 (defun dbus-string-to-byte-array (string)
817 "Transforms STRING to list (:array :byte c1 :byte c2 ...).
818 STRING shall be UTF8 coded."
819 (if (zerop (length string
))
820 '(:array
:signature
"y")
822 (dolist (elt (string-to-list string
) (append '(:array
) result
))
823 (setq result
(append result
(list :byte elt
)))))))
825 (defun dbus-byte-array-to-string (byte-array)
826 "Transforms BYTE-ARRAY into UTF8 coded string.
827 BYTE-ARRAY must be a list of structure (c1 c2 ...)."
828 (apply 'string byte-array
))
830 (defun dbus-escape-as-identifier (string)
831 "Escape an arbitrary STRING so it follows the rules for a C identifier.
832 The escaped string can be used as object path component, interface element
833 component, bus name component or member name in D-Bus.
835 The escaping consists of replacing all non-alphanumerics, and the
836 first character if it's a digit, with an underscore and two
837 lower-case hex digits:
839 \"0123abc_xyz\\x01\\xff\" -> \"_30123abc_5fxyz_01_ff\"
841 i.e. similar to URI encoding, but with \"_\" taking the role of \"%\",
842 and a smaller allowed set. As a special case, \"\" is escaped to
845 Returns the escaped string. Algorithm taken from
846 telepathy-glib's `tp-escape-as-identifier'."
847 (if (zerop (length string
))
849 (replace-regexp-in-string
850 "^[0-9]\\|[^A-Za-z0-9]"
851 (lambda (x) (format "_%2x" (aref x
0)))
854 (defun dbus-unescape-from-identifier (string)
855 "Retrieve the original string from the encoded STRING.
856 STRING must have been coded with `dbus-escape-as-identifier'"
857 (if (string-equal string
"_")
859 (replace-regexp-in-string
861 (lambda (x) (format "%c" (string-to-number (substring x
1) 16)))
867 (defun dbus-check-event (event)
868 "Checks whether EVENT is a well formed D-Bus event.
869 EVENT is a list which starts with symbol `dbus-event':
871 (dbus-event BUS TYPE SERIAL SERVICE PATH INTERFACE MEMBER HANDLER &rest ARGS)
873 BUS identifies the D-Bus the message is coming from. It is
874 either a Lisp symbol, `:system' or `:session', or a string
875 denoting the bus address. TYPE is the D-Bus message type which
876 has caused the event, SERIAL is the serial number of the received
877 D-Bus message. SERVICE and PATH are the unique name and the
878 object path of the D-Bus object emitting the message. INTERFACE
879 and MEMBER denote the message which has been sent. HANDLER is
880 the function which has been registered for this message. ARGS
881 are the arguments passed to HANDLER, when it is called during
882 event handling in `dbus-handle-event'.
884 This function raises a `dbus-error' signal in case the event is
886 (when dbus-debug
(message "DBus-Event %s" event
))
887 (unless (and (listp event
)
888 (eq (car event
) 'dbus-event
)
890 (or (symbolp (nth 1 event
))
891 (stringp (nth 1 event
)))
893 (and (natnump (nth 2 event
))
894 (< dbus-message-type-invalid
(nth 2 event
)))
896 (natnump (nth 3 event
))
898 (or (= dbus-message-type-method-return
(nth 2 event
))
899 (= dbus-message-type-error
(nth 2 event
))
900 (stringp (nth 4 event
)))
902 (or (= dbus-message-type-method-return
(nth 2 event
))
903 (= dbus-message-type-error
(nth 2 event
))
904 (stringp (nth 5 event
)))
906 (or (= dbus-message-type-method-return
(nth 2 event
))
907 (= dbus-message-type-error
(nth 2 event
))
908 (stringp (nth 6 event
)))
910 (or (= dbus-message-type-method-return
(nth 2 event
))
911 (= dbus-message-type-error
(nth 2 event
))
912 (stringp (nth 7 event
)))
914 (functionp (nth 8 event
)))
915 (signal 'dbus-error
(list "Not a valid D-Bus event" event
))))
918 (defun dbus-handle-event (event)
919 "Handle events from the D-Bus.
920 EVENT is a D-Bus event, see `dbus-check-event'. HANDLER, being
921 part of the event, is called with arguments ARGS.
922 If the HANDLER returns a `dbus-error', it is propagated as return message."
926 ;; We ignore not well-formed events.
927 (dbus-check-event event
)
928 ;; Error messages must be propagated.
929 (when (= dbus-message-type-error
(nth 2 event
))
930 (signal 'dbus-error
(nthcdr 9 event
)))
931 ;; Apply the handler.
932 (setq result
(apply (nth 8 event
) (nthcdr 9 event
)))
933 ;; Return a message when it is a message call.
934 (when (= dbus-message-type-method-call
(nth 2 event
))
936 (if (eq result
:ignore
)
937 (dbus-method-return-internal
938 (nth 1 event
) (nth 4 event
) (nth 3 event
))
939 (apply 'dbus-method-return-internal
940 (nth 1 event
) (nth 4 event
) (nth 3 event
)
941 (if (consp result
) result
(list result
)))))))
944 ;; Return an error message when it is a message call.
945 (when (= dbus-message-type-method-call
(nth 2 event
))
947 (dbus-method-error-internal
948 (nth 1 event
) (nth 4 event
) (nth 3 event
) (cadr err
))))
949 ;; Propagate D-Bus error messages.
950 (run-hook-with-args 'dbus-event-error-hooks event err
)
951 (when (or dbus-debug
(= dbus-message-type-error
(nth 2 event
)))
952 (signal (car err
) (cdr err
))))))
954 (defun dbus-event-bus-name (event)
955 "Return the bus name the event is coming from.
956 The result is either a Lisp symbol, `:system' or `:session', or a
957 string denoting the bus address. EVENT is a D-Bus event, see
958 `dbus-check-event'. This function raises a `dbus-error' signal
959 in case the event is not well formed."
960 (dbus-check-event event
)
963 (defun dbus-event-message-type (event)
964 "Return the message type of the corresponding D-Bus message.
965 The result is a number. EVENT is a D-Bus event, see
966 `dbus-check-event'. This function raises a `dbus-error' signal
967 in case the event is not well formed."
968 (dbus-check-event event
)
971 (defun dbus-event-serial-number (event)
972 "Return the serial number of the corresponding D-Bus message.
973 The result is a number. The serial number is needed for
974 generating a reply message. EVENT is a D-Bus event, see
975 `dbus-check-event'. This function raises a `dbus-error' signal
976 in case the event is not well formed."
977 (dbus-check-event event
)
980 (defun dbus-event-service-name (event)
981 "Return the name of the D-Bus object the event is coming from.
982 The result is a string. EVENT is a D-Bus event, see `dbus-check-event'.
983 This function raises a `dbus-error' signal in case the event is
985 (dbus-check-event event
)
988 (defun dbus-event-path-name (event)
989 "Return the object path of the D-Bus object the event is coming from.
990 The result is a string. EVENT is a D-Bus event, see `dbus-check-event'.
991 This function raises a `dbus-error' signal in case the event is
993 (dbus-check-event event
)
996 (defun dbus-event-interface-name (event)
997 "Return the interface name of the D-Bus object the event is coming from.
998 The result is a string. EVENT is a D-Bus event, see `dbus-check-event'.
999 This function raises a `dbus-error' signal in case the event is
1001 (dbus-check-event event
)
1004 (defun dbus-event-member-name (event)
1005 "Return the member name the event is coming from.
1006 It is either a signal name or a method name. The result is a
1007 string. EVENT is a D-Bus event, see `dbus-check-event'. This
1008 function raises a `dbus-error' signal in case the event is not
1010 (dbus-check-event event
)
1014 ;;; D-Bus registered names.
1016 (defun dbus-list-activatable-names (&optional bus
)
1017 "Return the D-Bus service names which can be activated as list.
1018 If BUS is left nil, `:system' is assumed. The result is a list
1019 of strings, which is `nil' when there are no activatable service
1023 (or bus
:system
) dbus-service-dbus
1024 dbus-path-dbus dbus-interface-dbus
"ListActivatableNames")))
1026 (defun dbus-list-names (bus)
1027 "Return the service names registered at D-Bus BUS.
1028 The result is a list of strings, which is `nil' when there are no
1029 registered service names at all. Well known names are strings
1030 like \"org.freedesktop.DBus\". Names starting with \":\" are
1031 unique names for services."
1034 bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
"ListNames")))
1036 (defun dbus-list-known-names (bus)
1037 "Retrieve all services which correspond to a known name in BUS.
1038 A service has a known name if it doesn't start with \":\"."
1040 (dolist (name (dbus-list-names bus
) result
)
1041 (unless (string-equal ":" (substring name
0 1))
1042 (add-to-list 'result name
'append
)))))
1044 (defun dbus-list-queued-owners (bus service
)
1045 "Return the unique names registered at D-Bus BUS and queued for SERVICE.
1046 The result is a list of strings, or `nil' when there are no
1047 queued name owners service names at all."
1050 bus dbus-service-dbus dbus-path-dbus
1051 dbus-interface-dbus
"ListQueuedOwners" service
)))
1053 (defun dbus-get-name-owner (bus service
)
1054 "Return the name owner of SERVICE registered at D-Bus BUS.
1055 The result is either a string, or `nil' if there is no name owner."
1058 bus dbus-service-dbus dbus-path-dbus
1059 dbus-interface-dbus
"GetNameOwner" service
)))
1061 (defun dbus-ping (bus service
&optional timeout
)
1062 "Check whether SERVICE is registered for D-Bus BUS.
1063 TIMEOUT, a nonnegative integer, specifies the maximum number of
1064 milliseconds `dbus-ping' must return. The default value is 25,000.
1066 Note, that this autoloads SERVICE if it is not running yet. If
1067 it shall be checked whether SERVICE is already running, one shall
1070 \(member service \(dbus-list-known-names bus))"
1071 ;; "Ping" raises a D-Bus error if SERVICE does not exist.
1072 ;; Otherwise, it returns silently with `nil'.
1075 (if (natnump timeout
)
1077 bus service dbus-path-dbus dbus-interface-peer
1078 "Ping" :timeout timeout
)
1080 bus service dbus-path-dbus dbus-interface-peer
"Ping")))
1084 ;;; D-Bus introspection.
1086 (defun dbus-introspect (bus service path
)
1087 "Return all interfaces and sub-nodes of SERVICE,
1088 registered at object path PATH at bus BUS.
1090 BUS is either a Lisp symbol, `:system' or `:session', or a string
1091 denoting the bus address. SERVICE must be a known service name,
1092 and PATH must be a valid object path. The last two parameters
1093 are strings. The result, the introspection data, is a string in
1095 ;; We don't want to raise errors.
1098 bus service path dbus-interface-introspectable
"Introspect"
1101 (defun dbus-introspect-xml (bus service path
)
1102 "Return the introspection data of SERVICE in D-Bus BUS at object path PATH.
1103 The data are a parsed list. The root object is a \"node\",
1104 representing the object path PATH. The root object can contain
1105 \"interface\" and further \"node\" objects."
1106 ;; We don't want to raise errors.
1110 (insert (dbus-introspect bus service path
))
1111 (xml-parse-region (point-min) (point-max))))))
1113 (defun dbus-introspect-get-attribute (object attribute
)
1114 "Return the ATTRIBUTE value of D-Bus introspection OBJECT.
1115 ATTRIBUTE must be a string according to the attribute names in
1116 the D-Bus specification."
1117 (xml-get-attribute-or-nil object
(intern attribute
)))
1119 (defun dbus-introspect-get-node-names (bus service path
)
1120 "Return all node names of SERVICE in D-Bus BUS at object path PATH.
1121 It returns a list of strings. The node names stand for further
1122 object paths of the D-Bus service."
1123 (let ((object (dbus-introspect-xml bus service path
))
1125 (dolist (elt (xml-get-children object
'node
) result
)
1127 'result
(dbus-introspect-get-attribute elt
"name") 'append
))))
1129 (defun dbus-introspect-get-all-nodes (bus service path
)
1130 "Return all node names of SERVICE in D-Bus BUS at object path PATH.
1131 It returns a list of strings, which are further object paths of SERVICE."
1132 (let ((result (list path
)))
1134 (dbus-introspect-get-node-names bus service path
)
1136 (setq elt
(expand-file-name elt path
))
1138 (append result
(dbus-introspect-get-all-nodes bus service elt
))))))
1140 (defun dbus-introspect-get-interface-names (bus service path
)
1141 "Return all interface names of SERVICE in D-Bus BUS at object path PATH.
1142 It returns a list of strings.
1144 There will be always the default interface
1145 \"org.freedesktop.DBus.Introspectable\". Another default
1146 interface is \"org.freedesktop.DBus.Properties\". If present,
1147 \"interface\" objects can also have \"property\" objects as
1148 children, beside \"method\" and \"signal\" objects."
1149 (let ((object (dbus-introspect-xml bus service path
))
1151 (dolist (elt (xml-get-children object
'interface
) result
)
1153 'result
(dbus-introspect-get-attribute elt
"name") 'append
))))
1155 (defun dbus-introspect-get-interface (bus service path interface
)
1156 "Return the INTERFACE of SERVICE in D-Bus BUS at object path PATH.
1157 The return value is an XML object. INTERFACE must be a string,
1158 element of the list returned by `dbus-introspect-get-interface-names'.
1159 The resulting \"interface\" object can contain \"method\", \"signal\",
1160 \"property\" and \"annotation\" children."
1161 (let ((elt (xml-get-children
1162 (dbus-introspect-xml bus service path
) 'interface
)))
1166 (dbus-introspect-get-attribute (car elt
) "name"))))
1167 (setq elt
(cdr elt
)))
1170 (defun dbus-introspect-get-method-names (bus service path interface
)
1171 "Return a list of strings of all method names of INTERFACE.
1172 SERVICE is a service of D-Bus BUS at object path PATH."
1173 (let ((object (dbus-introspect-get-interface bus service path interface
))
1175 (dolist (elt (xml-get-children object
'method
) result
)
1177 'result
(dbus-introspect-get-attribute elt
"name") 'append
))))
1179 (defun dbus-introspect-get-method (bus service path interface method
)
1180 "Return method METHOD of interface INTERFACE as XML object.
1181 It must be located at SERVICE in D-Bus BUS at object path PATH.
1182 METHOD must be a string, element of the list returned by
1183 `dbus-introspect-get-method-names'. The resulting \"method\"
1184 object can contain \"arg\" and \"annotation\" children."
1185 (let ((elt (xml-get-children
1186 (dbus-introspect-get-interface bus service path interface
)
1190 method
(dbus-introspect-get-attribute (car elt
) "name"))))
1191 (setq elt
(cdr elt
)))
1194 (defun dbus-introspect-get-signal-names (bus service path interface
)
1195 "Return a list of strings of all signal names of INTERFACE.
1196 SERVICE is a service of D-Bus BUS at object path PATH."
1197 (let ((object (dbus-introspect-get-interface bus service path interface
))
1199 (dolist (elt (xml-get-children object
'signal
) result
)
1201 'result
(dbus-introspect-get-attribute elt
"name") 'append
))))
1203 (defun dbus-introspect-get-signal (bus service path interface signal
)
1204 "Return signal SIGNAL of interface INTERFACE as XML object.
1205 It must be located at SERVICE in D-Bus BUS at object path PATH.
1206 SIGNAL must be a string, element of the list returned by
1207 `dbus-introspect-get-signal-names'. The resulting \"signal\"
1208 object can contain \"arg\" and \"annotation\" children."
1209 (let ((elt (xml-get-children
1210 (dbus-introspect-get-interface bus service path interface
)
1214 signal
(dbus-introspect-get-attribute (car elt
) "name"))))
1215 (setq elt
(cdr elt
)))
1218 (defun dbus-introspect-get-property-names (bus service path interface
)
1219 "Return a list of strings of all property names of INTERFACE.
1220 SERVICE is a service of D-Bus BUS at object path PATH."
1221 (let ((object (dbus-introspect-get-interface bus service path interface
))
1223 (dolist (elt (xml-get-children object
'property
) result
)
1225 'result
(dbus-introspect-get-attribute elt
"name") 'append
))))
1227 (defun dbus-introspect-get-property (bus service path interface property
)
1228 "This function returns PROPERTY of INTERFACE as XML object.
1229 It must be located at SERVICE in D-Bus BUS at object path PATH.
1230 PROPERTY must be a string, element of the list returned by
1231 `dbus-introspect-get-property-names'. The resulting PROPERTY
1232 object can contain \"annotation\" children."
1233 (let ((elt (xml-get-children
1234 (dbus-introspect-get-interface bus service path interface
)
1239 (dbus-introspect-get-attribute (car elt
) "name"))))
1240 (setq elt
(cdr elt
)))
1243 (defun dbus-introspect-get-annotation-names
1244 (bus service path interface
&optional name
)
1245 "Return all annotation names as list of strings.
1246 If NAME is `nil', the annotations are children of INTERFACE,
1247 otherwise NAME must be a \"method\", \"signal\", or \"property\"
1248 object, where the annotations belong to."
1251 (or (dbus-introspect-get-method bus service path interface name
)
1252 (dbus-introspect-get-signal bus service path interface name
)
1253 (dbus-introspect-get-property bus service path interface name
))
1254 (dbus-introspect-get-interface bus service path interface
)))
1256 (dolist (elt (xml-get-children object
'annotation
) result
)
1258 'result
(dbus-introspect-get-attribute elt
"name") 'append
))))
1260 (defun dbus-introspect-get-annotation
1261 (bus service path interface name annotation
)
1262 "Return ANNOTATION as XML object.
1263 If NAME is `nil', ANNOTATION is a child of INTERFACE, otherwise
1264 NAME must be the name of a \"method\", \"signal\", or
1265 \"property\" object, where the ANNOTATION belongs to."
1266 (let ((elt (xml-get-children
1268 (or (dbus-introspect-get-method
1269 bus service path interface name
)
1270 (dbus-introspect-get-signal
1271 bus service path interface name
)
1272 (dbus-introspect-get-property
1273 bus service path interface name
))
1274 (dbus-introspect-get-interface bus service path interface
))
1279 (dbus-introspect-get-attribute (car elt
) "name"))))
1280 (setq elt
(cdr elt
)))
1283 (defun dbus-introspect-get-argument-names (bus service path interface name
)
1284 "Return a list of all argument names as list of strings.
1285 NAME must be a \"method\" or \"signal\" object.
1287 Argument names are optional, the function can return `nil'
1288 therefore, even if the method or signal has arguments."
1290 (or (dbus-introspect-get-method bus service path interface name
)
1291 (dbus-introspect-get-signal bus service path interface name
)))
1293 (dolist (elt (xml-get-children object
'arg
) result
)
1295 'result
(dbus-introspect-get-attribute elt
"name") 'append
))))
1297 (defun dbus-introspect-get-argument (bus service path interface name arg
)
1298 "Return argument ARG as XML object.
1299 NAME must be a \"method\" or \"signal\" object. ARG must be a string,
1300 element of the list returned by `dbus-introspect-get-argument-names'."
1301 (let ((elt (xml-get-children
1302 (or (dbus-introspect-get-method bus service path interface name
)
1303 (dbus-introspect-get-signal bus service path interface name
))
1307 arg
(dbus-introspect-get-attribute (car elt
) "name"))))
1308 (setq elt
(cdr elt
)))
1311 (defun dbus-introspect-get-signature
1312 (bus service path interface name
&optional direction
)
1313 "Return signature of a `method' or `signal', represented by NAME, as string.
1314 If NAME is a `method', DIRECTION can be either \"in\" or \"out\".
1315 If DIRECTION is `nil', \"in\" is assumed.
1317 If NAME is a `signal', and DIRECTION is non-`nil', DIRECTION must
1319 ;; For methods, we use "in" as default direction.
1320 (let ((object (or (dbus-introspect-get-method
1321 bus service path interface name
)
1322 (dbus-introspect-get-signal
1323 bus service path interface name
))))
1324 (when (and (string-equal
1325 "method" (dbus-introspect-get-attribute object
"name"))
1326 (not (stringp direction
)))
1327 (setq direction
"in"))
1328 ;; In signals, no direction is given.
1329 (when (string-equal "signal" (dbus-introspect-get-attribute object
"name"))
1330 (setq direction nil
))
1331 ;; Collect the signatures.
1334 (let ((arg (dbus-introspect-get-argument
1335 bus service path interface name x
)))
1336 (if (or (not (stringp direction
))
1339 (dbus-introspect-get-attribute arg
"direction")))
1340 (dbus-introspect-get-attribute arg
"type")
1342 (dbus-introspect-get-argument-names bus service path interface name
)
1346 ;;; D-Bus properties.
1348 (defun dbus-get-property (bus service path interface property
)
1349 "Return the value of PROPERTY of INTERFACE.
1350 It will be checked at BUS, SERVICE, PATH. The result can be any
1351 valid D-Bus value, or `nil' if there is no PROPERTY."
1353 ;; "Get" returns a variant, so we must use the `car'.
1356 bus service path dbus-interface-properties
1357 "Get" :timeout
500 interface property
))))
1359 (defun dbus-set-property (bus service path interface property value
)
1360 "Set value of PROPERTY of INTERFACE to VALUE.
1361 It will be checked at BUS, SERVICE, PATH. When the value has
1362 been set successful, the result is VALUE. Otherwise, `nil' is
1365 ;; "Set" requires a variant.
1367 bus service path dbus-interface-properties
1368 "Set" :timeout
500 interface property
(list :variant value
))
1370 (dbus-get-property bus service path interface property
)))
1372 (defun dbus-get-all-properties (bus service path interface
)
1373 "Return all properties of INTERFACE at BUS, SERVICE, PATH.
1374 The result is a list of entries. Every entry is a cons of the
1375 name of the property, and its value. If there are no properties,
1378 ;; "GetAll" returns "a{sv}".
1382 bus service path dbus-interface-properties
1383 "GetAll" :timeout
500 interface
)
1385 (add-to-list 'result
(cons (car dict
) (cl-caadr dict
)) 'append
)))))
1387 (defun dbus-register-property
1388 (bus service path interface property access value
1389 &optional emits-signal dont-register-service
)
1390 "Register property PROPERTY on the D-Bus BUS.
1392 BUS is either a Lisp symbol, `:system' or `:session', or a string
1393 denoting the bus address.
1395 SERVICE is the D-Bus service name of the D-Bus. It must be a
1396 known name (See discussion of DONT-REGISTER-SERVICE below).
1398 PATH is the D-Bus object path SERVICE is registered (See
1399 discussion of DONT-REGISTER-SERVICE below). INTERFACE is the
1400 name of the interface used at PATH, PROPERTY is the name of the
1401 property of INTERFACE. ACCESS indicates, whether the property
1402 can be changed by other services via D-Bus. It must be either
1403 the symbol `:read' or `:readwrite'. VALUE is the initial value
1404 of the property, it can be of any valid type (see
1405 `dbus-call-method' for details).
1407 If PROPERTY already exists on PATH, it will be overwritten. For
1408 properties with access type `:read' this is the only way to
1409 change their values. Properties with access type `:readwrite'
1410 can be changed by `dbus-set-property'.
1412 The interface \"org.freedesktop.DBus.Properties\" is added to
1413 PATH, including a default handler for the \"Get\", \"GetAll\" and
1414 \"Set\" methods of this interface. When EMITS-SIGNAL is non-nil,
1415 the signal \"PropertiesChanged\" is sent when the property is
1416 changed by `dbus-set-property'.
1418 When DONT-REGISTER-SERVICE is non-nil, the known name SERVICE is
1419 not registered. This means that other D-Bus clients have no way
1420 of noticing the newly registered property. When interfaces are
1421 constructed incrementally by adding single methods or properties
1422 at a time, DONT-REGISTER-SERVICE can be used to prevent other
1423 clients from discovering the still incomplete interface."
1424 (unless (member access
'(:read
:readwrite
))
1425 (signal 'wrong-type-argument
(list "Access type invalid" access
)))
1427 ;; Add handlers for the three property-related methods.
1428 (dbus-register-method
1429 bus service path dbus-interface-properties
"Get"
1430 'dbus-property-handler
'dont-register
)
1431 (dbus-register-method
1432 bus service path dbus-interface-properties
"GetAll"
1433 'dbus-property-handler
'dont-register
)
1434 (dbus-register-method
1435 bus service path dbus-interface-properties
"Set"
1436 'dbus-property-handler
'dont-register
)
1438 ;; Register SERVICE.
1439 (unless (or dont-register-service
(member service
(dbus-list-names bus
)))
1440 (dbus-register-service bus service
))
1442 ;; Send the PropertiesChanged signal.
1445 bus service path dbus-interface-properties
"PropertiesChanged"
1446 `((:dict-entry
,property
(:variant
,value
)))
1449 ;; Create a hash table entry. We use nil for the unique name,
1450 ;; because the property might be accessed from anybody.
1451 (let ((key (list :property bus interface property
))
1457 (if emits-signal
(list access
:emits-signal
) (list access
))
1459 (puthash key val dbus-registered-objects-table
)
1461 ;; Return the object.
1462 (list key
(list service path
))))
1464 (defun dbus-property-handler (&rest args
)
1465 "Default handler for the \"org.freedesktop.DBus.Properties\" interface.
1466 It will be registered for all objects created by `dbus-register-property'."
1467 (let ((bus (dbus-event-bus-name last-input-event
))
1468 (service (dbus-event-service-name last-input-event
))
1469 (path (dbus-event-path-name last-input-event
))
1470 (method (dbus-event-member-name last-input-event
))
1471 (interface (car args
))
1472 (property (cadr args
)))
1474 ;; "Get" returns a variant.
1475 ((string-equal method
"Get")
1476 (let ((entry (gethash (list :property bus interface property
)
1477 dbus-registered-objects-table
)))
1478 (when (string-equal path
(nth 2 (car entry
)))
1479 `((:variant
,(cdar (last (car entry
))))))))
1481 ;; "Set" expects a variant.
1482 ((string-equal method
"Set")
1483 (let* ((value (caar (cddr args
)))
1484 (entry (gethash (list :property bus interface property
)
1485 dbus-registered-objects-table
))
1486 ;; The value of the hash table is a list; in case of
1487 ;; properties it contains just one element (UNAME SERVICE
1488 ;; PATH OBJECT). OBJECT is a cons cell of a list, which
1489 ;; contains a list of annotations (like :read,
1490 ;; :read-write, :emits-signal), and the value of the
1492 (object (car (last (car entry
)))))
1493 (unless (consp object
)
1495 (list "Property not registered at path" property path
)))
1496 (unless (member :readwrite
(car object
))
1498 (list "Property not writable at path" property path
)))
1499 (puthash (list :property bus interface property
)
1500 (list (append (butlast (car entry
))
1501 (list (cons (car object
) value
))))
1502 dbus-registered-objects-table
)
1503 ;; Send the "PropertiesChanged" signal.
1504 (when (member :emits-signal
(car object
))
1506 bus service path dbus-interface-properties
"PropertiesChanged"
1507 `((:dict-entry
,property
(:variant
,value
)))
1509 ;; Return empty reply.
1512 ;; "GetAll" returns "a{sv}".
1513 ((string-equal method
"GetAll")
1517 (when (and (equal (butlast key
) (list :property bus interface
))
1518 (string-equal path
(nth 2 (car val
)))
1519 (not (functionp (car (last (car val
))))))
1524 (list :variant
(cdar (last (car val
))))))))
1525 dbus-registered-objects-table
)
1526 ;; Return the result, or an empty array.
1527 (list :array
(or result
'(:signature
"{sv}"))))))))
1530 ;;; D-Bus object manager.
1532 (defun dbus-get-all-managed-objects (bus service path
)
1533 "Return all objects at BUS, SERVICE, PATH, and the children of PATH.
1534 The result is a list of objects. Every object is a cons of an
1535 existing path name, and the list of available interface objects.
1536 An interface object is another cons, which car is the interface
1537 name, and the cdr is the list of properties as returned by
1538 `dbus-get-all-properties' for that path and interface. Example:
1540 \(dbus-get-all-managed-objects :session \"org.gnome.SettingsDaemon\" \"/\")
1542 => \(\(\"/org/gnome/SettingsDaemon/MediaKeys\"
1543 \(\"org.gnome.SettingsDaemon.MediaKeys\")
1544 \(\"org.freedesktop.DBus.Peer\")
1545 \(\"org.freedesktop.DBus.Introspectable\")
1546 \(\"org.freedesktop.DBus.Properties\")
1547 \(\"org.freedesktop.DBus.ObjectManager\"))
1548 \(\"/org/gnome/SettingsDaemon/Power\"
1549 \(\"org.gnome.SettingsDaemon.Power.Keyboard\")
1550 \(\"org.gnome.SettingsDaemon.Power.Screen\")
1551 \(\"org.gnome.SettingsDaemon.Power\"
1552 \(\"Icon\" . \". GThemedIcon battery-full-charged-symbolic \")
1553 \(\"Tooltip\" . \"Laptop battery is charged\"))
1554 \(\"org.freedesktop.DBus.Peer\")
1555 \(\"org.freedesktop.DBus.Introspectable\")
1556 \(\"org.freedesktop.DBus.Properties\")
1557 \(\"org.freedesktop.DBus.ObjectManager\"))
1560 If possible, \"org.freedesktop.DBus.ObjectManager.GetManagedObjects\"
1561 is used for retrieving the information. Otherwise, the information
1562 is collected via \"org.freedesktop.DBus.Introspectable.Introspect\"
1563 and \"org.freedesktop.DBus.Properties.GetAll\", which is slow."
1565 ;; Direct call. Fails, if the target does not support the
1566 ;; object manager interface.
1569 bus service path dbus-interface-objectmanager
1570 "GetManagedObjects" :timeout
1000))))
1573 ;; Massage the returned structure.
1574 (dolist (entry result result
)
1576 (dolist (entry1 (cdr entry
))
1578 (dolist (entry2 entry1
)
1582 (dolist (entry3 (cadr entry2
))
1583 (setcdr entry3
(cl-caadr entry3
)))
1584 (setcdr entry2 nil
)))))
1586 ;; Fallback: collect the information. Slooow!
1588 (dbus-introspect-get-all-nodes bus service path
)
1593 (dbus-introspect-get-interface-names bus service object
)
1598 (dbus-get-all-properties bus service object interface
))))
1600 (add-to-list 'result
(cons object result1
))))))))
1602 (defun dbus-managed-objects-handler ()
1603 "Default handler for the \"org.freedesktop.DBus.ObjectManager\" interface.
1604 It will be registered for all objects created by `dbus-register-method'."
1605 (let* ((last-input-event last-input-event
)
1606 (bus (dbus-event-bus-name last-input-event
))
1607 (service (dbus-event-service-name last-input-event
))
1608 (path (dbus-event-path-name last-input-event
)))
1609 ;; "GetManagedObjects" returns "a{oa{sa{sv}}}".
1610 (let (interfaces result
)
1612 ;; Check for object path wildcard interfaces.
1615 (when (and (equal (butlast key
2) (list :method bus
))
1616 (null (nth 2 (car-safe val
))))
1617 (add-to-list 'interfaces
(nth 2 key
))))
1618 dbus-registered-objects-table
)
1620 ;; Check all registered object paths.
1623 (let ((object (or (nth 2 (car-safe val
)) ""))
1624 (interface (nth 2 key
)))
1625 (when (and (equal (butlast key
2) (list :method bus
))
1626 (string-prefix-p path object
))
1627 (dolist (interface (cons (nth 2 key
) interfaces
))
1628 (unless (assoc object result
)
1629 (add-to-list 'result
(list object
)))
1630 (unless (assoc interface
(cdr (assoc object result
)))
1632 (assoc object result
)
1636 ;; We simulate "org.freedesktop.DBus.Properties.GetAll"
1637 ;; by using an appropriate D-Bus event.
1638 (let ((last-input-event
1640 (butlast last-input-event
4)
1641 (list object dbus-interface-properties
1642 "GetAll" 'dbus-property-handler
))))
1643 (dbus-property-handler interface
))))
1644 (cdr (assoc object result
)))))))))
1645 dbus-registered-objects-table
)
1647 ;; Return the result, or an empty array.
1654 :dict-entry
:object-path
(car x
)
1655 (cons :array
(mapcar (lambda (y) (cons :dict-entry y
)) (cdr x
)))))
1657 '(:signature
"{oa{sa{sv}}}"))))))
1660 ;; Initialize `:system' and `:session' buses. This adds their file
1661 ;; descriptors to input_wait_mask, in order to detect incoming
1662 ;; messages immediately.
1663 (when (featurep 'dbusbind
)
1665 (dbus-init-bus :system
))
1667 (dbus-init-bus :session
)))
1673 ;; * Implement org.freedesktop.DBus.ObjectManager.InterfacesAdded and
1674 ;; org.freedesktop.DBus.ObjectManager.InterfacesRemoved.
1676 ;;; dbus.el ends here