diff options
author | sebres <sebres@users.sourceforge.net> | 2017-05-11 18:53:21 (GMT) |
---|---|---|
committer | sebres <sebres@users.sourceforge.net> | 2017-05-11 18:53:21 (GMT) |
commit | c7ee05b881b42a4e4e39bbe519714eea4af7beba (patch) | |
tree | 7871ca975e33745ffa98d6cc3746e915a61fce21 /library/http | |
parent | db083499bfff8aee794512e3da2f0ad2f201f6b0 (diff) | |
parent | 53c066e2314b0166a9fe30fd1f0026bb48f0d1f3 (diff) | |
download | tcl-c7ee05b881b42a4e4e39bbe519714eea4af7beba.zip tcl-c7ee05b881b42a4e4e39bbe519714eea4af7beba.tar.gz tcl-c7ee05b881b42a4e4e39bbe519714eea4af7beba.tar.bz2 |
merge trunk (to sebres-trunk-timerate)
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..d950441 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}}}] |