Attachment "http.patch" to
ticket [2911139fff]
added by
kakaroto
2010-01-12 06:12:23.
--- http.tcl?revision=1.67.2.9&pathrev=core-8-5-branch 2010-01-11 18:08:32.000000000 -0500
+++ http.tcl?revision=11889 2010-01-11 18:08:49.000000000 -0500
@@ -532,11 +532,10 @@
# If a timeout is specified we set up the after event and arrange for an
# asynchronous socket connection.
- set sockopts [list]
+ set sockopts [list -async]
if {$state(-timeout) > 0} {
set state(after) [after $state(-timeout) \
[list http::reset $token timeout]]
- lappend sockopts -async
}
# If we are using the proxy, we must pass in the full URL that includes
@@ -592,10 +591,15 @@
set socketmap($state(socketinfo)) $sock
}
- # Wait for the connection to complete.
+ if {![info exists phost]} {
+ set phost ""
+ }
+ fileevent $sock writable [list http::Connect $token $proto $phost $srvurl]
- if {$state(-timeout) > 0} {
- fileevent $sock writable [list http::Connect $token]
+ # 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]} {
@@ -611,15 +615,31 @@
set err [lindex $state(error) 0]
cleanup $token
return -code error $err
- } elseif {$state(status) ne "connect"} {
- # Likely to be connection timeout
- return $token
}
- set state(status) ""
}
- # Send data in cr-lf format, but accept any line terminators
+ return $token
+}
+
+
+proc http::Connected { token proto phost srvurl} {
+ variable http
+ variable urlTypes
+
+ variable $token
+ upvar 0 $token state
+
+ # Set back the variables needed here
+ set sock $state(sock)
+ set isQueryChannel [info exists state(-querychannel)]
+ set isQuery [info exists state(-query)]
+ set host [lindex [split $state(socketinfo) :] 0]
+ set port [lindex [split $state(socketinfo) :] 1]
+
+ set defport [lindex $urlTypes($proto) 0]
+
+ # Send data in cr-lf format, but accept any line terminators
fconfigure $sock -translation {auto crlf} -buffersize $state(-blocksize)
# The following is disallowed in safe interpreters, but the socket is
@@ -744,35 +764,17 @@
fileevent $sock readable [list http::Event $sock $token]
}
- if {![info exists state(-command)]} {
- # geturl does EVERYTHING asynchronously, so if the user calls it
- # synchronously, we just do a wait here.
-
- wait $token
- if {$state(status) eq "error"} {
- # Something went wrong, so throw the exception, and the
- # enclosing catch will do cleanup.
- return -code error [lindex $state(error) 0]
- }
- }
} err]} then {
# The socket probably was never connected, or the connection dropped
# later.
- # 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.
-
# if state(status) is error, it means someone's already called Finish
# to do the above-described clean up.
if {$state(status) ne "error"} {
- Finish $token $err 1
+ Finish $token $err
}
- cleanup $token
- return -code error $err
}
- return $token
}
# Data access functions:
@@ -856,7 +858,7 @@
# Sets the status of the connection, which unblocks
# the waiting geturl call
-proc http::Connect {token} {
+proc http::Connect {token proto phost srvurl} {
variable $token
upvar 0 $token state
global errorInfo errorCode
@@ -864,10 +866,10 @@
[eof $state(sock)] ||
[string length [fconfigure $state(sock) -error]]
} then {
- Finish $token "connect failed [fconfigure $state(sock) -error]" 1
+ Finish $token "connect failed [fconfigure $state(sock) -error]"
} else {
- set state(status) connect
fileevent $state(sock) writable {}
+ ::http::Connected $token $proto $phost $srvurl
}
return
}
