From 878b988b48fdea59d6255d946d026464fc7480c7 Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Fri, 25 May 2007 16:35:18 +0000 Subject: [PATCH] Removing dead code svn: r6303 --- .../web-server/prototype-web-server/server.ss | 64 +------------------ 1 file changed, 2 insertions(+), 62 deletions(-) diff --git a/collects/web-server/prototype-web-server/server.ss b/collects/web-server/prototype-web-server/server.ss index 3c470843f6..643bf8b958 100644 --- a/collects/web-server/prototype-web-server/server.ss +++ b/collects/web-server/prototype-web-server/server.ss @@ -1,6 +1,5 @@ (module server mzscheme (require (lib "connection-manager.ss" "web-server" "private") - (lib "request.ss" "web-server" "private") (lib "response.ss" "web-server") (lib "servlet-helpers.ss" "web-server" "private") (lib "response.ss" "web-server" "private") @@ -17,10 +16,9 @@ start-servlet) (lib "web-cells.ss" "web-server" "prototype-web-server" "newcont") "xexpr-extras.ss" - "utils.ss" - "hardcoded-configuration.ss") + "utils.ss") - (provide serve dispatch) + (provide dispatch) (define myprint printf #;(lambda _ (void))) @@ -28,64 +26,6 @@ (define-struct connection-state (conn req)) (define top-cust (current-custodian)) - ;; ************************************************************ - ;; serve: -> -> void - ;; start the server and return a thunk to shut it down - (define (serve . port) - (let ([the-server-custodian (make-custodian)]) - (start-connection-manager the-server-custodian) - (parameterize ([current-custodian the-server-custodian]) - (let ([get-ports - (let ([listener (tcp-listen (if (not (null? port)) - (car port) - config:port) - config:max-waiting - #t config:listen-ip)]) - (lambda () (tcp-accept listener)))]) - (thread - (lambda () - (server-loop get-ports))))) - (lambda () - (custodian-shutdown-all the-server-custodian)))) - - ;; ************************************************************ - ;; server-loop: (-> i-port o-port) -> void - ;; start a thread to handle each incoming connection - (define (server-loop get-ports) - (let loop () - (let ([connection-cust (make-custodian)]) - (parameterize ([current-custodian connection-cust]) - (let-values ([(ip op) (get-ports)]) - (thread - (lambda () - (serve-connection - (new-connection config:initial-connection-timeout - ip op (current-custodian) #f))))))) - (loop))) - - ;; ************************************************************ - ;; serve-connection: connection -> void - ;; respond to all requests on this connection - (define (serve-connection conn) - (myprint "serve-connection~n") - (let connection-loop () - (let-values ([(req close?) (read-request (connection-i-port conn))]) - (let* ([host (get-host (request-uri req) (request-headers req))] - [host-conf (config:virtual-hosts host)]) - (set-connection-close?! conn close?) - (dispatch conn req host-conf) - (adjust-connection-timeout! conn config:initial-connection-timeout) - ; TODO: track down bus-error here - ; 1. uncomment next line - ; 2. comment-out cond expression - ; 3. use error-servlet01.ss - ;; TODO: while I think of it. The session object needs - ;; to be guarded by a mutex. - ;(kill-connection! conn) - (cond - [close? (kill-connection! conn)] - [else (connection-loop)]))))) - ;; ************************************************************ ;; dispatch: connection request host -> void ;; trivial dispatcher