Tcl Source Code

Artifact [497a562095]
Login

Artifact 497a562095323f9f51f5150a5a37a8bb69b460b1:

Attachment "http-urlencoding.patch" to ticket [960462ffff] added by hobbs 2004-05-26 05:49:55.
Index: ChangeLog
===================================================================
RCS file: /cvsroot/tcl/tcl/ChangeLog,v
retrieving revision 1.1453.2.259
diff -u -b -r1.1453.2.259 ChangeLog
--- ChangeLog	25 May 2004 19:02:23 -0000	1.1453.2.259
+++ ChangeLog	25 May 2004 22:47:24 -0000
@@ -1,3 +1,13 @@
+2004-05-25  Jeff Hobbs  <[email protected]>
+
+	* 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  <[email protected]>
 
 	* tests/winFCmd.test: Correct test for the presence of a CD-ROM so
Index: doc/http.n
===================================================================
RCS file: /cvsroot/tcl/tcl/doc/http.n,v
retrieving revision 1.18.2.1
diff -u -b -r1.18.2.1 http.n
--- doc/http.n	16 Jul 2003 04:15:07 -0000	1.18.2.1
+++ doc/http.n	25 May 2004 22:47:24 -0000
@@ -1,6 +1,7 @@
 '\"
 '\" 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.
@@ -8,13 +9,13 @@
 '\" RCS: @(#) $Id: http.n,v 1.18.2.1 2003/07/16 04:15:07 dgp 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 @@
 \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
Index: tests/http.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/http.test,v
retrieving revision 1.33.2.1
diff -u -b -r1.33.2.1 http.test
--- tests/http.test	18 Jul 2003 19:41:17 -0000	1.33.2.1
+++ tests/http.test	25 May 2004 22:47:24 -0000
@@ -47,7 +47,7 @@
 
 # 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 @@
 
 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.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 @@
     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 @@
     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 @@
     removeFile $httpdFile
 }
 
+rename bgerror {}
 ::tcltest::cleanupTests
Index: library/http/http.tcl
===================================================================
RCS file: /cvsroot/tcl/tcl/library/http/http.tcl,v
retrieving revision 1.43.2.3
diff -u -b -r1.43.2.3 http.tcl
--- library/http/http.tcl	2 Oct 2003 23:07:33 -0000	1.43.2.3
+++ library/http/http.tcl	25 May 2004 22:47:24 -0000
@@ -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 @@
 	-proxyhost {}
 	-proxyport {}
 	-proxyfilter http::ProxyRequired
+	-urlencoding utf-8
     }
     set http(-useragent) "Tcl http client package [package provide http]"
 
@@ -611,14 +612,11 @@
     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 @@
 		set done 1
 	    }
 	} else {
-	    
 	    # Copy blocks from the query channel
 
 	    set outStr [read $state(-querychannel) $state(-queryblocksize)]
@@ -889,6 +886,7 @@
 #       The encoded string
 
 proc http::mapReply {string} {
+    variable http
     variable formMap
     variable alphanumeric
 
@@ -898,6 +896,9 @@
     # 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]
Index: library/http/pkgIndex.tcl
===================================================================
RCS file: /cvsroot/tcl/tcl/library/http/pkgIndex.tcl,v
retrieving revision 1.10.2.2
diff -u -b -r1.10.2.2 pkgIndex.tcl
--- library/http/pkgIndex.tcl	2 Oct 2003 23:07:34 -0000	1.10.2.2
+++ library/http/pkgIndex.tcl	25 May 2004 22:47:24 -0000
@@ -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}}}]