Check-in [a96749287b]
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:fixes in dbus/dbif mostly regarding threading
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: a96749287ba73b08f6602c0595742a2a21d59e51
User & Date: chw 2017-01-25 07:05:51
Context
2017-01-25
13:14
some tweaks in tkchat and tkmc for very high dpi displays etc. check-in: 888f1c0073 user: chw tags: trunk
07:05
fixes in dbus/dbif mostly regarding threading check-in: a96749287b user: chw tags: trunk
06:58
add RenĂ© Zaumseil's tksvg updates check-in: 25b5809b67 user: chw tags: trunk
Changes

Changes to undroid/dbus/dbus-intf/dbif.tcl.

726
727
728
729
730
731
732


733
734
735
736
737
738
739
740
741
742
743
744
	set sig [string range $sig 2 end]
       	if {$sig eq "v"} {
	    lassign $arg sig arg
	}
	if {$sig ne "v" && $sig ne $signature} {
	    dbuserr signature $bus $path $intf $name $sig $signature
    	}


	if {$command ne ""} {
	    # Failures will automatically be reported back to the caller
  	    interp eval $interp [list uplevel #0 [linsert $command end $arg]]
	}
	interp eval $interp [list uplevel #0 [list set $variable $arg]]
    }
    dict with data {
    	dbus return $bus $sender $serial
    }
    return -async 1
}








>
>




<







726
727
728
729
730
731
732
733
734
735
736
737
738

739
740
741
742
743
744
745
	set sig [string range $sig 2 end]
       	if {$sig eq "v"} {
	    lassign $arg sig arg
	}
	if {$sig ne "v" && $sig ne $signature} {
	    dbuserr signature $bus $path $intf $name $sig $signature
    	}
	# Set variable before callback to have Tk like semantics
	interp eval $interp [list uplevel #0 [list set $variable $arg]]
	if {$command ne ""} {
	    # Failures will automatically be reported back to the caller
  	    interp eval $interp [list uplevel #0 [linsert $command end $arg]]
	}

    }
    dict with data {
    	dbus return $bus $sender $serial
    }
    return -async 1
}

Changes to undroid/dbus/dbus-intf/examples/hello.tcl.

28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
# Send a response before quitting to keep the caller happy
dbif method / Quit {dbif return $msgid {};exit}

# Define a couple of properties that can be remotely accessed
#
dbif property / Message text
dbif property -access read /Counter Value:i counter
dbif property / BackgroundColor color(bg) {.b configure -background BackgroundColor}
dbif property / ForegroundColor color(fg) {.b configure -foreground ForegroundColor}

# Initialize the variables that hold the properties
set color(bg) [.b cget -background]
set color(fg) [.b cget -foreground]
set text "Hello World!"
set counter 0








|
|







28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
# Send a response before quitting to keep the caller happy
dbif method / Quit {dbif return $msgid {};exit}

# Define a couple of properties that can be remotely accessed
#
dbif property / Message text
dbif property -access read /Counter Value:i counter
dbif property / BackgroundColor color(bg) {.b configure -background $BackgroundColor}
dbif property / ForegroundColor color(fg) {.b configure -foreground $ForegroundColor}

# Initialize the variables that hold the properties
set color(bg) [.b cget -background]
set color(fg) [.b cget -foreground]
set text "Hello World!"
set counter 0

Changes to undroid/dbus/dbus-tcl/dbusCommand.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45

46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62






63
64
65
66
67
68
69
..
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
..
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112

113
114
115
116
117
118
119
120
121
122
123
124
125
126




127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151

152
153
154
155
156
157
158
159
160
161
162
163

164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
...
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
...
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
...
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
...
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
...
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
...
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
...
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
...
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
...
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
#include "dbustcl.h"

static int dbusid = 0;

/*
 *----------------------------------------------------------------------
 * 
 * DBus_MemoryError
 *	Set the result value for the interpreter to indicate an out of
 *	memory error.
 * 
 * Results:
 *	Always returns TCL_ERROR
 * 
 * Side effects:
 * 	None
 * 
 *----------------------------------------------------------------------
 */

