Tcl Source Code

Artifact [ef47e3779b]
Login
Bounty program for improvements to Tcl and certain Tcl packages.

Artifact ef47e3779bae67c05fcecad2477f0ea1e4c7018952738f3072138f38085a28c6:

Attachment "test-http-3.tcl" to ticket [46b6edad51] added by kjnash 2017-11-30 16:04:38. (unpublished)
#!/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.
# ------------------------------------------------------------------------------