From ab8a39e6b957afc4cf4f7157e1bb0d92e7f9cf07 Mon Sep 17 00:00:00 2001 From: dkf Date: Sat, 8 Oct 2016 16:38:42 +0000 Subject: [838e99a76d] Ensure that encodings are handled with application/xml and friends. --- library/http/http.tcl | 34 +++++++++++++++++++++++++++++++++- tests/http.test | 7 +++++++ tests/httpd | 4 ++++ 3 files changed, 44 insertions(+), 1 deletion(-) diff --git a/library/http/http.tcl b/library/http/http.tcl index 4c99f62..2975f82 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -1019,7 +1019,7 @@ proc http::Event {sock token} { fconfigure $sock -translation binary if { - $state(-binary) || ![string match -nocase text* $state(type)] + $state(-binary) || [IsBinaryContentType $state(type)] } then { # Turn off conversions for non-text data set state(binary) 1 @@ -1161,6 +1161,38 @@ proc http::Event {sock token} { } } +# http::IsBinaryContentType -- +# +# Determine if the content-type means that we should definitely transfer +# the data as binary. [Bug 838e99a76d] +# +# Arguments +# type The content-type of the data. +# +# Results: +# Boolean, true if we definitely should be binary. + +proc http::IsBinaryContentType {type} { + lassign [split [string tolower $type] "/;"] major minor + if {$major eq "text"} { + return false + } + # There's a bunch of XML-as-application-format things about. See RFC 3023 + # and so on. + if {$major eq "application"} { + set minor [string trimright $minor] + if {$minor in {"xml" "xml-external-parsed-entity" "xml-dtd"}} { + return false + } + } + # Not just application/foobar+xml but also image/svg+xml, so let us not + # restrict things for now... + if {[string match "*+xml" $minor]} { + return false + } + return true +} + # http::getTextLine -- # # Get one line with the stream in blocking crlf mode diff --git a/tests/http.test b/tests/http.test index 2fc0a51..322fb36 100644 --- a/tests/http.test +++ b/tests/http.test @@ -132,6 +132,7 @@ set tail /a/b/c set url //[info hostname]:$port/a/b/c set fullurl HTTP://user:pass@[info hostname]:$port/a/b/c set binurl //[info hostname]:$port/binary +set xmlurl //[info hostname]:$port/xml set posturl //[info hostname]:$port/post set badposturl //[info hostname]:$port/droppost set authorityurl //[info hostname]:$port @@ -364,6 +365,12 @@ test http-3.31 {http::geturl fragment without path} -body { } -cleanup { catch { http::cleanup $token } } -result 200 +test http-3.32 {http::geturl application/xml is text} -body { + set token [http::geturl "$xmlurl"] + scan [http::data $token] "<%\[^>]>%c<%\[^>]>" +} -cleanup { + catch { http::cleanup $token } +} -result {test 4660 /test} test http-4.1 {http::Event} { set token [http::geturl $url -keepalive 0] diff --git a/tests/httpd b/tests/httpd index 232e80a..8753912 100644 --- a/tests/httpd +++ b/tests/httpd @@ -171,6 +171,10 @@ proc httpdRespond { sock } { set html "$bindata[info hostname]:$port$data(url)" set type application/octet-stream } + *xml* { + set html [encoding convertto utf-8 "\u1234"] + set type "application/xml;charset=UTF-8" + } *post* { set html "Got [string length $data(query)] bytes" set type text/plain -- cgit v0.12 From a16868a54cf0e26f2bd11db549b2862196785df4 Mon Sep 17 00:00:00 2001 From: dkf Date: Sat, 8 Oct 2016 17:10:02 +0000 Subject: [74bc0e44f5] Document result of [http::unregister]. --- doc/http.n | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/doc/http.n b/doc/http.n index 8aeb286..c6e8983 100644 --- a/doc/http.n +++ b/doc/http.n @@ -369,7 +369,9 @@ set token [::http::geturl https://my.secure.site/] .TP \fB::http::unregister\fR \fIproto\fR This procedure unregisters a protocol handler that was previously -registered via \fB::http::register\fR. +registered via \fB::http::register\fR, returning a two-item list of +the default port and handler command that was previously installed +(via \fB::http::register\fR) if there was such a handler. .SH ERRORS The \fB::http::geturl\fR procedure will raise errors in the following cases: invalid command line options, -- cgit v0.12 From 05009534eeb14f31393d2a7bacff54cf31901492 Mon Sep 17 00:00:00 2001 From: ferrieux Date: Sun, 9 Oct 2016 10:35:24 +0000 Subject: Be more accurate about scan's %i --- doc/scan.n | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/doc/scan.n b/doc/scan.n index d963d6c..0c24fea 100644 --- a/doc/scan.n +++ b/doc/scan.n @@ -123,9 +123,7 @@ with conversion character \fBu\fR. .TP \fBi\fR . -The input substring must be an integer. The base (i.e. decimal, binary, -octal, or hexadecimal) is determined in the same fashion as described in -\fBexpr\fR. The integer value is stored in the variable, +The input substring must be an integer. The base (i.e. decimal, octal, or hexadecimal) is determined by the C convention (leading 0 for octal; prefix 0x for hexadecimal). The integer value is stored in the variable, truncated as required by the size modifier value. .TP \fBc\fR -- cgit v0.12 From c8597887e46c5008dde3018890624c244081c398 Mon Sep 17 00:00:00 2001 From: dkf Date: Sun, 9 Oct 2016 12:03:30 +0000 Subject: Be more accurate about scan's %i --- doc/scan.n | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/doc/scan.n b/doc/scan.n index d963d6c..0c24fea 100644 --- a/doc/scan.n +++ b/doc/scan.n @@ -123,9 +123,7 @@ with conversion character \fBu\fR. .TP \fBi\fR . -The input substring must be an integer. The base (i.e. decimal, binary, -octal, or hexadecimal) is determined in the same fashion as described in -\fBexpr\fR. The integer value is stored in the variable, +The input substring must be an integer. The base (i.e. decimal, octal, or hexadecimal) is determined by the C convention (leading 0 for octal; prefix 0x for hexadecimal). The integer value is stored in the variable, truncated as required by the size modifier value. .TP \fBc\fR -- cgit v0.12 From 71c2d1a883c2c1a1d96b7a2f80ccc4409ce97ca3 Mon Sep 17 00:00:00 2001 From: dkf Date: Sun, 9 Oct 2016 15:21:26 +0000 Subject: [7114ac6141] Improve testing and docs of Tcl_GetInt and Tcl_GetDouble. No behaviour change. --- doc/GetInt.3 | 31 +++++++++++++++++++++++-------- tests/get.test | 22 ++++++++++++++++++++-- 2 files changed, 43 insertions(+), 10 deletions(-) diff --git a/doc/GetInt.3 b/doc/GetInt.3 index 4e9d636..3e7204c 100644 --- a/doc/GetInt.3 +++ b/doc/GetInt.3 @@ -51,27 +51,42 @@ in the interpreter's result, and nothing is stored at *\fIintPtr\fR or *\fIdoublePtr\fR or *\fIboolPtr\fR. .PP \fBTcl_GetInt\fR expects \fIsrc\fR to consist of a collection -of integer digits, optionally signed and optionally preceded by -white space. If the first two characters of \fIsrc\fR +of integer digits, optionally signed and optionally preceded and +followed by white space. If the first two characters of \fIsrc\fR after the optional white space and sign are -.QW 0x +.QW \fB0x\fR then \fIsrc\fR is expected to be in hexadecimal form; otherwise, +if the first such characters are +.QW \fB0o\fR +then \fIsrc\fR is expected to be in octal form; otherwise, +if the first such characters are +.QW \fB0b\fR +then \fIsrc\fR is expected to be in binary form; otherwise, if the first such character is -.QW 0 +.QW \fB0\fR then \fIsrc\fR is expected to be in octal form; otherwise, \fIsrc\fR is expected to be in decimal form. .PP \fBTcl_GetDouble\fR expects \fIsrc\fR to consist of a floating-point number, which is: white space; a sign; a sequence of digits; a -decimal point; a sequence of digits; the letter -.QW e ; +decimal point +.QW \fB.\fR ; +a sequence of digits; the letter +.QW \fBe\fR ; a signed decimal exponent; and more white space. Any of the fields may be omitted, except that the digits either before or after the decimal point must be present and if the -.QW e -is present then it must be followed by the exponent number. +.QW \fBe\fR +is present then it must be followed by the exponent number. If there +are no fields apart from the sign and initial sequence of digits +(i.e., no decimal point or exponent indicator), that +initial sequence of digits should take one of the forms that +\fBTcl_GetInt\fR supports, described above. The use of +.QW \fB,\fR +as a decimal point is not supported nor should any other sort of +inter-digit separator be present. .PP \fBTcl_GetBoolean\fR expects \fIsrc\fR to specify a boolean value. If \fIsrc\fR is any of \fB0\fR, \fBfalse\fR, diff --git a/tests/get.test b/tests/get.test index d51ec6d..7aa06c1 100644 --- a/tests/get.test +++ b/tests/get.test @@ -19,9 +19,10 @@ if {[lsearch [namespace children] ::tcltest] == -1} { catch [list package require -exact Tcltest [info patchlevel]] testConstraint testgetint [llength [info commands testgetint]] +testConstraint testdoubleobj [llength [info commands testdoubleobj]] testConstraint longIs32bit [expr {int(0x80000000) < 0}] testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}] - + test get-1.1 {Tcl_GetInt procedure} testgetint { testgetint 44 { 22} } {66} @@ -95,7 +96,24 @@ test get-3.2 {Tcl_GetDouble(FromObj), bad numbers} { } set result } {0 1 0 1 1 {expected floating-point number but got "++1.0"} 1 {expected floating-point number but got "+-1.0"} 1 {expected floating-point number but got "-+1.0"} 0 -1 1 {expected floating-point number but got "--1.0"} 1 {expected floating-point number but got "- +1.0"}} - +# Bug 7114ac6141 +test get-3.3 {tcl_GetInt with iffy numbers} testgetint { + lmap x {0 " 0" "0 " " 0 " " 0xa " " 010 " " 0o10 " " 0b10 "} { + catch {testgetint 44 $x} x + set x + } +} {44 44 44 44 54 52 52 46} +test get-3.4 {Tcl_GetDouble with iffy numbers} testdoubleobj { + lmap x {0 0.0 " .0" ".0 " " 0e0 " "09" "- 0" "-0" "0o12" "0b10"} { + catch {testdoubleobj set 1 $x} x + set x + } +} {0.0 0.0 0.0 0.0 0.0 {expected floating-point number but got "09" (looks like invalid octal number)} {expected floating-point number but got "- 0"} 0.0 10.0 2.0} + # cleanup ::tcltest::cleanupTests return + +# Local Variables: +# mode: tcl +# End: -- cgit v0.12 From f3e9f9caa3f8a7c72efbf590c1f0cc0a836d6338 Mon Sep 17 00:00:00 2001 From: dkf Date: Sun, 9 Oct 2016 16:01:53 +0000 Subject: [62b36e326c] Noted edge case in behaviour of [concat] with empty arguments. --- doc/concat.n | 1 + 1 file changed, 1 insertion(+) diff --git a/doc/concat.n b/doc/concat.n index 252f52c..f68a06e 100644 --- a/doc/concat.n +++ b/doc/concat.n @@ -21,6 +21,7 @@ This command joins each of its arguments together with spaces after trimming leading and trailing white-space from each of them. If all the arguments are lists, this has the same effect as concatenating them into a single list. +Arguments that are empty (after trimming) are ignored entirely. It permits any number of arguments; if no \fIarg\fRs are supplied, the result is an empty string. .SH EXAMPLES -- cgit v0.12 From d81daf76bdb5794b66511feb620c36e932e9ac99 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 11 Oct 2016 21:35:27 +0000 Subject: Fix [3cc1d91345]: duplicate calls to TclpFreeAllocCache() on thread exists --- unix/tclUnixInit.c | 2 +- unix/tclUnixThrd.c | 7 ++++--- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c index a8cd00d..a873f6e 100644 --- a/unix/tclUnixInit.c +++ b/unix/tclUnixInit.c @@ -833,7 +833,7 @@ TclpSetVariables( CFLocaleRef localeRef; - if (CFLocaleCopyCurrent != NULL && CFLocaleGetIdentifier != NULL && + if (&CFLocaleCopyCurrent != NULL && &CFLocaleGetIdentifier != NULL && (localeRef = CFLocaleCopyCurrent())) { CFStringRef locale = CFLocaleGetIdentifier(localeRef); diff --git a/unix/tclUnixThrd.c b/unix/tclUnixThrd.c index a7a294d..1841242 100644 --- a/unix/tclUnixThrd.c +++ b/unix/tclUnixThrd.c @@ -810,7 +810,8 @@ TclpFreeAllocCache( { if (ptr != NULL) { /* - * Called by the pthread lib when a thread exits + * Called by TclFinalizeThreadAllocThread() during the thread + * finalization initiated from Tcl_FinalizeThread() */ TclFreeAllocCache(ptr); @@ -818,7 +819,7 @@ TclpFreeAllocCache( } else if (initialized) { /* - * Called by us in TclFinalizeThreadAlloc() during the library + * Called by TclFinalizeThreadAlloc() during the process * finalization initiated from Tcl_Finalize() */ @@ -833,7 +834,7 @@ TclpGetAllocCache(void) if (!initialized) { pthread_mutex_lock(allocLockPtr); if (!initialized) { - pthread_key_create(&key, TclpFreeAllocCache); + pthread_key_create(&key, NULL); initialized = 1; } pthread_mutex_unlock(allocLockPtr); -- cgit v0.12 From c482675d8403f441c50101cdd590df8ca6472ef5 Mon Sep 17 00:00:00 2001 From: dkf Date: Wed, 12 Oct 2016 09:57:15 +0000 Subject: [74bc0e44f5] Doc tweak. --- doc/http.n | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/doc/http.n b/doc/http.n index c6e8983..26f1298 100644 --- a/doc/http.n +++ b/doc/http.n @@ -371,7 +371,8 @@ set token [::http::geturl https://my.secure.site/] This procedure unregisters a protocol handler that was previously registered via \fB::http::register\fR, returning a two-item list of the default port and handler command that was previously installed -(via \fB::http::register\fR) if there was such a handler. +(via \fB::http::register\fR) if there was such a handler, and an error if +there was no such handler. .SH ERRORS The \fB::http::geturl\fR procedure will raise errors in the following cases: invalid command line options, -- cgit v0.12 From 29fdaa6dcd98bd9740a37b6555b0fa7ac20ab45e Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 12 Oct 2016 13:31:07 +0000 Subject: [be003d570f] TclParseNumber() failed to fully implement TCL_PARSE_OCTAL_ONLY. --- generic/tclStrToD.c | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index d05fe5d..b89ce45 100644 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c @@ -589,6 +589,9 @@ TclParseNumber( acceptPoint = p; acceptLen = len; if (c == 'x' || c == 'X') { + if (flags & TCL_PARSE_OCTAL_ONLY) { + goto endgame; + } state = ZERO_X; break; } @@ -599,6 +602,9 @@ TclParseNumber( goto zeroo; } if (c == 'b' || c == 'B') { + if (flags & TCL_PARSE_OCTAL_ONLY) { + goto endgame; + } state = ZERO_B; break; } -- cgit v0.12 From 326e0a8fdf312bb1823539ec064b5ecacb3dac58 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 12 Oct 2016 13:38:28 +0000 Subject: Add a test too. --- tests/scan.test | 3 +++ 1 file changed, 3 insertions(+) diff --git a/tests/scan.test b/tests/scan.test index 109746f..68c44b0 100644 --- a/tests/scan.test +++ b/tests/scan.test @@ -439,6 +439,9 @@ test scan-5.13 {integer scanning and overflow} { test scan-5.14 {integer scanning} { scan 0xff %u } 0 +test scan-5.15 {Bug be003d570f} { + scan 0x40 %o +} 0 test scan-6.1 {floating-point scanning} { set a {}; set b {}; set c {}; set d {} -- cgit v0.12 From 66f257a58823378a79c3fb14169ed308b3b04d29 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 12 Oct 2016 13:46:14 +0000 Subject: [be003d570f] TclParseNumber() failed to fully implement TCL_PARSE_BINARY_ONLY. --- generic/tclStrToD.c | 2 +- tests/scan.test | 3 +++ 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index dc85124..6da6df3 100644 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c @@ -630,7 +630,7 @@ TclParseNumber( acceptPoint = p; acceptLen = len; if (c == 'x' || c == 'X') { - if (flags & TCL_PARSE_OCTAL_ONLY) { + if (flags & (TCL_PARSE_OCTAL_ONLY|TCL_PARSE_BINARY_ONLY)) { goto endgame; } state = ZERO_X; diff --git a/tests/scan.test b/tests/scan.test index d814ce9..7540c9c 100644 --- a/tests/scan.test +++ b/tests/scan.test @@ -538,6 +538,9 @@ test scan-5.14 {integer scanning} { test scan-5.15 {Bug be003d570f} { scan 0x40 %o } 0 +test scan-5.16 {Bug be003d570f} { + scan 0x40 %b +} 0 test scan-6.1 {floating-point scanning} -setup { set a {}; set b {}; set c {}; set d {} -- cgit v0.12