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.)
_________________________________________________
For list-related administrative tasks:
http://lists.racket-lang.org/listinfo/users
