From 60ee451054fa072c36796fce1c41b63781fee85d Mon Sep 17 00:00:00 2001
From: patthoyts <patthoyts@users.sourceforge.net>
Date: Wed, 27 Feb 2008 23:49:23 +0000
Subject: bug #705956 - fix inverted logic when cleaning up socket error in
 geturl. Document meta accessor.

---
 ChangeLog             |  5 +++++
 doc/http.n            |  9 ++++++++-
 library/http/http.tcl | 44 ++++++++++++++++++++++++++++----------------
 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:
-- 
cgit v0.12