* 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.

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}