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