summaryrefslogtreecommitdiffstats
path: root/library/http/http.tcl
diff options
context:
space:
mode:
authorpatthoyts <patthoyts@users.sourceforge.net>2008-02-27 23:58:13 (GMT)
committerpatthoyts <patthoyts@users.sourceforge.net>2008-02-27 23:58:13 (GMT)
commit5771efaaf4889edc70633892c57587bc1df5445a (patch)
tree58a3dc1a0af13a72b6d3678130d338bb32eadd16 /library/http/http.tcl
parent41fc5bbfdb6b8ddd54f155e0858ba45e2b3f3224 (diff)
downloadtcl-5771efaaf4889edc70633892c57587bc1df5445a.zip
tcl-5771efaaf4889edc70633892c57587bc1df5445a.tar.gz
tcl-5771efaaf4889edc70633892c57587bc1df5445a.tar.bz2
Backport http 2.5.5 changes from HEAD
Diffstat (limited to 'library/http/http.tcl')
-rw-r--r--library/http/http.tcl67
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: