diff options
author | dgp <dgp@users.sourceforge.net> | 2017-06-22 12:25:35 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2017-06-22 12:25:35 (GMT) |
commit | 69201f94bdcef502012a231e2100bceef5062f90 (patch) | |
tree | 318ce059db03075568b505a7caa2624fce436e13 /library/http | |
parent | 6aa0cc7188b6df1dac97b03bc0b9240aa780799b (diff) | |
parent | f57dacd4955b9dd474cfd9d4e4d55cac22990f6c (diff) | |
download | tcl-tip_463.zip tcl-tip_463.tar.gz tcl-tip_463.tar.bz2 |
merge trunktip_463
Diffstat (limited to 'library/http')
-rw-r--r-- | library/http/http.tcl | 26 | ||||
-rw-r--r-- | library/http/pkgIndex.tcl | 2 |
2 files changed, 19 insertions, 9 deletions
diff --git a/library/http/http.tcl b/library/http/http.tcl index ccd4cd1..0350808 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.8.10 +package provide http 2.8.11 namespace eval http { # Allow resourcing to not clobber existing data @@ -28,10 +28,19 @@ namespace eval http { # We need a useragent string of this style or various servers will refuse to # send us compressed content even when we ask for it. This follows the # de-facto layout of user-agent strings in current browsers. - set http(-useragent) "Mozilla/5.0\ - ([string totitle $::tcl_platform(platform)]; U;\ - $::tcl_platform(os) $::tcl_platform(osVersion))\ - http/[package provide http] Tcl/[package provide Tcl]" + # Safe interpreters do not have ::tcl_platform(os) or + # ::tcl_platform(osVersion). + if {[interp issafe]} { + set http(-useragent) "Mozilla/5.0\ + (Windows; U;\ + Windows NT 10.0)\ + http/[package provide http] Tcl/[package provide Tcl]" + } else { + set http(-useragent) "Mozilla/5.0\ + ([string totitle $::tcl_platform(platform)]; U;\ + $::tcl_platform(os) $::tcl_platform(osVersion))\ + http/[package provide http] Tcl/[package provide Tcl]" + } } proc init {} { @@ -197,9 +206,10 @@ proc http::Finish {token {errormsg ""} {skipCB 0}} { set state(error) [list $errormsg $errorInfo $errorCode] set state(status) "error" } - if { - ($state(status) eq "timeout") || ($state(status) eq "error") || - ([info exists state(connection)] && ($state(connection) eq "close")) + if { ($state(status) eq "timeout") + || ($state(status) eq "error") + || ([info exists state(-keepalive)] && !$state(-keepalive)) + || ([info exists state(connection)] && ($state(connection) eq "close")) } { CloseSocket $state(sock) $token } diff --git a/library/http/pkgIndex.tcl b/library/http/pkgIndex.tcl index 841b4eb..a0d28f1 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.8.10 [list tclPkgSetup $dir http 2.8.10 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}] +package ifneeded http 2.8.11 [list tclPkgSetup $dir http 2.8.11 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}] |