diff options
| -rw-r--r-- | ChangeLog | 10 | ||||
| -rw-r--r-- | doc/http.n | 16 | ||||
| -rw-r--r-- | library/http/http.tcl | 37 | ||||
| -rw-r--r-- | library/http/pkgIndex.tcl | 2 | ||||
| -rw-r--r-- | tests/http.test | 62 |
5 files changed, 96 insertions, 31 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 Donal K. Fellows <donal.k.fellows@man.ac.uk> * generic/tclInterp.c (DeleteScriptLimitCallback): Move all @@ -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} |