suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

PR8809 (value-less keys in the query parts) -- see message in the PR log

Browse Source 
svn: r6931
This commit is contained in:
Eli Barzilay 2007-07-18 03:42:23 +00:00
parent 045b9e9ec7
commit 418df561e7
4 changed files with 42 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/net/doc.txt
View File

@ -37,7 +37,7 @@ _url struct_
> url-port : url -> (union false/c number?) > url-port : url -> (union false/c number?)
> url-path-absolute? : url -> boolean? > url-path-absolute? : url -> boolean?
> url-path : url -> (listof path/param?) > url-path : url -> (listof path/param?)
> url-query : url -> (listof (cons/c symbol? string?)) > url-query : url -> (listof (cons/c symbol? (union false/c string?)))
> url-fragment : url -> (union false/c string?) > url-fragment : url -> (union false/c string?)
> url? : any -> boolean > url? : any -> boolean
> make-url : ...as-above.. -> url > make-url : ...as-above.. -> url

76
collects/net/uri-codec-unit.ss
View File

@ -305,65 +305,39 @@ JALQefhDMCATcl2/bZL0bw==
;; http://www.w3.org/TR/html401/appendix/notes.html#ampersands-in-uris ;; http://www.w3.org/TR/html401/appendix/notes.html#ampersands-in-uris
;; listof (cons symbol string) -> string ;; listof (cons symbol string) -> string
(define (alist->form-urlencoded args) (define (alist->form-urlencoded args)
(let* ([mode (current-alist-separator-mode)] (let* ([sep (if (eq? (current-alist-separator-mode) 'amp) "&" ";")]
[format-one [format-one
(lambda (arg) (lambda (arg)
(let* ([name (car arg)] (let* ([name (car arg)]
[value (cdr arg)]) [value (cdr arg)]
(string-append (form-urlencoded-encode (symbol->string name)) [name (form-urlencoded-encode (symbol->string name))]
"=" [value (and value (form-urlencoded-encode value))])
(form-urlencoded-encode value))))] (if value (string-append name "=" value) name)))]
[strs (let loop ([args args]) [strs (if (null? args)
(cond '()
[(null? args) null] (cons (format-one (car args))
[(null? (cdr args)) (list (format-one (car args)))] (apply append
[else (list* (format-one (car args)) (map (lambda (a) (list sep (format-one a)))
(if (eq? mode 'amp) "&" ";") (cdr args)))))])
(loop (cdr args)))]))])
(apply string-append strs))) (apply string-append strs)))
;; string -> listof (cons string string) ;; string -> listof (cons string string)
;; http://www.w3.org/TR/html401/appendix/notes.html#ampersands-in-uris ;; http://www.w3.org/TR/html401/appendix/notes.html#ampersands-in-uris
(define (form-urlencoded->alist str) (define (form-urlencoded->alist str)
(define key-regexp #rx"[^=]*") (define keyval-regexp #rx"^([^=]*)(?:=(.*))?$")
(define value-regexp (case (current-alist-separator-mode) (define value-regexp
[(semi) #rx"[^;]*"] (case (current-alist-separator-mode)
[(amp) #rx"[^&]*"] [(semi) #rx"[;]"]
[else #rx"[^&;]*"])) [(amp) #rx"[&]"]
(define (next-key str start) [else #rx"[&;]"]))
(and (< start (string-length str)) (if (equal? "" str)
(match (regexp-match-positions key-regexp str start) '()
[((start . end)) (map (lambda (keyval)
(vector (let ([s (form-urlencoded-decode (let ([m (regexp-match keyval-regexp keyval)]) ; cannot fail
(substring str start end))]) (cons (string->symbol (form-urlencoded-decode (cadr m)))
(string->symbol s)) ;; can be #f for no "=..." part
(add1 end))] (and (caddr m) (form-urlencoded-decode (caddr m))))))
[#f #f]))) (regexp-split value-regexp str))))
(define (next-value str start)
(and (< start (string-length str))
(match (regexp-match-positions value-regexp str start)
[((start . end))
(vector (form-urlencoded-decode (substring str start end))
(add1 end))]
[#f #f])))
(define (next-pair str start)
(match (next-key str start)
[#(key start)
(match (next-value str start)
[#(value start)
(vector (cons key value) start)]
[#f
(vector (cons key "") (string-length str))])]
[#f #f]))
(let loop ([start 0]
[end (string-length str)]
[make-alist (lambda (x) x)])
(if (>= start end)
(make-alist '())
(match (next-pair str start)
[#(pair next-start)
(loop next-start end (lambda (x) (make-alist (cons pair x))))]
[#f (make-alist '())]))))
(define current-alist-separator-mode (define current-alist-separator-mode
(make-parameter 'amp-or-semi (make-parameter 'amp-or-semi

2
collects/net/url-structs.ss
View File

@ -12,7 +12,7 @@
[port (or/c false/c number?)] [port (or/c false/c number?)]
[path-absolute? boolean?] [path-absolute? boolean?]
[path (listof path/param?)] [path (listof path/param?)]
[query (listof (cons/c symbol? string?))] [query (listof (cons/c symbol? (or/c string? false/c)))]
[fragment (or/c false/c string?)])) [fragment (or/c false/c string?)]))
(struct path/param ([path (or/c string? (symbols 'up 'same))] (struct path/param ([path (or/c string? (symbols 'up 'same))]
[param (listof string?)])))) [param (listof string?)]))))

15
collects/tests/mzscheme/net.ss
View File

@ -132,7 +132,7 @@
(test '((key . "value")) form-urlencoded->alist "key=value") (test '((key . "value")) form-urlencoded->alist "key=value")
(test '((key . "hello there")) form-urlencoded->alist "key=hello+there") (test '((key . "hello there")) form-urlencoded->alist "key=hello+there")
(test '((key . "a value")) form-urlencoded->alist "key=a%20value") (test '((key . "a value")) form-urlencoded->alist "key=a%20value")
(test '((key . "")) form-urlencoded->alist "key") (test '((key . #f)) form-urlencoded->alist "key")
(test '((key1 . "value 1") (key2 . "value 2")) form-urlencoded->alist "key1=value+1&key2=value+2")) (test '((key1 . "value 1") (key2 . "value 2")) form-urlencoded->alist "key1=value+1&key2=value+2"))
;; ;;
@ -300,6 +300,19 @@
"http://foo:/abc/def.html") "http://foo:/abc/def.html")
(set-url:os-type! 'unix) (set-url:os-type! 'unix)
;; see PR8809 (value-less keys in the query part)
(test-s->u #("http" #f "foo.bar" #f #t (#("baz")) ((ugh . #f)) #f)
"http://foo.bar/baz?ugh")
(test-s->u #("http" #f "foo.bar" #f #t (#("baz")) ((ugh . "")) #f)
"http://foo.bar/baz?ugh=")
(test-s->u #("http" #f "foo.bar" #f #t (#("baz")) ((ugh . #f) (x . "y") (|1| . "2")) #f)
"http://foo.bar/baz?ugh;x=y;1=2")
(parameterize ([current-alist-separator-mode 'amp])
(test-s->u #("http" #f "foo.bar" #f #t (#("baz")) ((ugh . #f) (x . "y") (|1| . "2")) #f)
"http://foo.bar/baz?ugh&x=y&1=2"))
(test-s->u #("http" #f "foo.bar" #f #t (#("baz")) ((ugh . "") (x . "y") (|1| . "2")) #f)
"http://foo.bar/baz?ugh=;x=y;1=2")
;; test case sensitivity ;; test case sensitivity
(test #("http" "ROBBY" "www.drscheme.org" 80 #t (#("INDEX.HTML" "XXX")) ((T . "P")) "YYY") (test #("http" "ROBBY" "www.drscheme.org" 80 #t (#("INDEX.HTML" "XXX")) ((T . "P")) "YYY")
string->url/vec string->url/vec