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 <http://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 return SSDATA (CALLN (Fformat
, format
, object
));
243 #define XD_DBUS_VALIDATE_BUS_ADDRESS(bus) \
245 char const *session_bus_address = getenv ("DBUS_SESSION_BUS_ADDRESS"); \
248 DBusAddressEntry **entries; \
251 dbus_error_init (&derror); \
252 if (!dbus_parse_address (SSDATA (bus), &entries, &len, &derror)) \
255 dbus_error_free (&derror); \
256 dbus_address_entries_free (entries); \
257 /* Canonicalize session bus address. */ \
258 if ((session_bus_address != NULL) \
259 && (!NILP (Fstring_equal \
260 (bus, build_string (session_bus_address))))) \
266 CHECK_SYMBOL (bus); \
267 if (!(EQ (bus, QCsystem) || EQ (bus, QCsession))) \
268 XD_SIGNAL2 (build_string ("Wrong bus name"), bus); \
269 /* We do not want to have an autolaunch for the session bus. */ \
270 if (EQ (bus, QCsession) && session_bus_address == NULL) \
271 XD_SIGNAL2 (build_string ("No connection to bus"), bus); \
275 #if (HAVE_DBUS_VALIDATE_BUS_NAME || HAVE_DBUS_VALIDATE_PATH \
276 || HAVE_DBUS_VALIDATE_INTERFACE || HAVE_DBUS_VALIDATE_MEMBER)
277 #define XD_DBUS_VALIDATE_OBJECT(object, func) \
279 if (!NILP (object)) \
282 CHECK_STRING (object); \
283 dbus_error_init (&derror); \
284 if (!func (SSDATA (object), &derror)) \
287 dbus_error_free (&derror); \
292 #if HAVE_DBUS_VALIDATE_BUS_NAME
293 #define XD_DBUS_VALIDATE_BUS_NAME(bus_name) \
294 XD_DBUS_VALIDATE_OBJECT(bus_name, dbus_validate_bus_name);
296 #define XD_DBUS_VALIDATE_BUS_NAME(bus_name) \
297 if (!NILP (bus_name)) CHECK_STRING (bus_name);
300 #if HAVE_DBUS_VALIDATE_PATH
301 #define XD_DBUS_VALIDATE_PATH(path) \
302 XD_DBUS_VALIDATE_OBJECT(path, dbus_validate_path);
304 #define XD_DBUS_VALIDATE_PATH(path) \
305 if (!NILP (path)) CHECK_STRING (path);
308 #if HAVE_DBUS_VALIDATE_INTERFACE
309 #define XD_DBUS_VALIDATE_INTERFACE(interface) \
310 XD_DBUS_VALIDATE_OBJECT(interface, dbus_validate_interface);
312 #define XD_DBUS_VALIDATE_INTERFACE(interface) \
313 if (!NILP (interface)) CHECK_STRING (interface);
316 #if HAVE_DBUS_VALIDATE_MEMBER
317 #define XD_DBUS_VALIDATE_MEMBER(member) \
318 XD_DBUS_VALIDATE_OBJECT(member, dbus_validate_member);
320 #define XD_DBUS_VALIDATE_MEMBER(member) \
321 if (!NILP (member)) CHECK_STRING (member);
324 /* Append to SIGNATURE a copy of X, making sure SIGNATURE does
325 not become too long. */
327 xd_signature_cat (char *signature
, char const *x
)
329 ptrdiff_t siglen
= strlen (signature
);
330 ptrdiff_t xlen
= strlen (x
);
331 if (DBUS_MAXIMUM_SIGNATURE_LENGTH
- xlen
<= siglen
)
333 strcpy (signature
+ siglen
, x
);
336 /* Compute SIGNATURE of OBJECT. It must have a form that it can be
337 used in dbus_message_iter_open_container. DTYPE is the DBusType
338 the object is related to. It is passed as argument, because it
339 cannot be detected in basic type objects, when they are preceded by
340 a type symbol. PARENT_TYPE is the DBusType of a container this
341 signature is embedded, or DBUS_TYPE_INVALID. It is needed for the
342 check that DBUS_TYPE_DICT_ENTRY occurs only as array element. */
344 xd_signature (char *signature
, int dtype
, int parent_type
, Lisp_Object object
)
350 char x
[DBUS_MAXIMUM_SIGNATURE_LENGTH
];
357 case DBUS_TYPE_UINT16
:
358 CHECK_NATNUM (object
);
359 sprintf (signature
, "%c", dtype
);
362 case DBUS_TYPE_BOOLEAN
:
363 if (!EQ (object
, Qt
) && !EQ (object
, Qnil
))
364 wrong_type_argument (intern ("booleanp"), object
);
365 sprintf (signature
, "%c", dtype
);
368 case DBUS_TYPE_INT16
:
369 CHECK_NUMBER (object
);
370 sprintf (signature
, "%c", dtype
);
373 case DBUS_TYPE_UINT32
:
374 case DBUS_TYPE_UINT64
:
375 #ifdef DBUS_TYPE_UNIX_FD
376 case DBUS_TYPE_UNIX_FD
:
378 case DBUS_TYPE_INT32
:
379 case DBUS_TYPE_INT64
:
380 case DBUS_TYPE_DOUBLE
:
381 CHECK_NUMBER_OR_FLOAT (object
);
382 sprintf (signature
, "%c", dtype
);
385 case DBUS_TYPE_STRING
:
386 case DBUS_TYPE_OBJECT_PATH
:
387 case DBUS_TYPE_SIGNATURE
:
388 CHECK_STRING (object
);
389 sprintf (signature
, "%c", dtype
);
392 case DBUS_TYPE_ARRAY
:
393 /* Check that all list elements have the same D-Bus type. For
394 complex element types, we just check the container type, not
395 the whole element's signature. */
398 /* Type symbol is optional. */
399 if (EQ (QCarray
, CAR_SAFE (elt
)))
400 elt
= XD_NEXT_VALUE (elt
);
402 /* If the array is empty, DBUS_TYPE_STRING is the default
406 subtype
= DBUS_TYPE_STRING
;
407 subsig
= DBUS_TYPE_STRING_AS_STRING
;
411 subtype
= XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt
));
412 xd_signature (x
, subtype
, dtype
, CAR_SAFE (XD_NEXT_VALUE (elt
)));
416 /* If the element type is DBUS_TYPE_SIGNATURE, and this is the
417 only element, the value of this element is used as the
418 array's element signature. */
419 if ((subtype
== DBUS_TYPE_SIGNATURE
)
420 && STRINGP (CAR_SAFE (XD_NEXT_VALUE (elt
)))
421 && NILP (CDR_SAFE (XD_NEXT_VALUE (elt
))))
422 subsig
= SSDATA (CAR_SAFE (XD_NEXT_VALUE (elt
)));
426 if (subtype
!= XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt
)))
427 wrong_type_argument (intern ("D-Bus"), CAR_SAFE (elt
));
428 elt
= CDR_SAFE (XD_NEXT_VALUE (elt
));
431 subsiglen
= snprintf (signature
, DBUS_MAXIMUM_SIGNATURE_LENGTH
,
432 "%c%s", dtype
, subsig
);
433 if (! (0 <= subsiglen
&& subsiglen
< DBUS_MAXIMUM_SIGNATURE_LENGTH
))
437 case DBUS_TYPE_VARIANT
:
438 /* Check that there is exactly one list element. */
441 elt
= XD_NEXT_VALUE (elt
);
442 subtype
= XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt
));
443 xd_signature (x
, subtype
, dtype
, CAR_SAFE (XD_NEXT_VALUE (elt
)));
445 if (!NILP (CDR_SAFE (XD_NEXT_VALUE (elt
))))
446 wrong_type_argument (intern ("D-Bus"),
447 CAR_SAFE (CDR_SAFE (XD_NEXT_VALUE (elt
))));
449 sprintf (signature
, "%c", dtype
);
452 case DBUS_TYPE_STRUCT
:
453 /* A struct list might contain any number of elements with
454 different types. No further check needed. */
457 elt
= XD_NEXT_VALUE (elt
);
459 /* Compose the signature from the elements. It is enclosed by
461 sprintf (signature
, "%c", DBUS_STRUCT_BEGIN_CHAR
);
464 subtype
= XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt
));
465 xd_signature (x
, subtype
, dtype
, CAR_SAFE (XD_NEXT_VALUE (elt
)));
466 xd_signature_cat (signature
, x
);
467 elt
= CDR_SAFE (XD_NEXT_VALUE (elt
));
469 xd_signature_cat (signature
, DBUS_STRUCT_END_CHAR_AS_STRING
);
472 case DBUS_TYPE_DICT_ENTRY
:
473 /* Check that there are exactly two list elements, and the first
474 one is of basic type. The dictionary entry itself must be an
475 element of an array. */
478 /* Check the parent object type. */
479 if (parent_type
!= DBUS_TYPE_ARRAY
)
480 wrong_type_argument (intern ("D-Bus"), object
);
482 /* Compose the signature from the elements. It is enclosed by
484 sprintf (signature
, "%c", DBUS_DICT_ENTRY_BEGIN_CHAR
);
487 elt
= XD_NEXT_VALUE (elt
);
488 subtype
= XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt
));
489 xd_signature (x
, subtype
, dtype
, CAR_SAFE (XD_NEXT_VALUE (elt
)));
490 xd_signature_cat (signature
, x
);
492 if (!XD_BASIC_DBUS_TYPE (subtype
))
493 wrong_type_argument (intern ("D-Bus"), CAR_SAFE (XD_NEXT_VALUE (elt
)));
495 /* Second element. */
496 elt
= CDR_SAFE (XD_NEXT_VALUE (elt
));
497 subtype
= XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt
));
498 xd_signature (x
, subtype
, dtype
, CAR_SAFE (XD_NEXT_VALUE (elt
)));
499 xd_signature_cat (signature
, x
);
501 if (!NILP (CDR_SAFE (XD_NEXT_VALUE (elt
))))
502 wrong_type_argument (intern ("D-Bus"),
503 CAR_SAFE (CDR_SAFE (XD_NEXT_VALUE (elt
))));
505 /* Closing signature. */
506 xd_signature_cat (signature
, DBUS_DICT_ENTRY_END_CHAR_AS_STRING
);
510 wrong_type_argument (intern ("D-Bus"), object
);
513 XD_DEBUG_MESSAGE ("%s", signature
);
516 /* Convert X to a signed integer with bounds LO and HI. */
518 xd_extract_signed (Lisp_Object x
, intmax_t lo
, intmax_t hi
)
520 CHECK_NUMBER_OR_FLOAT (x
);
523 if (lo
<= XINT (x
) && XINT (x
) <= hi
)
528 double d
= XFLOAT_DATA (x
);
529 if (lo
<= d
&& d
< 1.0 + hi
)
536 if (xd_in_read_queued_messages
)
537 Fthrow (Qdbus_error
, Qnil
);
539 args_out_of_range_3 (x
,
540 make_fixnum_or_float (lo
),
541 make_fixnum_or_float (hi
));
544 /* Convert X to an unsigned integer with bounds 0 and HI. */
546 xd_extract_unsigned (Lisp_Object x
, uintmax_t hi
)
548 CHECK_NUMBER_OR_FLOAT (x
);
551 if (0 <= XINT (x
) && XINT (x
) <= hi
)
556 double d
= XFLOAT_DATA (x
);
557 if (0 <= d
&& d
< 1.0 + hi
)
564 if (xd_in_read_queued_messages
)
565 Fthrow (Qdbus_error
, Qnil
);
567 args_out_of_range_3 (x
, make_number (0), make_fixnum_or_float (hi
));
570 /* Append C value, extracted from Lisp OBJECT, to iteration ITER.
571 DTYPE must be a valid DBusType. It is used to convert Lisp
572 objects, being arguments of `dbus-call-method' or
573 `dbus-send-signal', into corresponding C values appended as
574 arguments to a D-Bus message. */
576 xd_append_arg (int dtype
, Lisp_Object object
, DBusMessageIter
*iter
)
578 char signature
[DBUS_MAXIMUM_SIGNATURE_LENGTH
];
579 DBusMessageIter subiter
;
581 if (XD_BASIC_DBUS_TYPE (dtype
))
585 CHECK_NATNUM (object
);
587 unsigned char val
= XFASTINT (object
) & 0xFF;
588 XD_DEBUG_MESSAGE ("%c %u", dtype
, val
);
589 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
590 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
594 case DBUS_TYPE_BOOLEAN
:
596 dbus_bool_t val
= (NILP (object
)) ? FALSE
: TRUE
;
597 XD_DEBUG_MESSAGE ("%c %s", dtype
, (val
== FALSE
) ? "false" : "true");
598 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
599 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
603 case DBUS_TYPE_INT16
:
606 xd_extract_signed (object
,
607 TYPE_MINIMUM (dbus_int16_t
),
608 TYPE_MAXIMUM (dbus_int16_t
));
610 XD_DEBUG_MESSAGE ("%c %d", dtype
, pval
);
611 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
612 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
616 case DBUS_TYPE_UINT16
:
619 xd_extract_unsigned (object
,
620 TYPE_MAXIMUM (dbus_uint16_t
));
621 unsigned int pval
= val
;
622 XD_DEBUG_MESSAGE ("%c %u", dtype
, pval
);
623 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
624 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
628 case DBUS_TYPE_INT32
:
631 xd_extract_signed (object
,
632 TYPE_MINIMUM (dbus_int32_t
),
633 TYPE_MAXIMUM (dbus_int32_t
));
635 XD_DEBUG_MESSAGE ("%c %d", dtype
, pval
);
636 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
637 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
641 case DBUS_TYPE_UINT32
:
642 #ifdef DBUS_TYPE_UNIX_FD
643 case DBUS_TYPE_UNIX_FD
:
647 xd_extract_unsigned (object
,
648 TYPE_MAXIMUM (dbus_uint32_t
));
649 unsigned int pval
= val
;
650 XD_DEBUG_MESSAGE ("%c %u", dtype
, pval
);
651 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
652 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
656 case DBUS_TYPE_INT64
:
659 xd_extract_signed (object
,
660 TYPE_MINIMUM (dbus_int64_t
),
661 TYPE_MAXIMUM (dbus_int64_t
));
662 printmax_t pval
= val
;
663 XD_DEBUG_MESSAGE ("%c %"pMd
, dtype
, pval
);
664 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
665 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
669 case DBUS_TYPE_UINT64
:
672 xd_extract_unsigned (object
,
673 TYPE_MAXIMUM (dbus_uint64_t
));
674 uprintmax_t pval
= val
;
675 XD_DEBUG_MESSAGE ("%c %"pMu
, dtype
, pval
);
676 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
677 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
681 case DBUS_TYPE_DOUBLE
:
683 double val
= extract_float (object
);
684 XD_DEBUG_MESSAGE ("%c %f", dtype
, val
);
685 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
686 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
690 case DBUS_TYPE_STRING
:
691 case DBUS_TYPE_OBJECT_PATH
:
692 case DBUS_TYPE_SIGNATURE
:
693 CHECK_STRING (object
);
695 /* We need to send a valid UTF-8 string. We could encode `object'
696 but by not encoding it, we guarantee it's valid utf-8, even if
697 it contains eight-bit-bytes. Of course, you can still send
698 manually-crafted junk by passing a unibyte string. */
699 char *val
= SSDATA (object
);
700 XD_DEBUG_MESSAGE ("%c %s", dtype
, val
);
701 if (!dbus_message_iter_append_basic (iter
, dtype
, &val
))
702 XD_SIGNAL2 (build_string ("Unable to append argument"), object
);
707 else /* Compound types. */
710 /* All compound types except array have a type symbol. For
711 array, it is optional. Skip it. */
712 if (!XD_BASIC_DBUS_TYPE (XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object
))))
713 object
= XD_NEXT_VALUE (object
);
715 /* Open new subiteration. */
718 case DBUS_TYPE_ARRAY
:
719 /* An array has only elements of the same type. So it is
720 sufficient to check the first element's signature
724 /* If the array is empty, DBUS_TYPE_STRING is the default
726 strcpy (signature
, DBUS_TYPE_STRING_AS_STRING
);
729 /* If the element type is DBUS_TYPE_SIGNATURE, and this is
730 the only element, the value of this element is used as
731 the array's element signature. */
732 if ((XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object
))
733 == DBUS_TYPE_SIGNATURE
)
734 && STRINGP (CAR_SAFE (XD_NEXT_VALUE (object
)))
735 && NILP (CDR_SAFE (XD_NEXT_VALUE (object
))))
737 lispstpcpy (signature
, CAR_SAFE (XD_NEXT_VALUE (object
)));
738 object
= CDR_SAFE (XD_NEXT_VALUE (object
));
742 xd_signature (signature
,
743 XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object
)),
744 dtype
, CAR_SAFE (XD_NEXT_VALUE (object
)));
746 XD_DEBUG_MESSAGE ("%c %s %s", dtype
, signature
,
747 XD_OBJECT_TO_STRING (object
));
748 if (!dbus_message_iter_open_container (iter
, dtype
,
749 signature
, &subiter
))
750 XD_SIGNAL3 (build_string ("Cannot open container"),
751 make_number (dtype
), build_string (signature
));
754 case DBUS_TYPE_VARIANT
:
755 /* A variant has just one element. */
756 xd_signature (signature
, XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object
)),
757 dtype
, CAR_SAFE (XD_NEXT_VALUE (object
)));
759 XD_DEBUG_MESSAGE ("%c %s %s", dtype
, signature
,
760 XD_OBJECT_TO_STRING (object
));
761 if (!dbus_message_iter_open_container (iter
, dtype
,
762 signature
, &subiter
))
763 XD_SIGNAL3 (build_string ("Cannot open container"),
764 make_number (dtype
), build_string (signature
));
767 case DBUS_TYPE_STRUCT
:
768 case DBUS_TYPE_DICT_ENTRY
:
769 /* These containers do not require a signature. */
770 XD_DEBUG_MESSAGE ("%c %s", dtype
, XD_OBJECT_TO_STRING (object
));
771 if (!dbus_message_iter_open_container (iter
, dtype
, NULL
, &subiter
))
772 XD_SIGNAL2 (build_string ("Cannot open container"),
773 make_number (dtype
));
777 /* Loop over list elements. */
778 while (!NILP (object
))
780 dtype
= XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object
));
781 object
= XD_NEXT_VALUE (object
);
783 xd_append_arg (dtype
, CAR_SAFE (object
), &subiter
);
785 object
= CDR_SAFE (object
);
788 /* Close the subiteration. */
789 if (!dbus_message_iter_close_container (iter
, &subiter
))
790 XD_SIGNAL2 (build_string ("Cannot close container"),
791 make_number (dtype
));
795 /* Retrieve C value from a DBusMessageIter structure ITER, and return
796 a converted Lisp object. The type DTYPE of the argument of the
797 D-Bus message must be a valid DBusType. Compound D-Bus types
798 result always in a Lisp list. */
800 xd_retrieve_arg (int dtype
, DBusMessageIter
*iter
)
808 dbus_message_iter_get_basic (iter
, &val
);
810 XD_DEBUG_MESSAGE ("%c %u", dtype
, val
);
811 return make_number (val
);
814 case DBUS_TYPE_BOOLEAN
:
817 dbus_message_iter_get_basic (iter
, &val
);
818 XD_DEBUG_MESSAGE ("%c %s", dtype
, (val
== FALSE
) ? "false" : "true");
819 return (val
== FALSE
) ? Qnil
: Qt
;
822 case DBUS_TYPE_INT16
:
826 dbus_message_iter_get_basic (iter
, &val
);
828 XD_DEBUG_MESSAGE ("%c %d", dtype
, pval
);
829 return make_number (val
);
832 case DBUS_TYPE_UINT16
:
836 dbus_message_iter_get_basic (iter
, &val
);
838 XD_DEBUG_MESSAGE ("%c %d", dtype
, pval
);
839 return make_number (val
);
842 case DBUS_TYPE_INT32
:
846 dbus_message_iter_get_basic (iter
, &val
);
848 XD_DEBUG_MESSAGE ("%c %d", dtype
, pval
);
849 return make_fixnum_or_float (val
);
852 case DBUS_TYPE_UINT32
:
853 #ifdef DBUS_TYPE_UNIX_FD
854 case DBUS_TYPE_UNIX_FD
:
859 dbus_message_iter_get_basic (iter
, &val
);
861 XD_DEBUG_MESSAGE ("%c %u", dtype
, pval
);
862 return make_fixnum_or_float (val
);
865 case DBUS_TYPE_INT64
:
869 dbus_message_iter_get_basic (iter
, &val
);
871 XD_DEBUG_MESSAGE ("%c %"pMd
, dtype
, pval
);
872 return make_fixnum_or_float (val
);
875 case DBUS_TYPE_UINT64
:
879 dbus_message_iter_get_basic (iter
, &val
);
881 XD_DEBUG_MESSAGE ("%c %"pMu
, dtype
, pval
);
882 return make_fixnum_or_float (val
);
885 case DBUS_TYPE_DOUBLE
:
888 dbus_message_iter_get_basic (iter
, &val
);
889 XD_DEBUG_MESSAGE ("%c %f", dtype
, val
);
890 return make_float (val
);
893 case DBUS_TYPE_STRING
:
894 case DBUS_TYPE_OBJECT_PATH
:
895 case DBUS_TYPE_SIGNATURE
:
898 dbus_message_iter_get_basic (iter
, &val
);
899 XD_DEBUG_MESSAGE ("%c %s", dtype
, val
);
900 return build_string (val
);
903 case DBUS_TYPE_ARRAY
:
904 case DBUS_TYPE_VARIANT
:
905 case DBUS_TYPE_STRUCT
:
906 case DBUS_TYPE_DICT_ENTRY
:
909 DBusMessageIter subiter
;
912 dbus_message_iter_recurse (iter
, &subiter
);
913 while ((subtype
= dbus_message_iter_get_arg_type (&subiter
))
914 != DBUS_TYPE_INVALID
)
916 result
= Fcons (xd_retrieve_arg (subtype
, &subiter
), result
);
917 dbus_message_iter_next (&subiter
);
919 XD_DEBUG_MESSAGE ("%c %s", dtype
, XD_OBJECT_TO_STRING (result
));
920 return Fnreverse (result
);
924 XD_DEBUG_MESSAGE ("DBusType '%c' not supported", dtype
);
929 /* Return the number of references of the shared CONNECTION. */
931 xd_get_connection_references (DBusConnection
*connection
)
935 /* We cannot access the DBusConnection structure, it is not public.
936 But we know, that the reference counter is the first field in
938 refcount
= (void *) &connection
;
939 refcount
= (void *) *refcount
;
943 /* Convert a Lisp D-Bus object to a pointer. */
944 static DBusConnection
*
945 xd_lisp_dbus_to_dbus (Lisp_Object bus
)
947 return (DBusConnection
*) XSAVE_POINTER (bus
, 0);
950 /* Return D-Bus connection address. BUS is either a Lisp symbol,
951 :system or :session, or a string denoting the bus address. */
952 static DBusConnection
*
953 xd_get_connection_address (Lisp_Object bus
)
955 DBusConnection
*connection
;
958 val
= CDR_SAFE (Fassoc (bus
, xd_registered_buses
));
960 XD_SIGNAL2 (build_string ("No connection to bus"), bus
);
962 connection
= xd_lisp_dbus_to_dbus (val
);
964 if (!dbus_connection_get_is_connected (connection
))
965 XD_SIGNAL2 (build_string ("No connection to bus"), bus
);
970 /* Return the file descriptor for WATCH, -1 if not found. */
972 xd_find_watch_fd (DBusWatch
*watch
)
974 #if HAVE_DBUS_WATCH_GET_UNIX_FD
975 /* TODO: Reverse these on w32, which prefers the opposite. */
976 int fd
= dbus_watch_get_unix_fd (watch
);
978 fd
= dbus_watch_get_socket (watch
);
980 int fd
= dbus_watch_get_fd (watch
);
986 static void xd_read_queued_messages (int fd
, void *data
);
988 /* Start monitoring WATCH for possible I/O. */
990 xd_add_watch (DBusWatch
*watch
, void *data
)
992 unsigned int flags
= dbus_watch_get_flags (watch
);
993 int fd
= xd_find_watch_fd (watch
);
995 XD_DEBUG_MESSAGE ("fd %d, write %u, enabled %u",
996 fd
, flags
& DBUS_WATCH_WRITABLE
,
997 dbus_watch_get_enabled (watch
));
1002 if (dbus_watch_get_enabled (watch
))
1004 if (flags
& DBUS_WATCH_WRITABLE
)
1005 add_write_fd (fd
, xd_read_queued_messages
, data
);
1006 if (flags
& DBUS_WATCH_READABLE
)
1007 add_read_fd (fd
, xd_read_queued_messages
, data
);
1012 /* Stop monitoring WATCH for possible I/O.
1013 DATA is the used bus, either a string or QCsystem or QCsession. */
1015 xd_remove_watch (DBusWatch
*watch
, void *data
)
1017 unsigned int flags
= dbus_watch_get_flags (watch
);
1018 int fd
= xd_find_watch_fd (watch
);
1020 XD_DEBUG_MESSAGE ("fd %d", fd
);
1025 /* Unset session environment. */
1027 /* This is buggy, since unsetenv is not thread-safe. */
1028 if (XSYMBOL (QCsession
) == data
)
1030 XD_DEBUG_MESSAGE ("unsetenv DBUS_SESSION_BUS_ADDRESS");
1031 unsetenv ("DBUS_SESSION_BUS_ADDRESS");
1035 if (flags
& DBUS_WATCH_WRITABLE
)
1036 delete_write_fd (fd
);
1037 if (flags
& DBUS_WATCH_READABLE
)
1038 delete_read_fd (fd
);
1041 /* Toggle monitoring WATCH for possible I/O. */
1043 xd_toggle_watch (DBusWatch
*watch
, void *data
)
1045 if (dbus_watch_get_enabled (watch
))
1046 xd_add_watch (watch
, data
);
1048 xd_remove_watch (watch
, data
);
1051 /* Close connection to D-Bus BUS. */
1053 xd_close_bus (Lisp_Object bus
)
1055 DBusConnection
*connection
;
1059 /* Check whether we are connected. */
1060 val
= Fassoc (bus
, xd_registered_buses
);
1064 busobj
= CDR_SAFE (val
);
1065 if (NILP (busobj
)) {
1066 xd_registered_buses
= Fdelete (val
, xd_registered_buses
);
1070 /* Retrieve bus address. */
1071 connection
= xd_lisp_dbus_to_dbus (busobj
);
1073 if (xd_get_connection_references (connection
) == 1)
1075 /* Close connection, if there isn't another shared application. */
1076 XD_DEBUG_MESSAGE ("Close connection to bus %s",
1077 XD_OBJECT_TO_STRING (bus
));
1078 dbus_connection_close (connection
);
1080 xd_registered_buses
= Fdelete (val
, xd_registered_buses
);
1084 /* Decrement reference count. */
1085 dbus_connection_unref (connection
);
1091 DEFUN ("dbus--init-bus", Fdbus__init_bus
, Sdbus__init_bus
, 1, 2, 0,
1092 doc
: /* Establish the connection to D-Bus BUS.
1094 This function is dbus internal. You almost certainly want to use
1097 BUS can be either the symbol `:system' or the symbol `:session', or it
1098 can be a string denoting the address of the corresponding bus. For
1099 the system and session buses, this function is called when loading
1100 `dbus.el', there is no need to call it again.
1102 The function returns a number, which counts the connections this Emacs
1103 session has established to the BUS under the same unique name (see
1104 `dbus-get-unique-name'). It depends on the libraries Emacs is linked
1105 with, and on the environment Emacs is running. For example, if Emacs
1106 is linked with the gtk toolkit, and it runs in a GTK-aware environment
1107 like Gnome, another connection might already be established.
1109 When PRIVATE is non-nil, a new connection is established instead of
1110 reusing an existing one. It results in a new unique name at the bus.
1111 This can be used, if it is necessary to distinguish from another
1112 connection used in the same Emacs process, like the one established by
1113 GTK+. It should be used with care for at least the `:system' and
1114 `:session' buses, because other Emacs Lisp packages might already use
1115 this connection to those buses. */)
1116 (Lisp_Object bus
, Lisp_Object
private)
1118 DBusConnection
*connection
;
1123 /* Check parameter. */
1124 XD_DBUS_VALIDATE_BUS_ADDRESS (bus
);
1126 /* Close bus if it is already open. */
1129 /* Check, whether we are still connected. */
1130 val
= Fassoc (bus
, xd_registered_buses
);
1133 connection
= xd_get_connection_address (bus
);
1134 dbus_connection_ref (connection
);
1140 dbus_error_init (&derror
);
1142 /* Open the connection. */
1145 connection
= dbus_connection_open (SSDATA (bus
), &derror
);
1147 connection
= dbus_connection_open_private (SSDATA (bus
), &derror
);
1151 DBusBusType bustype
= (EQ (bus
, QCsystem
)
1152 ? DBUS_BUS_SYSTEM
: DBUS_BUS_SESSION
);
1154 connection
= dbus_bus_get (bustype
, &derror
);
1156 connection
= dbus_bus_get_private (bustype
, &derror
);
1159 if (dbus_error_is_set (&derror
))
1162 if (connection
== NULL
)
1163 XD_SIGNAL2 (build_string ("No connection to bus"), bus
);
1165 /* If it is not the system or session bus, we must register
1166 ourselves. Otherwise, we have called dbus_bus_get, which has
1167 configured us to exit if the connection closes - we undo this
1170 dbus_bus_register (connection
, &derror
);
1172 dbus_connection_set_exit_on_disconnect (connection
, FALSE
);
1174 if (dbus_error_is_set (&derror
))
1177 /* Add the watch functions. We pass also the bus as data, in
1178 order to distinguish between the buses in xd_remove_watch. */
1179 if (!dbus_connection_set_watch_functions (connection
,
1184 ? (void *) XSYMBOL (bus
)
1185 : (void *) XSTRING (bus
),
1187 XD_SIGNAL1 (build_string ("Cannot add watch functions"));
1189 /* Add bus to list of registered buses. */
1190 val
= make_save_ptr (connection
);
1191 xd_registered_buses
= Fcons (Fcons (bus
, val
), xd_registered_buses
);
1194 dbus_error_free (&derror
);
1197 /* Return reference counter. */
1198 refcount
= xd_get_connection_references (connection
);
1199 XD_DEBUG_MESSAGE ("Bus %s, Reference counter %"pD
"d",
1200 XD_OBJECT_TO_STRING (bus
), refcount
);
1201 return make_number (refcount
);
1204 DEFUN ("dbus-get-unique-name", Fdbus_get_unique_name
, Sdbus_get_unique_name
,
1206 doc
: /* Return the unique name of Emacs registered at D-Bus BUS. */)
1209 DBusConnection
*connection
;
1212 /* Check parameter. */
1213 XD_DBUS_VALIDATE_BUS_ADDRESS (bus
);
1215 /* Retrieve bus address. */
1216 connection
= xd_get_connection_address (bus
);
1218 /* Request the name. */
1219 name
= dbus_bus_get_unique_name (connection
);
1221 XD_SIGNAL1 (build_string ("No unique name available"));
1224 return build_string (name
);
1227 DEFUN ("dbus-message-internal", Fdbus_message_internal
, Sdbus_message_internal
,
1229 doc
: /* Send a D-Bus message.
1230 This is an internal function, it shall not be used outside dbus.el.
1232 The following usages are expected:
1234 `dbus-call-method', `dbus-call-method-asynchronously':
1235 (dbus-message-internal
1236 dbus-message-type-method-call BUS SERVICE PATH INTERFACE METHOD HANDLER
1237 &optional :timeout TIMEOUT &rest ARGS)
1240 (dbus-message-internal
1241 dbus-message-type-signal BUS SERVICE PATH INTERFACE SIGNAL &rest ARGS)
1243 `dbus-method-return-internal':
1244 (dbus-message-internal
1245 dbus-message-type-method-return BUS SERVICE SERIAL &rest ARGS)
1247 `dbus-method-error-internal':
1248 (dbus-message-internal
1249 dbus-message-type-error BUS SERVICE SERIAL &rest ARGS)
1251 usage: (dbus-message-internal &rest REST) */)
1252 (ptrdiff_t nargs
, Lisp_Object
*args
)
1254 Lisp_Object message_type
, bus
, service
, handler
;
1255 Lisp_Object path
= Qnil
;
1256 Lisp_Object interface
= Qnil
;
1257 Lisp_Object member
= Qnil
;
1259 DBusConnection
*connection
;
1260 DBusMessage
*dmessage
;
1261 DBusMessageIter iter
;
1264 dbus_uint32_t serial
= 0;
1265 unsigned int ui_serial
;
1268 char signature
[DBUS_MAXIMUM_SIGNATURE_LENGTH
];
1270 /* Initialize parameters. */
1271 message_type
= args
[0];
1276 CHECK_NATNUM (message_type
);
1277 if (! (DBUS_MESSAGE_TYPE_INVALID
< XFASTINT (message_type
)
1278 && XFASTINT (message_type
) < DBUS_NUM_MESSAGE_TYPES
))
1279 XD_SIGNAL2 (build_string ("Invalid message type"), message_type
);
1280 mtype
= XFASTINT (message_type
);
1282 if ((mtype
== DBUS_MESSAGE_TYPE_METHOD_CALL
)
1283 || (mtype
== DBUS_MESSAGE_TYPE_SIGNAL
))
1286 interface
= args
[4];
1288 if (mtype
== DBUS_MESSAGE_TYPE_METHOD_CALL
)
1290 count
= (mtype
== DBUS_MESSAGE_TYPE_METHOD_CALL
) ? 7 : 6;
1292 else /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR */
1294 serial
= xd_extract_unsigned (args
[3], TYPE_MAXIMUM (dbus_uint32_t
));
1298 /* Check parameters. */
1299 XD_DBUS_VALIDATE_BUS_ADDRESS (bus
);
1300 XD_DBUS_VALIDATE_BUS_NAME (service
);
1302 xsignal2 (Qwrong_number_of_arguments
,
1303 Qdbus_message_internal
,
1304 make_number (nargs
));
1306 if ((mtype
== DBUS_MESSAGE_TYPE_METHOD_CALL
)
1307 || (mtype
== DBUS_MESSAGE_TYPE_SIGNAL
))
1309 XD_DBUS_VALIDATE_PATH (path
);
1310 XD_DBUS_VALIDATE_INTERFACE (interface
);
1311 XD_DBUS_VALIDATE_MEMBER (member
);
1312 if (!NILP (handler
) && !FUNCTIONP (handler
))
1313 wrong_type_argument (Qinvalid_function
, handler
);
1316 /* Trace parameters. */
1319 case DBUS_MESSAGE_TYPE_METHOD_CALL
:
1320 XD_DEBUG_MESSAGE ("%s %s %s %s %s %s %s",
1321 XD_MESSAGE_TYPE_TO_STRING (mtype
),
1322 XD_OBJECT_TO_STRING (bus
),
1323 XD_OBJECT_TO_STRING (service
),
1324 XD_OBJECT_TO_STRING (path
),
1325 XD_OBJECT_TO_STRING (interface
),
1326 XD_OBJECT_TO_STRING (member
),
1327 XD_OBJECT_TO_STRING (handler
));
1329 case DBUS_MESSAGE_TYPE_SIGNAL
:
1330 XD_DEBUG_MESSAGE ("%s %s %s %s %s %s",
1331 XD_MESSAGE_TYPE_TO_STRING (mtype
),
1332 XD_OBJECT_TO_STRING (bus
),
1333 XD_OBJECT_TO_STRING (service
),
1334 XD_OBJECT_TO_STRING (path
),
1335 XD_OBJECT_TO_STRING (interface
),
1336 XD_OBJECT_TO_STRING (member
));
1338 default: /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR */
1340 XD_DEBUG_MESSAGE ("%s %s %s %u",
1341 XD_MESSAGE_TYPE_TO_STRING (mtype
),
1342 XD_OBJECT_TO_STRING (bus
),
1343 XD_OBJECT_TO_STRING (service
),
1347 /* Retrieve bus address. */
1348 connection
= xd_get_connection_address (bus
);
1350 /* Create the D-Bus message. */
1351 dmessage
= dbus_message_new (mtype
);
1352 if (dmessage
== NULL
)
1353 XD_SIGNAL1 (build_string ("Unable to create a new message"));
1355 if (STRINGP (service
))
1357 if (mtype
!= DBUS_MESSAGE_TYPE_SIGNAL
)
1358 /* Set destination. */
1360 if (!dbus_message_set_destination (dmessage
, SSDATA (service
)))
1361 XD_SIGNAL2 (build_string ("Unable to set the destination"),
1366 /* Set destination for unicast signals. */
1370 /* If it is the same unique name as we are registered at the
1371 bus or an unknown name, we regard it as broadcast message
1372 due to backward compatibility. */
1373 if (dbus_bus_name_has_owner (connection
, SSDATA (service
), NULL
))
1374 uname
= call2 (intern ("dbus-get-name-owner"), bus
, service
);
1379 && (strcmp (dbus_bus_get_unique_name (connection
), SSDATA (uname
))
1381 && (!dbus_message_set_destination (dmessage
, SSDATA (service
))))
1382 XD_SIGNAL2 (build_string ("Unable to set signal destination"),
1387 /* Set message parameters. */
1388 if ((mtype
== DBUS_MESSAGE_TYPE_METHOD_CALL
)
1389 || (mtype
== DBUS_MESSAGE_TYPE_SIGNAL
))
1391 if ((!dbus_message_set_path (dmessage
, SSDATA (path
)))
1392 || (!dbus_message_set_interface (dmessage
, SSDATA (interface
)))
1393 || (!dbus_message_set_member (dmessage
, SSDATA (member
))))
1394 XD_SIGNAL1 (build_string ("Unable to set the message parameter"));
1397 else /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR */
1399 if (!dbus_message_set_reply_serial (dmessage
, serial
))
1400 XD_SIGNAL1 (build_string ("Unable to create a return message"));
1402 if ((mtype
== DBUS_MESSAGE_TYPE_ERROR
)
1403 && (!dbus_message_set_error_name (dmessage
, DBUS_ERROR_FAILED
)))
1404 XD_SIGNAL1 (build_string ("Unable to create a error message"));
1407 /* Check for timeout parameter. */
1408 if ((count
+ 2 <= nargs
) && EQ (args
[count
], QCtimeout
))
1410 CHECK_NATNUM (args
[count
+1]);
1411 timeout
= min (XFASTINT (args
[count
+1]), INT_MAX
);
1415 /* Initialize parameter list of message. */
1416 dbus_message_iter_init_append (dmessage
, &iter
);
1418 /* Append parameters to the message. */
1419 for (; count
< nargs
; ++count
)
1421 dtype
= XD_OBJECT_TO_DBUS_TYPE (args
[count
]);
1422 if (XD_DBUS_TYPE_P (args
[count
]))
1424 XD_DEBUG_VALID_LISP_OBJECT_P (args
[count
]);
1425 XD_DEBUG_VALID_LISP_OBJECT_P (args
[count
+1]);
1426 XD_DEBUG_MESSAGE ("Parameter%"pD
"d %s %s", count
- 4,
1427 XD_OBJECT_TO_STRING (args
[count
]),
1428 XD_OBJECT_TO_STRING (args
[count
+1]));
1433 XD_DEBUG_VALID_LISP_OBJECT_P (args
[count
]);
1434 XD_DEBUG_MESSAGE ("Parameter%"pD
"d %s", count
- 4,
1435 XD_OBJECT_TO_STRING (args
[count
]));
1438 /* Check for valid signature. We use DBUS_TYPE_INVALID as
1439 indication that there is no parent type. */
1440 xd_signature (signature
, dtype
, DBUS_TYPE_INVALID
, args
[count
]);
1442 xd_append_arg (dtype
, args
[count
], &iter
);
1445 if (!NILP (handler
))
1447 /* Send the message. The message is just added to the outgoing
1449 if (!dbus_connection_send_with_reply (connection
, dmessage
,
1451 XD_SIGNAL1 (build_string ("Cannot send message"));
1453 /* The result is the key in Vdbus_registered_objects_table. */
1454 serial
= dbus_message_get_serial (dmessage
);
1455 result
= list3 (QCserial
, bus
, make_fixnum_or_float (serial
));
1457 /* Create a hash table entry. */
1458 Fputhash (result
, handler
, Vdbus_registered_objects_table
);
1462 /* Send the message. The message is just added to the outgoing
1464 if (!dbus_connection_send (connection
, dmessage
, NULL
))
1465 XD_SIGNAL1 (build_string ("Cannot send message"));
1470 XD_DEBUG_MESSAGE ("Message sent: %s", XD_OBJECT_TO_STRING (result
));
1473 dbus_message_unref (dmessage
);
1475 /* Return the result. */
1479 /* Read one queued incoming message of the D-Bus BUS.
1480 BUS is either a Lisp symbol, :system or :session, or a string denoting
1483 xd_read_message_1 (DBusConnection
*connection
, Lisp_Object bus
)
1485 Lisp_Object args
, key
, value
;
1486 struct input_event event
;
1487 DBusMessage
*dmessage
;
1488 DBusMessageIter iter
;
1491 dbus_uint32_t serial
;
1492 unsigned int ui_serial
;
1493 const char *uname
, *path
, *interface
, *member
;
1495 dmessage
= dbus_connection_pop_message (connection
);
1497 /* Return if there is no queued message. */
1498 if (dmessage
== NULL
)
1501 /* Collect the parameters. */
1504 /* Loop over the resulting parameters. Construct a list. */
1505 if (dbus_message_iter_init (dmessage
, &iter
))
1507 while ((dtype
= dbus_message_iter_get_arg_type (&iter
))
1508 != DBUS_TYPE_INVALID
)
1510 args
= Fcons (xd_retrieve_arg (dtype
, &iter
), args
);
1511 dbus_message_iter_next (&iter
);
1513 /* The arguments are stored in reverse order. Reorder them. */
1514 args
= Fnreverse (args
);
1517 /* Read message type, message serial, unique name, object path,
1518 interface and member from the message. */
1519 mtype
= dbus_message_get_type (dmessage
);
1520 ui_serial
= serial
=
1521 ((mtype
== DBUS_MESSAGE_TYPE_METHOD_RETURN
)
1522 || (mtype
== DBUS_MESSAGE_TYPE_ERROR
))
1523 ? dbus_message_get_reply_serial (dmessage
)
1524 : dbus_message_get_serial (dmessage
);
1525 uname
= dbus_message_get_sender (dmessage
);
1526 path
= dbus_message_get_path (dmessage
);
1527 interface
= dbus_message_get_interface (dmessage
);
1528 member
= dbus_message_get_member (dmessage
);
1530 XD_DEBUG_MESSAGE ("Event received: %s %u %s %s %s %s %s",
1531 XD_MESSAGE_TYPE_TO_STRING (mtype
),
1532 ui_serial
, uname
, path
, interface
, member
,
1533 XD_OBJECT_TO_STRING (args
));
1535 if (mtype
== DBUS_MESSAGE_TYPE_INVALID
)
1538 else if ((mtype
== DBUS_MESSAGE_TYPE_METHOD_RETURN
)
1539 || (mtype
== DBUS_MESSAGE_TYPE_ERROR
))
1541 /* Search for a registered function of the message. */
1542 key
= list3 (QCserial
, bus
, make_fixnum_or_float (serial
));
1543 value
= Fgethash (key
, Vdbus_registered_objects_table
, Qnil
);
1545 /* There shall be exactly one entry. Construct an event. */
1549 /* Remove the entry. */
1550 Fremhash (key
, Vdbus_registered_objects_table
);
1552 /* Construct an event. */
1554 event
.kind
= DBUS_EVENT
;
1555 event
.frame_or_window
= Qnil
;
1556 event
.arg
= Fcons (value
, args
);
1559 else /* DBUS_MESSAGE_TYPE_METHOD_CALL, DBUS_MESSAGE_TYPE_SIGNAL. */
1561 /* Vdbus_registered_objects_table requires non-nil interface and
1563 if ((interface
== NULL
) || (member
== NULL
))
1566 /* Search for a registered function of the message. */
1567 key
= list4 (mtype
== DBUS_MESSAGE_TYPE_METHOD_CALL
? QCmethod
: QCsignal
,
1568 bus
, build_string (interface
), build_string (member
));
1569 value
= Fgethash (key
, Vdbus_registered_objects_table
, Qnil
);
1571 /* Loop over the registered functions. Construct an event. */
1572 while (!NILP (value
))
1574 key
= CAR_SAFE (value
);
1575 /* key has the structure (UNAME SERVICE PATH HANDLER). */
1576 if (((uname
== NULL
)
1577 || (NILP (CAR_SAFE (key
)))
1578 || (strcmp (uname
, SSDATA (CAR_SAFE (key
))) == 0))
1580 || (NILP (CAR_SAFE (CDR_SAFE (CDR_SAFE (key
)))))
1582 SSDATA (CAR_SAFE (CDR_SAFE (CDR_SAFE (key
)))))
1584 && (!NILP (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (key
)))))))
1587 event
.kind
= DBUS_EVENT
;
1588 event
.frame_or_window
= Qnil
;
1590 = Fcons (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (key
)))), args
);
1593 value
= CDR_SAFE (value
);
1600 /* Add type, serial, uname, path, interface and member to the event. */
1601 event
.arg
= Fcons ((member
== NULL
? Qnil
: build_string (member
)),
1603 event
.arg
= Fcons ((interface
== NULL
? Qnil
: build_string (interface
)),
1605 event
.arg
= Fcons ((path
== NULL
? Qnil
: build_string (path
)),
1607 event
.arg
= Fcons ((uname
== NULL
? Qnil
: build_string (uname
)),
1609 event
.arg
= Fcons (make_fixnum_or_float (serial
), event
.arg
);
1610 event
.arg
= Fcons (make_number (mtype
), event
.arg
);
1612 /* Add the bus symbol to the event. */
1613 event
.arg
= Fcons (bus
, event
.arg
);
1615 /* Store it into the input event queue. */
1616 kbd_buffer_store_event (&event
);
1618 XD_DEBUG_MESSAGE ("Event stored: %s", XD_OBJECT_TO_STRING (event
.arg
));
1622 dbus_message_unref (dmessage
);
1625 /* Read queued incoming messages of the D-Bus BUS.
1626 BUS is either a Lisp symbol, :system or :session, or a string denoting
1629 xd_read_message (Lisp_Object bus
)
1631 /* Retrieve bus address. */
1632 DBusConnection
*connection
= xd_get_connection_address (bus
);
1634 /* Non blocking read of the next available message. */
1635 dbus_connection_read_write (connection
, 0);
1637 while (dbus_connection_get_dispatch_status (connection
)
1638 != DBUS_DISPATCH_COMPLETE
)
1639 xd_read_message_1 (connection
, bus
);
1643 /* Callback called when something is ready to read or write. */
1645 xd_read_queued_messages (int fd
, void *data
)
1647 Lisp_Object busp
= xd_registered_buses
;
1648 Lisp_Object bus
= Qnil
;
1651 /* Find bus related to fd. */
1653 while (!NILP (busp
))
1655 key
= CAR_SAFE (CAR_SAFE (busp
));
1656 if ((SYMBOLP (key
) && XSYMBOL (key
) == data
)
1657 || (STRINGP (key
) && XSTRING (key
) == data
))
1659 busp
= CDR_SAFE (busp
);
1665 /* We ignore all Lisp errors during the call. */
1666 xd_in_read_queued_messages
= 1;
1667 internal_catch (Qdbus_error
, xd_read_message
, bus
);
1668 xd_in_read_queued_messages
= 0;
1673 init_dbusbind (void)
1675 /* We do not want to abort. */
1676 xputenv ("DBUS_FATAL_WARNINGS=0");
1680 syms_of_dbusbind (void)
1682 defsubr (&Sdbus__init_bus
);
1683 defsubr (&Sdbus_get_unique_name
);
1685 DEFSYM (Qdbus_message_internal
, "dbus-message-internal");
1686 defsubr (&Sdbus_message_internal
);
1688 /* D-Bus error symbol. */
1689 DEFSYM (Qdbus_error
, "dbus-error");
1690 Fput (Qdbus_error
, Qerror_conditions
,
1691 list2 (Qdbus_error
, Qerror
));
1692 Fput (Qdbus_error
, Qerror_message
,
1693 build_pure_c_string ("D-Bus error"));
1695 /* Lisp symbols of the system and session buses. */
1696 DEFSYM (QCsystem
, ":system");
1697 DEFSYM (QCsession
, ":session");
1699 /* Lisp symbol for method call timeout. */
1700 DEFSYM (QCtimeout
, ":timeout");
1702 /* Lisp symbols of D-Bus types. */
1703 DEFSYM (QCbyte
, ":byte");
1704 DEFSYM (QCboolean
, ":boolean");
1705 DEFSYM (QCint16
, ":int16");
1706 DEFSYM (QCuint16
, ":uint16");
1707 DEFSYM (QCint32
, ":int32");
1708 DEFSYM (QCuint32
, ":uint32");
1709 DEFSYM (QCint64
, ":int64");
1710 DEFSYM (QCuint64
, ":uint64");
1711 DEFSYM (QCdouble
, ":double");
1712 DEFSYM (QCstring
, ":string");
1713 DEFSYM (QCobject_path
, ":object-path");
1714 DEFSYM (QCsignature
, ":signature");
1715 #ifdef DBUS_TYPE_UNIX_FD
1716 DEFSYM (QCunix_fd
, ":unix-fd");
1718 DEFSYM (QCarray
, ":array");
1719 DEFSYM (QCvariant
, ":variant");
1720 DEFSYM (QCstruct
, ":struct");
1721 DEFSYM (QCdict_entry
, ":dict-entry");
1723 /* Lisp symbols of objects in `dbus-registered-objects-table'. */
1724 DEFSYM (QCserial
, ":serial");
1725 DEFSYM (QCmethod
, ":method");
1726 DEFSYM (QCsignal
, ":signal");
1728 DEFVAR_LISP ("dbus-compiled-version",
1729 Vdbus_compiled_version
,
1730 doc
: /* The version of D-Bus Emacs is compiled against. */);
1731 #ifdef DBUS_VERSION_STRING
1732 Vdbus_compiled_version
= build_pure_c_string (DBUS_VERSION_STRING
);
1734 Vdbus_compiled_version
= Qnil
;
1737 DEFVAR_LISP ("dbus-runtime-version",
1738 Vdbus_runtime_version
,
1739 doc
: /* The version of D-Bus Emacs runs with. */);
1742 int major
, minor
, micro
;
1743 char s
[sizeof ".." + 3 * INT_STRLEN_BOUND (int)];
1744 dbus_get_version (&major
, &minor
, µ
);
1745 Vdbus_runtime_version
1746 = make_formatted_string (s
, "%d.%d.%d", major
, minor
, micro
);
1748 Vdbus_runtime_version
= Qnil
;
1752 DEFVAR_LISP ("dbus-message-type-invalid",
1753 Vdbus_message_type_invalid
,
1754 doc
: /* This value is never a valid message type. */);
1755 Vdbus_message_type_invalid
= make_number (DBUS_MESSAGE_TYPE_INVALID
);
1757 DEFVAR_LISP ("dbus-message-type-method-call",
1758 Vdbus_message_type_method_call
,
1759 doc
: /* Message type of a method call message. */);
1760 Vdbus_message_type_method_call
= make_number (DBUS_MESSAGE_TYPE_METHOD_CALL
);
1762 DEFVAR_LISP ("dbus-message-type-method-return",
1763 Vdbus_message_type_method_return
,
1764 doc
: /* Message type of a method return message. */);
1765 Vdbus_message_type_method_return
1766 = make_number (DBUS_MESSAGE_TYPE_METHOD_RETURN
);
1768 DEFVAR_LISP ("dbus-message-type-error",
1769 Vdbus_message_type_error
,
1770 doc
: /* Message type of an error reply message. */);
1771 Vdbus_message_type_error
= make_number (DBUS_MESSAGE_TYPE_ERROR
);
1773 DEFVAR_LISP ("dbus-message-type-signal",
1774 Vdbus_message_type_signal
,
1775 doc
: /* Message type of a signal message. */);
1776 Vdbus_message_type_signal
= make_number (DBUS_MESSAGE_TYPE_SIGNAL
);
1778 DEFVAR_LISP ("dbus-registered-objects-table",
1779 Vdbus_registered_objects_table
,
1780 doc
: /* Hash table of registered functions for D-Bus.
1782 There are two different uses of the hash table: for accessing
1783 registered interfaces properties, targeted by signals or method calls,
1784 and for calling handlers in case of non-blocking method call returns.
1786 In the first case, the key in the hash table is the list (TYPE BUS
1787 INTERFACE MEMBER). TYPE is one of the Lisp symbols `:method',
1788 `:signal' or `:property'. BUS is either a Lisp symbol, `:system' or
1789 `:session', or a string denoting the bus address. INTERFACE is a
1790 string which denotes a D-Bus interface, and MEMBER, also a string, is
1791 either a method, a signal or a property INTERFACE is offering. All
1792 arguments but BUS must not be nil.
1794 The value in the hash table is a list of quadruple lists ((UNAME
1795 SERVICE PATH OBJECT [RULE]) ...). SERVICE is the service name as
1796 registered, UNAME is the corresponding unique name. In case of
1797 registered methods and properties, UNAME is nil. PATH is the object
1798 path of the sending object. All of them can be nil, which means a
1799 wildcard then. OBJECT is either the handler to be called when a D-Bus
1800 message, which matches the key criteria, arrives (TYPE `:method' and
1801 `:signal'), or a cons cell containing the value of the property (TYPE
1804 For entries of type `:signal', there is also a fifth element RULE,
1805 which keeps the match string the signal is registered with.
1807 In the second case, the key in the hash table is the list (:serial BUS
1808 SERIAL). BUS is either a Lisp symbol, `:system' or `:session', or a
1809 string denoting the bus address. SERIAL is the serial number of the
1810 non-blocking method call, a reply is expected. Both arguments must
1811 not be nil. The value in the hash table is HANDLER, the function to
1812 be called when the D-Bus reply message arrives. */);
1813 Vdbus_registered_objects_table
= CALLN (Fmake_hash_table
, QCtest
, Qequal
);
1815 DEFVAR_LISP ("dbus-debug", Vdbus_debug
,
1816 doc
: /* If non-nil, debug messages of D-Bus bindings are raised. */);
1819 /* We can also set environment variable DBUS_VERBOSE=1 in order to
1820 see more traces. This requires libdbus-1 to be configured with
1821 --enable-verbose-mode. */
1826 /* Initialize internal objects. */
1827 xd_registered_buses
= Qnil
;
1828 staticpro (&xd_registered_buses
);
1830 Fprovide (intern_c_string ("dbusbind"), Qnil
);
1834 #endif /* HAVE_DBUS */