diff --git a/collects/web-server/managers/lru.ss b/collects/web-server/managers/lru.ss index 2463447a0c..1160af0e7a 100644 --- a/collects/web-server/managers/lru.ss +++ b/collects/web-server/managers/lru.ss @@ -100,7 +100,7 @@ k-id (list salt k expiration-handler initial-count)) (list k-id salt)])) - (define (continuation-lookup instance-id a-k-id a-salt) + (define (continuation-lookup* instance-id a-k-id a-salt peek?) (match (instance-lookup instance-id) [(struct instance ((struct k-table (next-id-fn htable)))) (match @@ -111,8 +111,9 @@ (current-continuation-marks) instance-expiration-handler)))) [(list salt k expiration-handler count) - (hash-set! htable a-k-id - (list salt k expiration-handler (add1 count))) + (unless peek? + (hash-set! htable a-k-id + (list salt k expiration-handler (add1 count)))) (if (or (not (eq? salt a-salt)) (not k)) (raise (make-exn:fail:servlet-manager:no-continuation @@ -122,6 +123,10 @@ expiration-handler instance-expiration-handler))) k)])])) + (define (continuation-lookup instance-id a-k-id a-salt) + (continuation-lookup* instance-id a-k-id a-salt #f)) + (define (continuation-peek instance-id a-k-id a-salt) + (continuation-lookup* instance-id a-k-id a-salt #t)) (define (wrap f) (lambda args @@ -133,6 +138,7 @@ (wrap clear-continuations!) (wrap continuation-store!) (wrap continuation-lookup) + (wrap continuation-peek) ; Specific instance-expiration-handler ; Private diff --git a/collects/web-server/managers/manager.ss b/collects/web-server/managers/manager.ss index 8862a74315..052fa1fe79 100644 --- a/collects/web-server/managers/manager.ss +++ b/collects/web-server/managers/manager.ss @@ -6,7 +6,8 @@ adjust-timeout! clear-continuations! continuation-store! - continuation-lookup)) + continuation-lookup + continuation-peek)) (define-struct (exn:fail:servlet-manager:no-instance exn:fail) (expiration-handler)) (define-struct (exn:fail:servlet-manager:no-continuation exn:fail) (expiration-handler)) @@ -16,7 +17,8 @@ [adjust-timeout! (number? number? . -> . void)] [clear-continuations! (number? . -> . void)] [continuation-store! (number? any/c expiration-handler/c . -> . (list/c number? number?))] - [continuation-lookup (number? number? number? . -> . any/c)])] + [continuation-lookup (number? number? number? . -> . any/c)] + [continuation-peek (number? number? number? . -> . any/c)])] [struct (exn:fail:servlet-manager:no-instance exn:fail) ([message string?] [continuation-marks continuation-mark-set?] diff --git a/collects/web-server/managers/none.ss b/collects/web-server/managers/none.ss index efd8ca6832..f52c6dbda9 100644 --- a/collects/web-server/managers/none.ss +++ b/collects/web-server/managers/none.ss @@ -33,5 +33,6 @@ clear-continuations! continuation-store! continuation-lookup + continuation-lookup ; Specific instance-expiration-handler)) diff --git a/collects/web-server/managers/timeouts.ss b/collects/web-server/managers/timeouts.ss index 3670581655..adb38ab841 100644 --- a/collects/web-server/managers/timeouts.ss +++ b/collects/web-server/managers/timeouts.ss @@ -40,10 +40,10 @@ (hash-remove! instances instance-id))))) instance-id) (define (adjust-timeout! instance-id secs) - (reset-timer! (instance-timer (instance-lookup instance-id)) + (reset-timer! (instance-timer (instance-lookup instance-id #f)) secs)) - (define (instance-lookup instance-id) + (define (instance-lookup instance-id peek?) (define instance (hash-ref instances instance-id (lambda () @@ -51,8 +51,9 @@ (format "No instance for id: ~a" instance-id) (current-continuation-marks) instance-expiration-handler))))) - (increment-timer! (instance-timer instance) - instance-timer-length) + (unless peek? + (increment-timer! (instance-timer instance) + instance-timer-length)) instance) ;; Continuation table @@ -62,7 +63,7 @@ ;; Interface (define (clear-continuations! instance-id) - (match (instance-lookup instance-id) + (match (instance-lookup instance-id #f) [(struct instance ((and k-table (struct k-table (next-id-fn htable))) instance-timer)) (hash-for-each htable @@ -72,7 +73,7 @@ (list salt #f expiration-handler k-timer))]))])) (define (continuation-store! instance-id k expiration-handler) - (match (instance-lookup instance-id) + (match (instance-lookup instance-id #t) [(struct instance ((struct k-table (next-id-fn htable)) instance-timer)) (define k-id (next-id-fn)) (define salt (random 100000000)) @@ -85,8 +86,8 @@ (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) + (define (continuation-lookup* instance-id a-k-id a-salt peek?) + (match (instance-lookup instance-id peek?) [(struct instance ((struct k-table (next-id-fn htable)) instance-timer)) (match (hash-ref htable a-k-id @@ -96,8 +97,9 @@ (current-continuation-marks) instance-expiration-handler)))) [(list salt k expiration-handler k-timer) - (increment-timer! k-timer - continuation-timer-length) + (unless peek? + (increment-timer! k-timer + continuation-timer-length)) (if (or (not (eq? salt a-salt)) (not k)) (raise (make-exn:fail:servlet-manager:no-continuation @@ -107,12 +109,17 @@ expiration-handler instance-expiration-handler))) k)])])) + (define (continuation-lookup instance-id a-k-id a-salt) + (continuation-lookup* instance-id a-k-id a-salt #f)) + (define (continuation-peek instance-id a-k-id a-salt) + (continuation-lookup* instance-id a-k-id a-salt #t)) (make-timeout-manager create-instance adjust-timeout! clear-continuations! continuation-store! continuation-lookup + continuation-peek ; Specific instance-expiration-handler instance-timer-length diff --git a/collects/web-server/scribblings/managers.scrbl b/collects/web-server/scribblings/managers.scrbl index d7e8eaa0aa..83184c935b 100644 --- a/collects/web-server/scribblings/managers.scrbl +++ b/collects/web-server/scribblings/managers.scrbl @@ -24,7 +24,8 @@ the users and implementers of managers. [adjust-timeout! (number? number? . -> . void)] [clear-continuations! (number? . -> . void)] [continuation-store! (number? any/c expiration-handler/c . -> . (list/c number? number?))] - [continuation-lookup (number? number? number? . -> . any/c)])]{ + [continuation-lookup (number? number? number? . -> . any/c)] + [continuation-peek (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 a function to call when the instance is expired. It runs the id of the @@ -43,6 +44,10 @@ the users and implementers of managers. @scheme[continuation-lookup] finds the continuation value associated with the instance-id, continuation-id, and nonce triple it is given. + + @scheme[continuation-peek] is identical to @scheme[continuation-lookup] except that + its use must not affect the resource management policy decisions on the instance or + continuation accessed. It is intended to be used by debuggers and benchmarks. } @defstruct[(exn:fail:servlet-manager:no-instance exn:fail)