allows colons in the userinfo field of a url (ie, does not encode them)

svn: r13282

collects/net/scribblings/uri-codec.scrbl

@@ -78,6 +78,19 @@ Encode a string using the URI encoding rules.}
 
 Decode a string using the URI decoding rules.}
 
+@defproc[(uri-path-segment-encode [str string?]) string?]{
+Encodes a string according to the rules in @cite["RFC3986"] for path segments.
+}
+@defproc[(uri-path-segment-decode [str string?]) string?]{
+Decodes a string according to the rules in @cite["RFC3986"] for path segments.
+}
+@defproc[(uri-userinfo-encode [str string?]) string?]{
+Encodes a string according to the rules in @cite["RFC3986"] for the userinfo field.
+}
+@defproc[(uri-userinfo-decode [str string?]) string?]{
+Decodes a string according to the rules in @cite["RFC3986"] for the userinfo field.
+}
+
 
 @defproc[(form-urlencoded-encode [str string?]) string?]{
 

collects/net/uri-codec-sig.ss

@@ -4,6 +4,8 @@ uri-encode
 uri-decode
 uri-path-segment-encode
 uri-path-segment-decode
+uri-userinfo-encode
+uri-userinfo-decode
 form-urlencoded-encode
 form-urlencoded-decode
 alist->form-urlencoded

collects/net/uri-codec-unit.ss

@@ -106,6 +106,7 @@ See more in PR8831.
    "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"))
 
 ;; Characters that sometimes map to themselves
+;; called 'mark' in RFC 3986
 (define safe-mapping (self-map-chars "-_.!~*'()"))
 
 ;; The strict URI mapping
@@ -115,7 +116,22 @@ See more in PR8831.
 (define uri-path-segment-mapping
   (append alphanumeric-mapping
           safe-mapping
-          (map (λ (c) (cons c c)) (string->list "@+,=$&:"))))
+          (self-map-chars "@+,=$&:")))
+
+;; from RFC 3986
+(define unreserved-mapping
+  (append alphanumeric-mapping
+          (self-map-chars "-._~")))
+
+;; from RFC 3986
+(define sub-delims-mapping
+  (self-map-chars "!$&'()*+,;="))
+
+;; The uri userinfo mapping from RFC 3986
+(define uri-userinfo-mapping
+  (append unreserved-mapping
+          sub-delims-mapping
+          (self-map-chars ":")))
 
 ;; The form-urlencoded mapping
 (define form-urlencoded-mapping
@@ -152,6 +168,11 @@ See more in PR8831.
                 uri-path-segment-decoding-vector)
   (make-codec-tables uri-path-segment-mapping))
 
+(define-values (uri-userinfo-encoding-vector
+                uri-userinfo-decoding-vector)
+  (make-codec-tables uri-userinfo-mapping))
+
+
 (define-values (form-urlencoded-encoding-vector
                 form-urlencoded-decoding-vector)
   (make-codec-tables form-urlencoded-mapping))
@@ -207,6 +228,15 @@ See more in PR8831.
 (define (uri-path-segment-decode str)
   (decode uri-path-segment-decoding-vector str))
 
+;; string -> string
+(define (uri-userinfo-encode str)
+  (encode uri-userinfo-encoding-vector str))
+
+;; string -> string
+(define (uri-userinfo-decode str)
+  (decode uri-userinfo-decoding-vector str))
+
+
 ;; string -> string
 (define (form-urlencoded-encode str)
   (encode form-urlencoded-encoding-vector str))

collects/net/url-unit.ss

@@ -1,3 +1,5 @@
+#lang scheme/unit
+
 ;; To do:
 ;;   Handle HTTP/file errors.
 ;;   Not throw away MIME headers.
@@ -9,7 +11,6 @@
 ;;   "impure" = they have text waiting
 ;;   "pure" = the MIME headers have been read
 
-#lang scheme/unit
 (require scheme/port
          "url-structs.ss"
          "uri-codec.ss"
@@ -71,7 +72,7 @@
     (sa (if scheme (sa scheme ":") "")
         (if (or user host port)
           (sa "//"
-              (if user (sa (uri-encode user) "@") "")
+              (if user (sa (uri-userinfo-encode user) "@") "")
               (if host host "")
               (if port (sa ":" (number->string port)) "")
               ;; There used to be a "/" here, but that causes an
@@ -398,7 +399,9 @@
    (cdr (or (regexp-match url-rx str)
             (url-error "Invalid URL string: ~e" str)))))
 
-(define (uri-decode/maybe f)
+(define (uri-decode/maybe f) (friendly-decode/maybe f uri-decode))
+
+(define (friendly-decode/maybe f uri-decode)
   ;; If #f, and leave unmolested any % that is followed by hex digit
   ;; if a % is not followed by a hex digit, replace it with %25
   ;; in an attempt to be "friendly"

collects/tests/mzscheme/net.ss

@@ -148,6 +148,14 @@
 ;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(test "hello" uri-userinfo-encode "hello")
+(test "hello%20there" uri-userinfo-encode "hello there")
+(test "hello:there" uri-userinfo-encode "hello:there")
+(test "hello" uri-userinfo-decode "hello")
+(test "hello there" uri-userinfo-decode "hello%20there")
+(test "hello:there" uri-userinfo-decode "hello:there")
+
+
 (let ()
   (define (test-s->u vec str)
     (test vec string->url/vec str)
@@ -239,6 +247,9 @@
              "http://robb%20y@www.drscheme.org/")
   (test-s->u #("http" #f "www.drscheme.org" #f #t (#("%a") #("b/") #("c")) () #f)
              "http://www.drscheme.org/%25a/b%2F/c")
+  (test-s->u #("http" "robby:password" "www.drscheme.org" #f #t (#("")) () #f)
+             "http://robby:password@www.drscheme.org/")
+  (test "robby:password" (lambda (x) (url-user (string->url x))) "http://robby%3apassword@www.drscheme.org/")
 
   ;; test the characters that need to be encoded in paths vs those that do not need to
   ;; be encoded in paths