suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Require session to be same servlet; Fixing bug with cms

Browse Source 
svn: r6354
This commit is contained in:
Jay McCarthy 2007-05-28 17:07:55 +00:00
parent e961db90de
commit 4a67abe8eb
2 changed files with 36 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

58
collects/web-server/prototype-web-server/dispatch-servlets2.ss
View File

@ -20,7 +20,7 @@
(provide make)
(define myprint printf #;(lambda _ (void)))
(define myprint #;printf (lambda _ (void)))
(define top-cust (current-custodian))
@ -45,15 +45,15 @@
(string->number n)]
[_
#f]))))
(define make-servlet-namespace
(make-make-servlet-namespace
#:to-be-copied-module-specs
'(mzscheme
(lib "web-cells.ss" "web-server" "prototype-web-server" "lang-api")
(lib "abort-resume.ss" "web-server" "prototype-web-server" "private")
(lib "session.ss" "web-server" "prototype-web-server" "private")
(lib "request.ss" "web-server" "private"))))
(lib "web-cells.ss" "web-server" "prototype-web-server" "lang-api")
(lib "abort-resume.ss" "web-server" "prototype-web-server" "private")
(lib "session.ss" "web-server" "prototype-web-server" "private")
(lib "request.ss" "web-server" "private"))))
(define/kw (make #:key
[servlet-root "servlets"]
@ -107,6 +107,8 @@
[else
(begin-session conn req)]))))))
;; XXX Currently there are just sessions, should be servlets and sessions
;; begin-session: connection request
(define (begin-session conn req)
(myprint "begin-session~n")
@ -124,11 +126,8 @@
[current-session ses])
(let ([module-name `(file ,(path->string a-path))])
(myprint "dynamic-require ...~n")
(with-handlers ([exn:fail:contract?
(lambda _
(dynamic-require module-name #f))])
(let ([start (dynamic-require module-name 'start)])
(run-start start-servlet start)))))
(let ([start (dynamic-require module-name 'start)])
(run-start start-servlet start))))
(myprint "resume-session~n")
(resume-session (session-id ses)
conn req)))
@ -137,27 +136,38 @@
(responders-file-not-found uri)
(request-method req))))))
; same-servlet? : url? url? -> boolean?
(define (same-servlet? u v)
(define (abstract-url u)
(path->string
(apply build-path
(map path/param-path
(url-path u)))))
(string=? (abstract-url u)
(abstract-url v)))
;; resume-session: number connection request
(define (resume-session ses-id conn req)
; XXX Check if session is for same servlet!
(myprint "resume-session: ses-id = ~s~n" ses-id)
(cond
[(lookup-session ses-id)
=> (lambda (ses)
(parameterize ([current-custodian (session-cust ses)]
[current-session ses])
(with-handlers ([void
(lambda (the-exn)
(output-response/method
conn
(responders-servlet (request-uri req) the-exn)
(request-method req)))])
#;(printf "session-handler ~S~n" (session-handler ses))
(output-response conn
((session-handler ses) req)))))]
(if (same-servlet? (request-uri req)
(session-url ses))
(parameterize ([current-custodian (session-cust ses)]
[current-session ses])
(with-handlers ([void
(lambda (the-exn)
(output-response/method
conn
(responders-servlet (request-uri req) the-exn)
(request-method req)))])
#;(printf "session-handler ~S~n" (session-handler ses))
(output-response conn
((session-handler ses) req))))
(begin-session conn req)))]
[else
(myprint "resume-session: Unknown ses~n")
;; TODO: should just start a new session here.
(begin-session conn req)]))
dispatch))

4
collects/web-server/prototype-web-server/private/abort-resume.ss
View File

@ -101,9 +101,9 @@
(match f
[(vector f #f)
(rebuild-cms fs thunk)]
[(vector #f (list))
[(vector f (list))
(rebuild-cms fs thunk)]
[(vector #f (list-rest (list-rest cm-key cm-val) cms))
[(vector f (list-rest (list-rest cm-key cm-val) cms))
(with-continuation-mark cm-key cm-val
(begin
#;(printf "rcm: w-c-m ~S ~S~n" cm-key cm-val)