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

Cleaning up dispatch-servlets

Browse Source 
svn: r12349
This commit is contained in:
Jay McCarthy 2008-11-08 00:23:45 +00:00
parent 8a91afa69d
commit 411f6321fe
2 changed files with 50 additions and 81 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
collects/web-server/dispatchers/dispatch-lang.ss
View File

@ -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))))))))

117
collects/web-server/dispatchers/dispatch-servlets.ss
View File

@ -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))))