Implement queuing and pipelining for HTTP requests over a persistent connection.

3 files changed, 1799 insertions, 0 deletions

diff --git a/tests/httpPipeline.test b/tests/httpPipeline.test
new file mode 100644
index 0000000..017661d
--- /dev/null
+++ b/tests/httpPipeline.test
@@ -0,0 +1,859 @@
+# httpPipeline.test
+#
+#	Test HTTP/1.1 concurrent requests including
+#	queueing, pipelining and retries.
+#
+# Copyright (C) 2018 Keith Nash <kjnash@users.sourceforge.net>
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+package require tcltest 2
+namespace import -force ::tcltest::*
+
+package require http 2.8
+
+set sourcedir [file normalize [file dirname [info script]]]
+source [file join $sourcedir httpTest.tcl]
+source [file join $sourcedir httpTestScript.tcl]
+
+# ------------------------------------------------------------------------------
+# (1) Define the test scripts that will be used to generate logs for analysis -
+#     and also define the "correct" results.
+# ------------------------------------------------------------------------------
+
+proc ReturnTestScriptAndResult {ca cb delay te} {
+
+    switch -- $ca {
+	1     {set start {
+	    START
+	    KEEPALIVE 0
+	    PIPELINE  0
+	}}
+
+	2     {set start {
+	    START
+	    KEEPALIVE 0
+	    PIPELINE  1
+	}}
+
+	3     {set start {
+	    START
+	    KEEPALIVE 1
+	    PIPELINE  0
+	}}
+
+	4     {set start {
+	    START
+	    KEEPALIVE 1
+	    PIPELINE  1
+	}}
+
+	default {
+	    return -code error {no matching script}
+	}
+    }
+
+    set middle "
+	    [list DELAY $delay]
+    "
+
+    switch -- $cb {
+	1     {set end {
+	    GET a
+	    GET b
+	    GET c
+	    GET a
+	    STOP
+	    }
+	    set resShort {1 ? ? ?}
+	    set resLong  {1 2 3 4}
+	}
+
+	2     {set end {
+	    GET a
+	    HEAD b
+	    GET c
+	    HEAD a
+	    HEAD c
+	    STOP
+	    }
+	    set resShort {1 ? ? ? ?}
+	    set resLong  {1 2 3 4 5}
+	}
+
+	3     {set end {
+	    HEAD a
+	    GET b
+	    HEAD c
+	    HEAD b
+	    GET a
+	    GET b
+	    STOP
+	    }
+	    set resShort {1 ? ? ? ? ?}
+	    set resLong  {1 2 3 4 5 6}
+	}
+
+	4     {set end {
+	    GET a
+	    GET b
+	    GET c
+	    GET a
+	    POST b address=home code=brief paid=yes
+	    GET c
+	    GET a
+	    GET b
+	    GET c
+	    STOP
+	    }
+	    set resShort {1 ? ? ? 5 ? ? ? ?}
+	    set resLong  {1 2 3 4 5 6 7 8 9}
+	}
+
+	5     {set end {
+	    POST a address=home code=brief paid=yes
+	    POST b address=home code=brief paid=yes
+	    POST c address=home code=brief paid=yes
+	    POST a address=home code=brief paid=yes
+	    POST b address=home code=brief paid=yes
+	    POST c address=home code=brief paid=yes
+	    POST a address=home code=brief paid=yes
+	    POST b address=home code=brief paid=yes
+	    POST c address=home code=brief paid=yes
+	    STOP
+	    }
+	    set resShort {1 2 3 4 5 6 7 8 9}
+	    set resLong  {1 2 3 4 5 6 7 8 9}
+	}
+
+	6     {set end {
+	    POST a address=home code=brief paid=yes
+	    GET b address=home code=brief paid=yes
+	    POST c address=home code=brief paid=yes
+	    GET a address=home code=brief paid=yes
+	    GET b address=home code=brief paid=yes
+	    POST c address=home code=brief paid=yes
+	    POST a address=home code=brief paid=yes
+	    HEAD b address=home code=brief paid=yes
+	    GET c address=home code=brief paid=yes
+	    STOP
+	    }
+	    set resShort {1 ? 3 ? ? 6 7 ? ?}
+	    set resLong  {1 2 3 4 5 6 7 8 9}
+	}
+
+	7     {set end {
+	    GET b address=home code=brief paid=yes
+	    POST a address=home code=brief paid=yes
+	    GET a address=home code=brief paid=yes
+	    POST c address=home code=brief paid=yes
+	    GET b address=home code=brief paid=yes
+	    HEAD b address=home code=brief paid=yes
+	    POST c address=home code=brief paid=yes
+	    POST a address=home code=brief paid=yes
+	    GET c address=home code=brief paid=yes
+	    STOP
+	    }
+	    set resShort {1 2 ? 4 ? ? 7 8 ?}
+	    set resLong  {1 2 3 4 5 6 7 8 9}
+	}
+
+	8     {set end {
+	    # Telling the server to close the connection.
+	    GET a
+	    GET b close=y
+	    GET c
+	    GET a
+	    GET b
+	    GET c
+	    GET a
+	    GET b
+	    GET c
+	    STOP
+	    }
+	    set resShort {1 ? 3 ? ? ? ? ? ?}
+	    set resLong  {1 2 3 4 5 6 7 8 9}
+	}
+
+	9     {set end {
+	    # Telling the server to close the connection.
+	    GET a
+	    POST b close=y address=home code=brief paid=yes
+	    GET c
+	    GET a
+	    GET b
+	    GET c
+	    GET a
+	    GET b
+	    GET c
+	    STOP
+	    }
+	    set resShort {1 2 3 ? ? ? ? ? ?}
+	    set resLong  {1 2 3 4 5 6 7 8 9}
+	}
+
+	10     {set end {
+	    # Telling the server to close the connection.
+	    GET a
+	    GET b close=y
+	    POST c address=home code=brief paid=yes
+	    GET a
+	    GET b
+	    GET c
+	    GET a
+	    GET b
+	    GET c
+	    STOP
+	    }
+	    set resShort {1 ? 3 ? ? ? ? ? ?}
+	    set resLong  {1 2 3 4 5 6 7 8 9}
+	}
+
+	11    {set end {
+	    # Telling the server to close the connection twice.
+	    GET a
+	    GET b close=y
+	    GET c
+	    GET a
+	    GET b close=y
+	    GET c
+	    GET a
+	    GET b
+	    GET c
+	    STOP
+	    }
+	    set resShort {1 ? 3 ? ? 6 ? ? ?}
+	    set resLong  {1 2 3 4 5 6 7 8 9}
+	}
+
+	12    {set end {
+	    # Telling the server to delay before sending the response.
+	    GET a
+	    GET b delay=1
+	    GET c
+	    GET a
+	    GET b
+	    STOP
+	    }
+	    set resShort {1 ? ? ? ?}
+	    set resLong  {1 2 3 4 5}
+	}
+
+	13    {set end {
+	    # Making the server close the connection (time out).
+	    GET a
+	    WAIT 2000
+	    GET b
+	    GET c
+	    GET a
+	    GET b
+	    STOP
+	    }
+	    set resShort {1 2 ? ? ?}
+	    set resLong  {1 2 3 4 5}
+	}
+
+	14    {set end {
+	    # Making the server close the connection (time out) twice.
+	    GET a
+	    WAIT 2000
+	    GET b
+	    GET c
+	    GET a
+	    WAIT 2000
+	    GET b
+	    GET c
+	    GET a
+	    GET b
+	    GET c
+	    STOP
+	    }
+	    set resShort {1 2 ? ? 5 ? ? ? ?}
+	    set resLong  {1 2 3 4 5 6 7 8 9}
+	}
+
+	15    {set end {
+	    POST a address=home code=brief paid=yes
+	    POST b address=home code=brief paid=yes close=y delay=1
+	    POST c address=home code=brief paid=yes delay=1
+	    POST a address=home code=brief paid=yes close=y
+	    WAIT 2000
+	    POST b address=home code=brief paid=yes delay=1
+	    POST c address=home code=brief paid=yes close=y
+	    POST a address=home code=brief paid=yes
+	    POST b address=home code=brief paid=yes close=y
+	    POST c address=home code=brief paid=yes
+	    STOP
+	    }
+	    set resShort {1 2 3 4 5 6 7 8 9}
+	    set resLong  {1 2 3 4 5 6 7 8 9}
+	}
+
+	16    {set end {
+	    POST a address=home code=brief paid=yes
+	    GET b address=home code=brief paid=yes
+	    POST c address=home code=brief paid=yes close=y
+	    GET a address=home code=brief paid=yes
+	    GET b address=home code=brief paid=yes close=y
+	    POST c address=home code=brief paid=yes
+	    WAIT 2000
+	    POST a address=home code=brief paid=yes
+	    HEAD b address=home code=brief paid=yes close=y
+	    GET c address=home code=brief paid=yes
+	    STOP
+	    }
+	    set resShort {1 ? 3 4 ? 6 7 ? 9}
+	    set resLong  {1 2 3 4 5 6 7 8 9}
+	}
+
+	17    {set end {
+	    GET b address=home code=brief paid=yes
+	    POST a address=home code=brief paid=yes
+	    GET a address=home code=brief paid=yes
+	    POST c address=home code=brief paid=yes close=y
+	    GET b address=home code=brief paid=yes
+	    HEAD b address=home code=brief paid=yes close=y
+	    POST c address=home code=brief paid=yes
+	    WAIT 2000
+	    POST a address=home code=brief paid=yes
+	    WAIT 2000
+	    GET c address=home code=brief paid=yes
+	    STOP
+	    }
+	    set resShort {1 2 3 4 5 ? 7 8 9}
+	    set resLong  {1 2 3 4 5 6 7 8 9}
+	}
+
+
+	18    {set end {
+	    REPOST 0
+	    GET a
+	    WAIT 2000
+	    POST b address=home code=brief paid=yes
+	    GET c
+	    GET a
+	    STOP
+	    }
+	    set resShort {1 2 ? ?}
+	    set resLong  {1 2 3 4}
+	    # resShort is overwritten below for the case ($te == 1).
+	}
+
+
+	19    {set end {
+	    REPOST 0
+	    GET a
+	    WAIT 2000
+	    GET b address=home code=brief paid=yes
+	    GET c
+	    GET a
+	    STOP
+	    }
+	    set resShort {1 2 ? ?}
+	    set resLong  {1 2 3 4}
+	}
+
+
+	20    {set end {
+	    POSTFRESH 1
+	    GET a
+	    WAIT 2000
+	    POST b address=home code=brief paid=yes
+	    GET c
+	    GET a
+	    STOP
+	    }
+	    set resShort {1 3 ?}
+	    set resLong  {1 3 4}
+	}
+
+
+	21    {set end {
+	    POSTFRESH 1
+	    GET a
+	    WAIT 2000
+	    GET b address=home code=brief paid=yes
+	    GET c
+	    GET a
+	    STOP
+	    }
+	    set resShort {1 2 ? ?}
+	    set resLong  {1 2 3 4}
+	}
+
+	22    {set end {
+	    GET a
+	    WAIT 2000
+	    KEEPALIVE 0
+	    POST b address=home code=brief paid=yes
+	    KEEPALIVE 1
+	    GET c
+	    GET a
+	    STOP
+	    }
+	    set resShort {1 3 ?}
+	    set resLong  {1 3 4}
+	}
+
+
+	23    {set end {
+	    GET a
+	    WAIT 2000
+	    KEEPALIVE 0
+	    GET b address=home code=brief paid=yes
+	    KEEPALIVE 1
+	    GET c
+	    GET a
+	    STOP
+	    }
+	    set resShort {1 3 ?}
+	    set resLong  {1 3 4}
+	}
+
+	24    {set end {
+	    GET a
+	    KEEPALIVE 0
+	    POST b address=home code=brief paid=yes
+	    KEEPALIVE 1
+	    GET c
+	    GET a
+	    STOP
+	    }
+	    set resShort {1 ? ?}
+	    set resLong  {1 3 4}
+	}
+
+
+	25    {set end {
+	    GET a
+	    KEEPALIVE 0
+	    GET b address=home code=brief paid=yes
+	    KEEPALIVE 1
+	    GET c
+	    GET a
+	    STOP
+	    }
+	    set resShort {1 ? ?}
+	    set resLong  {1 3 4}
+	}
+
+	default {
+	    return -code error {no matching script}
+	}
+    }
+
+
+    if {$ca < 3} {
+	# Not Keep-Alive.
+        set result "Passed all sanity checks."
+
+    } elseif {$ca == 3} {
+        # Keep-Alive, not pipelined.
+        set result {}
+        append result "Passed all sanity checks.\n"
+        append result "Have overlaps including response body:\n"
+
+    } else {
+        # Keep-Alive, pipelined: ($ca == 4)
+        set result {}
+        append result "Passed all sanity checks.\n"
+        append result "Overlap-free without response body:\n"
+        append result "$resShort"
+    }
+
+    # - The special case of test *.18*-testEof needs test results to be
+    #   individually written.
+    # - These test -repost 0 when there is a POST to apply it to, and the server
+    #   timeout has not been detected.
+    if {($cb == 18) && ($te == 1)} {
+        if {$ca < 3} {
+	    # Not Keep-Alive.
+	    set result "Passed all sanity checks."
+
+	} elseif {$ca == 3 && $delay == 0} {
+	    # Keep-Alive, not pipelined.
+            set result [MakeMessage {
+		|Problems with sanity checks:
+		|Wrong sequence for token ::http::2 - {A B C D X X X}
+		|- and error(s) X
+		|Wrong sequence for token ::http::3 - {A X X}
+		|- and error(s) X
+		|Wrong sequence for token ::http::4 - {A X X X}
+		|- and error(s) X
+		|
+		|Have overlaps including response body:
+		|
+	    }]
+
+	} elseif {$ca == 3} {
+	    # Keep-Alive, not pipelined.
+            set result [MakeMessage {
+		|Problems with sanity checks:
+		|Wrong sequence for token ::http::2 - {A B C D X X X}
+		|- and error(s) X
+		|
+		|Have overlaps including response body:
+		|
+	    }]
+
+	} elseif {$delay == 0} {
+	    # Keep-Alive, pipelined: ($ca == 4)
+            set result [MakeMessage {
+		|Problems with sanity checks:
+		|Wrong sequence for token ::http::2 - {A B C D X X X}
+		|- and error(s) X
+		|Wrong sequence for token ::http::3 - {A X X}
+		|- and error(s) X
+		|Wrong sequence for token ::http::4 - {A X X X}
+		|- and error(s) X
+		|
+		|Overlap-free without response body:
+		|
+	    }]
+
+	} else {
+            set result [MakeMessage {
+		|Problems with sanity checks:
+		|Wrong sequence for token ::http::2 - {A B C D X X X}
+		|- and error(s) X
+		|
+		|Overlap-free without response body:
+		|
+	    }]
+
+        }
+    }
+
+    return [list "$start$middle$end" $result]
+}
+
+# ------------------------------------------------------------------------------
+#  Proc MakeMessage
+# ------------------------------------------------------------------------------
+# WHD's one-line command to generate multi-line strings from readable code.
+# 
+# Example:
+#   set blurb [MakeMessage {
+#            |This command allows multi-line strings to be created with readable
+#            |code, and without breaking the rules for indentation.
+#            |
+#            |The command shifts the entire block of text to the left, omitting
+#            |the pipe character and the spaces to its left.
+#   }]
+# ------------------------------------------------------------------------------
+
+proc MakeMessage {in} {
+    regsub -all -line {^\s*\|} [string trim $in] {}
+    # N.B. Implicit Return.
+}
+
+
+proc ReturnTestScript {ca cb delay te} {
+    lassign [ReturnTestScriptAndResult $ca $cb $delay $te] script result
+    return $script
+}
+
+proc ReturnTestResult {ca cb delay te} {
+    lassign [ReturnTestScriptAndResult $ca $cb $delay $te] script result
+    return $result
+}
+
+
+# ------------------------------------------------------------------------------
+# (2) Command to run a test script and use httpTest to analyse the logs.
+# ------------------------------------------------------------------------------
+
+namespace import httpTestScript::runHttpTestScript
+namespace import httpTestScript::cleanupHttpTestScript
+
+proc RunTest {header footer delay te} {
+    set num [runHttpTestScript [ReturnTestScript $header $footer $delay $te]]
+    set skipOverlaps 0
+    set notIncluded {}
+
+    # --------------------------------------------------------------------------
+    # Custom code for specific tests
+    # --------------------------------------------------------------------------
+    if {$header < 3} {
+        set skipOverlaps 1
+        for {set i 1} {$i <= $num} {incr i} {
+	    lappend notIncluded $i
+        }
+    } elseif {$header > 2 && $footer == 18 && $te == 1} {
+        set skipOverlaps 1
+        if {$delay == 0} {
+	    # Transaction 1 is conventional.
+	    # Check that transactions 2,3,4 are cancelled.
+	    set notIncluded {1}
+        } else {
+	    # Transaction 1 is conventional.
+	    # Check that transaction 2 is cancelled.
+	    # The timing of transactions 3 and 4 is uncertain.
+	    set notIncluded {1 3 4}
+	}
+    } elseif {$footer in {20 22 23 24 25}} {
+	# Transaction 2 uses its own socket.
+	set notIncluded 2
+    } else {
+    }
+    # --------------------------------------------------------------------------
+    # End of custom code for specific tests
+    # --------------------------------------------------------------------------
+
+
+    set Results [httpTest::LogAnalyse $num $skipOverlaps $notIncluded $notIncluded]
+    lassign $Results msg cleanE cleanF dirtyE dirtyF
+    if {$msg eq {}} {
+        set msg "Passed all sanity checks."
+    } else {
+        set msg "Problems with sanity checks:\n$msg"
+    }
+
+    if 0 {
+        puts $msg
+        puts "Overlap-free including response body:\n$cleanF"
+        puts "Have overlaps including response body:\n$dirtyF"
+        puts "Overlap-free without response body:\n$cleanE"
+        puts "Have overlaps without response body:\n$dirtyE"
+    }
+
+    if {$header < 3} {
+        # No ordering, just check that transactions all finish
+        set result $msg
+    } elseif {$header == 3} {
+        # Not pipelined - check overlaps with response body.
+        set result "$msg\nHave overlaps including response body:\n$dirtyF"
+    } else {
+        # Pipelined - check overlaps without response body.  Check that the
+        # first request, the first requests after replay, and POSTs are clean.
+        set result "$msg\nOverlap-free without response body:\n$cleanE"
+    }
+    set ::nTokens $num
+    return $result
+}
+
+
+# ------------------------------------------------------------------------------
+# (3) VERBOSITY CONTROL
+# ------------------------------------------------------------------------------
+# If tests fail, run an individual test with -verbose 1 or 2 for diagnosis.
+# If still obscure, uncomment #Log and ##Log lines in the http package.
+# ------------------------------------------------------------------------------
+
+set ::httpTest::testOptions(-verbose) 0
+
+
+# ------------------------------------------------------------------------------
+# (4) Define the base URLs used for testing.  Each must have a query string.
+# ------------------------------------------------------------------------------
+# - A HTTP/1.1 server is required.  It should be configured to provide
+#   persistent connections when requested to do so, and to close these
+#   connections if they are idle for one second.
+# - The resource must be served with status 200 in response to a valid GET or
+#   POST.
+# - The value of "page" is always specified in the query-string. Different
+#   resources for the three values of "page" allow testing of both chunked and
+#   unchunked transfer encoding.
+# - The variables "close" and "delay" may be specified in the query-string (for
+#   a GET) or the request body (for a POST).
+#   - "delay" is a numerical value in seconds, and causes the server to delay
+#     the response, including headers.
+#   - "close", if it has the value "y", instructs the server to close the
+#     connection ater the current request.
+# - Any other variables should be ignored.
+# ------------------------------------------------------------------------------
+
+namespace eval ::httpTestScript {
+    variable URL
+    array set URL {
+        a  http://test-tcl-http.kerlin.org/index.html?page=privacy
+        b  http://test-tcl-http.kerlin.org/index.html?page=conditions
+        c  http://test-tcl-http.kerlin.org/index.html?page=welcome
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+# (5) Define the tests
+# ------------------------------------------------------------------------------
+# Constraints:
+# - serverNeeded - the URLs defined at (4) must be available, and must have the
+#                  properties specified there.
+# - duplicate    - the value of -pipeline does not matter if -keepalive 0
+# - timeout1s    - tests that work correctly only if the server closes
+#                  persistent connections after one second.
+#
+# Server timeout of persistent connections should be 1s.  Delays of 2s are
+# intended to cause timeout.
+# Servers are usually configured to use a longer timeout: this will cause the
+# tests to fail.  The "2000" could be replaced with a larger number, but the
+# tests will then be inconveniently slow.
+# ------------------------------------------------------------------------------
+
+#testConstraint serverNeeded 1
+#testConstraint timeout1s 1
+#testConstraint duplicate 1
+
+# ------------------------------------------------------------------------------
+#  Proc SetTestEof - to edit the command ::http::KeepSocket
+# ------------------------------------------------------------------------------
+# The usual line in command ::http::KeepSocket is "    set TEST_EOF 0".
+# Whether the value set in the file is 0 or 1, change it here to the value
+# specified by the argument.
+#
+# It is worth doing all tests for both values of the argument.
+#
+# test 0  - ::http::KeepSocket is unchanged, detects server eof where possible
+#           and closes the connection.
+# test 1  - ::http::KeepSocket is edited, does not detect server eof, so the
+#           reaction to finding server eof can be tested without the difficulty
+#           of testing in the few milliseconds of an asynchronous close event.
+# ------------------------------------------------------------------------------
+
+proc SetTestEof {test} {
+    set body [info body ::http::KeepSocket]
+    set subs "    set TEST_EOF $test"
+    set count [regsub -line -all -- {^\s*set TEST_EOF .*$} $body $subs newBody]
+    if {$count != 1} {
+        return -code error {proc ::http::KeepSocket has unexpected form}
+    }
+    proc ::http::KeepSocket {token} $newBody
+    return
+}
+
+for {set header 1} {$header <= 4} {incr header} {
+    if {$header == 4} {
+	set ::httpTest::testOptions(-dotted) 1
+	set match glob
+    } else {
+	set ::httpTest::testOptions(-dotted) 0
+	set match exact
+    }
+
+    if {$header == 2} {
+        set cons0 {serverNeeded duplicate}
+    } else {
+        set cons0 serverNeeded
+    }
+
+    for {set footer 1} {$footer <= 25} {incr footer} {
+        foreach {delay label} {
+	       0 a
+	       1 b
+	       2 c
+	       3 d
+	       5 e
+	       8 f
+	      12 g
+	     100 h
+	     500 i
+	    2000 j
+	} {
+	  foreach te {0 1} {
+	    if {$te} {
+	        set tag testEof
+	    } else {
+	        set tag normal
+	    }
+	    set suffix {}
+	    set cons $cons0
+
+	    # ------------------------------------------------------------------
+	    # Custom code for individual tests
+	    # ------------------------------------------------------------------
+	    if {$footer in {18}} {
+		# Custom code:
+		if {($label eq "j") && ($te == 1)} {
+		    continue
+		}
+		if {$te == 1} {
+		    # The test (of REPOST 0) is useful if tag is "testEof"
+		    # (server timeout without client reaction).  The same test
+		    # has a different result if tag is "normal".
+
+		    set suffix " - extra test for -repost 0 - ::http::2 must be"
+		    append suffix " cancelled"
+		    if {($delay == 0)} {
+			append suffix ", along with  ::http::3  ::http::4 if"
+			append suffix " the test creates these before ::http::2"
+			append suffix " is cancelled"
+		    }
+		} else {
+		}
+	    } elseif {$footer in {19}} {
+		set suffix " - extra test for -repost 0"
+	    } elseif {$footer in {20 21}} {
+		set suffix " - extra test for -postfresh 1"
+		if {($footer == 20)} {
+		    append suffix " - ::http::2 uses a separate socket"
+		    append suffix ", other requests use a persistent connection"
+		}
+	    } elseif {$footer in {22 23 24 25}} {
+		append suffix " - ::http::2 uses a separate socket"
+		append suffix ", other requests use a persistent connection"
+	    } else {
+	    }
+
+	    if {($footer >= 13 && $footer <= 23)} {
+		# Test use WAIT and depend on server timeout before this time.
+		lappend cons timeout1s
+	    }
+	    # ------------------------------------------------------------------
+	    # End of custom code.
+	    # ------------------------------------------------------------------
+
+            set name "pipeline test header $header footer $footer delay $delay $tag$suffix"
+
+
+	    # Here's the test:
+            test http11-${header}.${footer}${label}-${tag} $name -constraints $cons \
+            -setup [string map [list TE $te] {
+                http::init
+                set http::http(uid) 0
+		# Restore default values for tests:
+		http::config -pipeline 1 -postfresh 0 -repost 1
+		SetTestEof {TE}
+	    }] -body [list RunTest $header $footer $delay $te] -cleanup {
+		# Restore default values for tests:
+		http::config -pipeline 1 -postfresh 0 -repost 1
+		cleanupHttpTestScript
+		SetTestEof 0
+		set ::httpTest::testResults {}
+		after 2000
+		# Wait for persistent sockets on the server to time out.
+	    } -result [ReturnTestResult $header $footer $delay $te] -match $match
+
+
+	  }
+
+	}
+    }
+}
+
+# ------------------------------------------------------------------------------
+# (*) Notes on tests *.18*-testEof, *.19*-testEof - these test -repost 0
+# ------------------------------------------------------------------------------
+# These tests are a bit awkward because the main test kit analyses whether all
+# requests are satisfied, with retries if necessary, and it has result analysis
+# for processing retry logs.
+# - *.18*-testEof tests that certain requests are NOT satisfied, so the analysis
+#   is a one-off.
+# - Tests *.18a-testEof depend on client/server timing - the test needs to call
+#   http::geturl for all requests before the POST (request 2) is cancelled.
+#   We test that requests 2, 3, 4 are all cancelled.
+# - Other tests *.18*-testEof may not request 3 and 4 in time for the to be
+#   added to the write queue before request 2 is completed. We simply check that
+#   request 2 is cancelled.
+# - The behaviour is different if all connections are allowed to time out
+#   (label "j").  This case is not needed to test -repost 0, and is omitted.
+# - Tests *.18*-normal and *.19* are conventional (-repost 0 should have no
+#   effect).
+# ------------------------------------------------------------------------------
+
+
+unset header footer delay label suffix match cons name te
+namespace delete ::httpTest
+namespace delete ::httpTestScript
+
+::tcltest::cleanupTests
diff --git a/tests/httpTest.tcl b/tests/httpTest.tcl
new file mode 100644
index 0000000..ad08048
--- /dev/null
+++ b/tests/httpTest.tcl
@@ -0,0 +1,431 @@
+# httpTest.tcl
+#
+#	Test HTTP/1.1 concurrent requests including
+#	queueing, pipelining and retries.
+#
+# Copyright (C) 2018 Keith Nash <kjnash@users.sourceforge.net>
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+# ------------------------------------------------------------------------------
+# "Package" httpTest for analysis of Log output of http requests.
+# ------------------------------------------------------------------------------
+# This is a specialised test kit for examining the presence, ordering, and
+# overlap of multiple HTTP transactions over a persistent ("Keep-Alive")
+# connection; and also for testing reconnection in accordance with RFC 7230 when
+# the connection is lost.
+#
+# This kit is probably not useful for other purposes.  It depends on the
+# presence of specific Log commands in the http library, and it interprets the
+# logs that these commands create.
+# ------------------------------------------------------------------------------
+
+package require http
+
+namespace eval ::http {
+    variable TestStartTimeInMs [clock milliseconds]
+}
+
+namespace eval ::httpTest {
+    variable testResults {}
+    variable testOptions
+    array set testOptions {
+        -verbose 0
+        -dotted  1
+    }
+    # -verbose - 0 quiet 1 write to stderr 2 write more
+    # -dotted  - (boolean) use dots for absences in lists of transactions
+}
+
+proc httpTest::Puts {txt} {
+    variable testOptions
+    if {$testOptions(-verbose) > 0} {
+        puts stderr $txt
+        flush stderr
+    }
+    return
+}
+
+# http::Log
+#
+# A special-purpose logger used for running tests.
+# - Processes Log calls that have "^" in their arguments, and records them in
+#   variable ::httpTest::testResults.
+# - Also writes them to stderr (using Puts) if ($testOptions(-verbose) > 0).
+# - Also writes Log calls that do not have "^", if ($testOptions(-verbose) > 1).
+
+proc http::Log {args} {
+    variable TestStartTimeInMs
+    set time [expr {[clock milliseconds] - $TestStartTimeInMs}]
+    set txt [list $time {*}$args]
+    if {[string first ^ $txt] != -1} {
+        ::httpTest::LogRecord $txt
+        ::httpTest::Puts $txt
+    } elseif {$::httpTest::testOptions(-verbose) > 1} {
+        ::httpTest::Puts $txt
+    }
+    return
+}
+
+
+# Called by http::Log (the "testing" version) to record logs for later analysis.
+
+proc httpTest::LogRecord {txt} {
+    variable testResults
+
+    set pos [string first ^ $txt]
+    set len [string length  $txt]
+    if {$pos > $len - 3} {
+        puts stderr "Logging Error: $txt"
+        puts stderr "Fix this call to Log in http-*.tm so it has ^ then\
+		a letter then a numeral."
+        flush stderr
+    } elseif {$pos == -1} {
+        # Called by mistake.
+    } else {
+        set letter [string index $txt [incr pos]]
+        set number [string index $txt [incr pos]]
+        # Max 9 requests!
+        lappend testResults [list $letter $number]
+    }
+
+    return
+}
+
+
+# ------------------------------------------------------------------------------
+# Commands for analysing the logs recorded when calling http::geturl.
+# ------------------------------------------------------------------------------
+
+# httpTest::TestOverlaps --
+#
+# The main test for correct behaviour of pipelined and sequential
+# (non-pipelined) transactions.  Other tests should be run first to detect
+# any inconsistencies in the data (e.g. absence of the elements that are
+# examined here).
+#
+# Examine the sequence $someResults for each transaction from 1 to $n,
+# ignoring any that are listed in $badTrans.
+# Determine whether the elements "B" to $term for one transaction overlap
+# elements "B" to $term for the previous and following transactions.
+#
+# Transactions in the list $badTrans are not included in "clean" or
+# "dirty", but their possible overlap with other transactions is noted.
+# Transactions in the list $notPiped are a subset of $badTrans, and
+# their possible overlap with other transactions is NOT noted.
+#
+# Arguments:
+# someResults - list of results, each of the form {letter numeral}
+# n           - number of HTTP transactions
+# term        - letter that indicated end of search range. "E" for testing
+#               overlaps from start of request to end of response headers.
+#               "F" to extend to the end of the response body.
+# msg         - the cumulative message from sanity checks.  Append to it only
+#               to report a test failure.
+# badTrans    - list of transaction numbers not to be assessed as "clean" or
+#               "dirty"
+# notPiped    - subset of badTrans.  List of transaction numbers that cannot
+#               taint another transaction by overlapping with it, because it
+#               used a different socket.
+#
+# Return value: [list $msg $clean $dirty]
+# msg   - warning messages: nothing will be appended to argument $msg if there
+#         is an error with the test.
+# clean - list of transactions that have no overlap with other transactions
+# dirty - list of transactions that have YES overlap with other transactions
+
+proc httpTest::TestOverlaps {someResults n term msg badTrans notPiped} {
+    variable testOptions
+
+    # Check whether transactions overlap:
+    set clean {}
+    set dirty {}
+    for {set i 1} {$i <= $n} {incr i} {
+        if {$i in $badTrans} {
+            continue
+        }
+        set myStart   [lsearch -exact $someResults [list B $i]]
+        set myEnd     [lsearch -exact $someResults [list $term $i]]
+
+        if {($myStart == -1 || $myEnd == -1)} {
+            set res "Cannot find positions of transaction $i"
+	    append msg $res \n
+	    Puts $res
+        }
+
+	set overlaps {}
+	for {set j $myStart} {$j <= $myEnd} {incr j} {
+	    lassign [lindex $someResults $j] letter number
+	    if {$number != $i && $letter ne "A" && $number ni $notPiped} {
+		lappend overlaps $number
+	    }
+	}
+
+        if {[llength $overlaps] == 0} {
+	    set res "Transaction $i has no overlaps"
+	    Puts $res
+	    lappend clean $i
+	    if {$testOptions(-dotted)} {
+		# N.B. results from different segments are concatenated.
+		lappend dirty .
+	    } else {
+	    }
+        } else {
+	    set res "Transaction $i overlaps with [join $overlaps { }]"
+	    Puts $res
+	    lappend dirty $i
+	    if {$testOptions(-dotted)} {
+		# N.B. results from different segments are concatenated.
+		lappend clean .
+	    } else {
+	    }
+        }
+    }
+    return [list $msg $clean $dirty]
+}
+
+# httpTest::PipelineNext --
+#
+# Test whether prevPair, pair are valid as consecutive elements of a pipelined
+# sequence (Start 1), (End 1), (Start 2), (End 2) ...
+# Numbers are integers increasing (by 1 if argument "any" is false), and need
+# not begin with 1.
+# The first element of the sequence has prevPair {} and is always passed as
+# valid.
+#
+# Arguments;
+# Start        - string that labels the start of a segment
+# End          - string that labels the end of a segment
+# prevPair     - previous "pair" (list of string and number) element of a
+#                sequence, or {} if argument "pair" is the first in the
+#                sequence.
+# pair         - current "pair" (list of string and number) element of a
+#                sequence
+# any          - (boolean) iff true, accept any increasing sequence of integers.
+#                If false, integers must increase by 1.
+#
+# Return value - boolean, true iff the two pairs are valid consecutive elements.
+
+proc httpTest::PipelineNext {Start End prevPair pair any} {
+    if {$prevPair eq {}} {
+        return 1
+    }
+
+    lassign $prevPair letter number
+    lassign $pair newLetter newNumber
+    if {$letter eq $Start} {
+	return [expr {($newLetter eq $End) && ($newNumber == $number)}]
+    } elseif {$any} {
+        set nxt [list $Start [expr {$number + 1}]]
+	return [expr {($newLetter eq $Start) && ($newNumber > $number)}]
+    } else {
+        set nxt [list $Start [expr {$number + 1}]]
+	return [expr {($newLetter eq $Start) && ($newNumber == $number + 1)}]
+    }
+}
+
+# httpTest::TestPipeline --
+#
+# Given a sequence of "pair" elements, check that the elements whose string is
+# $Start or $End form a valid pipeline. Ignore other elements.
+#
+# Return value: {} if valid pipeline, otherwise a non-empty error message.
+
+proc httpTest::TestPipeline {someResults n Start End msg desc badTrans} {
+    set sequence {}
+    set prevPair {}
+    set ok 1
+    set any [llength $badTrans]
+    foreach pair $someResults {
+        lassign $pair letter number
+        if {($letter in [list $Start $End]) && ($number ni $badTrans)} {
+            lappend sequence $pair
+            if {![PipelineNext $Start $End $prevPair $pair $any]} {
+		set ok 0
+		break
+            }
+            set prevPair $pair
+        }
+    }
+
+    if {!$ok} {
+        set res "$desc are not pipelined: {$sequence}"
+        append msg $res \n
+        Puts $res
+    }
+    return $msg
+}
+
+# httpTest::TestSequence --
+#
+# Examine each transaction from 1 to $n, ignoring any that are listed
+# in $badTrans.
+# Check that each transaction has elements A to F, in alphabetical order.
+
+proc httpTest::TestSequence {someResults n msg badTrans} {
+    variable testOptions
+
+    for {set i 1} {$i <= $n} {incr i} {
+        if {$i in $badTrans} {
+	    continue
+        }
+        set sequence {}
+        foreach pair $someResults {
+            lassign $pair letter number
+            if {$number == $i} {
+                lappend sequence $letter
+            }
+        }
+        if {$sequence eq {A B C D E F}} {
+        } else {
+            set res "Wrong sequence for token ::http::$i - {$sequence}"
+	    append msg $res \n
+	    Puts $res
+            if {"X" in $sequence} {
+                set res "- and error(s) X"
+		append msg $res \n
+		Puts $res
+            }
+            if {"Y" in $sequence} {
+                set res "- and warnings(s) Y"
+		append msg $res \n
+		Puts $res
+            }
+        }
+    }
+    return $msg
+}
+
+proc httpTest::MostAnalysis {someResults n msg skipOverlaps badTrans notPiped} {
+    variable testOptions
+
+    # Check that stages for "good" transactions are all present and correct:
+    set msg [TestSequence $someResults $n $msg $badTrans]
+
+    # Check that requests are pipelined:
+    set msg [TestPipeline $someResults $n B C $msg Requests $notPiped]
+
+    # Check that responses are pipelined:
+    set msg [TestPipeline $someResults $n D F $msg Responses $notPiped]
+
+    if {$skipOverlaps} {
+	set cleanE {}
+	set dirtyE {}
+	set cleanF {}
+	set dirtyF {}
+    } else {
+	Puts "Overlaps including response body (test for non-pipelined case)"
+	lassign [TestOverlaps $someResults $n F $msg $badTrans $notPiped] msg cleanF dirtyF
+
+	Puts "Overlaps without response body (test for pipelined case)"
+	lassign [TestOverlaps $someResults $n E $msg $badTrans $notPiped] msg cleanE dirtyE
+    }
+
+    return [list $msg $cleanE $cleanF $dirtyE $dirtyF]
+}
+
+# httpTest::ProcessRetries --
+#
+# Command to examine results for socket-changing records [PQR],
+# divide the results into segments for each connection, and analyse each segment
+# individually.
+# (Could add $sock to the logging to simplify this, but never mind.)
+#
+# In each segment, identify any transactions that are not included, and
+# any that are aborted, to assist subsequent testing.
+#
+# Prepend A records (socket-independent) to each segment for transactions that
+# were scheduled (by A) but not completed (by F).  Pass each segment to
+# MostAnalysis for processing.
+
+proc httpTest::ProcessRetries {someResults n msg skipOverlaps notIncluded notPiped} {
+    variable testOptions
+
+    set nextRetry [lsearch -glob -index 0 $someResults {[PQR]}]
+    if {$nextRetry == -1} {
+        return [MostAnalysis $someResults $n $msg $skipOverlaps $notIncluded $notPiped]
+    }
+    set badTrans $notIncluded
+    set tryCount 0
+    set try $nextRetry
+    incr tryCount
+    lassign [lindex $someResults $try] letter number
+    Puts "Processing retry [lindex $someResults $try]"
+    set beforeTry [lrange $someResults 0 $try-1]
+    Puts [join $beforeTry \n]
+    set afterTry [lrange $someResults $try+1 end]
+
+    set dummyTry   {}
+    for {set i 1} {$i <= $n} {incr i} {
+        set first [lsearch -exact $beforeTry [list A $i]]
+        set last  [lsearch -exact $beforeTry [list F $i]]
+        if {$first == -1} {
+	    set res "Transaction $i was not started in connection number $tryCount"
+	    # append msg $res \n
+	    Puts $res
+	    if {$i ni $badTrans} {
+		lappend badTrans $i
+	    } else {
+	    }
+        } elseif {$last == -1} {
+	    set res "Transaction $i was started but unfinished in connection number $tryCount"
+	    # append msg $res \n
+	    Puts $res
+	    lappend badTrans $i
+	    lappend dummyTry [list A $i]
+        } else {
+	    set res "Transaction $i was started and finished in connection number $tryCount"
+	    # append msg $res \n
+	    Puts $res
+	    lappend notIncluded $i
+        }
+    }
+
+    # Analyse the part of the results before the first replay:
+    set HeadResults [MostAnalysis $beforeTry $n $msg $skipOverlaps $badTrans $notPiped]
+    lassign $HeadResults msg cleanE1 cleanF1 dirtyE1 dirtyF1
+
+    # Pass the rest of the results to be processed recursively.
+    set afterTry [concat $dummyTry $afterTry]
+    set TailResults [ProcessRetries $afterTry $n $msg $skipOverlaps $notIncluded $notPiped]
+    lassign $TailResults msg cleanE2 cleanF2 dirtyE2 dirtyF2
+
+    set cleanE [concat $cleanE1 $cleanE2]
+    set cleanF [concat $cleanF1 $cleanF2]
+    set dirtyE [concat $dirtyE1 $dirtyE2]
+    set dirtyF [concat $dirtyF1 $dirtyF2]
+    return [list $msg $cleanE $cleanF $dirtyE $dirtyF]
+}
+
+proc httpTest::LogAnalyse {n skipOverlaps notIncluded notPiped} {
+    variable testResults
+    variable testOptions
+
+    # Check that each data item has the correct form {letter numeral}.
+    set ii 0
+    set ok 1
+    foreach pair $testResults {
+	lassign $pair letter number
+	if {    [string match {[A-Z]} $letter]
+	     && [string match {[0-9]} $number]
+	} {
+	    # OK
+	} else {
+	    set ok 0
+	    set res "Error: testResults has bad element {$pair} at position $ii"
+	    append msg $res \n
+	    Puts $res
+	}
+	incr ii
+    }
+
+    if {!$ok} {
+	return $msg
+    }
+    set msg {}
+
+    Puts [join $testResults \n]
+    ProcessRetries $testResults $n $msg $skipOverlaps $notIncluded $notPiped
+    # N.B. Implicit Return.
+}
diff --git a/tests/httpTestScript.tcl b/tests/httpTestScript.tcl
new file mode 100644
index 0000000..a826c81
--- /dev/null
+++ b/tests/httpTestScript.tcl
@@ -0,0 +1,509 @@
+# httpTestScript.tcl
+#
+#	Test HTTP/1.1 concurrent requests including
+#	queueing, pipelining and retries.
+#
+# Copyright (C) 2018 Keith Nash <kjnash@users.sourceforge.net>
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+# ------------------------------------------------------------------------------
+# "Package" httpTestScript for executing test scripts written in a convenient
+# shorthand.
+# ------------------------------------------------------------------------------
+
+# ------------------------------------------------------------------------------
+# Documentation for "package" httpTestScript.
+# ------------------------------------------------------------------------------
+# To use the package:
+# (a) define URLs as the values of elements in the array ::httpTestScript
+# (b) define a script in terms of the commands
+#         START STOP DELAY KEEPALIVE WAIT PIPELINE GET HEAD POST
+#     referring to URLs by the name of the corresponding array element.  The
+#     script can include any other Tcl commands, and evaluates in the
+#     httpTestScript namespace.
+# (c) Use the command httpTestScript::runHttpTestScript to evaluate the script.
+# (d) For tcltest tests, wrap the runHttpTestScript call in a suitable "test"
+#     command.
+# ------------------------------------------------------------------------------
+# START
+# Must be the first command of the script.
+#
+# STOP
+# Must be present in the script to avoid waiting for client timeout.
+# Usually the last command, but can be elsewhere to end a script prematurely.
+# Subsequent httpTestScript commands will have no effect.
+#
+# DELAY ms
+# If there are no WAIT commands, this sets the delay in ms between subsequent
+# calls to http::geturl.  Default 500ms.
+#
+# KEEPALIVE
+# Set the value passed to http::geturl for the -keepalive option.  The command
+# applies to subsequent requests in the script. Default 1.
+#
+# WAIT ms
+# Pause for a time in ms before sending subsequent requests.
+#
+# PIPELINE boolean
+# Set the value of -pipeline using http::config.  The last PIPELINE command
+# in the script applies to every request. Default 1.
+#
+# POSTFRESH boolean
+# Set the value of -postfresh using http::config.  The last POSTFRESH command
+# in the script applies to every request. Default 0.
+#
+# REPOST boolean
+# Set the value of -repost using http::config.  The last REPOST command
+# in the script applies to every request. Default 1 for httpTestScript.
+# (Default value in http is 0).
+#
+# GET uriCode ?arg ...?
+# Send a HTTP request using the GET method.
+# Arguments:
+# uriCode - the code for the base URI - the value must be stored in
+#           ::httpTestScript::URL($uriCode).
+# args    - strings that will be joined by "&" and appended to the query
+#           string with a preceding "&".
+#
+# HEAD uriCode ?arg ...?
+# Send a HTTP request using the HEAD method.
+# Arguments: as for GET
+#
+# POST uriCode ?arg ...?
+# Send a HTTP request using the POST method.
+# Arguments:
+# uriCode - the code for the base URI - the value must be stored in
+#           ::httpTestScript::URL($uriCode).
+# args    - strings that will be joined by "&" and used as the request body.
+# ------------------------------------------------------------------------------
+
+namespace eval ::httpTestScript {
+    namespace export runHttpTestScript cleanupHttpTestScript
+}
+
+# httpTestScript::START --
+# Initialise, and create a long-stop timeout.
+
+proc httpTestScript::START {} {
+    variable CountRequestedSoFar
+    variable RequestsWhenStopped
+    variable KeepAlive
+    variable Delay
+    variable TimeOutCode
+    variable TimeOutDone
+    variable StartDone
+    variable StopDone
+    variable CountFinishedSoFar
+    variable RequestList
+    variable RequestsMade
+    variable ExtraTime
+    variable ActualKeepAlive
+
+    if {[info exists StartDone] && ($StartDone == 1)} {
+        set msg {START has been called twice without an intervening STOP}
+        return -code error $msg
+    }
+
+    set StartDone 1
+    set StopDone 0
+    set TimeOutDone 0
+    set CountFinishedSoFar 0
+    set CountRequestedSoFar 0
+    set RequestList {}
+    set RequestsMade {}
+    set ExtraTime 0
+    set ActualKeepAlive 1
+
+    # Undefined until a STOP command:
+    unset -nocomplain RequestsWhenStopped
+
+    # Default values:
+    set KeepAlive 1
+    set Delay 500
+
+    # Default values for tests:
+    KEEPALIVE 1
+    PIPELINE  1
+    POSTFRESH 0
+    REPOST    1
+
+    set TimeOutCode [after 30000 httpTestScript::TimeOutNow]
+#    set TimeOutCode [after 4000 httpTestScript::TimeOutNow]
+    return
+}
+
+# httpTestScript::STOP --
+# Do not process any more commands.  The commands will be executed but will
+# silently do nothing.
+
+proc httpTestScript::STOP {} {
+    variable CountRequestedSoFar
+    variable CountFinishedSoFar
+    variable RequestsWhenStopped
+    variable TimeOutCode
+    variable StartDone
+    variable StopDone
+    variable RequestsMade
+
+    if {$StopDone} {
+        # Don't do anything on a second call.
+        return
+    }
+
+    if {![info exists StartDone]} {
+        return -code error {initialise the script by calling command START}
+    }
+
+    set StopDone 1
+    set StartDone 0
+    set RequestsWhenStopped $CountRequestedSoFar
+    unset -nocomplain StartDone
+
+    if {$CountFinishedSoFar == $RequestsWhenStopped} {
+        if {[info exists TimeOutCode]} {
+            after cancel $TimeOutCode
+        }
+        set ::httpTestScript::FOREVER 0
+    }
+    return
+}
+
+# httpTestScript::DELAY --
+# If there are no WAIT commands, this sets the delay in ms between subsequent
+# calls to http::geturl.  Default 500ms.
+
+proc httpTestScript::DELAY {t} {
+    variable StartDone
+    variable StopDone
+
+    if {$StopDone} {
+        return
+    }
+
+    if {![info exists StartDone]} {
+        return -code error {initialise the script by calling command START}
+    }
+
+    variable Delay
+
+    set Delay $t
+    return
+}
+
+# httpTestScript::KEEPALIVE --
+# Set the value passed to http::geturl for the -keepalive option.  Default 1.
+
+proc httpTestScript::KEEPALIVE {b} {
+    variable StartDone
+    variable StopDone
+
+    if {$StopDone} {
+        return
+    }
+
+    if {![info exists StartDone]} {
+        return -code error {initialise the script by calling command START}
+    }
+
+    variable KeepAlive
+    set KeepAlive $b
+    return
+}
+
+# httpTestScript::WAIT --
+# Pause for a time in ms before processing any more commands.
+
+proc httpTestScript::WAIT {t} {
+    variable StartDone
+    variable StopDone
+    variable ExtraTime
+
+    if {$StopDone} {
+        return
+    }
+
+    if {![info exists StartDone]} {
+        return -code error {initialise the script by calling command START}
+    }
+
+    if {(![string is integer -strict $t]) || $t < 0} {
+        return -code error {argument to WAIT must be a non-negative integer}
+    }
+
+    incr ExtraTime $t
+
+    return
+}
+
+# httpTestScript::PIPELINE --
+# Pass a value to http::config -pipeline.
+
+proc httpTestScript::PIPELINE {b} {
+    variable StartDone
+    variable StopDone
+
+    if {$StopDone} {
+        return
+    }
+
+    if {![info exists StartDone]} {
+        return -code error {initialise the script by calling command START}
+    }
+
+    ::http::config -pipeline $b
+    ::http::Log http(-pipeline) is now [::http::config -pipeline]
+    return
+}
+
+# httpTestScript::POSTFRESH --
+# Pass a value to http::config -postfresh.
+
+proc httpTestScript::POSTFRESH {b} {
+    variable StartDone
+    variable StopDone
+
+    if {$StopDone} {
+        return
+    }
+
+    if {![info exists StartDone]} {
+        return -code error {initialise the script by calling command START}
+    }
+
+    ::http::config -postfresh $b
+    ::http::Log http(-postfresh) is now [::http::config -postfresh]
+    return
+}
+
+# httpTestScript::REPOST --
+# Pass a value to http::config -repost.
+
+proc httpTestScript::REPOST {b} {
+    variable StartDone
+    variable StopDone
+
+    if {$StopDone} {
+        return
+    }
+
+    if {![info exists StartDone]} {
+        return -code error {initialise the script by calling command START}
+    }
+
+    ::http::config -repost $b
+    ::http::Log http(-repost) is now [::http::config -repost]
+    return
+}
+
+# httpTestScript::GET --
+# Send a HTTP request using the GET method.
+# Arguments:
+# uriCode - the code for the base URI - the value must be stored in
+#           ::httpTestScript::URL($uriCode).
+# args    - strings that will each be preceded by "&" and appended to the query
+#           string.
+
+proc httpTestScript::GET {uriCode args} {
+    variable RequestList
+    lappend RequestList GET
+    RequestAfter $uriCode 0 {} {*}$args
+    return
+}
+
+# httpTestScript::HEAD --
+# Send a HTTP request using the HEAD method.
+# Arguments: as for GET
+
+proc httpTestScript::HEAD {uriCode args} {
+    variable RequestList
+    lappend RequestList HEAD
+    RequestAfter $uriCode 1 {} {*}$args
+    return
+}
+
+# httpTestScript::POST --
+# Send a HTTP request using the POST method.
+# Arguments:
+# uriCode - the code for the base URI - the value must be stored in
+#           ::httpTestScript::URL($uriCode).
+# args    - strings that will be joined by "&" and used as the request body.
+
+proc httpTestScript::POST {uriCode args} {
+    variable RequestList
+    lappend RequestList POST
+    RequestAfter $uriCode 0 {use} {*}$args
+    return
+}
+
+
+proc httpTestScript::RequestAfter {uriCode validate query args} {
+    variable CountRequestedSoFar
+    variable Delay
+    variable ExtraTime
+    variable StartDone
+    variable StopDone
+    variable KeepAlive
+
+    if {$StopDone} {
+        return
+    }
+
+    if {![info exists StartDone]} {
+        return -code error {initialise the script by calling command START}
+    }
+
+    incr CountRequestedSoFar
+    set idelay [expr {($CountRequestedSoFar - 1) * $Delay + 10 + $ExtraTime}]
+
+    # Could pass values of -pipeline, -postfresh, -repost if it were
+    # useful to change these mid-script.
+    after $idelay [list httpTestScript::Requester $uriCode $KeepAlive $validate $query {*}$args]
+    return
+}
+
+proc httpTestScript::Requester {uriCode keepAlive validate query args} {
+    variable URL
+
+    ::http::config -accept {*/*}
+
+    set absUrl $URL($uriCode)
+    if {$query eq {}} {
+	if {$args ne {}} {
+	    append absUrl & [join $args &]
+	}
+	set queryArgs {}
+    } elseif {$validate} {
+        return -code error {cannot have both -validate (HEAD) and -query (POST)}
+    } else {
+	set queryArgs [list -query [join $args &]]
+    }
+
+    if {[catch {
+        ::http::geturl     $absUrl        \
+                -validate  $validate      \
+                -timeout   5000           \
+                {*}$queryArgs             \
+                -keepalive $keepAlive     \
+                -command   ::httpTestScript::WhenFinished
+    } token]} {
+        set msg $token
+        catch {puts stderr "Error: $msg"}
+        return
+    } else {
+        # Request will begin.
+    }
+
+    return
+
+}
+
+proc httpTestScript::TimeOutNow {} {
+    variable TimeOutDone
+
+    set TimeOutDone 1
+    set ::httpTestScript::FOREVER 0
+    return
+}
+
+proc httpTestScript::WhenFinished {hToken} {
+    variable CountFinishedSoFar
+    variable RequestsWhenStopped
+    variable TimeOutCode
+    variable StopDone
+    variable RequestList
+    variable RequestsMade
+    variable ActualKeepAlive
+
+    upvar #0 $hToken state
+
+    if {[catch {
+	if {    [info exists state(transfer)]
+	     && ($state(transfer) eq "chunked")
+	} {
+	    set Trans chunked
+	} else {
+	    set Trans unchunked
+	}
+
+	if {    [info exists ::httpTest::testOptions(-verbose)]
+	     && ($::httpTest::testOptions(-verbose) > 0)
+	} {
+	    puts "Token    $hToken
+Response $state(http)
+Status   $state(status)
+Method   $state(method)
+Transfer $Trans
+Size     $state(currentsize)
+URL      $state(url)
+"
+	}
+
+	if {!$state(-keepalive)} {
+	    set ActualKeepAlive 0
+	}
+
+	if {[info exists state(method)]} {
+	    lappend RequestsMade $state(method)
+	} else {
+	    lappend RequestsMade UNKNOWN
+	}
+	set tk [namespace tail $hToken]
+
+	if {    ($state(http) != {HTTP/1.1 200 OK})
+	     || ($state(status) != {ok})
+	     || (($state(currentsize) == 0) && ($state(method) ne "HEAD"))
+	} {
+	    ::http::Log ^X$tk unexpected result Response $state(http) Status $state(status) Size $state(currentsize) - token $hToken
+	}
+    } err]} {
+	::http::Log ^X$tk httpTestScript::WhenFinished failed with error status: $err - token $hToken
+    }
+
+    incr CountFinishedSoFar
+    if {$StopDone && ($CountFinishedSoFar == $RequestsWhenStopped)} {
+        if {[info exists TimeOutCode]} {
+            after cancel $TimeOutCode
+        }
+        if {$RequestsMade ne $RequestList && $ActualKeepAlive} {
+	    ::http::Log ^X$tk unexpected result - Script asked for "{$RequestList}" but got "{$RequestsMade}" - token $hToken
+        }
+        set ::httpTestScript::FOREVER 0
+    }
+
+    return
+}
+
+
+proc httpTestScript::runHttpTestScript {scr} {
+    variable TimeOutDone
+    variable RequestsWhenStopped
+
+    after idle [list namespace eval ::httpTestScript $scr]
+    vwait ::httpTestScript::FOREVER
+    # N.B. does not automatically execute in this namespace, unlike some other events.
+    # Release when all requests have been served or have timed out.
+
+    if {$TimeOutDone} {
+        return -code error {test script timed out}
+    }
+
+    return $RequestsWhenStopped
+}
+
+
+proc httpTestScript::cleanupHttpTestScript {} {
+    variable TimeOutDone
+    variable RequestsWhenStopped
+    
+    if {![info exists RequestsWhenStopped]} {
+	return -code error {Cleanup Failed: RequestsWhenStopped is undefined}
+    }
+
+    for {set i 1} {$i <= $RequestsWhenStopped} {incr i} {
+        http::cleanup ::http::$i
+    }
+
+    return
+}