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-path-absolute? : url -> boolean?
> 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? : any -> boolean
> make-url : ...as-above.. -> url

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

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

@ -12,7 +12,7 @@
[port (or/c false/c number?)]
[path-absolute? boolean?]
[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?)]))
(struct path/param ([path (or/c string? (symbols 'up 'same))]
[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 . "hello there")) form-urlencoded->alist "key=hello+there")
(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"))
;;
@ -300,6 +300,19 @@
"http://foo:/abc/def.html")
(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 #("http" "ROBBY" "www.drscheme.org" 80 #t (#("INDEX.HTML" "XXX")) ((T . "P")) "YYY")
string->url/vec