diff --git a/collects/web-server/dispatchers/dispatch-servlets.ss b/collects/web-server/dispatchers/dispatch-servlets.ss index 8c86116498..56fdeaf812 100644 --- a/collects/web-server/dispatchers/dispatch-servlets.ss +++ b/collects/web-server/dispatchers/dispatch-servlets.ss @@ -47,50 +47,46 @@ ;; servlet-content-producer/path: connection request url -> void (define (servlet-content-producer/path conn req uri) - (define servlet-mutex (make-semaphore 1)) (define response (with-handlers ([exn:fail:filesystem:exists:servlet? (lambda (the-exn) (next-dispatcher))] [(lambda (x) #t) (lambda (the-exn) (responders-servlet-loading uri the-exn))]) - (call-with-semaphore - servlet-mutex + (call-with-continuation-prompt (lambda () - (call-with-continuation-prompt - (lambda () - ; Create the session frame - (with-frame - (define instance-custodian (make-servlet-custodian)) - (define-values (servlet-path _) - (with-handlers - ([void (lambda (e) - (raise (make-exn:fail:filesystem:exists:servlet - (exn-message e) - (exn-continuation-marks e))))]) - (url->path uri))) - (parameterize ([current-directory (directory-part servlet-path)] - [current-custodian instance-custodian] - [exit-handler - (lambda (v) - (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 (cached-load servlet-path)) - (parameterize ([current-servlet 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) (make-servlet-instance-data servlet-mutex) (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))))) + ; Create the session frame + (with-frame + (define instance-custodian (make-servlet-custodian)) + (define-values (servlet-path _) + (with-handlers + ([void (lambda (e) + (raise (make-exn:fail:filesystem:exists:servlet + (exn-message e) + (exn-continuation-marks e))))]) + (url->path uri))) + (parameterize ([current-directory (directory-part servlet-path)] + [current-custodian instance-custodian] + [exit-handler + (lambda (v) + (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 (cached-load servlet-path)) + (parameterize ([current-servlet 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)) ;; default-server-instance-expiration-handler : (request -> response) @@ -102,7 +98,6 @@ (define-values (servlet-path _) (url->path uri)) (define the-servlet (cached-load servlet-path)) (define manager (servlet-manager the-servlet)) - (define data ((manager-instance-lookup-data manager) instance-id)) (define response (parameterize ([current-servlet the-servlet] [current-directory (directory-part servlet-path)] @@ -122,15 +117,12 @@ [exn:fail:servlet:instance? (lambda (the-exn) (default-servlet-instance-expiration-handler req))]) - (call-with-semaphore - (servlet-instance-data-mutex data) - (lambda () - (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))))))) + (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)) ;; cached-load : path -> script, namespace diff --git a/collects/web-server/docs/reference/managers.scrbl b/collects/web-server/docs/reference/managers.scrbl index 96cafc5738..a79be33fb3 100644 --- a/collects/web-server/docs/reference/managers.scrbl +++ b/collects/web-server/docs/reference/managers.scrbl @@ -19,15 +19,13 @@ pluggable through the manager interface. @file{managers/manager.ss} defines the manager interface. It is required by the users and implementers of managers. -@defstruct[manager ([create-instance (any/c (-> void) . -> . number?)] +@defstruct[manager ([create-instance ((-> void) . -> . number?)] [adjust-timeout! (number? number? . -> . void)] - [instance-lookup-data (number? . -> . any/c)] [clear-continuations! (number? . -> . void)] [continuation-store! (number? any/c expiration-handler? . -> . (list/c number? number?))] [continuation-lookup (number? number? number? . -> . any/c)])]{ @scheme[create-instance] is called to initialize a instance, to hold the - continuations of one servlet session. It is passed some internal data to store - for the server and + continuations of one servlet session. It is passed a function to call when the instance is expired. It runs the id of the instance. @@ -35,9 +33,6 @@ the users and implementers of managers. instance-id and a number. It is specific to the timeout-based manager and will be removed. - @scheme[instance-lookup-data] accesses the arbitrary data passed into - @scheme[create-instance] match by the given instance-id. - @scheme[clear-continuations!] expires all the continuations of an instance. @scheme[continuation-store!] is given an instance-id, a continuation value, diff --git a/collects/web-server/managers/lru.ss b/collects/web-server/managers/lru.ss index ebd28ef48a..9d71995bc3 100644 --- a/collects/web-server/managers/lru.ss +++ b/collects/web-server/managers/lru.ss @@ -30,12 +30,12 @@ (define instances (make-hash-table)) (define next-instance-id (make-counter)) - (define-struct instance (data k-table)) - (define (create-instance data expire-fn) + (define-struct instance (k-table)) + (define (create-instance expire-fn) (define instance-id (next-instance-id)) (hash-table-put! instances instance-id - (make-instance data (create-k-table))) + (make-instance (create-k-table))) instance-id) (define (adjust-timeout! instance-id secs) (void)) @@ -56,12 +56,9 @@ (make-k-table (make-counter) (make-hash-table))) ;; Interface - (define (instance-lookup-data instance-id) - (instance-data (instance-lookup instance-id))) - (define (clear-continuations! instance-id) (match (instance-lookup instance-id) - [(struct instance (data (and k-table (struct k-table (next-id-fn htable))))) + [(struct instance ((and k-table (struct k-table (next-id-fn htable))))) (hash-table-for-each htable (match-lambda* @@ -71,7 +68,7 @@ (define (continuation-store! instance-id k expiration-handler) (match (instance-lookup instance-id) - [(struct instance (data (struct k-table (next-id-fn htable)))) + [(struct instance ((struct k-table (next-id-fn htable)))) (define k-id (next-id-fn)) (define salt (random 100000000)) (hash-table-put! htable @@ -80,7 +77,7 @@ (list k-id salt)])) (define (continuation-lookup instance-id a-k-id a-salt) (match (instance-lookup instance-id) - [(struct instance (data (struct k-table (next-id-fn htable)))) + [(struct instance ((struct k-table (next-id-fn htable)))) (match (hash-table-get htable a-k-id (lambda () @@ -108,7 +105,6 @@ (define the-manager (make-LRU-manager (wrap create-instance) adjust-timeout! - (wrap instance-lookup-data) (wrap clear-continuations!) (wrap continuation-store!) (wrap continuation-lookup) @@ -127,7 +123,7 @@ (hash-table-for-each instances (match-lambda* - [(list instance-id (struct instance (_ (struct k-table (next-id-fn htable))))) + [(list instance-id (struct instance ((struct k-table (next-id-fn htable))))) (define empty? (box #t)) (hash-table-for-each htable diff --git a/collects/web-server/managers/manager.ss b/collects/web-server/managers/manager.ss index 0d95878d9c..233ef08f9d 100644 --- a/collects/web-server/managers/manager.ss +++ b/collects/web-server/managers/manager.ss @@ -4,7 +4,6 @@ (define-struct manager (create-instance adjust-timeout! - instance-lookup-data clear-continuations! continuation-store! continuation-lookup)) @@ -13,9 +12,8 @@ (define-struct (exn:fail:servlet-manager:no-continuation exn:fail) (expiration-handler)) (provide/contract - [struct manager ([create-instance (any/c (any/c . -> . void) . -> . number?)] + [struct manager ([create-instance ((any/c . -> . void) . -> . number?)] [adjust-timeout! (number? number? . -> . void)] - [instance-lookup-data (number? . -> . any/c)] [clear-continuations! (number? . -> . void)] [continuation-store! (number? any/c expiration-handler? . -> . (list/c number? number?))] [continuation-lookup (number? number? number? . -> . any/c)])] diff --git a/collects/web-server/managers/none.ss b/collects/web-server/managers/none.ss index f2f170f656..f804a10f8c 100644 --- a/collects/web-server/managers/none.ss +++ b/collects/web-server/managers/none.ss @@ -8,10 +8,8 @@ (define-struct (none-manager manager) (instance-expiration-handler)) (define (create-none-manager instance-expiration-handler) - (define the-data (make-thread-cell #f)) - (define (create-instance data expire-fn) - (thread-cell-set! the-data data) + (define (create-instance expire-fn) 0) (define (adjust-timeout! instance-id secs) (void)) @@ -22,9 +20,6 @@ (current-continuation-marks) instance-expiration-handler))) - (define (instance-lookup-data instance-id) - (thread-cell-ref the-data)) - (define (clear-continuations! instance-id) (instance-lookup instance-id)) @@ -35,7 +30,6 @@ (make-none-manager create-instance adjust-timeout! - instance-lookup-data clear-continuations! continuation-store! continuation-lookup diff --git a/collects/web-server/managers/timeouts.ss b/collects/web-server/managers/timeouts.ss index 6113eb69cd..cb071ecc72 100644 --- a/collects/web-server/managers/timeouts.ss +++ b/collects/web-server/managers/timeouts.ss @@ -28,13 +28,12 @@ (define instances (make-hash-table)) (define next-instance-id (make-counter)) - (define-struct instance (data k-table timer)) - (define (create-instance data expire-fn) + (define-struct instance (k-table timer)) + (define (create-instance expire-fn) (define instance-id (next-instance-id)) (hash-table-put! instances instance-id - (make-instance data - (create-k-table) + (make-instance (create-k-table) (start-timer instance-timer-length (lambda () (expire-fn) @@ -61,13 +60,10 @@ (define (create-k-table) (make-k-table (make-counter) (make-hash-table))) - ;; Interface - (define (instance-lookup-data instance-id) - (instance-data (instance-lookup instance-id))) - + ;; Interface (define (clear-continuations! instance-id) (match (instance-lookup instance-id) - [(struct instance (data (and k-table (struct k-table (next-id-fn htable))) instance-timer)) + [(struct instance ((and k-table (struct k-table (next-id-fn htable))) instance-timer)) (hash-table-for-each htable (match-lambda* @@ -77,7 +73,7 @@ (define (continuation-store! instance-id k expiration-handler) (match (instance-lookup instance-id) - [(struct instance (data (struct k-table (next-id-fn htable)) instance-timer)) + [(struct instance ((struct k-table (next-id-fn htable)) instance-timer)) (define k-id (next-id-fn)) (define salt (random 100000000)) (hash-table-put! htable @@ -91,7 +87,7 @@ (list k-id salt)])) (define (continuation-lookup instance-id a-k-id a-salt) (match (instance-lookup instance-id) - [(struct instance (data (struct k-table (next-id-fn htable)) instance-timer)) + [(struct instance ((struct k-table (next-id-fn htable)) instance-timer)) (match (hash-table-get htable a-k-id (lambda () @@ -114,7 +110,6 @@ (make-timeout-manager create-instance adjust-timeout! - instance-lookup-data clear-continuations! continuation-store! continuation-lookup @@ -124,4 +119,4 @@ continuation-timer-length ; Private instances - next-instance-id))) + next-instance-id))) \ No newline at end of file diff --git a/collects/web-server/private/servlet.ss b/collects/web-server/private/servlet.ss index f4320e735e..ea8f3e77ee 100644 --- a/collects/web-server/private/servlet.ss +++ b/collects/web-server/private/servlet.ss @@ -9,7 +9,6 @@ (define-struct (exn:fail:servlet:instance exn:fail) ()) (define-struct servlet (custodian namespace manager handler)) - (define-struct servlet-instance-data (mutex)) (define-struct execution-context (request)) (define current-servlet (make-parameter #f)) @@ -28,8 +27,6 @@ [namespace namespace?] [manager manager?] [handler (request? . -> . response?)])] - [struct servlet-instance-data - ([mutex semaphore?])] [struct execution-context ([request request?])] [current-servlet parameter?]