diff options
| -rw-r--r-- | ChangeLog | 10 | ||||
| -rw-r--r-- | doc/http.n | 16 | ||||
| -rw-r--r-- | library/http/http.tcl | 23 | ||||
| -rw-r--r-- | library/http/pkgIndex.tcl | 2 | ||||
| -rw-r--r-- | tests/http.test | 64 |
5 files changed, 91 insertions, 24 deletions
@@ -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 Kevin Kenny <kennykb@acm.org> * tests/winFCmd.test: Correct test for the presence of a CD-ROM so @@ -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.18.2.1 2003/07/16 04:15:07 dgp Exp $ +'\" RCS: @(#) $Id: http.n,v 1.18.2.2 2004/05/25 22:50:46 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 d0cf058..ae2b1d4 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.43.2.3 2003/10/02 23:07:33 dgp Exp $ +# RCS: @(#) $Id: http.tcl,v 1.43.2.4 2004/05/25 22:50:47 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.5 +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]" @@ -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\ @@ -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)] @@ -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 e114a44..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.5 [list tclPkgSetup $dir http 2.4.5 {{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 1051162..942c9a5 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.33.2.1 2003/07/18 19:41:17 hobbs Exp $ +# RCS: @(#) $Id: http.test,v 1.33.2.2 2004/05/25 22:50:47 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -47,7 +47,7 @@ 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]} { makeFile "" $httpdFile @@ -85,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 @@ -97,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] eval http::config $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} { @@ -465,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.4 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] @@ -489,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} @@ -506,4 +551,5 @@ if {[info exists removeHttpd]} { removeFile $httpdFile } +rename bgerror {} ::tcltest::cleanupTests |