up

svn: r4416

collects/web-server/dispatchers/dispatch-files.ss

@@ -4,7 +4,8 @@
            (lib "kw.ss")
            (lib "list.ss")
            (lib "plt-match.ss")
-           (lib "contract.ss"))
+           (lib "contract.ss")
+           (lib "uri-codec.ss" "net"))
   (require (lib "pretty.ss"))         
   (require "dispatch.ss"
            "../private/configuration.ss"
@@ -37,7 +38,7 @@
       ;; to find the file, including searching for implicit index files, and serve it out
       (define path 
         (url-path->path htdocs-path
-                        (translate-escapes (url-path->string (url-path uri)))))
+                        (uri-decode (url-path->string (url-path uri)))))
       (cond
         [(file-exists? path)
          (match (headers-assq #"Range" (request-headers/raw req))

collects/web-server/dispatchers/dispatch-passwords.ss

@@ -2,7 +2,7 @@
   (require (lib "kw.ss")
            (lib "contract.ss"))
   (require "dispatch.ss"
-           (all-except "../private/util.ss" translate-escapes)
+           "../private/util.ss"
            "../private/configuration.ss"
            "../private/servlet-helpers.ss"
            "../private/connection-manager.ss"

collects/web-server/dispatchers/dispatch-servlets.ss

@@ -12,7 +12,7 @@
            "../servlet.ss"
            "../sig.ss"
            "../private/configuration.ss"
-           (all-except "../private/util.ss" translate-escapes)
+           "../private/util.ss"
            "../managers/manager.ss"
            "../managers/timeouts.ss"
            "../managers/lru.ss"

collects/web-server/private/configure.ss

@@ -12,7 +12,7 @@
            (lib "configuration-table-structs.ss" "web-server" "private")
            (lib "parse-table.ss" "web-server" "private")
            (lib "configuration-util.ss" "web-server" "private")
-           (all-except (lib "util.ss" "web-server" "private") translate-escapes))
+           (lib "util.ss" "web-server" "private"))
   (provide/contract
    [servlet unit/sig?]
    ; XXX contract

collects/web-server/private/request.ss

@@ -2,7 +2,8 @@
   (require (lib "contract.ss")
            (lib "plt-match.ss")
            (lib "url.ss" "net")
-           (lib "list.ss"))
+           (lib "list.ss")
+           (lib "uri-codec.ss" "net"))
   (require "util.ss"
            "connection-manager.ss"
            "../request-structs.ss")
@@ -187,11 +188,11 @@
                   (if (or (= amp-end len) (eq? (bytes-ref raw amp-end) (char->integer #\&)))
                       (list* (make-binding:form
                               (string->bytes/utf-8
-                               (translate-escapes
+                               (uri-decode
                                 (bytes->string/utf-8
                                  (subbytes raw start key-end))))
                               (string->bytes/utf-8
-                               (translate-escapes
+                               (uri-decode
                                 (bytes->string/utf-8
                                  (subbytes raw (add1 key-end) amp-end)))))
                             (loop (add1 amp-end)))

collects/web-server/private/servlet-helpers.ss

@@ -4,7 +4,8 @@
            (lib "plt-match.ss")
            (lib "xml.ss" "xml")
            (lib "base64.ss" "net")
-           (lib "url.ss" "net"))
+           (lib "url.ss" "net")
+           (lib "uri-codec.ss" "net"))
   (require "util.ss"
            "bindings.ss"
            "../servlet-structs.ss"
@@ -124,8 +125,10 @@
     (let ([rx (byte-regexp #"^Basic .*")])
       (lambda (a) (regexp-match rx a))))
   
+  
+  
   (provide ; all-from
-   translate-escapes)
+   (rename uri-decode translate-escapes))
   (provide/contract
    [get-host (url? (listof header?) . -> . symbol?)]
    ; XXX contract maybe

collects/web-server/private/util.ss

@@ -2,9 +2,7 @@
   (require (lib "contract.ss")
            (lib "string.ss")
            (lib "list.ss")
-           (lib "plt-match.ss")
            (lib "url.ss" "net")
-           (lib "errortrace-lib.ss" "errortrace")
            (lib "uri-codec.ss" "net"))
   (require "../request-structs.ss")
   
@@ -33,7 +31,7 @@
   (define (decompose-request req)
     (let* ([uri (request-uri req)]
            [method (request-method req)]
-           [path (translate-escapes (url-path->string (url-path uri)))])
+           [path (uri-decode (url-path->string (url-path uri)))])
       (values uri method path)))
   
   ;; network-error: symbol string . values -> void
@@ -158,30 +156,10 @@
   ; hash-table-empty? : hash-table -> bool
   (define (hash-table-empty? table)
     (zero? (hash-table-count table)))
-  
-  ; This comes from Shriram's collection, and should be exported form there.
-  ; translate-escapes : String -> String
-  (define-struct servlet-error ())
-  (define-struct (invalid-%-suffix servlet-error) (chars))
-  (define-struct (incomplete-%-suffix invalid-%-suffix) ())
-  (define (translate-escapes init)
-    (define raw (uri-decode init))
-    (list->string
-     (let loop ([chars (string->list raw)])
-       (match chars
-         [(list)
-          (list)]
-         [(list-rest ic cs)
-          (define c
-            (cond
-              [(char=? ic #\+) #\space]
-              [else ic]))
-          (list* c (loop cs))]))))
-  
+    
   (provide/contract
    [url-path->string ((listof (or/c string? path/param?)) . -> . string?)]
    [extract-flag (symbol? (listof (cons/c symbol? any/c)) any/c . -> . any/c)]
-   [translate-escapes (string? . -> . string?)]
    [hash-table-empty? (any/c . -> . boolean?)]
    [valid-port? (any/c . -> . boolean?)]
    [decompose-request ((request?) . ->* . (url? symbol? string?))]