Tcl Source Code

Artifact 3c126a75483df7d68a5f97354ff7e034d770927a:

--- http-1.41.tcl	Thu Jun 27 10:53:16 2002
+++ http-new.tcl	Thu Jun 27 10:58:58 2002
@@ -242,6 +242,7 @@
 	-timeout 	0
 	-type           application/x-www-form-urlencoded
 	-queryprogress	{}
+	-myaddr		""
 	state		header
 	meta		{}
 	coding		{}
@@ -257,7 +258,7 @@
     set state(charset)	$defaultCharset
     set options {-binary -blocksize -channel -command -handler -headers \
 	    -progress -query -queryblocksize -querychannel -queryprogress\
-	    -validate -timeout -type}
+	    -validate -timeout -type -myaddr}
     set usage [join $options ", "]
     regsub -all -- - $options {} options
     set pat ^-([join $options |])$
@@ -325,9 +326,12 @@
     if {$state(-timeout) > 0} {
 	set state(after) [after $state(-timeout) \
 		[list http::reset $token timeout]]
-	set async -async
+    }
+
+    if {[string length $state(-myaddr)] > 0} {
+	set myaddr "-myaddr $state(-myaddr)"
     } else {
-	set async ""
+	set myaddr ""
     }
 
     # If we are using the proxy, we must pass in the full URL that
@@ -335,9 +339,9 @@
 
     if {[info exists phost] && [string length $phost]} {
 	set srvurl $url
-	set conStat [catch {eval $defcmd $async {$phost $pport}} s]
+	set conStat [catch {eval $defcmd -async $myaddr {$phost $pport}} s]
     } else {
-	set conStat [catch {eval $defcmd $async {$host $port}} s]
+	set conStat [catch {eval $defcmd -async $myaddr {$host $port}} s]
     }
     if {$conStat} {
 
@@ -351,27 +355,54 @@
     }
     set state(sock) $s
 
-    # Wait for the connection to complete
+    set state(srvurl) $srvurl
+    set state(host) $host
+    set state(port) $port
+    fileevent $s writable [list http::Connect $token]
 
-    if {$state(-timeout) > 0} {
-	fileevent $s writable [list http::Connect $token]
-	http::wait $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 {[string equal $state(status) "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.
+	    # Something went wrong, so throw the exception
 	    set err [lindex $state(error) 0]
+	    Finish $token $err 1
 	    cleanup $token
 	    return -code error $err
-	} elseif {![string equal $state(status) "connect"]} {
-	    # Likely to be connection timeout
-	    return $token
-	}
-	set state(status) ""
+	}		
     }
 
+    return $token
+}
+
+# http::WriteRequest
+#
+#	http::Connect calls this after a successful socket connect.
+#	This proc writes the HTTP request to the socket.
+#
+# Arguments
+#	token	The token from http::geturl
+#
+# Side Effects
+# 	Write the HTTP request to the socket.
+
+proc http::WriteRequest {token} {
+    variable http
+
+    variable $token
+    upvar 0 $token state
+
+    set s $state(sock)
+    set srvurl $state(srvurl)
+    set host $state(host)
+    set port $state(port)
+    unset state(srvurl) state(host) state(port)
+    set isQueryChannel [info exists state(-querychannel)]
+    set isQuery [info exists state(-query)]
+
     # Send data in cr-lf format, but accept any line terminators
 
     fconfigure $s -translation {auto crlf} -buffersize $state(-blocksize)
@@ -465,36 +496,10 @@
 	    fileevent $s readable [list http::Event $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 {[string equal $state(status) "error"]} {
-		# Something went wrong, so throw the exception, and the
-		# enclosing catch will do cleanup.
-		return -code error [lindex $state(error) 0]
-	    }		
-	}
     } err]} {
-	# 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 {[string equal $state(status) "error"]} {
-	    Finish $token $err 1
-	}
-	cleanup $token
-	return -code error $err
+	Finish $token $err
     }
-
-    return $token
+    return
 }
 
 # Data access functions:
@@ -568,8 +573,7 @@
 #	token	The token returned from http::geturl
 #
 # Side Effects
-#	Sets the status of the connection, which unblocks
-# 	the waiting geturl call
+# 	Calls WriteRequest to write the HTTP request to the socket.
 
 proc http::Connect {token} {
     variable $token
@@ -577,10 +581,10 @@
     global errorInfo errorCode
     if {[eof $state(sock)] ||
 	[string length [fconfigure $state(sock) -error]]} {
-	    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 {}
+	WriteRequest $token
     }
     return
 }