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

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

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