1 /* Elisp bindings for D-Bus.
2 Copyright (C) 2007-2017 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software: you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation, either version 3 of the License, or (at
9 your option) any later version.
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.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
24 #include <dbus/dbus.h>
27 #include "termhooks.h"
31 #ifndef DBUS_NUM_MESSAGE_TYPES
32 #define DBUS_NUM_MESSAGE_TYPES 5
36 /* Some platforms define the symbol "interface", but we want to use it
37 * as a variable name below. */
44 /* Alist of D-Bus buses we are polling for messages.
45 The key is the symbol or string of the bus, and the value is the
46 connection address. */
47 static Lisp_Object xd_registered_buses
;
49 /* Whether we are reading a D-Bus event. */
50 static bool xd_in_read_queued_messages
= 0;
53 /* We use "xd_" and "XD_" as prefix for all internal symbols, because
54 we don't want to poison other namespaces with "dbus_". */
56 /* Raise a signal. If we are reading events, we cannot signal; we
57 throw to xd_read_queued_messages then. */
58 #define XD_SIGNAL1(arg) \
60 if (xd_in_read_queued_messages) \
61 Fthrow (Qdbus_error, Qnil); \
63 xsignal1 (Qdbus_error, arg); \
66 #define XD_SIGNAL2(arg1, arg2) \
68 if (xd_in_read_queued_messages) \
69 Fthrow (Qdbus_error, Qnil); \
71 xsignal2 (Qdbus_error, arg1, arg2); \
74 #define XD_SIGNAL3(arg1, arg2, arg3) \
76 if (xd_in_read_queued_messages) \
77 Fthrow (Qdbus_error, Qnil); \
79 xsignal3 (Qdbus_error, arg1, arg2, arg3); \
82 /* Raise a Lisp error from a D-Bus ERROR. */
83 #define XD_ERROR(error) \
85 /* Remove the trailing newline. */ \
86 char const *mess = error.message; \
87 char const *nl = strchr (mess, '\n'); \
88 Lisp_Object err = make_string (mess, nl ? nl - mess : strlen (mess)); \
89 dbus_error_free (&error); \
93 /* Macros for debugging. In order to enable them, build with
94 "make MYCPPFLAGS='-DDBUS_DEBUG'". */
96 #define XD_DEBUG_MESSAGE(...) \
99 snprintf (s, sizeof s, __VA_ARGS__); \
100 if (!noninteractive) \
101 printf ("%s: %s\n", __func__, s); \
102 message ("%s: %s", __func__, s); \
104 #define XD_DEBUG_VALID_LISP_OBJECT_P(object) \
106 if (!valid_lisp_object_p (object)) \
108 XD_DEBUG_MESSAGE ("%d Assertion failure", __LINE__); \
109 XD_SIGNAL1 (build_string ("Assertion failure")); \
113 #else /* !DBUS_DEBUG */
114 # define XD_DEBUG_MESSAGE(...) \
116 if (!NILP (Vdbus_debug)) \
119 snprintf (s, sizeof s, __VA_ARGS__); \
120 message ("%s: %s", __func__, s); \
123 # define XD_DEBUG_VALID_LISP_OBJECT_P(object)
126 /* Check whether TYPE is a basic DBusType. */
127 #ifdef HAVE_DBUS_TYPE_IS_VALID
128 #define XD_BASIC_DBUS_TYPE(type) \
129 (dbus_type_is_valid (type) && dbus_type_is_basic (type))
131 #ifdef DBUS_TYPE_UNIX_FD
132 #define XD_BASIC_DBUS_TYPE(type) \
133 ((type == DBUS_TYPE_BYTE) \
134 || (type == DBUS_TYPE_BOOLEAN) \
135 || (type == DBUS_TYPE_INT16) \
136 || (type == DBUS_TYPE_UINT16) \
137 || (type == DBUS_TYPE_INT32) \
138 || (type == DBUS_TYPE_UINT32) \
139 || (type == DBUS_TYPE_INT64) \
140 || (type == DBUS_TYPE_UINT64) \
141 || (type == DBUS_TYPE_DOUBLE) \
142 || (type == DBUS_TYPE_STRING) \
143 || (type == DBUS_TYPE_OBJECT_PATH) \
144 || (type == DBUS_TYPE_SIGNATURE) \
145 || (type == DBUS_TYPE_UNIX_FD))
147 #define XD_BASIC_DBUS_TYPE(type) \
148 ((type == DBUS_TYPE_BYTE) \
149 || (type == DBUS_TYPE_BOOLEAN) \
150 || (type == DBUS_TYPE_INT16) \
151 || (type == DBUS_TYPE_UINT16) \
152 || (type == DBUS_TYPE_INT32) \
153 || (type == DBUS_TYPE_UINT32) \
154 || (type == DBUS_TYPE_INT64) \
155 || (type == DBUS_TYPE_UINT64) \
156 || (type == DBUS_TYPE_DOUBLE) \
157 || (type == DBUS_TYPE_STRING) \
158 || (type == DBUS_TYPE_OBJECT_PATH) \
159 || (type == DBUS_TYPE_SIGNATURE))
163 /* This was a macro. On Solaris 2.11 it was said to compile for
164 hours, when optimization is enabled. So we have transferred it into
166 /* Determine the DBusType of a given Lisp symbol. OBJECT must be one
167 of the predefined D-Bus type symbols. */
169 xd_symbol_to_dbus_type (Lisp_Object object
)
172 (EQ (object
, QCbyte
) ? DBUS_TYPE_BYTE
173 : EQ (object
, QCboolean
) ? DBUS_TYPE_BOOLEAN
174 : EQ (object
, QCint16
) ? DBUS_TYPE_INT16
175 : EQ (object
, QCuint16
) ? DBUS_TYPE_UINT16
176 : EQ (object
, QCint32
) ? DBUS_TYPE_INT32
177 : EQ (object
, QCuint32
) ? DBUS_TYPE_UINT32
178 : EQ (object
, QCint64
) ? DBUS_TYPE_INT64
179 : EQ (object
, QCuint64
) ? DBUS_TYPE_UINT64
180 : EQ (object
, QCdouble
) ? DBUS_TYPE_DOUBLE
181 : EQ (object
, QCstring
) ? DBUS_TYPE_STRING
182 : EQ (object
, QCobject_path
) ? DBUS_TYPE_OBJECT_PATH
183 : EQ (object
, QCsignature
) ? DBUS_TYPE_SIGNATURE
184 #ifdef DBUS_TYPE_UNIX_FD
185 : EQ (object
, QCunix_fd
) ? DBUS_TYPE_UNIX_FD
187 : EQ (object
, QCarray
) ? DBUS_TYPE_ARRAY
188 : EQ (object
, QCvariant
) ? DBUS_TYPE_VARIANT
189 : EQ (object
, QCstruct
) ? DBUS_TYPE_STRUCT
190 : EQ (object
, QCdict_entry
) ? DBUS_TYPE_DICT_ENTRY
191 : DBUS_TYPE_INVALID
);
194 /* Check whether a Lisp symbol is a predefined D-Bus type symbol. */
195 #define XD_DBUS_TYPE_P(object) \
196 (SYMBOLP (object) && ((xd_symbol_to_dbus_type (object) != DBUS_TYPE_INVALID)))
198 /* Determine the DBusType of a given Lisp OBJECT. It is used to
199 convert Lisp objects, being arguments of `dbus-call-method' or
200 `dbus-send-signal', into corresponding C values appended as
201 arguments to a D-Bus message. */
202 #define XD_OBJECT_TO_DBUS_TYPE(object) \
203 ((EQ (object, Qt) || EQ (object, Qnil)) ? DBUS_TYPE_BOOLEAN \
204 : (NATNUMP (object)) ? DBUS_TYPE_UINT32 \
205 : (INTEGERP (object)) ? DBUS_TYPE_INT32 \
206 : (FLOATP (object)) ? DBUS_TYPE_DOUBLE \
207 : (STRINGP (object)) ? DBUS_TYPE_STRING \
208 : (XD_DBUS_TYPE_P (object)) ? xd_symbol_to_dbus_type (object) \
210 ? ((XD_DBUS_TYPE_P (CAR_SAFE (object))) \
211 ? ((XD_BASIC_DBUS_TYPE (xd_symbol_to_dbus_type (CAR_SAFE (object)))) \
213 : xd_symbol_to_dbus_type (CAR_SAFE (object))) \
217 /* Return a list pointer which does not have a Lisp symbol as car. */
218 #define XD_NEXT_VALUE(object) \
219 ((XD_DBUS_TYPE_P (CAR_SAFE (object))) ? CDR_SAFE (object) : object)
221 /* Transform the message type to its string representation for debug
223 #define XD_MESSAGE_TYPE_TO_STRING(mtype) \
224 ((mtype == DBUS_MESSAGE_TYPE_INVALID) \
225 ? "DBUS_MESSAGE_TYPE_INVALID" \
226 : (mtype == DBUS_MESSAGE_TYPE_METHOD_CALL) \
227 ? "DBUS_MESSAGE_TYPE_METHOD_CALL" \
228 : (mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN) \
229 ? "DBUS_MESSAGE_TYPE_METHOD_RETURN" \
230 : (mtype == DBUS_MESSAGE_TYPE_ERROR) \
231 ? "DBUS_MESSAGE_TYPE_ERROR" \
232 : "DBUS_MESSAGE_TYPE_SIGNAL")
234 /* Transform the object to its string representation for debug
237 XD_OBJECT_TO_STRING (Lisp_Object object
)
239 AUTO_STRING (format
, "%s");
240 Lisp_Object args
[] = { format
, object
};
241 return SSDATA (styled_format (ARRAYELTS (args
), args
, false, false));
244 #define XD_DBUS_VALIDATE_BUS_ADDRESS(bus) \
246 char const *session_bus_address = getenv ("DBUS_SESSION_BUS_ADDRESS"); \
249 DBusAddressEntry **entries; \
252 dbus_error_init (&derror); \
253 if (!dbus_parse_address (SSDATA (bus), &entries, &len, &derror)) \
256 dbus_error_free (&derror); \
257 dbus_address_entries_free (entries); \
258 /* Canonicalize session bus address. */ \
259 if ((session_bus_address != NULL) \
260 && (!NILP (Fstring_equal \
261 (bus, build_string (session_bus_address))))) \
267 CHECK_SYMBOL (bus); \
268 if (!(EQ (bus, QCsystem) || EQ (bus, QCsession))) \
269 XD_SIGNAL2 (build_string ("Wrong bus name"), bus); \
270 /* We do not want to have an autolaunch for the session bus. */ \
271 if (EQ (bus, QCsession) && session_bus_address == NULL) \
272 XD_SIGNAL2 (build_string ("No connection to bus"), bus); \
276 #if (HAVE_DBUS_VALIDATE_BUS_NAME || HAVE_DBUS_VALIDATE_PATH \
277 || HAVE_DBUS_VALIDATE_INTERFACE || HAVE_DBUS_VALIDATE_MEMBER)
278 #define XD_DBUS_VALIDATE_OBJECT(object, func) \
280 if (!NILP (object)) \
283 CHECK_STRING (object); \
284 dbus_error_init (&derror); \
285 if (!func (SSDATA (object), &derror)) \
288 dbus_error_free (&derror); \
293 #if HAVE_DBUS_VALIDATE_BUS_NAME
294 #define XD_DBUS_VALIDATE_BUS_NAME(bus_name) \
295 XD_DBUS_VALIDATE_OBJECT(bus_name, dbus_validate_bus_name);
297 #define XD_DBUS_VALIDATE_BUS_NAME(bus_name) \
298 if (!NILP (bus_name)) CHECK_STRING (bus_name);
301 #if HAVE_DBUS_VALIDATE_PATH
302 #define XD_DBUS_VALIDATE_PATH(path) \
303 XD_DBUS_VALIDATE_OBJECT(path, dbus_validate_path);
305 #define XD_DBUS_VALIDATE_PATH(path) \
306 if (!NILP (path)) CHECK_STRING (path);
309 #if HAVE_DBUS_VALIDATE_INTERFACE
310 #define XD_DBUS_VALIDATE_INTERFACE(interface) \
311 XD_DBUS_VALIDATE_OBJECT(interface, dbus_validate_interface);
313 #define XD_DBUS_VALIDATE_INTERFACE(interface) \
314 if (!NILP (interface)) CHECK_STRING (interface);
317 #if HAVE_DBUS_VALIDATE_MEMBER
318 #define XD_DBUS_VALIDATE_MEMBER(member) \
319 XD_DBUS_VALIDATE_OBJECT(member, dbus_validate_member);
321 #define XD_DBUS_VALIDATE_MEMBER(member) \
322 if (!NILP (member)) CHECK_STRING (member);
325 /* Append to SIGNATURE a copy of X, making sure SIGNATURE does
326 not become too long. */
328 xd_signature_cat (char *signature
, char const *x
)
330 ptrdiff_t siglen
= strlen (signature
);
331 ptrdiff_t xlen
= strlen (x
);
332 if (DBUS_MAXIMUM_SIGNATURE_LENGTH
- xlen
<= siglen
)
334 strcpy (signature
+ siglen
, x
);
337 /* Compute SIGNATURE of OBJECT. It must have a form that it can be
338 used in dbus_message_iter_open_container. DTYPE is the DBusType
339 the object is related to. It is passed as argument, because it
340 cannot be detected in basic type objects, when they are preceded by
341 a type symbol. PARENT_TYPE is the DBusType of a container this
342 signature is embedded, or DBUS_TYPE_INVALID. It is needed for the
343 check that DBUS_TYPE_DICT_ENTRY occurs only as array element. */
345 xd_signature (char *signature
, int dtype
, int parent_type
, Lisp_Object object
)
351 char x
[DBUS_MAXIMUM_SIGNATURE_LENGTH
];
358 case DBUS_TYPE_UINT16
:
359 CHECK_NATNUM (object
);
360 sprintf (signature
, "%c", dtype
);
363 case DBUS_TYPE_BOOLEAN
:
364 if (!EQ (object
, Qt
) && !EQ (object
, Qnil
))
365 wrong_type_argument (intern ("booleanp"), object
);
366 sprintf (signature
, "%c", dtype
);
369 case DBUS_TYPE_INT16
:
370 CHECK_NUMBER (object
);
371 sprintf (signature
, "%c", dtype
);
374 case DBUS_TYPE_UINT32
:
375 case DBUS_TYPE_UINT64
:
376 #ifdef DBUS_TYPE_UNIX_FD
377 case DBUS_TYPE_UNIX_FD
:
379 case DBUS_TYPE_INT32
:
380 case DBUS_TYPE_INT64
:
381 case DBUS_TYPE_DOUBLE
:
382 CHECK_NUMBER_OR_FLOAT (object
);
383 sprintf (signature
, "%c", dtype
);
386 case DBUS_TYPE_STRING
:
387 case DBUS_TYPE_OBJECT_PATH
:
388 case DBUS_TYPE_SIGNATURE
:
389 CHECK_STRING (object
);
390 sprintf (signature
, "%c", dtype
);
393 case DBUS_TYPE_ARRAY
:
394 /* Check that all list elements have the same D-Bus type. For
395 complex element types, we just check the container type, not
396 the whole element's signature. */
399 /* Type symbol is optional. */
400 if (EQ (QCarray
, CAR_SAFE (elt
)))
401 elt
= XD_NEXT_VALUE (elt
);
403 /* If the array is empty, DBUS_TYPE_STRING is the default
407 subtype
= DBUS_TYPE_STRING
;
408 subsig
= DBUS_TYPE_STRING_AS_STRING
;
412 subtype
= XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt
));
413 xd_signature (x
, subtype
, dtype
, CAR_SAFE (XD_NEXT_VALUE (elt
)));
417 /* If the element type is DBUS_TYPE_SIGNATURE, and this is the
418 only element, the value of this element is used as the
419 array's element signature. */
420 if ((subtype
== DBUS_TYPE_SIGNATURE
)
421 && STRINGP (CAR_SAFE (XD_NEXT_VALUE (elt
)))
422 && NILP (CDR_SAFE (XD_NEXT_VALUE (elt
))))
423 subsig
= SSDATA (CAR_SAFE (XD_NEXT_VALUE (elt
)));
427 if (subtype
!= XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt
)))
428 wrong_type_argument (intern ("D-Bus"), CAR_SAFE (elt
));
429 elt
= CDR_SAFE (XD_NEXT_VALUE (elt
));
432 subsiglen
= snprintf (signature
, DBUS_MAXIMUM_SIGNATURE_LENGTH
,
433 "%c%s", dtype
, subsig
);
434 if (! (0 <= subsiglen
&& subsiglen
< DBUS_MAXIMUM_SIGNATURE_LENGTH
))
438 case DBUS_TYPE_VARIANT
:
439 /* Check that there is exactly one list element. */
442 elt
= XD_NEXT_VALUE (elt
);
443 subtype
= XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt
));
444 xd_signature (x
, subtype
, dtype
, CAR_SAFE (XD_NEXT_VALUE (elt
)));
446 if (!NILP (CDR_SAFE (XD_NEXT_VALUE (elt
))))
447 wrong_type_argument (intern ("D-Bus"),
448 CAR_SAFE (CDR_SAFE (XD_NEXT_VALUE (elt
))));
450 sprintf (signature
, "%c", dtype
);
453 case DBUS_TYPE_STRUCT
:
454 /* A struct list might contain any number of elements with
455 different types. No further check needed. */
458 elt
= XD_NEXT_VALUE (elt
);
460 /* Compose the signature from the elements. It is enclosed by
462 sprintf (signature
, "%c", DBUS_STRUCT_BEGIN_CHAR
);
465 subtype
= XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt
));
466 xd_signature (x
, subtype
, dtype
, CAR_SAFE (XD_NEXT_VALUE (elt
)));
467 xd_signature_cat (signature
, x
);
468 elt
= CDR_SAFE (XD_NEXT_VALUE (elt
));
470 xd_signature_cat (signature
, DBUS_STRUCT_END_CHAR_AS_STRING
);
473 case DBUS_TYPE_DICT_ENTRY
:
474 /* Check that there are exactly two list elements, and the first
475 one is of basic type. The dictionary entry itself must be an
476 element of an array. */
479 /* Check the parent object type. */
480 if (parent_type
!= DBUS_TYPE_ARRAY
)
481 wrong_type_argument (intern ("D-Bus"), object
);
483 /* Compose the signature from the elements. It is enclosed by
485 sprintf (signature
, "%c", DBUS_DICT_ENTRY_BEGIN_CHAR
);
488 elt
= XD_NEXT_VALUE (elt
);
489 subtype
= XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt
));
490 xd_signature (x
, subtype
, dtype
, CAR_SAFE (XD_NEXT_VALUE (elt
)));
491 xd_signature_cat (signature
, x
);
493 if (!XD_BASIC_DBUS_TYPE (subtype
))
494 wrong_type_argument (intern ("D-Bus"), CAR_SAFE (XD_NEXT_VALUE (elt
)));
496 /* Second element. */
497 elt
= CDR_SAFE (XD_NEXT_VALUE (elt
));
498 subtype
= XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt
));
499 xd_signature (x
, subtype
, dtype
, CAR_SAFE (XD_NEXT_VALUE (elt
)));
500 xd_signature_cat (signature
, x
);
502 if (!NILP (CDR_SAFE (XD_NEXT_VALUE (elt
))))
503 wrong_type_argument (intern ("D-Bus"),
504 CAR_SAFE (CDR_SAFE (XD_NEXT_VALUE (elt
))));
506 /* Closing signature. */
507 xd_signature_cat (signature
, DBUS_DICT_ENTRY_END_CHAR_AS_STRING
);
511 wrong_type_argument (intern ("D-Bus"), object
);
514 XD_DEBUG_MESSAGE ("%s", signature
);
517 /* Convert X to a signed integer with bounds LO and HI. */
519 xd_extract_signed (Lisp_Object x
, intmax_t lo
, intmax_t hi
)
521 CHECK_NUMBER_OR_FLOAT (x
);
524 if (lo
<= XINT (x
) && XINT (x
) <= hi
)
529 double d
= XFLOAT_DATA (x
);
530 if (lo
<= d
&& d
< 1.0 + hi
)
537 if (xd_in_read_queued_messages
)
538 Fthrow (Qdbus_error
, Qnil
);
540 args_out_of_range_3 (x
,
541 make_fixnum_or_float (lo
),
542 make_fixnum_or_float (hi
));
545 /* Convert X to an unsigned integer with bounds 0 and HI. */
547 xd_extract_unsigned (Lisp_Object x
, uintmax_t hi
)
549 CHECK_NUMBER_OR_FLOAT (x
);
552 if (0 <= XINT (x
) && XINT (x
) <= hi
)
557 double d
= XFLOAT_DATA (x
);
558 if (0 <= d
&& d
< 1.0 + hi
)
565 if (xd_in_read_queued_messages
)
566 Fthrow (Qdbus_error
, Qnil
);
568 args_out_of_range_3 (x
, make_number (0), make_fixnum_or_float (hi
));
571 /* Append C value, extracted from Lisp OBJECT, to iteration ITER.
572 DTYPE must be a valid DBusType. It is used to convert Lisp
573 objects, being arguments of `dbus-call-method' or
574 `dbus-send-signal', into corresponding C values appended as
575 arguments to a D-Bus message. */
577 xd_append_arg (int dtype
, Lisp_Object object
, DBusMessageIter
*iter
)
579 char signature
[DBUS_MAXIMUM_SIGNATURE_LENGTH
];
580 DBusMessageIter subiter
;
582 if (XD_BASIC_DBUS_TYPE (dtype
))
586 CHECK_NATNUM (object
);
588 unsigned char val
= XFASTINT (object
) & 0xFF;
589 XD_DEBUG_MESSAGE ("%c %u", dtype
, val
);
590 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
591 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
595 case DBUS_TYPE_BOOLEAN
:
597 dbus_bool_t val
= (NILP (object
)) ? FALSE
: TRUE
;
598 XD_DEBUG_MESSAGE ("%c %s", dtype
, (val
== FALSE
) ? "false" : "true");
599 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
600 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
604 case DBUS_TYPE_INT16
:
607 xd_extract_signed (object
,
608 TYPE_MINIMUM (dbus_int16_t
),
609 TYPE_MAXIMUM (dbus_int16_t
));
611 XD_DEBUG_MESSAGE ("%c %d", dtype
, pval
);
612 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
613 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
617 case DBUS_TYPE_UINT16
:
620 xd_extract_unsigned (object
,
621 TYPE_MAXIMUM (dbus_uint16_t
));
622 unsigned int pval
= val
;
623 XD_DEBUG_MESSAGE ("%c %u", dtype
, pval
);
624 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
625 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
629 case DBUS_TYPE_INT32
:
632 xd_extract_signed (object
,
633 TYPE_MINIMUM (dbus_int32_t
),
634 TYPE_MAXIMUM (dbus_int32_t
));
636 XD_DEBUG_MESSAGE ("%c %d", dtype
, pval
);
637 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
638 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
642 case DBUS_TYPE_UINT32
:
643 #ifdef DBUS_TYPE_UNIX_FD
644 case DBUS_TYPE_UNIX_FD
:
648 xd_extract_unsigned (object
,
649 TYPE_MAXIMUM (dbus_uint32_t
));
650 unsigned int pval
= val
;
651 XD_DEBUG_MESSAGE ("%c %u", dtype
, pval
);
652 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
653 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
657 case DBUS_TYPE_INT64
:
660 xd_extract_signed (object
,
661 TYPE_MINIMUM (dbus_int64_t
),
662 TYPE_MAXIMUM (dbus_int64_t
));
663 printmax_t pval
= val
;
664 XD_DEBUG_MESSAGE ("%c %"pMd
, dtype
, pval
);
665 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
666 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
670 case DBUS_TYPE_UINT64
:
673 xd_extract_unsigned (object
,
674 TYPE_MAXIMUM (dbus_uint64_t
));
675 uprintmax_t pval
= val
;
676 XD_DEBUG_MESSAGE ("%c %"pMu
, dtype
, pval
);
677 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
678 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
682 case DBUS_TYPE_DOUBLE
:
684 double val
= extract_float (object
);
685 XD_DEBUG_MESSAGE ("%c %f", dtype
, val
);
686 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
687 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
691 case DBUS_TYPE_STRING
:
692 case DBUS_TYPE_OBJECT_PATH
:
693 case DBUS_TYPE_SIGNATURE
:
694 CHECK_STRING (object
);
696 /* We need to send a valid UTF-8 string. We could encode `object'
697 but by not encoding it, we guarantee it's valid utf-8, even if
698 it contains eight-bit-bytes. Of course, you can still send
699 manually-crafted junk by passing a unibyte string. */
700 char *val
= SSDATA (object
);
701 XD_DEBUG_MESSAGE ("%c %s", dtype
, val
);
702 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
703 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
708 else /* Compound types. */
711 /* All compound types except array have a type symbol. For
712 array, it is optional. Skip it. */
713 if (!XD_BASIC_DBUS_TYPE (XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object
))))
714 object
= XD_NEXT_VALUE (object
);
716 /* Open new subiteration. */
719 case DBUS_TYPE_ARRAY
:
720 /* An array has only elements of the same type. So it is
721 sufficient to check the first element's signature
725 /* If the array is empty, DBUS_TYPE_STRING is the default
727 strcpy (signature
, DBUS_TYPE_STRING_AS_STRING
);
730 /* If the element type is DBUS_TYPE_SIGNATURE, and this is
731 the only element, the value of this element is used as
732 the array's element signature. */
733 if ((XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object
))
734 == DBUS_TYPE_SIGNATURE
)
735 && STRINGP (CAR_SAFE (XD_NEXT_VALUE (object
)))
736 && NILP (CDR_SAFE (XD_NEXT_VALUE (object
))))
738 lispstpcpy (signature
, CAR_SAFE (XD_NEXT_VALUE (object
)));
739 object
= CDR_SAFE (XD_NEXT_VALUE (object
));
743 xd_signature (signature
,
744 XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object
)),
745 dtype
, CAR_SAFE (XD_NEXT_VALUE (object
)));
747 XD_DEBUG_MESSAGE ("%c %s %s", dtype
, signature
,
748 XD_OBJECT_TO_STRING (object
));
749 if (!dbus_message_iter_open_container (iter
, dtype
,
750 signature
, &subiter
))
751 XD_SIGNAL3 (build_string ("Cannot open container"),
752 make_number (dtype
), build_string (signature
));
755 case DBUS_TYPE_VARIANT
:
756 /* A variant has just one element. */
757 xd_signature (signature
, XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object
)),
758 dtype
, CAR_SAFE (XD_NEXT_VALUE (object
)));
760 XD_DEBUG_MESSAGE ("%c %s %s", dtype
, signature
,
761 XD_OBJECT_TO_STRING (object
));
762 if (!dbus_message_iter_open_container (iter
, dtype
,
763 signature
, &subiter
))
764 XD_SIGNAL3 (build_string ("Cannot open container"),
765 make_number (dtype
), build_string (signature
));
768 case DBUS_TYPE_STRUCT
:
769 case DBUS_TYPE_DICT_ENTRY
:
770 /* These containers do not require a signature. */
771 XD_DEBUG_MESSAGE ("%c %s", dtype
, XD_OBJECT_TO_STRING (object
));
772 if (!dbus_message_iter_open_container (iter
, dtype
, NULL
, &subiter
))
773 XD_SIGNAL2 (build_string ("Cannot open container"),
774 make_number (dtype
));
778 /* Loop over list elements. */
779 while (!NILP (object
))
781 dtype
= XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object
));
782 object
= XD_NEXT_VALUE (object
);
784 xd_append_arg (dtype
, CAR_SAFE (object
), &subiter
);
786 object
= CDR_SAFE (object
);
789 /* Close the subiteration. */
790 if (!dbus_message_iter_close_container (iter
, &subiter
))
791 XD_SIGNAL2 (build_string ("Cannot close container"),
792 make_number (dtype
));
796 /* Retrieve C value from a DBusMessageIter structure ITER, and return
797 a converted Lisp object. The type DTYPE of the argument of the
798 D-Bus message must be a valid DBusType. Compound D-Bus types
799 result always in a Lisp list. */
801 xd_retrieve_arg (int dtype
, DBusMessageIter
*iter
)
809 dbus_message_iter_get_basic (iter
, &val
);
811 XD_DEBUG_MESSAGE ("%c %u", dtype
, val
);
812 return make_number (val
);
815 case DBUS_TYPE_BOOLEAN
:
818 dbus_message_iter_get_basic (iter
, &val
);
819 XD_DEBUG_MESSAGE ("%c %s", dtype
, (val
== FALSE
) ? "false" : "true");
820 return (val
== FALSE
) ? Qnil
: Qt
;
823 case DBUS_TYPE_INT16
:
827 dbus_message_iter_get_basic (iter
, &val
);
829 XD_DEBUG_MESSAGE ("%c %d", dtype
, pval
);
830 return make_number (val
);
833 case DBUS_TYPE_UINT16
:
837 dbus_message_iter_get_basic (iter
, &val
);
839 XD_DEBUG_MESSAGE ("%c %d", dtype
, pval
);
840 return make_number (val
);
843 case DBUS_TYPE_INT32
:
847 dbus_message_iter_get_basic (iter
, &val
);
849 XD_DEBUG_MESSAGE ("%c %d", dtype
, pval
);
850 return make_fixnum_or_float (val
);
853 case DBUS_TYPE_UINT32
:
854 #ifdef DBUS_TYPE_UNIX_FD
855 case DBUS_TYPE_UNIX_FD
:
860 dbus_message_iter_get_basic (iter
, &val
);
862 XD_DEBUG_MESSAGE ("%c %u", dtype
, pval
);
863 return make_fixnum_or_float (val
);
866 case DBUS_TYPE_INT64
:
870 dbus_message_iter_get_basic (iter
, &val
);
872 XD_DEBUG_MESSAGE ("%c %"pMd
, dtype
, pval
);
873 return make_fixnum_or_float (val
);
876 case DBUS_TYPE_UINT64
:
880 dbus_message_iter_get_basic (iter
, &val
);
882 XD_DEBUG_MESSAGE ("%c %"pMu
, dtype
, pval
);
883 return make_fixnum_or_float (val
);
886 case DBUS_TYPE_DOUBLE
:
889 dbus_message_iter_get_basic (iter
, &val
);
890 XD_DEBUG_MESSAGE ("%c %f", dtype
, val
);
891 return make_float (val
);
894 case DBUS_TYPE_STRING
:
895 case DBUS_TYPE_OBJECT_PATH
:
896 case DBUS_TYPE_SIGNATURE
:
899 dbus_message_iter_get_basic (iter
, &val
);
900 XD_DEBUG_MESSAGE ("%c %s", dtype
, val
);
901 return build_string (val
);
904 case DBUS_TYPE_ARRAY
:
905 case DBUS_TYPE_VARIANT
:
906 case DBUS_TYPE_STRUCT
:
907 case DBUS_TYPE_DICT_ENTRY
:
910 DBusMessageIter subiter
;
913 dbus_message_iter_recurse (iter
, &subiter
);
914 while ((subtype
= dbus_message_iter_get_arg_type (&subiter
))
915 != DBUS_TYPE_INVALID
)
917 result
= Fcons (xd_retrieve_arg (subtype
, &subiter
), result
);
918 dbus_message_iter_next (&subiter
);
920 XD_DEBUG_MESSAGE ("%c %s", dtype
, XD_OBJECT_TO_STRING (result
));
921 return Fnreverse (result
);
925 XD_DEBUG_MESSAGE ("DBusType '%c' not supported", dtype
);
930 /* Return the number of references of the shared CONNECTION. */
932 xd_get_connection_references (DBusConnection
*connection
)
936 /* We cannot access the DBusConnection structure, it is not public.
937 But we know, that the reference counter is the first field in
939 refcount
= (void *) &connection
;
940 refcount
= (void *) *refcount
;
944 /* Convert a Lisp D-Bus object to a pointer. */
945 static DBusConnection
*
946 xd_lisp_dbus_to_dbus (Lisp_Object bus
)
948 return (DBusConnection
*) XSAVE_POINTER (bus
, 0);
951 /* Return D-Bus connection address. BUS is either a Lisp symbol,
952 :system or :session, or a string denoting the bus address. */
953 static DBusConnection
*
954 xd_get_connection_address (Lisp_Object bus
)
956 DBusConnection
*connection
;
959 val
= CDR_SAFE (Fassoc (bus
, xd_registered_buses
, Qnil
));
961 XD_SIGNAL2 (build_string ("No connection to bus"), bus
);
963 connection
= xd_lisp_dbus_to_dbus (val
);
965 if (!dbus_connection_get_is_connected (connection
))
966 XD_SIGNAL2 (build_string ("No connection to bus"), bus
);
971 /* Return the file descriptor for WATCH, -1 if not found. */
973 xd_find_watch_fd (DBusWatch
*watch
)
975 #if HAVE_DBUS_WATCH_GET_UNIX_FD
976 /* TODO: Reverse these on w32, which prefers the opposite. */
977 int fd
= dbus_watch_get_unix_fd (watch
);
979 fd
= dbus_watch_get_socket (watch
);
981 int fd
= dbus_watch_get_fd (watch
);
987 static void xd_read_queued_messages (int fd
, void *data
);
989 /* Start monitoring WATCH for possible I/O. */
991 xd_add_watch (DBusWatch
*watch
, void *data
)
993 unsigned int flags
= dbus_watch_get_flags (watch
);
994 int fd
= xd_find_watch_fd (watch
);
996 XD_DEBUG_MESSAGE ("fd %d, write %u, enabled %u",
997 fd
, flags
& DBUS_WATCH_WRITABLE
,
998 dbus_watch_get_enabled (watch
));
1003 if (dbus_watch_get_enabled (watch
))
1005 if (flags
& DBUS_WATCH_WRITABLE
)
1006 add_write_fd (fd
, xd_read_queued_messages
, data
);
1007 if (flags
& DBUS_WATCH_READABLE
)
1008 add_read_fd (fd
, xd_read_queued_messages
, data
);
1013 /* Stop monitoring WATCH for possible I/O.
1014 DATA is the used bus, either a string or QCsystem or QCsession. */
1016 xd_remove_watch (DBusWatch
*watch
, void *data
)
1018 unsigned int flags
= dbus_watch_get_flags (watch
);
1019 int fd
= xd_find_watch_fd (watch
);
1021 XD_DEBUG_MESSAGE ("fd %d", fd
);
1026 /* Unset session environment. */
1028 /* This is buggy, since unsetenv is not thread-safe. */
1029 if (XSYMBOL (QCsession
) == data
)
1031 XD_DEBUG_MESSAGE ("unsetenv DBUS_SESSION_BUS_ADDRESS");
1032 unsetenv ("DBUS_SESSION_BUS_ADDRESS");
1036 if (flags
& DBUS_WATCH_WRITABLE
)
1037 delete_write_fd (fd
);
1038 if (flags
& DBUS_WATCH_READABLE
)
1039 delete_read_fd (fd
);
1042 /* Toggle monitoring WATCH for possible I/O. */
1044 xd_toggle_watch (DBusWatch
*watch
, void *data
)
1046 if (dbus_watch_get_enabled (watch
))
1047 xd_add_watch (watch
, data
);
1049 xd_remove_watch (watch
, data
);
1052 /* Close connection to D-Bus BUS. */
1054 xd_close_bus (Lisp_Object bus
)
1056 DBusConnection
*connection
;
1060 /* Check whether we are connected. */
1061 val
= Fassoc (bus
, xd_registered_buses
, Qnil
);
1065 busobj
= CDR_SAFE (val
);
1066 if (NILP (busobj
)) {
1067 xd_registered_buses
= Fdelete (val
, xd_registered_buses
);
1071 /* Retrieve bus address. */
1072 connection
= xd_lisp_dbus_to_dbus (busobj
);
1074 if (xd_get_connection_references (connection
) == 1)
1076 /* Close connection, if there isn't another shared application. */
1077 XD_DEBUG_MESSAGE ("Close connection to bus %s",
1078 XD_OBJECT_TO_STRING (bus
));
1079 dbus_connection_close (connection
);
1081 xd_registered_buses
= Fdelete (val
, xd_registered_buses
);
1085 /* Decrement reference count. */
1086 dbus_connection_unref (connection
);
1092 DEFUN ("dbus--init-bus", Fdbus__init_bus
, Sdbus__init_bus
, 1, 2, 0,
1093 doc
: /* Establish the connection to D-Bus BUS.
1095 This function is dbus internal. You almost certainly want to use
1098 BUS can be either the symbol `:system' or the symbol `:session', or it
1099 can be a string denoting the address of the corresponding bus. For
1100 the system and session buses, this function is called when loading
1101 `dbus.el', there is no need to call it again.
1103 The function returns a number, which counts the connections this Emacs
1104 session has established to the BUS under the same unique name (see
1105 `dbus-get-unique-name'). It depends on the libraries Emacs is linked
1106 with, and on the environment Emacs is running. For example, if Emacs
1107 is linked with the gtk toolkit, and it runs in a GTK-aware environment
1108 like Gnome, another connection might already be established.
1110 When PRIVATE is non-nil, a new connection is established instead of
1111 reusing an existing one. It results in a new unique name at the bus.
1112 This can be used, if it is necessary to distinguish from another
1113 connection used in the same Emacs process, like the one established by
1114 GTK+. It should be used with care for at least the `:system' and
1115 `:session' buses, because other Emacs Lisp packages might already use
1116 this connection to those buses. */)
1117 (Lisp_Object bus
, Lisp_Object
private)
1119 DBusConnection
*connection
;
1124 /* Check parameter. */
1125 XD_DBUS_VALIDATE_BUS_ADDRESS (bus
);
1127 /* Close bus if it is already open. */
1130 /* Check, whether we are still connected. */
1131 val
= Fassoc (bus
, xd_registered_buses
, Qnil
);
1134 connection
= xd_get_connection_address (bus
);
1135 dbus_connection_ref (connection
);
1141 dbus_error_init (&derror
);
1143 /* Open the connection. */
1146 connection
= dbus_connection_open (SSDATA (bus
), &derror
);
1148 connection
= dbus_connection_open_private (SSDATA (bus
), &derror
);
1152 DBusBusType bustype
= (EQ (bus
, QCsystem
)
1153 ? DBUS_BUS_SYSTEM
: DBUS_BUS_SESSION
);
1155 connection
= dbus_bus_get (bustype
, &derror
);
1157 connection
= dbus_bus_get_private (bustype
, &derror
);
1160 if (dbus_error_is_set (&derror
))
1163 if (connection
== NULL
)
1164 XD_SIGNAL2 (build_string ("No connection to bus"), bus
);
1166 /* If it is not the system or session bus, we must register
1167 ourselves. Otherwise, we have called dbus_bus_get, which has
1168 configured us to exit if the connection closes - we undo this
1171 dbus_bus_register (connection
, &derror
);
1173 dbus_connection_set_exit_on_disconnect (connection
, FALSE
);
1175 if (dbus_error_is_set (&derror
))
1178 /* Add the watch functions. We pass also the bus as data, in
1179 order to distinguish between the buses in xd_remove_watch. */
1180 if (!dbus_connection_set_watch_functions (connection
,
1185 ? (void *) XSYMBOL (bus
)
1186 : (void *) XSTRING (bus
),
1188 XD_SIGNAL1 (build_string ("Cannot add watch functions"));
1190 /* Add bus to list of registered buses. */
1191 val
= make_save_ptr (connection
);
1192 xd_registered_buses
= Fcons (Fcons (bus
, val
), xd_registered_buses
);
1195 dbus_error_free (&derror
);
1198 /* Return reference counter. */
1199 refcount
= xd_get_connection_references (connection
);
1200 XD_DEBUG_MESSAGE ("Bus %s, Reference counter %"pD
"d",
1201 XD_OBJECT_TO_STRING (bus
), refcount
);
1202 return make_number (refcount
);
1205 DEFUN ("dbus-get-unique-name", Fdbus_get_unique_name
, Sdbus_get_unique_name
,
1207 doc
: /* Return the unique name of Emacs registered at D-Bus BUS. */)
1210 DBusConnection
*connection
;
1213 /* Check parameter. */
1214 XD_DBUS_VALIDATE_BUS_ADDRESS (bus
);
1216 /* Retrieve bus address. */
1217 connection
= xd_get_connection_address (bus
);
1219 /* Request the name. */
1220 name
= dbus_bus_get_unique_name (connection
);
1222 XD_SIGNAL1 (build_string ("No unique name available"));
1225 return build_string (name
);
1228 DEFUN ("dbus-message-internal", Fdbus_message_internal
, Sdbus_message_internal
,
1230 doc
: /* Send a D-Bus message.
1231 This is an internal function, it shall not be used outside dbus.el.
1233 The following usages are expected:
1235 `dbus-call-method', `dbus-call-method-asynchronously':
1236 (dbus-message-internal
1237 dbus-message-type-method-call BUS SERVICE PATH INTERFACE METHOD HANDLER
1238 &optional :timeout TIMEOUT &rest ARGS)
1241 (dbus-message-internal
1242 dbus-message-type-signal BUS SERVICE PATH INTERFACE SIGNAL &rest ARGS)
1244 `dbus-method-return-internal':
1245 (dbus-message-internal
1246 dbus-message-type-method-return BUS SERVICE SERIAL &rest ARGS)
1248 `dbus-method-error-internal':
1249 (dbus-message-internal
1250 dbus-message-type-error BUS SERVICE SERIAL &rest ARGS)
1252 usage: (dbus-message-internal &rest REST) */)
1253 (ptrdiff_t nargs
, Lisp_Object
*args
)
1255 Lisp_Object message_type
, bus
, service
, handler
;
1256 Lisp_Object path
= Qnil
;
1257 Lisp_Object interface
= Qnil
;
1258 Lisp_Object member
= Qnil
;
1260 DBusConnection
*connection
;
1261 DBusMessage
*dmessage
;
1262 DBusMessageIter iter
;
1265 dbus_uint32_t serial
= 0;
1266 unsigned int ui_serial
;
1269 char signature
[DBUS_MAXIMUM_SIGNATURE_LENGTH
];
1271 /* Initialize parameters. */
1272 message_type
= args
[0];
1277 CHECK_NATNUM (message_type
);
1278 if (! (DBUS_MESSAGE_TYPE_INVALID
< XFASTINT (message_type
)
1279 && XFASTINT (message_type
) < DBUS_NUM_MESSAGE_TYPES
))
1280 XD_SIGNAL2 (build_string ("Invalid message type"), message_type
);
1281 mtype
= XFASTINT (message_type
);
1283 if ((mtype
== DBUS_MESSAGE_TYPE_METHOD_CALL
)
1284 || (mtype
== DBUS_MESSAGE_TYPE_SIGNAL
))
1287 interface
= args
[4];
1289 if (mtype
== DBUS_MESSAGE_TYPE_METHOD_CALL
)
1291 count
= (mtype
== DBUS_MESSAGE_TYPE_METHOD_CALL
) ? 7 : 6;
1293 else /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR */
1295 serial
= xd_extract_unsigned (args
[3], TYPE_MAXIMUM (dbus_uint32_t
));
1299 /* Check parameters. */
1300 XD_DBUS_VALIDATE_BUS_ADDRESS (bus
);
1301 XD_DBUS_VALIDATE_BUS_NAME (service
);
1303 xsignal2 (Qwrong_number_of_arguments
,
1304 Qdbus_message_internal
,
1305 make_number (nargs
));
1307 if ((mtype
== DBUS_MESSAGE_TYPE_METHOD_CALL
)
1308 || (mtype
== DBUS_MESSAGE_TYPE_SIGNAL
))
1310 XD_DBUS_VALIDATE_PATH (path
);
1311 XD_DBUS_VALIDATE_INTERFACE (interface
);
1312 XD_DBUS_VALIDATE_MEMBER (member
);
1313 if (!NILP (handler
) && !FUNCTIONP (handler
))
1314 wrong_type_argument (Qinvalid_function
, handler
);
1317 /* Trace parameters. */
1320 case DBUS_MESSAGE_TYPE_METHOD_CALL
:
1321 XD_DEBUG_MESSAGE ("%s %s %s %s %s %s %s",
1322 XD_MESSAGE_TYPE_TO_STRING (mtype
),
1323 XD_OBJECT_TO_STRING (bus
),
1324 XD_OBJECT_TO_STRING (service
),
1325 XD_OBJECT_TO_STRING (path
),
1326 XD_OBJECT_TO_STRING (interface
),
1327 XD_OBJECT_TO_STRING (member
),
1328 XD_OBJECT_TO_STRING (handler
));
1330 case DBUS_MESSAGE_TYPE_SIGNAL
:
1331 XD_DEBUG_MESSAGE ("%s %s %s %s %s %s",
1332 XD_MESSAGE_TYPE_TO_STRING (mtype
),
1333 XD_OBJECT_TO_STRING (bus
),
1334 XD_OBJECT_TO_STRING (service
),
1335 XD_OBJECT_TO_STRING (path
),
1336 XD_OBJECT_TO_STRING (interface
),
1337 XD_OBJECT_TO_STRING (member
));
1339 default: /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR */
1341 XD_DEBUG_MESSAGE ("%s %s %s %u",
1342 XD_MESSAGE_TYPE_TO_STRING (mtype
),
1343 XD_OBJECT_TO_STRING (bus
),
1344 XD_OBJECT_TO_STRING (service
),
1348 /* Retrieve bus address. */
1349 connection
= xd_get_connection_address (bus
);
1351 /* Create the D-Bus message. */
1352 dmessage
= dbus_message_new (mtype
);
1353 if (dmessage
== NULL
)
1354 XD_SIGNAL1 (build_string ("Unable to create a new message"));
1356 if (STRINGP (service
))
1358 if (mtype
!= DBUS_MESSAGE_TYPE_SIGNAL
)
1359 /* Set destination. */
1361 if (!dbus_message_set_destination (dmessage
, SSDATA (service
)))
1362 XD_SIGNAL2 (build_string ("Unable to set the destination"),
1367 /* Set destination for unicast signals. */
1371 /* If it is the same unique name as we are registered at the
1372 bus or an unknown name, we regard it as broadcast message
1373 due to backward compatibility. */
1374 if (dbus_bus_name_has_owner (connection
, SSDATA (service
), NULL
))
1375 uname
= call2 (intern ("dbus-get-name-owner"), bus
, service
);
1380 && (strcmp (dbus_bus_get_unique_name (connection
), SSDATA (uname
))
1382 && (!dbus_message_set_destination (dmessage
, SSDATA (service
))))
1383 XD_SIGNAL2 (build_string ("Unable to set signal destination"),
1388 /* Set message parameters. */
1389 if ((mtype
== DBUS_MESSAGE_TYPE_METHOD_CALL
)
1390 || (mtype
== DBUS_MESSAGE_TYPE_SIGNAL
))
1392 if ((!dbus_message_set_path (dmessage
, SSDATA (path
)))
1393 || (!dbus_message_set_interface (dmessage
, SSDATA (interface
)))
1394 || (!dbus_message_set_member (dmessage
, SSDATA (member
))))
1395 XD_SIGNAL1 (build_string ("Unable to set the message parameter"));
1398 else /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR */
1400 if (!dbus_message_set_reply_serial (dmessage
, serial
))
1401 XD_SIGNAL1 (build_string ("Unable to create a return message"));
1403 if ((mtype
== DBUS_MESSAGE_TYPE_ERROR
)
1404 && (!dbus_message_set_error_name (dmessage
, DBUS_ERROR_FAILED
)))
1405 XD_SIGNAL1 (build_string ("Unable to create a error message"));
1408 /* Check for timeout parameter. */
1409 if ((count
+ 2 <= nargs
) && EQ (args
[count
], QCtimeout
))
1411 CHECK_NATNUM (args
[count
+1]);
1412 timeout
= min (XFASTINT (args
[count
+1]), INT_MAX
);
1416 /* Initialize parameter list of message. */
1417 dbus_message_iter_init_append (dmessage
, &iter
);
1419 /* Append parameters to the message. */
1420 for (; count
< nargs
; ++count
)
1422 dtype
= XD_OBJECT_TO_DBUS_TYPE (args
[count
]);
1423 if (XD_DBUS_TYPE_P (args
[count
]))
1425 XD_DEBUG_VALID_LISP_OBJECT_P (args
[count
]);
1426 XD_DEBUG_VALID_LISP_OBJECT_P (args
[count
+1]);
1427 XD_DEBUG_MESSAGE ("Parameter%"pD
"d %s %s", count
- 4,
1428 XD_OBJECT_TO_STRING (args
[count
]),
1429 XD_OBJECT_TO_STRING (args
[count
+1]));
1434 XD_DEBUG_VALID_LISP_OBJECT_P (args
[count
]);
1435 XD_DEBUG_MESSAGE ("Parameter%"pD
"d %s", count
- 4,
1436 XD_OBJECT_TO_STRING (args
[count
]));
1439 /* Check for valid signature. We use DBUS_TYPE_INVALID as
1440 indication that there is no parent type. */
1441 xd_signature (signature
, dtype
, DBUS_TYPE_INVALID
, args
[count
]);
1443 xd_append_arg (dtype
, args
[count
], &iter
);
1446 if (!NILP (handler
))
1448 /* Send the message. The message is just added to the outgoing
1450 if (!dbus_connection_send_with_reply (connection
, dmessage
,
1452 XD_SIGNAL1 (build_string ("Cannot send message"));
1454 /* The result is the key in Vdbus_registered_objects_table. */
1455 serial
= dbus_message_get_serial (dmessage
);
1456 result
= list3 (QCserial
, bus
, make_fixnum_or_float (serial
));
1458 /* Create a hash table entry. */
1459 Fputhash (result
, handler
, Vdbus_registered_objects_table
);
1463 /* Send the message. The message is just added to the outgoing
1465 if (!dbus_connection_send (connection
, dmessage
, NULL
))
1466 XD_SIGNAL1 (build_string ("Cannot send message"));
1471 XD_DEBUG_MESSAGE ("Message sent: %s", XD_OBJECT_TO_STRING (result
));
1474 dbus_message_unref (dmessage
);
1476 /* Return the result. */
1480 /* Read one queued incoming message of the D-Bus BUS.
1481 BUS is either a Lisp symbol, :system or :session, or a string denoting
1484 xd_read_message_1 (DBusConnection
*connection
, Lisp_Object bus
)
1486 Lisp_Object args
, key
, value
;
1487 struct input_event event
;
1488 DBusMessage
*dmessage
;
1489 DBusMessageIter iter
;
1492 dbus_uint32_t serial
;
1493 unsigned int ui_serial
;
1494 const char *uname
, *path
, *interface
, *member
;
1496 dmessage
= dbus_connection_pop_message (connection
);
1498 /* Return if there is no queued message. */
1499 if (dmessage
== NULL
)
1502 /* Collect the parameters. */
1505 /* Loop over the resulting parameters. Construct a list. */
1506 if (dbus_message_iter_init (dmessage
, &iter
))
1508 while ((dtype
= dbus_message_iter_get_arg_type (&iter
))
1509 != DBUS_TYPE_INVALID
)
1511 args
= Fcons (xd_retrieve_arg (dtype
, &iter
), args
);
1512 dbus_message_iter_next (&iter
);
1514 /* The arguments are stored in reverse order. Reorder them. */
1515 args
= Fnreverse (args
);
1518 /* Read message type, message serial, unique name, object path,
1519 interface and member from the message. */
1520 mtype
= dbus_message_get_type (dmessage
);
1521 ui_serial
= serial
=
1522 ((mtype
== DBUS_MESSAGE_TYPE_METHOD_RETURN
)
1523 || (mtype
== DBUS_MESSAGE_TYPE_ERROR
))
1524 ? dbus_message_get_reply_serial (dmessage
)
1525 : dbus_message_get_serial (dmessage
);
1526 uname
= dbus_message_get_sender (dmessage
);
1527 path
= dbus_message_get_path (dmessage
);
1528 interface
= dbus_message_get_interface (dmessage
);
1529 member
= dbus_message_get_member (dmessage
);
1531 XD_DEBUG_MESSAGE ("Event received: %s %u %s %s %s %s %s",
1532 XD_MESSAGE_TYPE_TO_STRING (mtype
),
1533 ui_serial
, uname
, path
, interface
, member
,
1534 XD_OBJECT_TO_STRING (args
));
1536 if (mtype
== DBUS_MESSAGE_TYPE_INVALID
)
1539 else if ((mtype
== DBUS_MESSAGE_TYPE_METHOD_RETURN
)
1540 || (mtype
== DBUS_MESSAGE_TYPE_ERROR
))
1542 /* Search for a registered function of the message. */
1543 key
= list3 (QCserial
, bus
, make_fixnum_or_float (serial
));
1544 value
= Fgethash (key
, Vdbus_registered_objects_table
, Qnil
);
1546 /* There shall be exactly one entry. Construct an event. */
1550 /* Remove the entry. */
1551 Fremhash (key
, Vdbus_registered_objects_table
);
1553 /* Construct an event. */
1555 event
.kind
= DBUS_EVENT
;
1556 event
.frame_or_window
= Qnil
;
1557 event
.arg
= Fcons (value
, args
);
1560 else /* DBUS_MESSAGE_TYPE_METHOD_CALL, DBUS_MESSAGE_TYPE_SIGNAL. */
1562 /* Vdbus_registered_objects_table requires non-nil interface and
1564 if ((interface
== NULL
) || (member
== NULL
))
1567 /* Search for a registered function of the message. */
1568 key
= list4 (mtype
== DBUS_MESSAGE_TYPE_METHOD_CALL
? QCmethod
: QCsignal
,
1569 bus
, build_string (interface
), build_string (member
));
1570 value
= Fgethash (key
, Vdbus_registered_objects_table
, Qnil
);
1572 /* Loop over the registered functions. Construct an event. */
1573 while (!NILP (value
))
1575 key
= CAR_SAFE (value
);
1576 /* key has the structure (UNAME SERVICE PATH HANDLER). */
1577 if (((uname
== NULL
)
1578 || (NILP (CAR_SAFE (key
)))
1579 || (strcmp (uname
, SSDATA (CAR_SAFE (key
))) == 0))
1581 || (NILP (CAR_SAFE (CDR_SAFE (CDR_SAFE (key
)))))
1583 SSDATA (CAR_SAFE (CDR_SAFE (CDR_SAFE (key
)))))
1585 && (!NILP (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (key
)))))))
1588 event
.kind
= DBUS_EVENT
;
1589 event
.frame_or_window
= Qnil
;
1591 = Fcons (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (key
)))), args
);
1594 value
= CDR_SAFE (value
);
1601 /* Add type, serial, uname, path, interface and member to the event. */
1602 event
.arg
= Fcons ((member
== NULL
? Qnil
: build_string (member
)),
1604 event
.arg
= Fcons ((interface
== NULL
? Qnil
: build_string (interface
)),
1606 event
.arg
= Fcons ((path
== NULL
? Qnil
: build_string (path
)),
1608 event
.arg
= Fcons ((uname
== NULL
? Qnil
: build_string (uname
)),
1610 event
.arg
= Fcons (make_fixnum_or_float (serial
), event
.arg
);
1611 event
.arg
= Fcons (make_number (mtype
), event
.arg
);
1613 /* Add the bus symbol to the event. */
1614 event
.arg
= Fcons (bus
, event
.arg
);
1616 /* Store it into the input event queue. */
1617 kbd_buffer_store_event (&event
);
1619 XD_DEBUG_MESSAGE ("Event stored: %s", XD_OBJECT_TO_STRING (event
.arg
));
1623 dbus_message_unref (dmessage
);
1626 /* Read queued incoming messages of the D-Bus BUS.
1627 BUS is either a Lisp symbol, :system or :session, or a string denoting
1630 xd_read_message (Lisp_Object bus
)
1632 /* Retrieve bus address. */
1633 DBusConnection
*connection
= xd_get_connection_address (bus
);
1635 /* Non blocking read of the next available message. */
1636 dbus_connection_read_write (connection
, 0);
1638 while (dbus_connection_get_dispatch_status (connection
)
1639 != DBUS_DISPATCH_COMPLETE
)
1640 xd_read_message_1 (connection
, bus
);
1644 /* Callback called when something is ready to read or write. */
1646 xd_read_queued_messages (int fd
, void *data
)
1648 Lisp_Object busp
= xd_registered_buses
;
1649 Lisp_Object bus
= Qnil
;
1652 /* Find bus related to fd. */
1654 while (!NILP (busp
))
1656 key
= CAR_SAFE (CAR_SAFE (busp
));
1657 if ((SYMBOLP (key
) && XSYMBOL (key
) == data
)
1658 || (STRINGP (key
) && XSTRING (key
) == data
))
1660 busp
= CDR_SAFE (busp
);
1666 /* We ignore all Lisp errors during the call. */
1667 xd_in_read_queued_messages
= 1;
1668 internal_catch (Qdbus_error
, xd_read_message
, bus
);
1669 xd_in_read_queued_messages
= 0;
1674 init_dbusbind (void)
1676 /* We do not want to abort. */
1677 xputenv ("DBUS_FATAL_WARNINGS=0");
1681 syms_of_dbusbind (void)
1683 defsubr (&Sdbus__init_bus
);
1684 defsubr (&Sdbus_get_unique_name
);
1686 DEFSYM (Qdbus_message_internal
, "dbus-message-internal");
1687 defsubr (&Sdbus_message_internal
);
1689 /* D-Bus error symbol. */
1690 DEFSYM (Qdbus_error
, "dbus-error");
1691 Fput (Qdbus_error
, Qerror_conditions
,
1692 list2 (Qdbus_error
, Qerror
));
1693 Fput (Qdbus_error
, Qerror_message
,
1694 build_pure_c_string ("D-Bus error"));
1696 /* Lisp symbols of the system and session buses. */
1697 DEFSYM (QCsystem
, ":system");
1698 DEFSYM (QCsession
, ":session");
1700 /* Lisp symbol for method call timeout. */
1701 DEFSYM (QCtimeout
, ":timeout");
1703 /* Lisp symbols of D-Bus types. */
1704 DEFSYM (QCbyte
, ":byte");
1705 DEFSYM (QCboolean
, ":boolean");
1706 DEFSYM (QCint16
, ":int16");
1707 DEFSYM (QCuint16
, ":uint16");
1708 DEFSYM (QCint32
, ":int32");
1709 DEFSYM (QCuint32
, ":uint32");
1710 DEFSYM (QCint64
, ":int64");
1711 DEFSYM (QCuint64
, ":uint64");
1712 DEFSYM (QCdouble
, ":double");
1713 DEFSYM (QCstring
, ":string");
1714 DEFSYM (QCobject_path
, ":object-path");
1715 DEFSYM (QCsignature
, ":signature");
1716 #ifdef DBUS_TYPE_UNIX_FD
1717 DEFSYM (QCunix_fd
, ":unix-fd");
1719 DEFSYM (QCarray
, ":array");
1720 DEFSYM (QCvariant
, ":variant");
1721 DEFSYM (QCstruct
, ":struct");
1722 DEFSYM (QCdict_entry
, ":dict-entry");
1724 /* Lisp symbols of objects in `dbus-registered-objects-table'. */
1725 DEFSYM (QCserial
, ":serial");
1726 DEFSYM (QCmethod
, ":method");
1727 DEFSYM (QCsignal
, ":signal");
1729 DEFVAR_LISP ("dbus-compiled-version",
1730 Vdbus_compiled_version
,
1731 doc
: /* The version of D-Bus Emacs is compiled against. */);
1732 #ifdef DBUS_VERSION_STRING
1733 Vdbus_compiled_version
= build_pure_c_string (DBUS_VERSION_STRING
);
1735 Vdbus_compiled_version
= Qnil
;
1738 DEFVAR_LISP ("dbus-runtime-version",
1739 Vdbus_runtime_version
,
1740 doc
: /* The version of D-Bus Emacs runs with. */);
1743 int major
, minor
, micro
;
1744 char s
[sizeof ".." + 3 * INT_STRLEN_BOUND (int)];
1745 dbus_get_version (&major
, &minor
, µ
);
1746 Vdbus_runtime_version
1747 = make_formatted_string (s
, "%d.%d.%d", major
, minor
, micro
);
1749 Vdbus_runtime_version
= Qnil
;
1753 DEFVAR_LISP ("dbus-message-type-invalid",
1754 Vdbus_message_type_invalid
,
1755 doc
: /* This value is never a valid message type. */);
1756 Vdbus_message_type_invalid
= make_number (DBUS_MESSAGE_TYPE_INVALID
);
1758 DEFVAR_LISP ("dbus-message-type-method-call",
1759 Vdbus_message_type_method_call
,
1760 doc
: /* Message type of a method call message. */);
1761 Vdbus_message_type_method_call
= make_number (DBUS_MESSAGE_TYPE_METHOD_CALL
);
1763 DEFVAR_LISP ("dbus-message-type-method-return",
1764 Vdbus_message_type_method_return
,
1765 doc
: /* Message type of a method return message. */);
1766 Vdbus_message_type_method_return
1767 = make_number (DBUS_MESSAGE_TYPE_METHOD_RETURN
);
1769 DEFVAR_LISP ("dbus-message-type-error",
1770 Vdbus_message_type_error
,
1771 doc
: /* Message type of an error reply message. */);
1772 Vdbus_message_type_error
= make_number (DBUS_MESSAGE_TYPE_ERROR
);
1774 DEFVAR_LISP ("dbus-message-type-signal",
1775 Vdbus_message_type_signal
,
1776 doc
: /* Message type of a signal message. */);
1777 Vdbus_message_type_signal
= make_number (DBUS_MESSAGE_TYPE_SIGNAL
);
1779 DEFVAR_LISP ("dbus-registered-objects-table",
1780 Vdbus_registered_objects_table
,
1781 doc
: /* Hash table of registered functions for D-Bus.
1783 There are two different uses of the hash table: for accessing
1784 registered interfaces properties, targeted by signals or method calls,
1785 and for calling handlers in case of non-blocking method call returns.
1787 In the first case, the key in the hash table is the list (TYPE BUS
1788 INTERFACE MEMBER). TYPE is one of the Lisp symbols `:method',
1789 `:signal' or `:property'. BUS is either a Lisp symbol, `:system' or
1790 `:session', or a string denoting the bus address. INTERFACE is a
1791 string which denotes a D-Bus interface, and MEMBER, also a string, is
1792 either a method, a signal or a property INTERFACE is offering. All
1793 arguments but BUS must not be nil.
1795 The value in the hash table is a list of quadruple lists ((UNAME
1796 SERVICE PATH OBJECT [RULE]) ...). SERVICE is the service name as
1797 registered, UNAME is the corresponding unique name. In case of
1798 registered methods and properties, UNAME is nil. PATH is the object
1799 path of the sending object. All of them can be nil, which means a
1800 wildcard then. OBJECT is either the handler to be called when a D-Bus
1801 message, which matches the key criteria, arrives (TYPE `:method' and
1802 `:signal'), or a cons cell containing the value of the property (TYPE
1805 For entries of type `:signal', there is also a fifth element RULE,
1806 which keeps the match string the signal is registered with.
1808 In the second case, the key in the hash table is the list (:serial BUS
1809 SERIAL). BUS is either a Lisp symbol, `:system' or `:session', or a
1810 string denoting the bus address. SERIAL is the serial number of the
1811 non-blocking method call, a reply is expected. Both arguments must
1812 not be nil. The value in the hash table is HANDLER, the function to
1813 be called when the D-Bus reply message arrives. */);
1814 Vdbus_registered_objects_table
= CALLN (Fmake_hash_table
, QCtest
, Qequal
);
1816 DEFVAR_LISP ("dbus-debug", Vdbus_debug
,
1817 doc
: /* If non-nil, debug messages of D-Bus bindings are raised. */);
1820 /* We can also set environment variable DBUS_VERBOSE=1 in order to
1821 see more traces. This requires libdbus-1 to be configured with
1822 --enable-verbose-mode. */
1827 /* Initialize internal objects. */
1828 xd_registered_buses
= Qnil
;
1829 staticpro (&xd_registered_buses
);
1831 Fprovide (intern_c_string ("dbusbind"), Qnil
);
1835 #endif /* HAVE_DBUS */