From eb3033b11cf4f2f37c3fb2b41a2120628741d749 Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Sun, 28 May 2006 23:53:41 +0000 Subject: [PATCH] no class, no exp. handler bug svn: r3099 --- collects/web-server/dispatch-servlets.ss | 15 +- collects/web-server/managers/manager.ss | 15 +- collects/web-server/managers/timeouts.ss | 221 ++++++++++++----------- collects/web-server/private/servlet.ss | 3 +- collects/web-server/servlet-env.ss | 3 +- collects/web-server/servlet.ss | 8 +- 6 files changed, 135 insertions(+), 130 deletions(-) diff --git a/collects/web-server/dispatch-servlets.ss b/collects/web-server/dispatch-servlets.ss index b0b6f84879..8224a35a3d 100644 --- a/collects/web-server/dispatch-servlets.ss +++ b/collects/web-server/dispatch-servlets.ss @@ -1,7 +1,6 @@ (module dispatch-servlets mzscheme (require (lib "url.ss" "net") (lib "plt-match.ss") - (lib "class.ss") (lib "unitsig.ss")) (require "dispatch.ss" "web-server-structs.ss" @@ -114,7 +113,7 @@ data))) (custodian-shutdown-all instance-custodian))) (parameterize ([exit-handler the-exit-handler]) - (define instance-id (send manager create-instance data the-exit-handler)) + (define instance-id ((manager-create-instance manager) data the-exit-handler)) (thread-cell-set! current-servlet-instance-id instance-id) (with-handlers ([(lambda (x) #t) (make-servlet-exception-handler data)]) @@ -211,13 +210,13 @@ (default-servlet-instance-expiration-handler req) (request-method req)))]) - (define data (send manager instance-lookup-data instance-id)) + (define data ((manager-instance-lookup-data manager) instance-id)) ; We don't use call-with-semaphore or dynamic-wind because we ; always call a continuation. The exit-handler above ensures that ; the post is done. (semaphore-wait (servlet-instance-data-mutex data)) (let/cc suspend - (define k (send manager continuation-lookup instance-id k-id salt)) + (define k ((manager-continuation-lookup manager) instance-id k-id salt)) (set-servlet-instance-data-context! data (make-execution-context @@ -290,7 +289,7 @@ [(unit/sig? s) (make-servlet (current-custodian) (current-namespace) - (make-object timeout-manager% + (create-timeout-manager default-servlet-instance-expiration-handler timeouts-servlet-connection timeouts-default-servlet) @@ -306,7 +305,7 @@ [start (dynamic-require module-name 'start)]) (make-servlet (current-custodian) (current-namespace) - (make-object timeout-manager% + (create-timeout-manager default-servlet-instance-expiration-handler timeouts-servlet-connection timeouts-default-servlet) @@ -319,7 +318,7 @@ (define timeout (dynamic-require module-name 'timeout)) (define instance-expiration-handler (dynamic-require module-name 'instance-expiration-handler)) - (make-object timeout-manager% + (create-timeout-manager instance-expiration-handler timeouts-servlet-connection timeout))]) @@ -334,7 +333,7 @@ [(response? s) (make-servlet (current-custodian) (current-namespace) - (make-object timeout-manager% + (create-timeout-manager default-servlet-instance-expiration-handler timeouts-servlet-connection timeouts-default-servlet) diff --git a/collects/web-server/managers/manager.ss b/collects/web-server/managers/manager.ss index 492ad2641d..f1931a9197 100644 --- a/collects/web-server/managers/manager.ss +++ b/collects/web-server/managers/manager.ss @@ -1,15 +1,12 @@ (module manager mzscheme - (require (lib "class.ss")) (provide (all-defined)) - (define manager<%> - (interface () - create-instance - adjust-timeout! - instance-lookup-data - clear-continuations! - continuation-store! - continuation-lookup)) + (define-struct manager (create-instance + adjust-timeout! + instance-lookup-data + clear-continuations! + continuation-store! + continuation-lookup)) (define-struct (exn:fail:servlet-manager:no-instance exn:fail) (expiration-handler)) (define-struct (exn:fail:servlet-manager:no-continuation exn:fail) (expiration-handler))) diff --git a/collects/web-server/managers/timeouts.ss b/collects/web-server/managers/timeouts.ss index 6b90c145c3..d446f4448a 100644 --- a/collects/web-server/managers/timeouts.ss +++ b/collects/web-server/managers/timeouts.ss @@ -1,9 +1,8 @@ (module timeouts mzscheme - (require (lib "class.ss") - (lib "plt-match.ss")) + (require (lib "plt-match.ss")) (require "manager.ss") (require "../timer.ss") - (provide timeout-manager%) + (provide create-timeout-manager) ;; Utility (define (make-counter) @@ -12,105 +11,117 @@ (set! i (add1 i)) i))) - (define timeout-manager% - (class* object% (manager<%>) - (init-field instance-expiration-handler - instance-timer-length - continuation-timer-length) - (public create-instance - adjust-timeout! - instance-lookup-data - clear-continuations! - continuation-store! - continuation-lookup) - - ;; Instances - (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 instance-id (next-instance-id)) - (hash-table-put! instances - instance-id - (make-instance data - (create-k-table) - (start-timer instance-timer-length - (lambda () - (expire-fn) - (hash-table-remove! instances instance-id))))) - instance-id) - (define (adjust-timeout! instance-id secs) - (reset-timer! (instance-timer (instance-lookup instance-id)) - secs)) - - (define (instance-lookup instance-id) - (define instance - (hash-table-get instances instance-id - (lambda () - (raise (make-exn:fail:servlet-manager:no-instance - (string->immutable-string - (format "No instance for id: ~a" instance-id)) - (current-continuation-marks) - instance-expiration-handler))))) - (increment-timer! (instance-timer instance) - instance-timer-length) - instance) - - ;; Continuation table - (define-struct k-table (next-id-fn htable)) - (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))) - - (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)) - (hash-table-for-each - htable - (match-lambda* - [(list k-id (list salt k expiration-handler k-timer)) - (hash-table-put! htable k-id - (list salt #f expiration-handler k-timer))]))])) - - (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)) - (define k-id (next-id-fn)) - (define salt (random 100000000)) - (hash-table-put! htable - k-id - (list salt k expiration-handler - (start-timer continuation-timer-length - (lambda () - (hash-table-put! htable k-id - (list salt #f expiration-handler - (start-timer 0 void))))))) - (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)) - (match - (hash-table-get htable a-k-id - (lambda () - (raise (make-exn:fail:servlet-manager:no-continuation - (string->immutable-string - (format "No continuation for id: ~a" a-k-id)) - (current-continuation-marks) - instance-expiration-handler)))) - [(list salt k expiration-handler k-timer) - (increment-timer! k-timer - continuation-timer-length) - (if (or (not (eq? salt a-salt)) - (not k)) - (raise (make-exn:fail:servlet-manager:no-continuation - (string->immutable-string - (format "No continuation for id: ~a" a-k-id)) - (current-continuation-marks) - expiration-handler)) - k)])])) - - (super-new)))) + (define-struct (timeout-manager manager) (instance-expiration-handler + instance-timer-length + continuation-timer-length + ; Private + instances + next-instance-id)) + (define (create-timeout-manager + instance-expiration-handler + instance-timer-length + continuation-timer-length) + ;; Instances + (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 instance-id (next-instance-id)) + (hash-table-put! instances + instance-id + (make-instance data + (create-k-table) + (start-timer instance-timer-length + (lambda () + (expire-fn) + (hash-table-remove! instances instance-id))))) + instance-id) + (define (adjust-timeout! instance-id secs) + (reset-timer! (instance-timer (instance-lookup instance-id)) + secs)) + + (define (instance-lookup instance-id) + (define instance + (hash-table-get instances instance-id + (lambda () + (raise (make-exn:fail:servlet-manager:no-instance + (string->immutable-string + (format "No instance for id: ~a" instance-id)) + (current-continuation-marks) + instance-expiration-handler))))) + (increment-timer! (instance-timer instance) + instance-timer-length) + instance) + + ;; Continuation table + (define-struct k-table (next-id-fn htable)) + (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))) + + (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)) + (hash-table-for-each + htable + (match-lambda* + [(list k-id (list salt k expiration-handler k-timer)) + (hash-table-put! htable k-id + (list salt #f expiration-handler k-timer))]))])) + + (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)) + (define k-id (next-id-fn)) + (define salt (random 100000000)) + (hash-table-put! htable + k-id + (list salt k expiration-handler + (start-timer continuation-timer-length + (lambda () + (hash-table-put! htable k-id + (list salt #f expiration-handler + (start-timer 0 void))))))) + (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)) + (match + (hash-table-get htable a-k-id + (lambda () + (raise (make-exn:fail:servlet-manager:no-continuation + (string->immutable-string + (format "No continuation for id: ~a" a-k-id)) + (current-continuation-marks) + instance-expiration-handler)))) + [(list salt k expiration-handler k-timer) + (increment-timer! k-timer + continuation-timer-length) + (if (or (not (eq? salt a-salt)) + (not k)) + (raise (make-exn:fail:servlet-manager:no-continuation + (string->immutable-string + (format "No continuation for id: ~a" a-k-id)) + (current-continuation-marks) + (if expiration-handler + expiration-handler + instance-expiration-handler))) + k)])])) + + (make-timeout-manager create-instance + adjust-timeout! + instance-lookup-data + clear-continuations! + continuation-store! + continuation-lookup + ; Specific + instance-expiration-handler + instance-timer-length + continuation-timer-length + ; Private + instances + 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 e288e181b0..5e2d2ebde6 100644 --- a/collects/web-server/private/servlet.ss +++ b/collects/web-server/private/servlet.ss @@ -1,5 +1,4 @@ (module servlet mzscheme - (require (lib "class.ss")) (require "../managers/manager.ss") (define-struct (exn:fail:servlet:instance exn:fail) ()) @@ -26,6 +25,6 @@ (define (current-servlet-instance-data) (define manager (current-servlet-manager)) (define instance-id (thread-cell-ref current-servlet-instance-id)) - (send manager instance-lookup-data instance-id)) + ((manager-instance-lookup-data manager) instance-id)) (provide (all-defined))) diff --git a/collects/web-server/servlet-env.ss b/collects/web-server/servlet-env.ss index 170b92dcf7..4e4ee37cad 100644 --- a/collects/web-server/servlet-env.ss +++ b/collects/web-server/servlet-env.ss @@ -1,6 +1,5 @@ (module servlet-env mzscheme (require (lib "sendurl.ss" "net") - (lib "class.ss") (lib "unitsig.ss")) (require "configuration.ss" "web-server.ss" @@ -65,7 +64,7 @@ (lambda () (make-servlet (make-custodian) (i:make-servlet-namespace) - (make-object timeout-manager% + (create-timeout-manager (lambda (request) `(html (head "Return to the interaction window.") (body (p "Return to the interaction window.")))) diff --git a/collects/web-server/servlet.ss b/collects/web-server/servlet.ss index 57745a0a87..e1291e25f4 100644 --- a/collects/web-server/servlet.ss +++ b/collects/web-server/servlet.ss @@ -1,9 +1,9 @@ (module servlet mzscheme (require (lib "contract.ss") - (lib "class.ss") (lib "etc.ss") (lib "xml.ss" "xml")) (require "response.ss" + "managers/manager.ss" "private/servlet.ss" "private/url.ss" "servlet-helpers.ss" @@ -87,11 +87,11 @@ ;; adjust-timeout! : sec -> void ;; adjust the timeout on the servlet (define (adjust-timeout! secs) - (send (current-servlet-manager) adjust-timeout! (get-current-servlet-instance-id) secs)) + ((manager-adjust-timeout! (current-servlet-manager)) (get-current-servlet-instance-id) secs)) ;; ext:clear-continuations! -> void (define (clear-continuation-table!) - (send (current-servlet-manager) clear-continuations! (get-current-servlet-instance-id))) + ((manager-clear-continuations! (current-servlet-manager)) (get-current-servlet-instance-id))) ;; send/back: response -> void ;; send a response and don't clear the continuation table @@ -119,7 +119,7 @@ (let/cc k (define instance-id (get-current-servlet-instance-id)) (define ctxt (servlet-instance-data-context (current-servlet-instance-data))) - (define k-embedding (send (current-servlet-manager) continuation-store! instance-id k expiration-handler)) + (define k-embedding ((manager-continuation-store! (current-servlet-manager)) instance-id k expiration-handler)) (define k-url ((current-url-transform) (embed-ids (list* instance-id k-embedding)