PageRenderTime 137ms CodeModel.GetById 36ms RepoModel.GetById 1ms app.codeStats 0ms

/lisp/net/dbus.el

http://github.com/emacsmirror/emacs
Emacs Lisp | 1678 lines | 1246 code | 240 blank | 192 comment | 42 complexity | d86e3dbe8d2fee3173c36e04f04cda03 MD5 | raw file
Possible License(s): GPL-3.0, LGPL-2.0, AGPL-3.0

Large files files are truncated, but you can click here to view the full file

  1. ;;; dbus.el --- Elisp bindings for D-Bus.
  2. ;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
  3. ;; Author: Michael Albinus <michael.albinus@gmx.de>
  4. ;; Keywords: comm, hardware
  5. ;; This file is part of GNU Emacs.
  6. ;; GNU Emacs is free software: you can redistribute it and/or modify
  7. ;; it under the terms of the GNU General Public License as published by
  8. ;; the Free Software Foundation, either version 3 of the License, or
  9. ;; (at your option) any later version.
  10. ;; GNU Emacs is distributed in the hope that it will be useful,
  11. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  13. ;; GNU General Public License for more details.
  14. ;; You should have received a copy of the GNU General Public License
  15. ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
  16. ;;; Commentary:
  17. ;; This package provides language bindings for the D-Bus API. D-Bus
  18. ;; is a message bus system, a simple way for applications to talk to
  19. ;; one another. See <http://dbus.freedesktop.org/> for details.
  20. ;; Low-level language bindings are implemented in src/dbusbind.c.
  21. ;; D-Bus support in the Emacs core can be disabled with configuration
  22. ;; option "--without-dbus".
  23. ;;; Code:
  24. ;; Declare used subroutines and variables.
  25. (declare-function dbus-message-internal "dbusbind.c")
  26. (declare-function dbus-init-bus "dbusbind.c")
  27. (defvar dbus-message-type-invalid)
  28. (defvar dbus-message-type-method-call)
  29. (defvar dbus-message-type-method-return)
  30. (defvar dbus-message-type-error)
  31. (defvar dbus-message-type-signal)
  32. (defvar dbus-debug)
  33. (defvar dbus-registered-objects-table)
  34. ;; Pacify byte compiler.
  35. (eval-when-compile (require 'cl-lib))
  36. (require 'xml)
  37. (defconst dbus-service-dbus "org.freedesktop.DBus"
  38. "The bus name used to talk to the bus itself.")
  39. (defconst dbus-path-dbus "/org/freedesktop/DBus"
  40. "The object path used to talk to the bus itself.")
  41. ;; Default D-Bus interfaces.
  42. (defconst dbus-interface-dbus "org.freedesktop.DBus"
  43. "The interface exported by the service `dbus-service-dbus'.")
  44. (defconst dbus-interface-peer (concat dbus-interface-dbus ".Peer")
  45. "The interface for peer objects.
  46. See URL `http://dbus.freedesktop.org/doc/dbus-specification.html#standard-interfaces-peer'.")
  47. ;; <interface name="org.freedesktop.DBus.Peer">
  48. ;; <method name="Ping">
  49. ;; </method>
  50. ;; <method name="GetMachineId">
  51. ;; <arg name="machine_uuid" type="s" direction="out"/>
  52. ;; </method>
  53. ;; </interface>
  54. (defconst dbus-interface-introspectable
  55. (concat dbus-interface-dbus ".Introspectable")
  56. "The interface supported by introspectable objects.
  57. See URL `http://dbus.freedesktop.org/doc/dbus-specification.html#standard-interfaces-introspectable'.")
  58. ;; <interface name="org.freedesktop.DBus.Introspectable">
  59. ;; <method name="Introspect">
  60. ;; <arg name="data" type="s" direction="out"/>
  61. ;; </method>
  62. ;; </interface>
  63. (defconst dbus-interface-properties (concat dbus-interface-dbus ".Properties")
  64. "The interface for property objects.
  65. See URL `http://dbus.freedesktop.org/doc/dbus-specification.html#standard-interfaces-properties'.")
  66. ;; <interface name="org.freedesktop.DBus.Properties">
  67. ;; <method name="Get">
  68. ;; <arg name="interface" type="s" direction="in"/>
  69. ;; <arg name="propname" type="s" direction="in"/>
  70. ;; <arg name="value" type="v" direction="out"/>
  71. ;; </method>
  72. ;; <method name="Set">
  73. ;; <arg name="interface" type="s" direction="in"/>
  74. ;; <arg name="propname" type="s" direction="in"/>
  75. ;; <arg name="value" type="v" direction="in"/>
  76. ;; </method>
  77. ;; <method name="GetAll">
  78. ;; <arg name="interface" type="s" direction="in"/>
  79. ;; <arg name="props" type="a{sv}" direction="out"/>
  80. ;; </method>
  81. ;; <signal name="PropertiesChanged">
  82. ;; <arg name="interface" type="s"/>
  83. ;; <arg name="changed_properties" type="a{sv}"/>
  84. ;; <arg name="invalidated_properties" type="as"/>
  85. ;; </signal>
  86. ;; </interface>
  87. (defconst dbus-interface-objectmanager
  88. (concat dbus-interface-dbus ".ObjectManager")
  89. "The object manager interface.
  90. See URL `http://dbus.freedesktop.org/doc/dbus-specification.html#standard-interfaces-objectmanager'.")
  91. ;; <interface name="org.freedesktop.DBus.ObjectManager">
  92. ;; <method name="GetManagedObjects">
  93. ;; <arg name="object_paths_interfaces_and_properties"
  94. ;; type="a{oa{sa{sv}}}" direction="out"/>
  95. ;; </method>
  96. ;; <signal name="InterfacesAdded">
  97. ;; <arg name="object_path" type="o"/>
  98. ;; <arg name="interfaces_and_properties" type="a{sa{sv}}"/>
  99. ;; </signal>
  100. ;; <signal name="InterfacesRemoved">
  101. ;; <arg name="object_path" type="o"/>
  102. ;; <arg name="interfaces" type="as"/>
  103. ;; </signal>
  104. ;; </interface>
  105. ;; Emacs defaults.
  106. (defconst dbus-service-emacs "org.gnu.Emacs"
  107. "The well known service name of Emacs.")
  108. (defconst dbus-path-emacs "/org/gnu/Emacs"
  109. "The object path namespace used by Emacs.
  110. All object paths provided by the service `dbus-service-emacs'
  111. shall be subdirectories of this path.")
  112. (defconst dbus-interface-emacs "org.gnu.Emacs"
  113. "The interface namespace used by Emacs.")
  114. ;; D-Bus constants.
  115. (defmacro dbus-ignore-errors (&rest body)
  116. "Execute BODY; signal D-Bus error when `dbus-debug' is non-nil.
  117. Otherwise, return result of last form in BODY, or all other errors."
  118. (declare (indent 0) (debug t))
  119. `(condition-case err
  120. (progn ,@body)
  121. (dbus-error (when dbus-debug (signal (car err) (cdr err))))))
  122. (font-lock-add-keywords 'emacs-lisp-mode '("\\<dbus-ignore-errors\\>"))
  123. (define-obsolete-variable-alias 'dbus-event-error-hooks
  124. 'dbus-event-error-functions "24.3")
  125. (defvar dbus-event-error-functions nil
  126. "Functions to be called when a D-Bus error happens in the event handler.
  127. Every function must accept two arguments, the event and the error variable
  128. caught in `condition-case' by `dbus-error'.")
  129. ;;; Basic D-Bus message functions.
  130. (defvar dbus-return-values-table (make-hash-table :test 'equal)
  131. "Hash table for temporary storing arguments of reply messages.
  132. A key in this hash table is a list (:serial BUS SERIAL), like in
  133. `dbus-registered-objects-table'. BUS is either a Lisp symbol,
  134. `:system' or `:session', or a string denoting the bus address.
  135. SERIAL is the serial number of the reply message.")
  136. (defun dbus-call-method-handler (&rest args)
  137. "Handler for reply messages of asynchronous D-Bus message calls.
  138. It calls the function stored in `dbus-registered-objects-table'.
  139. The result will be made available in `dbus-return-values-table'."
  140. (puthash (list :serial
  141. (dbus-event-bus-name last-input-event)
  142. (dbus-event-serial-number last-input-event))
  143. (if (= (length args) 1) (car args) args)
  144. dbus-return-values-table))
  145. (defun dbus-call-method (bus service path interface method &rest args)
  146. "Call METHOD on the D-Bus BUS.
  147. BUS is either a Lisp symbol, `:system' or `:session', or a string
  148. denoting the bus address.
  149. SERVICE is the D-Bus service name to be used. PATH is the D-Bus
  150. object path SERVICE is registered at. INTERFACE is an interface
  151. offered by SERVICE. It must provide METHOD.
  152. If the parameter `:timeout' is given, the following integer TIMEOUT
  153. specifies the maximum number of milliseconds the method call must
  154. return. The default value is 25,000. If the method call doesn't
  155. return in time, a D-Bus error is raised.
  156. All other arguments ARGS are passed to METHOD as arguments. They are
  157. converted into D-Bus types via the following rules:
  158. t and nil => DBUS_TYPE_BOOLEAN
  159. number => DBUS_TYPE_UINT32
  160. integer => DBUS_TYPE_INT32
  161. float => DBUS_TYPE_DOUBLE
  162. string => DBUS_TYPE_STRING
  163. list => DBUS_TYPE_ARRAY
  164. All arguments can be preceded by a type symbol. For details about
  165. type symbols, see Info node `(dbus)Type Conversion'.
  166. `dbus-call-method' returns the resulting values of METHOD as a list of
  167. Lisp objects. The type conversion happens the other direction as for
  168. input arguments. It follows the mapping rules:
  169. DBUS_TYPE_BOOLEAN => t or nil
  170. DBUS_TYPE_BYTE => number
  171. DBUS_TYPE_UINT16 => number
  172. DBUS_TYPE_INT16 => integer
  173. DBUS_TYPE_UINT32 => number or float
  174. DBUS_TYPE_UNIX_FD => number or float
  175. DBUS_TYPE_INT32 => integer or float
  176. DBUS_TYPE_UINT64 => number or float
  177. DBUS_TYPE_INT64 => integer or float
  178. DBUS_TYPE_DOUBLE => float
  179. DBUS_TYPE_STRING => string
  180. DBUS_TYPE_OBJECT_PATH => string
  181. DBUS_TYPE_SIGNATURE => string
  182. DBUS_TYPE_ARRAY => list
  183. DBUS_TYPE_VARIANT => list
  184. DBUS_TYPE_STRUCT => list
  185. DBUS_TYPE_DICT_ENTRY => list
  186. Example:
  187. \(dbus-call-method
  188. :session \"org.gnome.seahorse\" \"/org/gnome/seahorse/keys/openpgp\"
  189. \"org.gnome.seahorse.Keys\" \"GetKeyField\"
  190. \"openpgp:657984B8C7A966DD\" \"simple-name\")
  191. => (t (\"Philip R. Zimmermann\"))
  192. If the result of the METHOD call is just one value, the converted Lisp
  193. object is returned instead of a list containing this single Lisp object.
  194. \(dbus-call-method
  195. :system \"org.freedesktop.Hal\" \"/org/freedesktop/Hal/devices/computer\"
  196. \"org.freedesktop.Hal.Device\" \"GetPropertyString\"
  197. \"system.kernel.machine\")
  198. => \"i686\""
  199. (or (memq bus '(:system :session)) (stringp bus)
  200. (signal 'wrong-type-argument (list 'keywordp bus)))
  201. (or (stringp service)
  202. (signal 'wrong-type-argument (list 'stringp service)))
  203. (or (stringp path)
  204. (signal 'wrong-type-argument (list 'stringp path)))
  205. (or (stringp interface)
  206. (signal 'wrong-type-argument (list 'stringp interface)))
  207. (or (stringp method)
  208. (signal 'wrong-type-argument (list 'stringp method)))
  209. (let ((timeout (plist-get args :timeout))
  210. (key
  211. (apply
  212. 'dbus-message-internal dbus-message-type-method-call
  213. bus service path interface method 'dbus-call-method-handler args)))
  214. ;; Wait until `dbus-call-method-handler' has put the result into
  215. ;; `dbus-return-values-table'. If no timeout is given, use the
  216. ;; default 25". Events which are not from D-Bus must be restored.
  217. (with-timeout ((if timeout (/ timeout 1000.0) 25))
  218. (while (eq (gethash key dbus-return-values-table :ignore) :ignore)
  219. (let ((event (let (unread-command-events) (read-event nil nil 0.1))))
  220. (when (and event (not (ignore-errors (dbus-check-event event))))
  221. (setq unread-command-events
  222. (append unread-command-events (list event)))))))
  223. ;; Cleanup `dbus-return-values-table'. Return the result.
  224. (prog1
  225. (gethash key dbus-return-values-table)
  226. (remhash key dbus-return-values-table))))
  227. ;; `dbus-call-method' works non-blocking now.
  228. (defalias 'dbus-call-method-non-blocking 'dbus-call-method)
  229. (make-obsolete 'dbus-call-method-non-blocking 'dbus-call-method "24.3")
  230. (defun dbus-call-method-asynchronously
  231. (bus service path interface method handler &rest args)
  232. "Call METHOD on the D-Bus BUS asynchronously.
  233. BUS is either a Lisp symbol, `:system' or `:session', or a string
  234. denoting the bus address.
  235. SERVICE is the D-Bus service name to be used. PATH is the D-Bus
  236. object path SERVICE is registered at. INTERFACE is an interface
  237. offered by SERVICE. It must provide METHOD.
  238. HANDLER is a Lisp function, which is called when the corresponding
  239. return message has arrived. If HANDLER is nil, no return message
  240. will be expected.
  241. If the parameter `:timeout' is given, the following integer TIMEOUT
  242. specifies the maximum number of milliseconds the method call must
  243. return. The default value is 25,000. If the method call doesn't
  244. return in time, a D-Bus error is raised.
  245. All other arguments ARGS are passed to METHOD as arguments. They are
  246. converted into D-Bus types via the following rules:
  247. t and nil => DBUS_TYPE_BOOLEAN
  248. number => DBUS_TYPE_UINT32
  249. integer => DBUS_TYPE_INT32
  250. float => DBUS_TYPE_DOUBLE
  251. string => DBUS_TYPE_STRING
  252. list => DBUS_TYPE_ARRAY
  253. All arguments can be preceded by a type symbol. For details about
  254. type symbols, see Info node `(dbus)Type Conversion'.
  255. If HANDLER is a Lisp function, the function returns a key into the
  256. hash table `dbus-registered-objects-table'. The corresponding entry
  257. in the hash table is removed, when the return message has been arrived,
  258. and HANDLER is called.
  259. Example:
  260. \(dbus-call-method-asynchronously
  261. :system \"org.freedesktop.Hal\" \"/org/freedesktop/Hal/devices/computer\"
  262. \"org.freedesktop.Hal.Device\" \"GetPropertyString\" 'message
  263. \"system.kernel.machine\")
  264. => \(:serial :system 2)
  265. -| i686"
  266. (or (memq bus '(:system :session)) (stringp bus)
  267. (signal 'wrong-type-argument (list 'keywordp bus)))
  268. (or (stringp service)
  269. (signal 'wrong-type-argument (list 'stringp service)))
  270. (or (stringp path)
  271. (signal 'wrong-type-argument (list 'stringp path)))
  272. (or (stringp interface)
  273. (signal 'wrong-type-argument (list 'stringp interface)))
  274. (or (stringp method)
  275. (signal 'wrong-type-argument (list 'stringp method)))
  276. (or (null handler) (functionp handler)
  277. (signal 'wrong-type-argument (list 'functionp handler)))
  278. (apply 'dbus-message-internal dbus-message-type-method-call
  279. bus service path interface method handler args))
  280. (defun dbus-send-signal (bus service path interface signal &rest args)
  281. "Send signal SIGNAL on the D-Bus BUS.
  282. BUS is either a Lisp symbol, `:system' or `:session', or a string
  283. denoting the bus address. The signal is sent from the D-Bus object
  284. Emacs is registered at BUS.
  285. SERVICE is the D-Bus name SIGNAL is sent to. It can be either a known
  286. name or a unique name. If SERVICE is nil, the signal is sent as
  287. broadcast message. PATH is the D-Bus object path SIGNAL is sent from.
  288. INTERFACE is an interface available at PATH. It must provide signal
  289. SIGNAL.
  290. All other arguments ARGS are passed to SIGNAL as arguments. They are
  291. converted into D-Bus types via the following rules:
  292. t and nil => DBUS_TYPE_BOOLEAN
  293. number => DBUS_TYPE_UINT32
  294. integer => DBUS_TYPE_INT32
  295. float => DBUS_TYPE_DOUBLE
  296. string => DBUS_TYPE_STRING
  297. list => DBUS_TYPE_ARRAY
  298. All arguments can be preceded by a type symbol. For details about
  299. type symbols, see Info node `(dbus)Type Conversion'.
  300. Example:
  301. \(dbus-send-signal
  302. :session nil \"/org/gnu/Emacs\" \"org.gnu.Emacs.FileManager\"
  303. \"FileModified\" \"/home/albinus/.emacs\")"
  304. (or (memq bus '(:system :session)) (stringp bus)
  305. (signal 'wrong-type-argument (list 'keywordp bus)))
  306. (or (null service) (stringp service)
  307. (signal 'wrong-type-argument (list 'stringp service)))
  308. (or (stringp path)
  309. (signal 'wrong-type-argument (list 'stringp path)))
  310. (or (stringp interface)
  311. (signal 'wrong-type-argument (list 'stringp interface)))
  312. (or (stringp signal)
  313. (signal 'wrong-type-argument (list 'stringp signal)))
  314. (apply 'dbus-message-internal dbus-message-type-signal
  315. bus service path interface signal args))
  316. (defun dbus-method-return-internal (bus service serial &rest args)
  317. "Return for message SERIAL on the D-Bus BUS.
  318. This is an internal function, it shall not be used outside dbus.el."
  319. (or (memq bus '(:system :session)) (stringp bus)
  320. (signal 'wrong-type-argument (list 'keywordp bus)))
  321. (or (stringp service)
  322. (signal 'wrong-type-argument (list 'stringp service)))
  323. (or (natnump serial)
  324. (signal 'wrong-type-argument (list 'natnump serial)))
  325. (apply 'dbus-message-internal dbus-message-type-method-return
  326. bus service serial args))
  327. (defun dbus-method-error-internal (bus service serial &rest args)
  328. "Return error message for message SERIAL on the D-Bus BUS.
  329. This is an internal function, it shall not be used outside dbus.el."
  330. (or (memq bus '(:system :session)) (stringp bus)
  331. (signal 'wrong-type-argument (list 'keywordp bus)))
  332. (or (stringp service)
  333. (signal 'wrong-type-argument (list 'stringp service)))
  334. (or (natnump serial)
  335. (signal 'wrong-type-argument (list 'natnump serial)))
  336. (apply 'dbus-message-internal dbus-message-type-error
  337. bus service serial args))
  338. ;;; Hash table of registered functions.
  339. (defun dbus-list-hash-table ()
  340. "Returns all registered member registrations to D-Bus.
  341. The return value is a list, with elements of kind (KEY . VALUE).
  342. See `dbus-registered-objects-table' for a description of the
  343. hash table."
  344. (let (result)
  345. (maphash
  346. (lambda (key value) (add-to-list 'result (cons key value) 'append))
  347. dbus-registered-objects-table)
  348. result))
  349. (defun dbus-setenv (bus variable value)
  350. "Set the value of the BUS environment variable named VARIABLE to VALUE.
  351. BUS is either a Lisp symbol, `:system' or `:session', or a string
  352. denoting the bus address. Both VARIABLE and VALUE should be strings.
  353. Normally, services inherit the environment of the BUS daemon. This
  354. function adds to or modifies that environment when activating services.
  355. Some bus instances, such as `:system', may disable setting the environment."
  356. (dbus-call-method
  357. bus dbus-service-dbus dbus-path-dbus
  358. dbus-interface-dbus "UpdateActivationEnvironment"
  359. `(:array (:dict-entry ,variable ,value))))
  360. (defun dbus-register-service (bus service &rest flags)
  361. "Register known name SERVICE on the D-Bus BUS.
  362. BUS is either a Lisp symbol, `:system' or `:session', or a string
  363. denoting the bus address.
  364. SERVICE is the D-Bus service name that should be registered. It must
  365. be a known name.
  366. FLAGS are keywords, which control how the service name is registered.
  367. The following keywords are recognized:
  368. `:allow-replacement': Allow another service to become the primary
  369. owner if requested.
  370. `:replace-existing': Request to replace the current primary owner.
  371. `:do-not-queue': If we can not become the primary owner do not place
  372. us in the queue.
  373. The function returns a keyword, indicating the result of the
  374. operation. One of the following keywords is returned:
  375. `:primary-owner': Service has become the primary owner of the
  376. requested name.
  377. `:in-queue': Service could not become the primary owner and has been
  378. placed in the queue.
  379. `:exists': Service is already in the queue.
  380. `:already-owner': Service is already the primary owner."
  381. ;; Add ObjectManager handler.
  382. (dbus-register-method
  383. bus service nil dbus-interface-objectmanager "GetManagedObjects"
  384. 'dbus-managed-objects-handler 'dont-register)
  385. (let ((arg 0)
  386. reply)
  387. (dolist (flag flags)
  388. (setq arg
  389. (+ arg
  390. (pcase flag
  391. (:allow-replacement 1)
  392. (:replace-existing 2)
  393. (:do-not-queue 4)
  394. (_ (signal 'wrong-type-argument (list flag)))))))
  395. (setq reply (dbus-call-method
  396. bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
  397. "RequestName" service arg))
  398. (pcase reply
  399. (1 :primary-owner)
  400. (2 :in-queue)
  401. (3 :exists)
  402. (4 :already-owner)
  403. (_ (signal 'dbus-error (list "Could not register service" service))))))
  404. (defun dbus-unregister-service (bus service)
  405. "Unregister all objects related to SERVICE from D-Bus BUS.
  406. BUS is either a Lisp symbol, `:system' or `:session', or a string
  407. denoting the bus address. SERVICE must be a known service name.
  408. The function returns a keyword, indicating the result of the
  409. operation. One of the following keywords is returned:
  410. `:released': Service has become the primary owner of the name.
  411. `:non-existent': Service name does not exist on this bus.
  412. `:not-owner': We are neither the primary owner nor waiting in the
  413. queue of this service."
  414. (maphash
  415. (lambda (key value)
  416. (dolist (elt value)
  417. (ignore-errors
  418. (when (and (equal bus (cadr key)) (string-equal service (cadr elt)))
  419. (unless
  420. (puthash key (delete elt value) dbus-registered-objects-table)
  421. (remhash key dbus-registered-objects-table))))))
  422. dbus-registered-objects-table)
  423. (let ((reply (dbus-call-method
  424. bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
  425. "ReleaseName" service)))
  426. (pcase reply
  427. (1 :released)
  428. (2 :non-existent)
  429. (3 :not-owner)
  430. (_ (signal 'dbus-error (list "Could not unregister service" service))))))
  431. (defun dbus-register-signal
  432. (bus service path interface signal handler &rest args)
  433. "Register for a signal on the D-Bus BUS.
  434. BUS is either a Lisp symbol, `:system' or `:session', or a string
  435. denoting the bus address.
  436. SERVICE is the D-Bus service name used by the sending D-Bus object.
  437. It can be either a known name or the unique name of the D-Bus object
  438. sending the signal.
  439. PATH is the D-Bus object path SERVICE is registered. INTERFACE
  440. is an interface offered by SERVICE. It must provide SIGNAL.
  441. HANDLER is a Lisp function to be called when the signal is
  442. received. It must accept as arguments the values SIGNAL is
  443. sending.
  444. SERVICE, PATH, INTERFACE and SIGNAL can be nil. This is
  445. interpreted as a wildcard for the respective argument.
  446. The remaining arguments ARGS can be keywords or keyword string pairs.
  447. The meaning is as follows:
  448. `:argN' STRING:
  449. `:pathN' STRING: This stands for the Nth argument of the
  450. signal. `:pathN' arguments can be used for object path wildcard
  451. matches as specified by D-Bus, while an `:argN' argument
  452. requires an exact match.
  453. `:arg-namespace' STRING: Register for the signals, which first
  454. argument defines the service or interface namespace STRING.
  455. `:path-namespace' STRING: Register for the object path namespace
  456. STRING. All signals sent from an object path, which has STRING as
  457. the preceding string, are matched. This requires PATH to be nil.
  458. `:eavesdrop': Register for unicast signals which are not directed
  459. to the D-Bus object Emacs is registered at D-Bus BUS, if the
  460. security policy of BUS allows this.
  461. Example:
  462. \(defun my-signal-handler (device)
  463. (message \"Device %s added\" device))
  464. \(dbus-register-signal
  465. :system \"org.freedesktop.Hal\" \"/org/freedesktop/Hal/Manager\"
  466. \"org.freedesktop.Hal.Manager\" \"DeviceAdded\" 'my-signal-handler)
  467. => \(\(:signal :system \"org.freedesktop.Hal.Manager\" \"DeviceAdded\")
  468. \(\"org.freedesktop.Hal\" \"/org/freedesktop/Hal/Manager\" my-signal-handler))
  469. `dbus-register-signal' returns an object, which can be used in
  470. `dbus-unregister-object' for removing the registration."
  471. (let ((counter 0)
  472. (rule "type='signal'")
  473. uname key key1 value)
  474. ;; Retrieve unique name of service. If service is a known name,
  475. ;; we will register for the corresponding unique name, if any.
  476. ;; Signals are sent always with the unique name as sender. Note:
  477. ;; the unique name of `dbus-service-dbus' is that string itself.
  478. (if (and (stringp service)
  479. (not (zerop (length service)))
  480. (not (string-equal service dbus-service-dbus))
  481. (not (string-match "^:" service)))
  482. (setq uname (dbus-get-name-owner bus service))
  483. (setq uname service))
  484. (setq rule (concat rule
  485. (when uname (format ",sender='%s'" uname))
  486. (when interface (format ",interface='%s'" interface))
  487. (when signal (format ",member='%s'" signal))
  488. (when path (format ",path='%s'" path))))
  489. ;; Add arguments to the rule.
  490. (if (or (stringp (car args)) (null (car args)))
  491. ;; As backward compatibility option, we allow just strings.
  492. (dolist (arg args)
  493. (if (stringp arg)
  494. (setq rule (concat rule (format ",arg%d='%s'" counter arg)))
  495. (if arg (signal 'wrong-type-argument (list "Wrong argument" arg))))
  496. (setq counter (1+ counter)))
  497. ;; Parse keywords.
  498. (while args
  499. (setq
  500. key (car args)
  501. rule (concat
  502. rule
  503. (cond
  504. ;; `:arg0' .. `:arg63', `:path0' .. `:path63'.
  505. ((and (keywordp key)
  506. (string-match
  507. "^:\\(arg\\|path\\)\\([[:digit:]]+\\)$"
  508. (symbol-name key)))
  509. (setq counter (match-string 2 (symbol-name key))
  510. args (cdr args)
  511. value (car args))
  512. (unless (and (<= counter 63) (stringp value))
  513. (signal 'wrong-type-argument
  514. (list "Wrong argument" key value)))
  515. (format
  516. ",arg%s%s='%s'"
  517. counter
  518. (if (string-equal (match-string 1 (symbol-name key)) "path")
  519. "path" "")
  520. value))
  521. ;; `:arg-namespace', `:path-namespace'.
  522. ((and (keywordp key)
  523. (string-match
  524. "^:\\(arg\\|path\\)-namespace$" (symbol-name key)))
  525. (setq args (cdr args)
  526. value (car args))
  527. (unless (stringp value)
  528. (signal 'wrong-type-argument
  529. (list "Wrong argument" key value)))
  530. (format
  531. ",%s='%s'"
  532. (if (string-equal (match-string 1 (symbol-name key)) "path")
  533. "path_namespace" "arg0namespace")
  534. value))
  535. ;; `:eavesdrop'.
  536. ((eq key :eavesdrop)
  537. ",eavesdrop='true'")
  538. (t (signal 'wrong-type-argument (list "Wrong argument" key)))))
  539. args (cdr args))))
  540. ;; Add the rule to the bus.
  541. (condition-case err
  542. (dbus-call-method
  543. bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
  544. "AddMatch" rule)
  545. (dbus-error
  546. (if (not (string-match "eavesdrop" rule))
  547. (signal (car err) (cdr err))
  548. ;; The D-Bus spec says we shall fall back to a rule without eavesdrop.
  549. (when dbus-debug (message "Removing eavesdrop from rule %s" rule))
  550. (setq rule (replace-regexp-in-string ",eavesdrop='true'" "" rule))
  551. (dbus-call-method
  552. bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
  553. "AddMatch" rule))))
  554. (when dbus-debug (message "Matching rule \"%s\" created" rule))
  555. ;; Create a hash table entry.
  556. (setq key (list :signal bus interface signal)
  557. key1 (list uname service path handler rule)
  558. value (gethash key dbus-registered-objects-table))
  559. (unless (member key1 value)
  560. (puthash key (cons key1 value) dbus-registered-objects-table))
  561. ;; Return the object.
  562. (list key (list service path handler))))
  563. (defun dbus-register-method
  564. (bus service path interface method handler &optional dont-register-service)
  565. "Register for method METHOD on the D-Bus BUS.
  566. BUS is either a Lisp symbol, `:system' or `:session', or a string
  567. denoting the bus address.
  568. SERVICE is the D-Bus service name of the D-Bus object METHOD is
  569. registered for. It must be a known name (See discussion of
  570. DONT-REGISTER-SERVICE below).
  571. PATH is the D-Bus object path SERVICE is registered (See discussion of
  572. DONT-REGISTER-SERVICE below). INTERFACE is the interface offered by
  573. SERVICE. It must provide METHOD.
  574. HANDLER is a Lisp function to be called when a method call is
  575. received. It must accept the input arguments of METHOD. The return
  576. value of HANDLER is used for composing the returning D-Bus message.
  577. In case HANDLER shall return a reply message with an empty argument
  578. list, HANDLER must return the symbol `:ignore'.
  579. When DONT-REGISTER-SERVICE is non-nil, the known name SERVICE is not
  580. registered. This means that other D-Bus clients have no way of
  581. noticing the newly registered method. When interfaces are constructed
  582. incrementally by adding single methods or properties at a time,
  583. DONT-REGISTER-SERVICE can be used to prevent other clients from
  584. discovering the still incomplete interface."
  585. ;; Register SERVICE.
  586. (unless (or dont-register-service
  587. (member service (dbus-list-names bus)))
  588. (dbus-register-service bus service))
  589. ;; Create a hash table entry. We use nil for the unique name,
  590. ;; because the method might be called from anybody.
  591. (let* ((key (list :method bus interface method))
  592. (key1 (list nil service path handler))
  593. (value (gethash key dbus-registered-objects-table)))
  594. (unless (member key1 value)
  595. (puthash key (cons key1 value) dbus-registered-objects-table))
  596. ;; Return the object.
  597. (list key (list service path handler))))
  598. (defun dbus-unregister-object (object)
  599. "Unregister OBJECT from D-Bus.
  600. OBJECT must be the result of a preceding `dbus-register-method',
  601. `dbus-register-property' or `dbus-register-signal' call. It
  602. returns `t' if OBJECT has been unregistered, `nil' otherwise.
  603. When OBJECT identifies the last method or property, which is
  604. registered for the respective service, Emacs releases its
  605. association to the service from D-Bus."
  606. ;; Check parameter.
  607. (unless (and (consp object) (not (null (car object))) (consp (cdr object)))
  608. (signal 'wrong-type-argument (list 'D-Bus object)))
  609. ;; Find the corresponding entry in the hash table.
  610. (let* ((key (car object))
  611. (type (car key))
  612. (bus (cadr key))
  613. (value (cadr object))
  614. (service (car value))
  615. (entry (gethash key dbus-registered-objects-table))
  616. ret)
  617. ;; key has the structure (TYPE BUS INTERFACE MEMBER).
  618. ;; value has the structure (SERVICE PATH [HANDLER]).
  619. ;; entry has the structure ((UNAME SERVICE PATH MEMBER [RULE]) ...).
  620. ;; MEMBER is either a string (the handler), or a cons cell (a
  621. ;; property value). UNAME and property values are not taken into
  622. ;; account for comparison.
  623. ;; Loop over the registered functions.
  624. (dolist (elt entry)
  625. (when (equal
  626. value
  627. (butlast (cdr elt) (- (length (cdr elt)) (length value))))
  628. (setq ret t)
  629. ;; Compute new hash value. If it is empty, remove it from the
  630. ;; hash table.
  631. (unless (puthash key (delete elt entry) dbus-registered-objects-table)
  632. (remhash key dbus-registered-objects-table))
  633. ;; Remove match rule of signals.
  634. (when (eq type :signal)
  635. (dbus-call-method
  636. bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
  637. "RemoveMatch" (nth 4 elt)))))
  638. ;; Check, whether there is still a registered function or property
  639. ;; for the given service. If not, unregister the service from the
  640. ;; bus.
  641. (when (and service (memq type '(:method :property))
  642. (not (catch :found
  643. (progn
  644. (maphash
  645. (lambda (k v)
  646. (dolist (e v)
  647. (ignore-errors
  648. (and
  649. ;; Bus.
  650. (equal bus (cadr k))
  651. ;; Service.
  652. (string-equal service (cadr e))
  653. ;; Non-empty object path.
  654. (cl-caddr e)
  655. (throw :found t)))))
  656. dbus-registered-objects-table)
  657. nil))))
  658. (dbus-unregister-service bus service))
  659. ;; Return.
  660. ret))
  661. ;;; D-Bus type conversion.
  662. (defun dbus-string-to-byte-array (string)
  663. "Transforms STRING to list (:array :byte c1 :byte c2 ...).
  664. STRING shall be UTF8 coded."
  665. (if (zerop (length string))
  666. '(:array :signature "y")
  667. (let (result)
  668. (dolist (elt (string-to-list string) (append '(:array) result))
  669. (setq result (append result (list :byte elt)))))))
  670. (defun dbus-byte-array-to-string (byte-array)
  671. "Transforms BYTE-ARRAY into UTF8 coded string.
  672. BYTE-ARRAY must be a list of structure (c1 c2 ...)."
  673. (apply 'string byte-array))
  674. (defun dbus-escape-as-identifier (string)
  675. "Escape an arbitrary STRING so it follows the rules for a C identifier.
  676. The escaped string can be used as object path component, interface element
  677. component, bus name component or member name in D-Bus.
  678. The escaping consists of replacing all non-alphanumerics, and the
  679. first character if it's a digit, with an underscore and two
  680. lower-case hex digits:
  681. \"0123abc_xyz\\x01\\xff\" -> \"_30123abc_5fxyz_01_ff\"
  682. i.e. similar to URI encoding, but with \"_\" taking the role of \"%\",
  683. and a smaller allowed set. As a special case, \"\" is escaped to
  684. \"_\".
  685. Returns the escaped string. Algorithm taken from
  686. telepathy-glib's `tp-escape-as-identifier'."
  687. (if (zerop (length string))
  688. "_"
  689. (replace-regexp-in-string
  690. "^[0-9]\\|[^A-Za-z0-9]"
  691. (lambda (x) (format "_%2x" (aref x 0)))
  692. string)))
  693. (defun dbus-unescape-from-identifier (string)
  694. "Retrieve the original string from the encoded STRING.
  695. STRING must have been coded with `dbus-escape-as-identifier'"
  696. (if (string-equal string "_")
  697. ""
  698. (replace-regexp-in-string
  699. "_.."
  700. (lambda (x) (format "%c" (string-to-number (substring x 1) 16)))
  701. string)))
  702. ;;; D-Bus events.
  703. (defun dbus-check-event (event)
  704. "Checks whether EVENT is a well formed D-Bus event.
  705. EVENT is a list which starts with symbol `dbus-event':
  706. (dbus-event BUS TYPE SERIAL SERVICE PATH INTERFACE MEMBER HANDLER &rest ARGS)
  707. BUS identifies the D-Bus the message is coming from. It is
  708. either a Lisp symbol, `:system' or `:session', or a string
  709. denoting the bus address. TYPE is the D-Bus message type which
  710. has caused the event, SERIAL is the serial number of the received
  711. D-Bus message. SERVICE and PATH are the unique name and the
  712. object path of the D-Bus object emitting the message. INTERFACE
  713. and MEMBER denote the message which has been sent. HANDLER is
  714. the function which has been registered for this message. ARGS
  715. are the arguments passed to HANDLER, when it is called during
  716. event handling in `dbus-handle-event'.
  717. This function raises a `dbus-error' signal in case the event is
  718. not well formed."
  719. (when dbus-debug (message "DBus-Event %s" event))
  720. (unless (and (listp event)
  721. (eq (car event) 'dbus-event)
  722. ;; Bus symbol.
  723. (or (symbolp (nth 1 event))
  724. (stringp (nth 1 event)))
  725. ;; Type.
  726. (and (natnump (nth 2 event))
  727. (< dbus-message-type-invalid (nth 2 event)))
  728. ;; Serial.
  729. (natnump (nth 3 event))
  730. ;; Service.
  731. (or (= dbus-message-type-method-return (nth 2 event))
  732. (= dbus-message-type-error (nth 2 event))
  733. (stringp (nth 4 event)))
  734. ;; Object path.
  735. (or (= dbus-message-type-method-return (nth 2 event))
  736. (= dbus-message-type-error (nth 2 event))
  737. (stringp (nth 5 event)))
  738. ;; Interface.
  739. (or (= dbus-message-type-method-return (nth 2 event))
  740. (= dbus-message-type-error (nth 2 event))
  741. (stringp (nth 6 event)))
  742. ;; Member.
  743. (or (= dbus-message-type-method-return (nth 2 event))
  744. (= dbus-message-type-error (nth 2 event))
  745. (stringp (nth 7 event)))
  746. ;; Handler.
  747. (functionp (nth 8 event)))
  748. (signal 'dbus-error (list "Not a valid D-Bus event" event))))
  749. ;;;###autoload
  750. (defun dbus-handle-event (event)
  751. "Handle events from the D-Bus.
  752. EVENT is a D-Bus event, see `dbus-check-event'. HANDLER, being
  753. part of the event, is called with arguments ARGS.
  754. If the HANDLER returns a `dbus-error', it is propagated as return message."
  755. (interactive "e")
  756. (condition-case err
  757. (let (result)
  758. ;; We ignore not well-formed events.
  759. (dbus-check-event event)
  760. ;; Error messages must be propagated.
  761. (when (= dbus-message-type-error (nth 2 event))
  762. (signal 'dbus-error (nthcdr 9 event)))
  763. ;; Apply the handler.
  764. (setq result (apply (nth 8 event) (nthcdr 9 event)))
  765. ;; Return a message when it is a message call.
  766. (when (= dbus-message-type-method-call (nth 2 event))
  767. (dbus-ignore-errors
  768. (if (eq result :ignore)
  769. (dbus-method-return-internal
  770. (nth 1 event) (nth 4 event) (nth 3 event))
  771. (apply 'dbus-method-return-internal
  772. (nth 1 event) (nth 4 event) (nth 3 event)
  773. (if (consp result) result (list result)))))))
  774. ;; Error handling.
  775. (dbus-error
  776. ;; Return an error message when it is a message call.
  777. (when (= dbus-message-type-method-call (nth 2 event))
  778. (dbus-ignore-errors
  779. (dbus-method-error-internal
  780. (nth 1 event) (nth 4 event) (nth 3 event) (cadr err))))
  781. ;; Propagate D-Bus error messages.
  782. (run-hook-with-args 'dbus-event-error-functions event err)
  783. (when (or dbus-debug (= dbus-message-type-error (nth 2 event)))
  784. (signal (car err) (cdr err))))))
  785. (defun dbus-event-bus-name (event)
  786. "Return the bus name the event is coming from.
  787. The result is either a Lisp symbol, `:system' or `:session', or a
  788. string denoting the bus address. EVENT is a D-Bus event, see
  789. `dbus-check-event'. This function raises a `dbus-error' signal
  790. in case the event is not well formed."
  791. (dbus-check-event event)
  792. (nth 1 event))
  793. (defun dbus-event-message-type (event)
  794. "Return the message type of the corresponding D-Bus message.
  795. The result is a number. EVENT is a D-Bus event, see
  796. `dbus-check-event'. This function raises a `dbus-error' signal
  797. in case the event is not well formed."
  798. (dbus-check-event event)
  799. (nth 2 event))
  800. (defun dbus-event-serial-number (event)
  801. "Return the serial number of the corresponding D-Bus message.
  802. The result is a number. The serial number is needed for
  803. generating a reply message. EVENT is a D-Bus event, see
  804. `dbus-check-event'. This function raises a `dbus-error' signal
  805. in case the event is not well formed."
  806. (dbus-check-event event)
  807. (nth 3 event))
  808. (defun dbus-event-service-name (event)
  809. "Return the name of the D-Bus object the event is coming from.
  810. The result is a string. EVENT is a D-Bus event, see `dbus-check-event'.
  811. This function raises a `dbus-error' signal in case the event is
  812. not well formed."
  813. (dbus-check-event event)
  814. (nth 4 event))
  815. (defun dbus-event-path-name (event)
  816. "Return the object path of the D-Bus object the event is coming from.
  817. The result is a string. EVENT is a D-Bus event, see `dbus-check-event'.
  818. This function raises a `dbus-error' signal in case the event is
  819. not well formed."
  820. (dbus-check-event event)
  821. (nth 5 event))
  822. (defun dbus-event-interface-name (event)
  823. "Return the interface name of the D-Bus object the event is coming from.
  824. The result is a string. EVENT is a D-Bus event, see `dbus-check-event'.
  825. This function raises a `dbus-error' signal in case the event is
  826. not well formed."
  827. (dbus-check-event event)
  828. (nth 6 event))
  829. (defun dbus-event-member-name (event)
  830. "Return the member name the event is coming from.
  831. It is either a signal name or a method name. The result is a
  832. string. EVENT is a D-Bus event, see `dbus-check-event'. This
  833. function raises a `dbus-error' signal in case the event is not
  834. well formed."
  835. (dbus-check-event event)
  836. (nth 7 event))
  837. ;;; D-Bus registered names.
  838. (defun dbus-list-activatable-names (&optional bus)
  839. "Return the D-Bus service names which can be activated as list.
  840. If BUS is left nil, `:system' is assumed. The result is a list
  841. of strings, which is `nil' when there are no activatable service
  842. names at all."
  843. (dbus-ignore-errors
  844. (dbus-call-method
  845. (or bus :system) dbus-service-dbus
  846. dbus-path-dbus dbus-interface-dbus "ListActivatableNames")))
  847. (defun dbus-list-names (bus)
  848. "Return the service names registered at D-Bus BUS.
  849. The result is a list of strings, which is `nil' when there are no
  850. registered service names at all. Well known names are strings
  851. like \"org.freedesktop.DBus\". Names starting with \":\" are
  852. unique names for services."
  853. (dbus-ignore-errors
  854. (dbus-call-method
  855. bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus "ListNames")))
  856. (defun dbus-list-known-names (bus)
  857. "Retrieve all services which correspond to a known name in BUS.
  858. A service has a known name if it doesn't start with \":\"."
  859. (let (result)
  860. (dolist (name (dbus-list-names bus) result)
  861. (unless (string-equal ":" (substring name 0 1))
  862. (add-to-list 'result name 'append)))))
  863. (defun dbus-list-queued-owners (bus service)
  864. "Return the unique names registered at D-Bus BUS and queued for SERVICE.
  865. The result is a list of strings, or `nil' when there are no
  866. queued name owners service names at all."
  867. (dbus-ignore-errors
  868. (dbus-call-method
  869. bus dbus-service-dbus dbus-path-dbus
  870. dbus-interface-dbus "ListQueuedOwners" service)))
  871. (defun dbus-get-name-owner (bus service)
  872. "Return the name owner of SERVICE registered at D-Bus BUS.
  873. The result is either a string, or `nil' if there is no name owner."
  874. (dbus-ignore-errors
  875. (dbus-call-method
  876. bus dbus-service-dbus dbus-path-dbus
  877. dbus-interface-dbus "GetNameOwner" service)))
  878. (defun dbus-ping (bus service &optional timeout)
  879. "Check whether SERVICE is registered for D-Bus BUS.
  880. TIMEOUT, a nonnegative integer, specifies the maximum number of
  881. milliseconds `dbus-ping' must return. The default value is 25,000.
  882. Note, that this autoloads SERVICE if it is not running yet. If
  883. it shall be checked whether SERVICE is already running, one shall
  884. apply
  885. \(member service \(dbus-list-known-names bus))"
  886. ;; "Ping" raises a D-Bus error if SERVICE does not exist.
  887. ;; Otherwise, it returns silently with `nil'.
  888. (condition-case nil
  889. (not
  890. (if (natnump timeout)
  891. (dbus-call-method
  892. bus service dbus-path-dbus dbus-interface-peer
  893. "Ping" :timeout timeout)
  894. (dbus-call-method
  895. bus service dbus-path-dbus dbus-interface-peer "Ping")))
  896. (dbus-error nil)))
  897. ;;; D-Bus introspection.
  898. (defun dbus-introspect (bus service path)
  899. "Return all interfaces and sub-nodes of SERVICE,
  900. registered at object path PATH at bus BUS.
  901. BUS is either a Lisp symbol, `:system' or `:session', or a string
  902. denoting the bus address. SERVICE must be a known service name,
  903. and PATH must be a valid object path. The last two parameters
  904. are strings. The result, the introspection data, is a string in
  905. XML format."
  906. ;; We don't want to raise errors.
  907. (dbus-ignore-errors
  908. (dbus-call-method
  909. bus service path dbus-interface-introspectable "Introspect"
  910. :timeout 1000)))
  911. (defun dbus-introspect-xml (bus service path)
  912. "Return the introspection data of SERVICE in D-Bus BUS at object path PATH.
  913. The data are a parsed list. The root object is a \"node\",
  914. representing the object path PATH. The root object can contain
  915. \"interface\" and further \"node\" objects."
  916. ;; We don't want to raise errors.
  917. (xml-node-name
  918. (ignore-errors
  919. (with-temp-buffer
  920. (insert (dbus-introspect bus service path))
  921. (xml-parse-region (point-min) (point-max))))))
  922. (defun dbus-introspect-get-attribute (object attribute)
  923. "Return the ATTRIBUTE value of D-Bus introspection OBJECT.
  924. ATTRIBUTE must be a string according to the attribute names in
  925. the D-Bus specification."
  926. (xml-get-attribute-or-nil object (intern attribute)))
  927. (defun dbus-introspect-get-node-names (bus service path)
  928. "Return all node names of SERVICE in D-Bus BUS at object path PATH.
  929. It returns a list of strings. The node names stand for further
  930. object paths of the D-Bus service."
  931. (let ((object (dbus-introspect-xml bus service path))
  932. result)
  933. (dolist (elt (xml-get-children object 'node) result)
  934. (add-to-list
  935. 'result (dbus-introspect-get-attribute elt "name") 'append))))
  936. (defun dbus-introspect-get-all-nodes (bus service path)
  937. "Return all node names of SERVICE in D-Bus BUS at object path PATH.
  938. It returns a list of strings, which are further object paths of SERVICE."
  939. (let ((result (list path)))
  940. (dolist (elt
  941. (dbus-introspect-get-node-names bus service path)
  942. result)
  943. (setq elt (expand-file-name elt path))
  944. (setq result
  945. (append result (dbus-introspect-get-all-nodes bus service elt))))))
  946. (defun dbus-introspect-get-interface-names (bus service path)
  947. "Return all interface names of SERVICE in D-Bus BUS at object path PATH.
  948. It returns a list of strings.
  949. There will be always the default interface
  950. \"org.freedesktop.DBus.Introspectable\". Another default
  951. interface is \"org.freedesktop.DBus.Properties\". If present,
  952. \"interface\" objects can also have \"property\" objects as
  953. children, beside \"method\" and \"signal\" objects."
  954. (let ((object (dbus-introspect-xml bus service path))
  955. result)
  956. (dolist (elt (xml-get-children object 'interface) result)
  957. (add-to-list
  958. 'result (dbus-introspect-get-attribute elt "name") 'append))))
  959. (defun dbus-introspect-get-interface (bus service path interface)
  960. "Return the INTERFACE of SERVICE in D-Bus BUS at object path PATH.
  961. The return value is an XML object. INTERFACE must be a string,
  962. element of the list returned by `dbus-introspect-get-interface-names'.
  963. The resulting \"interface\" object can contain \"method\", \"signal\",
  964. \"property\" and \"annotation\" children."
  965. (let ((elt (xml-get-children
  966. (dbus-introspect-xml bus service path) 'interface)))
  967. (while (and elt
  968. (not (string-equal
  969. interface
  970. (dbus-introspect-get-attribute (car elt) "name"))))
  971. (setq elt (cdr elt)))
  972. (car elt)))
  973. (defun dbus-introspect-get-method-names (bus service path interface)
  974. "Return a list of strings of all method names of INTERFACE.
  975. SERVICE is a service of D-Bus BUS at object path PATH."
  976. (let ((object (dbus-introspect-get-interface bus service path interface))
  977. result)
  978. (dolist (elt (xml-get-children object 'method) result)
  979. (add-to-list
  980. 'result (dbus-introspect-get-attribute elt "name") 'append))))
  981. (defun dbus-introspect-get-method (bus service path interface method)
  982. "Return method METHOD of interface INTERFACE as XML object.
  983. It must be located at SERVICE in D-Bus BUS at object path PATH.
  984. METHOD must be a string, element of the list returned by
  985. `dbus-introspect-get-method-names'. The resulting \"method\"
  986. object can contain \"arg\" and \"annotation\" children."
  987. (let ((elt (xml-get-children
  988. (dbus-introspect-get-interface bus service path interface)
  989. 'method)))
  990. (while (and elt
  991. (not (string-equal
  992. method (dbus-introspect-get-attribute (car elt) "name"))))
  993. (setq elt (cdr elt)))
  994. (car elt)))
  995. (defun dbus-introspect-get-signal-names (bus service path interface)
  996. "Return a list of strings of all signal names of INTERFACE.
  997. SERVICE is a service of D-Bus BUS at object path PATH."
  998. (let ((object (dbus-introspect-get-interface bus service path interface))
  999. result)
  1000. (dolist (elt (xml-get-children object 'signal) result)
  1001. (add-to-list
  1002. 'result (dbus-introspect-get-attribute elt "name") 'append))))
  1003. (defun dbus-introspect-get-signal (bus service path interface signal)
  1004. "Return signal SIGNAL of interface INTERFACE as XML object.
  1005. It must be located at SERVICE in D-Bus BUS at object path PATH.
  1006. SIGNAL must be a string, element of the list returned by
  1007. `dbus-introspect-get-signal-names'. The resulting \"signal\"
  1008. object can contain \"arg\" and \"annotation\" children."
  1009. (let ((elt (xml-get-children
  1010. (dbus-introspect-get-interface bus service path interface)
  1011. 'signal)))
  1012. (while (and elt
  1013. (not (string-equal
  1014. signal (dbus-introspect-get-attribute (car elt) "name"))))
  1015. (setq elt (cdr elt)))
  1016. (car elt)))
  1017. (defun dbus-introspect-get-property-names (bus service path interface)
  1018. "Return a list of strings of all property names of INTERFACE.
  1019. SERVICE is a service of D-Bus BUS at object path PATH."
  1020. (let ((object (dbus-introspect-get-interface bus service path interface))
  1021. result)
  1022. (dolist (elt (xml-get-children object 'property) result)
  1023. (add-to-list
  1024. 'result (dbus-introspect-get-attribute elt "name") 'append))))
  1025. (defun dbus-introspect-get-property (bus service path interface property)
  1026. "This function returns PROPERTY of INTERFACE as XML object.
  1027. It must be located at SERVICE in D-Bus BUS at object path PATH.
  1028. PROPERTY must be a string, element of the list returned by
  1029. `dbus-introspect-get-property-names'. The resulting PROPERTY
  1030. object can contain \"annotation\" children."
  1031. (let ((elt (xml-get-children
  1032. (dbus-introspect-get-interface bus service path interface)
  1033. 'property)))
  1034. (while (and elt
  1035. (not (string-equal
  1036. property
  1037. (dbus-introspect-get-attribute (car elt) "name"))))
  1038. (setq elt (cdr elt)))
  1039. (car elt)))
  1040. (defun dbus-introspect-get-annotation-names
  1041. (bus service path interface &optional name)
  1042. "Return all annotation names as list of strings.
  1043. If NAME is `nil', the annotations are children of INTERFACE,
  1044. otherwise NAME must be a \"method\", \"signal\", or \"property\"
  1045. object, where the annotations belong to."
  1046. (let ((object
  1047. (if name
  1048. (or (dbus-introspect-get-method bus service path interface name)
  1049. (dbus-introspect-get-signal bus service path interface name)
  1050. (dbus-introspect-get-property bus service path interface name))
  1051. (dbus-introspect-get-interface bus service path interface)))
  1052. result)
  1053. (dolist (elt (xml-get-children object 'annotation) result)
  1054. (add-to-list
  1055. 'result (dbus-introspect-get-attribute elt "name") 'append))))
  1056. (defun dbus-introspect-get-annotation
  1057. (bus service path interface name annotation)
  1058. "Return ANNOTATION as XML object.
  1059. If NAME is `nil', ANNOTATION is a child of INTERFACE, otherwise
  1060. NAME must be the name of a \"method\", \"signal\", or
  1061. \"property\" object, where the ANNOTATION belongs to."
  1062. (let ((elt (xml-get-children
  1063. (if name
  1064. (or (dbus-introspect-get-method
  1065. bus service path interface name)
  1066. (dbus-introspect-get-signal
  1067. bus service path interface name)
  1068. (dbus-introspect-get-property
  1069. bus service path interface name))
  1070. (dbus-introspect-get-interface bus service path interface))
  1071. 'annotation)))
  1072. (while (and elt
  1073. (not (string-equal
  1074. annotation
  1075. (dbus-introspect-get-attribute (car elt) "name"))))
  1076. (setq elt (cdr elt)))
  1077. (car elt)))
  1078. (defun dbus-introspect-get-argument-names (bus service path interface name)
  1079. "Return a list of all argument names as list of strings.
  1080. NAME must be a \"method\" or \"signal\" object.
  1081. Argument names are optional, the function can return `nil'
  1082. therefore, even if the method or signal has arguments."
  1083. (let ((object
  1084. (or (dbus-introspect-get-method bus service path interface name)
  1085. (dbus-introspect-get-signal bus service path interface name)))
  1086. result)
  1087. (dolist (elt (xml-get-children object 'arg) result)
  1088. (add-to-list
  1089. 'result (dbus-introspect-get-attribute elt "name") 'append))))
  1090. (defun dbus-introspect-get-argument (bus service path interface name arg)
  1091. "Return argument ARG as XML object.
  1092. NAME must be a \"method\" or \"signal\" object. ARG must be a string,
  1093. element of the list returned by `dbus-introspect-get-argument-names'."
  1094. (let ((elt (xml-get-children
  1095. (or (dbus-introspect-get-method bus service path interface name)
  1096. (dbus-introspect-get-signal bus service path interface name))
  1097. 'arg)))
  1098. (while (and elt
  1099. (not (string-equal
  1100. arg (dbus-introspect-get-attribute (car elt) "name"))))
  1101. (setq elt (cdr elt)))
  1102. (car elt)))
  1103. (defun dbus-introspect-get-signature
  1104. (bus service path interface name &optional direction)
  1105. "Return signature of a `method' or `signal', represented by NAME, as string.
  1106. If NAME is a `method', DIRECTION can be either \"in\" or \"out\".
  1107. If DIRECTION is `nil', \"in\" is assumed.
  1108. If NAME is a `signal', and DIRECTION is non-`nil', DIRECTION must
  1109. be \"out\"."
  1110. ;; For methods, we use "in" as default direction.
  1111. (let ((object (or (dbus-introspect-get-method
  1112. bus service path interface name)
  1113. (dbus-introspect-get-signal
  1114. bus service path interface name))))
  1115. (when (and (string-equal
  1116. "method" (dbus-introspect-ge

Large files files are truncated, but you can click here to view the full file