Cleaning up dispatch-servlets

svn: r12349

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-loading (url? any/c . -> . response?)
-                                  #:responders-servlet (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])
-  
+  (lambda (conn req)
-  ;; dispatch : connection request -> void
-  (define (dispatch 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)))))))
+            (output-response conn ((session-servlet ses) req))))))))
-  
-  dispatch)

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])
-  
+  (lambda (conn req)
-  ;; servlet-content-producer: connection request -> void
-  (define (servlet-content-producer conn req)
-    (define meth (request-method req))
     (define uri (request-uri req))
-    (cond
+    (define instance-custodian (make-servlet-custodian))      
-      [(continuation-url? uri)
+    (parameterize ([current-custodian instance-custodian]
-       => (match-lambda
+                   [exit-handler
-            [(list instance-id k-id salt)
+                    (lambda _
-             (invoke-servlet-continuation conn req instance-id k-id salt)])]
+                      (kill-connection! conn)
-      [else
+                      (custodian-shutdown-all instance-custodian))])
-       (servlet-content-producer/path conn req uri)]))
+      (define response
-  
+        (with-handlers ([exn:fail:filesystem:exists?
-  ;; servlet-content-producer/path: connection request url -> void
+                         (lambda (the-exn) (next-dispatcher))]
-  (define (servlet-content-producer/path conn req uri)
+                        [exn:fail:servlet-manager:no-instance?
-    (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?
                          (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))])
+                           (default-servlet-instance-expiration-handler req))]
-          (parameterize ([current-execution-context (make-execution-context req)])
+                        [(lambda (x) #t)
-            (call-with-continuation-prompt
+                         (lambda (the-exn) (responders-servlet-loading uri the-exn))])
-             (lambda ()
+          (define the-servlet (url->servlet uri))
-               (define kcb ((manager-continuation-lookup manager) instance-id k-id salt))
+          (parameterize ([current-servlet the-servlet]
-               ((custodian-box-value kcb) req))
+                         [current-custodian (servlet-custodian the-servlet)]
-             servlet-prompt)))))
+                         [current-directory (servlet-directory the-servlet)]
-    (output-response conn response))
+                         [current-namespace (servlet-namespace the-servlet)])
-  
+            (define manager (servlet-manager the-servlet))
-  servlet-content-producer)
+            (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))))