Backport http 2.5.5 changes from HEAD

4 files changed, 57 insertions, 27 deletions

diff --git a/ChangeLog b/ChangeLog
index 9f8cd17..25626fd 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2008-02-27  Pat Thoyts  <patthoyts@users.sourceforge.net>
+
+	* library/http/pkgIndex.tcl: Backported 2.5.5 changes from
+	* library/http/http.tcl:     8.5 version.
+	* doc/http.n:                Document the meta accessor.
+
 2008-02-26  Jeff Hobbs  <jeffh@ActiveState.com>
 
 	* generic/tclIOCmd.c (Tcl_GetsObjCmd): do not reuse resultObj as
diff --git a/doc/http.n b/doc/http.n
index 95efcd6..d4d9f97 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.18.2.3 2004/10/27 12:52:40 dkf Exp $
+'\" RCS: @(#) $Id: http.n,v 1.18.2.4 2008/02/27 23:58:17 patthoyts Exp $
 '\" 
 .so man.macros
 .TH "http" n 2.5 http "Tcl Bundled Packages"
@@ -35,6 +35,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
@@ -310,6 +312,11 @@ This is a convenience procedure that returns the \fBcurrentsize\fP
 element of the state array, which represents the number of bytes
 received from the URL in the \fB::http::geturl\fP call.
 .TP
+\fB::http::meta\fP \fItoken\fP
+This is a convenience procedure that returns the \fBmeta\fP
+element of the state array which contains the HTTP response
+headers. See below for an explanation of this element.
+.TP
 \fB::http::cleanup\fP \fItoken\fP
 This procedure cleans up the state associated with the connection
 identified by \fItoken\fP.  After this call, the procedures
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:
diff --git a/library/http/pkgIndex.tcl b/library/http/pkgIndex.tcl
index eaf0c86..cf6a1ff 100644
--- a/library/http/pkgIndex.tcl
+++ b/library/http/pkgIndex.tcl
@@ -9,4 +9,4 @@
 # full path name of this file's directory.
 
 if {![package vsatisfies [package provide Tcl] 8.4]} {return}
-package ifneeded http 2.5.4 [list tclPkgSetup $dir http 2.5.4 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
+package ifneeded http 2.5.5 [list tclPkgSetup $dir http 2.5.5 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]