Attachment "test-http-3.tcl" to
ticket [46b6edad51]
added by
kjnash
2017-11-30 16:04:38.
#!/usr/local/Tcl-8.6.7/bin/tclsh8.6
# ------------------------------------------------------------------------------
# Test Script for two HTTP requests using Keep-Alive.
# ------------------------------------------------------------------------------
# When the second request is made before the first response is complete, the
# first request fails. This appears to be a bug in HTTP pipelining. If this is
# difficult to fix, a possible workaround is not to use pipelining, i.e. for
# http::geturl to delay sending a request until the previous response has been
# received in full.
# ------------------------------------------------------------------------------
package require http
proc ::getUrl {KeepAlive absUrl} {
::http::config -accept {*/*}
if {[catch {
::http::geturl $absUrl \
-validate 0 \
-timeout 5000 \
-keepalive $KeepAlive \
-command ::WhenFinished
} token]} {
set msg $token
catch {puts "Error: $msg"}
return
} else {
# Request will begin.
catch {puts [list Token $token for $absUrl]}
}
return
}
proc ::WhenFinished {hToken} {
upvar #0 $hToken state
catch {puts "Token $hToken
Response $state(http)
Status $state(status)
Size $state(currentsize)
URL $state(url)"}
incr ::count
if {$::count == $::requests} {
set ::FOREVER 0
}
return
}
# ------------------------------------------------------------------------------
# Command ::fetches
# ------------------------------------------------------------------------------
# Arguments:
# KeepAlive - boolean, will be passed to ::http::geturl as the value of
# the -keepalive option.
# Delay - delay in ms between the first request and the second.
#
# If editing this command, set ::requests to the number of calls to getUrl.
# The value is used by command ::WhenFinished to end the script when all
# HTTP requests have either been fulfilled or have timed out.
# ------------------------------------------------------------------------------
proc ::fetches {KeepAlive Delay} {
after idle getUrl $KeepAlive $::URL1
after idle after $Delay getUrl $KeepAlive $::URL2
set ::requests 2
return
}
set URL1 http://www.osnews.com/story/30099/Ten_years_of_Icaros_Desktop
set URL2 http://www.osnews.com/story/30100/Adding_a_Graphics_Card_to_an_Amiga_500
set count 0
after idle fetches 1 50
vwait ::FOREVER
# ------------------------------------------------------------------------------
# Results
# ------------------------------------------------------------------------------
# With KeepAlive 1, the second request is fulfilled; the output indicates that
# the first request times out, unless the delay is long enough that pipelining
# is not needed.
#
# From my connection:
# Delay = 10 -- wireshark indicates that Tcl does not send the first HTTP
# request.
# Delay = 50 -- wireshark indicates that Tcl sends both HTTP requests, and both
# responses are received (but puts output implies that Tcl
# regards the first response as a timeout).
# Delay = 500 -- pipelining is not needed: the first response is complete before
# the second request is sent. Both requests are fulfilled.
# ------------------------------------------------------------------------------
