Fiddling with requires
svn: r6388
This commit is contained in:
Jay McCarthy
parent
31d07ed30e
commit
861a1c1ef5
|
|
@ -1,18 +1,17 @@
|
|||
(module dispatch-servlets2 mzscheme
|
||||
(require (lib "kw.ss")
|
||||
(lib "contract.ss")
|
||||
(lib "connection-manager.ss" "web-server" "private")
|
||||
(lib "request-structs.ss" "web-server")
|
||||
(lib "response-structs.ss" "web-server")
|
||||
(lib "response.ss" "web-server" "private")
|
||||
(lib "util.ss" "web-server" "private")
|
||||
(lib "url.ss" "net")
|
||||
(lib "plt-match.ss")
|
||||
(lib "dispatch.ss" "web-server" "dispatchers")
|
||||
(lib "request-structs.ss" "web-server")
|
||||
(lib "session.ss" "web-server" "prototype-web-server" "private")
|
||||
(only "private/web.ss"
|
||||
initialize-servlet)
|
||||
(lib "web-cells.ss" "web-server" "prototype-web-server" "lang-api")
|
||||
"../dispatchers/dispatch.ss"
|
||||
"../private/connection-manager.ss"
|
||||
"../private/util.ss"
|
||||
"../private/response.ss"
|
||||
"../private/configuration.ss"
|
||||
"private/utils.ss")
|
||||
|
||||
|
|
@ -20,8 +19,6 @@
|
|||
[interface-version dispatcher-interface-version?])
|
||||
(provide make)
|
||||
|
||||
(define myprint printf #;(lambda _ (void)))
|
||||
|
||||
(define top-cust (current-custodian))
|
||||
|
||||
(define make-servlet-namespace
|
||||
|
|
@ -46,40 +43,29 @@
|
|||
|
||||
;; dispatch : connection request -> void
|
||||
(define (dispatch conn req)
|
||||
(define uri (request-uri req))
|
||||
(adjust-connection-timeout! conn timeouts-servlet-connection)
|
||||
;; XXX - make timeouts proportional to size of bindings
|
||||
(myprint "servlet-content-producer~n")
|
||||
(let ([meth (request-method req)])
|
||||
(if (eq? meth 'head)
|
||||
(output-response/method
|
||||
conn
|
||||
(make-response/full
|
||||
200 "Okay" (current-seconds) TEXT/HTML-MIME-TYPE
|
||||
'() (list "ignored"))
|
||||
meth)
|
||||
(let ([uri (request-uri req)])
|
||||
(with-handlers ([void
|
||||
(lambda (the-exn)
|
||||
(output-response/method
|
||||
conn
|
||||
(responders-servlet-loading uri the-exn)
|
||||
(request-method req)))])
|
||||
(cond
|
||||
[(extract-session uri)
|
||||
=> (lambda (session-id)
|
||||
(resume-session session-id conn req))]
|
||||
[else
|
||||
(begin-session conn req)]))))))
|
||||
(with-handlers ([void
|
||||
(lambda (the-exn)
|
||||
(output-response/method
|
||||
conn
|
||||
(responders-servlet-loading uri the-exn)
|
||||
(request-method req)))])
|
||||
(cond
|
||||
[(extract-session uri)
|
||||
=> (lambda (session-id)
|
||||
(resume-session session-id conn req))]
|
||||
[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")
|
||||
(let ([uri (request-uri req)])
|
||||
(let-values ([(a-path url-servlet-path url-path-suffix)
|
||||
(url->servlet-path htdocs-path uri)])
|
||||
(myprint "a-path = ~s~n" a-path)
|
||||
(if a-path
|
||||
(parameterize ([current-directory (directory-part a-path)])
|
||||
(let* ([cust (make-custodian top-cust)]
|
||||
|
|
@ -89,11 +75,9 @@
|
|||
[current-namespace ns]
|
||||
[current-session ses])
|
||||
(let ([module-name `(file ,(path->string a-path))])
|
||||
(myprint "dynamic-require ...~n")
|
||||
(let ([start (dynamic-require module-name 'start)])
|
||||
(set-session-servlet! ses
|
||||
(initialize-servlet start)))))
|
||||
(myprint "resume-session~n")
|
||||
(resume-session (session-id ses)
|
||||
conn req)))
|
||||
(output-response/method
|
||||
|
|
@ -120,12 +104,11 @@
|
|||
(if (string=? s r)
|
||||
(loop rp sp)
|
||||
#f)])])))
|
||||
(myprint "~S => ~S~n" `(same-servlet? ,(url->string req) ,(url->string ses)) ans)
|
||||
#;(printf "~S => ~S~n" `(same-servlet? ,(url->string req) ,(url->string ses)) ans)
|
||||
ans)
|
||||
|
||||
;; resume-session: number connection request
|
||||
(define (resume-session ses-id conn req)
|
||||
(myprint "resume-session: ses-id = ~s~n" ses-id)
|
||||
(cond
|
||||
[(lookup-session ses-id)
|
||||
=> (lambda (ses)
|
||||
|
|
@ -138,12 +121,10 @@
|
|||
conn
|
||||
(responders-servlet (request-uri req) the-exn)
|
||||
(request-method req)))])
|
||||
(myprint "session-handler ~S~n" (session-servlet ses))
|
||||
(output-response conn
|
||||
((session-servlet ses) req))))
|
||||
(begin-session conn req)))]
|
||||
[else
|
||||
(myprint "resume-session: Unknown ses~n")
|
||||
(begin-session conn req)]))
|
||||
|
||||
dispatch))
|
||||
|
|
@ -1,7 +1,7 @@
|
|||
(module lang-api mzscheme
|
||||
(require (lib "request-structs.ss" "web-server")
|
||||
(lib "response-structs.ss" "web-server")
|
||||
(lib "url.ss" "net")
|
||||
(require (lib "url.ss" "net")
|
||||
"../request-structs.ss"
|
||||
"../response-structs.ss"
|
||||
"private/abort-resume.ss"
|
||||
"private/web.ss"
|
||||
"lang-api/web-cells.ss"
|
||||
|
|
@ -9,9 +9,9 @@
|
|||
"lang-api/file-box.ss"
|
||||
"lang-api/web-extras.ss")
|
||||
(provide (all-from-except mzscheme #%module-begin)
|
||||
(all-from (lib "request-structs.ss" "web-server"))
|
||||
(all-from (lib "response-structs.ss" "web-server"))
|
||||
(all-from (lib "url.ss" "net"))
|
||||
(all-from "../request-structs.ss")
|
||||
(all-from "../response-structs.ss")
|
||||
(all-from "private/abort-resume.ss")
|
||||
(all-from "private/web.ss")
|
||||
(all-from "lang-api/web-cells.ss")
|
||||
|
|
|
|||
|
|
@ -3,9 +3,9 @@
|
|||
(lib "etc.ss")
|
||||
(lib "plt-match.ss")
|
||||
(lib "base64.ss" "net")
|
||||
(lib "request-structs.ss" "web-server")
|
||||
(lib "response-structs.ss" "web-server")
|
||||
(lib "url.ss" "net")
|
||||
"../../request-structs.ss"
|
||||
"../../response-structs.ss"
|
||||
"../private/web.ss")
|
||||
(provide send/suspend/dispatch
|
||||
redirect/get)
|
||||
|
|
|
|||
|
|
@ -1,8 +1,8 @@
|
|||
(module session mzscheme
|
||||
(require (lib "contract.ss")
|
||||
(lib "url.ss" "net")
|
||||
(lib "request-structs.ss" "web-server")
|
||||
(lib "response.ss" "web-server")
|
||||
"../../response.ss"
|
||||
"../../request-structs.ss"
|
||||
"url-param.ss")
|
||||
(provide current-session)
|
||||
|
||||
|
|
@ -48,7 +48,7 @@
|
|||
;; encode-session : url number -> url
|
||||
(define (encode-session a-url ses-id)
|
||||
(insert-param a-url "s" (number->string ses-id)))
|
||||
|
||||
|
||||
;; extract-session : url -> (union number #f)
|
||||
;; Determine if the url encodes a session-id and extract it
|
||||
(define (extract-session a-url)
|
||||
|
|
|
|||
|
|
@ -2,9 +2,8 @@
|
|||
(require (lib "serialize.ss")
|
||||
(lib "plt-match.ss")
|
||||
(lib "url.ss" "net")
|
||||
(lib "request-structs.ss" "web-server")
|
||||
(rename "abort-resume.ss" send/suspend0 send/suspend)
|
||||
(all-except "abort-resume.ss" send/suspend)
|
||||
"../../request-structs.ss"
|
||||
"abort-resume.ss"
|
||||
"session.ss"
|
||||
"stuff-url.ss"
|
||||
"url-param.ss")
|
||||
|
|
@ -37,7 +36,7 @@
|
|||
;; send/suspend/hidden: (url input-field -> response) -> request
|
||||
;; like send/suspend except the continuation is encoded in a hidden field
|
||||
(define (send/suspend/hidden page-maker)
|
||||
(send/suspend0
|
||||
(send/suspend
|
||||
(lambda (k)
|
||||
(let ([p-cont (serialize k)])
|
||||
(page-maker
|
||||
|
|
@ -47,7 +46,7 @@
|
|||
;; send/suspend/url: (url -> response) -> request
|
||||
;; like send/suspend except the continuation is encoded in the url
|
||||
(define (send/suspend/url page-maker)
|
||||
(send/suspend0
|
||||
(send/suspend
|
||||
(lambda (k)
|
||||
(page-maker
|
||||
(stuff-url (serialize k)
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user