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

Fix PR14194

Browse Source
This commit is contained in:
Jay McCarthy 2013-11-25 15:15:54 -07:00
parent 7e8ed02704
commit 399e9a25b0
2 changed files with 84 additions and 101 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pkgs/web-server-pkgs/web-server-lib/web-server/http/cookie-parse.rkt
View File

@ -90,7 +90,7 @@
[(PATH) 'path] [(PATH) 'path]
[(TOKEN) $1]) [(TOKEN) $1])
(rhs [(TOKEN) $1] ; This is legal, but is subsumed by the illegal rule (rhs [(TOKEN) $1] ; This is legal, but is subsumed by the illegal rule
[(QUOTED-STRING) $1] [(QUOTED-STRING) (regexp-replace* (regexp-quote "\\\"") $1 "\"")]
; This is not part of the spec. It is illegal ; This is not part of the spec. It is illegal
[(illegal) $1]) [(illegal) $1])
(illegal (illegal

183
pkgs/web-server-pkgs/web-server-test/tests/web-server/http/cookies-test.rkt
View File

@ -1,5 +1,7 @@
#lang racket #lang racket/base
(require rackunit (require rackunit
racket/promise
racket/list
net/url net/url
web-server/http/request-structs web-server/http/request-structs
web-server/http/response-structs web-server/http/response-structs
@ -19,127 +21,108 @@
(define cookies-tests (define cookies-tests
(test-suite (test-suite
"Cookies" "Cookies"
(test-suite (test-suite
"cookie.rkt" "cookie.rkt"
(test-suite (test-suite
"cookie->header and make-cookie" "cookie->header and make-cookie"
(test-check "Simple" header-equal? (test-check "Simple" header-equal?
(cookie->header (make-cookie "name" "value")) (cookie->header (make-cookie "name" "value"))
(make-header #"Set-Cookie" #"name=value")) (make-header #"Set-Cookie" #"name=value"))
(test-equal? "Comment" (test-equal? "Comment"
(header-value (cookie->header (make-cookie "name" "value" #:comment "comment"))) (header-value (cookie->header (make-cookie "name" "value" #:comment "comment")))
#"name=value; Comment=comment") #"name=value; Comment=comment")
(test-equal? "Domain" (test-equal? "Domain"
(header-value (cookie->header (make-cookie "name" "value" #:domain ".domain"))) (header-value (cookie->header (make-cookie "name" "value" #:domain ".domain")))
#"name=value; Domain=.domain") #"name=value; Domain=.domain")
(test-equal? "max-age" (test-equal? "max-age"
(header-value (cookie->header (make-cookie "name" "value" #:max-age 24))) (header-value (cookie->header (make-cookie "name" "value" #:max-age 24)))
#"name=value; Max-Age=24") #"name=value; Max-Age=24")
(test-equal? "path" (test-equal? "path"
(header-value (cookie->header (make-cookie "name" "value" #:path "path"))) (header-value (cookie->header (make-cookie "name" "value" #:path "path")))
#"name=value; Path=path") #"name=value; Path=path")
(test-equal? "secure? #t" (test-equal? "secure? #t"
(header-value (cookie->header (make-cookie "name" "value" #:secure? #t))) (header-value (cookie->header (make-cookie "name" "value" #:secure? #t)))
#"name=value; Secure") #"name=value; Secure")
(test-equal? "secure? #f" (test-equal? "secure? #f"
(header-value (cookie->header (make-cookie "name" "value" #:secure? #f))) (header-value (cookie->header (make-cookie "name" "value" #:secure? #f)))
#"name=value"))) #"name=value")))
(test-suite (let ()
"cookie-parse.rkt" (define (reqcs hs)
(request-cookies
(test-equal? "None" (make-request
(request-cookies #"GET" (string->url "http://test.com/foo")
(make-request hs (delay empty) #f
#"GET" (string->url "http://test.com/foo") "host" 80 "client")))
empty (delay empty) #f (define (reqc h)
"host" 80 "client")) (reqcs (list (make-header #"Cookie" h))))
empty)
(test-suite
(test-equal? "Simple" "cookie-parse.rkt"
(request-cookies
(make-request
#"GET" (string->url "http://test.com/foo") (test-equal? "None"
(list (make-header #"Cookie" #"$Version=\"1\"; name=\"value\"")) (reqcs empty)
(delay empty) #f empty)
"host" 80 "client"))
(list (make-client-cookie "$Version" "1" #f #f) (test-equal? "Simple"
(make-client-cookie "name" "value" #f #f))) (reqc #"$Version=\"1\"; name=\"value\"")
(list (make-client-cookie "$Version" "1" #f #f)
(test-equal? "Path" (make-client-cookie "name" "value" #f #f)))
(request-cookies
(make-request (test-equal? "Path"
#"GET" (string->url "http://test.com/foo") (reqc #"$Version=\"1\"; name=\"value\"; $Path=\"/acme\"")
(list (make-header #"Cookie" #"$Version=\"1\"; name=\"value\"; $Path=\"/acme\"")) (list (make-client-cookie "$Version" "1" #f #f)
(delay empty) #f (make-client-cookie "name" "value" #f "/acme")))
"host" 80 "client"))
(list (make-client-cookie "$Version" "1" #f #f) (test-equal? "Domain"
(make-client-cookie "name" "value" #f "/acme"))) (reqc #"$Version=\"1\"; name=\"value\"; $Domain=\".acme\"")
(list (make-client-cookie "$Version" "1" #f #f)
(test-equal? "Domain" (make-client-cookie "name" "value" ".acme" #f)))
(request-cookies
(make-request (test-equal? "Multiple"
#"GET" (string->url "http://test.com/foo") (reqc #"$Version=\"1\"; key1=\"value1\"; key2=\"value2\"")
(list (make-header #"Cookie" #"$Version=\"1\"; name=\"value\"; $Domain=\".acme\"")) (list (make-client-cookie "$Version" "1" #f #f)
(delay empty) #f (make-client-cookie "key1" "value1" #f #f)
"host" 80 "client")) (make-client-cookie "key2" "value2" #f #f)))
(list (make-client-cookie "$Version" "1" #f #f)
(make-client-cookie "name" "value" ".acme" #f))) (test-equal? "Multiple w/ paths & domains"
(reqc #"$Version=\"1\"; key1=\"value1\"; $Path=\"/acme\"; key2=\"value2\"; $Domain=\".acme\"")
(test-equal? "Multiple" (list (make-client-cookie "$Version" "1" #f #f)
(request-cookies (make-client-cookie "key1" "value1" #f "/acme")
(make-request (make-client-cookie "key2" "value2" ".acme" #f)))
#"GET" (string->url "http://test.com/foo")
(list (make-header #"Cookie" #"$Version=\"1\"; key1=\"value1\"; key2=\"value2\"")) (test-equal? "phpBB. PR10689"
(delay empty) #f (reqc #"style_cookie=null; phpbb3_e1p9b_u=54; phpbb3_e1p9b_k=; phpbb3_e1p9b_sid=3fa8d7a7b65fbabcbe9b345861dc079a")
"host" 80 "client")) (list (make-client-cookie "style_cookie" "null" #f #f)
(list (make-client-cookie "$Version" "1" #f #f) (make-client-cookie "phpbb3_e1p9b_u" "54" #f #f)
(make-client-cookie "key1" "value1" #f #f) (make-client-cookie "phpbb3_e1p9b_k" "" #f #f)
(make-client-cookie "key2" "value2" #f #f))) (make-client-cookie "phpbb3_e1p9b_sid" "3fa8d7a7b65fbabcbe9b345861dc079a" #f #f)))
(test-equal? "Multiple w/ paths & domains" (test-equal? "Google"
(request-cookies (reqc #"teaching-order=course;
(make-request __utmz=165257760.1272597702.1.1.utmcsr=(direct)|utmccn=(direct)|utmcmd=(none)\r\n")
#"GET" (string->url "http://test.com/foo") (list (make-client-cookie "teaching-order" "course" #f #f)
(list (make-header #"Cookie" #"$Version=\"1\"; key1=\"value1\"; $Path=\"/acme\"; key2=\"value2\"; $Domain=\".acme\"")) (make-client-cookie "__utmz" "165257760.1272597702.1.1.utmcsr=(direct)|utmccn=(direct)|utmcmd=(none)" #f #f)))
(delay empty) #f
"host" 80 "client")) (let ()
(list (make-client-cookie "$Version" "1" #f #f) (define in "hell\"w\"o")
(make-client-cookie "key1" "value1" #f "/acme") (define out #"id=\"hell\\\"w\\\"o\"")
(make-client-cookie "key2" "value2" ".acme" #f))) (test-check "quotes (pr14194)" header-equal?
(cookie->header (make-cookie "id" in))
(test-equal? "phpBB. PR10689" (make-header #"Set-Cookie" out))
(request-cookies (test-equal? "quotes (pr14194)"
(make-request (reqc out)
#"GET" (string->url "http://test.com/foo") (list (make-client-cookie "id" in #f #f))))))))
(list (make-header #"Cookie"
#"style_cookie=null; phpbb3_e1p9b_u=54; phpbb3_e1p9b_k=; phpbb3_e1p9b_sid=3fa8d7a7b65fbabcbe9b345861dc079a")) (module+ test
(delay empty) #f (require rackunit/text-ui)
"host" 80 "client")) (run-tests cookies-tests))
(list (make-client-cookie "style_cookie" "null" #f #f)
(make-client-cookie "phpbb3_e1p9b_u" "54" #f #f)
(make-client-cookie "phpbb3_e1p9b_k" "" #f #f)
(make-client-cookie "phpbb3_e1p9b_sid" "3fa8d7a7b65fbabcbe9b345861dc079a" #f #f)))
(test-equal? "Google"
(request-cookies
(make-request
#"GET" (string->url "http://test.com/foo")
(list (make-header #"Cookie"
#"teaching-order=course;
__utmz=165257760.1272597702.1.1.utmcsr=(direct)|utmccn=(direct)|utmcmd=(none)\r\n"))
(delay empty) #f
"host" 80 "client"))
(list (make-client-cookie "teaching-order" "course" #f #f)
(make-client-cookie "__utmz" "165257760.1272597702.1.1.utmcsr=(direct)|utmccn=(direct)|utmcmd=(none)" #f #f)))
)))