@zzz0350/ozon-listing-workbench 0.5.0 → 1.0.0

package/versions/0.5.0/_internal/tcl8/8.6/http-2.9.8.tm

@@ -1,3603 +0,0 @@
-# http.tcl --
-#
-#	Client-side HTTP for GET, POST, and HEAD commands. These routines can
-#	be used in untrusted code that uses the Safesock security policy.
-#	These procedures use a callback interface to avoid using vwait, which
-#	is not defined in the safe base.
-#
-# See the file "license.terms" for information on usage and redistribution of
-# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-
-package require Tcl 8.6-
-# Keep this in sync with pkgIndex.tcl and with the install directories in
-# Makefiles
-package provide http 2.9.8
-
-namespace eval http {
-    # Allow resourcing to not clobber existing data
-
-    variable http
-    if {![info exists http]} {
-	array set http {
-	    -accept */*
-	    -pipeline 1
-	    -postfresh 0
-	    -proxyhost {}
-	    -proxyport {}
-	    -proxyfilter http::ProxyRequired
-	    -repost 0
-	    -urlencoding utf-8
-	    -zip 1
-	}
-	# 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.
-	# 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 {} {
-	# Set up the map for quoting chars. RFC3986 Section 2.3 say percent
-	# encode all except: "... percent-encoded octets in the ranges of
-	# ALPHA (%41-%5A and %61-%7A), DIGIT (%30-%39), hyphen (%2D), period
-	# (%2E), underscore (%5F), or tilde (%7E) should not be created by URI
-	# producers ..."
-	for {set i 0} {$i <= 256} {incr i} {
-	    set c [format %c $i]
-	    if {![string match {[-._~a-zA-Z0-9]} $c]} {
-		set map($c) %[format %.2X $i]
-	    }
-	}
-	# These are handled specially
-	set map(\n) %0D%0A
-	variable formMap [array get map]
-
-	# Create a map for HTTP/1.1 open sockets
-	variable socketMapping
-	variable socketRdState
-	variable socketWrState
-	variable socketRdQueue
-	variable socketWrQueue
-	variable socketClosing
-	variable socketPlayCmd
-	if {[info exists socketMapping]} {
-	    # Close open sockets on re-init.  Do not permit retries.
-	    foreach {url sock} [array get socketMapping] {
-		unset -nocomplain socketClosing($url)
-		unset -nocomplain socketPlayCmd($url)
-		CloseSocket $sock
-	    }
-	}
-
-	# CloseSocket should have unset the socket* arrays, one element at
-	# a time.  Now unset anything that was overlooked.
-	# Traces on "unset socketRdState(*)" will call CancelReadPipeline and
-	# cancel any queued responses.
-	# Traces on "unset socketWrState(*)" will call CancelWritePipeline and
-	# cancel any queued requests.
-	array unset socketMapping
-	array unset socketRdState
-	array unset socketWrState
-	array unset socketRdQueue
-	array unset socketWrQueue
-	array unset socketClosing
-	array unset socketPlayCmd
-	array set socketMapping {}
-	array set socketRdState {}
-	array set socketWrState {}
-	array set socketRdQueue {}
-	array set socketWrQueue {}
-	array set socketClosing {}
-	array set socketPlayCmd {}
-    }
-    init
-
-    variable urlTypes
-    if {![info exists urlTypes]} {
-	set urlTypes(http) [list 80 ::socket]
-    }
-
-    variable encodings [string tolower [encoding names]]
-    # This can be changed, but iso8859-1 is the RFC standard.
-    variable defaultCharset
-    if {![info exists defaultCharset]} {
-	set defaultCharset "iso8859-1"
-    }
-
-    # Force RFC 3986 strictness in geturl url verification?
-    variable strict
-    if {![info exists strict]} {
-	set strict 1
-    }
-
-    # Let user control default keepalive for compatibility
-    variable defaultKeepalive
-    if {![info exists defaultKeepalive]} {
-	set defaultKeepalive 0
-    }
-
-    namespace export geturl config reset wait formatQuery quoteString
-    namespace export register unregister registerError
-    # - Useful, but not exported: data, size, status, code, cleanup, error,
-    #   meta, ncode, mapReply, init.  Comments suggest that "init" can be used
-    #   for re-initialisation, although the command is undocumented.
-    # - Not exported, probably should be upper-case initial letter as part
-    #   of the internals: getTextLine, make-transformation-chunked.
-}
-
-# http::Log --
-#
-#	Debugging output -- define this to observe HTTP/1.1 socket usage.
-#	Should echo any args received.
-#
-# Arguments:
-#     msg	Message to output
-#
-if {[info command http::Log] eq {}} {proc http::Log {args} {}}
-
-# http::register --
-#
-#     See documentation for details.
-#
-# Arguments:
-#     proto	URL protocol prefix, e.g. https
-#     port	Default port for protocol
-#     command	Command to use to create socket
-# Results:
-#     list of port and command that was registered.
-
-proc http::register {proto port command} {
-    variable urlTypes
-    set urlTypes([string tolower $proto]) [list $port $command]
-}
-
-# http::unregister --
-#
-#     Unregisters URL protocol handler
-#
-# Arguments:
-#     proto	URL protocol prefix, e.g. https
-# Results:
-#     list of port and command that was unregistered.
-
-proc http::unregister {proto} {
-    variable urlTypes
-    set lower [string tolower $proto]
-    if {![info exists urlTypes($lower)]} {
-	return -code error "unsupported url type \"$proto\""
-    }
-    set old $urlTypes($lower)
-    unset urlTypes($lower)
-    return $old
-}
-
-# http::config --
-#
-#	See documentation for details.
-#
-# Arguments:
-#	args		Options parsed by the procedure.
-# Results:
-#        TODO
-
-proc http::config {args} {
-    variable http
-    set options [lsort [array names http -*]]
-    set usage [join $options ", "]
-    if {[llength $args] == 0} {
-	set result {}
-	foreach name $options {
-	    lappend result $name $http($name)
-	}
-	return $result
-    }
-    set options [string map {- ""} $options]
-    set pat ^-(?:[join $options |])$
-    if {[llength $args] == 1} {
-	set flag [lindex $args 0]
-	if {![regexp -- $pat $flag]} {
-	    return -code error "Unknown option $flag, must be: $usage"
-	}
-	return $http($flag)
-    } else {
-	foreach {flag value} $args {
-	    if {![regexp -- $pat $flag]} {
-		return -code error "Unknown option $flag, must be: $usage"
-	    }
-	    set http($flag) $value
-	}
-    }
-}
-
-# http::Finish --
-#
-#	Clean up the socket and eval close time callbacks
-#
-# Arguments:
-#	token	    Connection token.
-#	errormsg    (optional) If set, forces status to error.
-#	skipCB      (optional) If set, don't call the -command callback. This
-#		    is useful when geturl wants to throw an exception instead
-#		    of calling the callback. That way, the same error isn't
-#		    reported to two places.
-#
-# Side Effects:
-#        May close the socket.
-
-proc http::Finish {token {errormsg ""} {skipCB 0}} {
-    variable socketMapping
-    variable socketRdState
-    variable socketWrState
-    variable socketRdQueue
-    variable socketWrQueue
-    variable socketClosing
-    variable socketPlayCmd
-
-    variable $token
-    upvar 0 $token state
-    global errorInfo errorCode
-    set closeQueue 0
-    if {$errormsg ne ""} {
-	set state(error) [list $errormsg $errorInfo $errorCode]
-	set state(status) "error"
-    }
-    if {[info commands ${token}EventCoroutine] ne {}} {
-	rename ${token}EventCoroutine {}
-    }
-
-    # Is this an upgrade request/response?
-    set upgradeResponse \
-	[expr {    [info exists state(upgradeRequest)] && $state(upgradeRequest)
-		&& [info exists state(http)] && [ncode $token] eq {101}
-		&& [info exists state(connection)] && "upgrade" in $state(connection)
-		&& [info exists state(upgrade)] && "" ne $state(upgrade)}]
-
-    if {  ($state(status) eq "timeout")
-       || ($state(status) eq "error")
-       || ($state(status) eq "eof")
-    } {
-	set closeQueue 1
-	set connId $state(socketinfo)
-	set sock $state(sock)
-	CloseSocket $state(sock) $token
-    } elseif {$upgradeResponse} {
-	# Special handling for an upgrade request/response.
-	# - geturl ensures that this is not a "persistent" socket used for
-	#   multiple HTTP requests, so a call to KeepSocket is not needed.
-	# - Leave socket open, so a call to CloseSocket is not needed either.
-	# - Remove fileevent bindings.  The caller will set its own bindings.
-	# - THE CALLER MUST PROCESS THE UPGRADED SOCKET IN THE CALLBACK COMMAND
-	#   PASSED TO http::geturl AS -command callback.
-	catch {fileevent $state(sock) readable {}}
-	catch {fileevent $state(sock) writable {}}
-    } elseif {([info exists state(-keepalive)] && !$state(-keepalive))
-	|| ([info exists state(connection)] && ("close" in $state(connection)))
-    } {
-	set closeQueue 1
-	set connId $state(socketinfo)
-	set sock $state(sock)
-	CloseSocket $state(sock) $token
-    } elseif {
-	  ([info exists state(-keepalive)] && $state(-keepalive))
-       && ([info exists state(connection)] && ("close" ni $state(connection)))
-    } {
-	KeepSocket $token
-    }
-    if {[info exists state(after)]} {
-	after cancel $state(after)
-	unset state(after)
-    }
-    if {[info exists state(-command)] && (!$skipCB)
-	    && (![info exists state(done-command-cb)])} {
-	set state(done-command-cb) yes
-	if {[catch {eval $state(-command) {$token}} err] && $errormsg eq ""} {
-	    set state(error) [list $err $errorInfo $errorCode]
-	    set state(status) error
-	}
-    }
-
-    if {    $closeQueue
-	 && [info exists socketMapping($connId)]
-	 && ($socketMapping($connId) eq $sock)
-    } {
-	http::CloseQueuedQueries $connId $token
-    }
-}
-
-# http::KeepSocket -
-#
-#	Keep a socket in the persistent sockets table and connect it to its next
-#	queued task if possible.  Otherwise leave it idle and ready for its next
-#	use.
-#
-#	If $socketClosing(*), then ("close" in $state(connection)) and therefore
-#	this command will not be called by Finish.
-#
-# Arguments:
-#	token	    Connection token.
-
-proc http::KeepSocket {token} {
-    variable http
-    variable socketMapping
-    variable socketRdState
-    variable socketWrState
-    variable socketRdQueue
-    variable socketWrQueue
-    variable socketClosing
-    variable socketPlayCmd
-
-    variable $token
-    upvar 0 $token state
-    set tk [namespace tail $token]
-
-    # Keep this socket open for another request ("Keep-Alive").
-    # React if the server half-closes the socket.
-    # Discussion is in http::geturl.
-    catch {fileevent $state(sock) readable [list http::CheckEof $state(sock)]}
-
-    # The line below should not be changed in production code.
-    # It is edited by the test suite.
-    set TEST_EOF 0
-    if {$TEST_EOF} {
-	# ONLY for testing reaction to server eof.
-	# No server timeouts will be caught.
-	catch {fileevent $state(sock) readable {}}
-    }
-
-    if {    [info exists state(socketinfo)]
-	 && [info exists socketMapping($state(socketinfo))]
-    } {
-	set connId $state(socketinfo)
-	# The value "Rready" is set only here.
-	set socketRdState($connId) Rready
-
-	if {    $state(-pipeline)
-	     && [info exists socketRdQueue($connId)]
-	     && [llength $socketRdQueue($connId)]
-	} {
-	    # The usual case for pipelined responses - if another response is
-	    # queued, arrange to read it.
-	    set token3 [lindex $socketRdQueue($connId) 0]
-	    set socketRdQueue($connId) [lrange $socketRdQueue($connId) 1 end]
-	    variable $token3
-	    upvar 0 $token3 state3
-	    set tk2 [namespace tail $token3]
-
-	    #Log pipelined, GRANT read access to $token3 in KeepSocket
-	    set socketRdState($connId) $token3
-	    ReceiveResponse $token3
-
-	    # Other pipelined cases.
-	    # - The test above ensures that, for the pipelined cases in the two
-	    #   tests below, the read queue is empty.
-	    # - In those two tests, check whether the next write will be
-	    #   nonpipeline.
-	} elseif {
-		$state(-pipeline)
-	     && [info exists socketWrState($connId)]
-	     && ($socketWrState($connId) eq "peNding")
-
-	     && [info exists socketWrQueue($connId)]
-	     && [llength $socketWrQueue($connId)]
-	     && (![set token3 [lindex $socketWrQueue($connId) 0]
-		   set ${token3}(-pipeline)
-		  ]
-		)
-	} {
-	    # This case:
-	    # - Now it the time to run the "pending" request.
-	    # - The next token in the write queue is nonpipeline, and
-	    #   socketWrState has been marked "pending" (in
-	    #   http::NextPipelinedWrite or http::geturl) so a new pipelined
-	    #   request cannot jump the queue.
-	    #
-	    # Tests:
-	    # - In this case the read queue (tested above) is empty and this
-	    #   "pending" write token is in front of the rest of the write
-	    #   queue.
-	    # - The write state is not Wready and therefore appears to be busy,
-	    #   but because it is "pending" we know that it is reserved for the
-	    #   first item in the write queue, a non-pipelined request that is
-	    #   waiting for the read queue to empty.  That has now happened: so
-	    #   give that request read and write access.
-	    variable $token3
-	    set conn [set ${token3}(tmpConnArgs)]
-	    #Log nonpipeline, GRANT r/w access to $token3 in KeepSocket
-	    set socketRdState($connId) $token3
-	    set socketWrState($connId) $token3
-	    set socketWrQueue($connId) [lrange $socketWrQueue($connId) 1 end]
-	    # Connect does its own fconfigure.
-	    fileevent $state(sock) writable [list http::Connect $token3 {*}$conn]
-	    #Log ---- $state(sock) << conn to $token3 for HTTP request (c)
-
-	} elseif {
-		$state(-pipeline)
-	     && [info exists socketWrState($connId)]
-	     && ($socketWrState($connId) eq "peNding")
-
-	} {
-	    # Should not come here.  The second block in the previous "elseif"
-	    # test should be tautologous (but was needed in an earlier
-	    # implementation) and will be removed after testing.
-	    # If we get here, the value "pending" was assigned in error.
-	    # This error would block the queue for ever.
-	    Log ^X$tk <<<<< Error in queueing of requests >>>>> - token $token
-
-	} elseif {
-		$state(-pipeline)
-	     && [info exists socketWrState($connId)]
-	     && ($socketWrState($connId) eq "Wready")
-
-	     && [info exists socketWrQueue($connId)]
-	     && [llength $socketWrQueue($connId)]
-	     && (![set token3 [lindex $socketWrQueue($connId) 0]
-		   set ${token3}(-pipeline)
-		  ]
-		)
-	} {
-	    # This case:
-	    # - The next token in the write queue is nonpipeline, and
-	    #   socketWrState is Wready.  Get the next event from socketWrQueue.
-	    # Tests:
-	    # - In this case the read state (tested above) is Rready and the
-	    #   write state (tested here) is Wready - there is no "pending"
-	    #   request.
-	    # Code:
-	    # - The code is the same as the code below for the nonpipelined
-	    #   case with a queued request.
-	    variable $token3
-	    set conn [set ${token3}(tmpConnArgs)]
-	    #Log nonpipeline, GRANT r/w access to $token3 in KeepSocket
-	    set socketRdState($connId) $token3
-	    set socketWrState($connId) $token3
-	    set socketWrQueue($connId) [lrange $socketWrQueue($connId) 1 end]
-	    # Connect does its own fconfigure.
-	    fileevent $state(sock) writable [list http::Connect $token3 {*}$conn]
-	    #Log ---- $state(sock) << conn to $token3 for HTTP request (c)
-
-	} elseif {
-		(!$state(-pipeline))
-	     && [info exists socketWrQueue($connId)]
-	     && [llength $socketWrQueue($connId)]
-	     && ("close" ni $state(connection))
-	} {
-	    # If not pipelined, (socketRdState eq Rready) tells us that we are
-	    # ready for the next write - there is no need to check
-	    # socketWrState. Write the next request, if one is waiting.
-	    # If the next request is pipelined, it receives premature read
-	    # access to the socket. This is not a problem.
-	    set token3 [lindex $socketWrQueue($connId) 0]
-	    variable $token3
-	    set conn [set ${token3}(tmpConnArgs)]
-	    #Log nonpipeline, GRANT r/w access to $token3 in KeepSocket
-	    set socketRdState($connId) $token3
-	    set socketWrState($connId) $token3
-	    set socketWrQueue($connId) [lrange $socketWrQueue($connId) 1 end]
-	    # Connect does its own fconfigure.
-	    fileevent $state(sock) writable [list http::Connect $token3 {*}$conn]
-	    #Log ---- $state(sock) << conn to $token3 for HTTP request (d)
-
-	} elseif {(!$state(-pipeline))} {
-	    set socketWrState($connId) Wready
-	    # Rready and Wready and idle: nothing to do.
-	}
-
-    } else {
-	CloseSocket $state(sock) $token
-	# There is no socketMapping($state(socketinfo)), so it does not matter
-	# that CloseQueuedQueries is not called.
-    }
-}
-
-# http::CheckEof -
-#
-#	Read from a socket and close it if eof.
-#	The command is bound to "fileevent readable" on an idle socket, and
-#	"eof" is the only event that should trigger the binding, occurring when
-#	the server times out and half-closes the socket.
-#
-#	A read is necessary so that [eof] gives a meaningful result.
-#	Any bytes sent are junk (or a bug).
-
-proc http::CheckEof {sock} {
-    set junk [read $sock]
-    set n [string length $junk]
-    if {$n} {
-	Log "WARNING: $n bytes received but no HTTP request sent"
-    }
-
-    if {[catch {eof $sock} res] || $res} {
-	# The server has half-closed the socket.
-	# If a new write has started, its transaction will fail and
-	# will then be error-handled.
-	CloseSocket $sock
-    }
-}
-
-# http::CloseSocket -
-#
-#	Close a socket and remove it from the persistent sockets table.  If
-#	possible an http token is included here but when we are called from a
-#	fileevent on remote closure we need to find the correct entry - hence
-#	the "else" block of the first "if" command.
-
-proc http::CloseSocket {s {token {}}} {
-    variable socketMapping
-    variable socketRdState
-    variable socketWrState
-    variable socketRdQueue
-    variable socketWrQueue
-    variable socketClosing
-    variable socketPlayCmd
-
-    set tk [namespace tail $token]
-
-    catch {fileevent $s readable {}}
-    set connId {}
-    if {$token ne ""} {
-	variable $token
-	upvar 0 $token state
-	if {[info exists state(socketinfo)]} {
-	    set connId $state(socketinfo)
-	}
-    } else {
-	set map [array get socketMapping]
-	set ndx [lsearch -exact $map $s]
-	if {$ndx >= 0} {
-	    incr ndx -1
-	    set connId [lindex $map $ndx]
-	}
-    }
-    if {    ($connId ne {})
-	 && [info exists socketMapping($connId)]
-	 && ($socketMapping($connId) eq $s)
-    } {
-	Log "Closing connection $connId (sock $socketMapping($connId))"
-	if {[catch {close $socketMapping($connId)} err]} {
-	    Log "Error closing connection: $err"
-	}
-	if {$token eq {}} {
-	    # Cases with a non-empty token are handled by Finish, so the tokens
-	    # are finished in connection order.
-	    http::CloseQueuedQueries $connId
-	}
-    } else {
-	Log "Closing socket $s (no connection info)"
-	if {[catch {close $s} err]} {
-	    Log "Error closing socket: $err"
-	}
-    }
-}
-
-# http::CloseQueuedQueries
-#
-#	connId  - identifier "domain:port" for the connection
-#	token   - (optional) used only for logging
-#
-# Called from http::CloseSocket and http::Finish, after a connection is closed,
-# to clear the read and write queues if this has not already been done.
-
-proc http::CloseQueuedQueries {connId {token {}}} {
-    variable socketMapping
-    variable socketRdState
-    variable socketWrState
-    variable socketRdQueue
-    variable socketWrQueue
-    variable socketClosing
-    variable socketPlayCmd
-
-    if {![info exists socketMapping($connId)]} {
-	# Command has already been called.
-	# Don't come here again - especially recursively.
-	return
-    }
-
-    # Used only for logging.
-    if {$token eq {}} {
-	set tk {}
-    } else {
-	set tk [namespace tail $token]
-    }
-
-    if {    [info exists socketPlayCmd($connId)]
-	 && ($socketPlayCmd($connId) ne {ReplayIfClose Wready {} {}})
-    } {
-	# Before unsetting, there is some unfinished business.
-	# - If the server sent "Connection: close", we have stored the command
-	#   for retrying any queued requests in socketPlayCmd, so copy that
-	#   value for execution below.  socketClosing(*) was also set.
-	# - Also clear the queues to prevent calls to Finish that would set the
-	#   state for the requests that will be retried to "finished with error
-	#   status".
-	set unfinished $socketPlayCmd($connId)
-	set socketRdQueue($connId) {}
-	set socketWrQueue($connId) {}
-    } else {
-	set unfinished {}
-    }
-
-    Unset $connId
-
-    if {$unfinished ne {}} {
-	Log ^R$tk Any unfinished transactions (excluding $token) failed \
-		- token $token
-	{*}$unfinished
-    }
-}
-
-# http::Unset
-#
-#	The trace on "unset socketRdState(*)" will call CancelReadPipeline
-#	and cancel any queued responses.
-#	The trace on "unset socketWrState(*)" will call CancelWritePipeline
-#	and cancel any queued requests.
-
-proc http::Unset {connId} {
-    variable socketMapping
-    variable socketRdState
-    variable socketWrState
-    variable socketRdQueue
-    variable socketWrQueue
-    variable socketClosing
-    variable socketPlayCmd
-
-    unset socketMapping($connId)
-    unset socketRdState($connId)
-    unset socketWrState($connId)
-    unset -nocomplain socketRdQueue($connId)
-    unset -nocomplain socketWrQueue($connId)
-    unset -nocomplain socketClosing($connId)
-    unset -nocomplain socketPlayCmd($connId)
-}
-
-# http::reset --
-#
-#	See documentation for details.
-#
-# Arguments:
-#	token	Connection token.
-#	why	Status info.
-#
-# Side Effects:
-#        See Finish
-
-proc http::reset {token {why reset}} {
-    variable $token
-    upvar 0 $token state
-    set state(status) $why
-    catch {fileevent $state(sock) readable {}}
-    catch {fileevent $state(sock) writable {}}
-    Finish $token
-    if {[info exists state(error)]} {
-	set errorlist $state(error)
-	unset state
-	eval ::error $errorlist
-    }
-}
-
-# http::geturl --
-#
-#	Establishes a connection to a remote url via http.
-#
-# Arguments:
-#	url		The http URL to goget.
-#	args		Option value pairs. Valid options include:
-#				-blocksize, -validate, -headers, -timeout
-# Results:
-#	Returns a token for this connection. This token is the name of an
-#	array that the caller should unset to garbage collect the state.
-
-proc http::geturl {url args} {
-    variable http
-    variable urlTypes
-    variable defaultCharset
-    variable defaultKeepalive
-    variable strict
-
-    # Initialize the state variable, an array. We'll return the name of this
-    # array as the token for the transaction.
-
-    if {![info exists http(uid)]} {
-	set http(uid) 0
-    }
-    set token [namespace current]::[incr http(uid)]
-    ##Log Starting http::geturl - token $token
-    variable $token
-    upvar 0 $token state
-    set tk [namespace tail $token]
-    reset $token
-    Log ^A$tk URL $url - token $token
-
-    # Process command options.
-
-    array set state {
-	-binary		false
-	-blocksize	8192
-	-queryblocksize 8192
-	-validate	0
-	-headers	{}
-	-timeout	0
-	-type		application/x-www-form-urlencoded
-	-queryprogress	{}
-	-protocol	1.1
-	binary		0
-	state		created
-	meta		{}
-	method		{}
-	coding		{}
-	currentsize	0
-	totalsize	0
-	querylength	0
-	queryoffset	0
-	type		text/html
-	body		{}
-	status		""
-	http		""
-	connection	keep-alive
-    }
-    set state(-keepalive) $defaultKeepalive
-    set state(-strict) $strict
-    # These flags have their types verified [Bug 811170]
-    array set type {
-	-binary		boolean
-	-blocksize	integer
-	-queryblocksize integer
-	-strict		boolean
-	-timeout	integer
-	-validate	boolean
-	-headers	list
-    }
-    set state(charset)	$defaultCharset
-    set options {
-	-binary -blocksize -channel -command -handler -headers -keepalive
-	-method -myaddr -progress -protocol -query -queryblocksize
-	-querychannel -queryprogress -strict -timeout -type -validate
-    }
-    set usage [join [lsort $options] ", "]
-    set options [string map {- ""} $options]
-    set pat ^-(?:[join $options |])$
-    foreach {flag value} $args {
-	if {[regexp -- $pat $flag]} {
-	    # Validate numbers
-	    if {    [info exists type($flag)]
-		&& (![string is $type($flag) -strict $value])
-	    } {
-		unset $token
-		return -code error \
-		    "Bad value for $flag ($value), must be $type($flag)"
-	    }
-	    if {($flag eq "-headers") && ([llength $value] % 2 != 0)} {
-		unset $token
-		return -code error \
-		    "Bad value for $flag ($value), number of list elements must be even"
-	    }
-	    set state($flag) $value
-	} else {
-	    unset $token
-	    return -code error "Unknown option $flag, can be: $usage"
-	}
-    }
-
-    # Make sure -query and -querychannel aren't both specified
-
-    set isQueryChannel [info exists state(-querychannel)]
-    set isQuery [info exists state(-query)]
-    if {$isQuery && $isQueryChannel} {
-	unset $token
-	return -code error "Can't combine -query and -querychannel options!"
-    }
-
-    # Validate URL, determine the server host and port, and check proxy case
-    # Recognize user:pass@host URLs also, although we do not do anything with
-    # that info yet.
-
-    # URLs have basically four parts.
-    # First, before the colon, is the protocol scheme (e.g. http)
-    # Second, for HTTP-like protocols, is the authority
-    #	The authority is preceded by // and lasts up to (but not including)
-    #	the following / or ? and it identifies up to four parts, of which
-    #	only one, the host, is required (if an authority is present at all).
-    #	All other parts of the authority (user name, password, port number)
-    #	are optional.
-    # Third is the resource name, which is split into two parts at a ?
-    #	The first part (from the single "/" up to "?") is the path, and the
-    #	second part (from that "?" up to "#") is the query. *HOWEVER*, we do
-    #	not need to separate them; we send the whole lot to the server.
-    #	Both, path and query are allowed to be missing, including their
-    #	delimiting character.
-    # Fourth is the fragment identifier, which is everything after the first
-    #	"#" in the URL. The fragment identifier MUST NOT be sent to the server
-    #	and indeed, we don't bother to validate it (it could be an error to
-    #	pass it in here, but it's cheap to strip).
-    #
-    # An example of a URL that has all the parts:
-    #
-    #     http://jschmoe:xyzzy@www.bogus.net:8000/foo/bar.tml?q=foo#changes
-    #
-    # The "http" is the protocol, the user is "jschmoe", the password is
-    # "xyzzy", the host is "www.bogus.net", the port is "8000", the path is
-    # "/foo/bar.tml", the query is "q=foo", and the fragment is "changes".
-    #
-    # Note that the RE actually combines the user and password parts, as
-    # recommended in RFC 3986. Indeed, that RFC states that putting passwords
-    # in URLs is a Really Bad Idea, something with which I would agree utterly.
-    #
-    # From a validation perspective, we need to ensure that the parts of the
-    # URL that are going to the server are correctly encoded.  This is only
-    # done if $state(-strict) is true (inherited from $::http::strict).
-
-    set URLmatcher {(?x)		# this is _expanded_ syntax
-	^
-	(?: (\w+) : ) ?			# <protocol scheme>
-	(?: //
-	    (?:
-		(
-		    [^@/\#?]+		# <userinfo part of authority>
-		) @
-	    )?
-	    (				# <host part of authority>
-		[^/:\#?]+ |		# host name or IPv4 address
-		\[ [^/\#?]+ \]		# IPv6 address in square brackets
-	    )
-	    (?: : (\d+) )?		# <port part of authority>
-	)?
-	( [/\?] [^\#]*)?		# <path> (including query)
-	(?: \# (.*) )?			# <fragment>
-	$
-    }
-
-    # Phase one: parse
-    if {![regexp -- $URLmatcher $url -> proto user host port srvurl]} {
-	unset $token
-	return -code error "Unsupported URL: $url"
-    }
-    # Phase two: validate
-    set host [string trim $host {[]}]; # strip square brackets from IPv6 address
-    if {$host eq ""} {
-	# Caller has to provide a host name; we do not have a "default host"
-	# that would enable us to handle relative URLs.
-	unset $token
-	return -code error "Missing host part: $url"
-	# Note that we don't check the hostname for validity here; if it's
-	# invalid, we'll simply fail to resolve it later on.
-    }
-    if {$port ne "" && $port > 65535} {
-	unset $token
-	return -code error "Invalid port number: $port"
-    }
-    # The user identification and resource identification parts of the URL can
-    # have encoded characters in them; take care!
-    if {$user ne ""} {
-	# Check for validity according to RFC 3986, Appendix A
-	set validityRE {(?xi)
-	    ^
-	    (?: [-\w.~!$&'()*+,;=:] | %[0-9a-f][0-9a-f] )+
-	    $
-	}
-	if {$state(-strict) && ![regexp -- $validityRE $user]} {
-	    unset $token
-	    # Provide a better error message in this error case
-	    if {[regexp {(?i)%(?![0-9a-f][0-9a-f]).?.?} $user bad]} {
-		return -code error \
-			"Illegal encoding character usage \"$bad\" in URL user"
-	    }
-	    return -code error "Illegal characters in URL user"
-	}
-    }
-    if {$srvurl ne ""} {
-	# RFC 3986 allows empty paths (not even a /), but servers
-	# return 400 if the path in the HTTP request doesn't start
-	# with / , so add it here if needed.
-	if {[string index $srvurl 0] ne "/"} {
-	    set srvurl /$srvurl
-	}
-	# Check for validity according to RFC 3986, Appendix A
-	set validityRE {(?xi)
-	    ^
-	    # Path part (already must start with / character)
-	    (?:	      [-\w.~!$&'()*+,;=:@/]  | %[0-9a-f][0-9a-f] )*
-	    # Query part (optional, permits ? characters)
-	    (?: \? (?: [-\w.~!$&'()*+,;=:@/?] | %[0-9a-f][0-9a-f] )* )?
-	    $
-	}
-	if {$state(-strict) && ![regexp -- $validityRE $srvurl]} {
-	    unset $token
-	    # Provide a better error message in this error case
-	    if {[regexp {(?i)%(?![0-9a-f][0-9a-f])..} $srvurl bad]} {
-		return -code error \
-		    "Illegal encoding character usage \"$bad\" in URL path"
-	    }
-	    return -code error "Illegal characters in URL path"
-	}
-	if {![regexp {^[^?#]+} $srvurl state(path)]} {
-	    set state(path) /
-	}
-    } else {
-	set srvurl /
-	set state(path) /
-    }
-    if {$proto eq ""} {
-	set proto http
-    }
-    set lower [string tolower $proto]
-    if {![info exists urlTypes($lower)]} {
-	unset $token
-	return -code error "Unsupported URL type \"$proto\""
-    }
-    set defport [lindex $urlTypes($lower) 0]
-    set defcmd [lindex $urlTypes($lower) 1]
-
-    if {$port eq ""} {
-	set port $defport
-    }
-    if {![catch {$http(-proxyfilter) $host} proxy]} {
-	set phost [lindex $proxy 0]
-	set pport [lindex $proxy 1]
-    }
-
-    # OK, now reassemble into a full URL
-    set url ${proto}://
-    if {$user ne ""} {
-	append url $user
-	append url @
-    }
-    append url $host
-    if {$port != $defport} {
-	append url : $port
-    }
-    append url $srvurl
-    # Don't append the fragment!
-    set state(url) $url
-
-    set sockopts [list -async]
-
-    # If we are using the proxy, we must pass in the full URL that includes
-    # the server name.
-
-    if {[info exists phost] && ($phost ne "")} {
-	set srvurl $url
-	set targetAddr [list $phost $pport]
-    } else {
-	set targetAddr [list $host $port]
-    }
-    # Proxy connections aren't shared among different hosts.
-    set state(socketinfo) $host:$port
-
-    # Save the accept types at this point to prevent a race condition. [Bug
-    # c11a51c482]
-    set state(accept-types) $http(-accept)
-
-    # Check whether this is an Upgrade request.
-    set connectionValues [SplitCommaSeparatedFieldValue \
-			      [GetFieldValue $state(-headers) Connection]]
-    set connectionValues [string tolower $connectionValues]
-    set upgradeValues [SplitCommaSeparatedFieldValue \
-			   [GetFieldValue $state(-headers) Upgrade]]
-    set state(upgradeRequest) [expr {    "upgrade" in $connectionValues
-				      && [llength $upgradeValues] >= 1}]
-
-    if {$isQuery || $isQueryChannel} {
-	# It's a POST.
-	# A client wishing to send a non-idempotent request SHOULD wait to send
-	# that request until it has received the response status for the
-	# previous request.
-	if {$http(-postfresh)} {
-	    # Override -keepalive for a POST.  Use a new connection, and thus
-	    # avoid the small risk of a race against server timeout.
-	    set state(-keepalive) 0
-	} else {
-	    # Allow -keepalive but do not -pipeline - wait for the previous
-	    # transaction to finish.
-	    # There is a small risk of a race against server timeout.
-	    set state(-pipeline) 0
-	}
-    } elseif {$state(upgradeRequest)} {
-	# It's an upgrade request.  Method must be GET (untested).
-	# Force -keepalive to 0 so the connection is not made over a persistent
-	# socket, i.e. one used for multiple HTTP requests.
-	set state(-keepalive) 0
-    } else {
-	# It's a non-upgrade GET or HEAD.
-	set state(-pipeline) $http(-pipeline)
-    }
-
-    # We cannot handle chunked encodings with -handler, so force HTTP/1.0
-    # until we can manage this.
-    if {[info exists state(-handler)]} {
-	set state(-protocol) 1.0
-    }
-
-    # RFC 7320 A.1 - HTTP/1.0 Keep-Alive is problematic. We do not support it.
-    if {$state(-protocol) eq "1.0"} {
-	set state(connection) close
-	set state(-keepalive) 0
-    }
-
-    # See if we are supposed to use a previously opened channel.
-    # - In principle, ANY call to http::geturl could use a previously opened
-    #   channel if it is available - the "Connection: keep-alive" header is a
-    #   request to leave the channel open AFTER completion of this call.
-    # - In fact, we try to use an existing channel only if -keepalive 1 -- this
-    #   means that at most one channel is left open for each value of
-    #   $state(socketinfo). This property simplifies the mapping of open
-    #   channels.
-    set reusing 0
-    set alreadyQueued 0
-    if {$state(-keepalive)} {
-	variable socketMapping
-	variable socketRdState
-	variable socketWrState
-	variable socketRdQueue
-	variable socketWrQueue
-	variable socketClosing
-	variable socketPlayCmd
-
-	if {[info exists socketMapping($state(socketinfo))]} {
-	    # - If the connection is idle, it has a "fileevent readable" binding
-	    #   to http::CheckEof, in case the server times out and half-closes
-	    #   the socket (http::CheckEof closes the other half).
-	    # - We leave this binding in place until just before the last
-	    #   puts+flush in http::Connected (GET/HEAD) or http::Write (POST),
-	    #   after which the HTTP response might be generated.
-
-	    if {    [info exists socketClosing($state(socketinfo))]
-		       && $socketClosing($state(socketinfo))
-	    } {
-		# socketClosing(*) is set because the server has sent a
-		# "Connection: close" header.
-		# Do not use the persistent socket again.
-		# Since we have only one persistent socket per server, and the
-		# old socket is not yet dead, add the request to the write queue
-		# of the dying socket, which will be replayed by ReplayIfClose.
-		# Also add it to socketWrQueue(*) which is used only if an error
-		# causes a call to Finish.
-		set reusing 1
-		set sock $socketMapping($state(socketinfo))
-		Log "reusing socket $sock for $state(socketinfo) - token $token"
-
-		set alreadyQueued 1
-		lassign $socketPlayCmd($state(socketinfo)) com0 com1 com2 com3
-		lappend com3 $token
-		set socketPlayCmd($state(socketinfo)) [list $com0 $com1 $com2 $com3]
-		lappend socketWrQueue($state(socketinfo)) $token
-	    } elseif {[catch {fconfigure $socketMapping($state(socketinfo))}]} {
-		# FIXME Is it still possible for this code to be executed? If
-		#       so, this could be another place to call TestForReplay,
-		#       rather than discarding the queued transactions.
-		Log "WARNING: socket for $state(socketinfo) was closed\
-			- token $token"
-		Log "WARNING - if testing, pay special attention to this\
-			case (GH) which is seldom executed - token $token"
-
-		# This will call CancelReadPipeline, CancelWritePipeline, and
-		# cancel any queued requests, responses.
-		Unset $state(socketinfo)
-	    } else {
-		# Use the persistent socket.
-		# The socket may not be ready to write: an earlier request might
-		# still be still writing (in the pipelined case) or
-		# writing/reading (in the nonpipeline case). This possibility
-		# is handled by socketWrQueue later in this command.
-		set reusing 1
-		set sock $socketMapping($state(socketinfo))
-		Log "reusing socket $sock for $state(socketinfo) - token $token"
-
-	    }
-	    # Do not automatically close the connection socket.
-	    set state(connection) keep-alive
-	}
-    }
-
-    if {$reusing} {
-	# Define state(tmpState) and state(tmpOpenCmd) for use
-	# by http::ReplayIfDead if the persistent connection has died.
-	set state(tmpState) [array get state]
-
-	# Pass -myaddr directly to the socket command
-	if {[info exists state(-myaddr)]} {
-	    lappend sockopts -myaddr $state(-myaddr)
-	}
-
-	set state(tmpOpenCmd) [list {*}$defcmd {*}$sockopts {*}$targetAddr]
-    }
-
-    set state(reusing) $reusing
-    # Excluding ReplayIfDead and the decision whether to call it, there are four
-    # places outside http::geturl where state(reusing) is used:
-    # - Connected   - if reusing and not pipelined, start the state(-timeout)
-    #                 timeout (when writing).
-    # - DoneRequest - if reusing and pipelined, send the next pipelined write
-    # - Event       - if reusing and pipelined, start the state(-timeout)
-    #                 timeout (when reading).
-    # - Event       - if (not reusing) and pipelined, send the next pipelined
-    #                 write
-
-    # See comments above re the start of this timeout in other cases.
-    if {(!$state(reusing)) && ($state(-timeout) > 0)} {
-	set state(after) [after $state(-timeout) \
-		[list http::reset $token timeout]]
-    }
-
-    if {![info exists sock]} {
-	# Pass -myaddr directly to the socket command
-	if {[info exists state(-myaddr)]} {
-	    lappend sockopts -myaddr $state(-myaddr)
-	}
-	set pre [clock milliseconds]
-	##Log pre socket opened, - token $token
-	##Log [concat $defcmd $sockopts $targetAddr] - token $token
-	if {[catch {eval $defcmd $sockopts $targetAddr} sock errdict]} {
-	    # Something went wrong while trying to establish the connection.
-	    # Clean up after events and such, but DON'T call the command
-	    # callback (if available) because we're going to throw an
-	    # exception from here instead.
-
-	    set state(sock) NONE
-	    Finish $token $sock 1
-	    cleanup $token
-	    dict unset errdict -level
-	    return -options $errdict $sock
-	} else {
-	    # Initialisation of a new socket.
-	    ##Log post socket opened, - token $token
-	    ##Log socket opened, now fconfigure - token $token
-	    set delay [expr {[clock milliseconds] - $pre}]
-	    if {$delay > 3000} {
-		Log socket delay $delay - token $token
-	    }
-	    fconfigure $sock -translation {auto crlf} \
-			     -buffersize $state(-blocksize)
-	    ##Log socket opened, DONE fconfigure - token $token
-	}
-    }
-    # Command [socket] is called with -async, but takes 5s to 5.1s to return,
-    # with probability of order 1 in 10,000.  This may be a bizarre scheduling
-    # issue with my (KJN's) system (Fedora Linux).
-    # This does not cause a problem (unless the request times out when this
-    # command returns).
-
-    set state(sock) $sock
-    Log "Using $sock for $state(socketinfo) - token $token" \
-	[expr {$state(-keepalive)?"keepalive":""}]
-
-    if {    $state(-keepalive)
-	 && (![info exists socketMapping($state(socketinfo))])
-    } {
-	# Freshly-opened socket that we would like to become persistent.
-	set socketMapping($state(socketinfo)) $sock
-
-	if {![info exists socketRdState($state(socketinfo))]} {
-	    set socketRdState($state(socketinfo)) {}
-	    set varName ::http::socketRdState($state(socketinfo))
-	    trace add variable $varName unset ::http::CancelReadPipeline
-	}
-	if {![info exists socketWrState($state(socketinfo))]} {
-	    set socketWrState($state(socketinfo)) {}
-	    set varName ::http::socketWrState($state(socketinfo))
-	    trace add variable $varName unset ::http::CancelWritePipeline
-	}
-
-	if {$state(-pipeline)} {
-	    #Log new, init for pipelined, GRANT write access to $token in geturl
-	    # Also grant premature read access to the socket. This is OK.
-	    set socketRdState($state(socketinfo)) $token
-	    set socketWrState($state(socketinfo)) $token
-	} else {
-	    # socketWrState is not used by this non-pipelined transaction.
-	    # We cannot leave it as "Wready" because the next call to
-	    # http::geturl with a pipelined transaction would conclude that the
-	    # socket is available for writing.
-	    #Log new, init for nonpipeline, GRANT r/w access to $token in geturl
-	    set socketRdState($state(socketinfo)) $token
-	    set socketWrState($state(socketinfo)) $token
-	}
-
-	set socketRdQueue($state(socketinfo)) {}
-	set socketWrQueue($state(socketinfo)) {}
-	set socketClosing($state(socketinfo)) 0
-	set socketPlayCmd($state(socketinfo)) {ReplayIfClose Wready {} {}}
-    }
-
-    if {![info exists phost]} {
-	set phost ""
-    }
-    if {$reusing} {
-	# For use by http::ReplayIfDead if the persistent connection has died.
-	# Also used by NextPipelinedWrite.
-	set state(tmpConnArgs) [list $proto $phost $srvurl]
-    }
-
-    # The element socketWrState($connId) has a value which is either the name of
-    # the token that is permitted to write to the socket, or "Wready" if no
-    # token is permitted to write.
-    #
-    # The code that sets the value to Wready immediately calls
-    # http::NextPipelinedWrite, which examines socketWrQueue($connId) and
-    # processes the next request in the queue, if there is one.  The value
-    # Wready is not found when the interpreter is in the event loop unless the
-    # socket is idle.
-    #
-    # The element socketRdState($connId) has a value which is either the name of
-    # the token that is permitted to read from the socket, or "Rready" if no
-    # token is permitted to read.
-    #
-    # The code that sets the value to Rready then examines
-    # socketRdQueue($connId) and processes the next request in the queue, if
-    # there is one.  The value Rready is not found when the interpreter is in
-    # the event loop unless the socket is idle.
-
-    if {$alreadyQueued} {
-	# A write may or may not be in progress.  There is no need to set
-	# socketWrState to prevent another call stealing write access - all
-	# subsequent calls on this socket will come here because the socket
-	# will close after the current read, and its
-	# socketClosing($connId) is 1.
-	##Log "HTTP request for token $token is queued"
-
-    } elseif {    $reusing
-	       && $state(-pipeline)
-	       && ($socketWrState($state(socketinfo)) ne "Wready")
-    } {
-	##Log "HTTP request for token $token is queued for pipelined use"
-	lappend socketWrQueue($state(socketinfo)) $token
-
-    } elseif {    $reusing
-	       && (!$state(-pipeline))
-	       && ($socketWrState($state(socketinfo)) ne "Wready")
-    } {
-	# A write is queued or in progress.  Lappend to the write queue.
-	##Log "HTTP request for token $token is queued for nonpipeline use"
-	lappend socketWrQueue($state(socketinfo)) $token
-
-    } elseif {    $reusing
-	       && (!$state(-pipeline))
-	       && ($socketWrState($state(socketinfo)) eq "Wready")
-	       && ($socketRdState($state(socketinfo)) ne "Rready")
-    } {
-	# A read is queued or in progress, but not a write.  Cannot start the
-	# nonpipeline transaction, but must set socketWrState to prevent a
-	# pipelined request jumping the queue.
-	##Log "HTTP request for token $token is queued for nonpipeline use"
-	#Log re-use nonpipeline, GRANT delayed write access to $token in geturl
-
-	set socketWrState($state(socketinfo)) peNding
-	lappend socketWrQueue($state(socketinfo)) $token
-
-    } else {
-	if {$reusing && $state(-pipeline)} {
-	    #Log re-use pipelined, GRANT write access to $token in geturl
-	    set socketWrState($state(socketinfo)) $token
-
-	} elseif {$reusing} {
-	    # Cf tests above - both are ready.
-	    #Log re-use nonpipeline, GRANT r/w access to $token in geturl
-	    set socketRdState($state(socketinfo)) $token
-	    set socketWrState($state(socketinfo)) $token
-	}
-
-	# All (!$reusing) cases come here, and also some $reusing cases if the
-	# connection is ready.
-	#Log ---- $state(socketinfo) << conn to $token for HTTP request (a)
-	# Connect does its own fconfigure.
-	fileevent $sock writable \
-		[list http::Connect $token $proto $phost $srvurl]
-    }
-
-    # Wait for the connection to complete.
-    if {![info exists state(-command)]} {
-	# geturl does EVERYTHING asynchronously, so if the user
-	# calls it synchronously, we just do a wait here.
-	http::wait $token
-
-	if {![info exists state]} {
-	    # If we timed out then Finish has been called and the users
-	    # command callback may have cleaned up the token. If so we end up
-	    # here with nothing left to do.
-	    return $token
-	} elseif {$state(status) eq "error"} {
-	    # Something went wrong while trying to establish the connection.
-	    # Clean up after events and such, but DON'T call the command
-	    # callback (if available) because we're going to throw an
-	    # exception from here instead.
-	    set err [lindex $state(error) 0]
-	    cleanup $token
-	    return -code error $err
-	}
-    }
-    ##Log Leaving http::geturl - token $token
-    return $token
-}
-
-# http::Connected --
-#
-#	Callback used when the connection to the HTTP server is actually
-#	established.
-#
-# Arguments:
-#	token	State token.
-#	proto	What protocol (http, https, etc.) was used to connect.
-#	phost	Are we using keep-alive? Non-empty if yes.
-#	srvurl	Service-local URL that we're requesting
-# Results:
-#	None.
-
-proc http::Connected {token proto phost srvurl} {
-    variable http
-    variable urlTypes
-    variable socketMapping
-    variable socketRdState
-    variable socketWrState
-    variable socketRdQueue
-    variable socketWrQueue
-    variable socketClosing
-    variable socketPlayCmd
-
-    variable $token
-    upvar 0 $token state
-    set tk [namespace tail $token]
-
-    if {$state(reusing) && (!$state(-pipeline)) && ($state(-timeout) > 0)} {
-	set state(after) [after $state(-timeout) \
-		[list http::reset $token timeout]]
-    }
-
-    # Set back the variables needed here.
-    set sock $state(sock)
-    set isQueryChannel [info exists state(-querychannel)]
-    set isQuery [info exists state(-query)]
-    regexp {^(.+):([^:]+)$} $state(socketinfo) {} host port
-
-    set lower [string tolower $proto]
-    set defport [lindex $urlTypes($lower) 0]
-
-    # Send data in cr-lf format, but accept any line terminators.
-    # Initialisation to {auto *} now done in geturl, KeepSocket and DoneRequest.
-    # We are concerned here with the request (write) not the response (read).
-    lassign [fconfigure $sock -translation] trRead trWrite
-    fconfigure $sock -translation [list $trRead crlf] \
-		     -buffersize $state(-blocksize)
-
-    # The following is disallowed in safe interpreters, but the socket is
-    # already in non-blocking mode in that case.
-
-    catch {fconfigure $sock -blocking off}
-    set how GET
-    if {$isQuery} {
-	set state(querylength) [string length $state(-query)]
-	if {$state(querylength) > 0} {
-	    set how POST
-	    set contDone 0
-	} else {
-	    # There's no query data.
-	    unset state(-query)
-	    set isQuery 0
-	}
-    } elseif {$state(-validate)} {
-	set how HEAD
-    } elseif {$isQueryChannel} {
-	set how POST
-	# The query channel must be blocking for the async Write to
-	# work properly.
-	fconfigure $state(-querychannel) -blocking 1 -translation binary
-	set contDone 0
-    }
-    if {[info exists state(-method)] && ($state(-method) ne "")} {
-	set how $state(-method)
-    }
-    set accept_types_seen 0
-
-    Log ^B$tk begin sending request - token $token
-
-    if {[catch {
-	set state(method) $how
-	puts $sock "$how $srvurl HTTP/$state(-protocol)"
-	set hostValue [GetFieldValue $state(-headers) Host]
-	if {$hostValue ne {}} {
-	    # Allow Host spoofing. [Bug 928154]
-	    regexp {^[^:]+} $hostValue state(host)
-	    puts $sock "Host: $hostValue"
-	} elseif {$port == $defport} {
-	    # Don't add port in this case, to handle broken servers. [Bug
-	    # #504508]
-	    set state(host) $host
-	    puts $sock "Host: $host"
-	} else {
-	    set state(host) $host
-	    puts $sock "Host: $host:$port"
-	}
-	puts $sock "User-Agent: $http(-useragent)"
-	if {($state(-protocol) > 1.0) && $state(-keepalive)} {
-	    # Send this header, because a 1.1 server is not compelled to treat
-	    # this as the default.
-	    puts $sock "Connection: keep-alive"
-	}
-	if {($state(-protocol) > 1.0) && !$state(-keepalive)} {
-	    puts $sock "Connection: close" ;# RFC2616 sec 8.1.2.1
-	}
-	if {($state(-protocol) < 1.1)} {
-	    # RFC7230 A.1
-	    # Some server implementations of HTTP/1.0 have a faulty
-	    # implementation of RFC 2068 Keep-Alive.
-	    # Don't leave this to chance.
-	    # For HTTP/1.0 we have already "set state(connection) close"
-	    # and "state(-keepalive) 0".
-	    puts $sock "Connection: close"
-	}
-	# RFC7230 A.1 - "clients are encouraged not to send the
-	# Proxy-Connection header field in any requests"
-	set accept_encoding_seen 0
-	set content_type_seen 0
-	foreach {key value} $state(-headers) {
-	    set value [string map [list \n "" \r ""] $value]
-	    set key [string map {" " -} [string trim $key]]
-	    if {[string equal -nocase $key "host"]} {
-		continue
-	    }
-	    if {[string equal -nocase $key "accept-encoding"]} {
-		set accept_encoding_seen 1
-	    }
-	    if {[string equal -nocase $key "accept"]} {
-		set accept_types_seen 1
-	    }
-	    if {[string equal -nocase $key "content-type"]} {
-		set content_type_seen 1
-	    }
-	    if {[string equal -nocase $key "content-length"]} {
-		set contDone 1
-		set state(querylength) $value
-	    }
-	    if {[string length $key]} {
-		puts $sock "$key: $value"
-	    }
-	}
-	# Allow overriding the Accept header on a per-connection basis. Useful
-	# for working with REST services. [Bug c11a51c482]
-	if {!$accept_types_seen} {
-	    puts $sock "Accept: $state(accept-types)"
-	}
-	if {    (!$accept_encoding_seen)
-	     && (![info exists state(-handler)])
-	     && $http(-zip)
-	} {
-	    puts $sock "Accept-Encoding: gzip,deflate,compress"
-	}
-	if {$isQueryChannel && ($state(querylength) == 0)} {
-	    # Try to determine size of data in channel. If we cannot seek, the
-	    # surrounding catch will trap us
-
-	    set start [tell $state(-querychannel)]
-	    seek $state(-querychannel) 0 end
-	    set state(querylength) \
-		    [expr {[tell $state(-querychannel)] - $start}]
-	    seek $state(-querychannel) $start
-	}
-
-	# Flush the request header and set up the fileevent that will either
-	# push the POST data or read the response.
-	#
-	# fileevent note:
-	#
-	# It is possible to have both the read and write fileevents active at
-	# this point. The only scenario it seems to affect is a server that
-	# closes the connection without reading the POST data. (e.g., early
-	# versions TclHttpd in various error cases). Depending on the
-	# platform, the client may or may not be able to get the response from
-	# the server because of the error it will get trying to write the post
-	# data. Having both fileevents active changes the timing and the
-	# behavior, but no two platforms (among Solaris, Linux, and NT) behave
-	# the same, and none behave all that well in any case. Servers should
-	# always read their POST data if they expect the client to read their
-	# response.
-
-	if {$isQuery || $isQueryChannel} {
-	    # POST method.
-	    if {!$content_type_seen} {
-		puts $sock "Content-Type: $state(-type)"
-	    }
-	    if {!$contDone} {
-		puts $sock "Content-Length: $state(querylength)"
-	    }
-	    puts $sock ""
-	    flush $sock
-	    # Flush flushes the error in the https case with a bad handshake:
-	    # else the socket never becomes writable again, and hangs until
-	    # timeout (if any).
-
-	    lassign [fconfigure $sock -translation] trRead trWrite
-	    fconfigure $sock -translation [list $trRead binary]
-	    fileevent $sock writable [list http::Write $token]
-	    # The http::Write command decides when to make the socket readable,
-	    # using the same test as the GET/HEAD case below.
-	} else {
-	    # GET or HEAD method.
-	    if {    (![catch {fileevent $sock readable} binding])
-		 && ($binding eq [list http::CheckEof $sock])
-	    } {
-		# Remove the "fileevent readable" binding of an idle persistent
-		# socket to http::CheckEof.  We can no longer treat bytes
-		# received as junk. The server might still time out and
-		# half-close the socket if it has not yet received the first
-		# "puts".
-		fileevent $sock readable {}
-	    }
-	    puts $sock ""
-	    flush $sock
-	    Log ^C$tk end sending request - token $token
-	    # End of writing (GET/HEAD methods).  The request has been sent.
-
-	    DoneRequest $token
-	}
-
-    } err]} {
-	# The socket probably was never connected, OR the connection dropped
-	# later, OR https handshake error, which may be discovered as late as
-	# the "flush" command above...
-	Log "WARNING - if testing, pay special attention to this\
-		case (GI) which is seldom executed - token $token"
-	if {[info exists state(reusing)] && $state(reusing)} {
-	    # The socket was closed at the server end, and closed at
-	    # this end by http::CheckEof.
-    	    if {[TestForReplay $token write $err a]} {
-		return
-	    } else {
-		Finish $token {failed to re-use socket}
-	    }
-
-	    # else:
-	    # This is NOT a persistent socket that has been closed since its
-	    # last use.
-	    # If any other requests are in flight or pipelined/queued, they will
-	    # be discarded.
-	} elseif {$state(status) eq ""} {
-	    # ...https handshake errors come here.
-	    set msg [registerError $sock]
-	    registerError $sock {}
-	    if {$msg eq {}} {
-		set msg {failed to use socket}
-	    }
-	    Finish $token $msg
-	} elseif {$state(status) ne "error"} {
-	    Finish $token $err
-	}
-    }
-}
-
-# http::registerError
-#
-#	Called (for example when processing TclTLS activity) to register
-#	an error for a connection on a specific socket.  This helps
-#	http::Connected to deliver meaningful error messages, e.g. when a TLS
-#	certificate fails verification.
-#
-#	Usage: http::registerError socket ?newValue?
-#
-#	"set" semantics, except that a "get" (a call without a new value) for a
-#	non-existent socket returns {}, not an error.
-
-proc http::registerError {sock args} {
-    variable registeredErrors
-
-    if {    ([llength $args] == 0)
-	 && (![info exists registeredErrors($sock)])
-    } {
-	return
-    } elseif {    ([llength $args] == 1)
-	       && ([lindex $args 0] eq {})
-    } {
-	unset -nocomplain registeredErrors($sock)
-	return
-    }
-    set registeredErrors($sock) {*}$args
-}
-
-# http::DoneRequest --
-#
-#	Command called when a request has been sent.  It will arrange the
-#	next request and/or response as appropriate.
-#
-#	If this command is called when $socketClosing(*), the request $token
-#	that calls it must be pipelined and destined to fail.
-
-proc http::DoneRequest {token} {
-    variable http
-    variable socketMapping
-    variable socketRdState
-    variable socketWrState
-    variable socketRdQueue
-    variable socketWrQueue
-    variable socketClosing
-    variable socketPlayCmd
-
-    variable $token
-    upvar 0 $token state
-    set tk [namespace tail $token]
-    set sock $state(sock)
-
-    # If pipelined, connect the next HTTP request to the socket.
-    if {$state(reusing) && $state(-pipeline)} {
-	# Enable next token (if any) to write.
-	# The value "Wready" is set only here, and
-	# in http::Event after reading the response-headers of a
-	# non-reusing transaction.
-	# Previous value is $token. It cannot be pending.
-	set socketWrState($state(socketinfo)) Wready
-
-	# Now ready to write the next pipelined request (if any).
-	http::NextPipelinedWrite $token
-    } else {
-	# If pipelined, this is the first transaction on this socket.  We wait
-	# for the response headers to discover whether the connection is
-	# persistent.  (If this is not done and the connection is not
-	# persistent, we SHOULD retry and then MUST NOT pipeline before knowing
-	# that we have a persistent connection
-	# (rfc2616 8.1.2.2)).
-    }
-
-    # Connect to receive the response, unless the socket is pipelined
-    # and another response is being sent.
-    # This code block is separate from the code below because there are
-    # cases where socketRdState already has the value $token.
-    if {    $state(-keepalive)
-	 && $state(-pipeline)
-	 && [info exists socketRdState($state(socketinfo))]
-	 && ($socketRdState($state(socketinfo)) eq "Rready")
-    } {
-	#Log pipelined, GRANT read access to $token in Connected
-	set socketRdState($state(socketinfo)) $token
-    }
-
-    if {    $state(-keepalive)
-	 && $state(-pipeline)
-	 && [info exists socketRdState($state(socketinfo))]
-	 && ($socketRdState($state(socketinfo)) ne $token)
-    } {
-	# Do not read from the socket until it is ready.
-	##Log "HTTP response for token $token is queued for pipelined use"
-	# If $socketClosing(*), then the caller will be a pipelined write and
-	# execution will come here.
-	# This token has already been recorded as "in flight" for writing.
-	# When the socket is closed, the read queue will be cleared in
-	# CloseQueuedQueries and so the "lappend" here has no effect.
-	lappend socketRdQueue($state(socketinfo)) $token
-    } else {
-	# In the pipelined case, connection for reading depends on the
-	# value of socketRdState.
-	# In the nonpipeline case, connection for reading always occurs.
-	ReceiveResponse $token
-    }
-}
-
-# http::ReceiveResponse
-#
-#	Connects token to its socket for reading.
-
-proc http::ReceiveResponse {token} {
-    variable $token
-    upvar 0 $token state
-    set tk [namespace tail $token]
-    set sock $state(sock)
-
-    #Log ---- $state(socketinfo) >> conn to $token for HTTP response
-    lassign [fconfigure $sock -translation] trRead trWrite
-    fconfigure $sock -translation [list auto $trWrite] \
-		     -buffersize $state(-blocksize)
-    Log ^D$tk begin receiving response - token $token
-
-    coroutine ${token}EventCoroutine http::Event $sock $token
-    if {[info exists state(-handler)] || [info exists state(-progress)]} {
-	fileevent $sock readable [list http::EventGateway $sock $token]
-    } else {
-	fileevent $sock readable ${token}EventCoroutine
-    }
-    return
-}
-
-
-# http::EventGateway
-#
-#	Bug [c2dc1da315].
-#	- Recursive launch of the coroutine can occur if a -handler or -progress
-#	  callback is used, and the callback command enters the event loop.
-#	- To prevent this, the fileevent "binding" is disabled while the
-#	  coroutine is in flight.
-#	- If a recursive call occurs despite these precautions, it is not
-#	  trapped and discarded here, because it is better to report it as a
-#	  bug.
-#	- Although this solution is believed to be sufficiently general, it is
-#	  used only if -handler or -progress is specified.  In other cases,
-#	  the coroutine is called directly.
-
-proc http::EventGateway {sock token} {
-    variable $token
-    upvar 0 $token state
-    fileevent $sock readable {}
-    catch {${token}EventCoroutine} res opts
-    if {[info commands ${token}EventCoroutine] ne {}} {
-	# The coroutine can be deleted by completion (a non-yield return), by
-	# http::Finish (when there is a premature end to the transaction), by
-	# http::reset or http::cleanup, or if the caller set option -channel
-	# but not option -handler: in the last case reading from the socket is
-	# now managed by commands ::http::Copy*, http::ReceiveChunked, and
-	# http::make-transformation-chunked.
-	#
-	# Catch in case the coroutine has closed the socket.
-	catch {fileevent $sock readable [list http::EventGateway $sock $token]}
-    }
-
-    # If there was an error, re-throw it.
-    return -options $opts $res
-}
-
-
-# http::NextPipelinedWrite
-#
-# - Connecting a socket to a token for writing is done by this command and by
-#   command KeepSocket.
-# - If another request has a pipelined write scheduled for $token's socket,
-#   and if the socket is ready to accept it, connect the write and update
-#   the queue accordingly.
-# - This command is called from http::DoneRequest and http::Event,
-#   IF $state(-pipeline) AND (the current transfer has reached the point at
-#   which the socket is ready for the next request to be written).
-# - This command is called when a token has write access and is pipelined and
-#   keep-alive, and sets socketWrState to Wready.
-# - The command need not consider the case where socketWrState is set to a token
-#   that does not yet have write access.  Such a token is waiting for Rready,
-#   and the assignment of the connection to the token will be done elsewhere (in
-#   http::KeepSocket).
-# - This command cannot be called after socketWrState has been set to a
-#   "pending" token value (that is then overwritten by the caller), because that
-#   value is set by this command when it is called by an earlier token when it
-#   relinquishes its write access, and the pending token is always the next in
-#   line to write.
-
-proc http::NextPipelinedWrite {token} {
-    variable http
-    variable socketRdState
-    variable socketWrState
-    variable socketWrQueue
-    variable socketClosing
-    variable $token
-    upvar 0 $token state
-    set connId $state(socketinfo)
-
-    if {    [info exists socketClosing($connId)]
-	 && $socketClosing($connId)
-    } {
-	# socketClosing(*) is set because the server has sent a
-	# "Connection: close" header.
-	# Behave as if the queues are empty - so do nothing.
-    } elseif {    $state(-pipeline)
-	 && [info exists socketWrState($connId)]
-	 && ($socketWrState($connId) eq "Wready")
-
-	 && [info exists socketWrQueue($connId)]
-	 && [llength $socketWrQueue($connId)]
-	 && ([set token2 [lindex $socketWrQueue($connId) 0]
-	      set ${token2}(-pipeline)
-	     ]
-	    )
-    } {
-	# - The usual case for a pipelined connection, ready for a new request.
-	#Log pipelined, GRANT write access to $token2 in NextPipelinedWrite
-	set conn [set ${token2}(tmpConnArgs)]
-	set socketWrState($connId) $token2
-	set socketWrQueue($connId) [lrange $socketWrQueue($connId) 1 end]
-	# Connect does its own fconfigure.
-	fileevent $state(sock) writable [list http::Connect $token2 {*}$conn]
-	#Log ---- $connId << conn to $token2 for HTTP request (b)
-
-	# In the tests below, the next request will be nonpipeline.
-    } elseif {    $state(-pipeline)
-	       && [info exists socketWrState($connId)]
-	       && ($socketWrState($connId) eq "Wready")
-
-	       && [info exists socketWrQueue($connId)]
-	       && [llength $socketWrQueue($connId)]
-	       && (![ set token3 [lindex $socketWrQueue($connId) 0]
-		      set ${token3}(-pipeline)
-		    ]
-		  )
-
-	       && [info exists socketRdState($connId)]
-	       && ($socketRdState($connId) eq "Rready")
-    } {
-	# The case in which the next request will be non-pipelined, and the read
-	# and write queues is ready: which is the condition for a non-pipelined
-	# write.
-	variable $token3
-	upvar 0 $token3 state3
-	set conn [set ${token3}(tmpConnArgs)]
-	#Log nonpipeline, GRANT r/w access to $token3 in NextPipelinedWrite
-	set socketRdState($connId) $token3
-	set socketWrState($connId) $token3
-	set socketWrQueue($connId) [lrange $socketWrQueue($connId) 1 end]
-	# Connect does its own fconfigure.
-	fileevent $state(sock) writable [list http::Connect $token3 {*}$conn]
-	#Log ---- $state(sock) << conn to $token3 for HTTP request (c)
-
-    } elseif {    $state(-pipeline)
-	 && [info exists socketWrState($connId)]
-	 && ($socketWrState($connId) eq "Wready")
-
-	 && [info exists socketWrQueue($connId)]
-	 && [llength $socketWrQueue($connId)]
-	 && (![set token2 [lindex $socketWrQueue($connId) 0]
-	      set ${token2}(-pipeline)
-	     ]
-	    )
-    } {
-	# - The case in which the next request will be non-pipelined, but the
-	#   read queue is NOT ready.
-	# - A read is queued or in progress, but not a write.  Cannot start the
-	#   nonpipeline transaction, but must set socketWrState to prevent a new
-	#   pipelined request (in http::geturl) jumping the queue.
-	# - Because socketWrState($connId) is not set to Wready, the assignment
-	#   of the connection to $token2 will be done elsewhere - by command
-	#   http::KeepSocket when $socketRdState($connId) is set to "Rready".
-
-	#Log re-use nonpipeline, GRANT delayed write access to $token in NextP..
-	set socketWrState($connId) peNding
-    }
-}
-
-# http::CancelReadPipeline
-#
-#	Cancel pipelined responses on a closing "Keep-Alive" socket.
-#
-#	- Called by a variable trace on "unset socketRdState($connId)".
-#	- The variable relates to a Keep-Alive socket, which has been closed.
-#	- Cancels all pipelined responses. The requests have been sent,
-#	  the responses have not yet been received.
-#	- This is a hard cancel that ends each transaction with error status,
-#	  and closes the connection. Do not use it if you want to replay failed
-#	  transactions.
-#	- N.B. Always delete ::http::socketRdState($connId) before deleting
-#	  ::http::socketRdQueue($connId), or this command will do nothing.
-#
-# Arguments
-#	As for a trace command on a variable.
-
-proc http::CancelReadPipeline {name1 connId op} {
-    variable socketRdQueue
-    ##Log CancelReadPipeline $name1 $connId $op
-    if {[info exists socketRdQueue($connId)]} {
-	set msg {the connection was closed by CancelReadPipeline}
-	foreach token $socketRdQueue($connId) {
-	    set tk [namespace tail $token]
-	    Log ^X$tk end of response "($msg)" - token $token
-	    set ${token}(status) eof
-	    Finish $token ;#$msg
-	}
-	set socketRdQueue($connId) {}
-    }
-}
-
-# http::CancelWritePipeline
-#
-#	Cancel queued events on a closing "Keep-Alive" socket.
-#
-#	- Called by a variable trace on "unset socketWrState($connId)".
-#	- The variable relates to a Keep-Alive socket, which has been closed.
-#	- In pipelined or nonpipeline case: cancels all queued requests.  The
-#	  requests have not yet been sent, the responses are not due.
-#	- This is a hard cancel that ends each transaction with error status,
-#	  and closes the connection. Do not use it if you want to replay failed
-#	  transactions.
-#	- N.B. Always delete ::http::socketWrState($connId) before deleting
-#	  ::http::socketWrQueue($connId), or this command will do nothing.
-#
-# Arguments
-#	As for a trace command on a variable.
-
-proc http::CancelWritePipeline {name1 connId op} {
-    variable socketWrQueue
-
-    ##Log CancelWritePipeline $name1 $connId $op
-    if {[info exists socketWrQueue($connId)]} {
-	set msg {the connection was closed by CancelWritePipeline}
-	foreach token $socketWrQueue($connId) {
-	    set tk [namespace tail $token]
-	    Log ^X$tk end of response "($msg)" - token $token
-	    set ${token}(status) eof
-	    Finish $token ;#$msg
-	}
-	set socketWrQueue($connId) {}
-    }
-}
-
-# http::ReplayIfDead --
-#
-# - A query on a re-used persistent socket failed at the earliest opportunity,
-#   because the socket had been closed by the server.  Keep the token, tidy up,
-#   and try to connect on a fresh socket.
-# - The connection is monitored for eof by the command http::CheckEof.  Thus
-#   http::ReplayIfDead is needed only when a server event (half-closing an
-#   apparently idle connection), and a client event (sending a request) occur at
-#   almost the same time, and neither client nor server detects the other's
-#   action before performing its own (an "asynchronous close event").
-# - To simplify testing of http::ReplayIfDead, set TEST_EOF 1 in
-#   http::KeepSocket, and then http::ReplayIfDead will be called if http::geturl
-#   is called at any time after the server timeout.
-#
-# Arguments:
-#	token	Connection token.
-#
-# Side Effects:
-#	Use the same token, but try to open a new socket.
-
-proc http::ReplayIfDead {tokenArg doing} {
-    variable socketMapping
-    variable socketRdState
-    variable socketWrState
-    variable socketRdQueue
-    variable socketWrQueue
-    variable socketClosing
-    variable socketPlayCmd
-
-    variable $tokenArg
-    upvar 0 $tokenArg stateArg
-
-    Log running http::ReplayIfDead for $tokenArg $doing
-
-    # 1. Merge the tokens for transactions in flight, the read (response) queue,
-    #    and the write (request) queue.
-
-    set InFlightR {}
-    set InFlightW {}
-
-    # Obtain the tokens for transactions in flight.
-    if {$stateArg(-pipeline)} {
-	# Two transactions may be in flight.  The "read" transaction was first.
-	# It is unlikely that the server would close the socket if a response
-	# was pending; however, an earlier request (as well as the present
-	# request) may have been sent and ignored if the socket was half-closed
-	# by the server.
-
-	if {    [info exists socketRdState($stateArg(socketinfo))]
-	     && ($socketRdState($stateArg(socketinfo)) ne "Rready")
-	} {
-	    lappend InFlightR $socketRdState($stateArg(socketinfo))
-	} elseif {($doing eq "read")} {
-	    lappend InFlightR $tokenArg
-	}
-
-	if {    [info exists socketWrState($stateArg(socketinfo))]
-	     && $socketWrState($stateArg(socketinfo)) ni {Wready peNding}
-	} {
-	    lappend InFlightW $socketWrState($stateArg(socketinfo))
-	} elseif {($doing eq "write")} {
-	    lappend InFlightW $tokenArg
-	}
-
-	# Report any inconsistency of $tokenArg with socket*state.
-	if {    ($doing eq "read")
-	     && [info exists socketRdState($stateArg(socketinfo))]
-	     && ($tokenArg ne $socketRdState($stateArg(socketinfo)))
-	} {
-	    Log WARNING - ReplayIfDead pipelined tokenArg $tokenArg $doing \
-		    ne socketRdState($stateArg(socketinfo)) \
-		      $socketRdState($stateArg(socketinfo))
-
-	} elseif {
-		($doing eq "write")
-	     && [info exists socketWrState($stateArg(socketinfo))]
-	     && ($tokenArg ne $socketWrState($stateArg(socketinfo)))
-	} {
-	    Log WARNING - ReplayIfDead pipelined tokenArg $tokenArg $doing \
-		    ne socketWrState($stateArg(socketinfo)) \
-		      $socketWrState($stateArg(socketinfo))
-	}
-    } else {
-	# One transaction should be in flight.
-	# socketRdState, socketWrQueue are used.
-	# socketRdQueue should be empty.
-
-	# Report any inconsistency of $tokenArg with socket*state.
-	if {$tokenArg ne $socketRdState($stateArg(socketinfo))} {
-	    Log WARNING - ReplayIfDead nonpipeline tokenArg $tokenArg $doing \
-		    ne socketRdState($stateArg(socketinfo)) \
-		      $socketRdState($stateArg(socketinfo))
-	}
-
-	# Report the inconsistency that socketRdQueue is non-empty.
-	if {    [info exists socketRdQueue($stateArg(socketinfo))]
-	     && ($socketRdQueue($stateArg(socketinfo)) ne {})
-	} {
-	    Log WARNING - ReplayIfDead nonpipeline tokenArg $tokenArg $doing \
-		    has read queue socketRdQueue($stateArg(socketinfo)) \
-		    $socketRdQueue($stateArg(socketinfo)) ne {}
-	}
-
-	lappend InFlightW $socketRdState($stateArg(socketinfo))
-	set socketRdQueue($stateArg(socketinfo)) {}
-    }
-
-    set newQueue {}
-    lappend newQueue {*}$InFlightR
-    lappend newQueue {*}$socketRdQueue($stateArg(socketinfo))
-    lappend newQueue {*}$InFlightW
-    lappend newQueue {*}$socketWrQueue($stateArg(socketinfo))
-
-
-    # 2. Tidy up tokenArg.  This is a cut-down form of Finish/CloseSocket.
-    #    Do not change state(status).
-    #    No need to after cancel stateArg(after) - either this is done in
-    #    ReplayCore/ReInit, or Finish is called.
-
-    catch {close $stateArg(sock)}
-
-    # 2a. Tidy the tokens in the queues - this is done in ReplayCore/ReInit.
-    # - Transactions, if any, that are awaiting responses cannot be completed.
-    #   They are listed for re-sending in newQueue.
-    # - All tokens are preserved for re-use by ReplayCore, and their variables
-    #   will be re-initialised by calls to ReInit.
-    # - The relevant element of socketMapping, socketRdState, socketWrState,
-    #   socketRdQueue, socketWrQueue, socketClosing, socketPlayCmd will be set
-    #   to new values in ReplayCore.
-
-    ReplayCore $newQueue
-}
-
-# http::ReplayIfClose --
-#
-#	A request on a socket that was previously "Connection: keep-alive" has
-#	received a "Connection: close" response header.  The server supplies
-#	that response correctly, but any later requests already queued on this
-#	connection will be lost when the socket closes.
-#
-#	This command takes arguments that represent the socketWrState,
-#	socketRdQueue and socketWrQueue for this connection.  The socketRdState
-#	is not needed because the server responds in full to the request that
-#	received the "Connection: close" response header.
-#
-#	Existing request tokens $token (::http::$n) are preserved.  The caller
-#	will be unaware that the request was processed this way.
-
-proc http::ReplayIfClose {Wstate Rqueue Wqueue} {
-    Log running http::ReplayIfClose for $Wstate $Rqueue $Wqueue
-
-    if {$Wstate in $Rqueue || $Wstate in $Wqueue} {
-	Log WARNING duplicate token in http::ReplayIfClose - token $Wstate
-	set Wstate Wready
-    }
-
-    # 1. Create newQueue
-    set InFlightW {}
-    if {$Wstate ni {Wready peNding}} {
-	lappend InFlightW $Wstate
-    }
-
-    set newQueue {}
-    lappend newQueue {*}$Rqueue
-    lappend newQueue {*}$InFlightW
-    lappend newQueue {*}$Wqueue
-
-    # 2. Cleanup - none needed, done by the caller.
-
-    ReplayCore $newQueue
-}
-
-# http::ReInit --
-#
-#	Command to restore a token's state to a condition that
-#	makes it ready to replay a request.
-#
-#	Command http::geturl stores extra state in state(tmp*) so
-#	we don't need to do the argument processing again.
-#
-#	The caller must:
-#	- Set state(reusing) and state(sock) to their new values after calling
-#	  this command.
-#	- Unset state(tmpState), state(tmpOpenCmd) if future calls to ReplayCore
-#	  or ReInit are inappropriate for this token. Typically only one retry
-#	  is allowed.
-#	The caller may also unset state(tmpConnArgs) if this value (and the
-#	token) will be used immediately.  The value is needed by tokens that
-#	will be stored in a queue.
-#
-# Arguments:
-#	token	Connection token.
-#
-# Return Value: (boolean) true iff the re-initialisation was successful.
-
-proc http::ReInit {token} {
-    variable $token
-    upvar 0 $token state
-
-    if {!(
-	      [info exists state(tmpState)]
-	   && [info exists state(tmpOpenCmd)]
-	   && [info exists state(tmpConnArgs)]
-	 )
-    } {
-	Log FAILED in http::ReInit via ReplayCore - NO tmp vars for $token
-	return 0
-    }
-
-    if {[info exists state(after)]} {
-	after cancel $state(after)
-	unset state(after)
-    }
-
-    # Don't alter state(status) - this would trigger http::wait if it is in use.
-    set tmpState    $state(tmpState)
-    set tmpOpenCmd  $state(tmpOpenCmd)
-    set tmpConnArgs $state(tmpConnArgs)
-    foreach name [array names state] {
-	if {$name ne "status"} {
-	    unset state($name)
-	}
-    }
-
-    # Don't alter state(status).
-    # Restore state(tmp*) - the caller may decide to unset them.
-    # Restore state(tmpConnArgs) which is needed for connection.
-    # state(tmpState), state(tmpOpenCmd) are needed only for retries.
-
-    dict unset tmpState status
-    array set state $tmpState
-    set state(tmpState)    $tmpState
-    set state(tmpOpenCmd)  $tmpOpenCmd
-    set state(tmpConnArgs) $tmpConnArgs
-
-    return 1
-}
-
-# http::ReplayCore --
-#
-#	Command to replay a list of requests, using existing connection tokens.
-#
-#	Abstracted from http::geturl which stores extra state in state(tmp*) so
-#	we don't need to do the argument processing again.
-#
-# Arguments:
-#	newQueue	List of connection tokens.
-#
-# Side Effects:
-#	Use existing tokens, but try to open a new socket.
-
-proc http::ReplayCore {newQueue} {
-    variable socketMapping
-    variable socketRdState
-    variable socketWrState
-    variable socketRdQueue
-    variable socketWrQueue
-    variable socketClosing
-    variable socketPlayCmd
-
-    if {[llength $newQueue] == 0} {
-	# Nothing to do.
-	return
-    }
-
-    ##Log running ReplayCore for {*}$newQueue
-    set newToken [lindex $newQueue 0]
-    set newQueue [lrange $newQueue 1 end]
-
-    # 3. Use newToken, and restore its values of state(*).  Do not restore
-    #    elements tmp* - we try again only once.
-
-    set token $newToken
-    variable $token
-    upvar 0 $token state
-
-    if {![ReInit $token]} {
-	Log FAILED in http::ReplayCore - NO tmp vars
-	Finish $token {cannot send this request again}
-	return
-    }
-
-    set tmpState    $state(tmpState)
-    set tmpOpenCmd  $state(tmpOpenCmd)
-    set tmpConnArgs $state(tmpConnArgs)
-    unset state(tmpState)
-    unset state(tmpOpenCmd)
-    unset state(tmpConnArgs)
-
-    set state(reusing) 0
-
-    if {$state(-timeout) > 0} {
-	set resetCmd [list http::reset $token timeout]
-	set state(after) [after $state(-timeout) $resetCmd]
-    }
-
-    set pre [clock milliseconds]
-    ##Log pre socket opened, - token $token
-    ##Log $tmpOpenCmd - token $token
-    # 4. Open a socket.
-    if {[catch {eval $tmpOpenCmd} sock]} {
-	# Something went wrong while trying to establish the connection.
-	Log FAILED - $sock
-	set state(sock) NONE
-	Finish $token $sock
-	return
-    }
-    ##Log post socket opened, - token $token
-    set delay [expr {[clock milliseconds] - $pre}]
-    if {$delay > 3000} {
-	Log socket delay $delay - token $token
-    }
-    # Command [socket] is called with -async, but takes 5s to 5.1s to return,
-    # with probability of order 1 in 10,000.  This may be a bizarre scheduling
-    # issue with my (KJN's) system (Fedora Linux).
-    # This does not cause a problem (unless the request times out when this
-    # command returns).
-
-    # 5. Configure the persistent socket data.
-    if {$state(-keepalive)} {
-	set socketMapping($state(socketinfo)) $sock
-
-	if {![info exists socketRdState($state(socketinfo))]} {
-	    set socketRdState($state(socketinfo)) {}
-	    set varName ::http::socketRdState($state(socketinfo))
-	    trace add variable $varName unset ::http::CancelReadPipeline
-	}
-
-	if {![info exists socketWrState($state(socketinfo))]} {
-	    set socketWrState($state(socketinfo)) {}
-	    set varName ::http::socketWrState($state(socketinfo))
-	    trace add variable $varName unset ::http::CancelWritePipeline
-	}
-
-	if {$state(-pipeline)} {
-	    #Log new, init for pipelined, GRANT write acc to $token ReplayCore
-	    set socketRdState($state(socketinfo)) $token
-	    set socketWrState($state(socketinfo)) $token
-	} else {
-	    #Log new, init for nonpipeline, GRANT r/w acc to $token ReplayCore
-	    set socketRdState($state(socketinfo)) $token
-	    set socketWrState($state(socketinfo)) $token
-	}
-
-	set socketRdQueue($state(socketinfo)) {}
-	set socketWrQueue($state(socketinfo)) $newQueue
-	set socketClosing($state(socketinfo)) 0
-	set socketPlayCmd($state(socketinfo)) {ReplayIfClose Wready {} {}}
-    }
-
-    ##Log pre newQueue ReInit, - token $token
-    # 6. Configure sockets in the queue.
-    foreach tok $newQueue {
-	if {[ReInit $tok]} {
-	    set ${tok}(reusing) 1
-	    set ${tok}(sock) $sock
-	} else {
-	    set ${tok}(reusing) 1
-	    set ${tok}(sock) NONE
-	    Finish $token {cannot send this request again}
-	}
-    }
-
-    # 7. Configure the socket for newToken to send a request.
-    set state(sock) $sock
-    Log "Using $sock for $state(socketinfo) - token $token" \
-	[expr {$state(-keepalive)?"keepalive":""}]
-
-    # Initialisation of a new socket.
-    ##Log socket opened, now fconfigure - token $token
-    fconfigure $sock -translation {auto crlf} -buffersize $state(-blocksize)
-    ##Log socket opened, DONE fconfigure - token $token
-
-    # Connect does its own fconfigure.
-    fileevent $sock writable [list http::Connect $token {*}$tmpConnArgs]
-    #Log ---- $sock << conn to $token for HTTP request (e)
-}
-
-# Data access functions:
-# Data - the URL data
-# Status - the transaction status: ok, reset, eof, timeout, error
-# Code - the HTTP transaction code, e.g., 200
-# Size - the size of the URL data
-
-proc http::data {token} {
-    variable $token
-    upvar 0 $token state
-    return $state(body)
-}
-proc http::status {token} {
-    if {![info exists $token]} {
-	return "error"
-    }
-    variable $token
-    upvar 0 $token state
-    return $state(status)
-}
-proc http::code {token} {
-    variable $token
-    upvar 0 $token state
-    return $state(http)
-}
-proc http::ncode {token} {
-    variable $token
-    upvar 0 $token state
-    if {[regexp {[0-9]{3}} $state(http) numeric_code]} {
-	return $numeric_code
-    } else {
-	return $state(http)
-    }
-}
-proc http::size {token} {
-    variable $token
-    upvar 0 $token state
-    return $state(currentsize)
-}
-proc http::meta {token} {
-    variable $token
-    upvar 0 $token state
-    return $state(meta)
-}
-proc http::error {token} {
-    variable $token
-    upvar 0 $token state
-    if {[info exists state(error)]} {
-	return $state(error)
-    }
-    return ""
-}
-
-# http::cleanup
-#
-#	Garbage collect the state associated with a transaction
-#
-# Arguments
-#	token	The token returned from http::geturl
-#
-# Side Effects
-#	Unsets the state array.
-
-proc http::cleanup {token} {
-    variable $token
-    upvar 0 $token state
-    if {[info commands ${token}EventCoroutine] ne {}} {
-	rename ${token}EventCoroutine {}
-    }
-    if {[info exists state(after)]} {
-	after cancel $state(after)
-	unset state(after)
-    }
-    if {[info exists state]} {
-	unset state
-    }
-}
-
-# http::Connect
-#
-#	This callback is made when an asynchronous connection completes.
-#
-# Arguments
-#	token	The token returned from http::geturl
-#
-# Side Effects
-#	Sets the status of the connection, which unblocks
-# 	the waiting geturl call
-
-proc http::Connect {token proto phost srvurl} {
-    variable $token
-    upvar 0 $token state
-    set tk [namespace tail $token]
-    set err "due to unexpected EOF"
-    if {
-	[eof $state(sock)] ||
-	[set err [fconfigure $state(sock) -error]] ne ""
-    } {
-	Log "WARNING - if testing, pay special attention to this\
-		case (GJ) which is seldom executed - token $token"
-	if {[info exists state(reusing)] && $state(reusing)} {
-	    # The socket was closed at the server end, and closed at
-	    # this end by http::CheckEof.
-	    if {[TestForReplay $token write $err b]} {
-		return
-	    }
-
-	    # else:
-	    # This is NOT a persistent socket that has been closed since its
-	    # last use.
-	    # If any other requests are in flight or pipelined/queued, they will
-	    # be discarded.
-	}
-	Finish $token "connect failed $err"
-    } else {
-	set state(state) connecting
-	fileevent $state(sock) writable {}
-	::http::Connected $token $proto $phost $srvurl
-    }
-}
-
-# http::Write
-#
-#	Write POST query data to the socket
-#
-# Arguments
-#	token	The token for the connection
-#
-# Side Effects
-#	Write the socket and handle callbacks.
-
-proc http::Write {token} {
-    variable http
-    variable socketMapping
-    variable socketRdState
-    variable socketWrState
-    variable socketRdQueue
-    variable socketWrQueue
-    variable socketClosing
-    variable socketPlayCmd
-
-    variable $token
-    upvar 0 $token state
-    set tk [namespace tail $token]
-    set sock $state(sock)
-
-    # Output a block.  Tcl will buffer this if the socket blocks
-    set done 0
-    if {[catch {
-	# Catch I/O errors on dead sockets
-
-	if {[info exists state(-query)]} {
-	    # Chop up large query strings so queryprogress callback can give
-	    # smooth feedback.
-	    if {    $state(queryoffset) + $state(-queryblocksize)
-		 >= $state(querylength)
-	    } {
-		# This will be the last puts for the request-body.
-		if {    (![catch {fileevent $sock readable} binding])
-		     && ($binding eq [list http::CheckEof $sock])
-		} {
-		    # Remove the "fileevent readable" binding of an idle
-		    # persistent socket to http::CheckEof.  We can no longer
-		    # treat bytes received as junk. The server might still time
-		    # out and half-close the socket if it has not yet received
-		    # the first "puts".
-		    fileevent $sock readable {}
-		}
-	    }
-	    puts -nonewline $sock \
-		[string range $state(-query) $state(queryoffset) \
-		     [expr {$state(queryoffset) + $state(-queryblocksize) - 1}]]
-	    incr state(queryoffset) $state(-queryblocksize)
-	    if {$state(queryoffset) >= $state(querylength)} {
-		set state(queryoffset) $state(querylength)
-		set done 1
-	    }
-	} else {
-	    # Copy blocks from the query channel
-
-	    set outStr [read $state(-querychannel) $state(-queryblocksize)]
-	    if {[eof $state(-querychannel)]} {
-		# This will be the last puts for the request-body.
-		if {    (![catch {fileevent $sock readable} binding])
-		     && ($binding eq [list http::CheckEof $sock])
-		} {
-		    # Remove the "fileevent readable" binding of an idle
-		    # persistent socket to http::CheckEof.  We can no longer
-		    # treat bytes received as junk. The server might still time
-		    # out and half-close the socket if it has not yet received
-		    # the first "puts".
-		    fileevent $sock readable {}
-		}
-	    }
-	    puts -nonewline $sock $outStr
-	    incr state(queryoffset) [string length $outStr]
-	    if {[eof $state(-querychannel)]} {
-		set done 1
-	    }
-	}
-    } err]} {
-	# Do not call Finish here, but instead let the read half of the socket
-	# process whatever server reply there is to get.
-
-	set state(posterror) $err
-	set done 1
-    }
-
-    if {$done} {
-	catch {flush $sock}
-	fileevent $sock writable {}
-	Log ^C$tk end sending request - token $token
-	# End of writing (POST method).  The request has been sent.
-
-	DoneRequest $token
-    }
-
-    # Callback to the client after we've completely handled everything.
-
-    if {[string length $state(-queryprogress)]} {
-	eval $state(-queryprogress) \
-	    [list $token $state(querylength) $state(queryoffset)]
-    }
-}
-
-# http::Event
-#
-#	Handle input on the socket. This command is the core of
-#	the coroutine commands ${token}EventCoroutine that are
-#	bound to "fileevent $sock readable" and process input.
-#
-# Arguments
-#	sock	The socket receiving input.
-#	token	The token returned from http::geturl
-#
-# Side Effects
-#	Read the socket and handle callbacks.
-
-proc http::Event {sock token} {
-    variable http
-    variable socketMapping
-    variable socketRdState
-    variable socketWrState
-    variable socketRdQueue
-    variable socketWrQueue
-    variable socketClosing
-    variable socketPlayCmd
-
-    variable $token
-    upvar 0 $token state
-    set tk [namespace tail $token]
-    while 1 {
-	yield
-	##Log Event call - token $token
-
-	if {![info exists state]} {
-	    Log "Event $sock with invalid token '$token' - remote close?"
-	    if {![eof $sock]} {
-		if {[set d [read $sock]] ne ""} {
-		    Log "WARNING: additional data left on closed socket\
-			    - token $token"
-		}
-	    }
-	    Log ^X$tk end of response (token error) - token $token
-	    CloseSocket $sock
-	    return
-	}
-	if {$state(state) eq "connecting"} {
-	    ##Log - connecting - token $token
-	    if {    $state(reusing)
-		 && $state(-pipeline)
-		 && ($state(-timeout) > 0)
-		 && (![info exists state(after)])
-	    } {
-		set state(after) [after $state(-timeout) \
-			[list http::reset $token timeout]]
-	    }
-
-	    if {[catch {gets $sock state(http)} nsl]} {
-		Log "WARNING - if testing, pay special attention to this\
-			case (GK) which is seldom executed - token $token"
-		if {[info exists state(reusing)] && $state(reusing)} {
-		    # The socket was closed at the server end, and closed at
-		    # this end by http::CheckEof.
-
-		    if {[TestForReplay $token read $nsl c]} {
-			return
-		    }
-
-		    # else:
-		    # This is NOT a persistent socket that has been closed since
-		    # its last use.
-		    # If any other requests are in flight or pipelined/queued,
-		    # they will be discarded.
-		} else {
-		    Log ^X$tk end of response (error) - token $token
-		    Finish $token $nsl
-		    return
-		}
-	    } elseif {$nsl >= 0} {
-		##Log - connecting 1 - token $token
-		set state(state) "header"
-	    } elseif {    [eof $sock]
-		       && [info exists state(reusing)]
-		       && $state(reusing)
-	    } {
-		# The socket was closed at the server end, and we didn't notice.
-		# This is the first read - where the closure is usually first
-		# detected.
-
-		if {[TestForReplay $token read {} d]} {
-		    return
-		}
-
-		# else:
-		# This is NOT a persistent socket that has been closed since its
-		# last use.
-		# If any other requests are in flight or pipelined/queued, they
-		# will be discarded.
-	    }
-	} elseif {$state(state) eq "header"} {
-	    if {[catch {gets $sock line} nhl]} {
-		##Log header failed - token $token
-		Log ^X$tk end of response (error) - token $token
-		Finish $token $nhl
-		return
-	    } elseif {$nhl == 0} {
-		##Log header done - token $token
-		Log ^E$tk end of response headers - token $token
-		# We have now read all headers
-		# We ignore HTTP/1.1 100 Continue returns. RFC2616 sec 8.2.3
-		if {    ($state(http) == "")
-		     || ([regexp {^\S+\s(\d+)} $state(http) {} x] && $x == 100)
-		} {
-		    set state(state) "connecting"
-		    continue
-		    # This was a "return" in the pre-coroutine code.
-		}
-
-		if {    ([info exists state(connection)])
-		     && ([info exists socketMapping($state(socketinfo))])
-		     && ("keep-alive" in $state(connection))
-		     && ($state(-keepalive))
-		     && (!$state(reusing))
-		     && ($state(-pipeline))
-		} {
-		    # Response headers received for first request on a
-		    # persistent socket.  Now ready for pipelined writes (if
-		    # any).
-		    # Previous value is $token. It cannot be "pending".
-		    set socketWrState($state(socketinfo)) Wready
-		    http::NextPipelinedWrite $token
-		}
-
-		# Once a "close" has been signaled, the client MUST NOT send any
-		# more requests on that connection.
-		#
-		# If either the client or the server sends the "close" token in
-		# the Connection header, that request becomes the last one for
-		# the connection.
-
-		if {    ([info exists state(connection)])
-		     && ([info exists socketMapping($state(socketinfo))])
-		     && ("close" in $state(connection))
-		     && ($state(-keepalive))
-		} {
-		    # The server warns that it will close the socket after this
-		    # response.
-		    ##Log WARNING - socket will close after response for $token
-		    # Prepare data for a call to ReplayIfClose.
-		    if {    ($socketRdQueue($state(socketinfo)) ne {})
-			 || ($socketWrQueue($state(socketinfo)) ne {})
-			 || ($socketWrState($state(socketinfo)) ni
-						[list Wready peNding $token])
-		    } {
-			set InFlightW $socketWrState($state(socketinfo))
-			if {$InFlightW in [list Wready peNding $token]} {
-			    set InFlightW Wready
-			} else {
-			    set msg "token ${InFlightW} is InFlightW"
-			    ##Log $msg - token $token
-			}
-
-			set socketPlayCmd($state(socketinfo)) \
-				[list ReplayIfClose $InFlightW \
-				$socketRdQueue($state(socketinfo)) \
-				$socketWrQueue($state(socketinfo))]
-
-			# - All tokens are preserved for re-use by ReplayCore.
-			# - Queues are preserved in case of Finish with error,
-			#   but are not used for anything else because
-			#   socketClosing(*) is set below.
-			# - Cancel the state(after) timeout events.
-			foreach tokenVal $socketRdQueue($state(socketinfo)) {
-			    if {[info exists ${tokenVal}(after)]} {
-				after cancel [set ${tokenVal}(after)]
-				unset ${tokenVal}(after)
-			    }
-			}
-
-		    } else {
-			set socketPlayCmd($state(socketinfo)) \
-				{ReplayIfClose Wready {} {}}
-		    }
-
-		    # Do not allow further connections on this socket.
-		    set socketClosing($state(socketinfo)) 1
-		}
-
-		set state(state) body
-
-		# According to
-		# https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Connection
-		# any comma-separated "Connection:" list implies keep-alive, but I
-		# don't see this in the RFC so we'll play safe and
-		# scan any list for "close".
-		# Done here to support combining duplicate header field's values.
-		if {   [info exists state(connection)]
-		    && ("close" ni $state(connection))
-		    && ("keep-alive" ni $state(connection))
-		} {
-		    lappend state(connection) "keep-alive"
-		}
-
-		# If doing a HEAD, then we won't get any body
-		if {$state(-validate)} {
-		    Log ^F$tk end of response for HEAD request - token $token
-		    set state(state) complete
-		    Eot $token
-		    return
-		}
-
-		# - For non-chunked transfer we may have no body - in this case
-		#   we may get no further file event if the connection doesn't
-		#   close and no more data is sent. We can tell and must finish
-		#   up now - not later - the alternative would be to wait until
-		#   the server times out.
-		# - In this case, the server has NOT told the client it will
-		#   close the connection, AND it has NOT indicated the resource
-		#   length EITHER by setting the Content-Length (totalsize) OR
-		#   by using chunked Transfer-Encoding.
-		# - Do not worry here about the case (Connection: close) because
-		#   the server should close the connection.
-		# - IF (NOT Connection: close) AND (NOT chunked encoding) AND
-		#      (totalsize == 0).
-
-		if {    (!(    [info exists state(connection)]
-			    && ("close" in $state(connection))
-			  )
-			)
-		     && (![info exists state(transfer)])
-		     && ($state(totalsize) == 0)
-		} {
-		    set msg {body size is 0 and no events likely - complete}
-		    Log "$msg - token $token"
-		    set msg {(length unknown, set to 0)}
-		    Log ^F$tk end of response body {*}$msg - token $token
-		    set state(state) complete
-		    Eot $token
-		    return
-		}
-
-		# We have to use binary translation to count bytes properly.
-		lassign [fconfigure $sock -translation] trRead trWrite
-		fconfigure $sock -translation [list binary $trWrite]
-
-		if {
-		    $state(-binary) || [IsBinaryContentType $state(type)]
-		} {
-		    # Turn off conversions for non-text data.
-		    set state(binary) 1
-		}
-		if {[info exists state(-channel)]} {
-		    if {$state(binary) || [llength [ContentEncoding $token]]} {
-			fconfigure $state(-channel) -translation binary
-		    }
-		    if {![info exists state(-handler)]} {
-			# Initiate a sequence of background fcopies.
-			fileevent $sock readable {}
-			rename ${token}EventCoroutine {}
-			CopyStart $sock $token
-			return
-		    }
-		}
-	    } elseif {$nhl > 0} {
-		# Process header lines.
-		##Log header - token $token - $line
-		if {[regexp -nocase {^([^:]+):(.+)$} $line x key value]} {
-		    switch -- [string tolower $key] {
-			content-type {
-			    set state(type) [string trim [string tolower $value]]
-			    # Grab the optional charset information.
-			    if {[regexp -nocase \
-				    {charset\s*=\s*\"((?:[^""]|\\\")*)\"} \
-				    $state(type) -> cs]} {
-				set state(charset) [string map {{\"} \"} $cs]
-			    } else {
-				regexp -nocase {charset\s*=\s*(\S+?);?} \
-					$state(type) -> state(charset)
-			    }
-			}
-			content-length {
-			    set state(totalsize) [string trim $value]
-			}
-			content-encoding {
-			    set state(coding) [string trim $value]
-			}
-			transfer-encoding {
-			    set state(transfer) \
-				    [string trim [string tolower $value]]
-			}
-			proxy-connection -
-			connection {
-			    # RFC 7230 Section 6.1 states that a comma-separated
-			    # list is an acceptable value.
-			    foreach el [SplitCommaSeparatedFieldValue $value] {
-				lappend state(connection) [string tolower $el]
-			    }
-			}
-			upgrade {
-			    set state(upgrade) [string trim $value]
-			}
-		    }
-		    lappend state(meta) $key [string trim $value]
-		}
-	    }
-	} else {
-	    # Now reading body
-	    ##Log body - token $token
-	    if {[catch {
-		if {[info exists state(-handler)]} {
-		    set n [eval $state(-handler) [list $sock $token]]
-		    ##Log handler $n - token $token
-		    # N.B. the protocol has been set to 1.0 because the -handler
-		    # logic is not expected to handle chunked encoding.
-		    # FIXME Allow -handler with 1.1 on dechunked stacked chan.
-		    if {$state(totalsize) == 0} {
-			# We know the transfer is complete only when the server
-			# closes the connection - i.e. eof is not an error.
-			set state(state) complete
-		    }
-		    if {![string is integer -strict $n]} {
-			if 1 {
-			    # Do not tolerate bad -handler - fail with error
-			    # status.
-			    set msg {the -handler command for http::geturl must\
-				    return an integer (the number of bytes\
-				    read)}
-			    Log ^X$tk end of response (handler error) -\
-				    token $token
-			    Eot $token $msg
-			} else {
-			    # Tolerate the bad -handler, and continue.  The
-			    # penalty:
-			    # (a) Because the handler returns nonsense, we know
-			    #     the transfer is complete only when the server
-			    #     closes the connection - i.e. eof is not an
-			    #     error.
-			    # (b) http::size will not be accurate.
-			    # (c) The transaction is already downgraded to 1.0
-			    #     to avoid chunked transfer encoding.  It MUST
-			    #     also be forced to "Connection: close" or the
-			    #     HTTP/1.0 equivalent; or it MUST fail (as
-			    #     above) if the server sends
-			    #     "Connection: keep-alive" or the HTTP/1.0
-			    #     equivalent.
-			    set n 0
-			    set state(state) complete
-			}
-		    }
-		} elseif {[info exists state(transfer_final)]} {
-		    # This code forgives EOF in place of the final CRLF.
-		    set line [getTextLine $sock]
-		    set n [string length $line]
-		    set state(state) complete
-		    if {$n > 0} {
-			# - HTTP trailers (late response headers) are permitted
-			#   by Chunked Transfer-Encoding, and can be safely
-			#   ignored.
-			# - Do not count these bytes in the total received for
-			#   the response body.
-			Log "trailer of $n bytes after final chunk -\
-				token $token"
-			append state(transfer_final) $line
-			set n 0
-		    } else {
-			Log ^F$tk end of response body (chunked) - token $token
-			Log "final chunk part - token $token"
-			Eot $token
-		    }
-		} elseif {    [info exists state(transfer)]
-			   && ($state(transfer) eq "chunked")
-		} {
-		    ##Log chunked - token $token
-		    set size 0
-		    set hexLenChunk [getTextLine $sock]
-		    #set ntl [string length $hexLenChunk]
-		    if {[string trim $hexLenChunk] ne ""} {
-			scan $hexLenChunk %x size
-			if {$size != 0} {
-			    ##Log chunk-measure $size - token $token
-			    set chunk [BlockingRead $sock $size]
-			    set n [string length $chunk]
-			    if {$n >= 0} {
-				append state(body) $chunk
-				incr state(log_size) [string length $chunk]
-				##Log chunk $n cumul $state(log_size) -\
-					token $token
-			    }
-			    if {$size != [string length $chunk]} {
-				Log "WARNING: mis-sized chunk:\
-				    was [string length $chunk], should be\
-				    $size - token $token"
-				set n 0
-				set state(connection) close
-				Log ^X$tk end of response (chunk error) \
-					- token $token
-				set msg {error in chunked encoding - fetch\
-					terminated}
-				Eot $token $msg
-			    }
-			    # CRLF that follows chunk.
-			    # If eof, this is handled at the end of this proc.
-			    getTextLine $sock
-			} else {
-			    set n 0
-			    set state(transfer_final) {}
-			}
-		    } else {
-			# Line expected to hold chunk length is empty, or eof.
-			##Log bad-chunk-measure - token $token
-			set n 0
-			set state(connection) close
-			Log ^X$tk end of response (chunk error) - token $token
-			Eot $token {error in chunked encoding -\
-				fetch terminated}
-		    }
-		} else {
-		    ##Log unchunked - token $token
-		    if {$state(totalsize) == 0} {
-			# We know the transfer is complete only when the server
-			# closes the connection.
-			set state(state) complete
-			set reqSize $state(-blocksize)
-		    } else {
-			# Ask for the whole of the unserved response-body.
-			# This works around a problem with a tls::socket - for
-			# https in keep-alive mode, and a request for
-			# $state(-blocksize) bytes, the last part of the
-			# resource does not get read until the server times out.
-			set reqSize [expr {  $state(totalsize)
-					   - $state(currentsize)}]
-
-			# The workaround fails if reqSize is
-			# capped at $state(-blocksize).
-			# set reqSize [expr {min($reqSize, $state(-blocksize))}]
-		    }
-		    set c $state(currentsize)
-		    set t $state(totalsize)
-		    ##Log non-chunk currentsize $c of totalsize $t -\
-			    token $token
-		    set block [read $sock $reqSize]
-		    set n [string length $block]
-		    if {$n >= 0} {
-			append state(body) $block
-			##Log non-chunk [string length $state(body)] -\
-				token $token
-		    }
-		}
-		# This calculation uses n from the -handler, chunked, or
-		# unchunked case as appropriate.
-		if {[info exists state]} {
-		    if {$n >= 0} {
-			incr state(currentsize) $n
-			set c $state(currentsize)
-			set t $state(totalsize)
-			##Log another $n currentsize $c totalsize $t -\
-				token $token
-		    }
-		    # If Content-Length - check for end of data.
-		    if {
-			   ($state(totalsize) > 0)
-			&& ($state(currentsize) >= $state(totalsize))
-		    } {
-			Log ^F$tk end of response body (unchunked) -\
-				token $token
-			set state(state) complete
-			Eot $token
-		    }
-		}
-	    } err]} {
-		Log ^X$tk end of response (error ${err}) - token $token
-		Finish $token $err
-		return
-	    } else {
-		if {[info exists state(-progress)]} {
-		    eval $state(-progress) \
-			[list $token $state(totalsize) $state(currentsize)]
-		}
-	    }
-	}
-
-	# catch as an Eot above may have closed the socket already
-	# $state(state) may be connecting, header, body, or complete
-	if {![set cc [catch {eof $sock} eof]] && $eof} {
-	    ##Log eof - token $token
-	    if {[info exists $token]} {
-		set state(connection) close
-		if {$state(state) eq "complete"} {
-		    # This includes all cases in which the transaction
-		    # can be completed by eof.
-		    # The value "complete" is set only in http::Event, and it is
-		    # used only in the test above.
-		    Log ^F$tk end of response body (unchunked, eof) -\
-			    token $token
-		    Eot $token
-		} else {
-		    # Premature eof.
-		    Log ^X$tk end of response (unexpected eof) - token $token
-		    Eot $token eof
-		}
-	    } else {
-		# open connection closed on a token that has been cleaned up.
-		Log ^X$tk end of response (token error) - token $token
-		CloseSocket $sock
-	    }
-	} elseif {$cc} {
-	    return
-	}
-    }
-}
-
-# http::TestForReplay
-#
-#	Command called if eof is discovered when a socket is first used for a
-#	new transaction.  Typically this occurs if a persistent socket is used
-#	after a period of idleness and the server has half-closed the socket.
-#
-# token  - the connection token returned by http::geturl
-# doing  - "read" or "write"
-# err    - error message, if any
-# caller - code to identify the caller - used only in logging
-#
-# Return Value: boolean, true iff the command calls http::ReplayIfDead.
-
-proc http::TestForReplay {token doing err caller} {
-    variable http
-    variable $token
-    upvar 0 $token state
-    set tk [namespace tail $token]
-    if {$doing eq "read"} {
-	set code Q
-	set action response
-	set ing reading
-    } else {
-	set code P
-	set action request
-	set ing writing
-    }
-
-    if {$err eq {}} {
-	set err "detect eof when $ing (server timed out?)"
-    }
-
-    if {$state(method) eq "POST" && !$http(-repost)} {
-	# No Replay.
-	# The present transaction will end when Finish is called.
-	# That call to Finish will abort any other transactions
-	# currently in the write queue.
-	# For calls from http::Event this occurs when execution
-	# reaches the code block at the end of that proc.
-	set msg {no retry for POST with http::config -repost 0}
-	Log reusing socket failed "($caller)" - $msg - token $token
-	Log error - $err - token $token
-	Log ^X$tk end of $action (error) - token $token
-	return 0
-    } else {
-	# Replay.
-	set msg {try a new socket}
-	Log reusing socket failed "($caller)" - $msg - token $token
-	Log error - $err - token $token
-	Log ^$code$tk Any unfinished (incl this one) failed - token $token
-	ReplayIfDead $token $doing
-	return 1
-    }
-}
-
-# http::IsBinaryContentType --
-#
-#	Determine if the content-type means that we should definitely transfer
-#	the data as binary. [Bug 838e99a76d]
-#
-# Arguments
-#	type	The content-type of the data.
-#
-# Results:
-#	Boolean, true if we definitely should be binary.
-
-proc http::IsBinaryContentType {type} {
-    lassign [split [string tolower $type] "/;"] major minor
-    if {$major eq "text"} {
-	return false
-    }
-    # There's a bunch of XML-as-application-format things about. See RFC 3023
-    # and so on.
-    if {$major eq "application"} {
-	set minor [string trimright $minor]
-	if {$minor in {"json" "xml" "xml-external-parsed-entity" "xml-dtd"}} {
-	    return false
-	}
-    }
-    # Not just application/foobar+xml but also image/svg+xml, so let us not
-    # restrict things for now...
-    if {[string match "*+xml" $minor]} {
-	return false
-    }
-    return true
-}
-
-# http::getTextLine --
-#
-#	Get one line with the stream in crlf mode.
-#	Used if Transfer-Encoding is chunked.
-#	Empty line is not distinguished from eof.  The caller must
-#	be able to handle this.
-#
-# Arguments
-#	sock	The socket receiving input.
-#
-# Results:
-#	The line of text, without trailing newline
-
-proc http::getTextLine {sock} {
-    set tr [fconfigure $sock -translation]
-    lassign $tr trRead trWrite
-    fconfigure $sock -translation [list crlf $trWrite]
-    set r [BlockingGets $sock]
-    fconfigure $sock -translation $tr
-    return $r
-}
-
-# http::BlockingRead
-#
-#	Replacement for a blocking read.
-#	The caller must be a coroutine.
-
-proc http::BlockingRead {sock size} {
-    if {$size < 1} {
-	return
-    }
-    set result {}
-    while 1 {
-	set need [expr {$size - [string length $result]}]
-	set block [read $sock $need]
-	set eof [eof $sock]
-	append result $block
-	if {[string length $result] >= $size || $eof} {
-	    return $result
-	} else {
-	    yield
-	}
-    }
-}
-
-# http::BlockingGets
-#
-#	Replacement for a blocking gets.
-#	The caller must be a coroutine.
-#	Empty line is not distinguished from eof.  The caller must
-#	be able to handle this.
-
-proc http::BlockingGets {sock} {
-    while 1 {
-	set count [gets $sock line]
-	set eof [eof $sock]
-	if {$count >= 0 || $eof} {
-	    return $line
-	} else {
-	    yield
-	}
-    }
-}
-
-# http::CopyStart
-#
-#	Error handling wrapper around fcopy
-#
-# Arguments
-#	sock	The socket to copy from
-#	token	The token returned from http::geturl
-#
-# Side Effects
-#	This closes the connection upon error
-
-proc http::CopyStart {sock token {initial 1}} {
-    upvar #0 $token state
-    if {[info exists state(transfer)] && $state(transfer) eq "chunked"} {
-	foreach coding [ContentEncoding $token] {
-	    lappend state(zlib) [zlib stream $coding]
-	}
-	make-transformation-chunked $sock [namespace code [list CopyChunk $token]]
-    } else {
-	if {$initial} {
-	    foreach coding [ContentEncoding $token] {
-		zlib push $coding $sock
-	    }
-	}
-	if {[catch {
-	    # FIXME Keep-Alive on https tls::socket with unchunked transfer
-	    # hangs until the server times out. A workaround is possible, as for
-	    # the case without -channel, but it does not use the neat "fcopy"
-	    # solution.
-	    fcopy $sock $state(-channel) -size $state(-blocksize) -command \
-		[list http::CopyDone $token]
-	} err]} {
-	    Finish $token $err
-	}
-    }
-}
-
-proc http::CopyChunk {token chunk} {
-    upvar 0 $token state
-    if {[set count [string length $chunk]]} {
-	incr state(currentsize) $count
-	if {[info exists state(zlib)]} {
-	    foreach stream $state(zlib) {
-		set chunk [$stream add $chunk]
-	    }
-	}
-	puts -nonewline $state(-channel) $chunk
-	if {[info exists state(-progress)]} {
-	    eval [linsert $state(-progress) end \
-		      $token $state(totalsize) $state(currentsize)]
-	}
-    } else {
-	Log "CopyChunk Finish - token $token"
-	if {[info exists state(zlib)]} {
-	    set excess ""
-	    foreach stream $state(zlib) {
-		catch {set excess [$stream add -finalize $excess]}
-	    }
-	    puts -nonewline $state(-channel) $excess
-	    foreach stream $state(zlib) { $stream close }
-	    unset state(zlib)
-	}
-	Eot $token ;# FIX ME: pipelining.
-    }
-}
-
-# http::CopyDone
-#
-#	fcopy completion callback
-#
-# Arguments
-#	token	The token returned from http::geturl
-#	count	The amount transferred
-#
-# Side Effects
-#	Invokes callbacks
-
-proc http::CopyDone {token count {error {}}} {
-    variable $token
-    upvar 0 $token state
-    set sock $state(sock)
-    incr state(currentsize) $count
-    if {[info exists state(-progress)]} {
-	eval $state(-progress) \
-	    [list $token $state(totalsize) $state(currentsize)]
-    }
-    # At this point the token may have been reset.
-    if {[string length $error]} {
-	Finish $token $error
-    } elseif {[catch {eof $sock} iseof] || $iseof} {
-	Eot $token
-    } else {
-	CopyStart $sock $token 0
-    }
-}
-
-# http::Eot
-#
-#	Called when either:
-#	a. An eof condition is detected on the socket.
-#	b. The client decides that the response is complete.
-#	c. The client detects an inconsistency and aborts the transaction.
-#
-#	Does:
-#	1. Set state(status)
-#	2. Reverse any Content-Encoding
-#	3. Convert charset encoding and line ends if necessary
-#	4. Call http::Finish
-#
-# Arguments
-#	token	The token returned from http::geturl
-#	force	(previously) optional, has no effect
-#	reason	- "eof" means premature EOF (not EOF as the natural end of
-#		  the response)
-#		- "" means completion of response, with or without EOF
-#		- anything else describes an error condition other than
-#		  premature EOF.
-#
-# Side Effects
-#	Clean up the socket
-
-proc http::Eot {token {reason {}}} {
-    variable $token
-    upvar 0 $token state
-    if {$reason eq "eof"} {
-	# Premature eof.
-	set state(status) eof
-	set reason {}
-    } elseif {$reason ne ""} {
-	# Abort the transaction.
-	set state(status) $reason
-    } else {
-	# The response is complete.
-	set state(status) ok
-    }
-
-    if {[string length $state(body)] > 0} {
-	if {[catch {
-	    foreach coding [ContentEncoding $token] {
-		set state(body) [zlib $coding $state(body)]
-	    }
-	} err]} {
-	    Log "error doing decompression for token $token: $err"
-	    Finish $token $err
-	    return
-	}
-
-	if {!$state(binary)} {
-	    # If we are getting text, set the incoming channel's encoding
-	    # correctly.  iso8859-1 is the RFC default, but this could be any
-	    # IANA charset.  However, we only know how to convert what we have
-	    # encodings for.
-
-	    set enc [CharsetToEncoding $state(charset)]
-	    if {$enc ne "binary"} {
-		set state(body) [encoding convertfrom $enc $state(body)]
-	    }
-
-	    # Translate text line endings.
-	    set state(body) [string map {\r\n \n \r \n} $state(body)]
-	}
-    }
-    Finish $token $reason
-}
-
-# http::wait --
-#
-#	See documentation for details.
-#
-# Arguments:
-#	token	Connection token.
-#
-# Results:
-#	The status after the wait.
-
-proc http::wait {token} {
-    variable $token
-    upvar 0 $token state
-
-    if {![info exists state(status)] || $state(status) eq ""} {
-	# We must wait on the original variable name, not the upvar alias
-	vwait ${token}(status)
-    }
-
-    return [status $token]
-}
-
-# http::formatQuery --
-#
-#	See documentation for details.  Call http::formatQuery with an even
-#	number of arguments, where the first is a name, the second is a value,
-#	the third is another name, and so on.
-#
-# Arguments:
-#	args	A list of name-value pairs.
-#
-# Results:
-#	TODO
-
-proc http::formatQuery {args} {
-    if {[llength $args] % 2} {
-	return \
-		-code error \
-		-errorcode [list HTTP BADARGCNT $args] \
-		{Incorrect number of arguments, must be an even number.}
-    }
-    set result ""
-    set sep ""
-    foreach i $args {
-	append result $sep [mapReply $i]
-	if {$sep eq "="} {
-	    set sep &
-	} else {
-	    set sep =
-	}
-    }
-    return $result
-}
-
-# http::mapReply --
-#
-#	Do x-www-urlencoded character mapping
-#
-# Arguments:
-#	string	The string the needs to be encoded
-#
-# Results:
-#       The encoded string
-
-proc http::mapReply {string} {
-    variable http
-    variable formMap
-
-    # The spec says: "non-alphanumeric characters are replaced by '%HH'". Use
-    # a pre-computed map and [string map] to do the conversion (much faster
-    # than [regsub]/[subst]). [Bug 1020491]
-
-    if {$http(-urlencoding) ne ""} {
-	set string [encoding convertto $http(-urlencoding) $string]
-	return [string map $formMap $string]
-    }
-    set converted [string map $formMap $string]
-    if {[string match "*\[\u0100-\uffff\]*" $converted]} {
-	regexp "\[\u0100-\uffff\]" $converted badChar
-	# Return this error message for maximum compatibility... :^/
-	return -code error \
-	    "can't read \"formMap($badChar)\": no such element in array"
-    }
-    return $converted
-}
-interp alias {} http::quoteString {} http::mapReply
-
-# http::ProxyRequired --
-#	Default proxy filter.
-#
-# Arguments:
-#	host	The destination host
-#
-# Results:
-#       The current proxy settings
-
-proc http::ProxyRequired {host} {
-    variable http
-    if {[info exists http(-proxyhost)] && [string length $http(-proxyhost)]} {
-	if {
-	    ![info exists http(-proxyport)] ||
-	    ![string length $http(-proxyport)]
-	} {
-	    set http(-proxyport) 8080
-	}
-	return [list $http(-proxyhost) $http(-proxyport)]
-    }
-}
-
-# http::CharsetToEncoding --
-#
-#	Tries to map a given IANA charset to a tcl encoding.  If no encoding
-#	can be found, returns binary.
-#
-
-proc http::CharsetToEncoding {charset} {
-    variable encodings
-
-    set charset [string tolower $charset]
-    if {[regexp {iso-?8859-([0-9]+)} $charset -> num]} {
-	set encoding "iso8859-$num"
-    } elseif {[regexp {iso-?2022-(jp|kr)} $charset -> ext]} {
-	set encoding "iso2022-$ext"
-    } elseif {[regexp {shift[-_]?jis} $charset]} {
-	set encoding "shiftjis"
-    } elseif {[regexp {(?:windows|cp)-?([0-9]+)} $charset -> num]} {
-	set encoding "cp$num"
-    } elseif {$charset eq "us-ascii"} {
-	set encoding "ascii"
-    } elseif {[regexp {(?:iso-?)?lat(?:in)?-?([0-9]+)} $charset -> num]} {
-	switch -- $num {
-	    5 {set encoding "iso8859-9"}
-	    1 - 2 - 3 {
-		set encoding "iso8859-$num"
-	    }
-	    default {
-		set encoding "binary"
-	    }
-	}
-    } else {
-	# other charset, like euc-xx, utf-8,...  may directly map to encoding
-	set encoding $charset
-    }
-    set idx [lsearch -exact $encodings $encoding]
-    if {$idx >= 0} {
-	return $encoding
-    } else {
-	return "binary"
-    }
-}
-
-# Return the list of content-encoding transformations we need to do in order.
-proc http::ContentEncoding {token} {
-    upvar 0 $token state
-    set r {}
-    if {[info exists state(coding)]} {
-	foreach coding [split $state(coding) ,] {
-	    switch -exact -- $coding {
-		deflate { lappend r inflate }
-		gzip - x-gzip { lappend r gunzip }
-		compress - x-compress { lappend r decompress }
-		identity {}
-		br {
-		    return -code error\
-			    "content-encoding \"br\" not implemented"
-		}
-		default {
-		    Log "unknown content-encoding \"$coding\" ignored"
-		}
-	    }
-	}
-    }
-    return $r
-}
-
-proc http::ReceiveChunked {chan command} {
-    set data ""
-    set size -1
-    yield
-    while {1} {
-	chan configure $chan -translation {crlf binary}
-	while {[gets $chan line] < 1} { yield }
-	chan configure $chan -translation {binary binary}
-	if {[scan $line %x size] != 1} {
-	    return -code error "invalid size: \"$line\""
-	}
-	set chunk ""
-	while {$size && ![chan eof $chan]} {
-	    set part [chan read $chan $size]
-	    incr size -[string length $part]
-	    append chunk $part
-	}
-	if {[catch {
-	    uplevel #0 [linsert $command end $chunk]
-	}]} {
-	    http::Log "Error in callback: $::errorInfo"
-	}
-	if {[string length $chunk] == 0} {
-	    # channel might have been closed in the callback
-	    catch {chan event $chan readable {}}
-	    return
-	}
-    }
-}
-
-# http::SplitCommaSeparatedFieldValue --
-# 	Return the individual values of a comma-separated field value.
-#
-# Arguments:
-#	fieldValue	Comma-separated header field value.
-#
-# Results:
-#       List of values.
-proc http::SplitCommaSeparatedFieldValue {fieldValue} {
-    set r {}
-    foreach el [split $fieldValue ,] {
-	lappend r [string trim $el]
-    }
-    return $r
-}
-
-
-# http::GetFieldValue --
-# 	Return the value of a header field.
-#
-# Arguments:
-#	headers	Headers key-value list
-#	fieldName	Name of header field whose value to return.
-#
-# Results:
-#       The value of the fieldName header field
-#
-# Field names are matched case-insensitively (RFC 7230 Section 3.2).
-#
-# If the field is present multiple times, it is assumed that the field is
-# defined as a comma-separated list and the values are combined (by separating
-# them with commas, see RFC 7230 Section 3.2.2) and returned at once.
-proc http::GetFieldValue {headers fieldName} {
-    set r {}
-    foreach {field value} $headers {
-	if {[string equal -nocase $fieldName $field]} {
-	    if {$r eq {}} {
-		set r $value
-	    } else {
-		append r ", $value"
-	    }
-	}
-    }
-    return $r
-}
-
-proc http::make-transformation-chunked {chan command} {
-    coroutine [namespace current]::dechunk$chan ::http::ReceiveChunked $chan $command
-    chan event $chan readable [namespace current]::dechunk$chan
-}
-
-# Local variables:
-# indent-tabs-mode: t
-# End: