Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
33 changes: 26 additions & 7 deletions web-server-doc/web-server/scribblings/http.scrbl
Original file line number Diff line number Diff line change
Expand Up @@ -344,7 +344,7 @@ This module provides functions for creating and verifying
authenticated cookies that are intrinsically timestamped. It is based
on the algorithm proposed by the
@link["https://pdos.csail.mit.edu/archive/cookies/"]{MIT Cookie Eaters}: if you store
the data @racket[_data] at thime @racket[_authored-seconds], then the
the data @racket[_data] at time @racket[_authored-seconds], then the
user will receive @litchar{digest&authored-seconds&data}, where
@racket[_digest] is an HMAC-SHA1 digest of @racket[_authored-seconds]
and @racket[_data], using an arbitrary secret key. When you receive a
Expand Down Expand Up @@ -402,32 +402,51 @@ available (@racket[make-secret-salt/file]),
@defproc*[([(request-id-cookie [request request?]
[#:name name (and/c string? cookie-name?)]
[#:key secret-salt bytes?]
[#:timeout timeout number? +inf.0])
[#:timeout timeout real? +inf.0]
[#:shelf-life shelf-life real? +inf.0])
(or/c #f (and/c string? cookie-value?))]
[(request-id-cookie [name (and/c string? cookie-name?)]
[secret-salt bytes?]
[request request?]
[#:timeout timeout number? +inf.0])
[#:timeout timeout number? +inf.0]
[#:shelf-life shelf-life real? +inf.0])
(or/c #f (and/c string? cookie-value?))])]{
Extracts the first authenticated cookie named @racket[name]
that was previously signed with @racket[secret-salt]
before @racket[timeout] from @racket[request].
from @racket[request], with the allowable age of the cookie
is controlled by @racket[shelf-life] and @racket[timeout] as with
@racket[valid-id-cookie?].

If no valid cookie is available, returns @racket[#f].
}

@defproc[(valid-id-cookie? [cookie any/c]
[#:name name (and/c string? cookie-name?)]
[#:key secret-salt bytes?]
[#:timeout timeout number? +inf.0])
[#:timeout timeout number? +inf.0]
[#:shelf-life shelf-life real? +inf.0])
(or/c #f (and/c string? cookie-value?))]{
Recognizes authenticated cookies named @racket[name] that were
previously signed with @racket[secret-salt]
before @racket[timeout]. Values satisfying either @racket[cookie?]
previously signed with @racket[secret-salt].
Values satisfying either @racket[cookie?]
or @racket[client-cookie?] can be recognized.

The @racket[shelf-life] specifies the maximum age of the cookie
in seconds. Cookies created more than @racket[shelf-life] seconds
ago will not be considered valid.
The default value, @racket[+inf.0], permits all properly named and
signed cookies.

Counterintuitively,
the @racket[timeout] argument requires that the cookie have been
created @italic{before} a certain moment in time: in other words,
it requires that the cookie be @italic{older} than a certain age.
This is not usually what you want to restrict.
Specifically, @racket[valid-id-cookie?] tests that
@racket[(authored . <= . timeout)], where @racket[authored] is the
value returned by @racket[(current-seconds)] when the cookie was created.
The default value, @racket[+inf.0], permits all properly named and
signed cookies.
}

@defproc[(logout-id-cookie [name cookie-name?]
Expand Down
31 changes: 18 additions & 13 deletions web-server-lib/web-server/http/id-cookie.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -26,7 +26,8 @@
(->* [any/c
#:name (and/c string? cookie-name?)
#:key bytes?]
[#:timeout number?]
[#:timeout real?
#:shelf-life real?]
(or/c #f (and/c string? cookie-value?)))]
[request-id-cookie
(->i ([name-or-req {kw-name}
Expand All @@ -37,7 +38,8 @@
[maybe-req request?]
#:name [kw-name (and/c string? cookie-name?)]
#:key [kw-key bytes?]
#:timeout [timeout number?])
#:timeout [timeout number?]
#:shelf-life [shelf-life real?])
#:pre/desc {maybe-key maybe-req kw-name kw-key}
(let ([maybe-key/un (unsupplied-arg? maybe-key)]
[maybe-req/un (unsupplied-arg? maybe-req)]
Expand Down Expand Up @@ -131,18 +133,21 @@
(define (valid-id-cookie? c
#:name name
#:key key
#:timeout [timeout +inf.0])
#:timeout [timeout +inf.0]
#:shelf-life [shelf-life +inf.0])
(and (id-cookie? name c)
(with-handlers ([exn:fail? (lambda (x) #f)])
(match (if (client-cookie? c)
(client-cookie-value c)
(cookie-value c))
[(regexp #rx"^(.+)&(.+)&(.*)$"
(list _
digest
(app string->number authored)
data))
(and (authored . <= . timeout)
[(pregexp #px"^(.+)&(\\d+)&(.*)$"
(list _
digest
(app string->number authored)
data))
(and [authored . <= . timeout]
[shelf-life . >= . (- (current-seconds)
authored)]
(let ([re-digest (mac key (list authored data))])
(string=? digest re-digest))
data)]
Expand All @@ -154,15 +159,17 @@
[maybe-req #f]
#:name [kw-name #f]
#:key [kw-key #f]
#:timeout [timeout +inf.0])
#:timeout [timeout +inf.0]
#:shelf-life [shelf-life +inf.0])
(let ([name (or kw-name name-or-req)]
[key (or kw-key maybe-key)]
[req (or maybe-req name-or-req)])
(for/or ([c (in-list (request-cookies req))])
(valid-id-cookie? c
#:name name
#:key key
#:timeout timeout))))
#:timeout timeout
#:shelf-life shelf-life))))

(define (logout-id-cookie name
#:path [path #f]
Expand All @@ -175,5 +182,3 @@
#f)
#:path path
#:domain domain))


25 changes: 18 additions & 7 deletions web-server-test/tests/web-server/http/cookies-test.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -294,7 +294,7 @@
(list (header #"Cookie"
#"my-id-cookie=YmFLLOIDULjpLQOu1+cvMBM+m&1489023629&my-signed-value"))
(delay empty) #f "host" 80 "client"))
(test-not-false "infinite timeout"
(test-not-false "infinite timeout & shelf life"
(request-id-cookie req
#:name "my-id-cookie"
#:key test-secret-salt))
Expand All @@ -304,19 +304,30 @@
#:key test-secret-salt
#:timeout (current-seconds)))
(test-not-false "finite timeout / by position"
(request-id-cookie req
#:name "my-id-cookie"
#:key test-secret-salt
#:timeout (current-seconds)))
(test-false "reject expired"
(request-id-cookie "my-id-cookie"
test-secret-salt
req
#:timeout (current-seconds)))
(test-false "timeout / reject expired"
(request-id-cookie req
#:name "my-id-cookie"
#:key test-secret-salt
#:timeout 1089023629))
(test-equal? "long finite shelf-life"
(request-id-cookie req
#:name "my-id-cookie"
#:key test-secret-salt
#:shelf-life 500)
"test-value")
(test-false "shelf-life / reject expired"
(request-id-cookie req
#:name "my-id-cookie"
#:key test-secret-salt
#:shelf-life -10))
))))))


(module+ test
(require rackunit/text-ui)
(run-tests cookies-tests))