Check-in [7cdc432422]
Not logged in

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

Overview
Comment:merge with trunk
Timelines: family | ancestors | descendants | both | wtf-8-experiment
Files: files | file ages | folders
SHA1: 7cdc43242239b9f7058acaadea1a22fae0429aad
User & Date: chw 2019-02-07 07:15:20
Context
2019-02-08
06:06
merge with trunk check-in: a54b717dc3 user: chw tags: wtf-8-experiment
2019-02-07
07:15
merge with trunk check-in: 7cdc432422 user: chw tags: wtf-8-experiment
07:13
add dbus-tcl upstream changes check-in: bd96efa639 user: chw tags: trunk
06:50
fix "binary encoding" for WTF-8 check-in: 9ac4a99287 user: chw tags: wtf-8-experiment
Changes

Changes to assets/mqtt2.0/mqtt.tcl.

564
565
566
567
568
569
570

571
572


573
574

575
576
577
578
579
580
581
582
583
...
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
...
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
	    set rc [yieldto my notifier]
	    if {[lindex $rc 0] ne "receive"} {return $rc}
	    if {[eof $fd]} {return EOF}
	    set size [string length $data]
	    # A message is at least 2 bytes
	    if {$size < 2} {
		append data [read $fd [expr {2 - $size}]]

	    }
	    if {[binary scan $data cucu hdr len] < 2} continue


	    append data [read $fd $len]
	    set size [string length $data]

	    if {$size < 2 + $len} continue
	    set ptr 2
	    if {$len > 127} {
		# The max number of bytes in the Remaining Length field is 4
		binary scan $data x2cu3 length
		set len [expr {$len & 0x7f}]
		set shift 0;
		foreach l $length {
		    set len [expr {$len + (($l & 0x7f) << [incr shift 7])}]
................................................................................
			}
		    }
		    UNSUBACK {
			payload Su msgid
		    }
		    PINGREQ - PINGRESP - DISCONNECT {}
		    default {
			throw {MQTT PAYLOAD UNKNOWN}
		    }
		}
		set rc [dict merge $rc [payload]]
		if {[dict exists $rc will]} {
		    dict set rc will [dict merge [dict get $rc will] $will]
		}
		my report received $type $rc
