((( [logo]Racket )))Need Help?
AboutDownloadDocumentationPLaneTCommunityLearning

[plt-scheme] cookies in plt web server

From: Daniel Pinto de Mello e Silva (daniel.silva at gmail.com)
Date: Fri Jan 14 13:09:48 EST 2005		 
On Fri, 14 Jan 2005 11:59:26 -0500, Larry White <ljw1001 at gmail.com> wrote:
> I understand that one can set cookies in the plt web-server using
> "extras" in make-response/full, but that seems to be as far as the
> documentation goes.  Does anyone have an example of setting and
> reading cookies that they would pass along?

Fill in lookup-pw, uid->sid, save-sid!, and lookup-uid for your database.


  ; start : request -> response
  (define (start initial-request)
    (define uid (request->uid initial-request))
    (cond
      [uid `(html (body "Already logged in."))]
      [(let ([b (request-bindings initial-request)])
         (login (extract-binding/single 'user b)
(extract-binding/single 'password b)))
       =>
       (lambda (session-id)
         (make-response/full 200 "OK" (current-seconds) #"text/html"
             `((Set-Cookie . ,(print-cookie (cookie:add-path
(set-cookie "session"
                                                            session-id)
                                                            "/"))))
                  (list "<html><body>Logged in.</body></html>")))]
      [else `(html (body "Login incorrect."))]))



  (define (login user pw)
    (define uid (lookup-uid user))
    (and uid
         (string=? pw (lookup-pw uid))
         (generate-session-id uid)))

  (define (generate-session-id uid)
    (define sid (format "~a~a" (gensym (lookup-username uid)) (random 3000)))
    (save-sid! uid sid)
    sid)

  ;; if the request has a valid UID and SID, then return the UID
  ;; else return false
  (define (request->uid request)
    (define-values (uid sid) (request->uid&sid request))
    (define saved-sid (uid->sid uid))
    (and saved-sid
         (string=? sid saved-sid)
         uid))

(require (rename (lib "request-parsing.ss" "web-server")
                           request-headers request-headers))

  (define (request->uid&sid request)
    (cond
      [(assq 'cookie (request-headers request))
       => (match-lambda
            [(list-rest 'cookie cookies)
             (let ([c (bytes->string/utf-8 cookies)])
               (values (get-cookie/single "uid" c)
                       (get-cookie/single "session" c)))])]
      [else (values #f #f)]))


Daniel
Posted on the users mailing list.