[racket] Cookie Indigestion

From: J G Cho (gcho at fundingmatters.com)
Date: Wed May 18 04:23:01 EDT 2011

Hello, back with more questions about Web-Server doc.

I am going over HTTP Cookie section. Per recommendation, read MIT
Cookie Eaters paper. I am left with impression that I am to use

exp=t&data=s&digest=MAC(exp=t&data=s)

as an authenticator Cookie after a valid login.

So I am trying out with something similar:

time=t&id=joseph
where t is (number->string (current-seconds))

I am finding that I can read and write cookies as long as key and
values are run-of-the-mill string. But when I try to add digest I run
into trouble reading it back.

Here is the code that I am least sure about:

(define (make-digest s1 s2)
  (bytes->string/utf-8
  (base64-encode
   (HMAC-SHA1 (string->bytes/utf-8 s1)
              (string->bytes/utf-8 s2)))))

I then use it to make a cookie like:

  (define digest
    (make-digest "saltycracker" (string-append "time" time "id" "joseph")))

  (define digest-cookie
    (make-cookie "digest" digest))

Writing it out seems to go okay but when I try to read it back, I am
greeted with:

lexer: No match found in input starting with: "WFs1fa0jLTOXqiLG08EtBq1wNYI=

Stack Trace:

raise-read-error at:
  line 6, column 2, in file
/Users/jgc/Lisp/Racket5.1/collects/syntax/readerr.rkt
lexer-loop at:
  line 246, column 21, in file
/Users/jgc/Lisp/Racket5.1/collects/parser-tools/lex.rkt
parsing-loop at:
  line 326, column 16, in file
/Users/jgc/Lisp/Racket5.1/collects/parser-tools/yacc.rkt
<unknown procedure> at:
  line 117, column 4, in file
/Users/jgc/Lisp/Racket5.1/collects/web-server/http/cookie-parse.rkt
map at:
  line 18, column 11, in file
/Users/jgc/Lisp/Racket5.1/collects/racket/private/map.rkt
request-cookies at:
  line 139, column 0, in file
/Users/jgc/Lisp/Racket5.1/collects/web-server/http/cookie-parse.rkt
cookie-named at:
  line 52, column 2, in file /Users/jgc/Lisp/adhoc/cookie.rkt
extract-auth-cookies at:
  line 51, column 0, in file /Users/jgc/Lisp/adhoc/cookie.rkt
read-cookie at:
  line 96, column 0, in file /Users/jgc/Lisp/adhoc/cookie.rkt
<unknown procedure> at:
  line 58, column 2, in file
/Users/jgc/Lisp/Racket5.1/collects/web-server/dispatchers/dispatch-servlets.rkt
select-handler/no-breaks at:
  line 164, column 2, in file
/Users/jgc/Lisp/Racket5.1/collects/racket/private/more-scheme.rkt
select-handler/no-breaks at:
  line 164, column 2, in file
/Users/jgc/Lisp/Racket5.1/collects/racket/private/more-scheme.rkt
connection-loop at:
  line 74, column 2, in file
/Users/jgc/Lisp/Racket5.1/collects/web-server/private/dispatch-server-unit.rkt

Here is the source code:

#lang racket

(require web-server/servlet
         web-server/dispatch)

(define-values (handle-if-url-match hanlder->url)
  (dispatch-rules
   [("") say-hello]
   [("write") write-cookie]
   [("read") read-cookie]))

(define (say-hello req)
  (response/xexpr
   `(html (head (title "Hello world!"))
          (body (p
                 (a ([href "/write"])
                    "write cookie"))
                (p
                 (a ([href "/read"])
                    "read cookie"))))))

(require web-server/stuffers/hmac-sha1)
(require net/base64)

(define (make-digest s1 s2)
  (bytes->string/utf-8
  (base64-encode
   (HMAC-SHA1 (string->bytes/utf-8 s1)
              (string->bytes/utf-8 s2)))))

(define (make-auth-cookies)
  (define time
    (number->string (current-seconds)))
  (define time-cookie
    (make-cookie "time" time))
  (define id-cookie
    (make-cookie "id" "joseph"))

  (define digest
    (make-digest "saltycracker" (string-append "time" time "id" "joseph")))

  (define digest-cookie
    (make-cookie "digest" digest))


  (list time-cookie id-cookie digest-cookie))


; auth cookie if valid
; #f otherwise
(define (extract-auth-cookies req)
  (define (cookie-named name-string)
    (findf (λ (cookie)
             (string=? name-string (client-cookie-name cookie)))
           (request-cookies req)))

  (define time-cookie
    (cookie-named "time"))
  (define time-val
    (client-cookie-value time-cookie))
  (define id-cookie
    (cookie-named "id"))
  (define id-val
    (client-cookie-value id-cookie))
    (define digest-cookie
      (cookie-named "digest"))
    (define digest-val
      (client-cookie-value digest-cookie))

  (define (expired?)
    (< (+ (* 60) (string->number time-val))
       (current-seconds)))

    (define (tempered?)
      (not (equal? digest-val
                   (make-digest "saltycracker" (string-append "time"
time-val "id" id-val)))))

  (cond [(expired?) #f]
        ;[(tempered?) #f]
        [else
         id-val]))

(define (auth req)
  (extract-auth-cookies req))

(define (place-auth-cookie-then-redirect-to where-to)
  (redirect-to where-to
               see-other
               #:headers
               (map cookie->header
                    (make-auth-cookies))))

(define (write-cookie req)
  (place-auth-cookie-then-redirect-to "/"))

(define (read-cookie req)
  (define auth-data
    (auth req))
  (if auth-data
      (response/xexpr
       `(html (head (title "Read Cookie"))
              (body (p ,auth-data))))
      (response/xexpr
       `(html (head (title "Read Cookie"))
              (body (p "Cookie gone bad"))))))

(define (start request)
  (handle-if-url-match request))

(require web-server/servlet-env)
(serve/servlet start
               #:command-line? #t
               #:launch-browser? #t
               #:quit? #t
               #:listen-ip #f
               #:port 8080
               #:log-file "log"
               #:extra-files-paths (list (build-path
"/Users/jgc/Lisp/addhoc" "htdocs"))
               #:servlet-path "/"
               #:servlet-regexp #rx"")

Any help would be appreciated.

jGc

PS: Thanks for all the help w.r.t. checked=checked hint. (I would've
never though of it since I think it looks kinda weird. I don't usually
do things like true=true false=false, etc.)



Posted on the users mailing list.