summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorhobbs <hobbs>2004-05-25 22:56:29 (GMT)
committerhobbs <hobbs>2004-05-25 22:56:29 (GMT)
commit6418e217136079ba56cb50fea7ad22f0cc6b6dc0 (patch)
treebc3d9da983ce579996152ad388f54314ccfbe909
parentdf162f81b863ae6ae81d4550033b9c0c5ee280f2 (diff)
downloadtcl-6418e217136079ba56cb50fea7ad22f0cc6b6dc0.zip
tcl-6418e217136079ba56cb50fea7ad22f0cc6b6dc0.tar.gz
tcl-6418e217136079ba56cb50fea7ad22f0cc6b6dc0.tar.bz2
* doc/http.n (http::config): add -urlencoding option (default utf-8)
* library/http/http.tcl: that specifies encoding conversion of * library/http/pkgIndex.tcl: args for http::formatQuery. Previously * tests/http.test: undefined, RFC 2718 says it should be utf-8. 'http::config -urlencoding {}' returns previous behavior, which will throw errors processing non-latin-1 chars. Bumped http package to 2.5.0.
-rw-r--r--ChangeLog10
-rw-r--r--doc/http.n16
-rw-r--r--library/http/http.tcl37
-rw-r--r--library/http/pkgIndex.tcl2
-rw-r--r--tests/http.test62
5 files changed, 96 insertions, 31 deletions
diff --git a/ChangeLog b/ChangeLog
index 93bfc3d..90a66cc 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,13 @@
+2004-05-25 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * doc/http.n (http::config): add -urlencoding option (default utf-8)
+ * library/http/http.tcl: that specifies encoding conversion of
+ * library/http/pkgIndex.tcl: args for http::formatQuery. Previously
+ * tests/http.test: undefined, RFC 2718 says it should be
+ utf-8. 'http::config -urlencoding {}' returns previous behavior,
+ which will throw errors processing non-latin-1 chars.
+ Bumped http package to 2.5.0.
+
2004-05-25 Donal K. Fellows <donal.k.fellows@man.ac.uk>
* generic/tclInterp.c (DeleteScriptLimitCallback): Move all
diff --git a/doc/http.n b/doc/http.n
index a9a08c9..af81280 100644
--- a/doc/http.n
+++ b/doc/http.n
@@ -1,20 +1,21 @@
'\"
'\" Copyright (c) 1995-1997 Sun Microsystems, Inc.
'\" Copyright (c) 1998-2000 by Ajuba Solutions.
+'\" Copyright (c) 2004 ActiveState Corporation.
'\"
'\" 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.19 2003/07/16 04:04:40 dgp Exp $
+'\" RCS: @(#) $Id: http.n,v 1.20 2004/05/25 22:56:29 hobbs Exp $
'\"
.so man.macros
-.TH "http" n 2.4 http "Tcl Bundled Packages"
+.TH "http" n 2.5 http "Tcl Bundled Packages"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
http \- Client-side implementation of the HTTP/1.0 protocol.
.SH SYNOPSIS
-\fBpackage require http ?2.4?\fR
+\fBpackage require http ?2.5?\fR
.sp
\fB::http::config \fI?options?\fR
.sp
@@ -108,6 +109,15 @@ an empty list. The default filter returns the values of the
\fB\-proxyhost\fR and \fB\-proxyport\fR settings if they are
non-empty.
.TP
+\fB\-urlencoding\fP \fIencoding\fP
+The \fIencoding\fR used for creating the x-url-encoded URLs with
+\fB::http::formatQuery\fR. The default is \fButf-8\fR, as specified by RFC
+2718. Prior to http 2.5 this was unspecified, and that behavior can be
+returned by specifying the empty string (\fB{}\fR), although
+\fIiso8859-1\fR is recommended to restore similar behavior but without the
+\fB::http::formatQuery\fR throwing an error processing non-latin-1
+characters.
+.TP
\fB\-useragent\fP \fIstring\fP
The value of the User-Agent header in the HTTP request. The default
is \fB"Tcl http client package 2.4."\fR
diff --git a/library/http/http.tcl b/library/http/http.tcl
index 2744eb6..29662a4 100644
--- a/library/http/http.tcl
+++ b/library/http/http.tcl
@@ -9,7 +9,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.47 2003/09/29 10:01:33 dkf Exp $
+# RCS: @(#) $Id: http.tcl,v 1.48 2004/05/25 22:56:33 hobbs Exp $
# Rough version history:
# 1.0 Old http_get interface
@@ -25,7 +25,7 @@
package require Tcl 8.2
# keep this in sync with pkgIndex.tcl
# and with the install directories in Makefiles
-package provide http 2.4.4
+package provide http 2.5.0
namespace eval http {
variable http
@@ -34,6 +34,7 @@ namespace eval http {
-proxyhost {}
-proxyport {}
-proxyfilter http::ProxyRequired
+ -urlencoding utf-8
}
set http(-useragent) "Tcl http client package [package provide http]"
@@ -66,7 +67,7 @@ namespace eval http {
# http::register --
#
-# See documentation for details.
+# See documentaion for details.
#
# Arguments:
# proto URL protocol prefix, e.g. https
@@ -101,7 +102,7 @@ proc http::unregister {proto} {
# http::config --
#
-# See documentation for details.
+# See documentaion for details.
#
# Arguments:
# args Options parsed by the procedure.
@@ -180,7 +181,7 @@ proc http::Finish { token {errormsg ""} {skipCB 0}} {
# http::reset --
#
-# See documentation for details.
+# See documentaion for details.
#
# Arguments:
# token Connection token.
@@ -238,7 +239,7 @@ proc http::geturl { url args } {
-binary false
-blocksize 8192
-queryblocksize 8192
- -validate false
+ -validate 0
-headers {}
-timeout 0
-type application/x-www-form-urlencoded
@@ -262,7 +263,7 @@ proc http::geturl { url args } {
-queryblocksize integer
-validate boolean
-timeout integer
- }
+ }
set state(charset) $defaultCharset
set options {-binary -blocksize -channel -command -handler -headers \
-progress -query -queryblocksize -querychannel -queryprogress\
@@ -272,7 +273,7 @@ proc http::geturl { url args } {
set pat ^-([join $options |])$
foreach {flag value} $args {
if {[regexp $pat $flag]} {
- # Validate numbers and booleans
+ # Validate numbers
if {[info exists type($flag)] && \
![string is $type($flag) -strict $value]} {
unset $token
@@ -460,7 +461,7 @@ proc http::geturl { url args } {
# (among Solaris, Linux, and NT) behave the same, and none
# behave all that well in any case. Servers should always read thier
# POST data if they expect the client to read their response.
-
+
if {$isQuery || $isQueryChannel} {
puts $s "Content-Type: $state(-type)"
if {!$contDone} {
@@ -485,7 +486,7 @@ proc http::geturl { url args } {
# Something went wrong, so throw the exception, and the
# enclosing catch will do cleanup.
return -code error [lindex $state(error) 0]
- }
+ }
}
} err]} {
# The socket probably was never connected,
@@ -494,7 +495,7 @@ proc http::geturl { url args } {
# 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.
-
+
# if state(status) is error, it means someone's already called Finish
# to do the above-described clean up.
if {[string equal $state(status) "error"]} {
@@ -609,16 +610,13 @@ proc http::Write {token} {
variable $token
upvar 0 $token state
set s $state(sock)
-
+
# Output a block. Tcl will buffer this if the socket blocks
-
set done 0
if {[catch {
-
# Catch I/O errors on dead sockets
if {[info exists state(-query)]} {
-
# Chop up large query strings so queryprogress callback
# can give smooth feedback
@@ -631,7 +629,6 @@ proc http::Write {token} {
set done 1
}
} else {
-
# Copy blocks from the query channel
set outStr [read $state(-querychannel) $state(-queryblocksize)]
@@ -831,7 +828,7 @@ proc http::Eof {token} {
# http::wait --
#
-# See documentation for details.
+# See documentaion for details.
#
# Arguments:
# token Connection token.
@@ -853,7 +850,7 @@ proc http::wait {token} {
# http::formatQuery --
#
-# See documentation for details.
+# See documentaion 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.
@@ -889,6 +886,7 @@ proc http::formatQuery {args} {
# The encoded string
proc http::mapReply {string} {
+ variable http
variable formMap
variable alphanumeric
@@ -898,6 +896,9 @@ proc http::mapReply {string} {
# 3 Escape constructs that are "special" to the tcl parser
# 4 "subst" the result, doing all the array substitutions
+ if {$http(-urlencoding) ne ""} {
+ set string [encoding convertto $http(-urlencoding) $string]
+ }
regsub -all \[^$alphanumeric\] $string {$formMap(&)} string
regsub -all {[][{})\\]\)} $string {\\&} string
return [subst -nocommand $string]
diff --git a/library/http/pkgIndex.tcl b/library/http/pkgIndex.tcl
index 82c68f5..8efa64c 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.2]} {return}
-package ifneeded http 2.4.4 [list tclPkgSetup $dir http 2.4.4 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister}}}]
+package ifneeded http 2.5.0 [list tclPkgSetup $dir http 2.5.0 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister}}}]
diff --git a/tests/http.test b/tests/http.test
index 1ed63f8..86811f4 100644
--- a/tests/http.test
+++ b/tests/http.test
@@ -12,7 +12,7 @@
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
#
-# RCS: @(#) $Id: http.test,v 1.37 2004/05/25 18:06:25 dgp Exp $
+# RCS: @(#) $Id: http.test,v 1.38 2004/05/25 22:56:33 hobbs Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -47,7 +47,6 @@ catch {unset data}
# Ensure httpd file exists
-set origFile [file join $::tcltest::testsDirectory httpd]
set origFile [file join [pwd] [file dirname [info script]] httpd]
set httpdFile [file join [temporaryDirectory] httpd_[pid]]
if {![file exists $httpdFile]} {
@@ -86,7 +85,7 @@ if {[info commands testthread] == "testthread" && [file exists $httpdFile]} {
test http-1.1 {http::config} {
http::config
-} [list -accept */* -proxyfilter http::ProxyRequired -proxyhost {} -proxyport {} -useragent "Tcl http client package $version"]
+} [list -accept */* -proxyfilter http::ProxyRequired -proxyhost {} -proxyport {} -urlencoding utf-8 -useragent "Tcl http client package $version"]
test http-1.2 {http::config} {
http::config -proxyfilter
@@ -98,15 +97,25 @@ test http-1.3 {http::config} {
test http-1.4 {http::config} {
set savedconf [http::config]
- http::config -proxyhost nowhere.come -proxyport 8080 -proxyfilter myFilter -useragent "Tcl Test Suite"
+ http::config -proxyhost nowhere.come -proxyport 8080 \
+ -proxyfilter myFilter -useragent "Tcl Test Suite" \
+ -urlencoding iso8859-1
set x [http::config]
http::config {expand}$savedconf
set x
-} {-accept */* -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -useragent {Tcl Test Suite}}
+} {-accept */* -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -urlencoding iso8859-1 -useragent {Tcl Test Suite}}
test http-1.5 {http::config} {
list [catch {http::config -proxyhost {} -junk 8080} msg] $msg
-} {1 {Unknown option -junk, must be: -accept, -proxyfilter, -proxyhost, -proxyport, -useragent}}
+} {1 {Unknown option -junk, must be: -accept, -proxyfilter, -proxyhost, -proxyport, -urlencoding, -useragent}}
+
+test http-1.6 {http::config} {
+ set enc [list [http::config -urlencoding]]
+ http::config -urlencoding iso8859-1
+ lappend enc [http::config -urlencoding]
+ http::config -urlencoding [lindex $enc 0]
+ set enc
+} {utf-8 iso8859-1}
test http-2.1 {http::reset} {
@@ -466,14 +475,24 @@ test http-5.1 {http::formatQuery} {
http::formatQuery name1 value1 name2 "value two"
} {name1=value1&name2=value+two}
-test http-5.2 {http::formatQuery} {
- http::formatQuery name1 ~bwelch name2 \xa1\xa2\xa2
-} {name1=%7ebwelch&name2=%a1%a2%a2}
+# test http-5.2 obsoleted by 5.4 and 5.5 with http 2.5
test http-5.3 {http::formatQuery} {
http::formatQuery lines "line1\nline2\nline3"
} {lines=line1%0d%0aline2%0d%0aline3}
+test http-5.4 {http::formatQuery} {
+ http::formatQuery name1 ~bwelch name2 \xa1\xa2\xa2
+} {name1=%7ebwelch&name2=%c2%a1%c2%a2%c2%a2}
+
+test http-5.5 {http::formatQuery} {
+ set enc [http::config -urlencoding]
+ http::config -urlencoding iso8859-1
+ set res [http::formatQuery name1 ~bwelch name2 \xa1\xa2\xa2]
+ http::config -urlencoding $enc
+ set res
+} {name1=%7ebwelch&name2=%a1%a2%a2}
+
test http-6.1 {http::ProxyRequired} {
http::config -proxyhost [info hostname] -proxyport $port
set token [http::geturl $url]
@@ -490,6 +509,31 @@ test http-7.1 {http::mapReply} {
http::mapReply "abc\$\[\]\"\\()\}\{"
} {abc%24%5b%5d%22%5c%28%29%7d%7b}
+test http-7.2 {http::mapReply} {
+ # RFC 2718 specifies that we pass urlencoding on utf-8 chars by default,
+ # so make sure this gets converted to utf-8 then urlencoded.
+ http::mapReply "\u2208"
+} {%e2%88%88}
+
+test http-7.3 {http::formatQuery} {
+ set enc [http::config -urlencoding]
+ # this would be reverting to http <=2.4 behavior
+ http::config -urlencoding ""
+ set res [list [catch {http::mapReply "\u2208"} msg] $msg]
+ http::config -urlencoding $enc
+ set res
+} [list 1 "can't read \"formMap(\u2208)\": no such element in array"]
+
+test http-7.4 {http::formatQuery} {
+ set enc [http::config -urlencoding]
+ # this would be reverting to http <=2.4 behavior w/o errors
+ # (unknown chars become '?')
+ http::config -urlencoding "iso8859-1"
+ set res [http::mapReply "\u2208"]
+ http::config -urlencoding $enc
+ set res
+} {%3f}
+
# cleanup
catch {unset url}
catch {unset badurl}