int DBus_MemoryError(Tcl_Interp *interp)
{
   Tcl_SetObjResult(interp, Tcl_NewStringObj("Out Of Memory", -1));
   return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 * 
 * DBusConnectCmd
 *	Connect to the DBus.
 * 
 * Results:
 *	A standard Tcl result.
 * 
 * Side effects:
 * 	The result value of the interpreter is set to the busId for
 *	the connection.
 * 
 *----------------------------------------------------------------------
 */

int DBusConnectCmd(ClientData dummy, Tcl_Interp *interp,
		int objc, Tcl_Obj *const objv[])
{

   DBusBusType type = DBUS_BUS_SESSION;
   Tcl_DBusBus *dbus;
   Tcl_HashEntry *busPtr, *hPtr;
   DBusConnection *conn;
   DBusError err;
   int isNew;
   
   Tcl_Obj *result, *name = NULL;

   if (objc > 2) {
      Tcl_WrongNumArgs(interp, 1, objv, "?busId?");
      return TCL_ERROR;
   }
   if (objc == 2) {
      name = objv[1];
      type = DBus_BusType(NULL, name);
   }







   /* initialise the dbus error structure */
   dbus_error_init(&err);

   /* connect to the bus and check for errors */
   switch (type) {
    case DBUS_BUS_SESSION:
................................................................................
    case DBUS_BUS_SYSTEM:
    case DBUS_BUS_STARTER:
      conn = dbus_bus_get(type, &err);
      break;
    default:
      conn = dbus_connection_open(Tcl_GetString(name), &err);
      if (conn != NULL && !dbus_error_is_set(&err)) {
	 dbus_bus_register(conn, &err); 
      }
      break;
   }
   if (dbus_error_is_set(&err)) {
      result = Tcl_NewStringObj("Connection Error: ", -1);
      Tcl_AppendStringsToObj(result, err.message, (char *) NULL);
      Tcl_SetObjResult(interp, result);
................................................................................
   if ((int)type < 0) {
      name = Tcl_ObjPrintf("dbus%d", ++dbusid);
      type = 3;
   }
   else if (name == NULL)
     name = Tcl_NewStringObj("session", 7);
   Tcl_IncrRefCount(name);
   busPtr = Tcl_CreateHashEntry(&bus, (char *) name, &isNew);
   if (isNew) {
      /* First interpreter to connect to this dbus */
      dbus = (Tcl_DBusBus *) ckalloc(sizeof(Tcl_DBusBus));
      dbus->conn = conn;
      dbus->type = (int)type;
      dbus->snoop = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
      Tcl_InitHashTable(dbus->snoop, TCL_ONE_WORD_KEYS);
      dbus->fallback = NULL;
      Tcl_SetHashValue(busPtr, (ClientData) dbus);
      if (type == DBUS_BUS_SESSION) defaultbus = dbus;

   }
   else {
      dbus = Tcl_GetHashValue(busPtr);
   }
   hPtr = Tcl_CreateHashEntry(dbus->snoop, (char *) interp, &isNew);
   if (isNew) {
      /* Presence of the array entry indicates connection to the bus */
      Tcl_SetHashValue(hPtr, NULL);
      Tcl_CallWhenDeleted(interp, DBus_InterpDelete, busPtr);
   }

   dbus_connection_set_timeout_functions(conn, DBus_AddTimeout,
					    DBus_RemoveTimeout,
					    DBus_ToggleTimeout, NULL, NULL);





   /* Return the handle to the connection */
   Tcl_SetObjResult(interp, Tcl_DuplicateObj(name));
   Tcl_DecrRefCount(name);
   return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 * 
 * DBusCloseCmd
 *	Close a DBus connection.
 * 
 * Results:
 *	A standard Tcl result.
 * 
 * Side effects:
 * 	None
 * 
 *----------------------------------------------------------------------
 */

int DBusCloseCmd(ClientData dummy, Tcl_Interp *interp,
		int objc, Tcl_Obj *const objv[])
{

   Tcl_HashEntry *entry;
   Tcl_Obj *name;

   if (objc < 1 || objc > 2) {
      Tcl_WrongNumArgs(interp, 1, objv, "?busId?");
      return TCL_ERROR;
   }
   if (objc < 2)
     name = Tcl_NewStringObj("session", -1);
   else
     name = objv[1];
   Tcl_IncrRefCount(name);

   entry = Tcl_FindHashEntry(&bus, (char *) name);
   if (entry != NULL) {
      DBus_Disconnect(interp, entry);
      Tcl_DontCallWhenDeleted(interp, DBus_InterpDelete, entry);
   }
   Tcl_DecrRefCount(name);
   return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 * 
 * DBusFilterCmd
 *	Add or remove a dbus message filter.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 * 	The result value of the interpreter is set to the match rule passed
 *	to libdbus.
 * 
 *----------------------------------------------------------------------
 */

int DBusFilterCmd(ClientData dummy, Tcl_Interp *interp,
		int objc, Tcl_Obj *const objv[])
{
   Tcl_DBusBus *dbus = defaultbus;
   DBusError err;
   Tcl_Obj *match = NULL, *result;
   int index, subcmd, len, x = 1;
   static const char *subcmds[] = {
      "add", "remove", NULL
   };
   enum subcmds {
................................................................................
      /* Get the option without the - */
      Tcl_AppendObjToObj(match, Tcl_GetRange(objv[x], 1, len - 1));
      Tcl_AppendToObj(match, "='", 2);
      /* Get the specified value */
      Tcl_AppendObjToObj(match, objv[x+1]);
      Tcl_AppendToObj(match, "'", 1);
   }
   
   if (dbus == NULL) {
      Tcl_SetObjResult(interp, Tcl_NewStringObj("Not connected", -1));
      return TCL_ERROR;
   }
   /* initialise the dbus error structure */
   dbus_error_init(&err);
   
   if ((enum subcmds) subcmd == DBUS_FILTERADD)
     dbus_bus_add_match(dbus->conn, Tcl_GetString(match), &err);
   else
     dbus_bus_remove_match(dbus->conn, Tcl_GetString(match), &err);
   dbus_connection_flush(dbus->conn);
   if (dbus_error_is_set(&err)) {
      result = Tcl_NewStringObj("Match Error: ", -1);
      Tcl_AppendStringsToObj(result, err.message, (char *) NULL);
      /* Strip trailing newline off the error message */
      Tcl_SetObjLength(result, Tcl_GetCharLength(result) - 1);
      Tcl_SetObjResult(interp, result);
      dbus_error_free(&err);
      Tcl_DecrRefCount(match);
      return TCL_ERROR;
   }
   Tcl_SetObjResult(interp, match);
   return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 * 
 * DBusInfoCmd
 *	Provide information about various dbus aspects.
 * 
 * Results:
 *	A standard Tcl result.
 * 
 * Side effects:
 * 	On return, the result value of the interpreter contains the requested
 *	information.
 * 
 *----------------------------------------------------------------------
 */

int DBusInfoCmd(ClientData dummy, Tcl_Interp *interp,
		int objc, Tcl_Obj *const objv[])
{
   Tcl_DBusBus *dbus = defaultbus;
   int index, major, minor, micro, sw;
   Tcl_Obj *rc;
   static const char *options[] = {
      "capabilities", "local", "machineid", "name", "path", "pending", 
	"serverid", "service", "version", NULL
   };
   enum options {
      DBUS_INFOCAPS, DBUS_INFOLOCAL, DBUS_INFOUUID, DBUS_INFONAME,
      DBUS_INFOPATH, DBUS_INFOPENDING, DBUS_INFOSERVER, DBUS_INFOSERVICE,
      DBUS_INFOVERSION
   };
................................................................................
    case DBUS_INFOVERSION:
#ifdef DBUS_TYPE_UNIX_FD
      dbus_get_version(&major, &minor, &micro);
#else
      /* pretend 1.1.1 */
      major = minor = micro = 1;
#endif
      Tcl_SetObjResult(interp, 
		       Tcl_ObjPrintf("%d.%d.%d", major, minor, micro));
      return TCL_OK;
    case DBUS_INFOUUID:
      Tcl_SetObjResult(interp, 
		       Tcl_NewStringObj(dbus_get_local_machine_id(), -1));
      return TCL_OK;
    case DBUS_INFOSERVER:
      if (dbus == NULL) goto notconnected;
      Tcl_SetObjResult(interp,
	Tcl_NewStringObj(dbus_connection_get_server_id(dbus->conn), -1));
      return TCL_OK;
................................................................................
      if (dbus == NULL) goto notconnected;
      rc = Tcl_NewDictObj();
#ifdef DBUS_TYPE_UNIX_FD
      sw = dbus_connection_can_send_type(dbus->conn, DBUS_TYPE_UNIX_FD);
#else
      sw = 0;
#endif
      Tcl_DictObjPut(interp, rc, 
		Tcl_NewStringObj("unixfd", -1), Tcl_NewBooleanObj(sw));
      Tcl_SetObjResult(interp, rc);
      return TCL_OK;
   }
   return TCL_ERROR;

notconnected:
   Tcl_SetObjResult(interp, Tcl_NewStringObj("Not connected", -1));
   return TCL_ERROR; 
}

/*
 *----------------------------------------------------------------------
 * 
 * DBusNameCmd
 *	Request the dbus server to assign a given name to the connection.
 * 
 * Results:
 *	A standard Tcl result.
 * 
 * Side effects:
 * 	None.
 * 
 *----------------------------------------------------------------------
 */

int DBusNameCmd(ClientData dummy, Tcl_Interp *interp,
		int objc, Tcl_Obj *const objv[])
{
   Tcl_DBusBus *dbus = defaultbus;
   DBusError err;
   Tcl_Obj *result;
   int index, mask, ret, x = 1;
   static const char *options[] = {
      "-noqueue", "-replace", "-yield", NULL
   };
   static const int flag[] = {
................................................................................
      DBUS_NAME_FLAG_DO_NOT_QUEUE,
	DBUS_NAME_FLAG_REPLACE_EXISTING,
	DBUS_NAME_FLAG_ALLOW_REPLACEMENT
   };
   static const char *error[] = {
      "Name in use, request queued", "Name exists", "Already owner"
   };
   
   if (objc < 2) {
      Tcl_WrongNumArgs(interp, 1, objv, "?busId? ?options? name");
      return TCL_ERROR;
   }
   if (objc > 2 && Tcl_GetStringFromObj(objv[1], NULL)[0] != '-') {
      if (DBus_BusType(interp, objv[1]) < 0) return TCL_ERROR;
      dbus = DBus_GetConnection(interp, objv[1]);
      x++;
   }
   
   for (mask = 0; x < objc-1; x++) {
      if (Tcl_GetIndexFromObj(interp, objv[x], options,
			      "option", 0, &index) != TCL_OK) {
	 return TCL_ERROR;
      }
      mask |= flag[index];
   }
................................................................................
   if (dbus == NULL) {
      Tcl_SetObjResult(interp, Tcl_NewStringObj("Not connected", -1));
      return TCL_ERROR;
   }
   /* initialise the dbus error structure */
   dbus_error_init(&err);
   /* request our name on the bus and check for errors */
   ret = dbus_bus_request_name(dbus->conn, 
				  Tcl_GetString(objv[x]), mask, &err);
   /* 
    * DBUS_REQUEST_NAME_REPLY_PRIMARY_OWNER   1
    * DBUS_REQUEST_NAME_REPLY_IN_QUEUE        2
    * DBUS_REQUEST_NAME_REPLY_EXISTS          3
    * DBUS_REQUEST_NAME_REPLY_ALREADY_OWNER   4
    */
   if (dbus_error_is_set(&err)) {
      result = Tcl_NewStringObj("Name Error: ", -1);
................................................................................
   /* Command failed or only partially succeeded */
   Tcl_SetObjResult(interp, Tcl_NewStringObj(error[ret-2], -1));
   return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 * 
 * DBusReleaseCmd
 *	Asks the dbus server to unassign the given name from this connection.
 *
 * Results:
 *	A standard Tcl result.
 * 
 * Side effects:
 * 	None.
 * 
 *----------------------------------------------------------------------
 */

int DBusReleaseCmd(ClientData dummy, Tcl_Interp *interp,
		int objc, Tcl_Obj *const objv[])
{
   Tcl_DBusBus *dbus = defaultbus;
   DBusError err;
   Tcl_Obj *result;
   int ret;
   static const char *error[] = {
      "Name does not exist", "Not owner"
   };
   
   if (objc < 2 || objc > 3) {
      Tcl_WrongNumArgs(interp, 1, objv, "?busId? name");
      return TCL_ERROR;
   }
   if (objc > 2) {
      if (DBus_BusType(interp, objv[1]) < 0) return TCL_ERROR;
      dbus = DBus_GetConnection(interp, objv[1]);
................................................................................
   }

   /* Check the bus name */
   if (!DBus_CheckBusName(objv[objc - 1])) {
      Tcl_SetObjResult(interp, Tcl_NewStringObj("Invalid bus name", -1));
      return TCL_ERROR;
   }
      
   if (dbus == NULL) {
      Tcl_SetObjResult(interp, Tcl_NewStringObj("Not connected", -1));
      return TCL_ERROR;
   }
   /* initialise the dbus error structure */
   dbus_error_init(&err);

   /* release our name on the bus and check for errors */
   ret = dbus_bus_release_name(dbus->conn, 
				  Tcl_GetString(objv[objc - 1]), &err);
   /* 
    * DBUS_RELEASE_NAME_REPLY_RELEASED       1
    * DBUS_RELEASE_NAME_REPLY_NON_EXISTENT   2
    * DBUS_RELEASE_NAME_REPLY_NOT_OWNER      3
    */
   if (dbus_error_is_set(&err)) {
      result = Tcl_NewStringObj("Release Error: ", -1);
      Tcl_AppendStringsToObj(result, err.message, (char *) NULL);
................................................................................
   /* Name could not be released */
   Tcl_SetObjResult(interp, Tcl_NewStringObj(error[ret-2], -1));
   return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 * 
 * TclInitDBusCmd
 *	Create the dbus ensemble command.
 *
 * Results:
 *	The command token for the ensemble.
 *
 * Side effects:
 * 	None.
 * 
 *----------------------------------------------------------------------
 */

Tcl_Command TclInitDBusCmd(Tcl_Interp *interp)
{
   Tcl_Namespace *nsPtr;
   Tcl_Obj* subcmds;
................................................................................
   Tcl_CreateObjCommand(interp, "::dbus::call", DBusCallCmd,
			(ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
   Tcl_ListObjAppendElement(NULL, subcmds, Tcl_NewStringObj("call", -1));

   Tcl_CreateObjCommand(interp, "::dbus::close", DBusCloseCmd,
			(ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
   Tcl_ListObjAppendElement(NULL, subcmds, Tcl_NewStringObj("close", -1));
   
   Tcl_CreateObjCommand(interp, "::dbus::connect", DBusConnectCmd,
			(ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
   Tcl_ListObjAppendElement(NULL, subcmds, Tcl_NewStringObj("connect", -1));
   
   Tcl_CreateObjCommand(interp, "::dbus::error", DBusErrorCmd,
			(ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
   Tcl_ListObjAppendElement(NULL, subcmds, Tcl_NewStringObj("error", -1));

   Tcl_CreateObjCommand(interp, "::dbus::filter", DBusFilterCmd,
			(ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
   Tcl_ListObjAppendElement(NULL, subcmds, Tcl_NewStringObj("filter", -1));

   Tcl_CreateObjCommand(interp, "::dbus::info", DBusInfoCmd,
			(ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
   Tcl_ListObjAppendElement(NULL, subcmds, Tcl_NewStringObj("info", -1));
   
   Tcl_CreateObjCommand(interp, "::dbus::listen", DBusListenCmd,
			(ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
   Tcl_ListObjAppendElement(NULL, subcmds, Tcl_NewStringObj("listen", -1));
   
   Tcl_CreateObjCommand(interp, "::dbus::method", DBusMethodCmd,
			(ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
   Tcl_ListObjAppendElement(NULL, subcmds, Tcl_NewStringObj("method", -1));
   
   Tcl_CreateObjCommand(interp, "::dbus::monitor", DBusMonitorCmd,
			(ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
   Tcl_ListObjAppendElement(NULL, subcmds, Tcl_NewStringObj("monitor", -1));
   
   Tcl_CreateObjCommand(interp, "::dbus::name", DBusNameCmd,
			(ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
   Tcl_ListObjAppendElement(NULL, subcmds, Tcl_NewStringObj("name", -1));
   
   Tcl_CreateObjCommand(interp, "::dbus::release", DBusReleaseCmd,
			(ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
   Tcl_ListObjAppendElement(NULL, subcmds, Tcl_NewStringObj("release", -1));

   Tcl_CreateObjCommand(interp, "::dbus::return", DBusMethodReturnCmd,
			(ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
   Tcl_ListObjAppendElement(NULL, subcmds, Tcl_NewStringObj("return", -1));






|



|


|


|











|


|


|



|






>






|










>
>
>
>
>
>







 







|







 







|









|
>












|
|
>
>
>
>









|


|


|


|






>
|











>
|










|









|






|







 







|






|








<
<











|


|


|



|






|



|







 







|



|







 







|








|




|


|


|


|






|







 







|









|







 







|

|







 







|





|


|






|






|







 







|








|

|







 







|








|







 







|



|











|



|



|



|



|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
..
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
...
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
...
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272


273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
...
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
...
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
...
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
...
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
...
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
...
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
...
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
...
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
#include "dbustcl.h"

static int dbusid = 0;

/*
 *----------------------------------------------------------------------
 *
 * DBus_MemoryError
 *	Set the result value for the interpreter to indicate an out of
 *	memory error.
 *
 * Results:
 *	Always returns TCL_ERROR
 *
 * Side effects:
 * 	None
 *
 *----------------------------------------------------------------------
 */

int DBus_MemoryError(Tcl_Interp *interp)
{
   Tcl_SetObjResult(interp, Tcl_NewStringObj("Out Of Memory", -1));
   return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * DBusConnectCmd
 *	Connect to the DBus.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 * 	The result value of the interpreter is set to the busId for
 *	the connection.
 *
 *----------------------------------------------------------------------
 */

int DBusConnectCmd(ClientData dummy, Tcl_Interp *interp,
		int objc, Tcl_Obj *const objv[])
{
   Tcl_DBusThreadData *tsdPtr = DBus_GetThreadData();
   DBusBusType type = DBUS_BUS_SESSION;
   Tcl_DBusBus *dbus;
   Tcl_HashEntry *busPtr, *hPtr;
   DBusConnection *conn;
   DBusError err;
   int isNew;

   Tcl_Obj *result, *name = NULL;

   if (objc > 2) {
      Tcl_WrongNumArgs(interp, 1, objv, "?busId?");
      return TCL_ERROR;
   }
   if (objc == 2) {
      name = objv[1];
      type = DBus_BusType(NULL, name);
   }

   if (!tsdPtr->initialized) {
      result = Tcl_NewStringObj("DBus module not initialized", -1);
      Tcl_SetObjResult(interp, result);
      return TCL_ERROR;
   }

   /* initialise the dbus error structure */
   dbus_error_init(&err);

   /* connect to the bus and check for errors */
   switch (type) {
    case DBUS_BUS_SESSION:
................................................................................
    case DBUS_BUS_SYSTEM:
    case DBUS_BUS_STARTER:
      conn = dbus_bus_get(type, &err);
      break;
    default:
      conn = dbus_connection_open(Tcl_GetString(name), &err);
      if (conn != NULL && !dbus_error_is_set(&err)) {
	 dbus_bus_register(conn, &err);
      }
      break;
   }
   if (dbus_error_is_set(&err)) {
      result = Tcl_NewStringObj("Connection Error: ", -1);
      Tcl_AppendStringsToObj(result, err.message, (char *) NULL);
      Tcl_SetObjResult(interp, result);
................................................................................
   if ((int)type < 0) {
      name = Tcl_ObjPrintf("dbus%d", ++dbusid);
      type = 3;
   }
   else if (name == NULL)
     name = Tcl_NewStringObj("session", 7);
   Tcl_IncrRefCount(name);
   busPtr = Tcl_CreateHashEntry(&tsdPtr->bus, (char *) name, &isNew);
   if (isNew) {
      /* First interpreter to connect to this dbus */
      dbus = (Tcl_DBusBus *) ckalloc(sizeof(Tcl_DBusBus));
      dbus->conn = conn;
      dbus->type = (int)type;
      dbus->snoop = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
      Tcl_InitHashTable(dbus->snoop, TCL_ONE_WORD_KEYS);
      dbus->fallback = NULL;
      Tcl_SetHashValue(busPtr, (ClientData) dbus);
      if (type == DBUS_BUS_SESSION)
	tsdPtr->defaultbus = dbus;
   }
   else {
      dbus = Tcl_GetHashValue(busPtr);
   }
   hPtr = Tcl_CreateHashEntry(dbus->snoop, (char *) interp, &isNew);
   if (isNew) {
      /* Presence of the array entry indicates connection to the bus */
      Tcl_SetHashValue(hPtr, NULL);
      Tcl_CallWhenDeleted(interp, DBus_InterpDelete, busPtr);
   }

   dbus_connection_set_timeout_functions(conn, DBus_AddTimeout,
					 DBus_RemoveTimeout,
					 DBus_ToggleTimeout, NULL, NULL);
#ifndef _WIN32
   dbus_connection_set_watch_functions(conn, DBus_AddWatch, DBus_RemoveWatch,
				       DBus_ToggleWatch, conn, NULL);
#endif

   /* Return the handle to the connection */
   Tcl_SetObjResult(interp, Tcl_DuplicateObj(name));
   Tcl_DecrRefCount(name);
   return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * DBusCloseCmd
 *	Close a DBus connection.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 * 	None
 *
 *----------------------------------------------------------------------
 */

int DBusCloseCmd(ClientData dummy, Tcl_Interp *interp,
		int objc, Tcl_Obj *const objv[])
{
   Tcl_DBusThreadData *tsdPtr = DBus_GetThreadData();
   Tcl_HashEntry *entry = NULL;
   Tcl_Obj *name;

   if (objc < 1 || objc > 2) {
      Tcl_WrongNumArgs(interp, 1, objv, "?busId?");
      return TCL_ERROR;
   }
   if (objc < 2)
     name = Tcl_NewStringObj("session", -1);
   else
     name = objv[1];
   Tcl_IncrRefCount(name);
   if (tsdPtr->initialized)
     entry = Tcl_FindHashEntry(&tsdPtr->bus, (char *) name);
   if (entry != NULL) {
      DBus_Disconnect(interp, entry);
      Tcl_DontCallWhenDeleted(interp, DBus_InterpDelete, entry);
   }
   Tcl_DecrRefCount(name);
   return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * DBusFilterCmd
 *	Add or remove a dbus message filter.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 * 	The result value of the interpreter is set to the match rule passed
 *	to libdbus.
 *
 *----------------------------------------------------------------------
 */

int DBusFilterCmd(ClientData dummy, Tcl_Interp *interp,
		int objc, Tcl_Obj *const objv[])
{
   Tcl_DBusBus *dbus = DBus_GetDefaultBus();
   DBusError err;
   Tcl_Obj *match = NULL, *result;
   int index, subcmd, len, x = 1;
   static const char *subcmds[] = {
      "add", "remove", NULL
   };
   enum subcmds {
................................................................................
      /* Get the option without the - */
      Tcl_AppendObjToObj(match, Tcl_GetRange(objv[x], 1, len - 1));
      Tcl_AppendToObj(match, "='", 2);
      /* Get the specified value */
      Tcl_AppendObjToObj(match, objv[x+1]);
      Tcl_AppendToObj(match, "'", 1);
   }

   if (dbus == NULL) {
      Tcl_SetObjResult(interp, Tcl_NewStringObj("Not connected", -1));
      return TCL_ERROR;
   }
   /* initialise the dbus error structure */
   dbus_error_init(&err);

   if ((enum subcmds) subcmd == DBUS_FILTERADD)
     dbus_bus_add_match(dbus->conn, Tcl_GetString(match), &err);
   else
     dbus_bus_remove_match(dbus->conn, Tcl_GetString(match), &err);
   dbus_connection_flush(dbus->conn);
   if (dbus_error_is_set(&err)) {
      result = Tcl_NewStringObj("Match Error: ", -1);
      Tcl_AppendStringsToObj(result, err.message, (char *) NULL);


      Tcl_SetObjResult(interp, result);
      dbus_error_free(&err);
      Tcl_DecrRefCount(match);
      return TCL_ERROR;
   }
   Tcl_SetObjResult(interp, match);
   return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * DBusInfoCmd
 *	Provide information about various dbus aspects.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 * 	On return, the result value of the interpreter contains the requested
 *	information.
 *
 *----------------------------------------------------------------------
 */

int DBusInfoCmd(ClientData dummy, Tcl_Interp *interp,
		int objc, Tcl_Obj *const objv[])
{
   Tcl_DBusBus *dbus = DBus_GetDefaultBus();
   int index, major, minor, micro, sw;
   Tcl_Obj *rc;
   static const char *options[] = {
      "capabilities", "local", "machineid", "name", "path", "pending",
	"serverid", "service", "version", NULL
   };
   enum options {
      DBUS_INFOCAPS, DBUS_INFOLOCAL, DBUS_INFOUUID, DBUS_INFONAME,
      DBUS_INFOPATH, DBUS_INFOPENDING, DBUS_INFOSERVER, DBUS_INFOSERVICE,
      DBUS_INFOVERSION
   };
................................................................................
    case DBUS_INFOVERSION:
#ifdef DBUS_TYPE_UNIX_FD
      dbus_get_version(&major, &minor, &micro);
#else
      /* pretend 1.1.1 */
      major = minor = micro = 1;
#endif
      Tcl_SetObjResult(interp,
		       Tcl_ObjPrintf("%d.%d.%d", major, minor, micro));
      return TCL_OK;
    case DBUS_INFOUUID:
      Tcl_SetObjResult(interp,
		       Tcl_NewStringObj(dbus_get_local_machine_id(), -1));
      return TCL_OK;
    case DBUS_INFOSERVER:
      if (dbus == NULL) goto notconnected;
      Tcl_SetObjResult(interp,
	Tcl_NewStringObj(dbus_connection_get_server_id(dbus->conn), -1));
      return TCL_OK;
................................................................................
      if (dbus == NULL) goto notconnected;
      rc = Tcl_NewDictObj();
#ifdef DBUS_TYPE_UNIX_FD
      sw = dbus_connection_can_send_type(dbus->conn, DBUS_TYPE_UNIX_FD);
#else
      sw = 0;
#endif
      Tcl_DictObjPut(interp, rc,
		Tcl_NewStringObj("unixfd", -1), Tcl_NewBooleanObj(sw));
      Tcl_SetObjResult(interp, rc);
      return TCL_OK;
   }
   return TCL_ERROR;

notconnected:
   Tcl_SetObjResult(interp, Tcl_NewStringObj("Not connected", -1));
   return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * DBusNameCmd
 *	Request the dbus server to assign a given name to the connection.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 * 	None.
 *
 *----------------------------------------------------------------------
 */

int DBusNameCmd(ClientData dummy, Tcl_Interp *interp,
		int objc, Tcl_Obj *const objv[])
{
   Tcl_DBusBus *dbus = DBus_GetDefaultBus();
   DBusError err;
   Tcl_Obj *result;
   int index, mask, ret, x = 1;
   static const char *options[] = {
      "-noqueue", "-replace", "-yield", NULL
   };
   static const int flag[] = {
................................................................................
      DBUS_NAME_FLAG_DO_NOT_QUEUE,
	DBUS_NAME_FLAG_REPLACE_EXISTING,
	DBUS_NAME_FLAG_ALLOW_REPLACEMENT
   };
   static const char *error[] = {
      "Name in use, request queued", "Name exists", "Already owner"
   };

   if (objc < 2) {
      Tcl_WrongNumArgs(interp, 1, objv, "?busId? ?options? name");
      return TCL_ERROR;
   }
   if (objc > 2 && Tcl_GetStringFromObj(objv[1], NULL)[0] != '-') {
      if (DBus_BusType(interp, objv[1]) < 0) return TCL_ERROR;
      dbus = DBus_GetConnection(interp, objv[1]);
      x++;
   }

   for (mask = 0; x < objc-1; x++) {
      if (Tcl_GetIndexFromObj(interp, objv[x], options,
			      "option", 0, &index) != TCL_OK) {
	 return TCL_ERROR;
      }
      mask |= flag[index];
   }
................................................................................
   if (dbus == NULL) {
      Tcl_SetObjResult(interp, Tcl_NewStringObj("Not connected", -1));
      return TCL_ERROR;
   }
   /* initialise the dbus error structure */
   dbus_error_init(&err);
   /* request our name on the bus and check for errors */
   ret = dbus_bus_request_name(dbus->conn,
				  Tcl_GetString(objv[x]), mask, &err);
   /*
    * DBUS_REQUEST_NAME_REPLY_PRIMARY_OWNER   1
    * DBUS_REQUEST_NAME_REPLY_IN_QUEUE        2
    * DBUS_REQUEST_NAME_REPLY_EXISTS          3
    * DBUS_REQUEST_NAME_REPLY_ALREADY_OWNER   4
    */
   if (dbus_error_is_set(&err)) {
      result = Tcl_NewStringObj("Name Error: ", -1);
................................................................................
   /* Command failed or only partially succeeded */
   Tcl_SetObjResult(interp, Tcl_NewStringObj(error[ret-2], -1));
   return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * DBusReleaseCmd
 *	Asks the dbus server to unassign the given name from this connection.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 * 	None.
 *
 *----------------------------------------------------------------------
 */

int DBusReleaseCmd(ClientData dummy, Tcl_Interp *interp,
		int objc, Tcl_Obj *const objv[])
{
   Tcl_DBusBus *dbus = DBus_GetDefaultBus();
   DBusError err;
   Tcl_Obj *result;
   int ret;
   static const char *error[] = {
      "Name does not exist", "Not owner"
   };

   if (objc < 2 || objc > 3) {
      Tcl_WrongNumArgs(interp, 1, objv, "?busId? name");
      return TCL_ERROR;
   }
   if (objc > 2) {
      if (DBus_BusType(interp, objv[1]) < 0) return TCL_ERROR;
      dbus = DBus_GetConnection(interp, objv[1]);
................................................................................
   }

   /* Check the bus name */
   if (!DBus_CheckBusName(objv[objc - 1])) {
      Tcl_SetObjResult(interp, Tcl_NewStringObj("Invalid bus name", -1));
      return TCL_ERROR;
   }

   if (dbus == NULL) {
      Tcl_SetObjResult(interp, Tcl_NewStringObj("Not connected", -1));
      return TCL_ERROR;
   }
   /* initialise the dbus error structure */
   dbus_error_init(&err);

   /* release our name on the bus and check for errors */
   ret = dbus_bus_release_name(dbus->conn,
				  Tcl_GetString(objv[objc - 1]), &err);
   /*
    * DBUS_RELEASE_NAME_REPLY_RELEASED       1
    * DBUS_RELEASE_NAME_REPLY_NON_EXISTENT   2
    * DBUS_RELEASE_NAME_REPLY_NOT_OWNER      3
    */
   if (dbus_error_is_set(&err)) {
      result = Tcl_NewStringObj("Release Error: ", -1);
      Tcl_AppendStringsToObj(result, err.message, (char *) NULL);
................................................................................
   /* Name could not be released */
   Tcl_SetObjResult(interp, Tcl_NewStringObj(error[ret-2], -1));
   return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * TclInitDBusCmd
 *	Create the dbus ensemble command.
 *
 * Results:
 *	The command token for the ensemble.
 *
 * Side effects:
 * 	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Command TclInitDBusCmd(Tcl_Interp *interp)
{
   Tcl_Namespace *nsPtr;
   Tcl_Obj* subcmds;
................................................................................
   Tcl_CreateObjCommand(interp, "::dbus::call", DBusCallCmd,
			(ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
   Tcl_ListObjAppendElement(NULL, subcmds, Tcl_NewStringObj("call", -1));

   Tcl_CreateObjCommand(interp, "::dbus::close", DBusCloseCmd,
			(ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
   Tcl_ListObjAppendElement(NULL, subcmds, Tcl_NewStringObj("close", -1));

   Tcl_CreateObjCommand(interp, "::dbus::connect", DBusConnectCmd,
			(ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
   Tcl_ListObjAppendElement(NULL, subcmds, Tcl_NewStringObj("connect", -1));

   Tcl_CreateObjCommand(interp, "::dbus::error", DBusErrorCmd,
			(ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
   Tcl_ListObjAppendElement(NULL, subcmds, Tcl_NewStringObj("error", -1));

   Tcl_CreateObjCommand(interp, "::dbus::filter", DBusFilterCmd,
			(ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
   Tcl_ListObjAppendElement(NULL, subcmds, Tcl_NewStringObj("filter", -1));

   Tcl_CreateObjCommand(interp, "::dbus::info", DBusInfoCmd,
			(ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
   Tcl_ListObjAppendElement(NULL, subcmds, Tcl_NewStringObj("info", -1));

   Tcl_CreateObjCommand(interp, "::dbus::listen", DBusListenCmd,
			(ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
   Tcl_ListObjAppendElement(NULL, subcmds, Tcl_NewStringObj("listen", -1));

   Tcl_CreateObjCommand(interp, "::dbus::method", DBusMethodCmd,
			(ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
   Tcl_ListObjAppendElement(NULL, subcmds, Tcl_NewStringObj("method", -1));

   Tcl_CreateObjCommand(interp, "::dbus::monitor", DBusMonitorCmd,
			(ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
   Tcl_ListObjAppendElement(NULL, subcmds, Tcl_NewStringObj("monitor", -1));

   Tcl_CreateObjCommand(interp, "::dbus::name", DBusNameCmd,
			(ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
   Tcl_ListObjAppendElement(NULL, subcmds, Tcl_NewStringObj("name", -1));

   Tcl_CreateObjCommand(interp, "::dbus::release", DBusReleaseCmd,
			(ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
   Tcl_ListObjAppendElement(NULL, subcmds, Tcl_NewStringObj("release", -1));

   Tcl_CreateObjCommand(interp, "::dbus::return", DBusMethodReturnCmd,
			(ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
   Tcl_ListObjAppendElement(NULL, subcmds, Tcl_NewStringObj("return", -1));

Changes to undroid/dbus/dbus-tcl/dbusEvent.c.

18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
..
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
...
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
...
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
...
151
152
153
154
155
156
157

158
159
160
161
162
163



164
165
166
167
168
169
170
171
172
173
174
...
176
177
178
179
180
181
182

183
184
185
186
187
188


189
190
191
192
193
194
195
196
...
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
...
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
...
298
299
300
301
302
303
304

305

306
307
308
309
310
311
312
...
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
...
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
...
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
...
436
437
438
439
440
441
442


















































443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
...
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
...
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
...
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
...
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
...
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
...
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
...
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
...
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
...
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
...
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
...
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
...
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
...
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
....
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
....
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
....
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
....
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
....
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
....
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
	Tcl_DBusBus *dbus, char *path)
{
   DBusObjectPathVTable vtable;
   Tcl_DBusHandlerData *dataPtr;

   /* Get the currently registered handler for the path */
   if (*path == '\0') {
      if (!dbus_connection_get_object_path_data(dbus->conn, "/", 
		(void **)&dataPtr)) return NULL;
   }
   else {
      if (!dbus_connection_get_object_path_data(dbus->conn, path,
		(void **)&dataPtr)) return NULL;
   }
   if (dataPtr == NULL) {
................................................................................
      dataPtr = (Tcl_DBusHandlerData *)ckalloc(sizeof(Tcl_DBusHandlerData));
      dataPtr->dbus = dbus;
      dataPtr->signal = NULL;
      dataPtr->method = NULL;
      dataPtr->flags = 0;
      if (path[0] == '\0' || (path[0] == '/' && path[1] == '\0')) {
	 /* Register as a fallback method handler */
	 if (!dbus_connection_register_fallback(dbus->conn, "/", 
						   &vtable, dataPtr))
	   return NULL;
	 dataPtr->flags |= DBUSFLAG_FALLBACK;
      }
      else {
	 /* Register as a regular method handler */
	 if (!dbus_connection_register_object_path(dbus->conn, path, 
						      &vtable, dataPtr))
	   return NULL;
      }
   }
   if (*path == '\0') {
      if (dbus->fallback != NULL) 
	return dbus->fallback;
      dataPtr = (Tcl_DBusHandlerData *)ckalloc(sizeof(Tcl_DBusHandlerData));
      dataPtr->dbus = dbus;
      dataPtr->signal = NULL;
      dataPtr->method = NULL;
      dbus->fallback = dataPtr;	 
   }
   return dataPtr;
}

/*
 *----------------------------------------------------------------------
 * DBus_CleanUpHandler
 *----------------------------------------------------------------------
 */

void DBus_CleanUpHandler(Tcl_DBusBus *dbus, char *path)
{
   
}
		    
/* 
 *----------------------------------------------------------------------
 * 
 * DBus_EventHandler --
 * 
 * 	Handle a queued event by calling a Tcl script and, if necessary,
 * 	send out a message_return or error message to the DBus with the
 * 	result of the Tcl script.
 * 
 * Results:
 * 	Boolean indicating the event was processed.
 * 
 * Side effects:
 * 	Release the Tcl script object and the DBus message object
 * 	referenced in the Tcl_Event structure.
 * 
 *----------------------------------------------------------------------
 */

static int DBus_EventHandler(Tcl_Event *evPtr, int flags)
{
   Tcl_DBusEvent *ev;
   DBusMessageIter iter;
................................................................................
   int rc, defer;

   if (!(flags & TCL_IDLE_EVENTS)) return 0;
   ev = (Tcl_DBusEvent *) evPtr;
   script = ev->script;
   if (Tcl_IsShared(script))
     script = Tcl_DuplicateObj(script);
   Tcl_ListObjAppendElement(ev->interp, script, 
			    DBus_MessageInfo(ev->interp, ev->msg));
   /* read the parameters and append to the script */
   if (dbus_message_iter_init(ev->msg, &iter)) {
      list = DBus_IterList(ev->interp, &iter,
			   (ev->flags & DBUSFLAG_DETAILS) != 0);
      Tcl_ListObjAppendList(ev->interp, script, list);
      Tcl_DecrRefCount(list);
................................................................................
   if (rc != TCL_ERROR) {
      /* Report success only if noreply == 0 and async == 0 */
      if (!(ev->flags & DBUSFLAG_NOREPLY) && !(ev->flags & DBUSFLAG_ASYNC)) {
	 retopts = Tcl_GetReturnOptions(ev->interp, rc);
	 key = Tcl_NewStringObj("-async", 6);
	 Tcl_DictObjGet(NULL, retopts, key, &value);
	 Tcl_DecrRefCount(key);
	 if (value == NULL || 
	     Tcl_GetBooleanFromObj(NULL, value, &defer) != TCL_OK)
	   defer = 0;
	 if (!defer) {
	    /* read the parameters and append to the script */;
	    value = Tcl_GetObjResult(ev->interp);
	    DBus_SendMessage(ev->interp, ev->conn,
		DBUS_MESSAGE_TYPE_METHOD_RETURN, NULL, NULL, NULL,
................................................................................
   Tcl_DecrRefCount(ev->script);
   /* The event structure will be cleaned up by Tcl_ServiceEvent */
   return 1;
}

void DBus_SetupProc(ClientData data, int flags)
{

   Tcl_Time blockTime;
   DBusDispatchStatus status;
   Tcl_HashEntry *hPtr;
   Tcl_HashSearch search;
   Tcl_DBusBus *dbus;
   



   blockTime.sec = 0;
   blockTime.usec = 100000;
   /* Check the incoming message queues */
   for (hPtr = Tcl_FirstHashEntry(&bus, &search); hPtr != NULL;
	hPtr = Tcl_NextHashEntry(&search)) {
      dbus = (Tcl_DBusBus *) Tcl_GetHashValue(hPtr);
      dbus_connection_read_write(dbus->conn, 0);
      status = dbus_connection_get_dispatch_status(dbus->conn);
      if (status == DBUS_DISPATCH_DATA_REMAINS) {
	 blockTime.sec = 0;
	 blockTime.usec = 0;
................................................................................
      }
   }
   Tcl_SetMaxBlockTime(&blockTime);
}

void DBus_CheckProc(ClientData data, int flags)
{

   DBusDispatchStatus dispatch;
   Tcl_HashEntry *hPtr;
   Tcl_HashSearch search;
   Tcl_DBusBus *dbus;
   
   if (!(flags & TCL_IDLE_EVENTS)) return;


   for (hPtr = Tcl_FirstHashEntry(&bus, &search); hPtr != NULL;
	hPtr = Tcl_NextHashEntry(&search)) {
      dbus = (Tcl_DBusBus *) Tcl_GetHashValue(hPtr);
      /* Drain the message queue */
      do
	dispatch = dbus_connection_dispatch(dbus->conn);
      while (dispatch == DBUS_DISPATCH_DATA_REMAINS);
   }
................................................................................
   Tcl_DBusHandlerData *dataPtr;
   Tcl_HashTable *tablePtr;
   Tcl_HashEntry *hPtr;

   /* Get the currently registered handler for signal/method and path */
   if (*path == '\0')
     dataPtr = dbus->fallback;
   else 
     if (!dbus_connection_get_object_path_data(dbus->conn, path,
		(void **)&dataPtr)) return NULL;
   /* Check if any handler is registered for this path */
   if (dataPtr == NULL) return NULL;
   if (method)
     tablePtr = dataPtr->method;
   else
................................................................................
   /* Check if any handlers are registered for this path */
   if (tablePtr == NULL) return NULL;
   /* Check if a handler with the specified name was registered */
   hPtr = Tcl_FindHashEntry(tablePtr, name);
   if (hPtr == NULL) return NULL;
   return Tcl_GetHashValue(hPtr);
}
			   
/*
 *----------------------------------------------------------------------
 */

DBusHandlerResult DBus_Message(DBusConnection *conn, 
	DBusMessage *msg, void *data)
{
   Tcl_HashTable *members;
   Tcl_HashEntry *memberPtr;
   Tcl_HashSearch search;
   Tcl_DBusEvent *evPtr;
   Tcl_DBusMethodData *mPtr = NULL;
................................................................................
		      "at object path '%s' (signature '%s')",
		      name, dbus_message_get_interface(msg),
		      path, dbus_message_get_signature(msg));
	  }
	  /* Send the error back to the caller */
	  err = dbus_message_new_error(msg, DBUS_ERROR_UNKNOWN_METHOD, errbuf);
	  if (dbus_connection_send(conn, err, NULL)) {

	      dbus_connection_flush(conn);

	  }
	  /* Free up the used resources */
	  dbus_message_unref(err);
	  if (errbuf != NULL) ckfree(errbuf);
	  break;
      }
      evPtr = (Tcl_DBusEvent *) ckalloc(sizeof(Tcl_DBusEvent));
................................................................................
      evPtr->conn = mPtr->conn;
      evPtr->msg = msg;
      evPtr->flags = mPtr->flags;
      dbus_message_ref(msg);
      if (dbus_message_get_no_reply(msg))
	/* Don't report the result of the event handler */
	evPtr->flags |= DBUSFLAG_NOREPLY;
      Tcl_ThreadQueueEvent(mPtr->tid, (Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
      Tcl_ThreadAlert(mPtr->tid);
      break;
    case DBUS_MESSAGE_TYPE_METHOD_RETURN:
      break;
    case DBUS_MESSAGE_TYPE_ERROR:
      break;
    case DBUS_MESSAGE_TYPE_SIGNAL:
      str[0] = intf; str[1] = name;
................................................................................
	    evPtr->script = sPtr->script;
	    Tcl_IncrRefCount(evPtr->script);
	    evPtr->conn = conn;
	    evPtr->msg = msg;
	    /* Never report the result of a signal handler */
	    evPtr->flags = sPtr->flags | DBUSFLAG_NOREPLY;
	    dbus_message_ref(msg);
	    Tcl_ThreadQueueEvent(sPtr->tid,
				 (Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
	    Tcl_ThreadAlert(sPtr->tid);
	 }
      }
      break;
   }
   return DBUS_HANDLER_RESULT_HANDLED;
}

................................................................................
   evPtr->script = dataPtr->script;
   evPtr->conn = dataPtr->conn;
   /* Fill in the rest of the DBus event structure */
   evPtr->event.proc = DBus_EventHandler;
   evPtr->msg = msg;
   /* Don't send a reply on the reply */
   evPtr->flags = dataPtr->flags | DBUSFLAG_NOREPLY;
   Tcl_ThreadQueueEvent(dataPtr->tid, (Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
   Tcl_ThreadAlert(dataPtr->tid);
   /* Free the DBus handler data structure */
   ckfree(data);
}

void DBus_FreeTimeout(void *memory)
{
    Tcl_TimerToken token = memory;
................................................................................
   if (dbus_timeout_get_enabled(timeout)) {
      DBus_AddTimeout(timeout, data);
   } else {
      DBus_RemoveTimeout(timeout, data);
   }
}



















































/*
 *----------------------------------------------------------------------
 * 
 * DBus_ListListeners
 *	Check if a signal handler is registered by the specified interpreter
 *	for the specified path. Then otionally find the children of the path
 *	and call itself recursively for each child to generate a list with
 *	all registered handlers in the subtree.
 * 
 * Results:
 * 	A list consisting of alternating paths and registered listeners.
 * 
 * Side effects:
 * 	None.
 * 
 *----------------------------------------------------------------------
 */

static Tcl_Obj *DBus_ListListeners(Tcl_Interp *interp,
	Tcl_DBusBus *dbus, const char *path, int flags)
{
   Tcl_Obj *list, *sublist;
................................................................................
   Tcl_DBusSignalData *signal;
   Tcl_DBusMethodData *method;
   Tcl_HashTable *interps;
   Tcl_HashEntry *memberPtr, *interpPtr;
   Tcl_HashSearch search;

   list = Tcl_NewObj();
   
   /* Check if the specified path has a handler defined */
   if (*path == '\0')
     data = dbus->fallback;
   else
     dbus_connection_get_object_path_data(dbus->conn, path, (void **)&data);
   if (data != NULL) {
      if ((flags & DBUS_METHODFLAG) == 0 && data->signal != NULL) {
................................................................................
      ckfree(newpath);
   }
   return list;
}

/*
 *----------------------------------------------------------------------
 * 
 * DBusListenCmd
 *	Register a script to be called when a signal with a specific
 *	path is received.
 *
 * Results:
 *	A standard Tcl result.
 * 
 * Side effects:
 * 	None.
 * 
 *----------------------------------------------------------------------
 */

int DBusListenCmd(ClientData dummy, Tcl_Interp *interp,
	int objc, Tcl_Obj *const objv[])
{
   Tcl_DBusBus *dbus = defaultbus;
   Tcl_DBusHandlerData *data;
   Tcl_DBusSignalData *signal;
   Tcl_HashTable *interps;
   Tcl_HashEntry *memberPtr, *interpPtr;
   int x = 1, flags = 0, index, isNew;
   char c, *path = NULL;
   Tcl_Obj *name = NULL, *handler = NULL, *result, *extra;
................................................................................
	 return TCL_ERROR;
      }
      name = objv[x++];
   }
   if (x < objc) {
      handler = objv[x++];
   }
   
   if (x != objc) {
      Tcl_WrongNumArgs(interp, 1, objv, "?busId? ?options? "
		       "?path ?signal ?script???");
      return TCL_ERROR;
   }

   if (dbus == NULL) {
................................................................................
	    signal = Tcl_GetHashValue(memberPtr);
	    Tcl_IncrRefCount(signal->script);
	    Tcl_SetObjResult(interp, signal->script);
	 }
      }
      return TCL_OK;
   }
   
   if (Tcl_GetCharLength(handler) == 0) {
      /* Unregistering a handler */
      if (*path != '\0') {
	 if (!dbus_connection_get_object_path_data(dbus->conn, path,
						      (void **)&data))
	   return DBus_MemoryError(interp);
      }
................................................................................
	       else
		 dbus->fallback = NULL;
	    }
	 }
      }
      return TCL_OK;
   }
   
   /* Register the new handler */
   data = DBus_GetMessageHandler(interp, dbus, path);
   if (data->signal == NULL) {
      /* No signals have been defined for this path by any interpreter yet
         So first a hash table indexed by interpreter must be created */
      data->signal = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
      Tcl_InitHashTable(data->signal, TCL_STRING_KEYS);
................................................................................
      signal = (Tcl_DBusSignalData *) ckalloc(sizeof(Tcl_DBusSignalData));
      Tcl_SetHashValue(memberPtr, signal);
   } else {
      /* Release the old script */
      signal = Tcl_GetHashValue(memberPtr);
      Tcl_DecrRefCount(signal->script);
   }
   signal->tid = Tcl_GetCurrentThread();
   signal->script = handler;
   signal->flags = flags;
   Tcl_IncrRefCount(handler);
   return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 * 
 * DBusMethodCmd
 *	Register a script to be called when a call for a method at a
 *	specific path is received.
 *
 * Results:
 *	A standard Tcl result.
 * 
 * Side effects:
 * 	None.
 * 
 *----------------------------------------------------------------------
 */

int DBusMethodCmd(ClientData dummy, Tcl_Interp *interp,
	int objc, Tcl_Obj *const objv[])
{
   Tcl_DBusBus *dbus = defaultbus;
   Tcl_DBusHandlerData *data;
   Tcl_DBusMethodData *method;
   Tcl_HashEntry *memberPtr;
   int x = 1, flags = 0, isNew, index;
   char c, *str, *path = NULL;
   Tcl_Obj *name = NULL, *handler = NULL, *result, *extra;
   static const char *options[] = {"-async", "-details", NULL};
................................................................................
	 flags |= DBUSFLAG_ASYNC;
	 break;
       case DBUS_DETAILS:
	 flags |= DBUSFLAG_DETAILS;
	 break;
      }
   }
	 
   if (x < objc) {
      if (*str != '\0' && !DBus_CheckPath(objv[x])) {
	 Tcl_SetObjResult(interp, Tcl_NewStringObj("Invalid path", -1));
	 return TCL_ERROR;
      }
      path = Tcl_GetString(objv[x++]);
   }
................................................................................
	 return TCL_ERROR;
      }
      name = objv[x++];
   }
   if (x < objc) {
      handler = objv[x++];
   }
   
   if (x != objc) {
      Tcl_WrongNumArgs(interp, 1, objv, 
		       "?busId? ?options? ?path ?method ?script???");
      return TCL_ERROR;
   }

   if (dbus == NULL) {
      Tcl_SetObjResult(interp, Tcl_NewStringObj("Not connected", -1));
      return TCL_ERROR;
................................................................................
      if (method != NULL && method->interp == interp) {
	 /* Return the script configured for the handler */
	 Tcl_IncrRefCount(method->script);
	 Tcl_SetObjResult(interp, method->script);
      }
      return TCL_OK;
   }
   
   if (Tcl_GetCharLength(handler) == 0) {
      /* Unregistering a handler */
      if (flags & DBUSFLAG_ASYNC) {
	 Tcl_SetObjResult(interp, Tcl_NewStringObj("The -async option "
		"is not applicable for unregistering method handlers", -1));
	 return TCL_ERROR;
      }
................................................................................
	      dbus_connection_unregister_object_path(dbus->conn, path);
	    else
	      dbus->fallback = NULL;
	 }
      }
      return TCL_OK;
   }
   
   /* Register the new handler */
   data = DBus_GetMessageHandler(interp, dbus, path);
   if (data->method == NULL) {
      /* No methods have been defined for this path by any interpreter yet
         So first a hash table indexed by interpreter must be created */
      data->method = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
      Tcl_InitHashTable(data->method, TCL_STRING_KEYS);
   }
   memberPtr = Tcl_CreateHashEntry(data->method, Tcl_GetString(name), &isNew);
   if (isNew) {
      method = (Tcl_DBusMethodData *) ckalloc(sizeof(Tcl_DBusMethodData));
      method->tid = Tcl_GetCurrentThread();
      method->interp = interp;
      method->conn = dbus->conn;
      Tcl_SetHashValue(memberPtr, method);
   } else {
      method = Tcl_GetHashValue(memberPtr);
      if(method->interp == interp) {
	 /* Release the old script */
................................................................................
   method->flags = flags;
   Tcl_IncrRefCount(handler);
   return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 * 
 * DBusUnknownCmd
 *	Register a script to be called when a call for an unknown method
 *	is received.
 *
 * Results:
 *	A standard Tcl result.
 * 
 * Side effects:
 * 	None.
 * 
 *----------------------------------------------------------------------
 */

int DBusUnknownCmd(ClientData dummy, Tcl_Interp *interp,
	int objc, Tcl_Obj *const objv[])
{
   Tcl_DBusBus *dbus = defaultbus;
   Tcl_DBusHandlerData *data;
   Tcl_DBusMethodData *method;
   Tcl_HashEntry *memberPtr;
   int x = 1, isNew, flags, index;
   char c, *path = NULL;
   Tcl_Obj *handler = NULL, *result, *extra;
   static const char *options[] = {"-details", NULL};
................................................................................
      }
      switch ((enum options) index) {
       case DBUS_DETAILS:
	 flags |= DBUSFLAG_DETAILS;
	 break;
      }
   }
	 
   if (x < objc) {
      c = Tcl_GetString(objv[x])[0];
      if (c != '\0' && !DBus_CheckPath(objv[x])) {
	 Tcl_SetObjResult(interp, Tcl_NewStringObj("Invalid path", -1));
	 return TCL_ERROR;
      }
      path = Tcl_GetString(objv[x++]);
   }
   if (x < objc) {
      handler = objv[x++];
   }
   
   if (x != objc) {
      Tcl_WrongNumArgs(interp, 1, objv, "?busId? ?options? ?path ?script??");
      return TCL_ERROR;
   }

   if (dbus == NULL) {
      Tcl_SetObjResult(interp, Tcl_NewStringObj("Not connected", -1));
................................................................................
      return TCL_ERROR;
   }

   if (handler == NULL) {
      /* Request for a report on currently registered handler(s) */
      if (path == NULL) {
	 /* Get all handlers for any path */
	 result = DBus_ListListeners(interp, dbus, "", 
				     DBUS_METHODFLAG | DBUS_UNKNOWNFLAG);
	 /* append all currently registered handlers from the root path */
	 extra = DBus_ListListeners(interp, dbus, "/",
			DBUS_METHODFLAG | DBUS_UNKNOWNFLAG | DBUS_RECURSEFLAG);
	 Tcl_ListObjAppendList(NULL, result, extra);
	 Tcl_DecrRefCount(extra);
	 Tcl_SetObjResult(interp, result);
................................................................................
      if (method != NULL && method->interp == interp) {
	 /* Return the script configured for the handler */
	 Tcl_IncrRefCount(method->script);
	 Tcl_SetObjResult(interp, method->script);
      }
      return TCL_OK;
   }
   
   if (Tcl_GetCharLength(handler) == 0) {
      /* Unregistering a handler */
      if (*path != '\0') {
	 if (!dbus_connection_get_object_path_data(dbus->conn, path,
						      (void **)&data))
	   return DBus_MemoryError(interp);
      }
................................................................................
	      dbus_connection_unregister_object_path(dbus->conn, path);
	    else
	      dbus->fallback = NULL;
	 }
      }
      return TCL_OK;
   }
   
   /* Register the new handler */
   data = DBus_GetMessageHandler(interp, dbus, path);
   if (data->method == NULL) {
      /* No methods have been defined for this path by any interpreter yet
         So first a hash table indexed by interpreter must be created */
      data->method = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
      Tcl_InitHashTable(data->method, TCL_STRING_KEYS);
   }
   memberPtr = Tcl_CreateHashEntry(data->method, "", &isNew);
   if (isNew) {
      method = (Tcl_DBusMethodData *) ckalloc(sizeof(Tcl_DBusMethodData));
      method->tid = Tcl_GetCurrentThread();
      method->interp = interp;
      method->conn = dbus->conn;
      Tcl_SetHashValue(memberPtr, method);
   } else {
      method = Tcl_GetHashValue(memberPtr);
      if(method->interp == interp) {
	 /* Release the old script */
................................................................................
   return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 */

DBusHandlerResult DBus_Monitor(DBusConnection *conn, 
	DBusMessage *msg, void *data)
{
   Tcl_DBusEvent *evPtr;
   Tcl_DBusMonitorData* dataPtr = data;

   if (dataPtr->script != NULL) {
      evPtr = (Tcl_DBusEvent *) ckalloc(sizeof(Tcl_DBusEvent));
................................................................................
      evPtr->script = dataPtr->script;
      Tcl_IncrRefCount(evPtr->script);
      evPtr->conn = conn;
      evPtr->msg = msg;
      /* Never report the result of a snoop handler */
      evPtr->flags = dataPtr->flags | DBUSFLAG_NOREPLY;
      dbus_message_ref(msg);
      Tcl_ThreadQueueEvent(dataPtr->tid, (Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
      Tcl_ThreadAlert(dataPtr->tid);
   }
   /* Allow messages to proceed to invoke methods and signal events */
   return DBUS_HANDLER_RESULT_NOT_YET_HANDLED;
}

/*
 *----------------------------------------------------------------------
 * 
 * DBusMonitorCmd
 *	Register a script to be called whenever any D-Bus message is
 *	received.
 *
 * Results:
 *	A standard Tcl result.
 * 
 * Side effects:
 * 	None.
 * 
 *----------------------------------------------------------------------
 */

int DBusMonitorCmd(ClientData dummy, Tcl_Interp *interp,
	int objc, Tcl_Obj *const objv[])
{
   Tcl_DBusBus *dbus = defaultbus;
   Tcl_DBusMonitorData *snoop;
   Tcl_HashEntry *memberPtr;
   Tcl_Obj *handler;
   int x = 1, flags = 0, index;
   char c;
   static const char *options[] = {"-details", NULL};
   enum options {DBUS_DETAILS};
................................................................................
      }
      switch ((enum options) index) {
       case DBUS_DETAILS:
	 flags |= DBUSFLAG_DETAILS;
	 break;
      }
   }
	 
   if (objc != x + 1) {
      Tcl_WrongNumArgs(interp, 1, objv, "?busId? script");
      return TCL_ERROR;
   }
   handler = objv[x];

   if (dbus == NULL) {
................................................................................
      ckfree((char *) snoop);
      Tcl_SetHashValue(memberPtr, NULL);
   }

   if (Tcl_GetCharLength(handler) > 0) {
      /* Register the new handler */
      snoop = (Tcl_DBusMonitorData *)ckalloc(sizeof(Tcl_DBusMonitorData));
      snoop->tid = Tcl_GetCurrentThread();
      snoop->interp = interp;
      snoop->script = handler;
      snoop->flags = flags;
      Tcl_IncrRefCount(handler);
      Tcl_SetHashValue(memberPtr, snoop);

      dbus_connection_add_filter(dbus->conn, DBus_Monitor, snoop, NULL);
   }
   return TCL_OK;
}







|







 







|






|





|





|












|

|
|

|

|



|


|



|







 







|







 







|







 







>





|
>
>
>



|







 







>




|
|
>
>
|







 







|







 







|




|







 







>

>







 







|
<







 







<
|
<







 







|
<







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>


|





|


|


|







 







|







 







|






|


|






|







 







|







 







|







 







|







 







<








|






|


|






|







 







|







 







|

|







 







|







 







|











<







 







|






|


|






|







 







|











|







 







|







 







|







 







|











<







 







|







 







|
<







|






|


|






|







 







|







 







<










18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
..
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
...
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
...
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
...
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
...
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
...
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
...
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
...
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
...
326
327
328
329
330
331
332
333

334
335
336
337
338
339
340
...
355
356
357
358
359
360
361

362

363
364
365
366
367
368
369
...
386
387
388
389
390
391
392
393

394
395
396
397
398
399
400
...
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
...
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
...
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
...
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
...
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
...
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
...
773
774
775
776
777
778
779

780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
...
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
...
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
...
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
...
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954

955
956
957
958
959
960
961
...
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
....
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
....
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
....
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
....
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122

1123
1124
1125
1126
1127
1128
1129
....
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
....
1159
1160
1161
1162
1163
1164
1165
1166

1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
....
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
....
1243
1244
1245
1246
1247
1248
1249

1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
	Tcl_DBusBus *dbus, char *path)
{
   DBusObjectPathVTable vtable;
   Tcl_DBusHandlerData *dataPtr;

   /* Get the currently registered handler for the path */
   if (*path == '\0') {
      if (!dbus_connection_get_object_path_data(dbus->conn, "/",
		(void **)&dataPtr)) return NULL;
   }
   else {
      if (!dbus_connection_get_object_path_data(dbus->conn, path,
		(void **)&dataPtr)) return NULL;
   }
   if (dataPtr == NULL) {
................................................................................
      dataPtr = (Tcl_DBusHandlerData *)ckalloc(sizeof(Tcl_DBusHandlerData));
      dataPtr->dbus = dbus;
      dataPtr->signal = NULL;
      dataPtr->method = NULL;
      dataPtr->flags = 0;
      if (path[0] == '\0' || (path[0] == '/' && path[1] == '\0')) {
	 /* Register as a fallback method handler */
	 if (!dbus_connection_register_fallback(dbus->conn, "/",
						   &vtable, dataPtr))
	   return NULL;
	 dataPtr->flags |= DBUSFLAG_FALLBACK;
      }
      else {
	 /* Register as a regular method handler */
	 if (!dbus_connection_register_object_path(dbus->conn, path,
						      &vtable, dataPtr))
	   return NULL;
      }
   }
   if (*path == '\0') {
      if (dbus->fallback != NULL)
	return dbus->fallback;
      dataPtr = (Tcl_DBusHandlerData *)ckalloc(sizeof(Tcl_DBusHandlerData));
      dataPtr->dbus = dbus;
      dataPtr->signal = NULL;
      dataPtr->method = NULL;
      dbus->fallback = dataPtr;
   }
   return dataPtr;
}

/*
 *----------------------------------------------------------------------
 * DBus_CleanUpHandler
 *----------------------------------------------------------------------
 */

void DBus_CleanUpHandler(Tcl_DBusBus *dbus, char *path)
{

}

/*
 *----------------------------------------------------------------------
 *
 * DBus_EventHandler --
 *
 * 	Handle a queued event by calling a Tcl script and, if necessary,
 * 	send out a message_return or error message to the DBus with the
 * 	result of the Tcl script.
 *
 * Results:
 * 	Boolean indicating the event was processed.
 *
 * Side effects:
 * 	Release the Tcl script object and the DBus message object
 * 	referenced in the Tcl_Event structure.
 *
 *----------------------------------------------------------------------
 */

static int DBus_EventHandler(Tcl_Event *evPtr, int flags)
{
   Tcl_DBusEvent *ev;
   DBusMessageIter iter;
................................................................................
   int rc, defer;

   if (!(flags & TCL_IDLE_EVENTS)) return 0;
   ev = (Tcl_DBusEvent *) evPtr;
   script = ev->script;
   if (Tcl_IsShared(script))
     script = Tcl_DuplicateObj(script);
   Tcl_ListObjAppendElement(ev->interp, script,
			    DBus_MessageInfo(ev->interp, ev->msg));
   /* read the parameters and append to the script */
   if (dbus_message_iter_init(ev->msg, &iter)) {
      list = DBus_IterList(ev->interp, &iter,
			   (ev->flags & DBUSFLAG_DETAILS) != 0);
      Tcl_ListObjAppendList(ev->interp, script, list);
      Tcl_DecrRefCount(list);
................................................................................
   if (rc != TCL_ERROR) {
      /* Report success only if noreply == 0 and async == 0 */
      if (!(ev->flags & DBUSFLAG_NOREPLY) && !(ev->flags & DBUSFLAG_ASYNC)) {
	 retopts = Tcl_GetReturnOptions(ev->interp, rc);
	 key = Tcl_NewStringObj("-async", 6);
	 Tcl_DictObjGet(NULL, retopts, key, &value);
	 Tcl_DecrRefCount(key);
	 if (value == NULL ||
	     Tcl_GetBooleanFromObj(NULL, value, &defer) != TCL_OK)
	   defer = 0;
	 if (!defer) {
	    /* read the parameters and append to the script */;
	    value = Tcl_GetObjResult(ev->interp);
	    DBus_SendMessage(ev->interp, ev->conn,
		DBUS_MESSAGE_TYPE_METHOD_RETURN, NULL, NULL, NULL,
................................................................................
   Tcl_DecrRefCount(ev->script);
   /* The event structure will be cleaned up by Tcl_ServiceEvent */
   return 1;
}

void DBus_SetupProc(ClientData data, int flags)
{
   Tcl_DBusThreadData *tsdPtr = (Tcl_DBusThreadData *) data;
   Tcl_Time blockTime;
   DBusDispatchStatus status;
   Tcl_HashEntry *hPtr;
   Tcl_HashSearch search;
   Tcl_DBusBus *dbus;

   if (!(flags & TCL_FILE_EVENTS))
     return; 

   blockTime.sec = 0;
   blockTime.usec = 100000;
   /* Check the incoming message queues */
   for (hPtr = Tcl_FirstHashEntry(&tsdPtr->bus, &search); hPtr != NULL;
	hPtr = Tcl_NextHashEntry(&search)) {
      dbus = (Tcl_DBusBus *) Tcl_GetHashValue(hPtr);
      dbus_connection_read_write(dbus->conn, 0);
      status = dbus_connection_get_dispatch_status(dbus->conn);
      if (status == DBUS_DISPATCH_DATA_REMAINS) {
	 blockTime.sec = 0;
	 blockTime.usec = 0;
................................................................................
      }
   }
   Tcl_SetMaxBlockTime(&blockTime);
}

void DBus_CheckProc(ClientData data, int flags)
{
   Tcl_DBusThreadData *tsdPtr = (Tcl_DBusThreadData *) data;
   DBusDispatchStatus dispatch;
   Tcl_HashEntry *hPtr;
   Tcl_HashSearch search;
   Tcl_DBusBus *dbus;

   if (!(flags & TCL_FILE_EVENTS))
     return; 

   for (hPtr = Tcl_FirstHashEntry(&tsdPtr->bus, &search); hPtr != NULL;
	hPtr = Tcl_NextHashEntry(&search)) {
      dbus = (Tcl_DBusBus *) Tcl_GetHashValue(hPtr);
      /* Drain the message queue */
      do
	dispatch = dbus_connection_dispatch(dbus->conn);
      while (dispatch == DBUS_DISPATCH_DATA_REMAINS);
   }
................................................................................
   Tcl_DBusHandlerData *dataPtr;
   Tcl_HashTable *tablePtr;
   Tcl_HashEntry *hPtr;

   /* Get the currently registered handler for signal/method and path */
   if (*path == '\0')
     dataPtr = dbus->fallback;
   else
     if (!dbus_connection_get_object_path_data(dbus->conn, path,
		(void **)&dataPtr)) return NULL;
   /* Check if any handler is registered for this path */
   if (dataPtr == NULL) return NULL;
   if (method)
     tablePtr = dataPtr->method;
   else
................................................................................
   /* Check if any handlers are registered for this path */
   if (tablePtr == NULL) return NULL;
   /* Check if a handler with the specified name was registered */
   hPtr = Tcl_FindHashEntry(tablePtr, name);
   if (hPtr == NULL) return NULL;
   return Tcl_GetHashValue(hPtr);
}

/*
 *----------------------------------------------------------------------
 */

DBusHandlerResult DBus_Message(DBusConnection *conn,
	DBusMessage *msg, void *data)
{
   Tcl_HashTable *members;
   Tcl_HashEntry *memberPtr;
   Tcl_HashSearch search;
   Tcl_DBusEvent *evPtr;
   Tcl_DBusMethodData *mPtr = NULL;
................................................................................
		      "at object path '%s' (signature '%s')",
		      name, dbus_message_get_interface(msg),
		      path, dbus_message_get_signature(msg));
	  }
	  /* Send the error back to the caller */
	  err = dbus_message_new_error(msg, DBUS_ERROR_UNKNOWN_METHOD, errbuf);
	  if (dbus_connection_send(conn, err, NULL)) {
#ifdef _WIN32
	      dbus_connection_flush(conn);
#endif
	  }
	  /* Free up the used resources */
	  dbus_message_unref(err);
	  if (errbuf != NULL) ckfree(errbuf);
	  break;
      }
      evPtr = (Tcl_DBusEvent *) ckalloc(sizeof(Tcl_DBusEvent));
................................................................................
      evPtr->conn = mPtr->conn;
      evPtr->msg = msg;
      evPtr->flags = mPtr->flags;
      dbus_message_ref(msg);
      if (dbus_message_get_no_reply(msg))
	/* Don't report the result of the event handler */
	evPtr->flags |= DBUSFLAG_NOREPLY;
      Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);

      break;
    case DBUS_MESSAGE_TYPE_METHOD_RETURN:
      break;
    case DBUS_MESSAGE_TYPE_ERROR:
      break;
    case DBUS_MESSAGE_TYPE_SIGNAL:
      str[0] = intf; str[1] = name;
................................................................................
	    evPtr->script = sPtr->script;
	    Tcl_IncrRefCount(evPtr->script);
	    evPtr->conn = conn;
	    evPtr->msg = msg;
	    /* Never report the result of a signal handler */
	    evPtr->flags = sPtr->flags | DBUSFLAG_NOREPLY;
	    dbus_message_ref(msg);

	    Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);

	 }
      }
      break;
   }
   return DBUS_HANDLER_RESULT_HANDLED;
}

................................................................................
   evPtr->script = dataPtr->script;
   evPtr->conn = dataPtr->conn;
   /* Fill in the rest of the DBus event structure */
   evPtr->event.proc = DBus_EventHandler;
   evPtr->msg = msg;
   /* Don't send a reply on the reply */
   evPtr->flags = dataPtr->flags | DBUSFLAG_NOREPLY;
   Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);

   /* Free the DBus handler data structure */
   ckfree(data);
}

void DBus_FreeTimeout(void *memory)
{
    Tcl_TimerToken token = memory;
................................................................................
   if (dbus_timeout_get_enabled(timeout)) {
      DBus_AddTimeout(timeout, data);
   } else {
      DBus_RemoveTimeout(timeout, data);
   }
}

#ifndef _WIN32

static void DBus_FileHandler(ClientData data, int mask)
{
   if (mask & (TCL_READABLE | TCL_WRITABLE)) {
      DBusDispatchStatus dispatch;

      do {
	 dbus_connection_read_write((DBusConnection *) data, 0);
	 dispatch = dbus_connection_dispatch((DBusConnection *) data);
      } while (dispatch == DBUS_DISPATCH_DATA_REMAINS);
   }
}

dbus_bool_t DBus_AddWatch(DBusWatch *watch, void *data)
{
   int tflags = 0, dflags = dbus_watch_get_flags(watch);

   if (dflags & DBUS_WATCH_READABLE)
     tflags |= TCL_READABLE;
   if (dflags & DBUS_WATCH_WRITABLE)
     tflags |= TCL_WRITABLE;
   if (tflags)
      Tcl_CreateFileHandler(dbus_watch_get_unix_fd(watch), tflags,
			    DBus_FileHandler, data);
   return TRUE;
}

void DBus_RemoveWatch(DBusWatch *watch, void *data)
{
   Tcl_DeleteFileHandler(dbus_watch_get_unix_fd(watch));
}

void DBus_ToggleWatch(DBusWatch *watch, void *data)
{
   int tflags = 0, dflags = dbus_watch_get_flags(watch);

   if (dflags & DBUS_WATCH_READABLE)
     tflags |= TCL_READABLE;
   if (dflags & DBUS_WATCH_WRITABLE)
     tflags |= TCL_WRITABLE;
   if (tflags)
     Tcl_CreateFileHandler(dbus_watch_get_unix_fd(watch), tflags,
			   DBus_FileHandler, data);
   else
     Tcl_DeleteFileHandler(dbus_watch_get_unix_fd(watch));
}

#endif

/*
 *----------------------------------------------------------------------
 *
 * DBus_ListListeners
 *	Check if a signal handler is registered by the specified interpreter
 *	for the specified path. Then otionally find the children of the path
 *	and call itself recursively for each child to generate a list with
 *	all registered handlers in the subtree.
 *
 * Results:
 * 	A list consisting of alternating paths and registered listeners.
 *
 * Side effects:
 * 	None.
 *
 *----------------------------------------------------------------------
 */

static Tcl_Obj *DBus_ListListeners(Tcl_Interp *interp,
	Tcl_DBusBus *dbus, const char *path, int flags)
{
   Tcl_Obj *list, *sublist;
................................................................................
   Tcl_DBusSignalData *signal;
   Tcl_DBusMethodData *method;
   Tcl_HashTable *interps;
   Tcl_HashEntry *memberPtr, *interpPtr;
   Tcl_HashSearch search;

   list = Tcl_NewObj();

   /* Check if the specified path has a handler defined */
   if (*path == '\0')
     data = dbus->fallback;
   else
     dbus_connection_get_object_path_data(dbus->conn, path, (void **)&data);
   if (data != NULL) {
      if ((flags & DBUS_METHODFLAG) == 0 && data->signal != NULL) {
................................................................................
      ckfree(newpath);
   }
   return list;
}

/*
 *----------------------------------------------------------------------
 *
 * DBusListenCmd
 *	Register a script to be called when a signal with a specific
 *	path is received.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 * 	None.
 *
 *----------------------------------------------------------------------
 */

int DBusListenCmd(ClientData dummy, Tcl_Interp *interp,
	int objc, Tcl_Obj *const objv[])
{
   Tcl_DBusBus *dbus = DBus_GetDefaultBus();
   Tcl_DBusHandlerData *data;
   Tcl_DBusSignalData *signal;
   Tcl_HashTable *interps;
   Tcl_HashEntry *memberPtr, *interpPtr;
   int x = 1, flags = 0, index, isNew;
   char c, *path = NULL;
   Tcl_Obj *name = NULL, *handler = NULL, *result, *extra;
................................................................................
	 return TCL_ERROR;
      }
      name = objv[x++];
   }
   if (x < objc) {
      handler = objv[x++];
   }

   if (x != objc) {
      Tcl_WrongNumArgs(interp, 1, objv, "?busId? ?options? "
		       "?path ?signal ?script???");
      return TCL_ERROR;
   }

   if (dbus == NULL) {
................................................................................
	    signal = Tcl_GetHashValue(memberPtr);
	    Tcl_IncrRefCount(signal->script);
	    Tcl_SetObjResult(interp, signal->script);
	 }
      }
      return TCL_OK;
   }

   if (Tcl_GetCharLength(handler) == 0) {
      /* Unregistering a handler */
      if (*path != '\0') {
	 if (!dbus_connection_get_object_path_data(dbus->conn, path,
						      (void **)&data))
	   return DBus_MemoryError(interp);
      }
................................................................................
	       else
		 dbus->fallback = NULL;
	    }
	 }
      }
      return TCL_OK;
   }

   /* Register the new handler */
   data = DBus_GetMessageHandler(interp, dbus, path);
   if (data->signal == NULL) {
      /* No signals have been defined for this path by any interpreter yet
         So first a hash table indexed by interpreter must be created */
      data->signal = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
      Tcl_InitHashTable(data->signal, TCL_STRING_KEYS);
................................................................................
      signal = (Tcl_DBusSignalData *) ckalloc(sizeof(Tcl_DBusSignalData));
      Tcl_SetHashValue(memberPtr, signal);
   } else {
      /* Release the old script */
      signal = Tcl_GetHashValue(memberPtr);
      Tcl_DecrRefCount(signal->script);
   }

   signal->script = handler;
   signal->flags = flags;
   Tcl_IncrRefCount(handler);
   return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * DBusMethodCmd
 *	Register a script to be called when a call for a method at a
 *	specific path is received.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 * 	None.
 *
 *----------------------------------------------------------------------
 */

int DBusMethodCmd(ClientData dummy, Tcl_Interp *interp,
	int objc, Tcl_Obj *const objv[])
{
   Tcl_DBusBus *dbus = DBus_GetDefaultBus();
   Tcl_DBusHandlerData *data;
   Tcl_DBusMethodData *method;
   Tcl_HashEntry *memberPtr;
   int x = 1, flags = 0, isNew, index;
   char c, *str, *path = NULL;
   Tcl_Obj *name = NULL, *handler = NULL, *result, *extra;
   static const char *options[] = {"-async", "-details", NULL};
................................................................................
	 flags |= DBUSFLAG_ASYNC;
	 break;
       case DBUS_DETAILS:
	 flags |= DBUSFLAG_DETAILS;
	 break;
      }
   }

   if (x < objc) {
      if (*str != '\0' && !DBus_CheckPath(objv[x])) {
	 Tcl_SetObjResult(interp, Tcl_NewStringObj("Invalid path", -1));
	 return TCL_ERROR;
      }
      path = Tcl_GetString(objv[x++]);
   }
................................................................................
	 return TCL_ERROR;
      }
      name = objv[x++];
   }
   if (x < objc) {
      handler = objv[x++];
   }

   if (x != objc) {
      Tcl_WrongNumArgs(interp, 1, objv,
		       "?busId? ?options? ?path ?method ?script???");
      return TCL_ERROR;
   }

   if (dbus == NULL) {
      Tcl_SetObjResult(interp, Tcl_NewStringObj("Not connected", -1));
      return TCL_ERROR;
................................................................................
      if (method != NULL && method->interp == interp) {
	 /* Return the script configured for the handler */
	 Tcl_IncrRefCount(method->script);
	 Tcl_SetObjResult(interp, method->script);
      }
      return TCL_OK;
   }

   if (Tcl_GetCharLength(handler) == 0) {
      /* Unregistering a handler */
      if (flags & DBUSFLAG_ASYNC) {
	 Tcl_SetObjResult(interp, Tcl_NewStringObj("The -async option "
		"is not applicable for unregistering method handlers", -1));
	 return TCL_ERROR;
      }
................................................................................
	      dbus_connection_unregister_object_path(dbus->conn, path);
	    else
	      dbus->fallback = NULL;
	 }
      }
      return TCL_OK;
   }

   /* Register the new handler */
   data = DBus_GetMessageHandler(interp, dbus, path);
   if (data->method == NULL) {
      /* No methods have been defined for this path by any interpreter yet
         So first a hash table indexed by interpreter must be created */
      data->method = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
      Tcl_InitHashTable(data->method, TCL_STRING_KEYS);
   }
   memberPtr = Tcl_CreateHashEntry(data->method, Tcl_GetString(name), &isNew);
   if (isNew) {
      method = (Tcl_DBusMethodData *) ckalloc(sizeof(Tcl_DBusMethodData));

      method->interp = interp;
      method->conn = dbus->conn;
      Tcl_SetHashValue(memberPtr, method);
   } else {
      method = Tcl_GetHashValue(memberPtr);
      if(method->interp == interp) {
	 /* Release the old script */
................................................................................
   method->flags = flags;
   Tcl_IncrRefCount(handler);
   return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * DBusUnknownCmd
 *	Register a script to be called when a call for an unknown method
 *	is received.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 * 	None.
 *
 *----------------------------------------------------------------------
 */

int DBusUnknownCmd(ClientData dummy, Tcl_Interp *interp,
	int objc, Tcl_Obj *const objv[])
{
   Tcl_DBusBus *dbus = DBus_GetDefaultBus();
   Tcl_DBusHandlerData *data;
   Tcl_DBusMethodData *method;
   Tcl_HashEntry *memberPtr;
   int x = 1, isNew, flags, index;
   char c, *path = NULL;
   Tcl_Obj *handler = NULL, *result, *extra;
   static const char *options[] = {"-details", NULL};
................................................................................
      }
      switch ((enum options) index) {
       case DBUS_DETAILS:
	 flags |= DBUSFLAG_DETAILS;
	 break;
      }
   }

   if (x < objc) {
      c = Tcl_GetString(objv[x])[0];
      if (c != '\0' && !DBus_CheckPath(objv[x])) {
	 Tcl_SetObjResult(interp, Tcl_NewStringObj("Invalid path", -1));
	 return TCL_ERROR;
      }
      path = Tcl_GetString(objv[x++]);
   }
   if (x < objc) {
      handler = objv[x++];
   }

   if (x != objc) {
      Tcl_WrongNumArgs(interp, 1, objv, "?busId? ?options? ?path ?script??");
      return TCL_ERROR;
   }

   if (dbus == NULL) {
      Tcl_SetObjResult(interp, Tcl_NewStringObj("Not connected", -1));
................................................................................
      return TCL_ERROR;
   }

   if (handler == NULL) {
      /* Request for a report on currently registered handler(s) */
      if (path == NULL) {
	 /* Get all handlers for any path */
	 result = DBus_ListListeners(interp, dbus, "",
				     DBUS_METHODFLAG | DBUS_UNKNOWNFLAG);
	 /* append all currently registered handlers from the root path */
	 extra = DBus_ListListeners(interp, dbus, "/",
			DBUS_METHODFLAG | DBUS_UNKNOWNFLAG | DBUS_RECURSEFLAG);
	 Tcl_ListObjAppendList(NULL, result, extra);
	 Tcl_DecrRefCount(extra);
	 Tcl_SetObjResult(interp, result);
................................................................................
      if (method != NULL && method->interp == interp) {
	 /* Return the script configured for the handler */
	 Tcl_IncrRefCount(method->script);
	 Tcl_SetObjResult(interp, method->script);
      }
      return TCL_OK;
   }

   if (Tcl_GetCharLength(handler) == 0) {
      /* Unregistering a handler */
      if (*path != '\0') {
	 if (!dbus_connection_get_object_path_data(dbus->conn, path,
						      (void **)&data))
	   return DBus_MemoryError(interp);
      }
................................................................................
	      dbus_connection_unregister_object_path(dbus->conn, path);
	    else
	      dbus->fallback = NULL;
	 }
      }
      return TCL_OK;
   }

   /* Register the new handler */
   data = DBus_GetMessageHandler(interp, dbus, path);
   if (data->method == NULL) {
      /* No methods have been defined for this path by any interpreter yet
         So first a hash table indexed by interpreter must be created */
      data->method = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
      Tcl_InitHashTable(data->method, TCL_STRING_KEYS);
   }
   memberPtr = Tcl_CreateHashEntry(data->method, "", &isNew);
   if (isNew) {
      method = (Tcl_DBusMethodData *) ckalloc(sizeof(Tcl_DBusMethodData));

      method->interp = interp;
      method->conn = dbus->conn;
      Tcl_SetHashValue(memberPtr, method);
   } else {
      method = Tcl_GetHashValue(memberPtr);
      if(method->interp == interp) {
	 /* Release the old script */
................................................................................
   return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 */

DBusHandlerResult DBus_Monitor(DBusConnection *conn,
	DBusMessage *msg, void *data)
{
   Tcl_DBusEvent *evPtr;
   Tcl_DBusMonitorData* dataPtr = data;

   if (dataPtr->script != NULL) {
      evPtr = (Tcl_DBusEvent *) ckalloc(sizeof(Tcl_DBusEvent));
................................................................................
      evPtr->script = dataPtr->script;
      Tcl_IncrRefCount(evPtr->script);
      evPtr->conn = conn;
      evPtr->msg = msg;
      /* Never report the result of a snoop handler */
      evPtr->flags = dataPtr->flags | DBUSFLAG_NOREPLY;
      dbus_message_ref(msg);
      Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);

   }
   /* Allow messages to proceed to invoke methods and signal events */
   return DBUS_HANDLER_RESULT_NOT_YET_HANDLED;
}

/*
 *----------------------------------------------------------------------
 *
 * DBusMonitorCmd
 *	Register a script to be called whenever any D-Bus message is
 *	received.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 * 	None.
 *
 *----------------------------------------------------------------------
 */

int DBusMonitorCmd(ClientData dummy, Tcl_Interp *interp,
	int objc, Tcl_Obj *const objv[])
{
   Tcl_DBusBus *dbus = DBus_GetDefaultBus();
   Tcl_DBusMonitorData *snoop;
   Tcl_HashEntry *memberPtr;
   Tcl_Obj *handler;
   int x = 1, flags = 0, index;
   char c;
   static const char *options[] = {"-details", NULL};
   enum options {DBUS_DETAILS};
................................................................................
      }
      switch ((enum options) index) {
       case DBUS_DETAILS:
	 flags |= DBUSFLAG_DETAILS;
	 break;
      }
   }

   if (objc != x + 1) {
      Tcl_WrongNumArgs(interp, 1, objv, "?busId? script");
      return TCL_ERROR;
   }
   handler = objv[x];

   if (dbus == NULL) {
................................................................................
      ckfree((char *) snoop);
      Tcl_SetHashValue(memberPtr, NULL);
   }

   if (Tcl_GetCharLength(handler) > 0) {
      /* Register the new handler */
      snoop = (Tcl_DBusMonitorData *)ckalloc(sizeof(Tcl_DBusMonitorData));

      snoop->interp = interp;
      snoop->script = handler;
      snoop->flags = flags;
      Tcl_IncrRefCount(handler);
      Tcl_SetHashValue(memberPtr, snoop);

      dbus_connection_add_filter(dbus->conn, DBus_Monitor, snoop, NULL);
   }
   return TCL_OK;
}

Changes to undroid/dbus/dbus-tcl/dbusMain.c.

1
2
3














































4
5
6
7


8
9


10
11
12
13
14
15
16
17
18
19


20


21
22
23

24
25
26
27
28


















29
30
31

32
33
34


35
36
37
38
39
40
41
42
...
161
162
163
164
165
166
167

168
169
170
171
172
173
174
175
176
177
178
...
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
#include "dbustcl.h"

Tcl_HashTable bus;














































Tcl_DBusBus *defaultbus = NULL;
static int initialized = 0;
TCL_DECLARE_MUTEX(dbusMutex)



int Dbus_Init(Tcl_Interp *interp)
{


   if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
      return TCL_ERROR;
   }
   if (Tcl_PkgRequire(interp, "Tcl", "8.5", 0) == NULL) {
      return TCL_ERROR;
   }

   Tcl_MutexLock(&dbusMutex);
   if (!initialized) {
      Tcl_InitObjHashTable(&bus);


      Tcl_CreateEventSource(DBus_SetupProc, DBus_CheckProc, interp);


      initialized = TRUE;
   }
   Tcl_MutexUnlock(&dbusMutex);

   TclInitDBusCmd(interp);
   /* Provide the historical name for compatibility */
   Tcl_PkgProvide(interp, "dbus-tcl", PACKAGE_VERSION);
   return Tcl_PkgProvide(interp, PACKAGE_NAME, PACKAGE_VERSION);
}



















Tcl_DBusBus *DBus_GetConnection(Tcl_Interp *interp, Tcl_Obj *const name)
{

   Tcl_HashEntry *entry;
   Tcl_DBusBus *dbus;



   entry = Tcl_FindHashEntry(&bus, (char *) name);
   if (entry == NULL) return NULL;
   dbus = (Tcl_DBusBus *) Tcl_GetHashValue(entry);
   entry = Tcl_FindHashEntry(dbus->snoop, (char *) interp);
   if (entry != NULL)
     return dbus;
   else
     return NULL;
................................................................................
   if (master == NULL) return "";
   Tcl_GetInterpPath(master, interp);
   return (Tcl_GetStringResult(master));
}

void DBus_Disconnect(Tcl_Interp *interp, Tcl_HashEntry *busPtr)
{

   Tcl_DBusBus *data;
   Tcl_HashEntry *hPtr;
   Tcl_DBusMonitorData *snoop;
  
   data = Tcl_GetHashValue(busPtr);
   /* Find all paths with handlers registered by the interp */
   DBus_InterpCleanup(interp, data->conn, "/");
   /* Find all handlers of the interp without a path */
   if (data->fallback != NULL) {
      if (DBus_HandlerCleanup(interp, data->fallback)) {
	 ckfree((char *)data->fallback);
................................................................................
      if (Tcl_CheckHashEmpty(data->snoop)) {
	 /* Last interpreter that was connected to the dbus */
	 Tcl_DeleteHashTable(data->snoop);
	 ckfree((char *) data->snoop);
	 if (data->type == N_BUS_TYPES)
	   dbus_connection_unref(data->conn);
	 ckfree((char *) data);
	 if (defaultbus == data) defaultbus = NULL;
	 Tcl_DeleteHashEntry(busPtr);
      }
   }
}

void DBus_InterpDelete(ClientData clientData, Tcl_Interp *interp)
{
   DBus_Disconnect(interp, (Tcl_HashEntry *) clientData);
}


|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
<
|
>
>


>
>







|
|
|
>
>
|
>
>
|

<
>





>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>



>



>
>
|







 







>



|







 







|









1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51

52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75

76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
...
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
...
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
#include "dbustcl.h"

#define TCL_TSD_INIT(keyPtr) \
  (Tcl_DBusThreadData *)Tcl_GetThreadData((keyPtr), sizeof(Tcl_DBusThreadData))

static Tcl_ThreadDataKey dataKey;

static void Dbus_ThreadExit(ClientData data)
{
   Tcl_DBusThreadData *tsdPtr = (Tcl_DBusThreadData *) data;
   Tcl_HashSearch search, search2;
   Tcl_HashEntry *hPtr, *hPtr2;
   Tcl_DBusBus *dbus;
   Tcl_DBusMonitorData *snoop;
#ifndef _WIN32
   int fd;
#endif

   if (tsdPtr->initialized) {
#ifdef _WIN32
      Tcl_DeleteEventSource(DBus_SetupProc, DBus_CheckProc, tsdPtr);
#endif
      hPtr = Tcl_FirstHashEntry(&tsdPtr->bus, &search);
      while (hPtr != NULL) {
	 dbus = (Tcl_DBusBus *) Tcl_GetHashValue(hPtr);
	 hPtr2 = Tcl_FirstHashEntry(dbus->snoop, &search2);
	 while (hPtr2 != NULL) {
	    snoop = Tcl_GetHashValue(hPtr2);
	    if (snoop != NULL) {
	       dbus_connection_remove_filter(dbus->conn, DBus_Monitor, snoop);
	       Tcl_DecrRefCount(snoop->script);
	       ckfree((char *) snoop);
	    }
	    Tcl_DeleteHashEntry(hPtr2);
	    hPtr2 = Tcl_NextHashEntry(&search2);
	 }
	 Tcl_DeleteHashTable(dbus->snoop);
	 ckfree((char *) dbus->snoop);
#ifndef _WIN32
	 if (dbus_connection_get_unix_fd(dbus->conn, &fd) && (fd >= 0))
	   Tcl_DeleteFileHandler(fd);
#endif
	 if (dbus->type == N_BUS_TYPES)
	   dbus_connection_unref(dbus->conn);
	 ckfree((char *) dbus);
	 Tcl_DeleteHashEntry(hPtr);
	 hPtr = Tcl_NextHashEntry(&search);
      }
      Tcl_DeleteHashTable(&tsdPtr->bus);
      tsdPtr->defaultbus = NULL;
      tsdPtr->initialized = FALSE;

   }
}

int Dbus_Init(Tcl_Interp *interp)
{
   Tcl_DBusThreadData *tsdPtr;

   if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
      return TCL_ERROR;
   }
   if (Tcl_PkgRequire(interp, "Tcl", "8.5", 0) == NULL) {
      return TCL_ERROR;
   }

   tsdPtr = TCL_TSD_INIT(&dataKey);
   if (!tsdPtr->initialized) {
      Tcl_InitObjHashTable(&tsdPtr->bus);
      tsdPtr->defaultbus = NULL;
#ifdef _WIN32
      Tcl_CreateEventSource(DBus_SetupProc, DBus_CheckProc, tsdPtr);
#endif
      Tcl_CreateThreadExitHandler(Dbus_ThreadExit, tsdPtr);
      tsdPtr->initialized = TRUE;
   }


   TclInitDBusCmd(interp);
   /* Provide the historical name for compatibility */
   Tcl_PkgProvide(interp, "dbus-tcl", PACKAGE_VERSION);
   return Tcl_PkgProvide(interp, PACKAGE_NAME, PACKAGE_VERSION);
}

Tcl_DBusThreadData *DBus_GetThreadData(void)
{
   Tcl_DBusThreadData *tsdPtr = TCL_TSD_INIT(&dataKey);

   if (!tsdPtr->initialized)
     return NULL;
   return tsdPtr;
}

Tcl_DBusBus *DBus_GetDefaultBus(void)
{
   Tcl_DBusThreadData *tsdPtr = TCL_TSD_INIT(&dataKey);

   if (!tsdPtr->initialized)
     return NULL;
   return tsdPtr->defaultbus;
}

Tcl_DBusBus *DBus_GetConnection(Tcl_Interp *interp, Tcl_Obj *const name)
{
   Tcl_DBusThreadData *tsdPtr = TCL_TSD_INIT(&dataKey);
   Tcl_HashEntry *entry;
   Tcl_DBusBus *dbus;

   if (!tsdPtr->initialized)
     return NULL;
   entry = Tcl_FindHashEntry(&tsdPtr->bus, (char *) name);
   if (entry == NULL) return NULL;
   dbus = (Tcl_DBusBus *) Tcl_GetHashValue(entry);
   entry = Tcl_FindHashEntry(dbus->snoop, (char *) interp);
   if (entry != NULL)
     return dbus;
   else
     return NULL;
................................................................................
   if (master == NULL) return "";
   Tcl_GetInterpPath(master, interp);
   return (Tcl_GetStringResult(master));
}

void DBus_Disconnect(Tcl_Interp *interp, Tcl_HashEntry *busPtr)
{
   Tcl_DBusThreadData *tsdPtr = DBus_GetThreadData();
   Tcl_DBusBus *data;
   Tcl_HashEntry *hPtr;
   Tcl_DBusMonitorData *snoop;

   data = Tcl_GetHashValue(busPtr);
   /* Find all paths with handlers registered by the interp */
   DBus_InterpCleanup(interp, data->conn, "/");
   /* Find all handlers of the interp without a path */
   if (data->fallback != NULL) {
      if (DBus_HandlerCleanup(interp, data->fallback)) {
	 ckfree((char *)data->fallback);
................................................................................
      if (Tcl_CheckHashEmpty(data->snoop)) {
	 /* Last interpreter that was connected to the dbus */
	 Tcl_DeleteHashTable(data->snoop);
	 ckfree((char *) data->snoop);
	 if (data->type == N_BUS_TYPES)
	   dbus_connection_unref(data->conn);
	 ckfree((char *) data);
	 if (tsdPtr->defaultbus == data) tsdPtr->defaultbus = NULL;
	 Tcl_DeleteHashEntry(busPtr);
      }
   }
}

void DBus_InterpDelete(ClientData clientData, Tcl_Interp *interp)
{
   DBus_Disconnect(interp, (Tcl_HashEntry *) clientData);
}

Changes to undroid/dbus/dbus-tcl/dbusMessage.c.

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
..
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
...
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
...
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
...
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
...
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
...
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
...
344
345
346
347
348
349
350

351

352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
...
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
...
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
...
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
...
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
...
565
566
567
568
569
570
571

572

573
574
575
576
577
578
579
...
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
...
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
...
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
...
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
...
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
...
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
...
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
...
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
...
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
...
928
929
930
931
932
933
934
935
936
937
938

#ifndef DBUS_TYPE_UNIX_FD
#define DBUS_TYPE_UNIX_FD ((int) 'h')
#endif

/*
 *----------------------------------------------------------------------
 * 
 * DBus_MessageInfo --
 * 
 * 	Creates a dict with interesting information about a dbus message.
 * 
 * Results:
 * 	Returns a dict.
 * 
 * Side effects:
 * 	None.
 * 
 *----------------------------------------------------------------------
 */

Tcl_Obj *DBus_MessageInfo(Tcl_Interp *interp, DBusMessage *msg)
{
   Tcl_Obj *info;
   int type;
   
   info = Tcl_NewDictObj();
   /* Get the interface member being invoked or emitted */
   Tcl_DictObjPut(interp, info, Tcl_NewStringObj("member", -1),
		  Tcl_NewStringObj(dbus_message_get_member(msg), -1));
   /* Get the interface the message is being sent to or emitted from */
   Tcl_DictObjPut(interp, info, Tcl_NewStringObj("interface", -1),
		  Tcl_NewStringObj(dbus_message_get_interface(msg), -1));
................................................................................
   Tcl_DictObjPut(interp, info, Tcl_NewStringObj("errorname", -1),
		  Tcl_NewStringObj(dbus_message_get_error_name(msg), -1));
   return info;
}

/*
 *----------------------------------------------------------------------
 * 
 * DBus_IterList --
 * 
 *	Converts a dbus return value or message parameters into a (nested)
 *	Tcl list.
 * 
 * Returns:
 *	A list representing the dbus message parameters or return value.
 * 
 * Side effects:
 * 	None.
 * 
 *----------------------------------------------------------------------
 */

Tcl_Obj *DBus_IterList(Tcl_Interp *interp, DBusMessageIter *iter, int details)
{
   DBusMessageIter sub;
   Tcl_Obj *list, *str, *variant, *sublist;
   DBus_Value value;
   Tcl_Channel chan;
   
   list = Tcl_NewObj();
   do
     switch (dbus_message_iter_get_arg_type(iter)) {
      case DBUS_TYPE_STRING:
      case DBUS_TYPE_OBJECT_PATH:
      case DBUS_TYPE_SIGNATURE:
	dbus_message_iter_get_basic(iter, &value.str);
................................................................................
	/* This may be done more efficiently using something like:
	dbus_message_iter_recurse(iter, &sub);
	if (dbus_type_is_fixed(&sub)) {
	   dbus_message_iter_get_element_type(&sub);
	   dbus_message_iter_get_fixed_array(&sub, &array, 32);
	} */
	dbus_message_iter_recurse(iter, &sub);
	Tcl_ListObjAppendElement(interp, list, 
				 DBus_IterList(interp, &sub, details));
	break;
	
      case DBUS_TYPE_VARIANT:
	dbus_message_iter_recurse(iter, &sub);
	if (details) {
	   variant = Tcl_NewObj();
................................................................................
	   Tcl_RegisterChannel(interp, chan);
	   str = Tcl_NewStringObj(Tcl_GetChannelName(chan), -1);
	} else {
	   str = Tcl_NewStringObj("NULL", 4);
	}
	Tcl_ListObjAppendElement(interp, list, str);
	break;
	 
     }
   while (dbus_message_iter_next(iter));
   return list;
}

/*
 *----------------------------------------------------------------------
 * 
 * DBus_AppendArgs
 *      Append arguments according to the specified signature or as strings
 *      if signature is NULL.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *      Interpreter value is set to error text in case of error occured
 * 
 *----------------------------------------------------------------------
 */

int DBus_AppendArgs (Tcl_Interp *interp, DBusConnection *conn,
        DBusMessage *msg, const char *signature, int objc,
        Tcl_Obj *const objv[])
{
................................................................................
      }
   }
   return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 * 
 * DBus_SendMessage
 *	Send message with specified type, interface, name, replySerial and
 *      signature to destination.
 *
 *      This is a wrapper for dbus_message_new(), dbus_message_set_*()
 *      and dbus_connection_send() methods from dbus.h.
 *
................................................................................
 *      objv        Array of message parameters
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *      Interpreter value is set to error text in case an error occured
 * 
 *----------------------------------------------------------------------
 */

int DBus_SendMessage(Tcl_Interp *interp, DBusConnection *conn,
        int type, const char *path, const char *intf,
        const char *name, const char *destination,
        dbus_uint32_t replySerial, const char *signature,
................................................................................
			"Unable to create D-Bus message", -1));
      return TCL_ERROR;
   }
   dbus_message_set_no_reply(msg, TRUE);

   if ((type == DBUS_MESSAGE_TYPE_ERROR) && (name == NULL))
     name = DBUS_ERROR_FAILED;
      
   /* set message parameters */
   if (!dbus_message_set_path(msg, path) ||
       !dbus_message_set_interface(msg, intf) ||
       !(type != DBUS_MESSAGE_TYPE_SIGNAL ||
	 dbus_message_set_member(msg, name)) ||
       !(type != DBUS_MESSAGE_TYPE_ERROR ||
	 dbus_message_set_error_name(msg, name)) ||
................................................................................
   }

   /* send the message and flush the connection */
   if (!dbus_connection_send(conn, msg, &serial)) {
      dbus_message_unref(msg);
      return DBus_MemoryError(interp);
   }

   dbus_connection_flush(conn);

   dbus_message_unref(msg);
   Tcl_SetObjResult(interp, Tcl_NewIntObj(serial));
   return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 * 
 * DBus_Error
 *	Send a error message onto the dbus.
 *
 * Arguments:
 *      interp      Tcl interpreter instance
 *      conn        D-Bus connection
 *	name	    Error name (default: org.freedesktop.DBus.Error.Failed)
................................................................................
 *      message     Error message
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *      Interpreter value is set to error text in case of error occured
 * 
 *----------------------------------------------------------------------
 */

int DBus_Error (Tcl_Interp *interp, DBusConnection *conn,
        const char *name, const char *destination,
	dbus_uint32_t replySerial, const char *message)
{
................................................................................
      Tcl_DecrRefCount(msg);
   }
   return res;
}

/*
 *----------------------------------------------------------------------
 * 
 * DBusCallCmd
 *	This procedure is invoked to process the "dbus call" Tcl command.
 *	It sends a method call onto the dbus and optionally waits for a
 *	reply.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 * 	The result value of the interpreter is set depending on the
 *	specified options.
 * 
 *----------------------------------------------------------------------
 */

int DBusCallCmd(ClientData dummy, Tcl_Interp *interp,
	int objc, Tcl_Obj *const objv[])
{
   Tcl_DBusBus *dbus = defaultbus;
   DBusMessage *msg;
   DBusMessageIter iter;
   DBusPendingCall *pending;
   DBusError err;
   Tcl_Obj *tmp, *result, *handler = NULL;
   Tcl_CallData *dataPtr;
   int index, timeout = -1, x = 1, autostart = 1, details = 0;
................................................................................
	 if (timeout < 0) timeout = -2;
	 break;
       case DBUS_LAST:
	 /* Silence compiler warning. This can never happen */
	 break;
      }
   }
   
   if (x > objc - 3) {
      Tcl_WrongNumArgs(interp, 1, objv, 
		       "?option value ...? path interface method ?arg ...?");
      return TCL_ERROR;
   }
   if (!DBus_CheckPath(objv[x])) {
      Tcl_SetObjResult(interp, Tcl_NewStringObj("Invalid path", -1));
      return TCL_ERROR;
   }
................................................................................
   }

   msg = dbus_message_new_method_call(dest, Tcl_GetString(objv[x]),
				      Tcl_GetString(objv[x+1]),
				      Tcl_GetString(objv[x+2]));
   x += 3;
   dbus_message_set_auto_start(msg, autostart);
   
   if ((DBus_AppendArgs(interp, dbus->conn,
		msg, signature, objc - x, objv + x)) != TCL_OK) {
       dbus_message_unref(msg);
       return TCL_ERROR;
   }

   /* initialise the dbus error structure */
................................................................................

   if (timeout < -1) {
      /* Indicate we are not interested in a reply */
      dbus_message_set_no_reply(msg, TRUE);
      /* send the message and flush the connection */
      if (!dbus_connection_send(dbus->conn, msg, &serial))
	return DBus_MemoryError(interp);

      dbus_connection_flush(dbus->conn);

      dbus_message_unref(msg);
      Tcl_SetObjResult(interp, Tcl_NewIntObj(serial));
      return TCL_OK;
   }
   /* send message and get a handle for a reply */
   if (!dbus_connection_send_with_reply(dbus->conn, msg, &pending, timeout)) {
      dbus_message_unref(msg);
................................................................................
   }
   if (pending == NULL) {
      dbus_message_unref(msg);
      Tcl_SetObjResult(interp, Tcl_NewStringObj("Disconnected", -1));
      return TCL_ERROR;
   }
   dbus_connection_flush(dbus->conn);
   
   if (handler != NULL) {
      dataPtr = (Tcl_CallData *) ckalloc(sizeof(Tcl_DBusHandlerData));
      dataPtr->tid = Tcl_GetCurrentThread();
      dataPtr->interp = interp;
      dataPtr->conn = dbus->conn;
      dataPtr->script = handler;
      dataPtr->flags = details ? DBUSFLAG_DETAILS : 0;
      /* Make sure the script doesn't get freed prematurely */
      Tcl_IncrRefCount(handler);
      if (!dbus_pending_call_set_notify(pending, DBus_CallResult,
................................................................................
      dbus_message_unref(msg);
      return TCL_OK;
   }
}

/*
 *----------------------------------------------------------------------
 * 
 * DBusSignalCmd
 *	Send a signal onto the dbus.
 *
 * Arguments:
 *      busId(optional)     Bus handle
 *      signature(optional) Types of of arguments to be sent on the bus.
 *                          If not set, all arguments will be passed as
................................................................................
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	The result value of the interpreter is set to the serial number of
 *	the dbus message. If an error occurs the result value contains the
 *	error message.
 * 
 *----------------------------------------------------------------------
 */

int DBusSignalCmd(ClientData dummy, Tcl_Interp *interp,
	int objc, Tcl_Obj *const objv[])
{
   Tcl_DBusBus *dbus = defaultbus;
   int index, x = 1;
   char *signature = NULL;
   char *str, *object, *intf, *name;
   static const char *options[] = {
      "-signature", NULL
   };
   enum options {
      DBUS_SIGNATURE
   };
      
   if (objc > 4) {
      str = Tcl_GetString(objv[x]);
      /* Options start with '-', path starts with '/' */
      /* Anything else has to be a busId specification */
      if (*str != '-' && *str != '/') {
	 if (DBus_BusType(interp, objv[x]) < 0) return TCL_ERROR;
	 dbus = DBus_GetConnection(interp, objv[x]);
................................................................................
	       Tcl_AppendResult(interp, "Invalid type signature", NULL);
	       return TCL_ERROR;
	    }
	    x++;
	 }
      }
   }
   
   if (objc < x + 3) {
      Tcl_WrongNumArgs(interp, 1, objv, 
          "?busId? ?-signature string? path interface name ?arg ...?");
      return TCL_ERROR;
   }
   
   if (dbus == NULL) {
      Tcl_SetObjResult(interp, Tcl_NewStringObj("Not connected", -1));
      return TCL_ERROR;
   }

   if (!DBus_CheckPath(objv[x])) {
      Tcl_SetObjResult(interp, Tcl_NewStringObj("Invalid path", -1));
................................................................................
   name = Tcl_GetString(objv[x++]);
   return DBus_SendMessage(interp, dbus->conn, DBUS_MESSAGE_TYPE_SIGNAL,
	   object, intf, name, NULL, 0, signature, objc-x, objv+x);
}

/*
 *----------------------------------------------------------------------
 * 
 * DBusMethodReturnCmd
 *	Send a method return message onto the dbus.
 *
 * Arguments:
 *      busId(optional)     Bus handle
 *      signature(optional) Types of of arguments to be sent on the bus.
 *                          If not set, all arguments will be passed as
................................................................................
 *      arg ...             Method call results
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *      Interpreter value is set to error text in case of error occured
 * 
 *----------------------------------------------------------------------
 */

int DBusMethodReturnCmd(ClientData dummy, Tcl_Interp *interp,
	int objc, Tcl_Obj *const objv[])
{
   Tcl_DBusBus *dbus = defaultbus;
   int replySerial, index, x = 1;
   char *str, *destination, *signature = NULL;
   static const char *options[] = {
      "-signature", NULL
   };
   enum options {
      DBUS_SIGNATURE
   };
   
   if (objc > 3) {
      str = Tcl_GetString(objv[x]);
      /* Options start with '-', dest starts with ':' */
      /* Anything else has to be a busId specification */
      if (*str != '-' && *str != ':') {
	 if (DBus_BusType(interp, objv[x]) < 0) return TCL_ERROR;
	 dbus = DBus_GetConnection(interp, objv[x]);
................................................................................
      }
   }
   if (objc < x + 2) {
      Tcl_WrongNumArgs(interp, 1, objv,
          "?busId? ?-signature string? destination serial ?arg ...?");
      return TCL_ERROR;
   }
   
   if (dbus == NULL) {
      Tcl_SetObjResult(interp, Tcl_NewStringObj("Not connected", -1));
      return TCL_ERROR;
   }
   if (Tcl_GetIntFromObj(interp, objv[x+1], &replySerial) != TCL_OK) {
      Tcl_SetObjResult(interp, Tcl_NewStringObj("Invalid serial", -1));
      return TCL_ERROR;
................................................................................
   return DBus_SendMessage(interp, dbus->conn, DBUS_MESSAGE_TYPE_METHOD_RETURN,
           NULL, NULL, NULL, destination, replySerial, signature,
           objc-x, objv+x);
}

/*
 *----------------------------------------------------------------------
 * 
 * DBusErrorCmd
 *	Send a error message onto the dbus.
 *
 * Arguments:
 *      busId(optional)     Bus handle
 *      dest                Destination of a method caller
 *      serial              Method call message serial
................................................................................
 *      message             Error message (optional)
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *      Interpreter value is set to error text in case of error occured
 * 
 *----------------------------------------------------------------------
 */

int DBusErrorCmd(ClientData dummy, Tcl_Interp *interp,
	int objc, Tcl_Obj *const objv[])
{
   Tcl_DBusBus *dbus = defaultbus;
   int index, x = 1;
   int replySerial;
   char *str, *destination, *errorMessage = NULL, *errorName = NULL;
   static const char *options[] = {
      "-name", NULL
   };
   enum options {
      DBUS_ERRORNAME
   };
   
   if (objc > 3) {
      str = Tcl_GetString(objv[x]);
      /* Options start with '-', dest starts with ':' */
      /* Anything else has to be a busId specification */
      if (*str != '-' && *str != ':') {
	 if (DBus_BusType(interp, objv[x]) < 0) return TCL_ERROR;
	 dbus = DBus_GetConnection(interp, objv[x]);
................................................................................
      Tcl_SetObjResult(interp, Tcl_NewStringObj("Invalid serial", -1));
      return TCL_ERROR;
   }
   x += 2;
   if (objc > x) {
      errorMessage = Tcl_GetString(objv[x]);
   }
   
   return DBus_Error(interp, dbus->conn, errorName,
		     destination, replySerial, errorMessage);
}







|

|

|


|


|







|







 







|

|


|


|


|









|







 







|







 







|







|









|







 







|







 







|







 







|







 







>

>







|







 







|







 







|











|






|







 







|

|







 







|







 







>

>







 







|


<







 







|







 







|






|









|







 







|

|



|







 







|







 







|






|








|







 







|







 







|







 







|






|









|







 







|



2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
..
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
...
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
...
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
...
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
...
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
...
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
...
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
...
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
...
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
...
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
...
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
...
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
...
585
586
587
588
589
590
591
592
593
594

595
596
597
598
599
600
601
...
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
...
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
...
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
...
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
...
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
...
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
...
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
...
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
...
931
932
933
934
935
936
937
938
939
940
941

#ifndef DBUS_TYPE_UNIX_FD
#define DBUS_TYPE_UNIX_FD ((int) 'h')
#endif

/*
 *----------------------------------------------------------------------
 *
 * DBus_MessageInfo --
 *
 * 	Creates a dict with interesting information about a dbus message.
 *
 * Results:
 * 	Returns a dict.
 *
 * Side effects:
 * 	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *DBus_MessageInfo(Tcl_Interp *interp, DBusMessage *msg)
{
   Tcl_Obj *info;
   int type;

   info = Tcl_NewDictObj();
   /* Get the interface member being invoked or emitted */
   Tcl_DictObjPut(interp, info, Tcl_NewStringObj("member", -1),
		  Tcl_NewStringObj(dbus_message_get_member(msg), -1));
   /* Get the interface the message is being sent to or emitted from */
   Tcl_DictObjPut(interp, info, Tcl_NewStringObj("interface", -1),
		  Tcl_NewStringObj(dbus_message_get_interface(msg), -1));
................................................................................
   Tcl_DictObjPut(interp, info, Tcl_NewStringObj("errorname", -1),
		  Tcl_NewStringObj(dbus_message_get_error_name(msg), -1));
   return info;
}

/*
 *----------------------------------------------------------------------
 *
 * DBus_IterList --
 *
 *	Converts a dbus return value or message parameters into a (nested)
 *	Tcl list.
 *
 * Returns:
 *	A list representing the dbus message parameters or return value.
 *
 * Side effects:
 * 	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *DBus_IterList(Tcl_Interp *interp, DBusMessageIter *iter, int details)
{
   DBusMessageIter sub;
   Tcl_Obj *list, *str, *variant, *sublist;
   DBus_Value value;
   Tcl_Channel chan;

   list = Tcl_NewObj();
   do
     switch (dbus_message_iter_get_arg_type(iter)) {
      case DBUS_TYPE_STRING:
      case DBUS_TYPE_OBJECT_PATH:
      case DBUS_TYPE_SIGNATURE:
	dbus_message_iter_get_basic(iter, &value.str);
................................................................................
	/* This may be done more efficiently using something like:
	dbus_message_iter_recurse(iter, &sub);
	if (dbus_type_is_fixed(&sub)) {
	   dbus_message_iter_get_element_type(&sub);
	   dbus_message_iter_get_fixed_array(&sub, &array, 32);
	} */
	dbus_message_iter_recurse(iter, &sub);
	Tcl_ListObjAppendElement(interp, list,
				 DBus_IterList(interp, &sub, details));
	break;
	
      case DBUS_TYPE_VARIANT:
	dbus_message_iter_recurse(iter, &sub);
	if (details) {
	   variant = Tcl_NewObj();
................................................................................
	   Tcl_RegisterChannel(interp, chan);
	   str = Tcl_NewStringObj(Tcl_GetChannelName(chan), -1);
	} else {
	   str = Tcl_NewStringObj("NULL", 4);
	}
	Tcl_ListObjAppendElement(interp, list, str);
	break;

     }
   while (dbus_message_iter_next(iter));
   return list;
}

/*
 *----------------------------------------------------------------------
 *
 * DBus_AppendArgs
 *      Append arguments according to the specified signature or as strings
 *      if signature is NULL.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *      Interpreter value is set to error text in case of error occured
 *
 *----------------------------------------------------------------------
 */

int DBus_AppendArgs (Tcl_Interp *interp, DBusConnection *conn,
        DBusMessage *msg, const char *signature, int objc,
        Tcl_Obj *const objv[])
{
................................................................................
      }
   }
   return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * DBus_SendMessage
 *	Send message with specified type, interface, name, replySerial and
 *      signature to destination.
 *
 *      This is a wrapper for dbus_message_new(), dbus_message_set_*()
 *      and dbus_connection_send() methods from dbus.h.
 *
................................................................................
 *      objv        Array of message parameters
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *      Interpreter value is set to error text in case an error occured
 *
 *----------------------------------------------------------------------
 */

int DBus_SendMessage(Tcl_Interp *interp, DBusConnection *conn,
        int type, const char *path, const char *intf,
        const char *name, const char *destination,
        dbus_uint32_t replySerial, const char *signature,
................................................................................
			"Unable to create D-Bus message", -1));
      return TCL_ERROR;
   }
   dbus_message_set_no_reply(msg, TRUE);

   if ((type == DBUS_MESSAGE_TYPE_ERROR) && (name == NULL))
     name = DBUS_ERROR_FAILED;

   /* set message parameters */
   if (!dbus_message_set_path(msg, path) ||
       !dbus_message_set_interface(msg, intf) ||
       !(type != DBUS_MESSAGE_TYPE_SIGNAL ||
	 dbus_message_set_member(msg, name)) ||
       !(type != DBUS_MESSAGE_TYPE_ERROR ||
	 dbus_message_set_error_name(msg, name)) ||
................................................................................
   }

   /* send the message and flush the connection */
   if (!dbus_connection_send(conn, msg, &serial)) {
      dbus_message_unref(msg);
      return DBus_MemoryError(interp);
   }
#ifdef _WIN32
   dbus_connection_flush(conn);
#endif
   dbus_message_unref(msg);
   Tcl_SetObjResult(interp, Tcl_NewIntObj(serial));
   return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * DBus_Error
 *	Send a error message onto the dbus.
 *
 * Arguments:
 *      interp      Tcl interpreter instance
 *      conn        D-Bus connection
 *	name	    Error name (default: org.freedesktop.DBus.Error.Failed)
................................................................................
 *      message     Error message
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *      Interpreter value is set to error text in case of error occured
 *
 *----------------------------------------------------------------------
 */

int DBus_Error (Tcl_Interp *interp, DBusConnection *conn,
        const char *name, const char *destination,
	dbus_uint32_t replySerial, const char *message)
{
................................................................................
      Tcl_DecrRefCount(msg);
   }
   return res;
}

/*
 *----------------------------------------------------------------------
 *
 * DBusCallCmd
 *	This procedure is invoked to process the "dbus call" Tcl command.
 *	It sends a method call onto the dbus and optionally waits for a
 *	reply.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 * 	The result value of the interpreter is set depending on the
 *	specified options.
 *
 *----------------------------------------------------------------------
 */

int DBusCallCmd(ClientData dummy, Tcl_Interp *interp,
	int objc, Tcl_Obj *const objv[])
{
   Tcl_DBusBus *dbus = DBus_GetDefaultBus();
   DBusMessage *msg;
   DBusMessageIter iter;
   DBusPendingCall *pending;
   DBusError err;
   Tcl_Obj *tmp, *result, *handler = NULL;
   Tcl_CallData *dataPtr;
   int index, timeout = -1, x = 1, autostart = 1, details = 0;
................................................................................
	 if (timeout < 0) timeout = -2;
	 break;
       case DBUS_LAST:
	 /* Silence compiler warning. This can never happen */
	 break;
      }
   }

   if (x > objc - 3) {
      Tcl_WrongNumArgs(interp, 1, objv,
		       "?option value ...? path interface method ?arg ...?");
      return TCL_ERROR;
   }
   if (!DBus_CheckPath(objv[x])) {
      Tcl_SetObjResult(interp, Tcl_NewStringObj("Invalid path", -1));
      return TCL_ERROR;
   }
................................................................................
   }

   msg = dbus_message_new_method_call(dest, Tcl_GetString(objv[x]),
				      Tcl_GetString(objv[x+1]),
				      Tcl_GetString(objv[x+2]));
   x += 3;
   dbus_message_set_auto_start(msg, autostart);

   if ((DBus_AppendArgs(interp, dbus->conn,
		msg, signature, objc - x, objv + x)) != TCL_OK) {
       dbus_message_unref(msg);
       return TCL_ERROR;
   }

   /* initialise the dbus error structure */
................................................................................

   if (timeout < -1) {
      /* Indicate we are not interested in a reply */
      dbus_message_set_no_reply(msg, TRUE);
      /* send the message and flush the connection */
      if (!dbus_connection_send(dbus->conn, msg, &serial))
	return DBus_MemoryError(interp);
#ifdef _WIN32
      dbus_connection_flush(dbus->conn);
#endif
      dbus_message_unref(msg);
      Tcl_SetObjResult(interp, Tcl_NewIntObj(serial));
      return TCL_OK;
   }
   /* send message and get a handle for a reply */
   if (!dbus_connection_send_with_reply(dbus->conn, msg, &pending, timeout)) {
      dbus_message_unref(msg);
................................................................................
   }
   if (pending == NULL) {
      dbus_message_unref(msg);
      Tcl_SetObjResult(interp, Tcl_NewStringObj("Disconnected", -1));
      return TCL_ERROR;
   }
   dbus_connection_flush(dbus->conn);

   if (handler != NULL) {
      dataPtr = (Tcl_CallData *) ckalloc(sizeof(Tcl_DBusHandlerData));

      dataPtr->interp = interp;
      dataPtr->conn = dbus->conn;
      dataPtr->script = handler;
      dataPtr->flags = details ? DBUSFLAG_DETAILS : 0;
      /* Make sure the script doesn't get freed prematurely */
      Tcl_IncrRefCount(handler);
      if (!dbus_pending_call_set_notify(pending, DBus_CallResult,
................................................................................
      dbus_message_unref(msg);
      return TCL_OK;
   }
}

/*
 *----------------------------------------------------------------------
 *
 * DBusSignalCmd
 *	Send a signal onto the dbus.
 *
 * Arguments:
 *      busId(optional)     Bus handle
 *      signature(optional) Types of of arguments to be sent on the bus.
 *                          If not set, all arguments will be passed as
................................................................................
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	The result value of the interpreter is set to the serial number of
 *	the dbus message. If an error occurs the result value contains the
 *	error message.
 *
 *----------------------------------------------------------------------
 */

int DBusSignalCmd(ClientData dummy, Tcl_Interp *interp,
	int objc, Tcl_Obj *const objv[])
{
   Tcl_DBusBus *dbus = DBus_GetDefaultBus();
   int index, x = 1;
   char *signature = NULL;
   char *str, *object, *intf, *name;
   static const char *options[] = {
      "-signature", NULL
   };
   enum options {
      DBUS_SIGNATURE
   };

   if (objc > 4) {
      str = Tcl_GetString(objv[x]);
      /* Options start with '-', path starts with '/' */
      /* Anything else has to be a busId specification */
      if (*str != '-' && *str != '/') {
	 if (DBus_BusType(interp, objv[x]) < 0) return TCL_ERROR;
	 dbus = DBus_GetConnection(interp, objv[x]);
................................................................................
	       Tcl_AppendResult(interp, "Invalid type signature", NULL);
	       return TCL_ERROR;
	    }
	    x++;
	 }
      }
   }

   if (objc < x + 3) {
      Tcl_WrongNumArgs(interp, 1, objv,
          "?busId? ?-signature string? path interface name ?arg ...?");
      return TCL_ERROR;
   }

   if (dbus == NULL) {
      Tcl_SetObjResult(interp, Tcl_NewStringObj("Not connected", -1));
      return TCL_ERROR;
   }

   if (!DBus_CheckPath(objv[x])) {
      Tcl_SetObjResult(interp, Tcl_NewStringObj("Invalid path", -1));
................................................................................
   name = Tcl_GetString(objv[x++]);
   return DBus_SendMessage(interp, dbus->conn, DBUS_MESSAGE_TYPE_SIGNAL,
	   object, intf, name, NULL, 0, signature, objc-x, objv+x);
}

/*
 *----------------------------------------------------------------------
 *
 * DBusMethodReturnCmd
 *	Send a method return message onto the dbus.
 *
 * Arguments:
 *      busId(optional)     Bus handle
 *      signature(optional) Types of of arguments to be sent on the bus.
 *                          If not set, all arguments will be passed as
................................................................................
 *      arg ...             Method call results
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *      Interpreter value is set to error text in case of error occured
 *
 *----------------------------------------------------------------------
 */

int DBusMethodReturnCmd(ClientData dummy, Tcl_Interp *interp,
	int objc, Tcl_Obj *const objv[])
{
   Tcl_DBusBus *dbus = DBus_GetDefaultBus();
   int replySerial, index, x = 1;
   char *str, *destination, *signature = NULL;
   static const char *options[] = {
      "-signature", NULL
   };
   enum options {
      DBUS_SIGNATURE
   };

   if (objc > 3) {
      str = Tcl_GetString(objv[x]);
      /* Options start with '-', dest starts with ':' */
      /* Anything else has to be a busId specification */
      if (*str != '-' && *str != ':') {
	 if (DBus_BusType(interp, objv[x]) < 0) return TCL_ERROR;
	 dbus = DBus_GetConnection(interp, objv[x]);
................................................................................
      }
   }
   if (objc < x + 2) {
      Tcl_WrongNumArgs(interp, 1, objv,
          "?busId? ?-signature string? destination serial ?arg ...?");
      return TCL_ERROR;
   }

   if (dbus == NULL) {
      Tcl_SetObjResult(interp, Tcl_NewStringObj("Not connected", -1));
      return TCL_ERROR;
   }
   if (Tcl_GetIntFromObj(interp, objv[x+1], &replySerial) != TCL_OK) {
      Tcl_SetObjResult(interp, Tcl_NewStringObj("Invalid serial", -1));
      return TCL_ERROR;
................................................................................
   return DBus_SendMessage(interp, dbus->conn, DBUS_MESSAGE_TYPE_METHOD_RETURN,
           NULL, NULL, NULL, destination, replySerial, signature,
           objc-x, objv+x);
}

/*
 *----------------------------------------------------------------------
 *
 * DBusErrorCmd
 *	Send a error message onto the dbus.
 *
 * Arguments:
 *      busId(optional)     Bus handle
 *      dest                Destination of a method caller
 *      serial              Method call message serial
................................................................................
 *      message             Error message (optional)
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *      Interpreter value is set to error text in case of error occured
 *
 *----------------------------------------------------------------------
 */

int DBusErrorCmd(ClientData dummy, Tcl_Interp *interp,
	int objc, Tcl_Obj *const objv[])
{
   Tcl_DBusBus *dbus = DBus_GetDefaultBus();
   int index, x = 1;
   int replySerial;
   char *str, *destination, *errorMessage = NULL, *errorName = NULL;
   static const char *options[] = {
      "-name", NULL
   };
   enum options {
      DBUS_ERRORNAME
   };

   if (objc > 3) {
      str = Tcl_GetString(objv[x]);
      /* Options start with '-', dest starts with ':' */
      /* Anything else has to be a busId specification */
      if (*str != '-' && *str != ':') {
	 if (DBus_BusType(interp, objv[x]) < 0) return TCL_ERROR;
	 dbus = DBus_GetConnection(interp, objv[x]);
................................................................................
      Tcl_SetObjResult(interp, Tcl_NewStringObj("Invalid serial", -1));
      return TCL_ERROR;
   }
   x += 2;
   if (objc > x) {
      errorMessage = Tcl_GetString(objv[x]);
   }

   return DBus_Error(interp, dbus->conn, errorName,
		     destination, replySerial, errorMessage);
}

Changes to undroid/dbus/dbus-tcl/dbusSignature.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
..
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
..
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
...
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
...
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
...
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
...
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
...
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
...
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
...
457
458
459
460
461
462
463
464
465
466
467
468
469
470
/*
 * Signature parsing routines. These five functions build up the arguments
 * of a dbus message from Tcl objects based on a provided signature. Due to
 * the nested nature of signatures, these functions may recursively call
 * eachother.
 * 
 * The main entry point is DBus_ArgList. It repeatedly calls DBus_Argument
 * to add arguments to the message. DBus_Argument in turn may call
 * DBus_ArgList again to add embedded structure arguments. For the basic
 * argument types DBus_Argument calls DBus_BasicArg. Array arguments are
 * handled by DBus_ArrayArg which repeatedly calls DBus_Argument again for
 * the array elements, unless it's an array of dict entries in which case
 * DBus_DictArg is called to process the complete dict. DBus_DictArg
................................................................................
	DBusMessageIter *iter, DBusSignatureIter *sig,
	int argtype, Tcl_Obj *const arg);
static int DBus_DictArg(Tcl_Interp *interp, DBusConnection *conn,
	DBusMessageIter *iter, DBusSignatureIter *sig, Tcl_Obj *const arg);

/*
 *----------------------------------------------------------------------
 * 
 * DBus_ArgList --
 * 
 * 	Add a Tcl list as a structure argument to a DBus message
 * 
 * Results:
 * 	TCL_ERROR if errors were encountered, TCL_OK otherwise.
 * 
 * Side effects:
 * 	Pointers in DBusMessageIter and DBusSignatureIter are advanced
 * 	passed the processed part of the signature. The len variable is
 * 	decremented by the number of Tcl_Objs handled. In case of an
 * 	error, the interp Result variable contains a problem description.
 * 
 *----------------------------------------------------------------------
 */

int DBus_ArgList(Tcl_Interp *interp, DBusConnection *conn,
		 DBusMessageIter *iter, DBusSignatureIter *sig,
		 int* len, Tcl_Obj *const arg[])
{
................................................................................
   int c;

   while (*len > 0) {
      c = dbus_signature_iter_get_current_type(sig);
      if (DBus_Argument(interp, conn, iter, sig, c, *arg) != TCL_OK)
	return TCL_ERROR;
      ++arg; --*len;
      if (c == DBUS_TYPE_INVALID || 
	  (!dbus_signature_iter_next(sig) && *len > 0)) {
	 Tcl_AppendResult(interp, "Arguments left after exhausting "
			  "the type signature", NULL);
	 return TCL_ERROR;
      }
   }
   return TCL_OK;
}

/* 
 *----------------------------------------------------------------------
 * 
 * DBus_BasicArg --
 * 
 * 	Add a Tcl_Obj as a basic argument to a DBus message
 * 
 * Results:
 * 	TCL_ERROR if errors were encountered, TCL_OK otherwise.
 * 
 * Side effects:
 * 	Pointer of DBusMessageIter is advanced passed the added argument.
 * 	In case of error, the interp Result variable contains a problem
 * 	description.
 * 
 *----------------------------------------------------------------------
 */

int DBus_BasicArg(Tcl_Interp *interp, DBusMessageIter *iter, 
	int type, Tcl_Obj *const arg)
{
   DBus_Value value;
   int mode;
   Tcl_Channel chan;
   Tcl_DString ds;
   Tcl_Encoding encoding;
................................................................................
       }
       if (type == DBUS_TYPE_SIGNATURE && !DBus_CheckSignature(arg)) {
	   Tcl_AppendResult(interp, "Invalid signature", NULL);
	   return TCL_ERROR;
       }
       /* Fall through to DBUS_TYPE_STRING */
    case DBUS_TYPE_STRING:
      /* 
       * Need to convert from internal representation to real utf-8 because
       * the dbus library will crash on Tcl's \0 character (0xc080). After
       * conversion, the string will end at the first \0 (dbus doesn't allow
       * \0 in strings).
       */
      str = Tcl_GetStringFromObj(arg, &length);
      /* The utf-8 encoding is guaranteed to exist, so no checks are needed */
................................................................................
      }
      dbus_message_iter_append_basic(iter, DBUS_TYPE_UNIX_FD, &value.fd);
      break;
   }
   return TCL_OK;
}

/* 
 *----------------------------------------------------------------------
 * 
 * DBus_ArrayArg --
 * 
 * 	Add a Tcl list or dict as an array argument to a DBus message
 * 
 * Results:
 * 	TCL_ERROR if errors were encountered, TCL_OK otherwise.
 * 
 * Side effects:
 * 	Pointers in DBusMessageIter and DBusSignatureIter are advanced
 * 	passed the processed part of the signature. In case of an error,
 * 	the interp Result variable contains a problem description.
 * 
 *----------------------------------------------------------------------
 */

static int DBus_ArrayArg(Tcl_Interp *interp, DBusConnection *conn,
			 DBusMessageIter *iter, DBusSignatureIter *sig,
			 Tcl_Obj *const arg)
{
   int objc, c;
   Tcl_Obj **objv;
   DBusSignatureIter sigsub;
   
   c = dbus_signature_iter_get_current_type(sig);
   if (c != DBUS_TYPE_DICT_ENTRY) {
      if (Tcl_ListObjGetElements(interp, arg, &objc, &objv) != TCL_OK)
	return TCL_ERROR;
      while (objc > 0) {
	 if (DBus_Argument(interp, conn, iter, sig, c, *objv) != TCL_OK)
	   return TCL_ERROR;
................................................................................
      dbus_signature_iter_recurse(sig, &sigsub);
      if (DBus_DictArg(interp, conn, iter, &sigsub, arg))
	return TCL_ERROR;
   }
   return TCL_OK;
}

/* 
 *----------------------------------------------------------------------
 * 
 * DBus_DictArg --
 * 
 * 	Add a dict as an array of dictentry arguments to a DBus message
 * 
 * Results:
 * 	TCL_ERROR if errors were encountered, TCL_OK otherwise.
 * 
 * Side effects:
 * 	Pointers in DBusMessageIter and DBusSignatureIter are advanced
 * 	passed the processed part of the signature. In case of an error,
 * 	the interp Result variable contains a problem description.
 * 
 *----------------------------------------------------------------------
 */

static int DBus_DictArg(Tcl_Interp *interp, DBusConnection *conn,
			DBusMessageIter *iter, DBusSignatureIter *sig,
			Tcl_Obj *const arg)
{
   int keytype, valtype, done;
   Tcl_Obj *key, *val;
   Tcl_DictSearch search;
   DBusMessageIter msgsub;
   
   keytype = dbus_signature_iter_get_current_type(sig);
   dbus_signature_iter_next(sig);
   valtype = dbus_signature_iter_get_current_type(sig);
   if (Tcl_DictObjFirst(interp, arg, &search, &key, &val, &done) != TCL_OK)
     return TCL_ERROR;
   for (; !done; Tcl_DictObjNext(&search, &key, &val, &done)) {
      dbus_message_iter_open_container(iter, DBUS_TYPE_DICT_ENTRY, NULL, &msgsub);
................................................................................
      dbus_message_iter_close_container(iter, &msgsub);
   }
   Tcl_DictObjDone(&search);
   if (!done) return TCL_ERROR;
   return TCL_OK;
}

/* 
 *----------------------------------------------------------------------
 * 
 * DBus_VariantArg --
 * 
 * 	Adds a variant argument to a DBus message by autodetecting the
 *	type of the provided variable
 * 
 * Results:
 * 	TCL_ERROR if errors were encountered, TCL_OK otherwise.
 * 
 * Side effects:
 * 	Pointers in DBusMessageIter and DBusSignatureIter are advanced
 * 	passed the processed part of the signature. In case of an error,
 * 	the interp Result variable contains a problem description.
 * 
 *----------------------------------------------------------------------
 */

static int DBus_VariantArg(Tcl_Interp *interp, DBusConnection *conn,
			   DBusMessageIter *iter, Tcl_Obj *const arg)
{
   int i = 0, num = DBUS_TYPE_STRING;
................................................................................
      num = (*str == NULL ? DBUS_TYPE_STRING : types[i]);
   }
   switch (i) {
    case 5: /* list */
      sign = "as";
    case 6: /* dict */
      if (i == 6) sign = "a{ss}";
      dbus_message_iter_open_container(iter, DBUS_TYPE_VARIANT, 
					   sign, &msgsub);
      dbus_signature_iter_init(&sigsub, sign);
      num = 1;
      if (DBus_ArgList(interp, conn, &msgsub, &sigsub, &num, &arg) != TCL_OK)
	return TCL_ERROR;
      dbus_message_iter_close_container(iter, &msgsub);
      break;
    default:
      dbus_message_iter_open_container(iter, DBUS_TYPE_VARIANT, 
					   (char *)&num, &msgsub);
      if (DBus_BasicArg(interp, &msgsub, num, arg) != TCL_OK)
	return TCL_ERROR;
      dbus_message_iter_close_container(iter, &msgsub);
      break;
   }
   return TCL_OK;
}

/* 
 *----------------------------------------------------------------------
 * 
 * DBus_Argument --
 * 
 * 	Add a Tcl_Obj as the appropriate argument to a DBus message
 * 
 * Results:
 * 	TCL_ERROR if errors were encountered, TCL_OK otherwise.
 * 
 * Side effects:
 * 	Pointers in DBusMessageIter and DBusSignatureIter are advanced
 * 	passed the processed part of the signature. In case of an error,
 * 	the interp Result variable contains a problem description.
 * 
 *----------------------------------------------------------------------
 */

static int DBus_Argument(Tcl_Interp *interp, DBusConnection *conn,
			 DBusMessageIter *iter, DBusSignatureIter *sig,
			 int argtype, Tcl_Obj *const arg)
{
................................................................................
      if ((objtype == NULL || strcmp("list", objtype->name) == 0) &&
	  Tcl_ListObjLength(NULL, tmp, &len) == TCL_OK && len == 2 &&
	  Tcl_ListObjIndex(NULL, tmp, 0, &str) == TCL_OK &&
	  dbus_signature_validate_single(Tcl_GetString(str), NULL)) {
	 /* Argument is a 2-element list and the first element is a */
	 /* valid signature containing exactly one complete type */
	 sign = Tcl_GetString(str);
	 dbus_message_iter_open_container(iter, DBUS_TYPE_VARIANT, 
					      sign, &msgsub);
	 dbus_signature_iter_init(&sigsub, sign);
	 Tcl_ListObjIndex(NULL, tmp, 1, &str);
	 num = 1;
	 rc = DBus_ArgList(interp, conn, &msgsub, &sigsub, &num, &str);
	 if (rc == TCL_OK)
	   dbus_message_iter_close_container(iter, &msgsub);
................................................................................
      break;
    case DBUS_TYPE_INVALID:
      /* Will catch the error later */
      break;
    default:
      type[0] = dbus_signature_iter_get_current_type(sig);
      sign = dbus_signature_iter_get_signature(sig);
      Tcl_AppendResult(interp, "Unsupported argument type: \"", type, 
		       "/", sign, "\"", NULL);
      dbus_free(sign);
      return TCL_ERROR;
   }
   return rc;
}





|







 







|

|

|


|





|







 







|









|

|

|

|


|




|



|







 







|







 







|

|

|

|


|




|










|







 







|

|

|

|


|




|











|







 







|

|

|


|


|




|







 







|








|









|

|

|

|


|




|







 







|







 







|






1
2
3
4
5
6
7
8
9
10
11
12
13
..
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
..
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
...
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
...
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
...
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
...
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
...
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
...
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
...
457
458
459
460
461
462
463
464
465
466
467
468
469
470
/*
 * Signature parsing routines. These five functions build up the arguments
 * of a dbus message from Tcl objects based on a provided signature. Due to
 * the nested nature of signatures, these functions may recursively call
 * eachother.
 *
 * The main entry point is DBus_ArgList. It repeatedly calls DBus_Argument
 * to add arguments to the message. DBus_Argument in turn may call
 * DBus_ArgList again to add embedded structure arguments. For the basic
 * argument types DBus_Argument calls DBus_BasicArg. Array arguments are
 * handled by DBus_ArrayArg which repeatedly calls DBus_Argument again for
 * the array elements, unless it's an array of dict entries in which case
 * DBus_DictArg is called to process the complete dict. DBus_DictArg
................................................................................
	DBusMessageIter *iter, DBusSignatureIter *sig,
	int argtype, Tcl_Obj *const arg);
static int DBus_DictArg(Tcl_Interp *interp, DBusConnection *conn,
	DBusMessageIter *iter, DBusSignatureIter *sig, Tcl_Obj *const arg);

/*
 *----------------------------------------------------------------------
 *
 * DBus_ArgList --
 *
 * 	Add a Tcl list as a structure argument to a DBus message
 *
 * Results:
 * 	TCL_ERROR if errors were encountered, TCL_OK otherwise.
 *
 * Side effects:
 * 	Pointers in DBusMessageIter and DBusSignatureIter are advanced
 * 	passed the processed part of the signature. The len variable is
 * 	decremented by the number of Tcl_Objs handled. In case of an
 * 	error, the interp Result variable contains a problem description.
 *
 *----------------------------------------------------------------------
 */

int DBus_ArgList(Tcl_Interp *interp, DBusConnection *conn,
		 DBusMessageIter *iter, DBusSignatureIter *sig,
		 int* len, Tcl_Obj *const arg[])
{
................................................................................
   int c;

   while (*len > 0) {
      c = dbus_signature_iter_get_current_type(sig);
      if (DBus_Argument(interp, conn, iter, sig, c, *arg) != TCL_OK)
	return TCL_ERROR;
      ++arg; --*len;
      if (c == DBUS_TYPE_INVALID ||
	  (!dbus_signature_iter_next(sig) && *len > 0)) {
	 Tcl_AppendResult(interp, "Arguments left after exhausting "
			  "the type signature", NULL);
	 return TCL_ERROR;
      }
   }
   return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * DBus_BasicArg --
 *
 * 	Add a Tcl_Obj as a basic argument to a DBus message
 *
 * Results:
 * 	TCL_ERROR if errors were encountered, TCL_OK otherwise.
 *
 * Side effects:
 * 	Pointer of DBusMessageIter is advanced passed the added argument.
 * 	In case of error, the interp Result variable contains a problem
 * 	description.
 *
 *----------------------------------------------------------------------
 */

int DBus_BasicArg(Tcl_Interp *interp, DBusMessageIter *iter,
	int type, Tcl_Obj *const arg)
{
   DBus_Value value;
   int mode;
   Tcl_Channel chan;
   Tcl_DString ds;
   Tcl_Encoding encoding;
................................................................................
       }
       if (type == DBUS_TYPE_SIGNATURE && !DBus_CheckSignature(arg)) {
	   Tcl_AppendResult(interp, "Invalid signature", NULL);
	   return TCL_ERROR;
       }
       /* Fall through to DBUS_TYPE_STRING */
    case DBUS_TYPE_STRING:
      /*
       * Need to convert from internal representation to real utf-8 because
       * the dbus library will crash on Tcl's \0 character (0xc080). After
       * conversion, the string will end at the first \0 (dbus doesn't allow
       * \0 in strings).
       */
      str = Tcl_GetStringFromObj(arg, &length);
      /* The utf-8 encoding is guaranteed to exist, so no checks are needed */
................................................................................
      }
      dbus_message_iter_append_basic(iter, DBUS_TYPE_UNIX_FD, &value.fd);
      break;
   }
   return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * DBus_ArrayArg --
 *
 * 	Add a Tcl list or dict as an array argument to a DBus message
 *
 * Results:
 * 	TCL_ERROR if errors were encountered, TCL_OK otherwise.
 *
 * Side effects:
 * 	Pointers in DBusMessageIter and DBusSignatureIter are advanced
 * 	passed the processed part of the signature. In case of an error,
 * 	the interp Result variable contains a problem description.
 *
 *----------------------------------------------------------------------
 */

static int DBus_ArrayArg(Tcl_Interp *interp, DBusConnection *conn,
			 DBusMessageIter *iter, DBusSignatureIter *sig,
			 Tcl_Obj *const arg)
{
   int objc, c;
   Tcl_Obj **objv;
   DBusSignatureIter sigsub;

   c = dbus_signature_iter_get_current_type(sig);
   if (c != DBUS_TYPE_DICT_ENTRY) {
      if (Tcl_ListObjGetElements(interp, arg, &objc, &objv) != TCL_OK)
	return TCL_ERROR;
      while (objc > 0) {
	 if (DBus_Argument(interp, conn, iter, sig, c, *objv) != TCL_OK)
	   return TCL_ERROR;
................................................................................
      dbus_signature_iter_recurse(sig, &sigsub);
      if (DBus_DictArg(interp, conn, iter, &sigsub, arg))
	return TCL_ERROR;
   }
   return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * DBus_DictArg --
 *
 * 	Add a dict as an array of dictentry arguments to a DBus message
 *
 * Results:
 * 	TCL_ERROR if errors were encountered, TCL_OK otherwise.
 *
 * Side effects:
 * 	Pointers in DBusMessageIter and DBusSignatureIter are advanced
 * 	passed the processed part of the signature. In case of an error,
 * 	the interp Result variable contains a problem description.
 *
 *----------------------------------------------------------------------
 */

static int DBus_DictArg(Tcl_Interp *interp, DBusConnection *conn,
			DBusMessageIter *iter, DBusSignatureIter *sig,
			Tcl_Obj *const arg)
{
   int keytype, valtype, done;
   Tcl_Obj *key, *val;
   Tcl_DictSearch search;
   DBusMessageIter msgsub;

   keytype = dbus_signature_iter_get_current_type(sig);
   dbus_signature_iter_next(sig);
   valtype = dbus_signature_iter_get_current_type(sig);
   if (Tcl_DictObjFirst(interp, arg, &search, &key, &val, &done) != TCL_OK)
     return TCL_ERROR;
   for (; !done; Tcl_DictObjNext(&search, &key, &val, &done)) {
      dbus_message_iter_open_container(iter, DBUS_TYPE_DICT_ENTRY, NULL, &msgsub);
................................................................................
      dbus_message_iter_close_container(iter, &msgsub);
   }
   Tcl_DictObjDone(&search);
   if (!done) return TCL_ERROR;
   return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * DBus_VariantArg --
 *
 * 	Adds a variant argument to a DBus message by autodetecting the
 *	type of the provided variable
 *
 * Results:
 * 	TCL_ERROR if errors were encountered, TCL_OK otherwise.
 *
 * Side effects:
 * 	Pointers in DBusMessageIter and DBusSignatureIter are advanced
 * 	passed the processed part of the signature. In case of an error,
 * 	the interp Result variable contains a problem description.
 *
 *----------------------------------------------------------------------
 */

static int DBus_VariantArg(Tcl_Interp *interp, DBusConnection *conn,
			   DBusMessageIter *iter, Tcl_Obj *const arg)
{
   int i = 0, num = DBUS_TYPE_STRING;
................................................................................
      num = (*str == NULL ? DBUS_TYPE_STRING : types[i]);
   }
   switch (i) {
    case 5: /* list */
      sign = "as";
    case 6: /* dict */
      if (i == 6) sign = "a{ss}";
      dbus_message_iter_open_container(iter, DBUS_TYPE_VARIANT,
					   sign, &msgsub);
      dbus_signature_iter_init(&sigsub, sign);
      num = 1;
      if (DBus_ArgList(interp, conn, &msgsub, &sigsub, &num, &arg) != TCL_OK)
	return TCL_ERROR;
      dbus_message_iter_close_container(iter, &msgsub);
      break;
    default:
      dbus_message_iter_open_container(iter, DBUS_TYPE_VARIANT,
					   (char *)&num, &msgsub);
      if (DBus_BasicArg(interp, &msgsub, num, arg) != TCL_OK)
	return TCL_ERROR;
      dbus_message_iter_close_container(iter, &msgsub);
      break;
   }
   return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * DBus_Argument --
 *
 * 	Add a Tcl_Obj as the appropriate argument to a DBus message
 *
 * Results:
 * 	TCL_ERROR if errors were encountered, TCL_OK otherwise.
 *
 * Side effects:
 * 	Pointers in DBusMessageIter and DBusSignatureIter are advanced
 * 	passed the processed part of the signature. In case of an error,
 * 	the interp Result variable contains a problem description.
 *
 *----------------------------------------------------------------------
 */

static int DBus_Argument(Tcl_Interp *interp, DBusConnection *conn,
			 DBusMessageIter *iter, DBusSignatureIter *sig,
			 int argtype, Tcl_Obj *const arg)
{
................................................................................
      if ((objtype == NULL || strcmp("list", objtype->name) == 0) &&
	  Tcl_ListObjLength(NULL, tmp, &len) == TCL_OK && len == 2 &&
	  Tcl_ListObjIndex(NULL, tmp, 0, &str) == TCL_OK &&
	  dbus_signature_validate_single(Tcl_GetString(str), NULL)) {
	 /* Argument is a 2-element list and the first element is a */
	 /* valid signature containing exactly one complete type */
	 sign = Tcl_GetString(str);
	 dbus_message_iter_open_container(iter, DBUS_TYPE_VARIANT,
					      sign, &msgsub);
	 dbus_signature_iter_init(&sigsub, sign);
	 Tcl_ListObjIndex(NULL, tmp, 1, &str);
	 num = 1;
	 rc = DBus_ArgList(interp, conn, &msgsub, &sigsub, &num, &str);
	 if (rc == TCL_OK)
	   dbus_message_iter_close_container(iter, &msgsub);
................................................................................
      break;
    case DBUS_TYPE_INVALID:
      /* Will catch the error later */
      break;
    default:
      type[0] = dbus_signature_iter_get_current_type(sig);
      sign = dbus_signature_iter_get_signature(sig);
      Tcl_AppendResult(interp, "Unsupported argument type: \"", type,
		       "/", sign, "\"", NULL);
      dbus_free(sign);
      return TCL_ERROR;
   }
   return rc;
}

Changes to undroid/dbus/dbus-tcl/dbusValidate.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
..
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
..
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
...
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
...
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
...
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
...
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
#include "dbustcl.h"

/*
 *----------------------------------------------------------------------
 * 
 * DBus_ValidNameChars
 * 
 * 	Count the number of valid D-Bus name characters. Valid D-Bus name
 *	characters are "[A-Z][a-z][0-9]_".
 * 
 * Results:
 * 	Returns the number of valid name characters found.
 * 
 * Side effects:
 * 	None.
 * 
 *----------------------------------------------------------------------
 */

int DBus_ValidNameChars(char* s)
{
   int cnt = 0;
   while ((*s >= 'a' && *s <= 'z') || (*s >= 'A' && *s <= 'Z') ||
................................................................................
      cnt++;
   }
   return cnt;
}

/*
 *----------------------------------------------------------------------
 * 
 * DBus_CheckBusName
 * 
 * 	Check if a user provided dbus name is valid. Passing a bad name
 * 	to dbus_bus_request_name or dbus_bus_release_name results in a
 *	panic, so instead of relying on the check from libdbus it has to
 * 	be recreated here.
 * 
 * Results:
 * 	Returns 1 if true, 0 if false.
 * 
 * Side effects:
 * 	None.
 * 
 *----------------------------------------------------------------------
 */

int DBus_CheckBusName(Tcl_Obj* name)
{
   char* s;
   int length, n, unique = 0, periods = 0;
................................................................................
   }
   /* Bus names must contain at least one '.' (period) character */
   return (periods >= 1);
}

/*
 *----------------------------------------------------------------------
 * 
 * DBus_CheckIntfName
 * 
 * 	Check if a user provided dbus interface name is valid. Passing a
 *	bad name to dbus_bus_request_name or dbus_bus_release_name results
 *	in a panic, so instead of relying on the check from libdbus it has
 * 	to be recreated here.
 * 
 * Results:
 * 	Returns the number of separators found. Since valid interface
 *	names must have one or more separators the result can be treated
 *	as a boolean.
 * 
 * Side effects:
 * 	None.
 * 
 *----------------------------------------------------------------------
 */

int DBus_CheckIntfName(Tcl_Obj* name)
{
   char* s;
   int length, n, periods;
................................................................................
   }
   /* Interface names must contain at least one '.' (period) character */
   return periods;
}

/*
 *----------------------------------------------------------------------
 * 
 * DBus_CheckPath
 * 
 * 	Check if a user provided dbus path is valid. Passing a bad path
 * 	to dbus functions results in a panic, so instead of relying on the
 *	check from libdbus it has to be recreated here.
 * 
 * Results:
 * 	Returns 1 if true, 0 if false.
 * 
 * Side effects:
 * 	None.
 * 
 *----------------------------------------------------------------------
 */

int DBus_CheckPath(Tcl_Obj* name)
{
   char *s;
   int length, n;
................................................................................
      s += n;
   }
   return (*s == '\0');
}

/*
 *----------------------------------------------------------------------
 * 
 * DBus_CheckMember
 * 
 * 	Check if a user provided dbus member is valid. Passing a bad member
 * 	to dbus functions results in a panic, so instead of relying on the
 *	check from libdbus it has to be recreated here.
 * 
 * Results:
 * 	Returns 1 if true, 0 if false.
 * 
 * Side effects:
 * 	None.
 * 
 *----------------------------------------------------------------------
 */

int DBus_CheckMember(Tcl_Obj* name)
{
   char *s;
   int length;
................................................................................
   if (*s >= '0' && *s <= '9') return FALSE;
   s += DBus_ValidNameChars(s);
   return (*s == '\0');
}

/*
 *----------------------------------------------------------------------
 * 
 * DBus_CheckName
 * 
 * 	Check if a user provided string contains only valid characters.
 * 
 * Results:
 * 	Returns 1 if true, 0 if false.
 * 
 * Side effects:
 * 	None.
 * 
 *----------------------------------------------------------------------
 */

int DBus_CheckName(Tcl_Obj* name)
{
   char *s;
   int length;
................................................................................
   if (length == 0 || length > DBUS_MAXIMUM_NAME_LENGTH) return FALSE;
   s += DBus_ValidNameChars(s);
   return (s == '\0');
}

/*
 *----------------------------------------------------------------------
 * 
 * DBus_CheckSignature
 *
 * 	Check if a user provided dbus signature is valid. Passing a bad
 *	signature to dbus functions results in a panic.
 * 
 * Results:
 * 	Returns 1 if true, 0 if false.
 * 
 * Side effects:
 * 	None.
 * 
 *----------------------------------------------------------------------
 */

int DBus_CheckSignature(Tcl_Obj* name)
{
    return dbus_signature_validate(Tcl_GetString(name), NULL);
}

/*
 *----------------------------------------------------------------------
 * 
 * DBus_BusType
 *	Check the Tcl variable for a valid bus type specification.
 *
 * Results:
 *	The bus type index, or -1 if the bus type was invalid.
 *
 * Side effects:
 * 	None.
 * 
 *----------------------------------------------------------------------
 */

int DBus_BusType(Tcl_Interp *interp, Tcl_Obj *const arg)
{
   int index;
   static const char *bustypes[] = {
      "session", "system", "starter", NULL
   };
   if (Tcl_GetIndexFromObj(NULL, arg, bustypes,
			   "", TCL_EXACT, &index) == TCL_OK) {
      return index;
   }
   if (Tcl_StringMatch(Tcl_GetString(arg), "dbus*")) 
     return N_BUS_TYPES;
   if (Tcl_StringMatch(Tcl_GetString(arg), "*:*"))
     return N_BUS_TYPES;
   if (interp != NULL)
     Tcl_SetObjResult(interp, 
		      Tcl_ObjPrintf("bad busId \"%s\"", Tcl_GetString(arg)));
   return -1;
}

/*
 *----------------------------------------------------------------------
 * 
 * DBusValidateCmd
 *	Validate strings against various D-Bus rules
 * 
 * Results:
 *	A standard Tcl result.
 * 
 * Side effects:
 * 	On return, the result value of the interpreter contains a boolean
 *	indicating if the string passed validation.
 * 
 *----------------------------------------------------------------------
 */

int DBusValidateCmd(ClientData dummy, Tcl_Interp *interp,
		    int objc, Tcl_Obj *const objv[])
{
   int index, rc;




|

|


|


|


|







 







|

|




|


|


|







 







|

|




|




|


|







 







|

|



|


|


|







 







|

|



|


|


|







 







|

|

|


|


|







 







|




|


|


|










|








|













|




|






|


|


|



|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
..
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
..
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
...
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
...
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
...
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
...
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
#include "dbustcl.h"

/*
 *----------------------------------------------------------------------
 *
 * DBus_ValidNameChars
 *
 * 	Count the number of valid D-Bus name characters. Valid D-Bus name
 *	characters are "[A-Z][a-z][0-9]_".
 *
 * Results:
 * 	Returns the number of valid name characters found.
 *
 * Side effects:
 * 	None.
 *
 *----------------------------------------------------------------------
 */

int DBus_ValidNameChars(char* s)
{
   int cnt = 0;
   while ((*s >= 'a' && *s <= 'z') || (*s >= 'A' && *s <= 'Z') ||
................................................................................
      cnt++;
   }
   return cnt;
}

/*
 *----------------------------------------------------------------------
 *
 * DBus_CheckBusName
 *
 * 	Check if a user provided dbus name is valid. Passing a bad name
 * 	to dbus_bus_request_name or dbus_bus_release_name results in a
 *	panic, so instead of relying on the check from libdbus it has to
 * 	be recreated here.
 *
 * Results:
 * 	Returns 1 if true, 0 if false.
 *
 * Side effects:
 * 	None.
 *
 *----------------------------------------------------------------------
 */

int DBus_CheckBusName(Tcl_Obj* name)
{
   char* s;
   int length, n, unique = 0, periods = 0;
................................................................................
   }
   /* Bus names must contain at least one '.' (period) character */
   return (periods >= 1);
}

/*
 *----------------------------------------------------------------------
 *
 * DBus_CheckIntfName
 *
 * 	Check if a user provided dbus interface name is valid. Passing a
 *	bad name to dbus_bus_request_name or dbus_bus_release_name results
 *	in a panic, so instead of relying on the check from libdbus it has
 * 	to be recreated here.
 *
 * Results:
 * 	Returns the number of separators found. Since valid interface
 *	names must have one or more separators the result can be treated
 *	as a boolean.
 *
 * Side effects:
 * 	None.
 *
 *----------------------------------------------------------------------
 */

int DBus_CheckIntfName(Tcl_Obj* name)
{
   char* s;
   int length, n, periods;
................................................................................
   }
   /* Interface names must contain at least one '.' (period) character */
   return periods;
}

/*
 *----------------------------------------------------------------------
 *
 * DBus_CheckPath
 *
 * 	Check if a user provided dbus path is valid. Passing a bad path
 * 	to dbus functions results in a panic, so instead of relying on the
 *	check from libdbus it has to be recreated here.
 *
 * Results:
 * 	Returns 1 if true, 0 if false.
 *
 * Side effects:
 * 	None.
 *
 *----------------------------------------------------------------------
 */

int DBus_CheckPath(Tcl_Obj* name)
{
   char *s;
   int length, n;
................................................................................
      s += n;
   }
   return (*s == '\0');
}

/*
 *----------------------------------------------------------------------
 *
 * DBus_CheckMember
 *
 * 	Check if a user provided dbus member is valid. Passing a bad member
 * 	to dbus functions results in a panic, so instead of relying on the
 *	check from libdbus it has to be recreated here.
 *
 * Results:
 * 	Returns 1 if true, 0 if false.
 *
 * Side effects:
 * 	None.
 *
 *----------------------------------------------------------------------
 */

int DBus_CheckMember(Tcl_Obj* name)
{
   char *s;
   int length;
................................................................................
   if (*s >= '0' && *s <= '9') return FALSE;
   s += DBus_ValidNameChars(s);
   return (*s == '\0');
}

/*
 *----------------------------------------------------------------------
 *
 * DBus_CheckName
 *
 * 	Check if a user provided string contains only valid characters.
 *
 * Results:
 * 	Returns 1 if true, 0 if false.
 *
 * Side effects:
 * 	None.
 *
 *----------------------------------------------------------------------
 */

int DBus_CheckName(Tcl_Obj* name)
{
   char *s;
   int length;
................................................................................
   if (length == 0 || length > DBUS_MAXIMUM_NAME_LENGTH) return FALSE;
   s += DBus_ValidNameChars(s);
   return (s == '\0');
}

/*
 *----------------------------------------------------------------------
 *
 * DBus_CheckSignature
 *
 * 	Check if a user provided dbus signature is valid. Passing a bad
 *	signature to dbus functions results in a panic.
 *
 * Results:
 * 	Returns 1 if true, 0 if false.
 *
 * Side effects:
 * 	None.
 *
 *----------------------------------------------------------------------
 */

int DBus_CheckSignature(Tcl_Obj* name)
{
    return dbus_signature_validate(Tcl_GetString(name), NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * DBus_BusType
 *	Check the Tcl variable for a valid bus type specification.
 *
 * Results:
 *	The bus type index, or -1 if the bus type was invalid.
 *
 * Side effects:
 * 	None.
 *
 *----------------------------------------------------------------------
 */

int DBus_BusType(Tcl_Interp *interp, Tcl_Obj *const arg)
{
   int index;
   static const char *bustypes[] = {
      "session", "system", "starter", NULL
   };
   if (Tcl_GetIndexFromObj(NULL, arg, bustypes,
			   "", TCL_EXACT, &index) == TCL_OK) {
      return index;
   }
   if (Tcl_StringMatch(Tcl_GetString(arg), "dbus*"))
     return N_BUS_TYPES;
   if (Tcl_StringMatch(Tcl_GetString(arg), "*:*"))
     return N_BUS_TYPES;
   if (interp != NULL)
     Tcl_SetObjResult(interp,
		      Tcl_ObjPrintf("bad busId \"%s\"", Tcl_GetString(arg)));
   return -1;
}

/*
 *----------------------------------------------------------------------
 *
 * DBusValidateCmd
 *	Validate strings against various D-Bus rules
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 * 	On return, the result value of the interpreter contains a boolean
 *	indicating if the string passed validation.
 *
 *----------------------------------------------------------------------
 */

int DBusValidateCmd(ClientData dummy, Tcl_Interp *interp,
		    int objc, Tcl_Obj *const objv[])
{
   int index, rc;

Changes to undroid/dbus/dbus-tcl/dbustcl.h.

49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
...
125
126
127
128
129
130
131






132
133
134
135


136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153





154
155
156
157
158
159
160
typedef unsigned long long dbustcl_uint64_t;
#define DBUS_UINT64_FORMAT "%llu"
#define DBUS_UINT64_MASK 0x8000000000000000ULL
#endif

typedef struct Tcl_DBusBus Tcl_DBusBus;

extern Tcl_HashTable bus;
extern Tcl_DBusBus *defaultbus;

typedef struct {
   Tcl_Interp *interp;
   Tcl_Obj *script;
} Tcl_DBusScriptData;

typedef struct {
   Tcl_DBusBus *dbus;
   Tcl_HashTable *signal, *method;
   int flags;
} Tcl_DBusHandlerData;

typedef struct {
   Tcl_ThreadId tid;
   Tcl_Interp *interp;
   Tcl_Obj *script;
   int flags;
} Tcl_DBusMonitorData;

typedef struct {
   Tcl_ThreadId tid;
   Tcl_Obj *script;
   int flags;
} Tcl_DBusSignalData;

typedef struct {
   Tcl_ThreadId tid;
   Tcl_Interp *interp;
   Tcl_Obj *script;
   DBusConnection *conn;
   int flags;
} Tcl_DBusMethodData;

typedef struct {
   Tcl_ThreadId tid;
   Tcl_Interp *interp;
   Tcl_Obj *script;
   DBusConnection *conn;
   int flags;
} Tcl_CallData;

typedef struct {
................................................................................
struct Tcl_DBusBus {
   DBusConnection *conn;
   Tcl_HashTable *snoop;
   Tcl_DBusHandlerData *fallback;
   int type;
};







/* dbusMain.c */
extern char *DBus_Alloc(int, char*, int);
extern void DBus_Free(char*, char*, int);
extern const char *DBus_InterpPath(Tcl_Interp*);


extern Tcl_DBusBus *DBus_GetConnection(Tcl_Interp*, Tcl_Obj *const);
extern int Tcl_CheckHashEmpty(Tcl_HashTable*);
extern void DBus_Disconnect(Tcl_Interp*, Tcl_HashEntry*);
extern void DBus_InterpDelete(ClientData, Tcl_Interp*);
  
/* dbusCommand.c */
extern Tcl_Command TclInitDBusCmd(Tcl_Interp*);
extern int DBus_MemoryError(Tcl_Interp*);

/* dbusEvent.c */
extern void DBus_SetupProc(ClientData, int);
extern void DBus_CheckProc(ClientData, int);
extern DBusHandlerResult DBus_Message(DBusConnection*, DBusMessage*, void*);
extern void DBus_Unregister(DBusConnection*, void*);
extern void DBus_CallResult(DBusPendingCall*, void*);
extern dbus_bool_t DBus_AddTimeout(DBusTimeout*, void*);
extern void DBus_RemoveTimeout(DBusTimeout*, void*);
extern void DBus_ToggleTimeout(DBusTimeout*, void*);





extern int DBusListenCmd(ClientData, Tcl_Interp*, int, Tcl_Obj *const[]);
extern int DBusMethodCmd(ClientData, Tcl_Interp*, int, Tcl_Obj *const[]);
extern int DBusUnknownCmd(ClientData, Tcl_Interp*, int, Tcl_Obj *const[]);
extern DBusHandlerResult DBus_Monitor(DBusConnection*, DBusMessage*, void*);
extern int DBusMonitorCmd(ClientData, Tcl_Interp*, int, Tcl_Obj *const[]);

/* dbusMessage.c */







<
<
<












<






<





<







<







 







>
>
>
>
>
>




>
>




|













>
>
>
>
>







49
50
51
52
53
54
55



56
57
58
59
60
61
62
63
64
65
66
67

68
69
70
71
72
73

74
75
76
77
78

79
80
81
82
83
84
85

86
87
88
89
90
91
92
...
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
typedef unsigned long long dbustcl_uint64_t;
#define DBUS_UINT64_FORMAT "%llu"
#define DBUS_UINT64_MASK 0x8000000000000000ULL
#endif

typedef struct Tcl_DBusBus Tcl_DBusBus;




typedef struct {
   Tcl_Interp *interp;
   Tcl_Obj *script;
} Tcl_DBusScriptData;

typedef struct {
   Tcl_DBusBus *dbus;
   Tcl_HashTable *signal, *method;
   int flags;
} Tcl_DBusHandlerData;

typedef struct {

   Tcl_Interp *interp;
   Tcl_Obj *script;
   int flags;
} Tcl_DBusMonitorData;

typedef struct {

   Tcl_Obj *script;
   int flags;
} Tcl_DBusSignalData;

typedef struct {

   Tcl_Interp *interp;
   Tcl_Obj *script;
   DBusConnection *conn;
   int flags;
} Tcl_DBusMethodData;

typedef struct {

   Tcl_Interp *interp;
   Tcl_Obj *script;
   DBusConnection *conn;
   int flags;
} Tcl_CallData;

typedef struct {
................................................................................
struct Tcl_DBusBus {
   DBusConnection *conn;
   Tcl_HashTable *snoop;
   Tcl_DBusHandlerData *fallback;
   int type;
};

typedef struct {
   int initialized;
   Tcl_DBusBus *defaultbus;
   Tcl_HashTable bus;
} Tcl_DBusThreadData;

/* dbusMain.c */
extern char *DBus_Alloc(int, char*, int);
extern void DBus_Free(char*, char*, int);
extern const char *DBus_InterpPath(Tcl_Interp*);
extern Tcl_DBusThreadData *DBus_GetThreadData(void);
extern Tcl_DBusBus *DBus_GetDefaultBus(void);
extern Tcl_DBusBus *DBus_GetConnection(Tcl_Interp*, Tcl_Obj *const);
extern int Tcl_CheckHashEmpty(Tcl_HashTable*);
extern void DBus_Disconnect(Tcl_Interp*, Tcl_HashEntry*);
extern void DBus_InterpDelete(ClientData, Tcl_Interp*);

/* dbusCommand.c */
extern Tcl_Command TclInitDBusCmd(Tcl_Interp*);
extern int DBus_MemoryError(Tcl_Interp*);

/* dbusEvent.c */
extern void DBus_SetupProc(ClientData, int);
extern void DBus_CheckProc(ClientData, int);
extern DBusHandlerResult DBus_Message(DBusConnection*, DBusMessage*, void*);
extern void DBus_Unregister(DBusConnection*, void*);
extern void DBus_CallResult(DBusPendingCall*, void*);
extern dbus_bool_t DBus_AddTimeout(DBusTimeout*, void*);
extern void DBus_RemoveTimeout(DBusTimeout*, void*);
extern void DBus_ToggleTimeout(DBusTimeout*, void*);
#ifndef _WIN32
extern dbus_bool_t DBus_AddWatch(DBusWatch*, void*);
extern void DBus_RemoveWatch(DBusWatch*, void*);
extern void DBus_ToggleWatch(DBusWatch*, void*);
#endif
extern int DBusListenCmd(ClientData, Tcl_Interp*, int, Tcl_Obj *const[]);
extern int DBusMethodCmd(ClientData, Tcl_Interp*, int, Tcl_Obj *const[]);
extern int DBusUnknownCmd(ClientData, Tcl_Interp*, int, Tcl_Obj *const[]);
extern DBusHandlerResult DBus_Monitor(DBusConnection*, DBusMessage*, void*);
extern int DBusMonitorCmd(ClientData, Tcl_Interp*, int, Tcl_Obj *const[]);

/* dbusMessage.c */