1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17
18
19 #include "config.h"
20
21 #ifdef HAVE_DBUS
22 #include <stdlib.h>
23 #include <stdio.h>
24 #include <dbus/dbus.h>
25 #include <setjmp.h>
26 #include "lisp.h"
27 #include "frame.h"
28 #include "termhooks.h"
29 #include "keyboard.h"
30
31
32
33 Lisp_Object Qdbus_init_bus;
34 Lisp_Object Qdbus_get_unique_name;
35 Lisp_Object Qdbus_call_method;
36 Lisp_Object Qdbus_call_method_asynchronously;
37 Lisp_Object Qdbus_method_return_internal;
38 Lisp_Object Qdbus_method_error_internal;
39 Lisp_Object Qdbus_send_signal;
40 Lisp_Object Qdbus_register_signal;
41 Lisp_Object Qdbus_register_method;
42
43
44 Lisp_Object Qdbus_error;
45
46
47 Lisp_Object QCdbus_system_bus, QCdbus_session_bus;
48
49
50 Lisp_Object QCdbus_timeout;
51
52
53 Lisp_Object QCdbus_type_byte, QCdbus_type_boolean;
54 Lisp_Object QCdbus_type_int16, QCdbus_type_uint16;
55 Lisp_Object QCdbus_type_int32, QCdbus_type_uint32;
56 Lisp_Object QCdbus_type_int64, QCdbus_type_uint64;
57 Lisp_Object QCdbus_type_double, QCdbus_type_string;
58 Lisp_Object QCdbus_type_object_path, QCdbus_type_signature;
59 Lisp_Object QCdbus_type_array, QCdbus_type_variant;
60 Lisp_Object QCdbus_type_struct, QCdbus_type_dict_entry;
61
62
63 Lisp_Object Vdbus_registered_objects_table;
64
65
66 Lisp_Object Vdbus_debug;
67
68
69 int xd_in_read_queued_messages = 0;
70
71
72 73
74
75 76
77 #define XD_SIGNAL1(arg) \
78 do { \
79 if (xd_in_read_queued_messages) \
80 Fthrow (Qdbus_error, Qnil); \
81 else \
82 xsignal1 (Qdbus_error, arg); \
83 } while (0)
84
85 #define XD_SIGNAL2(arg1, arg2) \
86 do { \
87 if (xd_in_read_queued_messages) \
88 Fthrow (Qdbus_error, Qnil); \
89 else \
90 xsignal2 (Qdbus_error, arg1, arg2); \
91 } while (0)
92
93 #define XD_SIGNAL3(arg1, arg2, arg3) \
94 do { \
95 if (xd_in_read_queued_messages) \
96 Fthrow (Qdbus_error, Qnil); \
97 else \
98 xsignal3 (Qdbus_error, arg1, arg2, arg3); \
99 } while (0)
100
101
102 #define XD_ERROR(error) \
103 do { \
104 char s[1024]; \
105 strncpy (s, error.message, 1023); \
106 dbus_error_free (&error); \
107 \
108 if (strchr (s, '\n') != NULL) \
109 s[strlen (s) - 1] = '\0'; \
110 XD_SIGNAL1 (build_string (s)); \
111 } while (0)
112
113 114
115 #ifdef DBUS_DEBUG
116 #define XD_DEBUG_MESSAGE(...) \
117 do { \
118 char s[1024]; \
119 snprintf (s, 1023, __VA_ARGS__); \
120 printf ("%s: %s\n", __func__, s); \
121 message ("%s: %s", __func__, s); \
122 } while (0)
123 #define XD_DEBUG_VALID_LISP_OBJECT_P(object) \
124 do { \
125 if (!valid_lisp_object_p (object)) \
126 { \
127 XD_DEBUG_MESSAGE ("%d Assertion failure", __LINE__); \
128 XD_SIGNAL1 (build_string ("Assertion failure")); \
129 } \
130 } while (0)
131
132 #else
133 #define XD_DEBUG_MESSAGE(...) \
134 do { \
135 if (!NILP (Vdbus_debug)) \
136 { \
137 char s[1024]; \
138 snprintf (s, 1023, __VA_ARGS__); \
139 message ("%s: %s", __func__, s); \
140 } \
141 } while (0)
142 #define XD_DEBUG_VALID_LISP_OBJECT_P(object)
143 #endif
144
145
146 #define XD_BASIC_DBUS_TYPE(type) \
147 ((type == DBUS_TYPE_BYTE) \
148 || (type == DBUS_TYPE_BOOLEAN) \
149 || (type == DBUS_TYPE_INT16) \
150 || (type == DBUS_TYPE_UINT16) \
151 || (type == DBUS_TYPE_INT32) \
152 || (type == DBUS_TYPE_UINT32) \
153 || (type == DBUS_TYPE_INT64) \
154 || (type == DBUS_TYPE_UINT64) \
155 || (type == DBUS_TYPE_DOUBLE) \
156 || (type == DBUS_TYPE_STRING) \
157 || (type == DBUS_TYPE_OBJECT_PATH) \
158 || (type == DBUS_TYPE_SIGNATURE))
159
160 161 162
163 164
165 static int
166 xd_symbol_to_dbus_type (object)
167 Lisp_Object object;
168 {
169 return
170 ((EQ (object, QCdbus_type_byte)) ? DBUS_TYPE_BYTE
171 : (EQ (object, QCdbus_type_boolean)) ? DBUS_TYPE_BOOLEAN
172 : (EQ (object, QCdbus_type_int16)) ? DBUS_TYPE_INT16
173 : (EQ (object, QCdbus_type_uint16)) ? DBUS_TYPE_UINT16
174 : (EQ (object, QCdbus_type_int32)) ? DBUS_TYPE_INT32
175 : (EQ (object, QCdbus_type_uint32)) ? DBUS_TYPE_UINT32
176 : (EQ (object, QCdbus_type_int64)) ? DBUS_TYPE_INT64
177 : (EQ (object, QCdbus_type_uint64)) ? DBUS_TYPE_UINT64
178 : (EQ (object, QCdbus_type_double)) ? DBUS_TYPE_DOUBLE
179 : (EQ (object, QCdbus_type_string)) ? DBUS_TYPE_STRING
180 : (EQ (object, QCdbus_type_object_path)) ? DBUS_TYPE_OBJECT_PATH
181 : (EQ (object, QCdbus_type_signature)) ? DBUS_TYPE_SIGNATURE
182 : (EQ (object, QCdbus_type_array)) ? DBUS_TYPE_ARRAY
183 : (EQ (object, QCdbus_type_variant)) ? DBUS_TYPE_VARIANT
184 : (EQ (object, QCdbus_type_struct)) ? DBUS_TYPE_STRUCT
185 : (EQ (object, QCdbus_type_dict_entry)) ? DBUS_TYPE_DICT_ENTRY
186 : DBUS_TYPE_INVALID);
187 }
188
189
190 #define XD_DBUS_TYPE_P(object) \
191 (SYMBOLP (object) && ((xd_symbol_to_dbus_type (object) != DBUS_TYPE_INVALID)))
192
193 194 195 196
197 #define XD_OBJECT_TO_DBUS_TYPE(object) \
198 ((EQ (object, Qt) || EQ (object, Qnil)) ? DBUS_TYPE_BOOLEAN \
199 : (NATNUMP (object)) ? DBUS_TYPE_UINT32 \
200 : (INTEGERP (object)) ? DBUS_TYPE_INT32 \
201 : (FLOATP (object)) ? DBUS_TYPE_DOUBLE \
202 : (STRINGP (object)) ? DBUS_TYPE_STRING \
203 : (XD_DBUS_TYPE_P (object)) ? xd_symbol_to_dbus_type (object) \
204 : (CONSP (object)) \
205 ? ((XD_DBUS_TYPE_P (CAR_SAFE (object))) \
206 ? ((XD_BASIC_DBUS_TYPE (xd_symbol_to_dbus_type (CAR_SAFE (object)))) \
207 ? DBUS_TYPE_ARRAY \
208 : xd_symbol_to_dbus_type (CAR_SAFE (object))) \
209 : DBUS_TYPE_ARRAY) \
210 : DBUS_TYPE_INVALID)
211
212
213 #define XD_NEXT_VALUE(object) \
214 ((XD_DBUS_TYPE_P (CAR_SAFE (object))) ? CDR_SAFE (object) : object)
215
216 217 218 219 220 221 222
223 static void
224 xd_signature (signature, dtype, parent_type, object)
225 char *signature;
226 unsigned int dtype, parent_type;
227 Lisp_Object object;
228 {
229 unsigned int subtype;
230 Lisp_Object elt;
231 char x[DBUS_MAXIMUM_SIGNATURE_LENGTH];
232
233 elt = object;
234
235 switch (dtype)
236 {
237 case DBUS_TYPE_BYTE:
238 case DBUS_TYPE_UINT16:
239 case DBUS_TYPE_UINT32:
240 case DBUS_TYPE_UINT64:
241 CHECK_NATNUM (object);
242 sprintf (signature, "%c", dtype);
243 break;
244
245 case DBUS_TYPE_BOOLEAN:
246 if (!EQ (object, Qt) && !EQ (object, Qnil))
247 wrong_type_argument (intern ("booleanp"), object);
248 sprintf (signature, "%c", dtype);
249 break;
250
251 case DBUS_TYPE_INT16:
252 case DBUS_TYPE_INT32:
253 case DBUS_TYPE_INT64:
254 CHECK_NUMBER (object);
255 sprintf (signature, "%c", dtype);
256 break;
257
258 case DBUS_TYPE_DOUBLE:
259 CHECK_FLOAT (object);
260 sprintf (signature, "%c", dtype);
261 break;
262
263 case DBUS_TYPE_STRING:
264 case DBUS_TYPE_OBJECT_PATH:
265 case DBUS_TYPE_SIGNATURE:
266 CHECK_STRING (object);
267 sprintf (signature, "%c", dtype);
268 break;
269
270 case DBUS_TYPE_ARRAY:
271 272 273
274 CHECK_CONS (object);
275
276
277 if (EQ (QCdbus_type_array, CAR_SAFE (elt)))
278 elt = XD_NEXT_VALUE (elt);
279
280 281
282 if (NILP (elt))
283 {
284 subtype = DBUS_TYPE_STRING;
285 strcpy (x, DBUS_TYPE_STRING_AS_STRING);
286 }
287 else
288 {
289 subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
290 xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
291 }
292
293 294 295
296 if ((subtype == DBUS_TYPE_SIGNATURE)
297 && STRINGP (CAR_SAFE (XD_NEXT_VALUE (elt)))
298 && NILP (CDR_SAFE (XD_NEXT_VALUE (elt))))
299 strcpy (x, SDATA (CAR_SAFE (XD_NEXT_VALUE (elt))));
300
301 while (!NILP (elt))
302 {
303 if (subtype != XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt)))
304 wrong_type_argument (intern ("D-Bus"), CAR_SAFE (elt));
305 elt = CDR_SAFE (XD_NEXT_VALUE (elt));
306 }
307
308 sprintf (signature, "%c%s", dtype, x);
309 break;
310
311 case DBUS_TYPE_VARIANT:
312
313 CHECK_CONS (object);
314
315 elt = XD_NEXT_VALUE (elt);
316 subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
317 xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
318
319 if (!NILP (CDR_SAFE (XD_NEXT_VALUE (elt))))
320 wrong_type_argument (intern ("D-Bus"),
321 CAR_SAFE (CDR_SAFE (XD_NEXT_VALUE (elt))));
322
323 sprintf (signature, "%c", dtype);
324 break;
325
326 case DBUS_TYPE_STRUCT:
327 328
329 CHECK_CONS (object);
330
331 elt = XD_NEXT_VALUE (elt);
332
333 334
335 sprintf (signature, "%c", DBUS_STRUCT_BEGIN_CHAR );
336 while (!NILP (elt))
337 {
338 subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
339 xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
340 strcat (signature, x);
341 elt = CDR_SAFE (XD_NEXT_VALUE (elt));
342 }
343 strcat (signature, DBUS_STRUCT_END_CHAR_AS_STRING);
344 break;
345
346 case DBUS_TYPE_DICT_ENTRY:
347 348 349
350 CHECK_CONS (object);
351
352
353 if (parent_type != DBUS_TYPE_ARRAY)
354 wrong_type_argument (intern ("D-Bus"), object);
355
356 357
358 sprintf (signature, "%c", DBUS_DICT_ENTRY_BEGIN_CHAR);
359
360
361 elt = XD_NEXT_VALUE (elt);
362 subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
363 xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
364 strcat (signature, x);
365
366 if (!XD_BASIC_DBUS_TYPE (subtype))
367 wrong_type_argument (intern ("D-Bus"), CAR_SAFE (XD_NEXT_VALUE (elt)));
368
369
370 elt = CDR_SAFE (XD_NEXT_VALUE (elt));
371 subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
372 xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
373 strcat (signature, x);
374
375 if (!NILP (CDR_SAFE (XD_NEXT_VALUE (elt))))
376 wrong_type_argument (intern ("D-Bus"),
377 CAR_SAFE (CDR_SAFE (XD_NEXT_VALUE (elt))));
378
379
380 strcat (signature, DBUS_DICT_ENTRY_END_CHAR_AS_STRING);
381 break;
382
383 default:
384 wrong_type_argument (intern ("D-Bus"), object);
385 }
386
387 XD_DEBUG_MESSAGE ("%s", signature);
388 }
389
390 391 392 393 394
395 static void
396 xd_append_arg (dtype, object, iter)
397 unsigned int dtype;
398 Lisp_Object object;
399 DBusMessageIter *iter;
400 {
401 char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
402 DBusMessageIter subiter;
403
404 if (XD_BASIC_DBUS_TYPE (dtype))
405 switch (dtype)
406 {
407 case DBUS_TYPE_BYTE:
408 {
409 unsigned char val = XUINT (object) & 0xFF;
410 XD_DEBUG_MESSAGE ("%c %d", dtype, val);
411 if (!dbus_message_iter_append_basic (iter, dtype, &val))
412 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
413 return;
414 }
415
416 case DBUS_TYPE_BOOLEAN:
417 {
418 dbus_bool_t val = (NILP (object)) ? FALSE : TRUE;
419 XD_DEBUG_MESSAGE ("%c %s", dtype, (val == FALSE) ? "false" : "true");
420 if (!dbus_message_iter_append_basic (iter, dtype, &val))
421 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
422 return;
423 }
424
425 case DBUS_TYPE_INT16:
426 {
427 dbus_int16_t val = XINT (object);
428 XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val);
429 if (!dbus_message_iter_append_basic (iter, dtype, &val))
430 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
431 return;
432 }
433
434 case DBUS_TYPE_UINT16:
435 {
436 dbus_uint16_t val = XUINT (object);
437 XD_DEBUG_MESSAGE ("%c %u", dtype, (unsigned int) val);
438 if (!dbus_message_iter_append_basic (iter, dtype, &val))
439 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
440 return;
441 }
442
443 case DBUS_TYPE_INT32:
444 {
445 dbus_int32_t val = XINT (object);
446 XD_DEBUG_MESSAGE ("%c %d", dtype, val);
447 if (!dbus_message_iter_append_basic (iter, dtype, &val))
448 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
449 return;
450 }
451
452 case DBUS_TYPE_UINT32:
453 {
454 dbus_uint32_t val = XUINT (object);
455 XD_DEBUG_MESSAGE ("%c %u", dtype, val);
456 if (!dbus_message_iter_append_basic (iter, dtype, &val))
457 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
458 return;
459 }
460
461 case DBUS_TYPE_INT64:
462 {
463 dbus_int64_t val = XINT (object);
464 XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val);
465 if (!dbus_message_iter_append_basic (iter, dtype, &val))
466 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
467 return;
468 }
469
470 case DBUS_TYPE_UINT64:
471 {
472 dbus_uint64_t val = XUINT (object);
473 XD_DEBUG_MESSAGE ("%c %u", dtype, (unsigned int) val);
474 if (!dbus_message_iter_append_basic (iter, dtype, &val))
475 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
476 return;
477 }
478
479 case DBUS_TYPE_DOUBLE:
480 {
481 double val = XFLOAT_DATA (object);
482 XD_DEBUG_MESSAGE ("%c %f", dtype, val);
483 if (!dbus_message_iter_append_basic (iter, dtype, &val))
484 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
485 return;
486 }
487
488 case DBUS_TYPE_STRING:
489 case DBUS_TYPE_OBJECT_PATH:
490 case DBUS_TYPE_SIGNATURE:
491 {
492 char *val = SDATA (Fstring_make_unibyte (object));
493 XD_DEBUG_MESSAGE ("%c %s", dtype, val);
494 if (!dbus_message_iter_append_basic (iter, dtype, &val))
495 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
496 return;
497 }
498 }
499
500 else
501 {
502
503 504
505 if (!XD_BASIC_DBUS_TYPE (XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object))))
506 object = XD_NEXT_VALUE (object);
507
508
509 switch (dtype)
510 {
511 case DBUS_TYPE_ARRAY:
512 513 514
515
516 if (NILP (object))
517 518
519 strcpy (signature, DBUS_TYPE_STRING_AS_STRING);
520
521 else
522 523 524
525 if ((XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object))
526 == DBUS_TYPE_SIGNATURE)
527 && STRINGP (CAR_SAFE (XD_NEXT_VALUE (object)))
528 && NILP (CDR_SAFE (XD_NEXT_VALUE (object))))
529 {
530 strcpy (signature, SDATA (CAR_SAFE (XD_NEXT_VALUE (object))));
531 object = CDR_SAFE (XD_NEXT_VALUE (object));
532 }
533
534 else
535 xd_signature (signature,
536 XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object)),
537 dtype, CAR_SAFE (XD_NEXT_VALUE (object)));
538
539 XD_DEBUG_MESSAGE ("%c %s %s", dtype, signature,
540 SDATA (format2 ("%s", object, Qnil)));
541 if (!dbus_message_iter_open_container (iter, dtype,
542 signature, &subiter))
543 XD_SIGNAL3 (build_string ("Cannot open container"),
544 make_number (dtype), build_string (signature));
545 break;
546
547 case DBUS_TYPE_VARIANT:
548
549 xd_signature (signature, XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object)),
550 dtype, CAR_SAFE (XD_NEXT_VALUE (object)));
551
552 XD_DEBUG_MESSAGE ("%c %s %s", dtype, signature,
553 SDATA (format2 ("%s", object, Qnil)));
554 if (!dbus_message_iter_open_container (iter, dtype,
555 signature, &subiter))
556 XD_SIGNAL3 (build_string ("Cannot open container"),
557 make_number (dtype), build_string (signature));
558 break;
559
560 case DBUS_TYPE_STRUCT:
561 case DBUS_TYPE_DICT_ENTRY:
562
563 XD_DEBUG_MESSAGE ("%c %s", dtype,
564 SDATA (format2 ("%s", object, Qnil)));
565 if (!dbus_message_iter_open_container (iter, dtype, NULL, &subiter))
566 XD_SIGNAL2 (build_string ("Cannot open container"),
567 make_number (dtype));
568 break;
569 }
570
571
572 while (!NILP (object))
573 {
574 dtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object));
575 object = XD_NEXT_VALUE (object);
576
577 xd_append_arg (dtype, CAR_SAFE (object), &subiter);
578
579 object = CDR_SAFE (object);
580 }
581
582
583 if (!dbus_message_iter_close_container (iter, &subiter))
584 XD_SIGNAL2 (build_string ("Cannot close container"),
585 make_number (dtype));
586 }
587 }
588
589 590 591 592
593 static Lisp_Object
594 xd_retrieve_arg (dtype, iter)
595 unsigned int dtype;
596 DBusMessageIter *iter;
597 {
598
599 switch (dtype)
600 {
601 case DBUS_TYPE_BYTE:
602 {
603 unsigned int val;
604 dbus_message_iter_get_basic (iter, &val);
605 val = val & 0xFF;
606 XD_DEBUG_MESSAGE ("%c %d", dtype, val);
607 return make_number (val);
608 }
609
610 case DBUS_TYPE_BOOLEAN:
611 {
612 dbus_bool_t val;
613 dbus_message_iter_get_basic (iter, &val);
614 XD_DEBUG_MESSAGE ("%c %s", dtype, (val == FALSE) ? "false" : "true");
615 return (val == FALSE) ? Qnil : Qt;
616 }
617
618 case DBUS_TYPE_INT16:
619 {
620 dbus_int16_t val;
621 dbus_message_iter_get_basic (iter, &val);
622 XD_DEBUG_MESSAGE ("%c %d", dtype, val);
623 return make_number (val);
624 }
625
626 case DBUS_TYPE_UINT16:
627 {
628 dbus_uint16_t val;
629 dbus_message_iter_get_basic (iter, &val);
630 XD_DEBUG_MESSAGE ("%c %d", dtype, val);
631 return make_number (val);
632 }
633
634 case DBUS_TYPE_INT32:
635 {
636 dbus_int32_t val;
637 dbus_message_iter_get_basic (iter, &val);
638 XD_DEBUG_MESSAGE ("%c %d", dtype, val);
639 return make_fixnum_or_float (val);
640 }
641
642 case DBUS_TYPE_UINT32:
643 {
644 dbus_uint32_t val;
645 dbus_message_iter_get_basic (iter, &val);
646 XD_DEBUG_MESSAGE ("%c %d", dtype, val);
647 return make_fixnum_or_float (val);
648 }
649
650 case DBUS_TYPE_INT64:
651 {
652 dbus_int64_t val;
653 dbus_message_iter_get_basic (iter, &val);
654 XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val);
655 return make_fixnum_or_float (val);
656 }
657
658 case DBUS_TYPE_UINT64:
659 {
660 dbus_uint64_t val;
661 dbus_message_iter_get_basic (iter, &val);
662 XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val);
663 return make_fixnum_or_float (val);
664 }
665
666 case DBUS_TYPE_DOUBLE:
667 {
668 double val;
669 dbus_message_iter_get_basic (iter, &val);
670 XD_DEBUG_MESSAGE ("%c %f", dtype, val);
671 return make_float (val);
672 }
673
674 case DBUS_TYPE_STRING:
675 case DBUS_TYPE_OBJECT_PATH:
676 case DBUS_TYPE_SIGNATURE:
677 {
678 char *val;
679 dbus_message_iter_get_basic (iter, &val);
680 XD_DEBUG_MESSAGE ("%c %s", dtype, val);
681 return build_string (val);
682 }
683
684 case DBUS_TYPE_ARRAY:
685 case DBUS_TYPE_VARIANT:
686 case DBUS_TYPE_STRUCT:
687 case DBUS_TYPE_DICT_ENTRY:
688 {
689 Lisp_Object result;
690 struct gcpro gcpro1;
691 DBusMessageIter subiter;
692 int subtype;
693 result = Qnil;
694 GCPRO1 (result);
695 dbus_message_iter_recurse (iter, &subiter);
696 while ((subtype = dbus_message_iter_get_arg_type (&subiter))
697 != DBUS_TYPE_INVALID)
698 {
699 result = Fcons (xd_retrieve_arg (subtype, &subiter), result);
700 dbus_message_iter_next (&subiter);
701 }
702 XD_DEBUG_MESSAGE ("%c %s", dtype, SDATA (format2 ("%s", result, Qnil)));
703 RETURN_UNGCPRO (Fnreverse (result));
704 }
705
706 default:
707 XD_DEBUG_MESSAGE ("DBusType '%c' not supported", dtype);
708 return Qnil;
709 }
710 }
711
712 713
714 static DBusConnection *
715 xd_initialize (bus)
716 Lisp_Object bus;
717 {
718 DBusConnection *connection;
719 DBusError derror;
720
721
722 CHECK_SYMBOL (bus);
723 if (!(EQ (bus, QCdbus_system_bus) || EQ (bus, QCdbus_session_bus)))
724 XD_SIGNAL2 (build_string ("Wrong bus name"), bus);
725
726
727 if (EQ (bus, QCdbus_session_bus)
728 && getenv ("DBUS_SESSION_BUS_ADDRESS") == NULL)
729 XD_SIGNAL2 (build_string ("No connection to bus"), bus);
730
731
732 dbus_error_init (&derror);
733
734 if (EQ (bus, QCdbus_system_bus))
735 connection = dbus_bus_get (DBUS_BUS_SYSTEM, &derror);
736 else
737 connection = dbus_bus_get (DBUS_BUS_SESSION, &derror);
738
739 if (dbus_error_is_set (&derror))
740 XD_ERROR (derror);
741
742 if (connection == NULL)
743 XD_SIGNAL2 (build_string ("No connection to bus"), bus);
744
745
746 dbus_error_free (&derror);
747
748
749 return connection;
750 }
751
752
753 754
755 dbus_bool_t
756 xd_add_watch (watch, data)
757 DBusWatch *watch;
758 void *data;
759 {
760
761 if (dbus_watch_get_flags (watch) & DBUS_WATCH_READABLE)
762 {
763 #if HAVE_DBUS_WATCH_GET_UNIX_FD
764
765 int fd = dbus_watch_get_unix_fd(watch);
766 if (fd == -1)
767 fd = dbus_watch_get_socket(watch);
768 #else
769 int fd = dbus_watch_get_fd(watch);
770 #endif
771 XD_DEBUG_MESSAGE ("fd %d", fd);
772
773 if (fd == -1)
774 return FALSE;
775
776
777 add_keyboard_wait_descriptor (fd);
778 }
779
780
781 return TRUE;
782 }
783
784 785
786 void
787 xd_remove_watch (watch, data)
788 DBusWatch *watch;
789 void *data;
790 {
791
792 if (dbus_watch_get_flags (watch) & DBUS_WATCH_READABLE)
793 {
794 #if HAVE_DBUS_WATCH_GET_UNIX_FD
795
796 int fd = dbus_watch_get_unix_fd(watch);
797 if (fd == -1)
798 fd = dbus_watch_get_socket(watch);
799 #else
800 int fd = dbus_watch_get_fd(watch);
801 #endif
802 XD_DEBUG_MESSAGE ("fd %d", fd);
803
804 if (fd == -1)
805 return;
806
807
808 if ((data != NULL) && (data == (void*) XHASH (QCdbus_session_bus)))
809 {
810 XD_DEBUG_MESSAGE ("unsetenv DBUS_SESSION_BUS_ADDRESS");
811 unsetenv ("DBUS_SESSION_BUS_ADDRESS");
812 }
813
814
815 delete_keyboard_wait_descriptor (fd);
816 }
817
818
819 return;
820 }
821
822 DEFUN ("dbus-init-bus", Fdbus_init_bus, Sdbus_init_bus, 1, 1, 0,
823 doc: 824 )
825 (bus)
826 Lisp_Object bus;
827 {
828 DBusConnection *connection;
829
830
831 CHECK_SYMBOL (bus);
832
833
834 connection = xd_initialize (bus);
835
836 837
838 if (!dbus_connection_set_watch_functions (connection,
839 xd_add_watch,
840 xd_remove_watch,
841 NULL, (void*) XHASH (bus), NULL))
842 XD_SIGNAL1 (build_string ("Cannot add watch functions"));
843
844
845 return Qnil;
846 }
847
848 DEFUN ("dbus-get-unique-name", Fdbus_get_unique_name, Sdbus_get_unique_name,
849 1, 1, 0,
850 doc: )
851 (bus)
852 Lisp_Object bus;
853 {
854 DBusConnection *connection;
855 const char *name;
856
857
858 CHECK_SYMBOL (bus);
859
860
861 connection = xd_initialize (bus);
862
863
864 name = dbus_bus_get_unique_name (connection);
865 if (name == NULL)
866 XD_SIGNAL1 (build_string ("No unique name available"));
867
868
869 return build_string (name);
870 }
871
872 DEFUN ("dbus-call-method", Fdbus_call_method, Sdbus_call_method, 5, MANY, 0,
873 doc: 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 )
940 (nargs, args)
941 int nargs;
942 register Lisp_Object *args;
943 {
944 Lisp_Object bus, service, path, interface, method;
945 Lisp_Object result;
946 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
947 DBusConnection *connection;
948 DBusMessage *dmessage;
949 DBusMessage *reply;
950 DBusMessageIter iter;
951 DBusError derror;
952 unsigned int dtype;
953 int timeout = -1;
954 int i = 5;
955 char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
956
957
958 bus = args[0];
959 service = args[1];
960 path = args[2];
961 interface = args[3];
962 method = args[4];
963
964 CHECK_SYMBOL (bus);
965 CHECK_STRING (service);
966 CHECK_STRING (path);
967 CHECK_STRING (interface);
968 CHECK_STRING (method);
969 GCPRO5 (bus, service, path, interface, method);
970
971 XD_DEBUG_MESSAGE ("%s %s %s %s",
972 SDATA (service),
973 SDATA (path),
974 SDATA (interface),
975 SDATA (method));
976
977
978 connection = xd_initialize (bus);
979
980
981 dmessage = dbus_message_new_method_call (SDATA (service),
982 SDATA (path),
983 SDATA (interface),
984 SDATA (method));
985 UNGCPRO;
986 if (dmessage == NULL)
987 XD_SIGNAL1 (build_string ("Unable to create a new message"));
988
989
990 if ((i+2 <= nargs) && (EQ ((args[i]), QCdbus_timeout)))
991 {
992 CHECK_NATNUM (args[i+1]);
993 timeout = XUINT (args[i+1]);
994 i = i+2;
995 }
996
997
998 dbus_message_iter_init_append (dmessage, &iter);
999
1000
1001 for (; i < nargs; ++i)
1002 {
1003 dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
1004 if (XD_DBUS_TYPE_P (args[i]))
1005 {
1006 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1007 XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
1008 XD_DEBUG_MESSAGE ("Parameter%d %s %s", i-4,
1009 SDATA (format2 ("%s", args[i], Qnil)),
1010 SDATA (format2 ("%s", args[i+1], Qnil)));
1011 ++i;
1012 }
1013 else
1014 {
1015 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1016 XD_DEBUG_MESSAGE ("Parameter%d %s", i-4,
1017 SDATA (format2 ("%s", args[i], Qnil)));
1018 }
1019
1020 1021
1022 xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
1023
1024 xd_append_arg (dtype, args[i], &iter);
1025 }
1026
1027
1028 dbus_error_init (&derror);
1029 reply = dbus_connection_send_with_reply_and_block (connection,
1030 dmessage,
1031 timeout,
1032 &derror);
1033
1034 if (dbus_error_is_set (&derror))
1035 XD_ERROR (derror);
1036
1037 if (reply == NULL)
1038 XD_SIGNAL1 (build_string ("No reply"));
1039
1040 XD_DEBUG_MESSAGE ("Message sent");
1041
1042
1043 result = Qnil;
1044 GCPRO1 (result);
1045
1046 if (dbus_message_iter_init (reply, &iter))
1047 {
1048 1049
1050 while ((dtype = dbus_message_iter_get_arg_type (&iter))
1051 != DBUS_TYPE_INVALID)
1052 {
1053 result = Fcons (xd_retrieve_arg (dtype, &iter), result);
1054 dbus_message_iter_next (&iter);
1055 }
1056 }
1057 else
1058 {
1059
1060 }
1061
1062
1063 dbus_error_free (&derror);
1064 dbus_message_unref (dmessage);
1065 dbus_message_unref (reply);
1066
1067 1068
1069 if (XUINT (Flength (result)) == 1)
1070 RETURN_UNGCPRO (CAR_SAFE (result));
1071 else
1072 RETURN_UNGCPRO (Fnreverse (result));
1073 }
1074
1075 DEFUN ("dbus-call-method-asynchronously", Fdbus_call_method_asynchronously,
1076 Sdbus_call_method_asynchronously, 6, MANY, 0,
1077 doc: 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 )
1124 (nargs, args)
1125 int nargs;
1126 register Lisp_Object *args;
1127 {
1128 Lisp_Object bus, service, path, interface, method, handler;
1129 Lisp_Object result;
1130 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
1131 DBusConnection *connection;
1132 DBusMessage *dmessage;
1133 DBusMessageIter iter;
1134 unsigned int dtype;
1135 int timeout = -1;
1136 int i = 6;
1137 char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
1138
1139
1140 bus = args[0];
1141 service = args[1];
1142 path = args[2];
1143 interface = args[3];
1144 method = args[4];
1145 handler = args[5];
1146
1147 CHECK_SYMBOL (bus);
1148 CHECK_STRING (service);
1149 CHECK_STRING (path);
1150 CHECK_STRING (interface);
1151 CHECK_STRING (method);
1152 if (!NILP (handler) && !FUNCTIONP (handler))
1153 wrong_type_argument (intern ("functionp"), handler);
1154 GCPRO6 (bus, service, path, interface, method, handler);
1155
1156 XD_DEBUG_MESSAGE ("%s %s %s %s",
1157 SDATA (service),
1158 SDATA (path),
1159 SDATA (interface),
1160 SDATA (method));
1161
1162
1163 connection = xd_initialize (bus);
1164
1165
1166 dmessage = dbus_message_new_method_call (SDATA (service),
1167 SDATA (path),
1168 SDATA (interface),
1169 SDATA (method));
1170 if (dmessage == NULL)
1171 XD_SIGNAL1 (build_string ("Unable to create a new message"));
1172
1173
1174 if ((i+2 <= nargs) && (EQ ((args[i]), QCdbus_timeout)))
1175 {
1176 CHECK_NATNUM (args[i+1]);
1177 timeout = XUINT (args[i+1]);
1178 i = i+2;
1179 }
1180
1181
1182 dbus_message_iter_init_append (dmessage, &iter);
1183
1184
1185 for (; i < nargs; ++i)
1186 {
1187 dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
1188 if (XD_DBUS_TYPE_P (args[i]))
1189 {
1190 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1191 XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
1192 XD_DEBUG_MESSAGE ("Parameter%d %s %s", i-4,
1193 SDATA (format2 ("%s", args[i], Qnil)),
1194 SDATA (format2 ("%s", args[i+1], Qnil)));
1195 ++i;
1196 }
1197 else
1198 {
1199 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1200 XD_DEBUG_MESSAGE ("Parameter%d %s", i-4,
1201 SDATA (format2 ("%s", args[i], Qnil)));
1202 }
1203
1204 1205
1206 xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
1207
1208 xd_append_arg (dtype, args[i], &iter);
1209 }
1210
1211 if (!NILP (handler))
1212 {
1213 1214
1215 if (!dbus_connection_send_with_reply (connection, dmessage,
1216 NULL, timeout))
1217 XD_SIGNAL1 (build_string ("Cannot send message"));
1218
1219
1220 result = (list2 (bus, make_number (dbus_message_get_serial (dmessage))));
1221
1222
1223 Fputhash (result, handler, Vdbus_registered_objects_table);
1224 }
1225 else
1226 {
1227 1228
1229 if (!dbus_connection_send (connection, dmessage, NULL))
1230 XD_SIGNAL1 (build_string ("Cannot send message"));
1231
1232 result = Qnil;
1233 }
1234
1235
1236 dbus_connection_flush (connection);
1237
1238 XD_DEBUG_MESSAGE ("Message sent");
1239
1240
1241 dbus_message_unref (dmessage);
1242
1243
1244 RETURN_UNGCPRO (result);
1245 }
1246
1247 DEFUN ("dbus-method-return-internal", Fdbus_method_return_internal,
1248 Sdbus_method_return_internal,
1249 3, MANY, 0,
1250 doc: 1251 1252 1253 )
1254 (nargs, args)
1255 int nargs;
1256 register Lisp_Object *args;
1257 {
1258 Lisp_Object bus, serial, service;
1259 struct gcpro gcpro1, gcpro2, gcpro3;
1260 DBusConnection *connection;
1261 DBusMessage *dmessage;
1262 DBusMessageIter iter;
1263 unsigned int dtype;
1264 int i;
1265 char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
1266
1267
1268 bus = args[0];
1269 serial = args[1];
1270 service = args[2];
1271
1272 CHECK_SYMBOL (bus);
1273 CHECK_NUMBER (serial);
1274 CHECK_STRING (service);
1275 GCPRO3 (bus, serial, service);
1276
1277 XD_DEBUG_MESSAGE ("%lu %s ", (unsigned long) XUINT (serial), SDATA (service));
1278
1279
1280 connection = xd_initialize (bus);
1281
1282
1283 dmessage = dbus_message_new (DBUS_MESSAGE_TYPE_METHOD_RETURN);
1284 if ((dmessage == NULL)
1285 || (!dbus_message_set_reply_serial (dmessage, XUINT (serial)))
1286 || (!dbus_message_set_destination (dmessage, SDATA (service))))
1287 {
1288 UNGCPRO;
1289 XD_SIGNAL1 (build_string ("Unable to create a return message"));
1290 }
1291
1292 UNGCPRO;
1293
1294
1295 dbus_message_iter_init_append (dmessage, &iter);
1296
1297
1298 for (i = 3; i < nargs; ++i)
1299 {
1300 dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
1301 if (XD_DBUS_TYPE_P (args[i]))
1302 {
1303 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1304 XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
1305 XD_DEBUG_MESSAGE ("Parameter%d %s %s", i-2,
1306 SDATA (format2 ("%s", args[i], Qnil)),
1307 SDATA (format2 ("%s", args[i+1], Qnil)));
1308 ++i;
1309 }
1310 else
1311 {
1312 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1313 XD_DEBUG_MESSAGE ("Parameter%d %s", i-2,
1314 SDATA (format2 ("%s", args[i], Qnil)));
1315 }
1316
1317 1318
1319 xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
1320
1321 xd_append_arg (dtype, args[i], &iter);
1322 }
1323
1324 1325
1326 if (!dbus_connection_send (connection, dmessage, NULL))
1327 XD_SIGNAL1 (build_string ("Cannot send message"));
1328
1329
1330 dbus_connection_flush (connection);
1331
1332 XD_DEBUG_MESSAGE ("Message sent");
1333
1334
1335 dbus_message_unref (dmessage);
1336
1337
1338 return Qt;
1339 }
1340
1341 DEFUN ("dbus-method-error-internal", Fdbus_method_error_internal,
1342 Sdbus_method_error_internal,
1343 3, MANY, 0,
1344 doc: 1345 1346 1347 )
1348 (nargs, args)
1349 int nargs;
1350 register Lisp_Object *args;
1351 {
1352 Lisp_Object bus, serial, service;
1353 struct gcpro gcpro1, gcpro2, gcpro3;
1354 DBusConnection *connection;
1355 DBusMessage *dmessage;
1356 DBusMessageIter iter;
1357 unsigned int dtype;
1358 int i;
1359 char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
1360
1361
1362 bus = args[0];
1363 serial = args[1];
1364 service = args[2];
1365
1366 CHECK_SYMBOL (bus);
1367 CHECK_NUMBER (serial);
1368 CHECK_STRING (service);
1369 GCPRO3 (bus, serial, service);
1370
1371 XD_DEBUG_MESSAGE ("%lu %s ", (unsigned long) XUINT (serial), SDATA (service));
1372
1373
1374 connection = xd_initialize (bus);
1375
1376
1377 dmessage = dbus_message_new (DBUS_MESSAGE_TYPE_ERROR);
1378 if ((dmessage == NULL)
1379 || (!dbus_message_set_error_name (dmessage, DBUS_ERROR_FAILED))
1380 || (!dbus_message_set_reply_serial (dmessage, XUINT (serial)))
1381 || (!dbus_message_set_destination (dmessage, SDATA (service))))
1382 {
1383 UNGCPRO;
1384 XD_SIGNAL1 (build_string ("Unable to create a error message"));
1385 }
1386
1387 UNGCPRO;
1388
1389
1390 dbus_message_iter_init_append (dmessage, &iter);
1391
1392
1393 for (i = 3; i < nargs; ++i)
1394 {
1395 dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
1396 if (XD_DBUS_TYPE_P (args[i]))
1397 {
1398 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1399 XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
1400 XD_DEBUG_MESSAGE ("Parameter%d %s %s", i-2,
1401 SDATA (format2 ("%s", args[i], Qnil)),
1402 SDATA (format2 ("%s", args[i+1], Qnil)));
1403 ++i;
1404 }
1405 else
1406 {
1407 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1408 XD_DEBUG_MESSAGE ("Parameter%d %s", i-2,
1409 SDATA (format2 ("%s", args[i], Qnil)));
1410 }
1411
1412 1413
1414 xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
1415
1416 xd_append_arg (dtype, args[i], &iter);
1417 }
1418
1419 1420
1421 if (!dbus_connection_send (connection, dmessage, NULL))
1422 XD_SIGNAL1 (build_string ("Cannot send message"));
1423
1424
1425 dbus_connection_flush (connection);
1426
1427 XD_DEBUG_MESSAGE ("Message sent");
1428
1429
1430 dbus_message_unref (dmessage);
1431
1432
1433 return Qt;
1434 }
1435
1436 DEFUN ("dbus-send-signal", Fdbus_send_signal, Sdbus_send_signal, 5, MANY, 0,
1437 doc: 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 )
1465 (nargs, args)
1466 int nargs;
1467 register Lisp_Object *args;
1468 {
1469 Lisp_Object bus, service, path, interface, signal;
1470 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
1471 DBusConnection *connection;
1472 DBusMessage *dmessage;
1473 DBusMessageIter iter;
1474 unsigned int dtype;
1475 int i;
1476 char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
1477
1478
1479 bus = args[0];
1480 service = args[1];
1481 path = args[2];
1482 interface = args[3];
1483 signal = args[4];
1484
1485 CHECK_SYMBOL (bus);
1486 CHECK_STRING (service);
1487 CHECK_STRING (path);
1488 CHECK_STRING (interface);
1489 CHECK_STRING (signal);
1490 GCPRO5 (bus, service, path, interface, signal);
1491
1492 XD_DEBUG_MESSAGE ("%s %s %s %s",
1493 SDATA (service),
1494 SDATA (path),
1495 SDATA (interface),
1496 SDATA (signal));
1497
1498
1499 connection = xd_initialize (bus);
1500
1501
1502 dmessage = dbus_message_new_signal (SDATA (path),
1503 SDATA (interface),
1504 SDATA (signal));
1505 UNGCPRO;
1506 if (dmessage == NULL)
1507 XD_SIGNAL1 (build_string ("Unable to create a new message"));
1508
1509
1510 dbus_message_iter_init_append (dmessage, &iter);
1511
1512
1513 for (i = 5; i < nargs; ++i)
1514 {
1515 dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
1516 if (XD_DBUS_TYPE_P (args[i]))
1517 {
1518 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1519 XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
1520 XD_DEBUG_MESSAGE ("Parameter%d %s %s", i-4,
1521 SDATA (format2 ("%s", args[i], Qnil)),
1522 SDATA (format2 ("%s", args[i+1], Qnil)));
1523 ++i;
1524 }
1525 else
1526 {
1527 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1528 XD_DEBUG_MESSAGE ("Parameter%d %s", i-4,
1529 SDATA (format2 ("%s", args[i], Qnil)));
1530 }
1531
1532 1533
1534 xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
1535
1536 xd_append_arg (dtype, args[i], &iter);
1537 }
1538
1539 1540
1541 if (!dbus_connection_send (connection, dmessage, NULL))
1542 XD_SIGNAL1 (build_string ("Cannot send message"));
1543
1544
1545 dbus_connection_flush (connection);
1546
1547 XD_DEBUG_MESSAGE ("Signal sent");
1548
1549
1550 dbus_message_unref (dmessage);
1551
1552
1553 return Qt;
1554 }
1555
1556 1557
1558 int
1559 xd_get_dispatch_status (bus)
1560 Lisp_Object bus;
1561 {
1562 DBusConnection *connection;
1563
1564
1565 connection = xd_initialize (bus);
1566
1567
1568 dbus_connection_read_write (connection, 0);
1569
1570
1571 return
1572 (dbus_connection_get_dispatch_status (connection)
1573 == DBUS_DISPATCH_DATA_REMAINS)
1574 ? TRUE : FALSE;
1575 }
1576
1577
1578 int
1579 xd_pending_messages ()
1580 {
1581
1582 1583 1584
1585 return (HASH_TABLE_P (Vdbus_registered_objects_table)
1586 ? (xd_get_dispatch_status (QCdbus_system_bus)
1587 || ((getenv ("DBUS_SESSION_BUS_ADDRESS") != NULL)
1588 ? xd_get_dispatch_status (QCdbus_session_bus)
1589 : FALSE))
1590 : FALSE);
1591 }
1592
1593 1594
1595 static Lisp_Object
1596 xd_read_message (bus)
1597 Lisp_Object bus;
1598 {
1599 Lisp_Object args, key, value;
1600 struct gcpro gcpro1;
1601 struct input_event event;
1602 DBusConnection *connection;
1603 DBusMessage *dmessage;
1604 DBusMessageIter iter;
1605 unsigned int dtype;
1606 int mtype, serial;
1607 const char *uname, *path, *interface, *member;
1608
1609
1610 connection = xd_initialize (bus);
1611
1612
1613 dbus_connection_read_write (connection, 0);
1614 dmessage = dbus_connection_pop_message (connection);
1615
1616
1617 if (dmessage == NULL)
1618 return Qnil;
1619
1620
1621 args = Qnil;
1622 GCPRO1 (args);
1623
1624
1625 if (dbus_message_iter_init (dmessage, &iter))
1626 {
1627 while ((dtype = dbus_message_iter_get_arg_type (&iter))
1628 != DBUS_TYPE_INVALID)
1629 {
1630 args = Fcons (xd_retrieve_arg (dtype, &iter), args);
1631 dbus_message_iter_next (&iter);
1632 }
1633
1634 args = Fnreverse (args);
1635 }
1636
1637 1638
1639 mtype = dbus_message_get_type (dmessage);
1640 serial =
1641 ((mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN)
1642 || (mtype == DBUS_MESSAGE_TYPE_ERROR))
1643 ? dbus_message_get_reply_serial (dmessage)
1644 : dbus_message_get_serial (dmessage);
1645 uname = dbus_message_get_sender (dmessage);
1646 path = dbus_message_get_path (dmessage);
1647 interface = dbus_message_get_interface (dmessage);
1648 member = dbus_message_get_member (dmessage);
1649
1650 XD_DEBUG_MESSAGE ("Event received: %s %d %s %s %s %s %s",
1651 (mtype == DBUS_MESSAGE_TYPE_INVALID)
1652 ? "DBUS_MESSAGE_TYPE_INVALID"
1653 : (mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
1654 ? "DBUS_MESSAGE_TYPE_METHOD_CALL"
1655 : (mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN)
1656 ? "DBUS_MESSAGE_TYPE_METHOD_RETURN"
1657 : (mtype == DBUS_MESSAGE_TYPE_ERROR)
1658 ? "DBUS_MESSAGE_TYPE_ERROR"
1659 : "DBUS_MESSAGE_TYPE_SIGNAL",
1660 serial, uname, path, interface, member,
1661 SDATA (format2 ("%s", args, Qnil)));
1662
1663 if ((mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN)
1664 || (mtype == DBUS_MESSAGE_TYPE_ERROR))
1665 {
1666
1667 key = list2 (bus, make_number (serial));
1668 value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
1669
1670
1671 if (NILP (value))
1672 goto cleanup;
1673
1674
1675 Fremhash (key, Vdbus_registered_objects_table);
1676
1677
1678 EVENT_INIT (event);
1679 event.kind = DBUS_EVENT;
1680 event.frame_or_window = Qnil;
1681 event.arg = Fcons (value, args);
1682 }
1683
1684 else
1685 {
1686 1687
1688 if ((interface == NULL) || (member == NULL))
1689 goto cleanup;
1690
1691
1692 key = list3 (bus, build_string (interface), build_string (member));
1693 value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
1694
1695
1696 while (!NILP (value))
1697 {
1698 key = CAR_SAFE (value);
1699
1700 if (((uname == NULL)
1701 || (NILP (CAR_SAFE (key)))
1702 || (strcmp (uname, SDATA (CAR_SAFE (key))) == 0))
1703 && ((path == NULL)
1704 || (NILP (CAR_SAFE (CDR_SAFE (CDR_SAFE (key)))))
1705 || (strcmp (path,
1706 SDATA (CAR_SAFE (CDR_SAFE (CDR_SAFE (key)))))
1707 == 0))
1708 && (!NILP (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (key)))))))
1709 {
1710 EVENT_INIT (event);
1711 event.kind = DBUS_EVENT;
1712 event.frame_or_window = Qnil;
1713 event.arg = Fcons (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (key)))),
1714 args);
1715 break;
1716 }
1717 value = CDR_SAFE (value);
1718 }
1719
1720 if (NILP (value))
1721 goto cleanup;
1722 }
1723
1724
1725 event.arg = Fcons ((member == NULL ? Qnil : build_string (member)),
1726 event.arg);
1727 event.arg = Fcons ((interface == NULL ? Qnil : build_string (interface)),
1728 event.arg);
1729 event.arg = Fcons ((path == NULL ? Qnil : build_string (path)),
1730 event.arg);
1731 event.arg = Fcons ((uname == NULL ? Qnil : build_string (uname)),
1732 event.arg);
1733 event.arg = Fcons (make_number (serial), event.arg);
1734 event.arg = Fcons (make_number (mtype), event.arg);
1735
1736
1737 event.arg = Fcons (bus, event.arg);
1738
1739
1740 kbd_buffer_store_event (&event);
1741
1742 XD_DEBUG_MESSAGE ("Event stored: %s",
1743 SDATA (format2 ("%s", event.arg, Qnil)));
1744
1745
1746 cleanup:
1747 dbus_message_unref (dmessage);
1748
1749 RETURN_UNGCPRO (Qnil);
1750 }
1751
1752
1753 void
1754 xd_read_queued_messages ()
1755 {
1756
1757 1758 1759 1760
1761 if (HASH_TABLE_P (Vdbus_registered_objects_table))
1762 {
1763 xd_in_read_queued_messages = 1;
1764 internal_catch (Qdbus_error, xd_read_message, QCdbus_system_bus);
1765 internal_catch (Qdbus_error, xd_read_message, QCdbus_session_bus);
1766 xd_in_read_queued_messages = 0;
1767 }
1768 }
1769
1770 DEFUN ("dbus-register-signal", Fdbus_register_signal, Sdbus_register_signal,
1771 6, MANY, 0,
1772 doc: 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 )
1809 (nargs, args)
1810 int nargs;
1811 register Lisp_Object *args;
1812 {
1813 Lisp_Object bus, service, path, interface, signal, handler;
1814 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
1815 Lisp_Object uname, key, key1, value;
1816 DBusConnection *connection;
1817 int i;
1818 char rule[DBUS_MAXIMUM_MATCH_RULE_LENGTH];
1819 char x[DBUS_MAXIMUM_MATCH_RULE_LENGTH];
1820 DBusError derror;
1821
1822
1823 bus = args[0];
1824 service = args[1];
1825 path = args[2];
1826 interface = args[3];
1827 signal = args[4];
1828 handler = args[5];
1829
1830 CHECK_SYMBOL (bus);
1831 if (!NILP (service)) CHECK_STRING (service);
1832 if (!NILP (path)) CHECK_STRING (path);
1833 CHECK_STRING (interface);
1834 CHECK_STRING (signal);
1835 if (!FUNCTIONP (handler))
1836 wrong_type_argument (intern ("functionp"), handler);
1837 GCPRO6 (bus, service, path, interface, signal, handler);
1838
1839 1840 1841 1842
1843 if ((STRINGP (service))
1844 && (SBYTES (service) > 0)
1845 && (strcmp (SDATA (service), DBUS_SERVICE_DBUS) != 0)
1846 && (strncmp (SDATA (service), ":", 1) != 0))
1847 {
1848 uname = call2 (intern ("dbus-get-name-owner"), bus, service);
1849 1850
1851 if (NILP (uname))
1852 uname = empty_unibyte_string;
1853 }
1854 else
1855 uname = service;
1856
1857 1858
1859 if (NILP (uname) || (SBYTES (uname) > 0))
1860 {
1861
1862 connection = xd_initialize (bus);
1863
1864
1865 sprintf (rule,
1866 "type='signal',interface='%s',member='%s'",
1867 SDATA (interface),
1868 SDATA (signal));
1869
1870
1871 if (!NILP (uname))
1872 {
1873 sprintf (x, ",sender='%s'", SDATA (uname));
1874 strcat (rule, x);
1875 }
1876
1877 if (!NILP (path))
1878 {
1879 sprintf (x, ",path='%s'", SDATA (path));
1880 strcat (rule, x);
1881 }
1882
1883
1884 for (i = 6; i < nargs; ++i)
1885 if (!NILP (args[i]))
1886 {
1887 CHECK_STRING (args[i]);
1888 sprintf (x, ",arg%d='%s'", i-6, SDATA (args[i]));
1889 strcat (rule, x);
1890 }
1891
1892
1893 dbus_error_init (&derror);
1894 dbus_bus_add_match (connection, rule, &derror);
1895 if (dbus_error_is_set (&derror))
1896 {
1897 UNGCPRO;
1898 XD_ERROR (derror);
1899 }
1900
1901
1902 dbus_error_free (&derror);
1903
1904 XD_DEBUG_MESSAGE ("Matching rule \"%s\" created", rule);
1905 }
1906
1907
1908 key = list3 (bus, interface, signal);
1909 key1 = list4 (uname, service, path, handler);
1910 value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
1911
1912 if (NILP (Fmember (key1, value)))
1913 Fputhash (key, Fcons (key1, value), Vdbus_registered_objects_table);
1914
1915
1916 RETURN_UNGCPRO (list2 (key, list3 (service, path, handler)));
1917 }
1918
1919 DEFUN ("dbus-register-method", Fdbus_register_method, Sdbus_register_method,
1920 6, 6, 0,
1921 doc: 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 )
1933 (bus, service, path, interface, method, handler)
1934 Lisp_Object bus, service, path, interface, method, handler;
1935 {
1936 Lisp_Object key, key1, value;
1937 DBusConnection *connection;
1938 int result;
1939 DBusError derror;
1940
1941
1942 CHECK_SYMBOL (bus);
1943 CHECK_STRING (service);
1944 CHECK_STRING (path);
1945 CHECK_STRING (interface);
1946 CHECK_STRING (method);
1947 if (!FUNCTIONP (handler))
1948 wrong_type_argument (intern ("functionp"), handler);
1949 1950
1951
1952
1953 connection = xd_initialize (bus);
1954
1955 1956
1957 dbus_error_init (&derror);
1958 result = dbus_bus_request_name (connection, SDATA (service), 0, &derror);
1959 if (dbus_error_is_set (&derror))
1960 XD_ERROR (derror);
1961
1962 1963
1964 key = list3 (bus, interface, method);
1965 key1 = list4 (Qnil, service, path, handler);
1966 value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
1967
1968 if (NILP (Fmember (key1, value)))
1969 Fputhash (key, Fcons (key1, value), Vdbus_registered_objects_table);
1970
1971
1972 dbus_error_free (&derror);
1973
1974
1975 return list2 (key, list3 (service, path, handler));
1976 }
1977
1978
1979 void
1980 syms_of_dbusbind ()
1981 {
1982
1983 Qdbus_init_bus = intern_c_string ("dbus-init-bus");
1984 staticpro (&Qdbus_init_bus);
1985 defsubr (&Sdbus_init_bus);
1986
1987 Qdbus_get_unique_name = intern_c_string ("dbus-get-unique-name");
1988 staticpro (&Qdbus_get_unique_name);
1989 defsubr (&Sdbus_get_unique_name);
1990
1991 Qdbus_call_method = intern_c_string ("dbus-call-method");
1992 staticpro (&Qdbus_call_method);
1993 defsubr (&Sdbus_call_method);
1994
1995 Qdbus_call_method_asynchronously = intern_c_string ("dbus-call-method-asynchronously");
1996 staticpro (&Qdbus_call_method_asynchronously);
1997 defsubr (&Sdbus_call_method_asynchronously);
1998
1999 Qdbus_method_return_internal = intern_c_string ("dbus-method-return-internal");
2000 staticpro (&Qdbus_method_return_internal);
2001 defsubr (&Sdbus_method_return_internal);
2002
2003 Qdbus_method_error_internal = intern_c_string ("dbus-method-error-internal");
2004 staticpro (&Qdbus_method_error_internal);
2005 defsubr (&Sdbus_method_error_internal);
2006
2007 Qdbus_send_signal = intern_c_string ("dbus-send-signal");
2008 staticpro (&Qdbus_send_signal);
2009 defsubr (&Sdbus_send_signal);
2010
2011 Qdbus_register_signal = intern_c_string ("dbus-register-signal");
2012 staticpro (&Qdbus_register_signal);
2013 defsubr (&Sdbus_register_signal);
2014
2015 Qdbus_register_method = intern_c_string ("dbus-register-method");
2016 staticpro (&Qdbus_register_method);
2017 defsubr (&Sdbus_register_method);
2018
2019 Qdbus_error = intern_c_string ("dbus-error");
2020 staticpro (&Qdbus_error);
2021 Fput (Qdbus_error, Qerror_conditions,
2022 list2 (Qdbus_error, Qerror));
2023 Fput (Qdbus_error, Qerror_message,
2024 make_pure_c_string ("D-Bus error"));
2025
2026 QCdbus_system_bus = intern_c_string (":system");
2027 staticpro (&QCdbus_system_bus);
2028
2029 QCdbus_session_bus = intern_c_string (":session");
2030 staticpro (&QCdbus_session_bus);
2031
2032 QCdbus_timeout = intern_c_string (":timeout");
2033 staticpro (&QCdbus_timeout);
2034
2035 QCdbus_type_byte = intern_c_string (":byte");
2036 staticpro (&QCdbus_type_byte);
2037
2038 QCdbus_type_boolean = intern_c_string (":boolean");
2039 staticpro (&QCdbus_type_boolean);
2040
2041 QCdbus_type_int16 = intern_c_string (":int16");
2042 staticpro (&QCdbus_type_int16);
2043
2044 QCdbus_type_uint16 = intern_c_string (":uint16");
2045 staticpro (&QCdbus_type_uint16);
2046
2047 QCdbus_type_int32 = intern_c_string (":int32");
2048 staticpro (&QCdbus_type_int32);
2049
2050 QCdbus_type_uint32 = intern_c_string (":uint32");
2051 staticpro (&QCdbus_type_uint32);
2052
2053 QCdbus_type_int64 = intern_c_string (":int64");
2054 staticpro (&QCdbus_type_int64);
2055
2056 QCdbus_type_uint64 = intern_c_string (":uint64");
2057 staticpro (&QCdbus_type_uint64);
2058
2059 QCdbus_type_double = intern_c_string (":double");
2060 staticpro (&QCdbus_type_double);
2061
2062 QCdbus_type_string = intern_c_string (":string");
2063 staticpro (&QCdbus_type_string);
2064
2065 QCdbus_type_object_path = intern_c_string (":object-path");
2066 staticpro (&QCdbus_type_object_path);
2067
2068 QCdbus_type_signature = intern_c_string (":signature");
2069 staticpro (&QCdbus_type_signature);
2070
2071 QCdbus_type_array = intern_c_string (":array");
2072 staticpro (&QCdbus_type_array);
2073
2074 QCdbus_type_variant = intern_c_string (":variant");
2075 staticpro (&QCdbus_type_variant);
2076
2077 QCdbus_type_struct = intern_c_string (":struct");
2078 staticpro (&QCdbus_type_struct);
2079
2080 QCdbus_type_dict_entry = intern_c_string (":dict-entry");
2081 staticpro (&QCdbus_type_dict_entry);
2082
2083 DEFVAR_LISP ("dbus-registered-objects-table",
2084 &Vdbus_registered_objects_table,
2085 doc: 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107 2108 2109 2110 2111 );
2112 2113
2114 Vdbus_registered_objects_table = Qnil;
2115
2116 DEFVAR_LISP ("dbus-debug", &Vdbus_debug,
2117 doc: );
2118 #ifdef DBUS_DEBUG
2119 Vdbus_debug = Qt;
2120 #else
2121 Vdbus_debug = Qnil;
2122 #endif
2123
2124 Fprovide (intern_c_string ("dbusbind"), Qnil);
2125
2126 }
2127
2128 #endif
2129
2130 2131