diff --git a/collects/web-server/prototype-web-server/dispatch-servlets2.ss b/collects/web-server/prototype-web-server/dispatch-servlets2.ss index 5a25575d7b..3f4eb50b84 100644 --- a/collects/web-server/prototype-web-server/dispatch-servlets2.ss +++ b/collects/web-server/prototype-web-server/dispatch-servlets2.ss @@ -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)) \ No newline at end of file diff --git a/collects/web-server/prototype-web-server/lang-api.ss b/collects/web-server/prototype-web-server/lang-api.ss index 61bdd6170b..f0504269cd 100644 --- a/collects/web-server/prototype-web-server/lang-api.ss +++ b/collects/web-server/prototype-web-server/lang-api.ss @@ -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") diff --git a/collects/web-server/prototype-web-server/lang-api/web-extras.ss b/collects/web-server/prototype-web-server/lang-api/web-extras.ss index 305a71280a..dd0f0b0fed 100644 --- a/collects/web-server/prototype-web-server/lang-api/web-extras.ss +++ b/collects/web-server/prototype-web-server/lang-api/web-extras.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) diff --git a/collects/web-server/prototype-web-server/private/session.ss b/collects/web-server/prototype-web-server/private/session.ss index 264b90fed8..e35f517079 100644 --- a/collects/web-server/prototype-web-server/private/session.ss +++ b/collects/web-server/prototype-web-server/private/session.ss @@ -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) diff --git a/collects/web-server/prototype-web-server/private/web.ss b/collects/web-server/prototype-web-server/private/web.ss index 0fd2db97e2..f4ac30436f 100644 --- a/collects/web-server/prototype-web-server/private/web.ss +++ b/collects/web-server/prototype-web-server/private/web.ss @@ -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)