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: |
7cdc43242239b9f7058acaadea1a22fa |
User & Date: | chw 2019-02-07 07:15:20.758 |
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 | 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 | > > > | | > | < | 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 | 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])}] |
︙ | ︙ | |||
662 663 664 665 666 667 668 | } } UNSUBACK { payload Su msgid } PINGREQ - PINGRESP - DISCONNECT {} default { | | | 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 | } } 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 |
︙ | ︙ | |||
693 694 695 696 697 698 699 | 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} { | | | 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 | 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 | 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); } | > > > | | | | | | | | | | | | | 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 | 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 |
︙ | ︙ | |||
568 569 570 571 572 573 574 | } 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. */ | | | 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 | } 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); } |
︙ | ︙ |