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

cookie debugging

Browse Source 
svn: r13876
This commit is contained in:
Jay McCarthy 2009-02-27 21:49:42 +00:00
parent 12dcbfdc88
commit bebc7f50ef
1 changed files with 29 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
collects/web-server/http/cookie-parse.ss
View File

@ -41,9 +41,9 @@
(define-empty-tokens keywords (EQUALS SEMI COMMA PATH DOMAIN VERSION EOF)) (define-empty-tokens keywords (EQUALS SEMI COMMA PATH DOMAIN VERSION EOF))
(define cookie-lexer (define cookie-lexer
(lexer (lexer-src-pos
[(eof) (token-EOF)] [(eof) (token-EOF)]
[whitespace (cookie-lexer input-port)] [whitespace (return-without-pos (cookie-lexer input-port))]
["=" (token-EQUALS)] ["=" (token-EQUALS)]
[";" (token-SEMI)] [";" (token-SEMI)]
["," (token-COMMA)] ["," (token-COMMA)]
@ -54,8 +54,18 @@
(token-QUOTED-STRING (substring lexeme 1 (- (string-length lexeme) 1)))] (token-QUOTED-STRING (substring lexeme 1 (- (string-length lexeme) 1)))]
[(:+ token-char) (token-TOKEN lexeme)])) [(:+ token-char) (token-TOKEN lexeme)]))
(define current-source-name (make-parameter #f))
(define (make-srcloc start-pos end-pos)
(list (current-source-name)
(position-line start-pos)
(position-col start-pos)
(position-offset start-pos)
(- (position-offset end-pos) (position-offset start-pos))))
(define assoc-list-parser (define assoc-list-parser
(parser (start cookie) (parser (src-pos)
(start cookie)
(tokens regular keywords) (tokens regular keywords)
(grammar (cookie [(VERSION EQUALS rhs separator items) $5] (grammar (cookie [(VERSION EQUALS rhs separator items) $5]
[(items) $1]) [(items) $1])
@ -71,16 +81,26 @@
(rhs [(TOKEN) $1] (rhs [(TOKEN) $1]
[(QUOTED-STRING) $1])) [(QUOTED-STRING) $1]))
(end EOF) (end EOF)
(error (lambda (a b c) (error 'assoc-list-parser "Malformed cookie: ~v ~v ~v" a b c))))) (error (lambda (tok-ok? tok-name tok-value start-pos end-pos)
(raise-syntax-error
'assoc-list-parser
(format
(if tok-ok?
"Did not expect token ~a"
"Invalid token ~a")
tok-name)
(datum->syntax #f tok-value (make-srcloc start-pos end-pos)))))))
(define (do-parse str) (define (do-parse str)
(with-handlers ([exn:fail? (with-handlers ([exn:fail?
(λ (e) empty)]) (λ (e) empty)])
(let ([ip (open-input-string str)]) (with-input-from-string
(dynamic-wind str
void (λ ()
(λ () (raw->cookies (assoc-list-parser (λ () (cookie-lexer ip))))) (let ([ip (current-input-port)])
(λ () (close-input-port ip)))))) (port-count-lines! 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)