Adds a #:shelf-life argument to valid-id-cookie?

and `request-id-cookie`.

The current `#:timeout` argument does something counterintuitive:
it requires that the cookie have been created *before* a certain
moment in time, effectively specifying a *minimum* age.

The new `#:shelf-life` argument supports specifying a maximum age.

Author: LiberalArtist

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

@@ -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
@@ -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?]

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

@@ -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}
@@ -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)]
@@ -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)]
@@ -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]
@@ -175,5 +182,3 @@
                               #f)
                #:path path
                #:domain domain))
-
-

web-server-test/tests/web-server/http/cookies-test.rkt

@@ -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))
@@ -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))
-  
+