HCoop / bpt / emacs.git / blob
? search:


58513e18743f05c420a5e39ee07a0fc83d1377ba
[bpt/emacs.git] / src / dbusbind.c
1 /* Elisp bindings for D-Bus.
2 Copyright (C) 2007-2014 Free Software Foundation, Inc.
3
4 This file is part of GNU Emacs.
5
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
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
18
19 #include <config.h>
20
21 #ifdef HAVE_DBUS
22 #include <stdio.h>
23 #include <dbus/dbus.h>
24
25 #include "lisp.h"
26 #include "frame.h"
27 #include "termhooks.h"
28 #include "keyboard.h"
29 #include "process.h"
30
31 #ifndef DBUS_NUM_MESSAGE_TYPES
32 #define DBUS_NUM_MESSAGE_TYPES 5
33 #endif
34
35
36 /* Some platforms define the symbol "interface", but we want to use it
37 * as a variable name below. */
38
39 #ifdef interface
40 #undef interface
41 #endif
42
43 \f
44 /* Subroutines. */
45 static Lisp_Object Qdbus__init_bus;
46 static Lisp_Object Qdbus_get_unique_name;
47 static Lisp_Object Qdbus_message_internal;
48
49 /* D-Bus error symbol. */
50 static Lisp_Object Qdbus_error;
51
52 /* Lisp symbols of the system and session buses. */
53 static Lisp_Object QCdbus_system_bus, QCdbus_session_bus;
54
55 /* Lisp symbol for method call timeout. */
56 static Lisp_Object QCdbus_timeout;
57
58 /* Lisp symbols of D-Bus types. */
59 static Lisp_Object QCdbus_type_byte, QCdbus_type_boolean;
60 static Lisp_Object QCdbus_type_int16, QCdbus_type_uint16;
61 static Lisp_Object QCdbus_type_int32, QCdbus_type_uint32;
62 static Lisp_Object QCdbus_type_int64, QCdbus_type_uint64;
63 static Lisp_Object QCdbus_type_double, QCdbus_type_string;
64 static Lisp_Object QCdbus_type_object_path, QCdbus_type_signature;
65 #ifdef DBUS_TYPE_UNIX_FD
66 static Lisp_Object QCdbus_type_unix_fd;
67 #endif
68 static Lisp_Object QCdbus_type_array, QCdbus_type_variant;
69 static Lisp_Object QCdbus_type_struct, QCdbus_type_dict_entry;
70
71 /* Lisp symbols of objects in `dbus-registered-objects-table'. */
72 static Lisp_Object QCdbus_registered_serial, QCdbus_registered_method;
73 static Lisp_Object QCdbus_registered_signal;
74
75 /* Alist of D-Bus buses we are polling for messages.
76 The key is the symbol or string of the bus, and the value is the
77 connection address. */
78 static Lisp_Object xd_registered_buses;
79
80 /* Whether we are reading a D-Bus event. */
81 static bool xd_in_read_queued_messages = 0;
82
83 \f
84 /* We use "xd_" and "XD_" as prefix for all internal symbols, because
85 we don't want to poison other namespaces with "dbus_". */
86
87 /* Raise a signal. If we are reading events, we cannot signal; we
88 throw to xd_read_queued_messages then. */
89 #define XD_SIGNAL1(arg) \
90 do { \
91 if (xd_in_read_queued_messages) \
92 Fthrow (Qdbus_error, Qnil); \
93 else \
94 xsignal1 (Qdbus_error, arg); \
95 } while (0)
96
97 #define XD_SIGNAL2(arg1, arg2) \
98 do { \
99 if (xd_in_read_queued_messages) \
100 Fthrow (Qdbus_error, Qnil); \
101 else \
102 xsignal2 (Qdbus_error, arg1, arg2); \
103 } while (0)
104
105 #define XD_SIGNAL3(arg1, arg2, arg3) \
106 do { \
107 if (xd_in_read_queued_messages) \
108 Fthrow (Qdbus_error, Qnil); \
109 else \
110 xsignal3 (Qdbus_error, arg1, arg2, arg3); \
111 } while (0)
112
113 /* Raise a Lisp error from a D-Bus ERROR. */
114 #define XD_ERROR(error) \
115 do { \
116 /* Remove the trailing newline. */ \
117 char const *mess = error.message; \
118 char const *nl = strchr (mess, '\n'); \
119 Lisp_Object err = make_string (mess, nl ? nl - mess : strlen (mess)); \
120 dbus_error_free (&error); \
121 XD_SIGNAL1 (err); \
122 } while (0)
123
124 /* Macros for debugging. In order to enable them, build with
125 "env MYCPPFLAGS='-DDBUS_DEBUG -Wall' make". */
126 #ifdef DBUS_DEBUG
127 #define XD_DEBUG_MESSAGE(...) \
128 do { \
129 char s[1024]; \
130 snprintf (s, sizeof s, __VA_ARGS__); \
131 if (!noninteractive) \
132 printf ("%s: %s\n", __func__, s); \
133 message ("%s: %s", __func__, s); \
134 } while (0)
135 #define XD_DEBUG_VALID_LISP_OBJECT_P(object) \
136 do { \
137 if (!valid_lisp_object_p (object)) \
138 { \
139 XD_DEBUG_MESSAGE ("%d Assertion failure", __LINE__); \
140 XD_SIGNAL1 (build_string ("Assertion failure")); \
141 } \
142 } while (0)
143
144 #else /* !DBUS_DEBUG */
145 # define XD_DEBUG_MESSAGE(...) \
146 do { \
147 if (!NILP (Vdbus_debug)) \
148 { \
149 char s[1024]; \
150 snprintf (s, sizeof s, __VA_ARGS__); \
151 message ("%s: %s", __func__, s); \
152 } \
153 } while (0)
154 # define XD_DEBUG_VALID_LISP_OBJECT_P(object)
155 #endif
156
157 /* Check whether TYPE is a basic DBusType. */
158 #ifdef HAVE_DBUS_TYPE_IS_VALID
159 #define XD_BASIC_DBUS_TYPE(type) \
160 (dbus_type_is_valid (type) && dbus_type_is_basic (type))
161 #else
162 #ifdef DBUS_TYPE_UNIX_FD
163 #define XD_BASIC_DBUS_TYPE(type) \
164 ((type == DBUS_TYPE_BYTE) \
165 || (type == DBUS_TYPE_BOOLEAN) \
166 || (type == DBUS_TYPE_INT16) \
167 || (type == DBUS_TYPE_UINT16) \
168 || (type == DBUS_TYPE_INT32) \
169 || (type == DBUS_TYPE_UINT32) \
170 || (type == DBUS_TYPE_INT64) \
171 || (type == DBUS_TYPE_UINT64) \
172 || (type == DBUS_TYPE_DOUBLE) \
173 || (type == DBUS_TYPE_STRING) \
174 || (type == DBUS_TYPE_OBJECT_PATH) \
175 || (type == DBUS_TYPE_SIGNATURE) \
176 || (type == DBUS_TYPE_UNIX_FD))
177 #else
178 #define XD_BASIC_DBUS_TYPE(type) \
179 ((type == DBUS_TYPE_BYTE) \
180 || (type == DBUS_TYPE_BOOLEAN) \
181 || (type == DBUS_TYPE_INT16) \
182 || (type == DBUS_TYPE_UINT16) \
183 || (type == DBUS_TYPE_INT32) \
184 || (type == DBUS_TYPE_UINT32) \
185 || (type == DBUS_TYPE_INT64) \
186 || (type == DBUS_TYPE_UINT64) \
187 || (type == DBUS_TYPE_DOUBLE) \
188 || (type == DBUS_TYPE_STRING) \
189 || (type == DBUS_TYPE_OBJECT_PATH) \
190 || (type == DBUS_TYPE_SIGNATURE))
191 #endif
192 #endif
193
194 /* This was a macro. On Solaris 2.11 it was said to compile for
195 hours, when optimization is enabled. So we have transferred it into
196 a function. */
197 /* Determine the DBusType of a given Lisp symbol. OBJECT must be one
198 of the predefined D-Bus type symbols. */
199 static int
200 xd_symbol_to_dbus_type (Lisp_Object object)
201 {
202 return
203 ((EQ (object, QCdbus_type_byte)) ? DBUS_TYPE_BYTE
204 : (EQ (object, QCdbus_type_boolean)) ? DBUS_TYPE_BOOLEAN
205 : (EQ (object, QCdbus_type_int16)) ? DBUS_TYPE_INT16
206 : (EQ (object, QCdbus_type_uint16)) ? DBUS_TYPE_UINT16
207 : (EQ (object, QCdbus_type_int32)) ? DBUS_TYPE_INT32
208 : (EQ (object, QCdbus_type_uint32)) ? DBUS_TYPE_UINT32
209 : (EQ (object, QCdbus_type_int64)) ? DBUS_TYPE_INT64
210 : (EQ (object, QCdbus_type_uint64)) ? DBUS_TYPE_UINT64
211 : (EQ (object, QCdbus_type_double)) ? DBUS_TYPE_DOUBLE
212 : (EQ (object, QCdbus_type_string)) ? DBUS_TYPE_STRING
213 : (EQ (object, QCdbus_type_object_path)) ? DBUS_TYPE_OBJECT_PATH
214 : (EQ (object, QCdbus_type_signature)) ? DBUS_TYPE_SIGNATURE
215 #ifdef DBUS_TYPE_UNIX_FD
216 : (EQ (object, QCdbus_type_unix_fd)) ? DBUS_TYPE_UNIX_FD
217 #endif
218 : (EQ (object, QCdbus_type_array)) ? DBUS_TYPE_ARRAY
219 : (EQ (object, QCdbus_type_variant)) ? DBUS_TYPE_VARIANT
220 : (EQ (object, QCdbus_type_struct)) ? DBUS_TYPE_STRUCT
221 : (EQ (object, QCdbus_type_dict_entry)) ? DBUS_TYPE_DICT_ENTRY
222 : DBUS_TYPE_INVALID);
223 }
224
225 /* Check whether a Lisp symbol is a predefined D-Bus type symbol. */
226 #define XD_DBUS_TYPE_P(object) \
227 (SYMBOLP (object) && ((xd_symbol_to_dbus_type (object) != DBUS_TYPE_INVALID)))
228
229 /* Determine the DBusType of a given Lisp OBJECT. It is used to
230 convert Lisp objects, being arguments of `dbus-call-method' or
231 `dbus-send-signal', into corresponding C values appended as
232 arguments to a D-Bus message. */
233 #define XD_OBJECT_TO_DBUS_TYPE(object) \
234 ((EQ (object, Qt) || EQ (object, Qnil)) ? DBUS_TYPE_BOOLEAN \
235 : (NATNUMP (object)) ? DBUS_TYPE_UINT32 \
236 : (INTEGERP (object)) ? DBUS_TYPE_INT32 \
237 : (FLOATP (object)) ? DBUS_TYPE_DOUBLE \
238 : (STRINGP (object)) ? DBUS_TYPE_STRING \
239 : (XD_DBUS_TYPE_P (object)) ? xd_symbol_to_dbus_type (object) \
240 : (CONSP (object)) \
241 ? ((XD_DBUS_TYPE_P (CAR_SAFE (object))) \
242 ? ((XD_BASIC_DBUS_TYPE (xd_symbol_to_dbus_type (CAR_SAFE (object)))) \
243 ? DBUS_TYPE_ARRAY \
244 : xd_symbol_to_dbus_type (CAR_SAFE (object))) \
245 : DBUS_TYPE_ARRAY) \
246 : DBUS_TYPE_INVALID)
247
248 /* Return a list pointer which does not have a Lisp symbol as car. */
249 #define XD_NEXT_VALUE(object) \
250 ((XD_DBUS_TYPE_P (CAR_SAFE (object))) ? CDR_SAFE (object) : object)
251
252 /* Transform the message type to its string representation for debug
253 messages. */
254 #define XD_MESSAGE_TYPE_TO_STRING(mtype) \
255 ((mtype == DBUS_MESSAGE_TYPE_INVALID) \
256 ? "DBUS_MESSAGE_TYPE_INVALID" \
257 : (mtype == DBUS_MESSAGE_TYPE_METHOD_CALL) \
258 ? "DBUS_MESSAGE_TYPE_METHOD_CALL" \
259 : (mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN) \
260 ? "DBUS_MESSAGE_TYPE_METHOD_RETURN" \
261 : (mtype == DBUS_MESSAGE_TYPE_ERROR) \
262 ? "DBUS_MESSAGE_TYPE_ERROR" \
263 : "DBUS_MESSAGE_TYPE_SIGNAL")
264
265 /* Transform the object to its string representation for debug
266 messages. */
267 #define XD_OBJECT_TO_STRING(object) \
268 SDATA (format2 ("%s", object, Qnil))
269
270 #define XD_DBUS_VALIDATE_BUS_ADDRESS(bus) \
271 do { \
272 char const *session_bus_address = getenv ("DBUS_SESSION_BUS_ADDRESS"); \
273 if (STRINGP (bus)) \
274 { \
275 DBusAddressEntry **entries; \
276 int len; \
277 DBusError derror; \
278 dbus_error_init (&derror); \
279 if (!dbus_parse_address (SSDATA (bus), &entries, &len, &derror)) \
280 XD_ERROR (derror); \
281 /* Cleanup. */ \
282 dbus_error_free (&derror); \
283 dbus_address_entries_free (entries); \
284 /* Canonicalize session bus address. */ \
285 if ((session_bus_address != NULL) \
286 && (!NILP (Fstring_equal \
287 (bus, build_string (session_bus_address))))) \
288 bus = QCdbus_session_bus; \
289 } \
290 \
291 else \
292 { \
293 CHECK_SYMBOL (bus); \
294 if (!(EQ (bus, QCdbus_system_bus) || EQ (bus, QCdbus_session_bus))) \
295 XD_SIGNAL2 (build_string ("Wrong bus name"), bus); \
296 /* We do not want to have an autolaunch for the session bus. */ \
297 if (EQ (bus, QCdbus_session_bus) && session_bus_address == NULL) \
298 XD_SIGNAL2 (build_string ("No connection to bus"), bus); \
299 } \
300 } while (0)
301
302 #if (HAVE_DBUS_VALIDATE_BUS_NAME || HAVE_DBUS_VALIDATE_PATH \
303 || HAVE_DBUS_VALIDATE_INTERFACE || HAVE_DBUS_VALIDATE_MEMBER)
304 #define XD_DBUS_VALIDATE_OBJECT(object, func) \
305 do { \
306 if (!NILP (object)) \
307 { \
308 DBusError derror; \
309 CHECK_STRING (object); \
310 dbus_error_init (&derror); \
311 if (!func (SSDATA (object), &derror)) \
312 XD_ERROR (derror); \
313 /* Cleanup. */ \
314 dbus_error_free (&derror); \
315 } \
316 } while (0)
317 #endif
318
319 #if HAVE_DBUS_VALIDATE_BUS_NAME
320 #define XD_DBUS_VALIDATE_BUS_NAME(bus_name) \
321 XD_DBUS_VALIDATE_OBJECT(bus_name, dbus_validate_bus_name);
322 #else
323 #define XD_DBUS_VALIDATE_BUS_NAME(bus_name) \
324 if (!NILP (bus_name)) CHECK_STRING (bus_name);
325 #endif
326
327 #if HAVE_DBUS_VALIDATE_PATH
328 #define XD_DBUS_VALIDATE_PATH(path) \
329 XD_DBUS_VALIDATE_OBJECT(path, dbus_validate_path);
330 #else
331 #define XD_DBUS_VALIDATE_PATH(path) \
332 if (!NILP (path)) CHECK_STRING (path);
333 #endif
334
335 #if HAVE_DBUS_VALIDATE_INTERFACE
336 #define XD_DBUS_VALIDATE_INTERFACE(interface) \
337 XD_DBUS_VALIDATE_OBJECT(interface, dbus_validate_interface);
338 #else
339 #define XD_DBUS_VALIDATE_INTERFACE(interface) \
340 if (!NILP (interface)) CHECK_STRING (interface);
341 #endif
342
343 #if HAVE_DBUS_VALIDATE_MEMBER
344 #define XD_DBUS_VALIDATE_MEMBER(member) \
345 XD_DBUS_VALIDATE_OBJECT(member, dbus_validate_member);
346 #else
347 #define XD_DBUS_VALIDATE_MEMBER(member) \
348 if (!NILP (member)) CHECK_STRING (member);
349 #endif
350
351 /* Append to SIGNATURE a copy of X, making sure SIGNATURE does
352 not become too long. */
353 static void
354 xd_signature_cat (char *signature, char const *x)
355 {
356 ptrdiff_t siglen = strlen (signature);
357 ptrdiff_t xlen = strlen (x);
358 if (DBUS_MAXIMUM_SIGNATURE_LENGTH - xlen <= siglen)
359 string_overflow ();
360 strcat (signature, x);
361 }
362
363 /* Compute SIGNATURE of OBJECT. It must have a form that it can be
364 used in dbus_message_iter_open_container. DTYPE is the DBusType
365 the object is related to. It is passed as argument, because it
366 cannot be detected in basic type objects, when they are preceded by
367 a type symbol. PARENT_TYPE is the DBusType of a container this
368 signature is embedded, or DBUS_TYPE_INVALID. It is needed for the
369 check that DBUS_TYPE_DICT_ENTRY occurs only as array element. */
370 static void
371 xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object)
372 {
373 int subtype;
374 Lisp_Object elt;
375 char const *subsig;
376 int subsiglen;
377 char x[DBUS_MAXIMUM_SIGNATURE_LENGTH];
378
379 elt = object;
380
381 switch (dtype)
382 {
383 case DBUS_TYPE_BYTE:
384 case DBUS_TYPE_UINT16:
385 CHECK_NATNUM (object);
386 sprintf (signature, "%c", dtype);
387 break;
388
389 case DBUS_TYPE_BOOLEAN:
390 if (!EQ (object, Qt) && !EQ (object, Qnil))
391 wrong_type_argument (intern ("booleanp"), object);
392 sprintf (signature, "%c", dtype);
393 break;
394
395 case DBUS_TYPE_INT16:
396 CHECK_NUMBER (object);
397 sprintf (signature, "%c", dtype);
398 break;
399
400 case DBUS_TYPE_UINT32:
401 case DBUS_TYPE_UINT64:
402 #ifdef DBUS_TYPE_UNIX_FD
403 case DBUS_TYPE_UNIX_FD:
404 #endif
405 case DBUS_TYPE_INT32:
406 case DBUS_TYPE_INT64:
407 case DBUS_TYPE_DOUBLE:
408 CHECK_NUMBER_OR_FLOAT (object);
409 sprintf (signature, "%c", dtype);
410 break;
411
412 case DBUS_TYPE_STRING:
413 case DBUS_TYPE_OBJECT_PATH:
414 case DBUS_TYPE_SIGNATURE:
415 CHECK_STRING (object);
416 sprintf (signature, "%c", dtype);
417 break;
418
419 case DBUS_TYPE_ARRAY:
420 /* Check that all list elements have the same D-Bus type. For
421 complex element types, we just check the container type, not
422 the whole element's signature. */
423 CHECK_CONS (object);
424
425 /* Type symbol is optional. */
426 if (EQ (QCdbus_type_array, CAR_SAFE (elt)))
427 elt = XD_NEXT_VALUE (elt);
428
429 /* If the array is empty, DBUS_TYPE_STRING is the default
430 element type. */
431 if (NILP (elt))
432 {
433 subtype = DBUS_TYPE_STRING;
434 subsig = DBUS_TYPE_STRING_AS_STRING;
435 }
436 else
437 {
438 subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
439 xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
440 subsig = x;
441 }
442
443 /* If the element type is DBUS_TYPE_SIGNATURE, and this is the
444 only element, the value of this element is used as the
445 array's element signature. */
446 if ((subtype == DBUS_TYPE_SIGNATURE)
447 && STRINGP (CAR_SAFE (XD_NEXT_VALUE (elt)))
448 && NILP (CDR_SAFE (XD_NEXT_VALUE (elt))))
449 subsig = SSDATA (CAR_SAFE (XD_NEXT_VALUE (elt)));
450
451 while (!NILP (elt))
452 {
453 if (subtype != XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt)))
454 wrong_type_argument (intern ("D-Bus"), CAR_SAFE (elt));
455 elt = CDR_SAFE (XD_NEXT_VALUE (elt));
456 }
457
458 subsiglen = snprintf (signature, DBUS_MAXIMUM_SIGNATURE_LENGTH,
459 "%c%s", dtype, subsig);
460 if (! (0 <= subsiglen && subsiglen < DBUS_MAXIMUM_SIGNATURE_LENGTH))
461 string_overflow ();
462 break;
463
464 case DBUS_TYPE_VARIANT:
465 /* Check that there is exactly one list element. */
466 CHECK_CONS (object);
467
468 elt = XD_NEXT_VALUE (elt);
469 subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
470 xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
471
472 if (!NILP (CDR_SAFE (XD_NEXT_VALUE (elt))))
473 wrong_type_argument (intern ("D-Bus"),
474 CAR_SAFE (CDR_SAFE (XD_NEXT_VALUE (elt))));
475
476 sprintf (signature, "%c", dtype);
477 break;
478
479 case DBUS_TYPE_STRUCT:
480 /* A struct list might contain any number of elements with
481 different types. No further check needed. */
482 CHECK_CONS (object);
483
484 elt = XD_NEXT_VALUE (elt);
485
486 /* Compose the signature from the elements. It is enclosed by
487 parentheses. */
488 sprintf (signature, "%c", DBUS_STRUCT_BEGIN_CHAR );
489 while (!NILP (elt))
490 {
491 subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
492 xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
493 xd_signature_cat (signature, x);
494 elt = CDR_SAFE (XD_NEXT_VALUE (elt));
495 }
496 xd_signature_cat (signature, DBUS_STRUCT_END_CHAR_AS_STRING);
497 break;
498
499 case DBUS_TYPE_DICT_ENTRY:
500 /* Check that there are exactly two list elements, and the first
501 one is of basic type. The dictionary entry itself must be an
502 element of an array. */
503 CHECK_CONS (object);
504
505 /* Check the parent object type. */
506 if (parent_type != DBUS_TYPE_ARRAY)
507 wrong_type_argument (intern ("D-Bus"), object);
508
509 /* Compose the signature from the elements. It is enclosed by
510 curly braces. */
511 sprintf (signature, "%c", DBUS_DICT_ENTRY_BEGIN_CHAR);
512
513 /* First element. */
514 elt = XD_NEXT_VALUE (elt);
515 subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
516 xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
517 xd_signature_cat (signature, x);
518
519 if (!XD_BASIC_DBUS_TYPE (subtype))
520 wrong_type_argument (intern ("D-Bus"), CAR_SAFE (XD_NEXT_VALUE (elt)));
521
522 /* Second element. */
523 elt = CDR_SAFE (XD_NEXT_VALUE (elt));
524 subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
525 xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
526 xd_signature_cat (signature, x);
527
528 if (!NILP (CDR_SAFE (XD_NEXT_VALUE (elt))))
529 wrong_type_argument (intern ("D-Bus"),
530 CAR_SAFE (CDR_SAFE (XD_NEXT_VALUE (elt))));
531
532 /* Closing signature. */
533 xd_signature_cat (signature, DBUS_DICT_ENTRY_END_CHAR_AS_STRING);
534 break;
535
536 default:
537 wrong_type_argument (intern ("D-Bus"), object);
538 }
539
540 XD_DEBUG_MESSAGE ("%s", signature);
541 }
542
543 /* Convert X to a signed integer with bounds LO and HI. */
544 static intmax_t
545 xd_extract_signed (Lisp_Object x, intmax_t lo, intmax_t hi)
546 {
547 CHECK_NUMBER_OR_FLOAT (x);
548 if (INTEGERP (x))
549 {
550 if (lo <= XINT (x) && XINT (x) <= hi)
551 return XINT (x);
552 }
553 else
554 {
555 double d = XFLOAT_DATA (x);
556 if (lo <= d && d <= hi)
557 {
558 intmax_t n = d;
559 if (n == d)
560 return n;
561 }
562 }
563 if (xd_in_read_queued_messages)
564 Fthrow (Qdbus_error, Qnil);
565 else
566 args_out_of_range_3 (x,
567 make_fixnum_or_float (lo),
568 make_fixnum_or_float (hi));
569 }
570
571 /* Convert X to an unsigned integer with bounds 0 and HI. */
572 static uintmax_t
573 xd_extract_unsigned (Lisp_Object x, uintmax_t hi)
574 {
575 CHECK_NUMBER_OR_FLOAT (x);
576 if (INTEGERP (x))
577 {
578 if (0 <= XINT (x) && XINT (x) <= hi)
579 return XINT (x);
580 }
581 else
582 {
583 double d = XFLOAT_DATA (x);
584 if (0 <= d && d <= hi)
585 {
586 uintmax_t n = d;
587 if (n == d)
588 return n;
589 }
590 }
591 if (xd_in_read_queued_messages)
592 Fthrow (Qdbus_error, Qnil);
593 else
594 args_out_of_range_3 (x, make_number (0), make_fixnum_or_float (hi));
595 }
596
597 /* Append C value, extracted from Lisp OBJECT, to iteration ITER.
598 DTYPE must be a valid DBusType. It is used to convert Lisp
599 objects, being arguments of `dbus-call-method' or
600 `dbus-send-signal', into corresponding C values appended as
601 arguments to a D-Bus message. */
602 static void
603 xd_append_arg (int dtype, Lisp_Object object, DBusMessageIter *iter)
604 {
605 char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
606 DBusMessageIter subiter;
607
608 if (XD_BASIC_DBUS_TYPE (dtype))
609 switch (dtype)
610 {
611 case DBUS_TYPE_BYTE:
612 CHECK_NATNUM (object);
613 {
614 unsigned char val = XFASTINT (object) & 0xFF;
615 XD_DEBUG_MESSAGE ("%c %u", dtype, val);
616 if (!dbus_message_iter_append_basic (iter, dtype, &val))
617 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
618 return;
619 }
620
621 case DBUS_TYPE_BOOLEAN:
622 {
623 dbus_bool_t val = (NILP (object)) ? FALSE : TRUE;
624 XD_DEBUG_MESSAGE ("%c %s", dtype, (val == FALSE) ? "false" : "true");
625 if (!dbus_message_iter_append_basic (iter, dtype, &val))
626 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
627 return;
628 }
629
630 case DBUS_TYPE_INT16:
631 {
632 dbus_int16_t val =
633 xd_extract_signed (object,
634 TYPE_MINIMUM (dbus_int16_t),
635 TYPE_MAXIMUM (dbus_int16_t));
636 int pval = val;
637 XD_DEBUG_MESSAGE ("%c %d", dtype, pval);
638 if (!dbus_message_iter_append_basic (iter, dtype, &val))
639 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
640 return;
641 }
642
643 case DBUS_TYPE_UINT16:
644 {
645 dbus_uint16_t val =
646 xd_extract_unsigned (object,
647 TYPE_MAXIMUM (dbus_uint16_t));
648 unsigned int pval = val;
649 XD_DEBUG_MESSAGE ("%c %u", dtype, pval);
650 if (!dbus_message_iter_append_basic (iter, dtype, &val))
651 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
652 return;
653 }
654
655 case DBUS_TYPE_INT32:
656 {
657 dbus_int32_t val =
658 xd_extract_signed (object,
659 TYPE_MINIMUM (dbus_int32_t),
660 TYPE_MAXIMUM (dbus_int32_t));
661 int pval = val;
662 XD_DEBUG_MESSAGE ("%c %d", dtype, pval);
663 if (!dbus_message_iter_append_basic (iter, dtype, &val))
664 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
665 return;
666 }
667
668 case DBUS_TYPE_UINT32:
669 #ifdef DBUS_TYPE_UNIX_FD
670 case DBUS_TYPE_UNIX_FD:
671 #endif
672 {
673 dbus_uint32_t val =
674 xd_extract_unsigned (object,
675 TYPE_MAXIMUM (dbus_uint32_t));
676 unsigned int pval = val;
677 XD_DEBUG_MESSAGE ("%c %u", dtype, pval);
678 if (!dbus_message_iter_append_basic (iter, dtype, &val))
679 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
680 return;
681 }
682
683 case DBUS_TYPE_INT64:
684 {
685 dbus_int64_t val =
686 xd_extract_signed (object,
687 TYPE_MINIMUM (dbus_int64_t),
688 TYPE_MAXIMUM (dbus_int64_t));
689 printmax_t pval = val;
690 XD_DEBUG_MESSAGE ("%c %"pMd, dtype, pval);
691 if (!dbus_message_iter_append_basic (iter, dtype, &val))
692 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
693 return;
694 }
695
696 case DBUS_TYPE_UINT64:
697 {
698 dbus_uint64_t val =
699 xd_extract_unsigned (object,
700 TYPE_MAXIMUM (dbus_uint64_t));
701 uprintmax_t pval = val;
702 XD_DEBUG_MESSAGE ("%c %"pMu, dtype, pval);
703 if (!dbus_message_iter_append_basic (iter, dtype, &val))
704 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
705 return;
706 }
707
708 case DBUS_TYPE_DOUBLE:
709 {
710 double val = extract_float (object);
711 XD_DEBUG_MESSAGE ("%c %f", dtype, val);
712 if (!dbus_message_iter_append_basic (iter, dtype, &val))
713 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
714 return;
715 }
716
717 case DBUS_TYPE_STRING:
718 case DBUS_TYPE_OBJECT_PATH:
719 case DBUS_TYPE_SIGNATURE:
720 CHECK_STRING (object);
721 {
722 /* We need to send a valid UTF-8 string. We could encode `object'
723 but by not encoding it, we guarantee it's valid utf-8, even if
724 it contains eight-bit-bytes. Of course, you can still send
725 manually-crafted junk by passing a unibyte string. */
726 char *val = SSDATA (object);
727 XD_DEBUG_MESSAGE ("%c %s", dtype, val);
728 if (!dbus_message_iter_append_basic (iter, dtype, &val))
729 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
730 return;
731 }
732 }
733
734 else /* Compound types. */
735 {
736
737 /* All compound types except array have a type symbol. For
738 array, it is optional. Skip it. */
739 if (!XD_BASIC_DBUS_TYPE (XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object))))
740 object = XD_NEXT_VALUE (object);
741
742 /* Open new subiteration. */
743 switch (dtype)
744 {
745 case DBUS_TYPE_ARRAY:
746 /* An array has only elements of the same type. So it is
747 sufficient to check the first element's signature
748 only. */
749
750 if (NILP (object))
751 /* If the array is empty, DBUS_TYPE_STRING is the default
752 element type. */
753 strcpy (signature, DBUS_TYPE_STRING_AS_STRING);
754
755 else
756 /* If the element type is DBUS_TYPE_SIGNATURE, and this is
757 the only element, the value of this element is used as
758 the array's element signature. */
759 if ((XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object))
760 == DBUS_TYPE_SIGNATURE)
761 && STRINGP (CAR_SAFE (XD_NEXT_VALUE (object)))
762 && NILP (CDR_SAFE (XD_NEXT_VALUE (object))))
763 {
764 strcpy (signature, SSDATA (CAR_SAFE (XD_NEXT_VALUE (object))));
765 object = CDR_SAFE (XD_NEXT_VALUE (object));
766 }
767
768 else
769 xd_signature (signature,
770 XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object)),
771 dtype, CAR_SAFE (XD_NEXT_VALUE (object)));
772
773 XD_DEBUG_MESSAGE ("%c %s %s", dtype, signature,
774 XD_OBJECT_TO_STRING (object));
775 if (!dbus_message_iter_open_container (iter, dtype,
776 signature, &subiter))
777 XD_SIGNAL3 (build_string ("Cannot open container"),
778 make_number (dtype), build_string (signature));
779 break;
780
781 case DBUS_TYPE_VARIANT:
782 /* A variant has just one element. */
783 xd_signature (signature, XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object)),
784 dtype, CAR_SAFE (XD_NEXT_VALUE (object)));
785
786 XD_DEBUG_MESSAGE ("%c %s %s", dtype, signature,
787 XD_OBJECT_TO_STRING (object));
788 if (!dbus_message_iter_open_container (iter, dtype,
789 signature, &subiter))
790 XD_SIGNAL3 (build_string ("Cannot open container"),
791 make_number (dtype), build_string (signature));
792 break;
793
794 case DBUS_TYPE_STRUCT:
795 case DBUS_TYPE_DICT_ENTRY:
796 /* These containers do not require a signature. */
797 XD_DEBUG_MESSAGE ("%c %s", dtype, XD_OBJECT_TO_STRING (object));
798 if (!dbus_message_iter_open_container (iter, dtype, NULL, &subiter))
799 XD_SIGNAL2 (build_string ("Cannot open container"),
800 make_number (dtype));
801 break;
802 }
803
804 /* Loop over list elements. */
805 while (!NILP (object))
806 {
807 dtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object));
808 object = XD_NEXT_VALUE (object);
809
810 xd_append_arg (dtype, CAR_SAFE (object), &subiter);
811
812 object = CDR_SAFE (object);
813 }
814
815 /* Close the subiteration. */
816 if (!dbus_message_iter_close_container (iter, &subiter))
817 XD_SIGNAL2 (build_string ("Cannot close container"),
818 make_number (dtype));
819 }
820 }
821
822 /* Retrieve C value from a DBusMessageIter structure ITER, and return
823 a converted Lisp object. The type DTYPE of the argument of the
824 D-Bus message must be a valid DBusType. Compound D-Bus types
825 result always in a Lisp list. */
826 static Lisp_Object
827 xd_retrieve_arg (int dtype, DBusMessageIter *iter)
828 {
829
830 switch (dtype)
831 {
832 case DBUS_TYPE_BYTE:
833 {
834 unsigned int val;
835 dbus_message_iter_get_basic (iter, &val);
836 val = val & 0xFF;
837 XD_DEBUG_MESSAGE ("%c %u", dtype, val);
838 return make_number (val);
839 }
840
841 case DBUS_TYPE_BOOLEAN:
842 {
843 dbus_bool_t val;
844 dbus_message_iter_get_basic (iter, &val);
845 XD_DEBUG_MESSAGE ("%c %s", dtype, (val == FALSE) ? "false" : "true");
846 return (val == FALSE) ? Qnil : Qt;
847 }
848
849 case DBUS_TYPE_INT16:
850 {
851 dbus_int16_t val;
852 int pval;
853 dbus_message_iter_get_basic (iter, &val);
854 pval = val;
855 XD_DEBUG_MESSAGE ("%c %d", dtype, pval);
856 return make_number (val);
857 }
858
859 case DBUS_TYPE_UINT16:
860 {
861 dbus_uint16_t val;
862 int pval;
863 dbus_message_iter_get_basic (iter, &val);
864 pval = val;
865 XD_DEBUG_MESSAGE ("%c %d", dtype, pval);
866 return make_number (val);
867 }
868
869 case DBUS_TYPE_INT32:
870 {
871 dbus_int32_t val;
872 int pval;
873 dbus_message_iter_get_basic (iter, &val);
874 pval = val;
875 XD_DEBUG_MESSAGE ("%c %d", dtype, pval);
876 return make_fixnum_or_float (val);
877 }
878
879 case DBUS_TYPE_UINT32:
880 #ifdef DBUS_TYPE_UNIX_FD
881 case DBUS_TYPE_UNIX_FD:
882 #endif
883 {
884 dbus_uint32_t val;
885 unsigned int pval;
886 dbus_message_iter_get_basic (iter, &val);
887 pval = val;
888 XD_DEBUG_MESSAGE ("%c %u", dtype, pval);
889 return make_fixnum_or_float (val);
890 }
891
892 case DBUS_TYPE_INT64:
893 {
894 dbus_int64_t val;
895 printmax_t pval;
896 dbus_message_iter_get_basic (iter, &val);
897 pval = val;
898 XD_DEBUG_MESSAGE ("%c %"pMd, dtype, pval);
899 return make_fixnum_or_float (val);
900 }
901
902 case DBUS_TYPE_UINT64:
903 {
904 dbus_uint64_t val;
905 uprintmax_t pval;
906 dbus_message_iter_get_basic (iter, &val);
907 pval = val;
908 XD_DEBUG_MESSAGE ("%c %"pMd, dtype, pval);
909 return make_fixnum_or_float (val);
910 }
911
912 case DBUS_TYPE_DOUBLE:
913 {
914 double val;
915 dbus_message_iter_get_basic (iter, &val);
916 XD_DEBUG_MESSAGE ("%c %f", dtype, val);
917 return make_float (val);
918 }
919
920 case DBUS_TYPE_STRING:
921 case DBUS_TYPE_OBJECT_PATH:
922 case DBUS_TYPE_SIGNATURE:
923 {
924 char *val;
925 dbus_message_iter_get_basic (iter, &val);
926 XD_DEBUG_MESSAGE ("%c %s", dtype, val);
927 return build_string (val);
928 }
929
930 case DBUS_TYPE_ARRAY:
931 case DBUS_TYPE_VARIANT:
932 case DBUS_TYPE_STRUCT:
933 case DBUS_TYPE_DICT_ENTRY:
934 {
935 Lisp_Object result;
936 struct gcpro gcpro1;
937 DBusMessageIter subiter;
938 int subtype;
939 result = Qnil;
940 GCPRO1 (result);
941 dbus_message_iter_recurse (iter, &subiter);
942 while ((subtype = dbus_message_iter_get_arg_type (&subiter))
943 != DBUS_TYPE_INVALID)
944 {
945 result = Fcons (xd_retrieve_arg (subtype, &subiter), result);
946 dbus_message_iter_next (&subiter);
947 }
948 XD_DEBUG_MESSAGE ("%c %s", dtype, XD_OBJECT_TO_STRING (result));
949 RETURN_UNGCPRO (Fnreverse (result));
950 }
951
952 default:
953 XD_DEBUG_MESSAGE ("DBusType '%c' not supported", dtype);
954 return Qnil;
955 }
956 }
957
958 /* Return the number of references of the shared CONNECTION. */
959 static ptrdiff_t
960 xd_get_connection_references (DBusConnection *connection)
961 {
962 ptrdiff_t *refcount;
963
964 /* We cannot access the DBusConnection structure, it is not public.
965 But we know, that the reference counter is the first field in
966 that structure. */
967 refcount = (void *) &connection;
968 refcount = (void *) *refcount;
969 return *refcount;
970 }
971
972 /* Convert a Lisp D-Bus object to a pointer. */
973 static DBusConnection*
974 xd_lisp_dbus_to_dbus (Lisp_Object bus)
975 {
976 return (DBusConnection *) (intptr_t) XFASTINT (bus);
977 }
978
979 /* Return D-Bus connection address. BUS is either a Lisp symbol,
980 :system or :session, or a string denoting the bus address. */
981 static DBusConnection *
982 xd_get_connection_address (Lisp_Object bus)
983 {
984 DBusConnection *connection;
985 Lisp_Object val;
986
987 val = CDR_SAFE (Fassoc (bus, xd_registered_buses));
988 if (NILP (val))
989 XD_SIGNAL2 (build_string ("No connection to bus"), bus);
990 else
991 connection = xd_lisp_dbus_to_dbus (val);
992
993 if (!dbus_connection_get_is_connected (connection))
994 XD_SIGNAL2 (build_string ("No connection to bus"), bus);
995
996 return connection;
997 }
998
999 /* Return the file descriptor for WATCH, -1 if not found. */
1000 static int
1001 xd_find_watch_fd (DBusWatch *watch)
1002 {
1003 #if HAVE_DBUS_WATCH_GET_UNIX_FD
1004 /* TODO: Reverse these on w32, which prefers the opposite. */
1005 int fd = dbus_watch_get_unix_fd (watch);
1006 if (fd == -1)
1007 fd = dbus_watch_get_socket (watch);
1008 #else
1009 int fd = dbus_watch_get_fd (watch);
1010 #endif
1011 return fd;
1012 }
1013
1014 /* Prototype. */
1015 static void xd_read_queued_messages (int fd, void *data);
1016
1017 /* Start monitoring WATCH for possible I/O. */
1018 static dbus_bool_t
1019 xd_add_watch (DBusWatch *watch, void *data)
1020 {
1021 unsigned int flags = dbus_watch_get_flags (watch);
1022 int fd = xd_find_watch_fd (watch);
1023
1024 XD_DEBUG_MESSAGE ("fd %d, write %d, enabled %d",
1025 fd, flags & DBUS_WATCH_WRITABLE,
1026 dbus_watch_get_enabled (watch));
1027
1028 if (fd == -1)
1029 return FALSE;
1030
1031 if (dbus_watch_get_enabled (watch))
1032 {
1033 if (flags & DBUS_WATCH_WRITABLE)
1034 add_write_fd (fd, xd_read_queued_messages, data);
1035 if (flags & DBUS_WATCH_READABLE)
1036 add_read_fd (fd, xd_read_queued_messages, data);
1037 }
1038 return TRUE;
1039 }
1040
1041 /* Stop monitoring WATCH for possible I/O.
1042 DATA is the used bus, either a string or QCdbus_system_bus or
1043 QCdbus_session_bus. */
1044 static void
1045 xd_remove_watch (DBusWatch *watch, void *data)
1046 {
1047 unsigned int flags = dbus_watch_get_flags (watch);
1048 int fd = xd_find_watch_fd (watch);
1049
1050 XD_DEBUG_MESSAGE ("fd %d", fd);
1051
1052 if (fd == -1)
1053 return;
1054
1055 /* Unset session environment. */
1056 #if 0
1057 if (XSYMBOL (QCdbus_session_bus) == data)
1058 {
1059 XD_DEBUG_MESSAGE ("unsetenv DBUS_SESSION_BUS_ADDRESS");
1060 unsetenv ("DBUS_SESSION_BUS_ADDRESS");
1061 }
1062 #endif
1063
1064 if (flags & DBUS_WATCH_WRITABLE)
1065 delete_write_fd (fd);
1066 if (flags & DBUS_WATCH_READABLE)
1067 delete_read_fd (fd);
1068 }
1069
1070 /* Toggle monitoring WATCH for possible I/O. */
1071 static void
1072 xd_toggle_watch (DBusWatch *watch, void *data)
1073 {
1074 if (dbus_watch_get_enabled (watch))
1075 xd_add_watch (watch, data);
1076 else
1077 xd_remove_watch (watch, data);
1078 }
1079
1080 /* Close connection to D-Bus BUS. */
1081 static void
1082 xd_close_bus (Lisp_Object bus)
1083 {
1084 DBusConnection *connection;
1085 Lisp_Object val;
1086 Lisp_Object busobj;
1087
1088 /* Check whether we are connected. */
1089 val = Fassoc (bus, xd_registered_buses);
1090 if (NILP (val))
1091 return;
1092
1093 busobj = CDR_SAFE (val);
1094 if (NILP (busobj)) {
1095 xd_registered_buses = Fdelete (val, xd_registered_buses);
1096 return;
1097 }
1098
1099 /* Retrieve bus address. */
1100 connection = xd_lisp_dbus_to_dbus (busobj);
1101
1102 if (xd_get_connection_references (connection) == 1)
1103 {
1104 /* Close connection, if there isn't another shared application. */
1105 XD_DEBUG_MESSAGE ("Close connection to bus %s",
1106 XD_OBJECT_TO_STRING (bus));
1107 dbus_connection_close (connection);
1108
1109 xd_registered_buses = Fdelete (val, xd_registered_buses);
1110 }
1111
1112 else
1113 /* Decrement reference count. */
1114 dbus_connection_unref (connection);
1115
1116 /* Return. */
1117 return;
1118 }
1119
1120 DEFUN ("dbus--init-bus", Fdbus__init_bus, Sdbus__init_bus, 1, 2, 0,
1121 doc: /* Establish the connection to D-Bus BUS.
1122
1123 This function is dbus internal. You almost certainly want to use
1124 `dbus-init-bus'.
1125
1126 BUS can be either the symbol `:system' or the symbol `:session', or it
1127 can be a string denoting the address of the corresponding bus. For
1128 the system and session buses, this function is called when loading
1129 `dbus.el', there is no need to call it again.
1130
1131 The function returns a number, which counts the connections this Emacs
1132 session has established to the BUS under the same unique name (see
1133 `dbus-get-unique-name'). It depends on the libraries Emacs is linked
1134 with, and on the environment Emacs is running. For example, if Emacs
1135 is linked with the gtk toolkit, and it runs in a GTK-aware environment
1136 like Gnome, another connection might already be established.
1137
1138 When PRIVATE is non-nil, a new connection is established instead of
1139 reusing an existing one. It results in a new unique name at the bus.
1140 This can be used, if it is necessary to distinguish from another
1141 connection used in the same Emacs process, like the one established by
1142 GTK+. It should be used with care for at least the `:system' and
1143 `:session' buses, because other Emacs Lisp packages might already use
1144 this connection to those buses. */)
1145 (Lisp_Object bus, Lisp_Object private)
1146 {
1147 DBusConnection *connection;
1148 DBusError derror;
1149 Lisp_Object val;
1150 ptrdiff_t refcount;
1151
1152 /* Check parameter. */
1153 XD_DBUS_VALIDATE_BUS_ADDRESS (bus);
1154
1155 /* Close bus if it is already open. */
1156 xd_close_bus (bus);
1157
1158 /* Check, whether we are still connected. */
1159 val = Fassoc (bus, xd_registered_buses);
1160 if (!NILP (val))
1161 {
1162 connection = xd_get_connection_address (bus);
1163 dbus_connection_ref (connection);
1164 }
1165
1166 else
1167 {
1168 /* Initialize. */
1169 dbus_error_init (&derror);
1170
1171 /* Open the connection. */
1172 if (STRINGP (bus))
1173 if (NILP (private))
1174 connection = dbus_connection_open (SSDATA (bus), &derror);
1175 else
1176 connection = dbus_connection_open_private (SSDATA (bus), &derror);
1177
1178 else
1179 if (NILP (private))
1180 connection = dbus_bus_get (EQ (bus, QCdbus_system_bus)
1181 ? DBUS_BUS_SYSTEM : DBUS_BUS_SESSION,
1182 &derror);
1183 else
1184 connection = dbus_bus_get_private (EQ (bus, QCdbus_system_bus)
1185 ? DBUS_BUS_SYSTEM : DBUS_BUS_SESSION,
1186 &derror);
1187
1188 if (dbus_error_is_set (&derror))
1189 XD_ERROR (derror);
1190
1191 if (connection == NULL)
1192 XD_SIGNAL2 (build_string ("No connection to bus"), bus);
1193
1194 /* If it is not the system or session bus, we must register
1195 ourselves. Otherwise, we have called dbus_bus_get, which has
1196 configured us to exit if the connection closes - we undo this
1197 setting. */
1198 if (STRINGP (bus))
1199 dbus_bus_register (connection, &derror);
1200 else
1201 dbus_connection_set_exit_on_disconnect (connection, FALSE);
1202
1203 if (dbus_error_is_set (&derror))
1204 XD_ERROR (derror);
1205
1206 /* Add the watch functions. We pass also the bus as data, in
1207 order to distinguish between the buses in xd_remove_watch. */
1208 if (!dbus_connection_set_watch_functions (connection,
1209 xd_add_watch,
1210 xd_remove_watch,
1211 xd_toggle_watch,
1212 SYMBOLP (bus)
1213 ? (void *) XSYMBOL (bus)
1214 : (void *) XSTRING (bus),
1215 NULL))
1216 XD_SIGNAL1 (build_string ("Cannot add watch functions"));
1217
1218 /* Add bus to list of registered buses. */
1219 XSETFASTINT (val, (intptr_t) connection);
1220 xd_registered_buses = Fcons (Fcons (bus, val), xd_registered_buses);
1221
1222 /* We do not want to abort. */
1223 xputenv ("DBUS_FATAL_WARNINGS=0");
1224
1225 /* Cleanup. */
1226 dbus_error_free (&derror);
1227 }
1228
1229 /* Return reference counter. */
1230 refcount = xd_get_connection_references (connection);
1231 XD_DEBUG_MESSAGE ("Bus %s, Reference counter %"pD"d",
1232 XD_OBJECT_TO_STRING (bus), refcount);
1233 return make_number (refcount);
1234 }
1235
1236 DEFUN ("dbus-get-unique-name", Fdbus_get_unique_name, Sdbus_get_unique_name,
1237 1, 1, 0,
1238 doc: /* Return the unique name of Emacs registered at D-Bus BUS. */)
1239 (Lisp_Object bus)
1240 {
1241 DBusConnection *connection;
1242 const char *name;
1243
1244 /* Check parameter. */
1245 XD_DBUS_VALIDATE_BUS_ADDRESS (bus);
1246
1247 /* Retrieve bus address. */
1248 connection = xd_get_connection_address (bus);
1249
1250 /* Request the name. */
1251 name = dbus_bus_get_unique_name (connection);
1252 if (name == NULL)
1253 XD_SIGNAL1 (build_string ("No unique name available"));
1254
1255 /* Return. */
1256 return build_string (name);
1257 }
1258
1259 DEFUN ("dbus-message-internal", Fdbus_message_internal, Sdbus_message_internal,
1260 4, MANY, 0,
1261 doc: /* Send a D-Bus message.
1262 This is an internal function, it shall not be used outside dbus.el.
1263
1264 The following usages are expected:
1265
1266 `dbus-call-method', `dbus-call-method-asynchronously':
1267 \(dbus-message-internal
1268 dbus-message-type-method-call BUS SERVICE PATH INTERFACE METHOD HANDLER
1269 &optional :timeout TIMEOUT &rest ARGS)
1270
1271 `dbus-send-signal':
1272 \(dbus-message-internal
1273 dbus-message-type-signal BUS SERVICE PATH INTERFACE SIGNAL &rest ARGS)
1274
1275 `dbus-method-return-internal':
1276 \(dbus-message-internal
1277 dbus-message-type-method-return BUS SERVICE SERIAL &rest ARGS)
1278
1279 `dbus-method-error-internal':
1280 \(dbus-message-internal
1281 dbus-message-type-error BUS SERVICE SERIAL &rest ARGS)
1282
1283 usage: (dbus-message-internal &rest REST) */)
1284 (ptrdiff_t nargs, Lisp_Object *args)
1285 {
1286 Lisp_Object message_type, bus, service, handler;
1287 Lisp_Object path = Qnil;
1288 Lisp_Object interface = Qnil;
1289 Lisp_Object member = Qnil;
1290 Lisp_Object result;
1291 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
1292 DBusConnection *connection;
1293 DBusMessage *dmessage;
1294 DBusMessageIter iter;
1295 int dtype;
1296 int mtype;
1297 dbus_uint32_t serial = 0;
1298 unsigned int ui_serial;
1299 int timeout = -1;
1300 ptrdiff_t count;
1301 char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
1302
1303 /* Initialize parameters. */
1304 message_type = args[0];
1305 bus = args[1];
1306 service = args[2];
1307 handler = Qnil;
1308
1309 CHECK_NATNUM (message_type);
1310 if (! (DBUS_MESSAGE_TYPE_INVALID < XFASTINT (message_type)
1311 && XFASTINT (message_type) < DBUS_NUM_MESSAGE_TYPES))
1312 XD_SIGNAL2 (build_string ("Invalid message type"), message_type);
1313 mtype = XFASTINT (message_type);
1314
1315 if ((mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
1316 || (mtype == DBUS_MESSAGE_TYPE_SIGNAL))
1317 {
1318 path = args[3];
1319 interface = args[4];
1320 member = args[5];
1321 if (mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
1322 handler = args[6];
1323 count = (mtype == DBUS_MESSAGE_TYPE_METHOD_CALL) ? 7 : 6;
1324 }
1325 else /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR */
1326 {
1327 serial = xd_extract_unsigned (args[3], TYPE_MAXIMUM (dbus_uint32_t));
1328 count = 4;
1329 }
1330
1331 /* Check parameters. */
1332 XD_DBUS_VALIDATE_BUS_ADDRESS (bus);
1333 XD_DBUS_VALIDATE_BUS_NAME (service);
1334 if (nargs < count)
1335 xsignal2 (Qwrong_number_of_arguments,
1336 Qdbus_message_internal,
1337 make_number (nargs));
1338
1339 if ((mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
1340 || (mtype == DBUS_MESSAGE_TYPE_SIGNAL))
1341 {
1342 XD_DBUS_VALIDATE_PATH (path);
1343 XD_DBUS_VALIDATE_INTERFACE (interface);
1344 XD_DBUS_VALIDATE_MEMBER (member);
1345 if (!NILP (handler) && (!FUNCTIONP (handler)))
1346 wrong_type_argument (Qinvalid_function, handler);
1347 }
1348
1349 /* Protect Lisp variables. */
1350 GCPRO6 (bus, service, path, interface, member, handler);
1351
1352 /* Trace parameters. */
1353 switch (mtype)
1354 {
1355 case DBUS_MESSAGE_TYPE_METHOD_CALL:
1356 XD_DEBUG_MESSAGE ("%s %s %s %s %s %s %s",
1357 XD_MESSAGE_TYPE_TO_STRING (mtype),
1358 XD_OBJECT_TO_STRING (bus),
1359 XD_OBJECT_TO_STRING (service),
1360 XD_OBJECT_TO_STRING (path),
1361 XD_OBJECT_TO_STRING (interface),
1362 XD_OBJECT_TO_STRING (member),
1363 XD_OBJECT_TO_STRING (handler));
1364 break;
1365 case DBUS_MESSAGE_TYPE_SIGNAL:
1366 XD_DEBUG_MESSAGE ("%s %s %s %s %s %s",
1367 XD_MESSAGE_TYPE_TO_STRING (mtype),
1368 XD_OBJECT_TO_STRING (bus),
1369 XD_OBJECT_TO_STRING (service),
1370 XD_OBJECT_TO_STRING (path),
1371 XD_OBJECT_TO_STRING (interface),
1372 XD_OBJECT_TO_STRING (member));
1373 break;
1374 default: /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR */
1375 ui_serial = serial;
1376 XD_DEBUG_MESSAGE ("%s %s %s %u",
1377 XD_MESSAGE_TYPE_TO_STRING (mtype),
1378 XD_OBJECT_TO_STRING (bus),
1379 XD_OBJECT_TO_STRING (service),
1380 ui_serial);
1381 }
1382
1383 /* Retrieve bus address. */
1384 connection = xd_get_connection_address (bus);
1385
1386 /* Create the D-Bus message. */
1387 dmessage = dbus_message_new (mtype);
1388 if (dmessage == NULL)
1389 {
1390 UNGCPRO;
1391 XD_SIGNAL1 (build_string ("Unable to create a new message"));
1392 }
1393
1394 if (STRINGP (service))
1395 {
1396 if (mtype != DBUS_MESSAGE_TYPE_SIGNAL)
1397 /* Set destination. */
1398 {
1399 if (!dbus_message_set_destination (dmessage, SSDATA (service)))
1400 {
1401 UNGCPRO;
1402 XD_SIGNAL2 (build_string ("Unable to set the destination"),
1403 service);
1404 }
1405 }
1406
1407 else
1408 /* Set destination for unicast signals. */
1409 {
1410 Lisp_Object uname;
1411
1412 /* If it is the same unique name as we are registered at the
1413 bus or an unknown name, we regard it as broadcast message
1414 due to backward compatibility. */
1415 if (dbus_bus_name_has_owner (connection, SSDATA (service), NULL))
1416 uname = call2 (intern ("dbus-get-name-owner"), bus, service);
1417 else
1418 uname = Qnil;
1419
1420 if (STRINGP (uname)
1421 && (strcmp (dbus_bus_get_unique_name (connection), SSDATA (uname))
1422 != 0)
1423 && (!dbus_message_set_destination (dmessage, SSDATA (service))))
1424 {
1425 UNGCPRO;
1426 XD_SIGNAL2 (build_string ("Unable to set signal destination"),
1427 service);
1428 }
1429 }
1430 }
1431
1432 /* Set message parameters. */
1433 if ((mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
1434 || (mtype == DBUS_MESSAGE_TYPE_SIGNAL))
1435 {
1436 if ((!dbus_message_set_path (dmessage, SSDATA (path)))
1437 || (!dbus_message_set_interface (dmessage, SSDATA (interface)))
1438 || (!dbus_message_set_member (dmessage, SSDATA (member))))
1439 {
1440 UNGCPRO;
1441 XD_SIGNAL1 (build_string ("Unable to set the message parameter"));
1442 }
1443 }
1444
1445 else /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR */
1446 {
1447 if (!dbus_message_set_reply_serial (dmessage, serial))
1448 {
1449 UNGCPRO;
1450 XD_SIGNAL1 (build_string ("Unable to create a return message"));
1451 }
1452
1453 if ((mtype == DBUS_MESSAGE_TYPE_ERROR)
1454 && (!dbus_message_set_error_name (dmessage, DBUS_ERROR_FAILED)))
1455 {
1456 UNGCPRO;
1457 XD_SIGNAL1 (build_string ("Unable to create a error message"));
1458 }
1459 }
1460
1461 /* Check for timeout parameter. */
1462 if ((count+2 <= nargs) && (EQ ((args[count]), QCdbus_timeout)))
1463 {
1464 CHECK_NATNUM (args[count+1]);
1465 timeout = min (XFASTINT (args[count+1]), INT_MAX);
1466 count = count+2;
1467 }
1468
1469 /* Initialize parameter list of message. */
1470 dbus_message_iter_init_append (dmessage, &iter);
1471
1472 /* Append parameters to the message. */
1473 for (; count < nargs; ++count)
1474 {
1475 dtype = XD_OBJECT_TO_DBUS_TYPE (args[count]);
1476 if (XD_DBUS_TYPE_P (args[count]))
1477 {
1478 XD_DEBUG_VALID_LISP_OBJECT_P (args[count]);
1479 XD_DEBUG_VALID_LISP_OBJECT_P (args[count+1]);
1480 XD_DEBUG_MESSAGE ("Parameter%"pD"d %s %s", count - 4,
1481 XD_OBJECT_TO_STRING (args[count]),
1482 XD_OBJECT_TO_STRING (args[count+1]));
1483 ++count;
1484 }
1485 else
1486 {
1487 XD_DEBUG_VALID_LISP_OBJECT_P (args[count]);
1488 XD_DEBUG_MESSAGE ("Parameter%"pD"d %s", count - 4,
1489 XD_OBJECT_TO_STRING (args[count]));
1490 }
1491
1492 /* Check for valid signature. We use DBUS_TYPE_INVALID as
1493 indication that there is no parent type. */
1494 xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[count]);
1495
1496 xd_append_arg (dtype, args[count], &iter);
1497 }
1498
1499 if (!NILP (handler))
1500 {
1501 /* Send the message. The message is just added to the outgoing
1502 message queue. */
1503 if (!dbus_connection_send_with_reply (connection, dmessage,
1504 NULL, timeout))
1505 {
1506 UNGCPRO;
1507 XD_SIGNAL1 (build_string ("Cannot send message"));
1508 }
1509
1510 /* The result is the key in Vdbus_registered_objects_table. */
1511 serial = dbus_message_get_serial (dmessage);
1512 result = list3 (QCdbus_registered_serial,
1513 bus, make_fixnum_or_float (serial));
1514
1515 /* Create a hash table entry. */
1516 Fputhash (result, handler, Vdbus_registered_objects_table);
1517 }
1518 else
1519 {
1520 /* Send the message. The message is just added to the outgoing
1521 message queue. */
1522 if (!dbus_connection_send (connection, dmessage, NULL))
1523 {
1524 UNGCPRO;
1525 XD_SIGNAL1 (build_string ("Cannot send message"));
1526 }
1527
1528 result = Qnil;
1529 }
1530
1531 XD_DEBUG_MESSAGE ("Message sent: %s", XD_OBJECT_TO_STRING (result));
1532
1533 /* Cleanup. */
1534 dbus_message_unref (dmessage);
1535
1536 /* Return the result. */
1537 RETURN_UNGCPRO (result);
1538 }
1539
1540 /* Read one queued incoming message of the D-Bus BUS.
1541 BUS is either a Lisp symbol, :system or :session, or a string denoting
1542 the bus address. */
1543 static void
1544 xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
1545 {
1546 Lisp_Object args, key, value;
1547 struct gcpro gcpro1;
1548 struct input_event event;
1549 DBusMessage *dmessage;
1550 DBusMessageIter iter;
1551 int dtype;
1552 int mtype;
1553 dbus_uint32_t serial;
1554 unsigned int ui_serial;
1555 const char *uname, *path, *interface, *member;
1556
1557 dmessage = dbus_connection_pop_message (connection);
1558
1559 /* Return if there is no queued message. */
1560 if (dmessage == NULL)
1561 return;
1562
1563 /* Collect the parameters. */
1564 args = Qnil;
1565 GCPRO1 (args);
1566
1567 /* Loop over the resulting parameters. Construct a list. */
1568 if (dbus_message_iter_init (dmessage, &iter))
1569 {
1570 while ((dtype = dbus_message_iter_get_arg_type (&iter))
1571 != DBUS_TYPE_INVALID)
1572 {
1573 args = Fcons (xd_retrieve_arg (dtype, &iter), args);
1574 dbus_message_iter_next (&iter);
1575 }
1576 /* The arguments are stored in reverse order. Reorder them. */
1577 args = Fnreverse (args);
1578 }
1579
1580 /* Read message type, message serial, unique name, object path,
1581 interface and member from the message. */
1582 mtype = dbus_message_get_type (dmessage);
1583 ui_serial = serial =
1584 ((mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN)
1585 || (mtype == DBUS_MESSAGE_TYPE_ERROR))
1586 ? dbus_message_get_reply_serial (dmessage)
1587 : dbus_message_get_serial (dmessage);
1588 uname = dbus_message_get_sender (dmessage);
1589 path = dbus_message_get_path (dmessage);
1590 interface = dbus_message_get_interface (dmessage);
1591 member = dbus_message_get_member (dmessage);
1592
1593 XD_DEBUG_MESSAGE ("Event received: %s %u %s %s %s %s %s",
1594 XD_MESSAGE_TYPE_TO_STRING (mtype),
1595 ui_serial, uname, path, interface, member,
1596 XD_OBJECT_TO_STRING (args));
1597
1598 if (mtype == DBUS_MESSAGE_TYPE_INVALID)
1599 goto cleanup;
1600
1601 else if ((mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN)
1602 || (mtype == DBUS_MESSAGE_TYPE_ERROR))
1603 {
1604 /* Search for a registered function of the message. */
1605 key = list3 (QCdbus_registered_serial, bus,
1606 make_fixnum_or_float (serial));
1607 value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
1608
1609 /* There shall be exactly one entry. Construct an event. */
1610 if (NILP (value))
1611 goto cleanup;
1612
1613 /* Remove the entry. */
1614 Fremhash (key, Vdbus_registered_objects_table);
1615
1616 /* Construct an event. */
1617 EVENT_INIT (event);
1618 event.kind = DBUS_EVENT;
1619 event.frame_or_window = Qnil;
1620 event.arg = Fcons (value, args);
1621 }
1622
1623 else /* DBUS_MESSAGE_TYPE_METHOD_CALL, DBUS_MESSAGE_TYPE_SIGNAL. */
1624 {
1625 /* Vdbus_registered_objects_table requires non-nil interface and
1626 member. */
1627 if ((interface == NULL) || (member == NULL))
1628 goto cleanup;
1629
1630 /* Search for a registered function of the message. */
1631 key = list4 ((mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
1632 ? QCdbus_registered_method
1633 : QCdbus_registered_signal,
1634 bus, build_string (interface), build_string (member));
1635 value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
1636
1637 /* Loop over the registered functions. Construct an event. */
1638 while (!NILP (value))
1639 {
1640 key = CAR_SAFE (value);
1641 /* key has the structure (UNAME SERVICE PATH HANDLER). */
1642 if (((uname == NULL)
1643 || (NILP (CAR_SAFE (key)))
1644 || (strcmp (uname, SSDATA (CAR_SAFE (key))) == 0))
1645 && ((path == NULL)
1646 || (NILP (CAR_SAFE (CDR_SAFE (CDR_SAFE (key)))))
1647 || (strcmp (path,
1648 SSDATA (CAR_SAFE (CDR_SAFE (CDR_SAFE (key)))))
1649 == 0))
1650 && (!NILP (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (key)))))))
1651 {
1652 EVENT_INIT (event);
1653 event.kind = DBUS_EVENT;
1654 event.frame_or_window = Qnil;
1655 event.arg
1656 = Fcons (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (key)))), args);
1657 break;
1658 }
1659 value = CDR_SAFE (value);
1660 }
1661
1662 if (NILP (value))
1663 goto cleanup;
1664 }
1665
1666 /* Add type, serial, uname, path, interface and member to the event. */
1667 event.arg = Fcons ((member == NULL ? Qnil : build_string (member)),
1668 event.arg);
1669 event.arg = Fcons ((interface == NULL ? Qnil : build_string (interface)),
1670 event.arg);
1671 event.arg = Fcons ((path == NULL ? Qnil : build_string (path)),
1672 event.arg);
1673 event.arg = Fcons ((uname == NULL ? Qnil : build_string (uname)),
1674 event.arg);
1675 event.arg = Fcons (make_fixnum_or_float (serial), event.arg);
1676 event.arg = Fcons (make_number (mtype), event.arg);
1677
1678 /* Add the bus symbol to the event. */
1679 event.arg = Fcons (bus, event.arg);
1680
1681 /* Store it into the input event queue. */
1682 kbd_buffer_store_event (&event);
1683
1684 XD_DEBUG_MESSAGE ("Event stored: %s", XD_OBJECT_TO_STRING (event.arg));
1685
1686 /* Cleanup. */
1687 cleanup:
1688 dbus_message_unref (dmessage);
1689
1690 UNGCPRO;
1691 }
1692
1693 /* Read queued incoming messages of the D-Bus BUS.
1694 BUS is either a Lisp symbol, :system or :session, or a string denoting
1695 the bus address. */
1696 static Lisp_Object
1697 xd_read_message (Lisp_Object bus)
1698 {
1699 /* Retrieve bus address. */
1700 DBusConnection *connection = xd_get_connection_address (bus);
1701
1702 /* Non blocking read of the next available message. */
1703 dbus_connection_read_write (connection, 0);
1704
1705 while (dbus_connection_get_dispatch_status (connection)
1706 != DBUS_DISPATCH_COMPLETE)
1707 xd_read_message_1 (connection, bus);
1708 return Qnil;
1709 }
1710
1711 /* Callback called when something is ready to read or write. */
1712 static void
1713 xd_read_queued_messages (int fd, void *data)
1714 {
1715 Lisp_Object busp = xd_registered_buses;
1716 Lisp_Object bus = Qnil;
1717 Lisp_Object key;
1718
1719 /* Find bus related to fd. */
1720 if (data != NULL)
1721 while (!NILP (busp))
1722 {
1723 key = CAR_SAFE (CAR_SAFE (busp));
1724 if ((SYMBOLP (key) && XSYMBOL (key) == data)
1725 || (STRINGP (key) && XSTRING (key) == data))
1726 bus = key;
1727 busp = CDR_SAFE (busp);
1728 }
1729
1730 if (NILP (bus))
1731 return;
1732
1733 /* We ignore all Lisp errors during the call. */
1734 xd_in_read_queued_messages = 1;
1735 internal_catch (Qdbus_error, xd_read_message, bus);
1736 xd_in_read_queued_messages = 0;
1737 }
1738
1739 \f
1740 void
1741 syms_of_dbusbind (void)
1742 {
1743 #include "dbusbind.x"
1744
1745 DEFSYM (Qdbus__init_bus, "dbus--init-bus");
1746 DEFSYM (Qdbus_get_unique_name, "dbus-get-unique-name");
1747 DEFSYM (Qdbus_message_internal, "dbus-message-internal");
1748 DEFSYM (Qdbus_error, "dbus-error");
1749 Fput (Qdbus_error, Qerror_conditions,
1750 list2 (Qdbus_error, Qerror));
1751 Fput (Qdbus_error, Qerror_message,
1752 build_pure_c_string ("D-Bus error"));
1753 DEFSYM (QCdbus_system_bus, ":system");
1754 DEFSYM (QCdbus_session_bus, ":session");
1755 DEFSYM (QCdbus_timeout, ":timeout");
1756 DEFSYM (QCdbus_type_byte, ":byte");
1757 DEFSYM (QCdbus_type_boolean, ":boolean");
1758 DEFSYM (QCdbus_type_int16, ":int16");
1759 DEFSYM (QCdbus_type_uint16, ":uint16");
1760 DEFSYM (QCdbus_type_int32, ":int32");
1761 DEFSYM (QCdbus_type_uint32, ":uint32");
1762 DEFSYM (QCdbus_type_int64, ":int64");
1763 DEFSYM (QCdbus_type_uint64, ":uint64");
1764 DEFSYM (QCdbus_type_double, ":double");
1765 DEFSYM (QCdbus_type_string, ":string");
1766 DEFSYM (QCdbus_type_object_path, ":object-path");
1767 DEFSYM (QCdbus_type_signature, ":signature");
1768 #ifdef DBUS_TYPE_UNIX_FD
1769 DEFSYM (QCdbus_type_unix_fd, ":unix-fd");
1770 #endif
1771 DEFSYM (QCdbus_type_array, ":array");
1772 DEFSYM (QCdbus_type_variant, ":variant");
1773 DEFSYM (QCdbus_type_struct, ":struct");
1774 DEFSYM (QCdbus_type_dict_entry, ":dict-entry");
1775 DEFSYM (QCdbus_registered_serial, ":serial");
1776 DEFSYM (QCdbus_registered_method, ":method");
1777 DEFSYM (QCdbus_registered_signal, ":signal");
1778
1779 DEFVAR_LISP ("dbus-compiled-version",
1780 Vdbus_compiled_version,
1781 doc: /* The version of D-Bus Emacs is compiled against. */);
1782 #ifdef DBUS_VERSION_STRING
1783 Vdbus_compiled_version = build_pure_c_string (DBUS_VERSION_STRING);
1784 #else
1785 Vdbus_compiled_version = Qnil;
1786 #endif
1787
1788 DEFVAR_LISP ("dbus-runtime-version",
1789 Vdbus_runtime_version,
1790 doc: /* The version of D-Bus Emacs runs with. */);
1791 {
1792 #ifdef DBUS_VERSION
1793 int major, minor, micro;
1794 char s[sizeof ".." + 3 * INT_STRLEN_BOUND (int)];
1795 dbus_get_version (&major, &minor, &micro);
1796 Vdbus_runtime_version
1797 = make_formatted_string (s, "%d.%d.%d", major, minor, micro);
1798 #else
1799 Vdbus_runtime_version = Qnil;
1800 #endif
1801 }
1802
1803 DEFVAR_LISP ("dbus-message-type-invalid",
1804 Vdbus_message_type_invalid,
1805 doc: /* This value is never a valid message type. */);
1806 Vdbus_message_type_invalid = make_number (DBUS_MESSAGE_TYPE_INVALID);
1807
1808 DEFVAR_LISP ("dbus-message-type-method-call",
1809 Vdbus_message_type_method_call,
1810 doc: /* Message type of a method call message. */);
1811 Vdbus_message_type_method_call = make_number (DBUS_MESSAGE_TYPE_METHOD_CALL);
1812
1813 DEFVAR_LISP ("dbus-message-type-method-return",
1814 Vdbus_message_type_method_return,
1815 doc: /* Message type of a method return message. */);
1816 Vdbus_message_type_method_return
1817 = make_number (DBUS_MESSAGE_TYPE_METHOD_RETURN);
1818
1819 DEFVAR_LISP ("dbus-message-type-error",
1820 Vdbus_message_type_error,
1821 doc: /* Message type of an error reply message. */);
1822 Vdbus_message_type_error = make_number (DBUS_MESSAGE_TYPE_ERROR);
1823
1824 DEFVAR_LISP ("dbus-message-type-signal",
1825 Vdbus_message_type_signal,
1826 doc: /* Message type of a signal message. */);
1827 Vdbus_message_type_signal = make_number (DBUS_MESSAGE_TYPE_SIGNAL);
1828
1829 DEFVAR_LISP ("dbus-registered-objects-table",
1830 Vdbus_registered_objects_table,
1831 doc: /* Hash table of registered functions for D-Bus.
1832
1833 There are two different uses of the hash table: for accessing
1834 registered interfaces properties, targeted by signals or method calls,
1835 and for calling handlers in case of non-blocking method call returns.
1836
1837 In the first case, the key in the hash table is the list (TYPE BUS
1838 INTERFACE MEMBER). TYPE is one of the Lisp symbols `:method',
1839 `:signal' or `:property'. BUS is either a Lisp symbol, `:system' or
1840 `:session', or a string denoting the bus address. INTERFACE is a
1841 string which denotes a D-Bus interface, and MEMBER, also a string, is
1842 either a method, a signal or a property INTERFACE is offering. All
1843 arguments but BUS must not be nil.
1844
1845 The value in the hash table is a list of quadruple lists \((UNAME
1846 SERVICE PATH OBJECT [RULE]) ...). SERVICE is the service name as
1847 registered, UNAME is the corresponding unique name. In case of
1848 registered methods and properties, UNAME is nil. PATH is the object
1849 path of the sending object. All of them can be nil, which means a
1850 wildcard then. OBJECT is either the handler to be called when a D-Bus
1851 message, which matches the key criteria, arrives (TYPE `:method' and
1852 `:signal'), or a cons cell containing the value of the property (TYPE
1853 `:property').
1854
1855 For entries of type `:signal', there is also a fifth element RULE,
1856 which keeps the match string the signal is registered with.
1857
1858 In the second case, the key in the hash table is the list (:serial BUS
1859 SERIAL). BUS is either a Lisp symbol, `:system' or `:session', or a
1860 string denoting the bus address. SERIAL is the serial number of the
1861 non-blocking method call, a reply is expected. Both arguments must
1862 not be nil. The value in the hash table is HANDLER, the function to
1863 be called when the D-Bus reply message arrives. */);
1864 {
1865 Lisp_Object args[2];
1866 args[0] = QCtest;
1867 args[1] = Qequal;
1868 Vdbus_registered_objects_table = Fmake_hash_table (2, args);
1869 }
1870
1871 DEFVAR_LISP ("dbus-debug", Vdbus_debug,
1872 doc: /* If non-nil, debug messages of D-Bus bindings are raised. */);
1873 #ifdef DBUS_DEBUG
1874 Vdbus_debug = Qt;
1875 /* We can also set environment variable DBUS_VERBOSE=1 in order to
1876 see more traces. This requires libdbus-1 to be configured with
1877 --enable-verbose-mode. */
1878 #else
1879 Vdbus_debug = Qnil;
1880 #endif
1881
1882 /* Initialize internal objects. */
1883 xd_registered_buses = Qnil;
1884 staticpro (&xd_registered_buses);
1885
1886 Fprovide (intern_c_string ("dbusbind"), Qnil);
1887
1888 }
1889
1890 #endif /* HAVE_DBUS */
Unnamed repository; edit this file 'description' to name the repository.