summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorpatthoyts <patthoyts@users.sourceforge.net>2008-02-27 23:49:23 (GMT)
committerpatthoyts <patthoyts@users.sourceforge.net>2008-02-27 23:49:23 (GMT)
commit60ee451054fa072c36796fce1c41b63781fee85d (patch)
tree255f918867dfa8650731eb81bd3b682afbca43d0
parent875ce2be361a6cbefe1f035aa859cf663d1d501a (diff)
downloadtcl-60ee451054fa072c36796fce1c41b63781fee85d.zip
tcl-60ee451054fa072c36796fce1c41b63781fee85d.tar.gz
tcl-60ee451054fa072c36796fce1c41b63781fee85d.tar.bz2
bug #705956 - fix inverted logic when cleaning up socket error in geturl. Document meta accessor.
-rw-r--r--ChangeLog5
-rw-r--r--doc/http.n9
-rw-r--r--library/http/http.tcl44
3 files changed, 41 insertions, 17 deletions
diff --git a/ChangeLog b/ChangeLog
index 8bcaa5f..83efdba 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2008-02-27 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * library/http/http.tcl: bug #705956 - fix inverted logic when
+ cleaning up socket error in geturl.
+
2008-02-22 Joe English <jenglish@users.sourceforge.net>
* generic/tclIOUtil.c, unix/tclUnixPort.h, unix/tclUnixChan.c:
diff --git a/doc/http.n b/doc/http.n
index 3f04bd5..56c4d94 100644
--- a/doc/http.n
+++ b/doc/http.n
@@ -6,7 +6,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.n,v 1.31 2007/12/13 15:22:32 dgp Exp $
+'\" RCS: @(#) $Id: http.n,v 1.32 2008/02/27 23:49:23 patthoyts Exp $
'\"
.so man.macros
.TH "http" n 2.5 http "Tcl Bundled Packages"
@@ -36,6 +36,8 @@ http \- Client-side implementation of the HTTP/1.0 protocol
.sp
\fB::http::ncode \fItoken\fR
.sp
+\fB::http::meta \fItoken\fR
+.sp
\fB::http::data \fItoken\fR
.sp
\fB::http::error \fItoken\fR
@@ -315,6 +317,11 @@ This is a convenience procedure that returns the \fBcurrentsize\fR
element of the state array, which represents the number of bytes
received from the URL in the \fB::http::geturl\fR call.
.TP
+\fB::http::meta\fR \fItoken\fR
+This is a convenience procedure that returns the \fBmeta\fR
+element of the state array which contains the HTTP response
+headers. See below for an explanation of this element.
+.TP
\fB::http::cleanup\fR \fItoken\fR
This procedure cleans up the state associated with the connection
identified by \fItoken\fR. After this call, the procedures
diff --git a/library/http/http.tcl b/library/http/http.tcl
index b8764b4..ef7950c 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.62 2008/02/26 19:52:54 patthoyts Exp $
+# RCS: @(#) $Id: http.tcl,v 1.63 2008/02/27 23:49:23 patthoyts Exp $
# Rough version history:
# 1.0 Old http_get interface.
@@ -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
@@ -633,6 +640,7 @@ proc http::data {token} {
}
proc http::status {token} {
if {![info exists $token]} { return "error" }
+ variable $token
upvar 0 $token state
return $state(status)
}
@@ -820,7 +828,7 @@ proc http::Event {token} {
# Initiate a sequence of background fcopies
fileevent $s readable {}
CopyStart $s $token
- return
+ return
}
} elseif {$n > 0} {
if {[regexp -nocase {^content-type:(.+)$} $line x type]} {
@@ -865,8 +873,8 @@ proc http::Event {token} {
}
if {[eof $s]} {
- Eof $token
- return
+ Eof $token
+ return
}
}
@@ -1043,3 +1051,7 @@ proc http::ProxyRequired {host} {
return [list $http(-proxyhost) $http(-proxyport)]
}
}
+
+# Local variables:
+# indent-tabs-mode: t
+# End: