allows colons in the userinfo field of a url (ie, does not encode them)
svn: r13282 original commit: 134138916fbfaf52b45a43f62eb557eab7ecb142
This commit is contained in:
parent
fa1e6bf2c7
commit
8f3c97eab8
|
@ -4,6 +4,8 @@ uri-encode
|
||||||
uri-decode
|
uri-decode
|
||||||
uri-path-segment-encode
|
uri-path-segment-encode
|
||||||
uri-path-segment-decode
|
uri-path-segment-decode
|
||||||
|
uri-userinfo-encode
|
||||||
|
uri-userinfo-decode
|
||||||
form-urlencoded-encode
|
form-urlencoded-encode
|
||||||
form-urlencoded-decode
|
form-urlencoded-decode
|
||||||
alist->form-urlencoded
|
alist->form-urlencoded
|
||||||
|
|
|
@ -106,6 +106,7 @@ See more in PR8831.
|
||||||
"0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"))
|
"0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"))
|
||||||
|
|
||||||
;; Characters that sometimes map to themselves
|
;; Characters that sometimes map to themselves
|
||||||
|
;; called 'mark' in RFC 3986
|
||||||
(define safe-mapping (self-map-chars "-_.!~*'()"))
|
(define safe-mapping (self-map-chars "-_.!~*'()"))
|
||||||
|
|
||||||
;; The strict URI mapping
|
;; The strict URI mapping
|
||||||
|
@ -115,7 +116,22 @@ See more in PR8831.
|
||||||
(define uri-path-segment-mapping
|
(define uri-path-segment-mapping
|
||||||
(append alphanumeric-mapping
|
(append alphanumeric-mapping
|
||||||
safe-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
|
;; The form-urlencoded mapping
|
||||||
(define form-urlencoded-mapping
|
(define form-urlencoded-mapping
|
||||||
|
@ -152,6 +168,11 @@ See more in PR8831.
|
||||||
uri-path-segment-decoding-vector)
|
uri-path-segment-decoding-vector)
|
||||||
(make-codec-tables uri-path-segment-mapping))
|
(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
|
(define-values (form-urlencoded-encoding-vector
|
||||||
form-urlencoded-decoding-vector)
|
form-urlencoded-decoding-vector)
|
||||||
(make-codec-tables form-urlencoded-mapping))
|
(make-codec-tables form-urlencoded-mapping))
|
||||||
|
@ -207,6 +228,15 @@ See more in PR8831.
|
||||||
(define (uri-path-segment-decode str)
|
(define (uri-path-segment-decode str)
|
||||||
(decode uri-path-segment-decoding-vector 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
|
;; string -> string
|
||||||
(define (form-urlencoded-encode str)
|
(define (form-urlencoded-encode str)
|
||||||
(encode form-urlencoded-encoding-vector str))
|
(encode form-urlencoded-encoding-vector str))
|
||||||
|
|
|
@ -1,3 +1,5 @@
|
||||||
|
#lang scheme/unit
|
||||||
|
|
||||||
;; To do:
|
;; To do:
|
||||||
;; Handle HTTP/file errors.
|
;; Handle HTTP/file errors.
|
||||||
;; Not throw away MIME headers.
|
;; Not throw away MIME headers.
|
||||||
|
@ -9,7 +11,6 @@
|
||||||
;; "impure" = they have text waiting
|
;; "impure" = they have text waiting
|
||||||
;; "pure" = the MIME headers have been read
|
;; "pure" = the MIME headers have been read
|
||||||
|
|
||||||
#lang scheme/unit
|
|
||||||
(require scheme/port
|
(require scheme/port
|
||||||
"url-structs.ss"
|
"url-structs.ss"
|
||||||
"uri-codec.ss"
|
"uri-codec.ss"
|
||||||
|
@ -71,7 +72,7 @@
|
||||||
(sa (if scheme (sa scheme ":") "")
|
(sa (if scheme (sa scheme ":") "")
|
||||||
(if (or user host port)
|
(if (or user host port)
|
||||||
(sa "//"
|
(sa "//"
|
||||||
(if user (sa (uri-encode user) "@") "")
|
(if user (sa (uri-userinfo-encode user) "@") "")
|
||||||
(if host host "")
|
(if host host "")
|
||||||
(if port (sa ":" (number->string port)) "")
|
(if port (sa ":" (number->string port)) "")
|
||||||
;; There used to be a "/" here, but that causes an
|
;; There used to be a "/" here, but that causes an
|
||||||
|
@ -398,7 +399,9 @@
|
||||||
(cdr (or (regexp-match url-rx str)
|
(cdr (or (regexp-match url-rx str)
|
||||||
(url-error "Invalid URL string: ~e" 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 #f, and leave unmolested any % that is followed by hex digit
|
||||||
;; if a % is not followed by a hex digit, replace it with %25
|
;; if a % is not followed by a hex digit, replace it with %25
|
||||||
;; in an attempt to be "friendly"
|
;; in an attempt to be "friendly"
|
||||||
|
|
Loading…
Reference in New Issue
Block a user