From ffcbe192a990ccb07e04eb6f162091c91d8f377b Mon Sep 17 00:00:00 2001
From: hobbs <hobbs>
Date: Wed, 5 Oct 2005 05:03:38 +0000
Subject: 	* tests/http.test:              do not URI encode -._~
 according 	* library/http/http.tcl (init): to RFC3986. [Bug 1182373]
 (aho)

---
 ChangeLog             |  3 +++
 library/http/http.tcl | 12 ++++++++----
 tests/http.test       |  6 +++---
 3 files changed, 14 insertions(+), 7 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 2710c29..dce77c5 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,8 @@
 2005-10-04  Jeff Hobbs  <jeffh@ActiveState.com>
 
+	* tests/http.test:              do not URI encode -._~ according
+	* library/http/http.tcl (init): to RFC3986. [Bug 1182373] (aho)
+
 	* unix/tclLoadShl.c (TclpDlopen): use DYNAMIC_PATH on second
 	shl_load only.  [Bug 1204237]
 
diff --git a/library/http/http.tcl b/library/http/http.tcl
index c3454c4..39814f8 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.51 2005/05/10 18:34:54 kennykb Exp $
+# RCS: @(#) $Id: http.tcl,v 1.52 2005/10/05 05:03:38 hobbs Exp $
 
 # Rough version history:
 # 1.0	Old http_get interface
@@ -40,10 +40,14 @@ namespace eval http {
 
     proc init {} {
 	# Set up the map for quoting chars
-	# The spec says: "non-alphanumeric characters are replaced by '%HH'"
-	for {set i 0} {$i < 256} {incr i} {
+	# RFC3986 Section 2.3 say percent encode all except:
+	# "... percent-encoded octets in the ranges of ALPHA
+	# (%41-%5A and %61-%7A), DIGIT (%30-%39), hyphen (%2D),
+	# period (%2E), underscore (%5F), or tilde (%7E) should
+	# not be created by URI producers ..."
+	for {set i 0} {$i <= 256} {incr i} {
 	    set c [format %c $i]
-	    if {![string match {[a-zA-Z0-9]} $c]} {
+	    if {![string match {[-._~a-zA-Z0-9]} $c]} {
 		set map($c) %[format %.2x $i]
 	    }
 	}
diff --git a/tests/http.test b/tests/http.test
index 86811f4..2a12aff 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.38 2004/05/25 22:56:33 hobbs Exp $
+# RCS: @(#) $Id: http.test,v 1.39 2005/10/05 05:03:38 hobbs Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -483,7 +483,7 @@ test http-5.3 {http::formatQuery} {
 
 test http-5.4 {http::formatQuery} {
     http::formatQuery name1 ~bwelch name2 \xa1\xa2\xa2
-} {name1=%7ebwelch&name2=%c2%a1%c2%a2%c2%a2}
+} {name1=~bwelch&name2=%c2%a1%c2%a2%c2%a2}
 
 test http-5.5 {http::formatQuery} {
     set enc [http::config -urlencoding]
@@ -491,7 +491,7 @@ test http-5.5 {http::formatQuery} {
     set res [http::formatQuery name1 ~bwelch name2 \xa1\xa2\xa2]
     http::config -urlencoding $enc
     set res
-} {name1=%7ebwelch&name2=%a1%a2%a2}
+} {name1=~bwelch&name2=%a1%a2%a2}
 
 test http-6.1 {http::ProxyRequired} {
     http::config -proxyhost [info hostname] -proxyport $port
-- 
cgit v0.12