diff --git a/collects/web-server/internal-structs.ss b/collects/web-server/internal-structs.ss deleted file mode 100644 index d8bf496464..0000000000 --- a/collects/web-server/internal-structs.ss +++ /dev/null @@ -1,24 +0,0 @@ -(module internal-structs mzscheme - (provide current-servlet-stuff) - (require "util.ss") - - ; more here - rename - (define current-servlet-stuff (make-parameter #f (lambda (x) x))) - - ; servlet-instance = (make-servlet-instance Nat Channel (Hashtable Symbol -> cont)) - (provide-define-struct servlet-instance (k-counter channel cont-table)) - - ; config = (make-config host-table script-table instance-table access-table) - (provide-define-struct config (hosts scripts instances access)) - - ; more here - rename - ; more here - check if method is needed. (I think it's for purge-table.) - ; note: the url is the initial starting url without instance or continuation specific stuff at the end. - ; servlet-stuff = (make-servlet-stuff url sym instance-table (response -> void) (instance -> doesn't) method) - (provide-define-struct servlet-stuff (url invoke-id instances output-page resume method)) - - ;; a connection is a structure - ;; (make-connection custodian input-port output-port timer boolean) - (provide-define-struct connection (i-port o-port close?)) - - ) \ No newline at end of file diff --git a/collects/web-server/servlet-tables.ss b/collects/web-server/servlet-tables.ss index 52799c7537..1511aca805 100644 --- a/collects/web-server/servlet-tables.ss +++ b/collects/web-server/servlet-tables.ss @@ -14,7 +14,7 @@ ;; or invoking a continuation. The current-servlet-instance ;; will be in affect for the entire dynamic extent of every ;; continuation associated with that instance. - (define current-servlet-instance (make-parameter #f)) + (define current-servlet-instance (make-thread-cell #f)) (define-struct servlet-instance (id k-table custodian context mutex timer)) (define-struct execution-context (connection request suspend)) @@ -38,8 +38,7 @@ [create-new-instance! (hash-table? custodian? execution-context? semaphore? timer? . -> . servlet-instance?)] [remove-instance! (hash-table? servlet-instance? . -> . any)] - [clear-continuations! (servlet-instance? . -> . any)] - ) + [clear-continuations! (servlet-instance? . -> . any)]) ;; not found in the instance table (define-struct (exn:servlet-instance exn) ()) diff --git a/collects/web-server/servlet.ss b/collects/web-server/servlet.ss index a540f3c768..d419352407 100644 --- a/collects/web-server/servlet.ss +++ b/collects/web-server/servlet.ss @@ -30,27 +30,27 @@ ;; adjust-timeout! : sec -> void ;; adjust the timeout on the servlet (define (adjust-timeout! secs) - (reset-timer (servlet-instance-timer (current-servlet-instance)) + (reset-timer (servlet-instance-timer (thread-cell-ref current-servlet-instance)) secs)) ;; send/back: response -> void ;; send a response and don't clear the continuation table (define (send/back resp) - (let ([ctxt (servlet-instance-context (current-servlet-instance))]) + (let ([ctxt (servlet-instance-context (thread-cell-ref current-servlet-instance))]) (output-response (execution-context-connection ctxt) resp) ((execution-context-suspend ctxt)))) ;; send/finish: response -> void ;; send a response and clear the continuation table (define (send/finish resp) - (clear-continuations! (current-servlet-instance)) + (clear-continuations! (thread-cell-ref current-servlet-instance)) (send/back resp)) ;; send/suspend: (url -> response) -> request ;; send a response and apply the continuation to the next request (define (send/suspend response-generator) (let/cc k - (let* ([inst (current-servlet-instance)] + (let* ([inst (thread-cell-ref current-servlet-instance)] [ctxt (servlet-instance-context inst)] [k-url (store-continuation! k (request-uri (execution-context-request ctxt)) @@ -62,7 +62,7 @@ ;; send/forward: (url -> response) -> request ;; clear the continuation table, then behave like send/suspend (define (send/forward response-generator) - (clear-continuations! (current-servlet-instance)) + (clear-continuations! (thread-cell-ref current-servlet-instance)) (send/suspend response-generator)) ;; send/suspend/callback : xexpr/callback? -> void diff --git a/collects/web-server/web-server-unit.ss b/collects/web-server/web-server-unit.ss index 4fb1b9078f..a26704f3cf 100644 --- a/collects/web-server/web-server-unit.ss +++ b/collects/web-server/web-server-unit.ss @@ -112,11 +112,12 @@ ;; connection managers don't do anything anyways. -robby ;; NOTE: (GregP) should allow the user to pass in a connection-custodian (define (serve-ports ip op) - (let ([connection-cust (make-custodian)] - [server-cust (make-custodian)]) - (parameterize ([current-custodian connection-cust] + (let ([server-cust (make-custodian)]) + (parameterize ([current-custodian server-cust] [current-server-custodian server-cust]) - (serve-ports/inner ip op)))) + (let ([connection-cust (make-custodian)]) + (parameterize ([current-custodian connection-cust]) + (serve-ports/inner ip op)))))) ;; serve-ports/inner : input-port output-port -> void ;; returns immediately, spawning a thread to handle @@ -464,7 +465,8 @@ the-exn) (request-method req)))]) - (let ([sema (make-semaphore 0)]) + (let ([sema (make-semaphore 0)] + [last-inst (thread-cell-ref current-servlet-instance)]) (let/cc suspend (let* ([servlet-custodian (make-servlet-custodian)] [inst (create-new-instance! @@ -476,11 +478,11 @@ [real-servlet-path (url-path->path (paths-servlet (host-paths host-info)) (url-path->string (url-path uri)))] - [servlet-exit-handler (make-servlet-exit-handler inst)]) + [servlet-exit-handler (make-servlet-exit-handler inst)]) (parameterize ([current-directory (get-servlet-base-dir real-servlet-path)] [current-custodian servlet-custodian] - [current-servlet-instance inst] [exit-handler servlet-exit-handler]) + (thread-cell-set! current-servlet-instance inst) (let-values (;; timer thread must be within the dynamic extent of ;; servlet custodian [(time-bomb) (start-timer (timeouts-default-servlet @@ -494,8 +496,7 @@ (parameterize ([current-namespace servlet-namespace]) (set-servlet-instance-timer! inst time-bomb) (with-handlers ([(lambda (x) #t) - (make-servlet-exception-handler inst - host-info)]) + (make-servlet-exception-handler inst host-info)]) ;; Two possibilities: ;; - module servlet. start : Request -> Void handles ;; output-response via send/finish, etc. @@ -507,6 +508,7 @@ (let ([r (servlet-program req)]) (when (response? r) (send/back r))))))))) + (thread-cell-set! current-servlet-instance last-inst) (semaphore-post sema)))) ;; make-servlet-exit-handler: servlet-instance -> alpha -> void @@ -579,7 +581,8 @@ host-info)) (request-uri req)) (request-method req)))]) - (let* ([inst + (let* ([last-inst (thread-cell-ref current-servlet-instance)] + [inst (hash-table-get config:instances (first k-ref) (lambda () (raise @@ -592,6 +595,7 @@ ; always call a continuation. The exit-handler above ensures that ; the post is done. (semaphore-wait (servlet-instance-mutex inst)) + (thread-cell-set! current-servlet-instance inst) (set-servlet-instance-context! inst (make-execution-context @@ -610,6 +614,7 @@ (raise (make-exn:servlet-continuation "" (current-continuation-marks)))))) + (thread-cell-set! current-servlet-instance last-inst) (semaphore-post (servlet-instance-mutex inst)) )))