From 763c581edb801f34c61cce8eadcf7d8904b3cce9 Mon Sep 17 00:00:00 2001 From: kjnash Date: Mon, 10 Oct 2022 15:37:23 +0000 Subject: Bugfix library/http/http.tcl for connection request header - tcllib/websocket ticket [d01de3281f]. Revise header order in 3 tests. --- library/http/http.tcl | 37 ++++++++++++++++++++++++++++++------- tests/http.test | 6 +++--- 2 files changed, 33 insertions(+), 10 deletions(-) diff --git a/library/http/http.tcl b/library/http/http.tcl index 326aede..88685ec 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -1260,6 +1260,7 @@ proc http::CreateToken {url args} { [GetFieldValue $state(-headers) Upgrade]] set state(upgradeRequest) [expr { "upgrade" in $connectionValues && [llength $upgradeValues] >= 1}] + set state(connectionValues) $connectionValues if {$isQuery || $isQueryChannel} { # It's a POST. @@ -2104,24 +2105,25 @@ proc http::Connected {token proto phost srvurl} { if {($state(-protocol) > 1.0) && $state(-keepalive)} { # Send this header, because a 1.1 server is not compelled to treat # this as the default. - SendHeader $token Connection keep-alive - } - if {($state(-protocol) > 1.0) && !$state(-keepalive)} { - SendHeader $token Connection close ;# RFC2616 sec 8.1.2.1 - } - if {($state(-protocol) < 1.1)} { + set ConnVal keep-alive + } elseif {($state(-protocol) > 1.0)} { + # RFC2616 sec 8.1.2.1 + set ConnVal close + } else { + # ($state(-protocol) <= 1.0) # RFC7230 A.1 # Some server implementations of HTTP/1.0 have a faulty # implementation of RFC 2068 Keep-Alive. # Don't leave this to chance. # For HTTP/1.0 we have already "set state(connection) close" # and "state(-keepalive) 0". - SendHeader $token Connection close + set ConnVal close } # RFC7230 A.1 - "clients are encouraged not to send the # Proxy-Connection header field in any requests" set accept_encoding_seen 0 set content_type_seen 0 + set connection_seen 0 foreach {key value} $state(-headers) { set value [string map [list \n "" \r ""] $value] set key [string map {" " -} [string trim $key]] @@ -2141,6 +2143,24 @@ proc http::Connected {token proto phost srvurl} { set contDone 1 set state(querylength) $value } + if {[string equal -nocase $key "connection"]} { + # Remove "close" or "keep-alive" and use our own value. + # In an upgrade request, the upgrade is not guaranteed. + # Value "close" or "keep-alive" tells the server what to do + # if it refuses the upgrade. We send a single "Connection" + # header because some websocket servers, e.g. civetweb, reject + # multiple headers. Bug [d01de3281f] of tcllib/websocket. + set connection_seen 1 + set listVal $state(connectionValues) + if {[set pos [lsearch $listVal close]] != -1} { + set listVal [lreplace $listVal $pos $pos] + } + if {[set pos [lsearch $listVal keep-alive]] != -1} { + set listVal [lreplace $listVal $pos $pos] + } + lappend listVal $ConnVal + set value [join $listVal {, }] + } if {[string length $key]} { SendHeader $token $key $value } @@ -2159,6 +2179,9 @@ proc http::Connected {token proto phost srvurl} { SendHeader $token Accept-Encoding identity } else { } + if {!$connection_seen} { + SendHeader $token Connection $ConnVal + } if {$isQueryChannel && ($state(querylength) == 0)} { # Try to determine size of data in channel. If we cannot seek, the # surrounding catch will trap us diff --git a/tests/http.test b/tests/http.test index e88210a..1218536 100644 --- a/tests/http.test +++ b/tests/http.test @@ -409,10 +409,10 @@ test http-3.27 {http::geturl: -headers override -type} -body { http::cleanup $token } -match regexp -result {(?n)Host .* User-Agent .* -Connection close Content-Type {text/plain;charset=utf-8} Accept \*/\* Accept-Encoding .* +Connection close Content-Length 5} test http-3.28 {http::geturl: -headers override -type default} -body { set token [http::geturl $url/headers -query dummy \ @@ -422,10 +422,10 @@ test http-3.28 {http::geturl: -headers override -type default} -body { http::cleanup $token } -match regexp -result {(?n)Host .* User-Agent .* -Connection close Content-Type {text/plain;charset=utf-8} Accept \*/\* Accept-Encoding .* +Connection close Content-Length 5} test http-3.29 {http::geturl IPv6 address} -body { # We only want to see if the URL gets parsed correctly. This is @@ -462,9 +462,9 @@ test http-3.32 {http::geturl: -headers override -accept default} -body { http::cleanup $token } -match regexp -result {(?n)Host .* User-Agent .* -Connection close Accept text/plain,application/tcl-test-value Accept-Encoding .* +Connection close Content-Type application/x-www-form-urlencoded Content-Length 5} # Bug 838e99a76d -- cgit v0.12 From 0d0cf6602a9b466d777c22736156422c586c8c94 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 11 Oct 2022 06:26:44 +0000 Subject: There's a duplicate set of io-75.* testcases, so renumber one of them --- tests/io.test | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/tests/io.test b/tests/io.test index 96abadd..f928cd3 100644 --- a/tests/io.test +++ b/tests/io.test @@ -9052,7 +9052,7 @@ test io-75.5 {incomplete shiftjis encoding read is ignored} -setup { -test io-75.0 {channel modes} -setup { +test io-76.0 {channel modes} -setup { set datafile [makeFile {some characters} dummy] set f [open $datafile r] } -constraints testchannel -body { @@ -9062,7 +9062,7 @@ test io-75.0 {channel modes} -setup { removeFile dummy } -result {read {}} -test io-75.1 {channel modes} -setup { +test io-76.1 {channel modes} -setup { set datafile [makeFile {some characters} dummy] set f [open $datafile w] } -constraints testchannel -body { @@ -9072,7 +9072,7 @@ test io-75.1 {channel modes} -setup { removeFile dummy } -result {{} write} -test io-75.2 {channel modes} -setup { +test io-76.2 {channel modes} -setup { set datafile [makeFile {some characters} dummy] set f [open $datafile r+] } -constraints testchannel -body { @@ -9082,7 +9082,7 @@ test io-75.2 {channel modes} -setup { removeFile dummy } -result {read write} -test io-75.3 {channel mode dropping} -setup { +test io-76.3 {channel mode dropping} -setup { set datafile [makeFile {some characters} dummy] set f [open $datafile r] } -constraints testchannel -body { @@ -9093,7 +9093,7 @@ test io-75.3 {channel mode dropping} -setup { removeFile dummy } -result {{read {}} {read {}}} -test io-75.4 {channel mode dropping} -setup { +test io-76.4 {channel mode dropping} -setup { set datafile [makeFile {some characters} dummy] set f [open $datafile r] } -constraints testchannel -body { @@ -9103,7 +9103,7 @@ test io-75.4 {channel mode dropping} -setup { removeFile dummy } -match glob -result {Tcl_RemoveChannelMode error: Bad mode, would make channel inacessible. Channel: "*"} -test io-75.5 {channel mode dropping} -setup { +test io-76.5 {channel mode dropping} -setup { set datafile [makeFile {some characters} dummy] set f [open $datafile w] } -constraints testchannel -body { @@ -9114,7 +9114,7 @@ test io-75.5 {channel mode dropping} -setup { removeFile dummy } -result {{{} write} {{} write}} -test io-75.6 {channel mode dropping} -setup { +test io-76.6 {channel mode dropping} -setup { set datafile [makeFile {some characters} dummy] set f [open $datafile w] } -constraints testchannel -body { @@ -9124,7 +9124,7 @@ test io-75.6 {channel mode dropping} -setup { removeFile dummy } -match glob -result {Tcl_RemoveChannelMode error: Bad mode, would make channel inacessible. Channel: "*"} -test io-75.7 {channel mode dropping} -setup { +test io-76.7 {channel mode dropping} -setup { set datafile [makeFile {some characters} dummy] set f [open $datafile r+] } -constraints testchannel -body { @@ -9135,7 +9135,7 @@ test io-75.7 {channel mode dropping} -setup { removeFile dummy } -result {{{} write} {read write}} -test io-75.8 {channel mode dropping} -setup { +test io-76.8 {channel mode dropping} -setup { set datafile [makeFile {some characters} dummy] set f [open $datafile r+] } -constraints testchannel -body { @@ -9146,7 +9146,7 @@ test io-75.8 {channel mode dropping} -setup { removeFile dummy } -result {{read {}} {read write}} -test io-75.9 {channel mode dropping} -setup { +test io-76.9 {channel mode dropping} -setup { set datafile [makeFile {some characters} dummy] set f [open $datafile r+] } -constraints testchannel -body { @@ -9157,7 +9157,7 @@ test io-75.9 {channel mode dropping} -setup { removeFile dummy } -match glob -result {Tcl_RemoveChannelMode error: Bad mode, would make channel inacessible. Channel: "*"} -test io-75.10 {channel mode dropping} -setup { +test io-76.10 {channel mode dropping} -setup { set datafile [makeFile {some characters} dummy] set f [open $datafile r+] } -constraints testchannel -body { -- cgit v0.12 From 6b05e4086f08a1a91dc39467e9421a011ba91768 Mon Sep 17 00:00:00 2001 From: sbron Date: Tue, 11 Oct 2022 10:37:03 +0000 Subject: Update Tcl_TraceVar manual page. --- doc/TraceVar.3 | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/doc/TraceVar.3 b/doc/TraceVar.3 index 649565a..2a3c58d 100644 --- a/doc/TraceVar.3 +++ b/doc/TraceVar.3 @@ -137,9 +137,11 @@ trace was created. \fIclientData\fR typically points to an application-specific data structure that describes what to do when \fIproc\fR is invoked. -\fIName1\fR and \fIname2\fR give the name of the traced variable -in the normal two-part form (see the description of \fBTcl_TraceVar2\fR -below for details). +\fIName1\fR and \fIname2\fR give the name of the variable that +triggered the callback in the normal two-part form (see the description +of \fBTcl_TraceVar2\fR below for details). In case \fIname1\fR is an +alias to an array element (created through facilities such as \fBupvar\fR), +\fIname2\fR holds the index of the array element, rather than NULL. \fIFlags\fR is an OR-ed combination of bits providing several pieces of information. One of the bits \fBTCL_TRACE_READS\fR, \fBTCL_TRACE_WRITES\fR, -- cgit v0.12 From 75ba8ac33bf8e8e9c0dfed189d177ebb6710dd15 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 11 Oct 2022 11:02:45 +0000 Subject: Format errors in vwait.n --- doc/vwait.n | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/doc/vwait.n b/doc/vwait.n index 5f240d6..d67c16d 100644 --- a/doc/vwait.n +++ b/doc/vwait.n @@ -13,7 +13,7 @@ vwait \- Process events until a variable is written .SH SYNOPSIS \fBvwait\fR \fIvarName\fR .PP -\fBvwait\fR ?\Ioptions\fR? ?\fIvarName ...\fR? +\fBvwait\fR ?\fIoptions\fR? ?\fIvarName ...\fR? .BE .SH DESCRIPTION .PP @@ -66,7 +66,7 @@ Events of the windowing system are not handled during the wait operation. \fIChannel\fR must name a Tcl channel open for reading. If \fIchannel\fR is or becomes readable the wait operation completes. .TP -\fB\-timeout\fR milliseconds\fR +\fB\-timeout\fR \fImilliseconds\fR . The wait operation is constrained to \fImilliseconds\fR. .TP -- cgit v0.12 From d4c0a2c2ae26239197650eaaf6388d7ccdc51e48 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 11 Oct 2022 14:22:17 +0000 Subject: Few more formatting errors --- doc/http.n | 6 +----- doc/vwait.n | 2 +- 2 files changed, 2 insertions(+), 6 deletions(-) diff --git a/doc/http.n b/doc/http.n index c08d221..59f15b6 100644 --- a/doc/http.n +++ b/doc/http.n @@ -613,13 +613,11 @@ The "request line" is the first line of a HTTP client request, and has three elements separated by spaces: the HTTP method, the URL relative to the server, and the HTTP version. Examples: .PP -.DS .RS GET / HTTP/1.1 GET /introduction.html?subject=plumbing HTTP/1.1 POST /forms/order.html HTTP/1.1 .RE -.DE .TP \fB::http::requestHeaders\fR \fItoken\fR ?\fIheaderName\fR? . @@ -650,12 +648,10 @@ elements separated by spaces: the HTTP version, a three-digit numerical "status code", and a "reason phrase". Only the reason phrase may contain spaces. Examples: .PP -.DS .RS HTTP/1.1 200 OK HTTP/1.0 404 Not Found .RE -.DE .RS The "status code" is a three-digit number in the range 100 to 599. A value of 200 is the normal return from a GET request, and its matching @@ -1589,7 +1585,7 @@ that \fB::tls::socketCmd\fR has this value, it replaces it with the value i.e. if the script or the Tcl installation has replaced the value "::socket" with the name of a different command, then http does not change the value. The script or installation that modified \fB::tls::socketCmd\fR is responsible -for integrating \fR::http::socket\fR into its own replacement command. +for integrating \fB::http::socket\fR into its own replacement command. .PP .SS "WITH A CHILD INTERPRETER" .PP diff --git a/doc/vwait.n b/doc/vwait.n index d67c16d..e595a74 100644 --- a/doc/vwait.n +++ b/doc/vwait.n @@ -12,7 +12,7 @@ vwait \- Process events until a variable is written .SH SYNOPSIS \fBvwait\fR \fIvarName\fR -.PP +.sp \fBvwait\fR ?\fIoptions\fR? ?\fIvarName ...\fR? .BE .SH DESCRIPTION -- cgit v0.12 From 7a961752a9d930a7eb51f6f813df3e4570026bb1 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 11 Oct 2022 15:48:43 +0000 Subject: Make TCL_ENCODING_STRICT and TCL_ENCODING_NOCOMPLAIN work independant from each other (suggested by Harald Oehlmann) --- generic/tcl.h | 4 +++- generic/tclEncoding.c | 2 +- generic/tclIO.c | 34 +++++++++++++++++++++------------- 3 files changed, 25 insertions(+), 15 deletions(-) diff --git a/generic/tcl.h b/generic/tcl.h index 80494f3..1d2c5be 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -1890,6 +1890,8 @@ typedef struct Tcl_EncodingType { * reset to an initial state. If the source * buffer contains the entire input stream to be * converted, this flag should be set. + * TCL_ENCODING_STRICT - Be more strict in accepting what + * is considered a 'invalid byte sequence'. * TCL_ENCODING_STOPONERROR - Not used any more. * TCL_ENCODING_NO_TERMINATE - If set, Tcl_ExternalToUtf does not append a * terminating NUL byte. Since it does not need @@ -1921,12 +1923,12 @@ typedef struct Tcl_EncodingType { #define TCL_ENCODING_START 0x01 #define TCL_ENCODING_END 0x02 +#define TCL_ENCODING_STRICT 0x04 #define TCL_ENCODING_STOPONERROR 0x0 /* Not used any more */ #define TCL_ENCODING_NO_TERMINATE 0x08 #define TCL_ENCODING_CHAR_LIMIT 0x10 #define TCL_ENCODING_MODIFIED 0x20 #define TCL_ENCODING_NOCOMPLAIN 0x40 -#define TCL_ENCODING_STRICT 0x44 /* * The following definitions are the error codes returned by the conversion diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index e366904..cd6aacb 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -2222,7 +2222,7 @@ BinaryProc( *------------------------------------------------------------------------- */ -#define STOPONERROR ((flags & TCL_ENCODING_STRICT) != TCL_ENCODING_NOCOMPLAIN) +#define STOPONERROR (!(flags & TCL_ENCODING_NOCOMPLAIN)) static int UtfToUtfProc( diff --git a/generic/tclIO.c b/generic/tclIO.c index 5f831c9..48aa18d 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -4360,14 +4360,16 @@ Write( } /* - * Transfer encoding strict/nocomplain option to the encoding flags + * Transfer encoding nocomplain/strict option to the encoding flags */ + if (GotFlag(statePtr, CHANNEL_ENCODING_NOCOMPLAIN)) { + statePtr->outputEncodingFlags |= TCL_ENCODING_NOCOMPLAIN; + } else { + statePtr->outputEncodingFlags &= ~TCL_ENCODING_NOCOMPLAIN; + } if (GotFlag(statePtr, CHANNEL_ENCODING_STRICT)) { statePtr->outputEncodingFlags |= TCL_ENCODING_STRICT; - } else if (GotFlag(statePtr, CHANNEL_ENCODING_NOCOMPLAIN)) { - statePtr->outputEncodingFlags &= ~TCL_ENCODING_STRICT; - statePtr->outputEncodingFlags |= TCL_ENCODING_NOCOMPLAIN; } else { statePtr->outputEncodingFlags &= ~TCL_ENCODING_STRICT; } @@ -4693,11 +4695,13 @@ Tcl_GetsObj( * Transfer encoding nocomplain/strict option to the encoding flags */ + if (GotFlag(statePtr, CHANNEL_ENCODING_NOCOMPLAIN)) { + statePtr->inputEncodingFlags |= TCL_ENCODING_NOCOMPLAIN; + } else { + statePtr->inputEncodingFlags &= ~TCL_ENCODING_NOCOMPLAIN; + } if (GotFlag(statePtr, CHANNEL_ENCODING_STRICT)) { statePtr->inputEncodingFlags |= TCL_ENCODING_STRICT; - } else if (GotFlag(statePtr, CHANNEL_ENCODING_NOCOMPLAIN)) { - statePtr->inputEncodingFlags &= ~TCL_ENCODING_STRICT; - statePtr->inputEncodingFlags |= TCL_ENCODING_NOCOMPLAIN; } else { statePtr->inputEncodingFlags &= ~TCL_ENCODING_STRICT; } @@ -5464,11 +5468,13 @@ FilterInputBytes( * Transfer encoding nocomplain/strict option to the encoding flags */ + if (GotFlag(statePtr, CHANNEL_ENCODING_NOCOMPLAIN)) { + statePtr->inputEncodingFlags |= TCL_ENCODING_NOCOMPLAIN; + } else { + statePtr->inputEncodingFlags &= ~TCL_ENCODING_NOCOMPLAIN; + } if (GotFlag(statePtr, CHANNEL_ENCODING_STRICT)) { statePtr->inputEncodingFlags |= TCL_ENCODING_STRICT; - } else if (GotFlag(statePtr, CHANNEL_ENCODING_NOCOMPLAIN)) { - statePtr->inputEncodingFlags &= ~TCL_ENCODING_STRICT; - statePtr->inputEncodingFlags |= TCL_ENCODING_NOCOMPLAIN; } else { statePtr->inputEncodingFlags &= ~TCL_ENCODING_STRICT; } @@ -6250,11 +6256,13 @@ ReadChars( * Transfer encoding nocomplain/strict option to the encoding flags */ + if (GotFlag(statePtr, CHANNEL_ENCODING_NOCOMPLAIN)) { + statePtr->inputEncodingFlags |= TCL_ENCODING_NOCOMPLAIN; + } else { + statePtr->inputEncodingFlags &= ~TCL_ENCODING_NOCOMPLAIN; + } if (GotFlag(statePtr, CHANNEL_ENCODING_STRICT)) { statePtr->inputEncodingFlags |= TCL_ENCODING_STRICT; - } else if (GotFlag(statePtr, CHANNEL_ENCODING_NOCOMPLAIN)) { - statePtr->inputEncodingFlags &= ~TCL_ENCODING_STRICT; - statePtr->inputEncodingFlags |= TCL_ENCODING_NOCOMPLAIN; } else { statePtr->inputEncodingFlags &= ~TCL_ENCODING_STRICT; } -- cgit v0.12 From b758c501cf323af7a0fddb806260e84ad03c68e5 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 11 Oct 2022 15:51:42 +0000 Subject: Document TCL_ENCODING_STRICT flag --- doc/Encoding.3 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/doc/Encoding.3 b/doc/Encoding.3 index 86c5a78..553cc21 100644 --- a/doc/Encoding.3 +++ b/doc/Encoding.3 @@ -114,7 +114,9 @@ byte is converted and then to reset to an initial state. \fBTCL_ENCODING_STOPONERROR\fR signifies that the conversion routine should return immediately upon reading a source character that does not exist in the target encoding; otherwise a default fallback character will -automatically be substituted. The flag \fBTCL_ENCODING_NOCOMPLAIN\fR has +automatically be substituted. The flag \fBTCL_ENCODING_STRICT\fR makes the +encoder/decoder more strict in what it considers to be an invalid byte +sequence. The flag \fBTCL_ENCODING_NOCOMPLAIN\fR has no effect, it is reserved for Tcl 9.0. The flag \fBTCL_ENCODING_MODIFIED\fR makes \fBTcl_UtfToExternalDStringEx\fR and \fBTcl_UtfToExternal\fR produce the byte sequence \exC0\ex80 in stead of \ex00, for the utf-8/cesu-8 encoders. -- cgit v0.12