Commit | Line | Data |
---|---|---|
3a993e3d MA |
1 | ;;; -*- no-byte-compile: t; -*- |
2 | ;;; dbus.el --- Elisp bindings for D-Bus. | |
3 | ||
4 | ;; Copyright (C) 2007 Free Software Foundation, Inc. | |
5 | ||
6 | ;; Author: Michael Albinus <michael.albinus@gmx.de> | |
7 | ;; Keywords: comm, hardware | |
8 | ||
9 | ;; This file is part of GNU Emacs. | |
10 | ||
11 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
12 | ;; it under the terms of the GNU General Public License as published by | |
13 | ;; the Free Software Foundation; either version 3, or (at your option) | |
14 | ;; any later version. | |
15 | ||
16 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 | ;; GNU General Public License for more details. | |
20 | ||
21 | ;; You should have received a copy of the GNU General Public License | |
22 | ;; along with GNU Emacs; see the file COPYING. If not, see | |
23 | ;; <http://www.gnu.org/licenses/>. | |
24 | ||
25 | ;;; Commentary: | |
26 | ||
27 | ;; This package provides language bindings for the D-Bus API. D-Bus | |
28 | ;; is a message bus system, a simple way for applications to talk to | |
29 | ;; one another. See <http://dbus.freedesktop.org/> for details. | |
30 | ||
31 | ;; Low-level language bindings are implemented in src/dbusbind.c. | |
32 | ||
33 | ;;; Code: | |
34 | ||
35 | (require 'xml) | |
36 | ||
37 | (defconst dbus-service-dbus "org.freedesktop.DBus" | |
38 | "The bus name used to talk to the bus itself.") | |
39 | ||
40 | (defconst dbus-path-dbus "/org/freedesktop/DBus" | |
41 | "The object path used to talk to the bus itself.") | |
42 | ||
43 | (defconst dbus-interface-dbus "org.freedesktop.DBus" | |
44 | "The interface exported by the object with `dbus-service-dbus' and `dbus-path-dbus'.") | |
45 | ||
46 | (defconst dbus-interface-introspectable "org.freedesktop.DBus.Introspectable" | |
47 | "The interface supported by introspectable objects.") | |
48 | ||
5363d8ea MA |
49 | \f |
50 | ;;; Hash table of registered functions. | |
51 | ||
52 | (defun dbus-hash-table= (x y) | |
53 | "Compares keys X and Y in the hash table of registered functions for D-Bus. | |
54 | See `dbus-registered-functions-table' for a description of the hash table." | |
55 | (and | |
5363d8ea | 56 | ;; Bus symbol, either :system or :session. |
ef6ce14c MA |
57 | (equal (car x) (car y)) |
58 | ;; Service. | |
59 | (or | |
60 | (null (nth 1 x)) (null (nth 1 y)) ; wildcard | |
61 | (string-equal (nth 1 x) (nth 1 y))) | |
62 | ;; Path. | |
7b760f0a | 63 | (or |
ef6ce14c MA |
64 | (null (nth 2 x)) (null (nth 2 y)) ; wildcard |
65 | (string-equal (nth 2 x) (nth 2 y))) | |
5363d8ea | 66 | ;; Member. |
7b760f0a | 67 | (or |
ef6ce14c MA |
68 | (null (nth 3 x)) (null (nth 3 y)) ; wildcard |
69 | (string-equal (nth 3 x) (nth 3 y))) | |
70 | ;; Interface. | |
71 | (or | |
72 | (null (nth 4 x)) (null (nth 4 y)) ; wildcard | |
73 | (string-equal (nth 4 x) (nth 4 y))))) | |
5363d8ea | 74 | |
7b760f0a | 75 | (define-hash-table-test 'dbus-hash-table-test 'dbus-hash-table= 'sxhash) |
5363d8ea | 76 | |
ef6ce14c MA |
77 | ;; When we assume that service, path, interface and and member are |
78 | ;; always strings in the key, we could use `equal' as test function. | |
79 | ;; But we want to have also `nil' there, being a wildcard. | |
5363d8ea MA |
80 | (setq dbus-registered-functions-table |
81 | (make-hash-table :test 'dbus-hash-table-test)) | |
82 | ||
ef6ce14c MA |
83 | (defun dbus-list-hash-table () |
84 | "Returns all registered signal registrations to D-Bus. | |
85 | The return value is a list, with elements of kind (KEY . VALUE). | |
86 | See `dbus-registered-functions-table' for a description of the | |
87 | hash table." | |
88 | (let (result) | |
89 | (maphash | |
90 | '(lambda (key value) (add-to-list 'result (cons key value) 'append)) | |
91 | dbus-registered-functions-table) | |
92 | result)) | |
93 | ||
94 | (defun dbus-name-owner-changed-handler (service old-owner new-owner) | |
95 | "Reapplies all signal registrations to D-Bus. | |
96 | This handler is applied when a \"NameOwnerChanged\" signal has | |
97 | arrived. SERVICE is the object name for which the name owner has | |
98 | been changed. OLD-OWNER is the previous owner of SERVICE, or the | |
99 | empty string if SERVICE was not owned yet. NEW-OWNER is the new | |
100 | owner of SERVICE, or the empty string if SERVICE looses any name owner." | |
101 | (save-match-data | |
102 | ;; Check whether SERVICE is a known name, and OLD-OWNER and | |
103 | ;; NEW-OWNER are defined. | |
104 | (when (and (stringp service) (not (string-match "^:" service)) | |
105 | (not (zerop (length old-owner))) | |
106 | (not (zerop (length new-owner)))) | |
107 | (let ((bus (dbus-event-bus-name last-input-event))) | |
108 | (maphash | |
109 | '(lambda (key value) | |
110 | ;; Check for matching bus and service name. | |
111 | (when (and (equal bus (car key)) | |
112 | (string-equal old-owner (nth 1 key))) | |
113 | ;; Remove old key, and add new entry with changed name. | |
114 | (when dbus-debug (message "Remove rule for %s" key)) | |
115 | (dbus-unregister-signal key) | |
116 | (setcar (nthcdr 1 key) new-owner) | |
117 | (when dbus-debug (message "Add rule for %s" key)) | |
118 | (apply 'dbus-register-signal (append key (list value))))) | |
119 | (copy-hash-table dbus-registered-functions-table)))))) | |
120 | ||
121 | ;; Register the handler. | |
122 | (condition-case nil | |
123 | (progn | |
124 | (dbus-register-signal | |
125 | :system dbus-service-dbus dbus-path-dbus dbus-interface-dbus | |
126 | "NameOwnerChanged" 'dbus-name-owner-changed-handler) | |
127 | (dbus-register-signal | |
128 | :session dbus-service-dbus dbus-path-dbus dbus-interface-dbus | |
129 | "NameOwnerChanged" 'dbus-name-owner-changed-handler)) | |
130 | (dbus-error)) | |
131 | ||
5363d8ea MA |
132 | \f |
133 | ;;; D-Bus events. | |
134 | ||
3a993e3d MA |
135 | (defun dbus-check-event (event) |
136 | "Checks whether EVENT is a well formed D-Bus event. | |
137 | EVENT is a list which starts with symbol `dbus-event': | |
138 | ||
ef6ce14c | 139 | (dbus-event BUS SERVICE PATH INTERFACE MEMBER HANDLER &rest ARGS) |
3a993e3d | 140 | |
ef6ce14c MA |
141 | BUS identifies the D-Bus the signal is coming from. It is either |
142 | the symbol `:system' or the symbol `:session'. SERVICE and PATH | |
143 | are the unique name and the object path of the D-Bus object | |
5363d8ea | 144 | emitting the signal. INTERFACE and MEMBER denote the signal |
ef6ce14c MA |
145 | which has been sent. HANDLER is the function which has been |
146 | registered for this signal. ARGS are the arguments passed to | |
147 | HANDLER, when it is called during event handling in | |
148 | `dbus-handle-event'. | |
3a993e3d MA |
149 | |
150 | This function raises a `dbus-error' signal in case the event is | |
151 | not well formed." | |
152 | (when dbus-debug (message "DBus-Event %s" event)) | |
153 | (unless (and (listp event) | |
154 | (eq (car event) 'dbus-event) | |
5363d8ea | 155 | ;; Bus symbol. |
ef6ce14c | 156 | (symbolp (nth 1 event)) |
5363d8ea | 157 | ;; Service. |
ef6ce14c | 158 | (stringp (nth 2 event)) |
5363d8ea | 159 | ;; Object path. |
ef6ce14c | 160 | (stringp (nth 3 event)) |
5363d8ea | 161 | ;; Interface. |
ef6ce14c | 162 | (stringp (nth 4 event)) |
5363d8ea | 163 | ;; Member. |
ef6ce14c MA |
164 | (stringp (nth 5 event)) |
165 | ;; Handler. | |
166 | (functionp (nth 6 event))) | |
3a993e3d MA |
167 | (signal 'dbus-error (list "Not a valid D-Bus event" event)))) |
168 | ||
169 | ;;;###autoload | |
170 | (defun dbus-handle-event (event) | |
171 | "Handle events from the D-Bus. | |
5363d8ea MA |
172 | EVENT is a D-Bus event, see `dbus-check-event'. HANDLER, being |
173 | part of the event, is called with arguments ARGS." | |
3a993e3d | 174 | (interactive "e") |
5363d8ea MA |
175 | ;; We don't want to raise an error, because this function is called |
176 | ;; in the event handling loop. | |
177 | (condition-case nil | |
178 | (progn | |
179 | (dbus-check-event event) | |
ef6ce14c | 180 | (apply (nth 6 event) (nthcdr 7 event))) |
5363d8ea | 181 | (dbus-error))) |
3a993e3d MA |
182 | |
183 | (defun dbus-event-bus-name (event) | |
184 | "Return the bus name the event is coming from. | |
185 | The result is either the symbol `:system' or the symbol `:session'. | |
186 | EVENT is a D-Bus event, see `dbus-check-event'. This function | |
187 | raises a `dbus-error' signal in case the event is not well | |
188 | formed." | |
189 | (dbus-check-event event) | |
ef6ce14c | 190 | (nth 1 event)) |
3a993e3d MA |
191 | |
192 | (defun dbus-event-service-name (event) | |
5363d8ea | 193 | "Return the name of the D-Bus object the event is coming from. |
3a993e3d MA |
194 | The result is a string. EVENT is a D-Bus event, see `dbus-check-event'. |
195 | This function raises a `dbus-error' signal in case the event is | |
196 | not well formed." | |
197 | (dbus-check-event event) | |
ef6ce14c | 198 | (nth 2 event)) |
3a993e3d MA |
199 | |
200 | (defun dbus-event-path-name (event) | |
201 | "Return the object path of the D-Bus object the event is coming from. | |
202 | The result is a string. EVENT is a D-Bus event, see `dbus-check-event'. | |
203 | This function raises a `dbus-error' signal in case the event is | |
204 | not well formed." | |
205 | (dbus-check-event event) | |
ef6ce14c | 206 | (nth 3 event)) |
3a993e3d MA |
207 | |
208 | (defun dbus-event-interface-name (event) | |
209 | "Return the interface name of the D-Bus object the event is coming from. | |
210 | The result is a string. EVENT is a D-Bus event, see `dbus-check-event'. | |
211 | This function raises a `dbus-error' signal in case the event is | |
212 | not well formed." | |
213 | (dbus-check-event event) | |
ef6ce14c | 214 | (nth 4 event)) |
3a993e3d MA |
215 | |
216 | (defun dbus-event-member-name (event) | |
217 | "Return the member name the event is coming from. | |
218 | It is either a signal name or a method name. The result is is a | |
219 | string. EVENT is a D-Bus event, see `dbus-check-event'. This | |
220 | function raises a `dbus-error' signal in case the event is not | |
221 | well formed." | |
222 | (dbus-check-event event) | |
ef6ce14c | 223 | (nth 5 event)) |
5363d8ea MA |
224 | |
225 | \f | |
226 | ;;; D-Bus registered names. | |
3a993e3d MA |
227 | |
228 | (defun dbus-list-activatable-names () | |
229 | "Return the D-Bus service names which can be activated as list. | |
230 | The result is a list of strings, which is nil when there are no | |
231 | activatable service names at all." | |
232 | (condition-case nil | |
233 | (dbus-call-method | |
ef6ce14c MA |
234 | :system dbus-service-dbus |
235 | dbus-path-dbus dbus-interface-dbus "ListActivatableNames") | |
3a993e3d MA |
236 | (dbus-error))) |
237 | ||
238 | (defun dbus-list-names (bus) | |
239 | "Return the service names registered at D-Bus BUS. | |
240 | The result is a list of strings, which is nil when there are no | |
241 | registered service names at all. Well known names are strings like | |
242 | \"org.freedesktop.DBus\". Names starting with \":\" are unique names | |
243 | for services." | |
244 | (condition-case nil | |
245 | (dbus-call-method | |
ef6ce14c | 246 | bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus "ListNames") |
3a993e3d MA |
247 | (dbus-error))) |
248 | ||
249 | (defun dbus-list-known-names (bus) | |
250 | "Retrieve all services which correspond to a known name in BUS. | |
251 | A service has a known name if it doesn't start with \":\"." | |
252 | (let (result) | |
253 | (dolist (name (dbus-list-names bus) result) | |
254 | (unless (string-equal ":" (substring name 0 1)) | |
255 | (add-to-list 'result name 'append))))) | |
256 | ||
257 | (defun dbus-list-queued-owners (bus service) | |
258 | "Return the unique names registered at D-Bus BUS and queued for SERVICE. | |
259 | The result is a list of strings, or nil when there are no queued name | |
260 | owners service names at all." | |
261 | (condition-case nil | |
262 | (dbus-call-method | |
ef6ce14c MA |
263 | bus dbus-service-dbus dbus-path-dbus |
264 | dbus-interface-dbus "ListQueuedOwners" service) | |
3a993e3d MA |
265 | (dbus-error))) |
266 | ||
267 | (defun dbus-get-name-owner (bus service) | |
268 | "Return the name owner of SERVICE registered at D-Bus BUS. | |
269 | The result is either a string, or nil if there is no name owner." | |
270 | (condition-case nil | |
271 | (dbus-call-method | |
ef6ce14c MA |
272 | bus dbus-service-dbus dbus-path-dbus |
273 | dbus-interface-dbus "GetNameOwner" service) | |
3a993e3d MA |
274 | (dbus-error))) |
275 | ||
276 | (defun dbus-introspect (bus service path) | |
277 | "Return the introspection data of SERVICE in D-Bus BUS at object path PATH. | |
278 | The data are in XML format. | |
279 | ||
280 | Example: | |
281 | ||
282 | \(dbus-introspect | |
283 | :system \"org.freedesktop.Hal\" | |
ef6ce14c | 284 | \"/org/freedesktop/Hal/devices/computer\")" |
3a993e3d MA |
285 | (condition-case nil |
286 | (dbus-call-method | |
ef6ce14c | 287 | bus service path dbus-interface-introspectable "Introspect") |
3a993e3d MA |
288 | (dbus-error))) |
289 | ||
290 | (if nil ;; Must be reworked. Shall we offer D-Bus signatures at all? | |
291 | (defun dbus-get-signatures (bus interface signal) | |
292 | "Retrieve SIGNAL's type signatures from D-Bus. | |
293 | The result is a list of SIGNAL's type signatures. Example: | |
294 | ||
295 | \(\"s\" \"b\" \"ai\"\) | |
296 | ||
297 | This list represents 3 parameters of SIGNAL. The first parameter | |
298 | is of type string, the second parameter is of type boolean, and | |
299 | the third parameter is of type array of integer. | |
300 | ||
301 | If INTERFACE or SIGNAL do not exist, or if they do not support | |
302 | the D-Bus method org.freedesktop.DBus.Introspectable.Introspect, | |
303 | the function returns nil." | |
304 | (condition-case nil | |
305 | (let ((introspect-xml | |
306 | (with-temp-buffer | |
307 | (insert (dbus-introspect bus interface)) | |
308 | (xml-parse-region (point-min) (point-max)))) | |
309 | node interfaces signals args result) | |
310 | ;; Get the root node. | |
311 | (setq node (xml-node-name introspect-xml)) | |
312 | ;; Get all interfaces. | |
313 | (setq interfaces (xml-get-children node 'interface)) | |
314 | (while interfaces | |
315 | (when (string-equal (xml-get-attribute (car interfaces) 'name) | |
316 | interface) | |
317 | ;; That's the requested interface. Check for signals. | |
318 | (setq signals (xml-get-children (car interfaces) 'signal)) | |
319 | (while signals | |
320 | (when (string-equal (xml-get-attribute (car signals) 'name) | |
321 | signal) | |
322 | ;; The signal we are looking for. | |
323 | (setq args (xml-get-children (car signals) 'arg)) | |
324 | (while args | |
325 | (unless (xml-get-attribute (car args) 'type) | |
326 | ;; This shouldn't happen, let's escape. | |
327 | (signal 'dbus-error "")) | |
328 | ;; We append the signature. | |
329 | (setq | |
330 | result (append result | |
331 | (list (xml-get-attribute (car args) 'type)))) | |
332 | (setq args (cdr args))) | |
333 | (setq signals nil)) | |
334 | (setq signals (cdr signals))) | |
335 | (setq interfaces nil)) | |
336 | (setq interfaces (cdr interfaces))) | |
337 | result) | |
338 | ;; We ignore `dbus-error'. There might be no introspectable interface. | |
339 | (dbus-error nil))) | |
340 | ) ;; (if nil ... | |
341 | ||
342 | (provide 'dbus) | |
343 | ||
79f10da0 | 344 | ;; arch-tag: a47caf84-9162-4811-90cc-5d388e37b9bd |
3a993e3d | 345 | ;;; dbus.el ends here |