diff options
author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2020-08-03 15:43:45 (GMT) |
---|---|---|
committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2020-08-03 15:43:45 (GMT) |
commit | d40f0fe1b3a6c3b142ddfa9bdd741f29a8a8e8eb (patch) | |
tree | 2e5636e507a5acba9a1a3c9f6f76f336423cff5c | |
parent | 0d231a3919435409be9374f0a792e364e804b20c (diff) | |
parent | ca51d20173c55f80a6d14a618d3d95880fb0e4f7 (diff) | |
download | tcl-d40f0fe1b3a6c3b142ddfa9bdd741f29a8a8e8eb.zip tcl-d40f0fe1b3a6c3b142ddfa9bdd741f29a8a8e8eb.tar.gz tcl-d40f0fe1b3a6c3b142ddfa9bdd741f29a8a8e8eb.tar.bz2 |
Merge 8.6
-rw-r--r-- | library/http/http.tcl | 33 | ||||
-rw-r--r-- | library/http/pkgIndex.tcl | 2 | ||||
-rw-r--r-- | macosx/tclMacOSXNotify.c | 2 | ||||
-rw-r--r-- | tests/chanio.test | 9 | ||||
-rw-r--r-- | tests/http11.test | 39 | ||||
-rw-r--r-- | tests/httpPipeline.test | 2 | ||||
-rw-r--r-- | tests/io.test | 11 | ||||
-rw-r--r-- | tests/socket.test | 4 | ||||
-rw-r--r-- | unix/Makefile.in | 4 | ||||
-rw-r--r-- | win/Makefile.in | 4 |
10 files changed, 87 insertions, 23 deletions
diff --git a/library/http/http.tcl b/library/http/http.tcl index a93e67b..f9ec8ca 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -11,7 +11,7 @@ package require Tcl 8.6- # Keep this in sync with pkgIndex.tcl and with the install directories in # Makefiles -package provide http 2.9.2 +package provide http 2.9.3 namespace eval http { # Allow resourcing to not clobber existing data @@ -721,7 +721,7 @@ proc http::geturl {url args} { body {} status "" http "" - connection close + connection keep-alive } set state(-keepalive) $defaultKeepalive set state(-strict) $strict @@ -1037,7 +1037,7 @@ proc http::geturl {url args} { } # Do not automatically close the connection socket. - set state(connection) {} + set state(connection) keep-alive } } @@ -2688,8 +2688,31 @@ proc http::Event {sock token} { } proxy-connection - connection { - set state(connection) \ - [string trim [string tolower $value]] + set tmpHeader [string trim [string tolower $value]] + # RFC 7230 Section 6.1 states that a comma-separated + # list is an acceptable value. According to + # https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Connection + # any comma-separated list implies keep-alive, but I + # don't see this in the RFC so we'll play safe and + # scan any list for "close". + if {$tmpHeader in {close keep-alive}} { + # The common cases, continue. + } elseif {[string first , $tmpHeader] == -1} { + # Not a comma-separated list, not "close", + # therefore "keep-alive". + set tmpHeader keep-alive + } else { + set tmpHeader keep-alive + set tmpCsl [split $tmpHeader ,] + # Optional whitespace either side of separator. + foreach el $tmpCsl { + if {[string trim $el] eq {close}} { + set tmpHeader close + break + } + } + } + set state(connection) $tmpHeader } } lappend state(meta) $key [string trim $value] diff --git a/library/http/pkgIndex.tcl b/library/http/pkgIndex.tcl index 4f5eafb..43cd86b 100644 --- a/library/http/pkgIndex.tcl +++ b/library/http/pkgIndex.tcl @@ -1,2 +1,2 @@ if {![package vsatisfies [package provide Tcl] 8.6-]} {return} -package ifneeded http 2.9.2 [list tclPkgSetup $dir http 2.9.2 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}] +package ifneeded http 2.9.3 [list tclPkgSetup $dir http 2.9.3 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}] diff --git a/macosx/tclMacOSXNotify.c b/macosx/tclMacOSXNotify.c index 7f451c7..bbbac65 100644 --- a/macosx/tclMacOSXNotify.c +++ b/macosx/tclMacOSXNotify.c @@ -20,13 +20,11 @@ * OSSpinLock, and the OSSpinLock was deprecated. */ -#if 0 #if MAC_OS_X_VERSION_MIN_REQUIRED >= 101200 #define USE_OS_UNFAIR_LOCK #include <os/lock.h> #undef TCL_MAC_DEBUG_NOTIFIER #endif -#endif #ifdef HAVE_COREFOUNDATION /* Traditional unix select-based notifier is * in tclUnixNotfy.c */ diff --git a/tests/chanio.test b/tests/chanio.test index 5989bfe..cdaf183 100644 --- a/tests/chanio.test +++ b/tests/chanio.test @@ -5642,7 +5642,9 @@ test chan-io-44.4 {FileEventProc procedure: eror in write event} -setup { catch {chan close $f2} catch {chan close $f3} } -result {bad-write {}} -test chan-io-44.5 {FileEventProc procedure: end of file} {stdio unixExecs openpipe fileevent} { +test chan-io-44.5 {FileEventProc procedure: end of file} -constraints { + stdio unixExecs openpipe fileevent +} -body { set f4 [openpipe r $path(cat) << foo] chan event $f4 readable [namespace code { if {[chan gets $f4 line] < 0} { @@ -5655,9 +5657,10 @@ test chan-io-44.5 {FileEventProc procedure: end of file} {stdio unixExecs openpi variable x initial vwait [namespace which -variable x] vwait [namespace which -variable x] - chan close $f4 set x -} {initial foo eof} +} -cleanup { + chan close $f4 +} -result {initial foo eof} chan close $f makeFile "foo bar" foo diff --git a/tests/http11.test b/tests/http11.test index 1e30802..762788e 100644 --- a/tests/http11.test +++ b/tests/http11.test @@ -10,7 +10,7 @@ package require tcltest 2 namespace import -force ::tcltest::* -package require http 2.8 +package require http 2.9 # start the server variable httpd_output @@ -60,6 +60,20 @@ proc meta {tok {key ""}} { return $meta } +proc state {tok {key ""}} { + upvar 1 $tok state + if {$key ne ""} { + if {[array names state -exact $key] ne {}} { + return $state($key) + } else { + return "" + } + } + set res [array get state] + dict set res body <elided> + return $res +} + proc check_crc {tok args} { set crc [meta $tok x-crc32] set data [expr {[llength $args] ? [lindex $args 0] : [http::data $tok]}] @@ -241,6 +255,29 @@ test http11-1.12 "normal,identity,chunked" -setup { halt_httpd } -result {ok {HTTP/1.1 200 OK} ok {} chunked} +test http11-1.13 "normal, 1.1 and keepalive as server default, no zip" -setup { + variable httpd [create_httpd] + set zipTmp [http::config -zip] + http::config -zip 0 +} -body { + set tok [http::geturl http://localhost:$httpd_port/testdoc.html?transfer= \ + -protocol 1.1 -keepalive 1 -timeout 10000] + http::wait $tok + set res1 [list [http::status $tok] [http::code $tok] [check_crc $tok] \ + [meta $tok connection] [meta $tok transfer-encoding] [state $tok reusing] [state $tok connection]] + set toj [http::geturl http://localhost:$httpd_port/testdoc.html?transfer= \ + -protocol 1.1 -keepalive 1 -timeout 10000] + http::wait $toj + set res2 [list [http::status $toj] [http::code $toj] [check_crc $toj] \ + [meta $toj connection] [meta $toj transfer-encoding] [state $toj reusing] [state $toj connection]] + concat $res1 -- $res2 +} -cleanup { + http::cleanup $tok + http::cleanup $toj + halt_httpd + http::config -zip $zipTmp +} -result {ok {HTTP/1.1 200 OK} ok {} {} 0 keep-alive -- ok {HTTP/1.1 200 OK} ok {} {} 1 keep-alive} + # ------------------------------------------------------------------------- test http11-2.0 "-channel" -setup { diff --git a/tests/httpPipeline.test b/tests/httpPipeline.test index 8de79b9..de1a7d8 100644 --- a/tests/httpPipeline.test +++ b/tests/httpPipeline.test @@ -11,7 +11,7 @@ package require tcltest 2 namespace import -force ::tcltest::* -package require http 2.8 +package require http 2.9 set sourcedir [file normalize [file dirname [info script]]] source [file join $sourcedir httpTest.tcl] diff --git a/tests/io.test b/tests/io.test index 86e426c..912f4c5 100644 --- a/tests/io.test +++ b/tests/io.test @@ -5946,7 +5946,9 @@ test io-44.4 {FileEventProc procedure: eror in write event} -constraints { catch {close $f2} catch {close $f3} } -result {bad-write {}} -test io-44.5 {FileEventProc procedure: end of file} {stdio unixExecs openpipe fileevent} { +test io-44.5 {FileEventProc procedure: end of file} -constraints { + stdio unixExecs openpipe fileevent +} -body { set f4 [open "|[list [interpreter] $path(cat) << foo]" r] fileevent $f4 readable [namespace code { if {[gets $f4 line] < 0} { @@ -5959,9 +5961,10 @@ test io-44.5 {FileEventProc procedure: end of file} {stdio unixExecs openpipe fi variable x initial vwait [namespace which -variable x] vwait [namespace which -variable x] - close $f4 set x -} {initial foo eof} +} -cleanup { + close $f4 +} -result {initial foo eof} close $f makeFile "foo bar" foo @@ -6841,9 +6844,9 @@ test io-50.5 {testing handler deletion vs reentrant calls} -constraints testchan set z "" set u toplevel update - close $f set z } -cleanup { + close $f } -result [list {del calling recursive} {del deleted notcalled} \ {del deleted myself} {del after update}] test io-50.6 {testing handler deletion vs reentrant calls} -constraints testchannelevent -setup { diff --git a/tests/socket.test b/tests/socket.test index 55b4f2f..87169ae 100644 --- a/tests/socket.test +++ b/tests/socket.test @@ -904,7 +904,7 @@ test socket_$af-5.1 {byte order problems, socket numbers, htons} -body { return {htons problem, should be disallowed, are you running as SU?} } return {couldn't open socket: not owner} -} -constraints [list socket supported_$af unix notRoot] -result {couldn't open socket: not owner} +} -constraints [list socket supported_$af unix notRoot notOSX] -result {couldn't open socket: not owner} test socket_$af-5.2 {byte order problems, socket numbers, htons} -body { if {![catch {socket -server dodo 0x10000} msg]} { close $msg @@ -918,7 +918,7 @@ test socket_$af-5.3 {byte order problems, socket numbers, htons} -body { return {htons problem, should be disallowed, are you running as SU?} } return {couldn't open socket: not owner} -} -constraints [list socket supported_$af unix notRoot] -result {couldn't open socket: not owner} +} -constraints [list socket supported_$af unix notRoot notOSX] -result {couldn't open socket: not owner} test socket_$af-6.1 {accept callback error} -constraints [list socket supported_$af stdio] -setup { proc myHandler {msg options} { diff --git a/unix/Makefile.in b/unix/Makefile.in index 5a023e2..3e0dd1e 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -944,8 +944,8 @@ install-libraries: libraries do \ $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/http1.0"; \ done; - @echo "Installing package http 2.9.2 as a Tcl Module"; - @$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/8.6/http-2.9.2.tm"; + @echo "Installing package http 2.9.3 as a Tcl Module"; + @$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/8.6/http-2.9.3.tm"; @echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/"; @for i in $(TOP_DIR)/library/opt/*.tcl ; \ do \ diff --git a/win/Makefile.in b/win/Makefile.in index 651f6b2..7c0db47 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -719,8 +719,8 @@ install-libraries: libraries install-tzdata install-msgs do \ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http1.0"; \ done; - @echo "Installing package http 2.9.2 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/8.6/http-2.9.2.tm"; + @echo "Installing package http 2.9.3 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/8.6/http-2.9.3.tm"; @echo "Installing library opt0.4 directory"; @for j in $(ROOT_DIR)/library/opt/*.tcl; \ do \ |