diff --git a/collects/web-server/private/connection-manager.ss b/collects/web-server/private/connection-manager.ss index 2fd58496c0..e0a5d08f40 100644 --- a/collects/web-server/private/connection-manager.ss +++ b/collects/web-server/private/connection-manager.ss @@ -2,11 +2,16 @@ (require (lib "contract.ss") "timer.ss") - (define-struct connection (timer i-port o-port custodian close?)) + (define-struct connection (id timer i-port o-port custodian close?)) (provide/contract [struct connection - ([timer timer?] [i-port input-port?] [o-port output-port?] [custodian custodian?] [close? boolean?])] + ([id integer?] + [timer timer?] + [i-port input-port?] + [o-port output-port?] + [custodian custodian?] + [close? boolean?])] [start-connection-manager (custodian? . -> . void)] [new-connection (number? input-port? output-port? custodian? boolean? . -> . connection?)] [kill-connection! (connection? . -> . void)] @@ -19,24 +24,34 @@ ;; new-connection: number i-port o-port custodian -> connection ;; ask the connection manager for a new connection + (define i (box 0)) (define (new-connection time-to-live i-port o-port cust close?) - (letrec ([conn - (make-connection - (start-timer time-to-live - (lambda () (kill-connection! conn))) - i-port o-port cust close?)]) - conn)) + (define conn + (make-connection + (begin0 (unbox i) (set-box! i (add1 (unbox i)))) + #f i-port o-port cust close?)) + (define conn-wb (make-weak-box conn)) + (set-connection-timer! + conn + (start-timer time-to-live + (lambda () + (cond + [(weak-box-value conn-wb) + => kill-connection!])))) + conn) ;; kill-connection!: connection -> void ;; kill this connection - (define (kill-connection! conn-demned) - (cancel-timer! (connection-timer conn-demned)) + (define (kill-connection! conn) + #;(printf "K: ~a~n" (connection-id conn)) + ; XXX Don't need to do this when called from timer + (with-handlers ([exn? void]) + (cancel-timer! (connection-timer conn))) (with-handlers ([exn:fail:network? void]) - (close-output-port (connection-o-port conn-demned))) + (close-output-port (connection-o-port conn))) (with-handlers ([exn:fail:network? void]) - (close-input-port (connection-i-port conn-demned))) - (set-connection-close?! conn-demned #t) - (custodian-shutdown-all (connection-custodian conn-demned))) + (close-input-port (connection-i-port conn))) + (custodian-shutdown-all (connection-custodian conn))) ;; adjust-connection-timeout!: connection number -> void ;; change the expiration time for this connection diff --git a/collects/web-server/private/dispatch-server-unit.ss b/collects/web-server/private/dispatch-server-unit.ss index ff67a41431..92a9ab1644 100644 --- a/collects/web-server/private/dispatch-server-unit.ss +++ b/collects/web-server/private/dispatch-server-unit.ss @@ -18,14 +18,16 @@ (start-connection-manager the-server-custodian) (parameterize ([current-custodian the-server-custodian] [current-server-custodian the-server-custodian] - [current-thread-initial-stack-size 3]) + #;[current-thread-initial-stack-size 3]) (thread (lambda () (run-server config:port handle-connection #f (lambda (exn) - #f) + ((error-display-handler) + (format "Connection error: ~a" (exn-message exn)) + exn)) (lambda (p mw re) (tcp-listen p config:max-waiting #t config:listen-ip)) tcp-close @@ -60,15 +62,11 @@ (define conn (new-connection config:initial-connection-timeout ip op (current-custodian) #f)) - (with-handlers ([exn:fail:network? - (lambda (e) - (kill-connection! conn) - (raise e))]) - (let connection-loop () - (define-values (req close?) (config:read-request conn config:port port-addresses)) + (let connection-loop () + #;(printf "C: ~a~n" (connection-id conn)) + (let-values ([(req close?) (config:read-request conn config:port port-addresses)]) + (set-connection-close?! conn close?) (config:dispatch conn req) - (unless (connection-close? conn) - (set-connection-close?! conn close?)) - (cond - [(connection-close? conn) (kill-connection! conn)] - [else (connection-loop)]))))) \ No newline at end of file + (if (connection-close? conn) + (kill-connection! conn) + (connection-loop)))))) \ No newline at end of file diff --git a/collects/web-server/private/request.ss b/collects/web-server/private/request.ss index 9bd222f518..3a24c684c1 100644 --- a/collects/web-server/private/request.ss +++ b/collects/web-server/private/request.ss @@ -9,7 +9,13 @@ "../private/request-structs.ss") (provide/contract - [read-request ((connection? number? ((input-port?) . ->* . (string? string?))) . ->* . (request? boolean?))]) + [rename ext:read-request read-request ((connection? number? ((input-port?) . ->* . (string? string?))) . ->* . (request? boolean?))]) + + (define (ext:read-request conn host-port port-addresses) + (with-handlers ([exn? (lambda (exn) + (kill-connection! conn) + (raise exn))]) + (read-request conn host-port port-addresses))) ;; ************************************************** ;; read-request: connection number (input-port -> string string) -> request boolean? diff --git a/collects/web-server/private/response.ss b/collects/web-server/private/response.ss index cb8ca40a50..002b8fe7c9 100644 --- a/collects/web-server/private/response.ss +++ b/collects/web-server/private/response.ss @@ -171,13 +171,11 @@ (define (ext:wrap f) (lambda (conn . args) - (if (connection-close? conn) - (error 'output-response "Attempt to write to closed connection.") - (with-handlers ([exn? (lambda (exn) - (kill-connection! conn) - (raise exn))]) - (apply f conn args) - (flush-output (connection-o-port conn)))))) + (with-handlers ([exn? (lambda (exn) + (kill-connection! conn) + (raise exn))]) + (apply f conn args) + (flush-output (connection-o-port conn))))) (define ext:output-response (ext:wrap output-response)) diff --git a/collects/web-server/private/timer.ss b/collects/web-server/private/timer.ss index 583465790d..7284cd4bc6 100644 --- a/collects/web-server/private/timer.ss +++ b/collects/web-server/private/timer.ss @@ -14,6 +14,7 @@ (thread (lambda () (let loop ([timers null]) + #;(printf "Timers: ~a~n" (length timers)) ;; Wait for either... (apply sync ;; ... a timer-request message ... diff --git a/collects/web-server/tests/private/request-test.ss b/collects/web-server/tests/private/request-test.ss index 8c57a4437c..e231eeda57 100644 --- a/collects/web-server/tests/private/request-test.ss +++ b/collects/web-server/tests/private/request-test.ss @@ -18,7 +18,7 @@ (number->string (bytes-length b)))))] [ip (open-input-bytes b)] [op (open-output-bytes)]) - (values (make-connection (make-timer ip +inf.0 (lambda () (void))) + (values (make-connection 0 (make-timer ip +inf.0 (lambda () (void))) ip op (make-custodian) #f) headers))) diff --git a/collects/web-server/tests/util.ss b/collects/web-server/tests/util.ss index ea741c1b0f..dcf8247410 100644 --- a/collects/web-server/tests/util.ss +++ b/collects/web-server/tests/util.ss @@ -30,7 +30,7 @@ (define (make-mock-connection ib) (define ip (open-input-bytes ib)) (define op (open-output-bytes)) - (values (make-connection (make-timer never-evt +inf.0 (lambda () (void))) + (values (make-connection 0 (make-timer never-evt +inf.0 (lambda () (void))) ip op (current-custodian) #f) ip op))