................................................................................
	while {$spec ne "" || [llength $args]} {
	    set parts [regexp -all -inline \
	      {[aAbBhHcsStiInwWmfrRdqQ]u?(?:\d*|\*)} $spec]
	    set vars {}
	    set cnt [llength $parts]
	    for {set i 1} {$i <= $cnt} {incr i} {lappend vars $i}
	    if {[binary scan $data @$pos$spec {*}$vars] != $cnt} {
		throw {MQTT PAYLOAD DEPLETED}
	    }
	    set result [lmap v $vars {set $v}]
	    foreach a $args v $result p $parts {
		if {$a eq ""} break
		if {[string match {[aA]u*} $p]} {
		    dict set msg {*}$a [encoding convertfrom utf-8 $v]
		} else {







>


>
>
|
|
>
|
<







 







|







 







|







564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579

580
581
582
583
584
585
586
...
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
...
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
	    set rc [yieldto my notifier]
	    if {[lindex $rc 0] ne "receive"} {return $rc}
	    if {[eof $fd]} {return EOF}
	    set size [string length $data]
	    # A message is at least 2 bytes
	    if {$size < 2} {
		append data [read $fd [expr {2 - $size}]]
		set size [string length $data]
	    }
	    if {[binary scan $data cucu hdr len] < 2} continue
	    set ptr 2
	    if {$size < $ptr + $len} {
		append data [read $fd [expr {$ptr + $len - $size}]]
		set size [string length $data]
	    }
	    if {$size < $ptr + $len} continue

	    if {$len > 127} {
		# The max number of bytes in the Remaining Length field is 4
		binary scan $data x2cu3 length
		set len [expr {$len & 0x7f}]
		set shift 0;
		foreach l $length {
		    set len [expr {$len + (($l & 0x7f) << [incr shift 7])}]
................................................................................
			}
		    }
		    UNSUBACK {
			payload Su msgid
		    }
		    PINGREQ - PINGRESP - DISCONNECT {}
		    default {
			throw {MQTT PAYLOAD UNKNOWN} "Unknown payload: $type"
		    }
		}
		set rc [dict merge $rc [payload]]
		if {[dict exists $rc will]} {
		    dict set rc will [dict merge [dict get $rc will] $will]
		}
		my report received $type $rc
................................................................................
	while {$spec ne "" || [llength $args]} {
	    set parts [regexp -all -inline \
	      {[aAbBhHcsStiInwWmfrRdqQ]u?(?:\d*|\*)} $spec]
	    set vars {}
	    set cnt [llength $parts]
	    for {set i 1} {$i <= $cnt} {incr i} {lappend vars $i}
	    if {[binary scan $data @$pos$spec {*}$vars] != $cnt} {
		throw {MQTT PAYLOAD DEPLETED} "payload too short"
	    }
	    set result [lmap v $vars {set $v}]
	    foreach a $args v $result p $parts {
		if {$a eq ""} break
		if {[string match {[aA]u*} $p]} {
		    dict set msg {*}$a [encoding convertfrom utf-8 $v]
		} else {

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

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
...
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582

static int DBus_EventHandler(Tcl_Event *evPtr, int flags)
{
   Tcl_DBusEvent *ev;
   Tcl_DBusBus *dbus;
   DBusMessageIter iter;
   Tcl_Obj *script, *retopts, *key, *value, *list;

   int rc, defer;

   if (!(flags & TCL_IDLE_EVENTS)) return 0;
   ev = (Tcl_DBusEvent *) evPtr;
   dbus = dbus_connection_get_data(ev->conn, dataSlot);


   script = ev->script;
   /* The script should actually never be shared */
   if (Tcl_IsShared(script)) {
      script = Tcl_DuplicateObj(script);
      Tcl_IncrRefCount(script);
      Tcl_DecrRefCount(ev->script);
   }
   Tcl_ListObjAppendElement(dbus->interp, script,
			    DBus_MessageInfo(dbus->interp, ev->msg));
   /* read the parameters and append to the script */
   if (dbus_message_iter_init(ev->msg, &iter)) {
      list = DBus_IterList(dbus->interp, &iter,
			   (ev->flags & DBUSFLAG_DETAILS) != 0);
      Tcl_ListObjAppendList(dbus->interp, script, list);
      Tcl_DecrRefCount(list);
   }
   /* Excute the constructed Tcl command */
   Tcl_Preserve(dbus->interp);
   rc = Tcl_EvalObjEx(dbus->interp, script, TCL_EVAL_GLOBAL);
   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(dbus->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(dbus->interp);
	    DBus_SendMessage(dbus->interp, "RETURN", ev->conn,
		DBUS_MESSAGE_TYPE_METHOD_RETURN, NULL, NULL, NULL,
		dbus_message_get_sender(ev->msg),
		dbus_message_get_serial(ev->msg),
		NULL, 1, &value);
	 }
	 Tcl_DecrRefCount(retopts);
      }
   } else {
      /* Always report failures if noreply == 0 */
      if (!(ev->flags & DBUSFLAG_NOREPLY)) {
	 value = Tcl_GetObjResult(dbus->interp);
	 DBus_Error(dbus->interp, ev->conn, NULL,
		dbus_message_get_sender(ev->msg),
		dbus_message_get_serial(ev->msg),
		Tcl_GetString(value));
      }
   }
   Tcl_Release(dbus->interp);
   dbus_message_unref(ev->msg);
   Tcl_DecrRefCount(script);
   /* The event structure will be cleaned up by Tcl_ServiceEvent */
#ifdef DBUS_MEM_DEBUG
   printf("Free %p is left to Tcl_ServiceEvent() (%s:%d)\n",
	  evPtr, __FILE__, __LINE__);
#endif
................................................................................
      } else if ((flags & DBUS_METHODFLAG) != 0 && data->method != NULL) {
	 for (memberPtr = Tcl_FirstHashEntry(data->method, &search);
	      memberPtr != NULL; memberPtr = Tcl_NextHashEntry(&search)) {
	    method = Tcl_GetHashValue(memberPtr);
	    s = Tcl_GetHashKey(data->method, memberPtr);
	    /* Normally skip unknown handlers. But when listing */
	    /* unknown handlers, skip all named handlers. */
	    if ((!(flags & DBUS_UNKNOWNFLAG)) == (*s == '\0')) continue;
	    /* Report both the path and the script configured for the path */
	    Tcl_ListObjAppendElement(NULL, list, Tcl_NewStringObj(path, -1));
	    /* There is no method name for unknown handlers */
	    if (!(flags & DBUS_UNKNOWNFLAG))
	      Tcl_ListObjAppendElement(NULL, list, Tcl_NewStringObj(s, -1));
	    Tcl_ListObjAppendElement(NULL, list, method->script);
	 }







>





>
>







|
|


|

|



|
|



|








|
|










|
|





|







 







|







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
...
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585

static int DBus_EventHandler(Tcl_Event *evPtr, int flags)
{
   Tcl_DBusEvent *ev;
   Tcl_DBusBus *dbus;
   DBusMessageIter iter;
   Tcl_Obj *script, *retopts, *key, *value, *list;
   Tcl_Interp *interp;
   int rc, defer;

   if (!(flags & TCL_IDLE_EVENTS)) return 0;
   ev = (Tcl_DBusEvent *) evPtr;
   dbus = dbus_connection_get_data(ev->conn, dataSlot);
   /* Get a copy of the interp in case the script closes the dbus */
   interp = dbus->interp;
   script = ev->script;
   /* The script should actually never be shared */
   if (Tcl_IsShared(script)) {
      script = Tcl_DuplicateObj(script);
      Tcl_IncrRefCount(script);
      Tcl_DecrRefCount(ev->script);
   }
   Tcl_ListObjAppendElement(interp, script,
			    DBus_MessageInfo(interp, ev->msg));
   /* read the parameters and append to the script */
   if (dbus_message_iter_init(ev->msg, &iter)) {
      list = DBus_IterList(interp, &iter,
			   (ev->flags & DBUSFLAG_DETAILS) != 0);
      Tcl_ListObjAppendList(interp, script, list);
      Tcl_DecrRefCount(list);
   }
   /* Excute the constructed Tcl command */
   Tcl_Preserve(interp);
   rc = Tcl_EvalObjEx(interp, script, TCL_EVAL_GLOBAL);
   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(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(interp);
	    DBus_SendMessage(interp, "RETURN", ev->conn,
		DBUS_MESSAGE_TYPE_METHOD_RETURN, NULL, NULL, NULL,
		dbus_message_get_sender(ev->msg),
		dbus_message_get_serial(ev->msg),
		NULL, 1, &value);
	 }
	 Tcl_DecrRefCount(retopts);
      }
   } else {
      /* Always report failures if noreply == 0 */
      if (!(ev->flags & DBUSFLAG_NOREPLY)) {
	 value = Tcl_GetObjResult(interp);
	 DBus_Error(interp, ev->conn, NULL,
		dbus_message_get_sender(ev->msg),
		dbus_message_get_serial(ev->msg),
		Tcl_GetString(value));
      }
   }
   Tcl_Release(interp);
   dbus_message_unref(ev->msg);
   Tcl_DecrRefCount(script);
   /* The event structure will be cleaned up by Tcl_ServiceEvent */
#ifdef DBUS_MEM_DEBUG
   printf("Free %p is left to Tcl_ServiceEvent() (%s:%d)\n",
	  evPtr, __FILE__, __LINE__);
#endif
................................................................................
      } else if ((flags & DBUS_METHODFLAG) != 0 && data->method != NULL) {
	 for (memberPtr = Tcl_FirstHashEntry(data->method, &search);
	      memberPtr != NULL; memberPtr = Tcl_NextHashEntry(&search)) {
	    method = Tcl_GetHashValue(memberPtr);
	    s = Tcl_GetHashKey(data->method, memberPtr);
	    /* Normally skip unknown handlers. But when listing */
	    /* unknown handlers, skip all named handlers. */
	    if (!(flags & DBUS_UNKNOWNFLAG) == (*s == '\0')) continue;
	    /* Report both the path and the script configured for the path */
	    Tcl_ListObjAppendElement(NULL, list, Tcl_NewStringObj(path, -1));
	    /* There is no method name for unknown handlers */
	    if (!(flags & DBUS_UNKNOWNFLAG))
	      Tcl_ListObjAppendElement(NULL, list, Tcl_NewStringObj(s, -1));
	    Tcl_ListObjAppendElement(NULL, list, method->script);
	 }