summaryrefslogtreecommitdiffstats
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
parent41fc5bbfdb6b8ddd54f155e0858ba45e2b3f3224 (diff)
downloadtcl-5771efaaf4889edc70633892c57587bc1df5445a.zip
tcl-5771efaaf4889edc70633892c57587bc1df5445a.tar.gz
tcl-5771efaaf4889edc70633892c57587bc1df5445a.tar.bz2
Backport http 2.5.5 changes from HEAD
-rw-r--r--ChangeLog6
-rw-r--r--doc/http.n9
-rw-r--r--library/http/http.tcl67
-rw-r--r--library/http/pkgIndex.tcl2
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}}}]