From 411f6321fea8c90ac31c9cacd60e74da147a72d7 Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Sat, 8 Nov 2008 00:23:45 +0000 Subject: [PATCH] Cleaning up dispatch-servlets svn: r12349 --- .../web-server/dispatchers/dispatch-lang.ss | 14 +-- .../dispatchers/dispatch-servlets.ss | 117 +++++++----------- 2 files changed, 50 insertions(+), 81 deletions(-) diff --git a/collects/web-server/dispatchers/dispatch-lang.ss b/collects/web-server/dispatchers/dispatch-lang.ss index c806429af7..1de4927a5f 100644 --- a/collects/web-server/dispatchers/dispatch-lang.ss +++ b/collects/web-server/dispatchers/dispatch-lang.ss @@ -21,8 +21,8 @@ [make (->* (#:url->path url->path/c) (#:make-servlet-namespace make-servlet-namespace/c - #:responders-servlet-loading (url? any/c . -> . response?) - #:responders-servlet (url? any/c . -> . response?)) + #:responders-servlet-loading (url? any/c . -> . response?) + #:responders-servlet (url? any/c . -> . response?)) dispatcher/c)]) (define interface-version 'v1) @@ -30,9 +30,7 @@ #:make-servlet-namespace [make-servlet-namespace (make-make-servlet-namespace)] #:responders-servlet-loading [responders-servlet-loading servlet-loading-responder] #:responders-servlet [responders-servlet servlet-error-responder]) - - ;; dispatch : connection request -> void - (define (dispatch conn req) + (lambda (conn req) (define uri (request-uri req)) (with-handlers ([void (lambda (exn) (next-dispatcher))]) (define-values (a-path url-servlet-path) (url->path uri)) @@ -50,7 +48,7 @@ => (lambda (ses) ses)] [else (let () - (define cust (make-custodian (current-server-custodian))) + (define cust (make-servlet-custodian)) (define ns (make-servlet-namespace #:additional-specs '(web-server/lang/web-cells @@ -77,6 +75,4 @@ conn (responders-servlet uri the-exn) (request-method req)))]) - (output-response conn ((session-servlet ses) req))))))) - - dispatch) + (output-response conn ((session-servlet ses) req)))))))) \ No newline at end of file diff --git a/collects/web-server/dispatchers/dispatch-servlets.ss b/collects/web-server/dispatchers/dispatch-servlets.ss index be6fb6af0e..d96ae17a11 100644 --- a/collects/web-server/dispatchers/dispatch-servlets.ss +++ b/collects/web-server/dispatchers/dispatch-servlets.ss @@ -145,69 +145,18 @@ (define (make url->servlet #:responders-servlet-loading [responders-servlet-loading servlet-loading-responder] #:responders-servlet [responders-servlet servlet-error-responder]) - - ;; servlet-content-producer: connection request -> void - (define (servlet-content-producer conn req) - (define meth (request-method req)) + (lambda (conn req) (define uri (request-uri req)) - (cond - [(continuation-url? uri) - => (match-lambda - [(list instance-id k-id salt) - (invoke-servlet-continuation conn req instance-id k-id salt)])] - [else - (servlet-content-producer/path conn req uri)])) - - ;; servlet-content-producer/path: connection request url -> void - (define (servlet-content-producer/path conn req uri) - (define response - (with-handlers ([exn:fail:filesystem:exists? - (lambda (the-exn) (next-dispatcher))] - [(lambda (x) #t) - (lambda (the-exn) (responders-servlet-loading uri the-exn))]) - (call-with-continuation-prompt - (lambda () - (define instance-custodian (make-servlet-custodian)) - (parameterize ([current-custodian instance-custodian] - [exit-handler - (lambda _ - (kill-connection! conn) - (custodian-shutdown-all instance-custodian))]) - ;; any resources (e.g. threads) created when the - ;; servlet is loaded should be within the dynamic - ;; extent of the servlet custodian - (define the-servlet (url->servlet uri)) - (parameterize ([current-servlet the-servlet] - [current-directory (servlet-directory the-servlet)] - [current-namespace (servlet-namespace the-servlet)]) - (define manager (servlet-manager the-servlet)) - (parameterize ([current-execution-context (make-execution-context req)]) - (define instance-id ((manager-create-instance manager) (exit-handler))) - (parameterize ([current-servlet-instance-id instance-id]) - (with-handlers ([(lambda (x) #t) - (lambda (exn) - (responders-servlet - (request-uri req) - exn))]) - ((servlet-handler the-servlet) req))))))) - servlet-prompt))) - (output-response conn response)) - - (define (invoke-servlet-continuation conn req instance-id k-id salt) - (define uri (request-uri req)) - (define the-servlet (url->servlet uri)) - (define manager (servlet-manager the-servlet)) - (define response - (parameterize ([current-servlet the-servlet] - [current-directory (servlet-directory the-servlet)] - [current-servlet-instance-id instance-id] - [current-custodian (servlet-custodian the-servlet)] - [current-namespace (servlet-namespace the-servlet)] - [exit-handler - (lambda _ - (kill-connection! conn) - (custodian-shutdown-all (servlet-custodian the-servlet)))]) - (with-handlers ([exn:fail:servlet-manager:no-instance? + (define instance-custodian (make-servlet-custodian)) + (parameterize ([current-custodian instance-custodian] + [exit-handler + (lambda _ + (kill-connection! conn) + (custodian-shutdown-all instance-custodian))]) + (define response + (with-handlers ([exn:fail:filesystem:exists? + (lambda (the-exn) (next-dispatcher))] + [exn:fail:servlet-manager:no-instance? (lambda (the-exn) ((exn:fail:servlet-manager:no-instance-expiration-handler the-exn) req))] [exn:fail:servlet-manager:no-continuation? @@ -215,13 +164,37 @@ ((exn:fail:servlet-manager:no-continuation-expiration-handler the-exn) req))] [exn:fail:servlet:instance? (lambda (the-exn) - (default-servlet-instance-expiration-handler req))]) - (parameterize ([current-execution-context (make-execution-context req)]) - (call-with-continuation-prompt - (lambda () - (define kcb ((manager-continuation-lookup manager) instance-id k-id salt)) - ((custodian-box-value kcb) req)) - servlet-prompt))))) - (output-response conn response)) - - servlet-content-producer) + (default-servlet-instance-expiration-handler req))] + [(lambda (x) #t) + (lambda (the-exn) (responders-servlet-loading uri the-exn))]) + (define the-servlet (url->servlet uri)) + (parameterize ([current-servlet the-servlet] + [current-custodian (servlet-custodian the-servlet)] + [current-directory (servlet-directory the-servlet)] + [current-namespace (servlet-namespace the-servlet)]) + (define manager (servlet-manager the-servlet)) + (parameterize ([current-execution-context (make-execution-context req)]) + + (define-values (instance-id handler) + (cond + [(continuation-url? uri) + => (match-lambda + [(list instance-id k-id salt) + (values instance-id + (custodian-box-value ((manager-continuation-lookup manager) instance-id k-id salt)))])] + [else + (values ((manager-create-instance manager) (exit-handler)) + (servlet-handler the-servlet))])) + + (parameterize ([current-servlet-instance-id instance-id]) + (with-handlers ([(lambda (x) #t) + (lambda (exn) + (responders-servlet + (request-uri req) + exn))]) + (call-with-continuation-prompt + (lambda () + (handler req)) + servlet-prompt))))))) + + (output-response conn response)))) \ No newline at end of file