[tclwebtest] Fixing directory traversal characters

[Grzegorz A. H. <gr...@ef...>]

I've commited the following patch. It has the potential of working
with file urls, but I haven't tested that. It makes this work:

 do_request http://www.google.com/././//juanito/../juanito/..

Index: lib/tclwebtest.tcl
===================================================================
RCS file: /cvsroot/tclwebtest/tclwebtest/lib/tclwebtest.tcl,v
retrieving revision 1.25
diff -u -r1.25 tclwebtest.tcl
--- lib/tclwebtest.tcl  15 Feb 2003 11:01:07 -0000      1.25
+++ lib/tclwebtest.tcl  18 Feb 2003 18:30:53 -0000
@@ -2035,7 +2035,7 @@
     # a selftest
     regsub {#[^#]*$} $url {} url
     
-    set url [absolute_link $url]
+    set url [post_process_url [absolute_link $url]]
     set previous_url $::tclwebtest::url
     set ::tclwebtest::url $url
     
@@ -2326,6 +2326,29 @@
             return "$host_path_part/$url"
         }
     }
+}
+
+
+ad_proc -private post_process_url {
+    url
+} {
+
+    Do some url cleanup, like substitution of '/./' or '/..'.
+
+} {
+
+    # substitute /././
+    regsub -all {/(\./)+} $url "/" url
+    regexp {([^:]+)://([^/]+)(.*)} $url match protocol domain path
+    if { $match != "" } {
+        # substitute 'folder/..'
+        while { [regsub {/[^/]+(/\.\.(/|$))} $path "/" path] } { }
+        # substitute '/////'
+        regsub -all {//+} $path "/" path
+        set url "$protocol://$domain$path"
+    }
+    return $url
+
 }
 
 
--
 Grzegorz Adam Hankiewicz, gr...@ef.... Tel: +34-94-472 35 89.
 eFaber SL, Maria Diaz de Haro, 68, 2         http://www.efaber.net/
 48920 Portugalete, Bizkaia (SPAIN)