diff options
Diffstat (limited to 'library/http/http.tcl')
| -rw-r--r-- | library/http/http.tcl | 67 |
1 files changed, 42 insertions, 25 deletions
diff --git a/library/http/http.tcl b/library/http/http.tcl index cc91421..1a10b75 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -8,7 +8,7 @@ # 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.43.2.14 2008/02/22 11:36:56 patthoyts Exp $ +# RCS: @(#) $Id: http.tcl,v 1.43.2.15 2008/02/27 23:58:18 patthoyts Exp $ # Rough version history: # 1.0 Old http_get interface. @@ -24,7 +24,7 @@ package require Tcl 8.4 # Keep this in sync with pkgIndex.tcl and with the install directories # in Makefiles -package provide http 2.5.4 +package provide http 2.5.5 namespace eval http { variable http @@ -73,7 +73,7 @@ namespace eval http { # http::register -- # -# See documentaion for details. +# See documentation for details. # # Arguments: # proto URL protocol prefix, e.g. https @@ -108,7 +108,7 @@ proc http::unregister {proto} { # http::config -- # -# See documentaion for details. +# See documentation for details. # # Arguments: # args Options parsed by the procedure. @@ -187,7 +187,7 @@ proc http::Finish { token {errormsg ""} {skipCB 0}} { # http::reset -- # -# See documentaion for details. +# See documentation for details. # # Arguments: # token Connection token. @@ -482,19 +482,26 @@ proc http::geturl { url args } { fileevent $s writable [list http::Connect $token] http::wait $token - if {$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 - } elseif {$state(status) ne "connect"} { - # Likely to be connection timeout + 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 + } else { + if {$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 + } elseif {$state(status) ne "connect"} { + # Likely to be connection timeout + return $token + } + set state(status) "" } - set state(status) "" } # Send data in cr-lf format, but accept any line terminators @@ -610,7 +617,7 @@ proc http::geturl { url args } { # if state(status) is error, it means someone's already called Finish # to do the above-described clean up. - if {$state(status) eq "error"} { + if {$state(status) ne "error"} { Finish $token $err 1 } cleanup $token @@ -656,7 +663,11 @@ proc http::size {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 @@ -787,13 +798,9 @@ proc http::Event {token} { upvar 0 $token state set s $state(sock) - if {[eof $s]} { - Eof $token - return - } if {$state(state) eq "header"} { if {[catch {gets $s line} n]} { - Finish $token $n + return [Finish $token $n] } elseif {$n == 0} { variable encodings set state(state) body @@ -821,6 +828,7 @@ proc http::Event {token} { # Initiate a sequence of background fcopies fileevent $s readable {} CopyStart $s $token + return } } elseif {$n > 0} { if {[regexp -nocase {^content-type:(.+)$} $line x type]} { @@ -855,7 +863,7 @@ proc http::Event {token} { incr state(currentsize) $n } } err]} { - Finish $token $err + return [Finish $token $err] } else { if {[info exists state(-progress)]} { eval $state(-progress) \ @@ -863,6 +871,11 @@ proc http::Event {token} { } } } + + if {[eof $s]} { + Eof $token + return + } } # http::CopyStart @@ -963,7 +976,7 @@ proc http::wait {token} { # http::formatQuery -- # -# See documentaion for details. Call http::formatQuery with an even +# 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. # @@ -1038,3 +1051,7 @@ proc http::ProxyRequired {host} { return [list $http(-proxyhost) $http(-proxyport)] } } + +# Local variables: +# indent-tabs-mode: t +# End: |