diff options
Diffstat (limited to 'library/http2.1')
| -rw-r--r-- | library/http2.1/http.tcl | 76 |
1 files changed, 67 insertions, 9 deletions
diff --git a/library/http2.1/http.tcl b/library/http2.1/http.tcl index 6ad16df..dc3c890 100644 --- a/library/http2.1/http.tcl +++ b/library/http2.1/http.tcl @@ -9,9 +9,9 @@ # See the file "license.terms" for information on usage and # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: http.tcl,v 1.5 1999/02/02 22:28:30 stanton Exp $ +# RCS: @(#) $Id: http.tcl,v 1.6 1999/06/30 17:43:51 welch Exp $ -package provide http 2.0 ;# This uses Tcl namespaces +package provide http 2.1 ;# This uses Tcl namespaces namespace eval http { variable http @@ -134,15 +134,20 @@ proc http::reset { token {why reset} } { # Establishes a connection to a remote url via http. # # Arguments: -# url The http URL to goget. -# args Option value pairs. Valid options include: +# url The http URL to goget. +# args Option value pairs. Valid options include: # -blocksize, -validate, -headers, -timeout # Results: -# Returns a token for this connection. - +# 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 + + # 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 } @@ -150,6 +155,9 @@ proc http::geturl { url args } { variable $token upvar 0 $token state reset $token + + # Process command options. + array set state { -blocksize 8192 -validate 0 @@ -170,7 +178,9 @@ proc http::geturl { url args } { set pat ^-([join $options |])$ foreach {flag value} $args { if {[regexp $pat $flag]} { + # Validate numbers + if {[info exists state($flag)] && \ [regexp {^[0-9]+$} $state($flag)] && \ ![regexp {^[0-9]+$} $value]} { @@ -199,17 +209,39 @@ proc http::geturl { url args } { set phost [lindex $proxy 0] set pport [lindex $proxy 1] } + + # If a timeout is specified we set up the after event + # and arrange for an asynchronous socket connection. + if {$state(-timeout) > 0} { - set state(after) [after $state(-timeout) [list http::reset $token timeout]] + set state(after) [after $state(-timeout) \ + [list http::reset $token timeout]] + set async -async + } else { + set async "" } + + # If we are using the proxy, we must pass in the full URL that + # includes the server name. + if {[info exists phost] && [string length $phost]} { set srvurl $url - set s [socket $phost $pport] + set s [eval socket $async {$phost $pport}] } else { - set s [socket $host $port] + set s [eval socket $async {$host $port}] } set state(sock) $s + # Wait for the connection to complete + + if {$state(-timeout) > 0} { + #fileevent $s writable [list set $token\(status) connect] + fileevent $s writable [list http::Connect $token] + http::wait $token + fileevent $s writable {} + unset state(status) + } + # Send data in cr-lf format, but accept any line terminators fconfigure $s -translation {auto crlf} -buffersize $state(-blocksize) @@ -283,6 +315,29 @@ proc http::size {token} { return $state(currentsize) } +# 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 exist state]} { + unset state + } +} + proc http::Connect {token} { + variable $token + upvar 0 $token state + set state(status) connect + } + proc http::Event {token} { variable $token upvar 0 $token state @@ -399,6 +454,9 @@ proc http::wait {token} { upvar 0 $token state if {![info exists state(status)] || [string length $state(status)] == 0} { + + # We must wait on the original variable name, not the upvar alias + vwait $token\(status) } if {[info exists state(error)]} { |