+\fB\-threadlevel\fR \fIlevel\fR

+.

+Specifies whether and how to use the \fBThread\fR package. Possible values of \fIlevel\fR are 0, 1 or 2.

+.RS

+.PP

+.DS

+0 - (the default) do not use Thread

+1 - use Thread if it is available, do not use it if it is unavailable

+2 - use Thread if it is available, raise an error if it is unavailable

+.DE

+The Tcl \fBsocket -async\fR command can block in adverse cases (e.g. a slow DNS lookup). Using the Thread package works around this problem, for both HTTP and HTTPS transactions. Values of \fIlevel\fR other than 0 are available only to the main interpreter in each thread. See section \fBTHREADS\fR for more information.

+.RE

+.TP

+.SH THREADS

+.PP

+.SS "PURPOSE"

+.PP

+Command \fB::http::geturl\fR uses the Tcl \fB::socket\fR command with the \-async option to connect to a remote server, but the return from this command can be delayed in adverse cases (e.g. a slow DNS lookup), preventing the event loop from processing other events. This delay is avoided if the \fB::socket\fR command is evaluated in another thread. The Thread package is not part of Tcl but is provided in "Batteries Included" distributions. Instead of the \fB::socket\fR command, the http package uses \fB::http::socket\fR which makes connections in the manner specified by the value of \-threadlevel and the availability of package Thread.

+.PP

+.SS "WITH TLS (HTTPS)"

+.PP

+The same \-threadlevel configuration applies to both HTTP and HTTPS connections. HTTPS is enabled by using the \fBhttp::register\fR command, typically by specifying the \fB::tls::socket\fR command of the tls package to handle TLS cryptography. The \fB::tls::socket\fR command connects to the remote server by using the command specified by the value of variable \fB::tls::socketCmd\fR, and this value defaults to "::socket". If http::geturl finds that \fB::tls::socketCmd\fR has this value, it replaces it with the value "::http::socket". If \fB::tls::socketCmd\fR has a value other than "::socket", i.e. if the script or the Tcl installation has replaced the value "::socket" with the name of a different command, then http does not change the value. The script or installation that modified \fB::tls::socketCmd\fR is responsible for integrating \fB::http::socket\fR into its own replacement command.

+.PP

+.SS "WITH A CHILD INTERPRETER"

+.PP

+The peer thread can transfer the socket only to the main interpreter of the script's thread. Therefore the thread-based \fB::http::socket\fR works with non-zero \-threadlevel values only if the script runs in the main interpreter. A child interpreter must use \-threadlevel 0 unless the parent interpreter has provided alternative facilities. The main parent interpreter may grant full \-threadlevel facilities to a child interpreter, for example by aliasing, to \fB::http::socket\fR in the child, a command that runs \fBhttp::socket\fR in the parent, and then transfers the socket to the child.

+.PP

+#undef TclObjInterpProc

+/* Slot 259 is reserved */

+ void (*reserved259)(void);

+/* Slot 259 is reserved */

+#undef TclObjInterpProc

+#define TclObjInterpProc TclGetObjInterpProc()

+#undef TclObjInterpProc

+#undef TclObjInterpProc

+#undef TclObjInterpProc

+ 0, /* 259 */

+ -threadlevel 0

+ variable socketPhQueue

+ variable socketCoEvent

+ array unset socketPhQueue

+ array unset socketCoEvent

+ array set socketPhQueue {}

+ array set socketCoEvent {}

+ return

+ set urlTypes(http) [list 80 ::http::socket]

+ variable TmpSockCounter 0

+ variable ThreadCounter 0

+

+ } elseif {[llength $args] % 2} {

+ return -code error "If more than one argument is supplied, the\

+ number of arguments must be even"

+ if {($flag eq {-threadlevel}) && ($value ni {0 1 2})} {

+ return -code error {Option -threadlevel must be 0, 1 or 2}

+ }

+ return

+ variable socketPhQueue

+ variable socketCoEvent

+ if {[info commands ${token}--EventCoroutine] ne {}} {

+ rename ${token}--EventCoroutine {}

+ }

+ if {[info commands ${token}--SocketCoroutine] ne {}} {

+ rename ${token}--SocketCoroutine {}

+ }

+ if {[info exists state(socketcoro)]} {

+ Log $token Cancel socket after-idle event (Finish)

+ after cancel $state(socketcoro)

+ unset state(socketcoro)

+ [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 {[info exists state(sock)]} {

+ set sock $state(sock)

+ CloseSocket $state(sock) $token

+ } else {

+ # When opening the socket and calling http::reset

+ # immediately, the socket may not yet exist.

+ # Test http-4.11 may come here.

+ }

+ if {$state(tid) ne {}} {

+ # When opening the socket in a thread, and calling http::reset

+ # immediately, the thread may still exist.

+ # Test http-4.11 may come here.

+ thread::release $state(tid)

+ set state(tid) {}

+ } else {

+ }

+ if {[info exists state(sock)]} {

+ set sock $state(sock)

+ CloseSocket $state(sock) $token

+ } else {

+ # When opening the socket and calling http::reset

+ # immediately, the socket may not yet exist.

+ # Test http-4.11 may come here.

+ }

+ # This calls Unset. Other cases do not need the call.

+ return

+ variable socketPhQueue

+ variable socketCoEvent

+ set conn [set ${token3}(connArgs)]

+ set conn [set ${token3}(connArgs)]

+ set conn [set ${token3}(connArgs)]

+ return

+ return

+ variable socketPhQueue

+ variable socketCoEvent

+ } else {

+ } else {

+ } else {

+ return

+ variable socketPhQueue

+ variable socketCoEvent

+ ##Log CloseQueuedQueries $connId

+ # - At this stage socketPhQueue is empty.

+ - token $token - unfinished $unfinished

+ # Calls ReplayIfClose.

+ return

+ variable socketPhQueue

+ variable socketCoEvent

+ return

+ return

+ variable urlTypes

+

+ # The value is set in the namespace header of this file. If the file has

+ # not been modified the value is "::http::socket".

+ set socketCmd [lindex $urlTypes(http) 1]

+

+ # - If ::tls::socketCmd has its default value "::socket", change it to the

+ # new value $socketCmd.

+ # - If the old value is different, then it has been modified either by the

+ # script or by the Tcl installation, and replaced by a new command. The

+ # script or installation that modified ::tls::socketCmd is also

+ # responsible for integrating ::http::socket into its own "new" command,

+ # if it wishes to do so.

+

+ if {[info exists ::tls::socketCmd] && ($::tls::socketCmd eq {::socket})} {

+ set ::tls::socketCmd $socketCmd

+ }

+

+ set token [CreateToken $url {*}$args]

+ variable $token

+ upvar 0 $token state

+

+ AsyncTransaction $token

+

+ # --------------------------------------------------------------------------

+ # Synchronous Call to http::geturl

+ # --------------------------------------------------------------------------

+ # - If the call to http::geturl is asynchronous, it is now complete (apart

+ # from delivering the return value).

+ # - If the call to http::geturl is synchronous, the command must now wait

+ # for the HTTP transaction to be completed. The call to http::wait uses

+ # vwait, which may be inappropriate if the caller makes other HTTP

+ # requests in the background.

+ # --------------------------------------------------------------------------

+

+ 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

+ }

+ }

+

+ return $token

+}

