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

Including version in cookie output

Browse Source
This commit is contained in:
Jay McCarthy 2010-05-04 10:42:57 -06:00
parent 6685b67033
commit 3f19ad6fce
2 changed files with 26 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
collects/tests/web-server/http/cookies-test.rkt
View File

@ -86,7 +86,8 @@
(list (make-header #"Cookie" #"$Version=\"1\"; name=\"value\""))
(delay empty) #f
"host" 80 "client"))
(list (make-client-cookie "name" "value" #f #f)))
(list (make-client-cookie "$Version" "1" #f #f)
(make-client-cookie "name" "value" #f #f)))
(test-equal? "Path"
(request-cookies
@ -95,7 +96,8 @@
(list (make-header #"Cookie" #"$Version=\"1\"; name=\"value\"; $Path=\"/acme\""))
(delay empty) #f
"host" 80 "client"))
(list (make-client-cookie "name" "value" #f "/acme")))
(list (make-client-cookie "$Version" "1" #f #f)
(make-client-cookie "name" "value" #f "/acme")))
(test-equal? "Domain"
(request-cookies
@ -104,7 +106,8 @@
(list (make-header #"Cookie" #"$Version=\"1\"; name=\"value\"; $Domain=\".acme\""))
(delay empty) #f
"host" 80 "client"))
(list (make-client-cookie "name" "value" ".acme" #f)))
(list (make-client-cookie "$Version" "1" #f #f)
(make-client-cookie "name" "value" ".acme" #f)))
(test-equal? "Multiple"
(request-cookies
@ -113,7 +116,8 @@
(list (make-header #"Cookie" #"$Version=\"1\"; key1=\"value1\"; key2=\"value2\""))
(delay empty) #f
"host" 80 "client"))
(list (make-client-cookie "key1" "value1" #f #f)
(list (make-client-cookie "$Version" "1" #f #f)
(make-client-cookie "key1" "value1" #f #f)
(make-client-cookie "key2" "value2" #f #f)))
(test-equal? "Multiple w/ paths & domains"
@ -123,7 +127,8 @@
(list (make-header #"Cookie" #"$Version=\"1\"; key1=\"value1\"; $Path=\"/acme\"; key2=\"value2\"; $Domain=\".acme\""))
(delay empty) #f
"host" 80 "client"))
(list (make-client-cookie "key1" "value1" #f "/acme")
(list (make-client-cookie "$Version" "1" #f #f)
(make-client-cookie "key1" "value1" #f "/acme")
(make-client-cookie "key2" "value2" ".acme" #f)))
(test-equal? "phpBB. PR10689"
@ -141,5 +146,5 @@
)))
#;(require racunit/text-ui)
#;(run-tests cookies-tests)
(require racunit/text-ui)
(run-tests cookies-tests)

17
collects/web-server/http/cookie-parse.rkt
View File

@ -6,7 +6,7 @@
(define-struct client-cookie
(name value domain path)
#:transparent)
#:prefab)
(provide/contract
[struct client-cookie
@ -70,12 +70,13 @@
(position-offset start-pos)
(- (position-offset end-pos) (position-offset start-pos))))
(define assoc-list-parser
(define cookies-parser
(parser (src-pos)
(start cookie)
(start cookies)
(tokens regular keywords)
(grammar (cookie [(VERSION EQUALS rhs separator items) $5]
(grammar (cookies [(cookie-version items) (cons $1 $2)]
[(items) $1])
(cookie-version [(VERSION EQUALS rhs separator) (cons "$Version" $3)])
(items [(item separator items) (cons $1 $3)]
[(item) (list $1)])
(separator
@ -92,7 +93,7 @@
(end EOF)
(error (lambda (tok-ok? tok-name tok-value start-pos end-pos)
(raise-syntax-error
'assoc-list-parser
'cookies-parser
(format
(if tok-ok?
"Did not expect token ~a"
@ -101,15 +102,13 @@
(datum->syntax #f tok-value (make-srcloc start-pos end-pos)))))))
(define (do-parse str)
(with-handlers ([exn:fail?
(λ (e) empty)])
(with-input-from-string
str
(λ ()
(let ([ip (current-input-port)])
(define ip (current-input-port))
(port-count-lines! ip)
(parameterize ([current-source-name (object-name ip)])
(raw->cookies (assoc-list-parser (λ () (cookie-lexer ip))))))))))
(raw->cookies (cookies-parser (λ () (cookie-lexer ip))))))))
;; raw->cookies : flat-property-list -> (listof cookie)
(define (raw->cookies associations)