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

Capturing exceptions and helping with timeouts

Browse Source 
svn: r638
This commit is contained in:
Jay McCarthy 2005-08-23 16:52:40 +00:00
parent 85ca8748d7
commit 00b13175b8
1 changed files with 25 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
collects/web-server/web-server-unit.ss
View File

@ -85,12 +85,8 @@
(let ([connection-cust (make-custodian)]) (let ([connection-cust (make-custodian)])
(parameterize ([current-custodian connection-cust]) (parameterize ([current-custodian connection-cust])
(let-values ([(ip op) (get-ports)]) (let-values ([(ip op) (get-ports)])
(thread (serve-ports/inner ip op))))
(lambda () (loop)))
(serve-connection
(new-connection config:initial-connection-timeout
ip op (current-custodian) #f))))))
(loop))))
;; serve-ports : input-port output-port -> void ;; serve-ports : input-port output-port -> void
;; returns immediately, spawning a thread to handle ;; returns immediately, spawning a thread to handle
@ -103,11 +99,22 @@
[server-cust (make-custodian)]) [server-cust (make-custodian)])
(parameterize ([current-custodian connection-cust] (parameterize ([current-custodian connection-cust]
[current-server-custodian server-cust]) [current-server-custodian server-cust])
(serve-ports/inner ip op))))
;; serve-ports/inner : input-port output-port -> void
;; returns immediately, spawning a thread to handle
(define (serve-ports/inner ip op)
(thread (thread
(lambda () (lambda ()
(serve-connection (let ([conn (new-connection config:initial-connection-timeout
(new-connection config:initial-connection-timeout ip op (current-custodian) #f)])
ip op connection-cust #f))))))) (with-handlers ([exn:fail:network?
(lambda (e)
(set-connection-close?! conn #t)
; XXX: Can this block on the mutex?
(kill-connection! conn)
(raise e))])
(serve-connection conn))))))
;; serve-connection: connection -> void ;; serve-connection: connection -> void
;; respond to all requests on this connection ;; respond to all requests on this connection
@ -119,10 +126,10 @@
((host-log-message host-conf) (request-host-ip req) ((host-log-message host-conf) (request-host-ip req)
(request-client-ip req) (request-method req) (request-uri req) host) (request-client-ip req) (request-method req) (request-uri req) host)
(set-connection-close?! conn close?) (set-connection-close?! conn close?)
(dispatch conn req host-conf)
(adjust-connection-timeout! conn config:initial-connection-timeout) (adjust-connection-timeout! conn config:initial-connection-timeout)
(dispatch conn req host-conf)
(cond (cond
[close? (kill-connection! conn)] [(connection-close? conn) (kill-connection! conn)]
[else (connection-loop)]))))) [else (connection-loop)])))))
;; dispatch: connection request host -> void ;; dispatch: connection request host -> void
@ -523,9 +530,11 @@
host-info)) host-info))
(request-uri req) (request-uri req)
the-exn)]) the-exn)])
;; Don't handle twice
(with-handlers ([exn:fail? (lambda (exn) (void))])
(output-response/method (output-response/method
(execution-context-connection ctxt) (execution-context-connection ctxt)
resp (request-method req)) resp (request-method req)))
((execution-context-suspend ctxt))))) ((execution-context-suspend ctxt)))))
;; path -> path ;; path -> path