Skip to content

Commit 666889c

Browse files
LiberalArtistLiberalArtist
committed
Added test for RFC 6265 cookies
1 parent 7974d4d commit 666889c

File tree

6 files changed

+302
-96
lines changed

6 files changed

+302
-96
lines changed

‎web-server-doc/info.rkt‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,7 @@
33
(define collection 'multi)
44

55
(define build-deps '("net-doc"
6+
"net-cookies"
67
"rackunit-doc"
78
"compatibility-doc"
89
"db-doc"

‎web-server-doc/web-server/scribblings/http.scrbl‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -294,10 +294,11 @@ transmission that the server @bold{will not catch}.}
294294
Constructs a cookie with the appropriate fields.
295295

296296
This is a wrapper around @racket[make-cookie] from @racketmodname[net/cookies/server]
297-
for backwords compatability. The @racket[comment] argument is ignored.
297+
for backwards compatability. The @racket[comment] argument is ignored.
298298
If @racket[expires] is given as a string, it should match
299299
@link["https://tools.ietf.org/html/rfc7231#section-7.1.1.2"]{RFC 7231, Section 7.1.1.2},
300300
in which case it will be converted to a @racket[date?] value.
301+
If conversion fails, an @racket[exn:fail:contract?] is raised.
301302
}
302303

303304
@defproc[(cookie->header [c cookie?]) header?]{
@@ -401,7 +402,7 @@ available (@racket[make-secret-salt/file]),
401402
@defproc*[([(request-id-cookie [request request?]
402403
[#:name name (and/c string? cookie-name?)]
403404
[#:key secret-salt bytes?]
404-
[#:timeout timeout +inf.0])
405+
[#:timeout timeout number? +inf.0])
405406
(or/c #f (and/c string? cookie-value?))]
406407
[(request-id-cookie [name (and/c string? cookie-name?)]
407408
[secret-salt bytes?]

‎web-server-lib/web-server/http/cookie-parse.rkt‎

Lines changed: 9 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,8 @@
33
(require web-server/http/request-structs
44
net/cookies/common
55
net/cookies/server
6-
web-server/private/util
6+
web-server/private/util
7+
racket/match
78
racket/contract)
89

910
(provide (contract-out
@@ -20,6 +21,12 @@
2021
(name value domain path)
2122
#:prefab)
2223

24+
(define handle-quoted-value
25+
(match-lambda
26+
[(regexp #rx"^\"(.*)\"$" (list _ inner))
27+
inner]
28+
[val val]))
29+
2330
(define (request-cookies req)
2431
(for/fold ([cookies-so-far null])
2532
([this-header (in-list (request-headers/raw req))]
@@ -29,6 +36,6 @@
2936
(for/list ([pr (in-list (cookie-header->alist
3037
(header-value this-header)))])
3138
(client-cookie (bytes->string/utf-8 (car pr))
32-
(bytes->string/utf-8 (cdr pr))
39+
(handle-quoted-value (bytes->string/utf-8 (cdr pr)))
3340
#f
3441
#f)))))

‎web-server-lib/web-server/http/cookie.rkt‎

Lines changed: 21 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -65,27 +65,30 @@
6565
(app string->number hour)
6666
(app string->number min)
6767
(app string->number sec)))
68-
(seconds->date
69-
(find-seconds sec min hour day
70-
(case month-str
71-
[("Jan") 1]
72-
[("Feb") 2]
73-
[("Mar") 3]
74-
[("Apr") 4]
75-
[("May") 5]
76-
[("Jun") 6]
77-
[("Jul") 7]
78-
[("Aug") 8]
79-
[("Sep") 9]
80-
[("Oct") 10]
81-
[("Nov") 11]
82-
[("Dec") 12])
83-
year
84-
#f))]
68+
(with-handlers ([exn:fail? (λ (e) (failure-cont))])
69+
(seconds->date
70+
(find-seconds sec min hour day
71+
(case month-str
72+
[("Jan") 1]
73+
[("Feb") 2]
74+
[("Mar") 3]
75+
[("Apr") 4]
76+
[("May") 5]
77+
[("Jun") 6]
78+
[("Jul") 7]
79+
[("Aug") 8]
80+
[("Sep") 9]
81+
[("Oct") 10]
82+
[("Nov") 11]
83+
[("Dec") 12])
84+
year
85+
#f)
86+
#f))]
8587
[_ (raise-arguments-error
8688
'make-cookie*
8789
"invalid #:expires string"
88-
'expected "#f, a date?, or a string conforming to RFC 7231 Section 7.1.1.2"
90+
'expected
91+
"#f, a date?, or a string conforming to RFC 7231 Section 7.1.1.2"
8992
'given exp-date/raw)])]
9093
[else exp-date/raw])))
9194

‎web-server-lib/web-server/http/id-cookie.rkt‎

Lines changed: 16 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -19,15 +19,15 @@
1919
bytes?)]
2020
[logout-id-cookie
2121
(->* [(and/c string? cookie-name?)]
22-
[#:path (or/c path/extension-value? #f)
23-
#:domain (or/c domain-value? #f)]
24-
cookie?)]
22+
[#:path (or/c path/extension-value? #f)
23+
#:domain (or/c domain-value? #f)]
24+
cookie?)]
2525
[valid-id-cookie?
26-
(-> any/c
27-
#:name (and/c string? cookie-name?)
28-
#:key bytes?
29-
#:timeout number?
30-
(or/c #f (and/c string? cookie-value?)))]
26+
(->* [any/c
27+
#:name (and/c string? cookie-name?)
28+
#:key bytes?]
29+
[#:timeout number?]
30+
(or/c #f (and/c string? cookie-value?)))]
3131
[request-id-cookie
3232
(->i ([name-or-req {kw-name}
3333
(if (unsupplied-arg? kw-name)
@@ -111,8 +111,8 @@
111111
)
112112
(define-values {data key}
113113
(if maybe-key
114-
(values maybe-key data-or-key)
115-
(values data-or-key maybe-data)))
114+
(values data-or-key maybe-key)
115+
(values maybe-data data-or-key)))
116116
(define authored (current-seconds))
117117
(define digest
118118
(mac key (list authored data)))
@@ -131,7 +131,7 @@
131131
(define (valid-id-cookie? c
132132
#:name name
133133
#:key key
134-
#:timeout timeout)
134+
#:timeout [timeout +inf.0])
135135
(and (id-cookie? name c)
136136
(with-handlers ([exn:fail? (lambda (x) #f)])
137137
(match (if (client-cookie? c)
@@ -158,11 +158,11 @@
158158
(let ([name (or kw-name name-or-req)]
159159
[key (or kw-key maybe-key)]
160160
[req (or maybe-req name-or-req)])
161-
(for/or ([c (in-list (request-cookies req))])
162-
(valid-id-cookie? c
163-
#:name name
164-
#:key key
165-
#:timeout timeout))))
161+
(for/or ([c (in-list (request-cookies req))])
162+
(valid-id-cookie? c
163+
#:name name
164+
#:key key
165+
#:timeout timeout))))
166166

167167
(define (logout-id-cookie name
168168
#:path [path #f]

0 commit comments

Comments
 (0)