+

+# ------------------------------------------------------------------------------

+# Proc http::CreateToken

+# ------------------------------------------------------------------------------

+# Command to convert arguments into an initialised request token.

+# The return value is the variable name of the token.

+#

+# Other effects:

+# - Sets ::http::http(usingThread) if not already done

+# - Sets ::http::http(uid) if not already done

+# - Increments ::http::http(uid)

+# - May increment ::http::TmpSockCounter

+# - Alters ::http::socketPlayCmd, ::http::socketWrQueue if a -keepalive 1

+# request is appended to the queue of a persistent socket that is already

+# scheduled to close.

+# This also sets state(alreadyQueued) to 1.

+# - Alters ::http::socketPhQueue if a -keepalive 1 request is appended to the

+# queue of a persistent socket that has not yet been created (and is therefore

+# represented by a placeholder).

+# This also sets state(ReusingPlaceholder) to 1.

+# ------------------------------------------------------------------------------

+

+proc http::CreateToken {url args} {

+ variable TmpSockCounter

+ if {![info exists http(usingThread)]} {

+ set http(usingThread) 0

+ }

+ tid {}

+ return -code error "Bad value for $flag ($value), number\

+ of list elements must be even"

+ } else {

+ set phost {}

+ set pport {}

+ # Don't append the fragment! RFC 7230 Sec 5.1

+ # If we are using the proxy, we must pass in the full URL that includes

+ # the server name.

+ if {$phost ne ""} {

+ set srvurl $url

+ set targetAddr [list $phost $pport]

+ } else {

+ set targetAddr [list $host $port]

+ }

+

+ set sockopts [list -async]

+

+ # Pass -myaddr directly to the socket command

+ if {[info exists state(-myaddr)]} {

+ lappend sockopts -myaddr $state(-myaddr)

+ }

+

+ set state(connArgs) [list $proto $phost $srvurl]

+ set state(openCmd) [list {*}$defcmd {*}$sockopts {*}$targetAddr]

+

+ set state(alreadyQueued) 0

+ set state(ReusingPlaceholder) 0

+ variable socketPhQueue

+ variable socketCoEvent

+ Log "reusing closing socket $sock for $state(socketinfo) - token $token"

+ set state(alreadyQueued) 1

+ ##Log socketPlayCmd($state(socketinfo)) is $socketPlayCmd($state(socketinfo))

+ ##Log socketWrQueue($state(socketinfo)) is $socketWrQueue($state(socketinfo))

+ } elseif {

+ [catch {fconfigure $socketMapping($state(socketinfo))}]

+ && (![SockIsPlaceHolder $socketMapping($state(socketinfo))])

+ } {

+ ###Log "Socket $socketMapping($state(socketinfo)) for $state(socketinfo)"

+ # - 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.

+ # - The socket may not yet exist, and be defined with a placeholder.

+ if {[SockIsPlaceHolder $sock]} {

+ set state(ReusingPlaceholder) 1

+ lappend socketPhQueue($sock) $token

+ } else {

+ }

+ Log "reusing open socket $sock for $state(socketinfo) - token $token"

+ set state(reusing) $reusing

+ unset reusing

+ if {![info exists sock]} {

+ # N.B. At this point ([info exists sock] == $state(reusing)).

+ # This will no longer be true after we set a value of sock here.

+ # Give the socket a placeholder name.

+ set sock HTTP_PLACEHOLDER_[incr TmpSockCounter]

+ }

+ set state(sock) $sock

+ if {$state(reusing)} {

+ # Define these for use (only) by http::ReplayIfDead if the persistent

+ # connection has died.

+ set state(tmpConnArgs) $state(connArgs)

+ set state(tmpState) [array get state]

+ set state(tmpOpenCmd) $state(openCmd)

+ return $token

+}

+

+# ------------------------------------------------------------------------------

+# Proc ::http::SockIsPlaceHolder

+# ------------------------------------------------------------------------------

+# Command to return 0 if the argument is a genuine socket handle, or 1 if is a

+# placeholder value generated by geturl or ReplayCore before the real socket is

+# created.

+#

+# Arguments:

+# sock - either a valid socket handle or a placeholder value

+#

+# Return Value: 0 or 1

+# ------------------------------------------------------------------------------

+

+proc http::SockIsPlaceHolder {sock} {

+ expr {[string range $sock 0 16] eq {HTTP_PLACEHOLDER_}}

+}

+

+

+# ------------------------------------------------------------------------------

+# state(reusing)

+# ------------------------------------------------------------------------------

+# - state(reusing) is set by geturl, ReplayCore

+# - state(reusing) is used by geturl, AsyncTransaction, OpenSocket,

+# ConfigureNewSocket, and ScheduleRequest when creating and configuring the

+# connection.

+# - state(reusing) is used by Connect, Connected, Event x 2 when deciding

+# whether to call TestForReplay.

+# - Other places 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.

+# ------------------------------------------------------------------------------

+

+

+# ------------------------------------------------------------------------------

+# Proc http::AsyncTransaction

+# ------------------------------------------------------------------------------

+# This command is called by geturl and ReplayCore to prepare the HTTP

+# transaction prescribed by a suitably prepared token.

+#

+# Arguments:

+# token - connection token (name of an array)

+#

+# Return Value: none

+# ------------------------------------------------------------------------------

+

+proc http::AsyncTransaction {token} {

+ variable $token

+ upvar 0 $token state

+ set tk [namespace tail $token]

+

+ variable socketMapping

+ variable socketRdState

+ variable socketWrState

+ variable socketRdQueue

+ variable socketWrQueue

+ variable socketPhQueue

+ variable socketClosing

+ variable socketPlayCmd

+ variable socketCoEvent

+

+ set sock $state(sock)

+ if { $state(-keepalive)

+ && (![info exists socketMapping($state(socketinfo))])

+ } {

+ # This code is executed only for the first -keepalive request on a

+ # socket. It makes the socket persistent.

+ ##Log " PreparePersistentConnection" $token -- $sock -- DO

+ set DoLater [PreparePersistentConnection $token]

+ } else {

+ ##Log " PreparePersistentConnection" $token -- $sock -- SKIP

+ set DoLater {-traceread 0 -tracewrite 0}

+ }

+

+ if {$state(ReusingPlaceholder)} {

+ # - This request was added to the socketPhQueue of a persistent

+ # connection.

+ # - But the connection has not yet been created and is a placeholder;

+ # - And the placeholder was created by an earlier request.

+ # - When that earlier request calls OpenSocket, its placeholder is

+ # replaced with a true socket, and it then executes the equivalent of

+ # OpenSocket for any subsequent requests that have

+ # $state(ReusingPlaceholder).

+ Log >J$tk after idle coro NO - ReusingPlaceholder

+ } elseif {$state(alreadyQueued)} {

+ # - This request was added to the socketWrQueue and socketPlayCmd

+ # of a persistent connection that will close at the end of its current

+ # read operation.

+ Log >J$tk after idle coro NO - alreadyQueued

+ } else {

+ Log >J$tk after idle coro YES

+ set CoroName ${token}--SocketCoroutine

+ set cancel [after idle [list coroutine $CoroName ::http::OpenSocket \

+ $token $DoLater]]

+ dict set socketCoEvent($state(socketinfo)) $token $cancel

+ set state(socketcoro) $cancel

+ }

+

+ return

+}

+

+

+# ------------------------------------------------------------------------------

+# Proc http::PreparePersistentConnection

+# ------------------------------------------------------------------------------

+# This command is called by AsyncTransaction to initialise a "persistent

+# connection" based upon a socket placeholder. It is called the first time the

+# socket is associated with a "-keepalive" request.

+#

+# Arguments:

+# token - connection token (name of an array)

+#

+# Return Value: - DoLater, a dictionary of boolean values listing unfinished

+# tasks; to be passed to ConfigureNewSocket via OpenSocket.

+# ------------------------------------------------------------------------------

+

+proc http::PreparePersistentConnection {token} {

+ variable $token

+ upvar 0 $token state

+

+ variable socketMapping

+ variable socketRdState

+ variable socketWrState

+ variable socketRdQueue

+ variable socketWrQueue

+ variable socketPhQueue

+ variable socketClosing

+ variable socketPlayCmd

+ variable socketCoEvent

+

+ set DoLater {-traceread 0 -tracewrite 0}

+ set socketMapping($state(socketinfo)) $state(sock)

+

+ if {![info exists socketRdState($state(socketinfo))]} {

+ set socketRdState($state(socketinfo)) {}

+ # set varName ::http::socketRdState($state(socketinfo))

+ # trace add variable $varName unset ::http::CancelReadPipeline

+ dict set DoLater -traceread 1

+ }

+ if {![info exists socketWrState($state(socketinfo))]} {

+ set socketWrState($state(socketinfo)) {}

+ # set varName ::http::socketWrState($state(socketinfo))

+ # trace add variable $varName unset ::http::CancelWritePipeline

+ dict set DoLater -tracewrite 1

+ }

+

+ 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 socketPhQueue($state(socketinfo)) {}

+ set socketClosing($state(socketinfo)) 0

+ set socketPlayCmd($state(socketinfo)) {ReplayIfClose Wready {} {}}

+ set socketCoEvent($state(socketinfo)) {}

+

+ return $DoLater

+}

+

+# ------------------------------------------------------------------------------

+# Proc ::http::OpenSocket

+# ------------------------------------------------------------------------------

+# This command is called as a coroutine idletask to start the asynchronous HTTP

+# transaction in most cases. For the exceptions, see the calling code in

+# command AsyncTransaction.

+#

+# Arguments:

+# token - connection token (name of an array)

+# DoLater - dictionary of boolean values listing unfinished tasks

+#

+# Return Value: none

+# ------------------------------------------------------------------------------

+

+proc http::OpenSocket {token DoLater} {

+ variable $token

+ upvar 0 $token state

+ set tk [namespace tail $token]

+

+ variable socketMapping

+ variable socketRdState

+ variable socketWrState

+ variable socketRdQueue

+ variable socketWrQueue

+ variable socketPhQueue

+ variable socketClosing

+ variable socketPlayCmd

+ variable socketCoEvent

+

+ Log >K$tk Start OpenSocket coroutine

+

+ if {![info exists state(-keepalive)]} {

+ # The request has already been cancelled by the calling script.

+ return

+ }

+

+ set sockOld $state(sock)

+

+ dict unset socketCoEvent($state(socketinfo)) $token

+ unset -nocomplain state(socketcoro)

+

+ set reusing $state(reusing)

+

+ if {$reusing} {

+ # If ($reusing) is true, then we do not need to create a new socket,

+ # even if $sockOld is only a placeholder for a socket.

+ set sock $sockOld

+ } else {

+ # set sock in the [catch] below.

+ ##Log $state(openCmd) - token $token

+ if {[catch {eval $state(openCmd)} sock errdict]} {

+ # ERROR CASE

+ # Tidy up after events and such, but DON'T call the command

+ # callback (if available).

+ # - When this was inline code in http::geturl, it threw an exception

+ # from here instead.

+ # - Now that this code is called from geturl as an idletask and not

+ # as inline code, it is inappropriate to run cleanup or throw an

+ # exception. Instead do a normal return, and let Finish report

+ # the error using token/state and the -command callback.

+ # Finish also undoes PreparePersistentConnection.

+ set ::errorInfo [dict get $errdict -errorinfo]

+ set ::errorCode [dict get $errdict -errorcode]

+ Finish $token $sock

+ # cleanup $token

+ return

+ # Normal return from $state(openCmd) always returns a valid socket.

+ set state(sock) $sock

+ # Code above has set state(sock) $sock

+ ConfigureNewSocket $token $sockOld $DoLater

+

+ ##Log Leaving http::OpenSocket coroutine [info coroutine] - token $token

+ return

+}

+

+

+# ------------------------------------------------------------------------------

+# Proc ::http::ConfigureNewSocket

+# ------------------------------------------------------------------------------

+# Command to initialise a newly-created socket. Called only from OpenSocket.

+#

+# This command is called by OpenSocket whenever a genuine socket (sockNew) has

+# been opened for for use by HTTP. It does two things:

+# (1) If $token uses a placeholder socket, this command replaces the placeholder

+# socket with the real socket, not only in $token but in all other requests

+# that use the same placeholder.

+# (2) It calls ScheduleRequest to schedule each request that uses the socket.

+#

+#

+# Value of sockOld/sockNew can be "sock" (genuine socket) or "ph" (placeholder).

+# sockNew is ${token}(sock)

+# sockOld sockNew CASES

+# sock sock (if $reusing, and sockOld is sock)

+# ph sock (if (not $reusing), and sockOld is ph)

+# ph ph (if $reusing, and sockOld is ph) - not called in this case

+# sock ph (cannot occur unless a bug) - not called in this case

+# (if (not $reusing), and sockOld is sock) - illogical

+#

+# Arguments:

+# token - connection token (name of an array)

+# sockOld - handle or placeholder used for a socket before the call to OpenSocket

+# DoLater - dictionary of boolean values listing unfinished tasks

+#

+# Return Value: none

+# ------------------------------------------------------------------------------

+

+proc http::ConfigureNewSocket {token sockOld DoLater} {

+ variable $token

+ upvar 0 $token state

+ set tk [namespace tail $token]

+

+ variable socketMapping

+ variable socketRdState

+ variable socketWrState

+ variable socketRdQueue

+ variable socketWrQueue

+ variable socketPhQueue

+ variable socketClosing

+ variable socketPlayCmd

+ variable socketCoEvent

+

+ set reusing $state(reusing)

+ set sock $state(sock)

+ ##Log " ConfigureNewSocket" $token $sockOld ... -- $sock

+ if {(!$reusing) && ($sock ne $sockOld)} {

+ # Replace the placeholder value sockOld with sock.

+

+ if { [info exists socketMapping($state(socketinfo))]

+ && ($socketMapping($state(socketinfo)) eq $sockOld)

+ } {

+ set socketMapping($state(socketinfo)) $sock

+ ##Log set socketMapping($state(socketinfo)) $sock

+ }

+

+ # Now finish any tasks left over from PreparePersistentConnection on

+ # the connection.

+ #

+ # The "unset" traces are fired by init (clears entire arrays), and

+ # by http::Unset.

+ # Unset is called by CloseQueuedQueries and (possibly never) by geturl.

+ #

+ # CancelReadPipeline, CancelWritePipeline call http::Finish for each

+ # token.

+ #

+ # FIXME If Finish is placeholder-aware, these traces can be set earlier,

+ # in PreparePersistentConnection.

+

+ if {[dict get $DoLater -traceread]} {

+ }

+ if {[dict get $DoLater -tracewrite]} {

+ }

+ }

+ # Do this in all cases.

+ ScheduleRequest $token

+ # Now look at all other tokens that use the placeholder $sockOld.

+ if { (!$reusing)

+ && ($sock ne $sockOld)

+ && [info exists socketPhQueue($sockOld)]

+ } {

+ ##Log " ConfigureNewSocket" $token scheduled, now do $socketPhQueue($sockOld)

+ foreach tok $socketPhQueue($sockOld) {

+ # 1. Amend the token's (sock).

+ ##Log set ${tok}(sock) $sock

+ set ${tok}(sock) $sock

+ # 2. Schedule the token's HTTP request.

+ # Every token in socketPhQueue(*) has reusing 1 alreadyQueued 0.

+ set ${tok}(reusing) 1

+ set ${tok}(alreadyQueued) 0

+ ScheduleRequest $tok

+ }

+ set socketPhQueue($sockOld) {}

+ ##Log " ConfigureNewSocket" $token DONE

+ return

+}

+

+

+# ------------------------------------------------------------------------------

+# The values of array variables socketMapping etc.

+# ------------------------------------------------------------------------------

+# connId "$host:$port"

+# socketMapping($connId) the handle or placeholder for the socket that is used

+# for "-keepalive 1" requests to $connId.

+# socketRdState($connId) the token that is currently reading from the socket.

+# Other values: Rready (ready for next token to read).

+# socketWrState($connId) the token that is currently writing to the socket.

+# Other values: Wready (ready for next token to write),

+# peNding (would be ready for next write, except that

+# the integrity of a non-pipelined transaction requires

+# waiting until the read(s) in progress are finished).

+# socketRdQueue($connId) List of tokens that are queued for reading later.

+# socketWrQueue($connId) List of tokens that are queued for writing later.

+# socketPhQueue($connId) List of tokens that are queued to use a placeholder

+# socket, when the real socket has not yet been created.

+# socketClosing($connId) (boolean) true iff a server response header indicates

+# that the server will close the connection at the end of

+# the current response.

+# socketPlayCmd($connId) The command to execute to replay pending and

+# part-completed transactions if the socket closes early.

+# socketCoEvent($connId) Identifier for the "after idle" event that will launch

+# an OpenSocket coroutine to open or re-use a socket.

+# ------------------------------------------------------------------------------

+

+

+# ------------------------------------------------------------------------------

+# Using socketWrState(*), socketWrQueue(*), socketRdState(*), socketRdQueue(*)

+# ------------------------------------------------------------------------------

+# 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.

+# ------------------------------------------------------------------------------

+

+

+# ------------------------------------------------------------------------------

+# Proc http::ScheduleRequest

+# ------------------------------------------------------------------------------

+# Command to either begin the HTTP request, or add it to the appropriate queue.

+# Called from two places in ConfigureNewSocket.

+#

+# Arguments:

+# token - connection token (name of an array)

+#

+# Return Value: none

+# ------------------------------------------------------------------------------

+

+proc http::ScheduleRequest {token} {

+ variable $token

+ upvar 0 $token state

+ set tk [namespace tail $token]

+

+ Log >L$tk ScheduleRequest

+

+ variable socketMapping

+ variable socketRdState

+ variable socketWrState

+ variable socketRdQueue

+ variable socketWrQueue

+ variable socketPhQueue

+ variable socketClosing

+ variable socketPlayCmd

+ variable socketCoEvent

+

+ set Unfinished 0

+

+ set reusing $state(reusing)

+ set sockNew $state(sock)

+ # The "if" tests below: must test against the current values of

+ # socketWrState, socketRdState, and so the tests must be done here,

+ # not earlier in PreparePersistentConnection.

+

+ if {$state(alreadyQueued)} {

+ # The request has been appended to the queue of a persistent socket

+ # (that is scheduled to close and have its queue replayed).

+ #

+ if {$reusing && $state(-pipeline)} {

+ #Log new, init for pipelined, GRANT write access to $token in geturl

+ # DO NOT grant premature read access to the socket.

+ # set socketRdState($state(socketinfo)) $token

+ set socketWrState($state(socketinfo)) $token

+ } elseif {$reusing} {

+ # 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

+ } else {

+ }

+

+ # Process the request now.

+ # - Command is not called unless $state(sock) is a real socket handle

+ # and not a placeholder.

+ # - All (!$reusing) cases come here.

+ # - Some $reusing cases come here too if the connection is

+ # marked as ready. Those $reusing cases are:

+ # $reusing && ($socketWrState($state(socketinfo)) eq "Wready") &&

+ # EITHER !$pipeline && ($socketRdState($state(socketinfo)) eq "Rready")

+ # OR $pipeline

+ #

+ ##Log " ScheduleRequest" $token -- fileevent $state(sock) writable for $token

+ lassign $state(connArgs) proto phost srvurl

+ if {[catch {

+ fileevent $state(sock) writable \

+ [list http::Connect $token $proto $phost $srvurl]

+ } res opts]} {

+ # The socket no longer exists.

+ ##Log bug -- socket gone -- $res -- $opts

+

+

+ return

+

+ variable socketPhQueue

+ variable socketCoEvent

+ return

+ variable socketPhQueue

+ variable socketCoEvent

+ return

+ coroutine ${token}--EventCoroutine http::Event $sock $token

+ fileevent $sock readable ${token}--EventCoroutine

+ catch {${token}--EventCoroutine} res opts

+ if {[info commands ${token}--EventCoroutine] ne {}} {

+ set conn [set ${token2}(connArgs)]

+ set conn [set ${token3}(connArgs)]

+ return

+ return

+ return

+proc http::ReplayIfDead {token doing} {

+ variable socketPhQueue

+ variable socketCoEvent

+ variable $token

+ upvar 0 $token state

+ Log running http::ReplayIfDead for $token $doing

+ if {$state(-pipeline)} {

+ if { [info exists socketRdState($state(socketinfo))]

+ && ($socketRdState($state(socketinfo)) ne "Rready")

+ lappend InFlightR $socketRdState($state(socketinfo))

+ lappend InFlightR $token

+ if { [info exists socketWrState($state(socketinfo))]

+ && $socketWrState($state(socketinfo)) ni {Wready peNding}

+ lappend InFlightW $socketWrState($state(socketinfo))

+ lappend InFlightW $token

+ # Report any inconsistency of $token with socket*state.

+ && [info exists socketRdState($state(socketinfo))]

+ && ($token ne $socketRdState($state(socketinfo)))

+ Log WARNING - ReplayIfDead pipelined token $token $doing \

+ ne socketRdState($state(socketinfo)) \

+ $socketRdState($state(socketinfo))

+ && [info exists socketWrState($state(socketinfo))]

+ && ($token ne $socketWrState($state(socketinfo)))

+ Log WARNING - ReplayIfDead pipelined token $token $doing \

+ ne socketWrState($state(socketinfo)) \

+ $socketWrState($state(socketinfo))

+ # Report any inconsistency of $token with socket*state.

+ if {$token ne $socketRdState($state(socketinfo))} {

+ Log WARNING - ReplayIfDead nonpipeline token $token $doing \

+ ne socketRdState($state(socketinfo)) \

+ $socketRdState($state(socketinfo))

+ if { [info exists socketRdQueue($state(socketinfo))]

+ && ($socketRdQueue($state(socketinfo)) ne {})

+ Log WARNING - ReplayIfDead nonpipeline token $token $doing \

+ has read queue socketRdQueue($state(socketinfo)) \

+ $socketRdQueue($state(socketinfo)) ne {}

+ lappend InFlightW $socketRdState($state(socketinfo))

+ set socketRdQueue($state(socketinfo)) {}

+ lappend newQueue {*}$socketRdQueue($state(socketinfo))

+ lappend newQueue {*}$socketWrQueue($state(socketinfo))

+ # 2. Tidy up token. This is a cut-down form of Finish/CloseSocket.

+ # No need to after cancel state(after) - either this is done in

+ catch {close $state(sock)}

+ Unset $state(socketinfo)

+ return

+ ##Log $Rqueue -- $InFlightW -- $Wqueue

+ return

+ if {[info exists state(socketcoro)]} {

+ Log $token Cancel socket after-idle event (ReInit)

+ after cancel $state(socketcoro)

+ unset state(socketcoro)

+ }

+ variable TmpSockCounter

+

+ variable socketPhQueue

+ variable socketCoEvent

+ set state(ReusingPlaceholder) 0

+ set state(alreadyQueued) 0

+ # Give the socket a placeholder name before it is created.

+ set sock HTTP_PLACEHOLDER_[incr TmpSockCounter]

+ set state(sock) $sock

+ # Move the $newQueue into the placeholder socket's socketPhQueue.

+ set socketPhQueue($sock) {}

+ lappend socketPhQueue($sock) $tok

+ Finish $tok {cannot send this request again}

+ AsyncTransaction $token

+ return

+ return

+ if {[info commands ${token}--EventCoroutine] ne {}} {

+ rename ${token}--EventCoroutine {}

+ }

+ if {[info commands ${token}--SocketCoroutine] ne {}} {

+ rename ${token}--SocketCoroutine {}

+ if {[info exists state(socketcoro)]} {

+ Log $token Cancel socket after-idle event (cleanup)

+ after cancel $state(socketcoro)

+ unset state(socketcoro)

+ }

+ return

+

+ if {[catch {eof $state(sock)} tmp] || $tmp} {

+ set err "due to unexpected EOF"

+ } elseif {[set err [fconfigure $state(sock) -error]] ne ""} {

+ # set err is done in test

+ } else {

+ # All OK

+ set state(state) connecting

+ fileevent $state(sock) writable {}

+ ::http::Connected $token $proto $phost $srvurl

+ return

+ }

+

+ # Error cases.

+ return

+ variable socketPhQueue

+ variable socketCoEvent

+ return

+# the coroutine commands ${token}--EventCoroutine that are

+ variable socketPhQueue

+ variable socketCoEvent

+ if {!([catch {eof $sock} tmp] || $tmp)} {

+ } elseif { ([catch {eof $sock} tmp] || $tmp)

+ Log $token socket will close after this transaction

+ # 1. Cancel socket-assignment coro events that have not yet

+ # launched, and add the tokens to the write queue.

+ if {[info exists socketCoEvent($state(socketinfo))]} {

+ foreach {tok can} $socketCoEvent($state(socketinfo)) {

+ lappend socketWrQueue($state(socketinfo)) $tok

+ unset -nocomplain ${tok}(socketcoro)

+ after cancel $can

+ Log $tok Cancel socket after-idle event (Event)

+ Log Move $tok from socketCoEvent to socketWrQueue and cancel its after idle coro

+ }

+ set socketCoEvent($state(socketinfo)) {}

+ }

+

+ # Tokens in the read queue have no (socketcoro) to

+ # cancel.

+ # Do not allow further connections on this socket (but

+ # geturl can add new requests to the replay).

+ rename ${token}--EventCoroutine {}

+ if {(![catch {eof $sock} eof]) && $eof} {

+ # [eof sock] succeeded and the result was 1

+ } else {

+ # EITHER [eof sock] failed - presumed done by Eot

+ # OR [eof sock] succeeded and the result was 0

+ return

+# Used if Transfer-Encoding is chunked, to read the line that

+# reports the size of the following chunk.

+# Used when we expect to read a chunked-encoding

+# chunk of known size.

+ set eof [expr {[catch {eof $sock} tmp] || $tmp}]

+ set eof [expr {[catch {eof $sock} tmp] || $tmp}]

+ upvar 0 $token state

+ return

+ return

+ return

+ return

+ } else {

+ return

+ return

+}

+

+

+# ------------------------------------------------------------------------------

+# Proc http::socket

+# ------------------------------------------------------------------------------

+# This command is a drop-in replacement for ::socket.

+# Arguments and return value as for ::socket.

+#

+# Notes.

+# - http::socket is specified in place of ::socket by the definition of urlTypes

+# in the namespace header of this file (http.tcl).

+# - The command makes a simple call to ::socket unless the user has called

+# http::config to change the value of -threadlevel from the default value 0.

+# - For -threadlevel 1 or 2, if the Thread package is available, the command

+# waits in the event loop while the socket is opened in another thread. This

+# is a workaround for bug [824251] - it prevents http::geturl from blocking

+# the event loop if the DNS lookup or server connection is slow.

+# - FIXME Use a thread pool if connections are very frequent.

+# - FIXME The peer thread can transfer the socket only to the main interpreter

+# in the present thread. Therefore this code works only if this script runs

+# in the main interpreter. In a child interpreter, the parent must alias a

+# command to ::http::socket in the child, run http::socket in the parent,

+# and then transfer the socket to the child.

+# - The http::socket command is simple, and can easily be replaced with an

+# alternative command that uses a different technique to open a socket while

+# entering the event loop.

+# ------------------------------------------------------------------------------

+

+proc http::socket {args} {

+ variable ThreadVar

+ variable ThreadCounter

+ variable http

+

+ LoadThreadIfNeeded

+

+ set targ [lsearch -exact $args -token]

+ if {$targ != -1} {

+ set token [lindex $args $targ+1]

+ set args [lreplace $args $targ $targ+1]

+ upvar 0 $token state

+ }

+

+ if {!$http(usingThread)} {

+ # Use plain "::socket". This is the default.

+ return [eval ::socket $args]

+ }

+

+ set defcmd ::socket

+ set sockargs $args

+ set script "

+ [list proc ::SockInThread {caller defcmd sockargs} [info body http::SockInThread]]

+ [list ::SockInThread [thread::id] $defcmd $sockargs]

+ "

+

+ set state(tid) [thread::create]

+ set varName ::http::ThreadVar([incr ThreadCounter])

+ thread::send -async $state(tid) $script $varName

+ Log >T Thread Start Wait $args -- coro [info coroutine] $varName

+ if {[info coroutine] ne {}} {

+ # All callers in the http package are coroutines launched by

+ # the event loop.

+ # The cwait command requires a coroutine because it yields

+ # to the caller; $varName is traced and the coroutine resumes

+ # when the variable is written.

+ cwait $varName

+ } else {

+ return -code error {code must run in a coroutine}

+ # For testing with a non-coroutine caller outside the http package.

+ # vwait $varName

+ }

+ Log >U Thread End Wait $args -- coro [info coroutine] $varName [set $varName]

+ thread::release $state(tid)

+ set state(tid) {}

+ lassign [set $varName] catchCode errdict sock

+ unset $varName

+ dict set errdict -code $catchCode

+ return -options $errdict $sock

+}

+

+# The commands below are dependencies of http::socket and

+# are not used elsewhere.

+

+# ------------------------------------------------------------------------------

+# Proc http::LoadThreadIfNeeded

+# ------------------------------------------------------------------------------

+# Command to load the Thread package if it is needed. If it is needed and not

+# loadable, the outcome depends on $http(-threadlevel):

+# value 0 => Thread package not required, no problem

+# value 1 => operate as if -threadlevel 0

+# value 2 => error return

+#

+# Arguments: none

+# Return Value: none

+# ------------------------------------------------------------------------------

+

+proc http::LoadThreadIfNeeded {} {

+ variable http

+ if {$http(usingThread) || ($http(-threadlevel) == 0)} {

+ return

+ }

+ if {[catch {package require Thread}]} {

+ if {$http(-threadlevel) == 2} {

+ set msg {[http::config -threadlevel] has value 2,\

+ but the Thread package is not available}

+ return -code error $msg

+ }

+ return

+ }

+ set http(usingThread) 1

+ return

+}

+

+

+# ------------------------------------------------------------------------------

+# Proc http::SockInThread

+# ------------------------------------------------------------------------------

+# Command http::socket is a ::socket replacement. It defines and runs this

+# command, http::SockInThread, in a peer thread.

+#

+# Arguments:

+# caller

+# defcmd

+# sockargs

+#

+# Return value: list of values that describe the outcome. The return is

+# intended to be a normal (non-error) return in all cases.

+# ------------------------------------------------------------------------------

+

+proc http::SockInThread {caller defcmd sockargs} {

+ package require Thread

+

+ set catchCode [catch {eval $defcmd $sockargs} sock errdict]

+ if {$catchCode == 0} {

+ set catchCode [catch {thread::transfer $caller $sock; set sock} sock errdict]

+ }

+ return [list $catchCode $errdict $sock]

+}

+

+

+# ------------------------------------------------------------------------------

+# Proc ::http::cwaiter::cwait

+# ------------------------------------------------------------------------------

+# Command to substitute for vwait, without the ordering issues.

+# A command that uses cwait must be a coroutine that is launched by an event,

+# e.g. fileevent or after idle, and has no calling code to be resumed upon

+# "yield". It cannot return a value.

+#

+# Arguments:

+# varName - fully-qualified name of the variable that the calling script

+# will write to resume the coroutine. Any scalar variable or

+# array element is permitted.

+# coroName - (optional) name of the coroutine to be called when varName is

+# written - defaults to this coroutine

+# timeout - (optional) timeout value in ms

+# timeoutValue - (optional) value to assign to varName if there is a timeout

+#

+# Return Value: none

+# ------------------------------------------------------------------------------

+

+namespace eval ::http::cwaiter {

+ namespace export cwait

+ variable log {}

+ variable logOn 0

+}

+

+proc ::http::cwaiter::cwait {

+ varName {coroName {}} {timeout {}} {timeoutValue {}}

+} {

+ set thisCoro [info coroutine]

+ if {$thisCoro eq {}} {

+ return -code error {cwait cannot be called outside a coroutine}

+ }

+ if {$coroName eq {}} {

+ set coroName $thisCoro

+ }

+ if {[string range $varName 0 1] ne {::}} {

+ return -code error {argument varName must be fully qualified}

+ }

+ if {$timeout eq {}} {

+ set toe {}

+ } elseif {[string is integer -strict $timeout] && ($timeout > 0)} {

+ set toe [after $timeout [list set $varName $timeoutValue]]

+ } else {

+ return -code error {if timeout is supplied it must be a positive integer}

+ }

+

+ set cmd [list ::http::cwaiter::CwaitHelper $varName $coroName $toe]

+ trace add variable $varName write $cmd

+ CoLog "Yield $varName $coroName"

+ yield

+ CoLog "Resume $varName $coroName"

+ return

+}

+

+

+# ------------------------------------------------------------------------------

+# Proc ::http::cwaiter::CwaitHelper

+# ------------------------------------------------------------------------------

+# Helper command called by the trace set by cwait.

+# - Ignores the arguments added by trace.

+# - A simple call to $coroName works, and in error cases gives a suitable stack

+# trace, but because it is inside a trace the headline error message is

+# something like {can't set "::Result(6)": error}, not the actual

+# error. So let the trace command return.

+# - Remove the trace immediately. We don't want multiple calls.

+# ------------------------------------------------------------------------------

+

+proc ::http::cwaiter::CwaitHelper {varName coroName toe args} {

+ CoLog "got $varName for $coroName"

+ set cmd [list ::http::cwaiter::CwaitHelper $varName $coroName $toe]

+ trace remove variable $varName write $cmd

+ after cancel $toe

+

+ after 0 $coroName

+ return

+}

+

+

+# ------------------------------------------------------------------------------

+# Proc ::http::cwaiter::LogInit

+# ------------------------------------------------------------------------------

+# Call this command to initiate debug logging and clear the log.

+# ------------------------------------------------------------------------------

+

+proc ::http::cwaiter::LogInit {} {

+ variable log

+ variable logOn

+ set log {}

+ set logOn 1

+ return

+}

+

+proc ::http::cwaiter::LogRead {} {

+ variable log

+ return $log

+}

+

+proc ::http::cwaiter::CoLog {msg} {

+ variable log

+ variable logOn

+ if {$logOn} {

+ append log $msg \n

+ }

+ return

+}

+

+namespace eval ::http {

+ namespace import ::http::cwaiter::*

+package require http 2.10

+

+if {![info exists ThreadLevel]} {

+ if {[catch {package require Thread}] == 0} {

+ set ValueRange {0 1 2}

+ } else {

+ set ValueRange {0 1}

+ }

+

+ # For each value of ThreadLevel, source this file recursively in the

+ # same interpreter.

+ foreach ThreadLevel $ValueRange {

+ source [info script]

+ }

+ catch {unset ThreadLevel}

+ catch {unset ValueRange}

+ return

+}

+

+catch {puts "==== Test with ThreadLevel $ThreadLevel ===="}

+http::config -threadlevel $ThreadLevel

+} [list -accept */* -cookiejar {} -pipeline 1 -postfresh 0 -proxyfilter http::ProxyRequired -proxyhost {} -proxyport {} -repost 0 -threadlevel $ThreadLevel -urlencoding utf-8 -useragent UserAgent -zip 1]

+} [list -accept */* -cookiejar {} -pipeline 1 -postfresh 0 -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -repost 0 -threadlevel $ThreadLevel -urlencoding iso8859-1 -useragent {Tcl Test Suite} -zip 1]

+} -result {Unknown option -junk, must be: -accept, -cookiejar, -pipeline, -postfresh, -proxyfilter, -proxyhost, -proxyport, -repost, -threadlevel, -urlencoding, -useragent, -zip}

+

+

+

+

+

+

+

+

+

+ set result "[http::status $token] -- [lindex [http::error $token] 0]"

+} -match glob -result "error -- couldn't open socket*"

+

+package require http 2.10

+

+if {![info exists ThreadLevel]} {

+ if {[catch {package require Thread}] == 0} {

+ set ValueRange {0 1 2}

+ } else {

+ set ValueRange {0 1}

+ }

+

+ # For each value of ThreadLevel, source this file recursively in the

+ # same interpreter.

+ foreach ThreadLevel $ValueRange {

+ source [info script]

+ }

+ catch {unset ThreadLevel}

+ catch {unset ValueRange}

+ return

+}

+

+catch {puts "==== Test with ThreadLevel $ThreadLevel ===="}

+http::config -threadlevel $ThreadLevel

+package require http 2.10

+

+# ------------------------------------------------------------------------------

+# (0) Socket Creation in Thread, which triples the number of tests.

+# ------------------------------------------------------------------------------

+

+if {![info exists ThreadLevel]} {

+ if {[catch {package require Thread}] == 0} {

+ set ValueRange {0 1 2}

+ } else {

+ set ValueRange {0 1}

+ }

+

+ # For each value of ThreadLevel, source this file recursively in the

+ # same interpreter.

+ foreach ThreadLevel $ValueRange {

+ source [info script]

+ }

+ catch {unset ThreadLevel}

+ catch {unset ValueRange}

+ return

+}

+

+catch {puts "==== Test with ThreadLevel $ThreadLevel ===="}

+http::config -threadlevel $ThreadLevel