suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Removing servlet instance semaphore and instance-data from manager

Browse Source 
svn: r6657
This commit is contained in:
Jay McCarthy 2007-06-14 02:50:22 +00:00
parent 31999c4898
commit 676ba36fca
7 changed files with 59 additions and 92 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

88
collects/web-server/dispatchers/dispatch-servlets.ss
View File

@ -47,50 +47,46 @@
;; servlet-content-producer/path: connection request url -> void ;; servlet-content-producer/path: connection request url -> void
(define (servlet-content-producer/path conn req uri) (define (servlet-content-producer/path conn req uri)
(define servlet-mutex (make-semaphore 1))
(define response (define response
(with-handlers ([exn:fail:filesystem:exists:servlet? (with-handlers ([exn:fail:filesystem:exists:servlet?
(lambda (the-exn) (next-dispatcher))] (lambda (the-exn) (next-dispatcher))]
[(lambda (x) #t) [(lambda (x) #t)
(lambda (the-exn) (responders-servlet-loading uri the-exn))]) (lambda (the-exn) (responders-servlet-loading uri the-exn))])
(call-with-semaphore (call-with-continuation-prompt
servlet-mutex
(lambda () (lambda ()
(call-with-continuation-prompt ; Create the session frame
(lambda () (with-frame
; Create the session frame (define instance-custodian (make-servlet-custodian))
(with-frame (define-values (servlet-path _)
(define instance-custodian (make-servlet-custodian)) (with-handlers
(define-values (servlet-path _) ([void (lambda (e)
(with-handlers (raise (make-exn:fail:filesystem:exists:servlet
([void (lambda (e) (exn-message e)
(raise (make-exn:fail:filesystem:exists:servlet (exn-continuation-marks e))))])
(exn-message e) (url->path uri)))
(exn-continuation-marks e))))]) (parameterize ([current-directory (directory-part servlet-path)]
(url->path uri))) [current-custodian instance-custodian]
(parameterize ([current-directory (directory-part servlet-path)] [exit-handler
[current-custodian instance-custodian] (lambda (v)
[exit-handler (kill-connection! conn)
(lambda (v) (custodian-shutdown-all instance-custodian))])
(kill-connection! conn) ;; any resources (e.g. threads) created when the
(custodian-shutdown-all instance-custodian))]) ;; servlet is loaded should be within the dynamic
;; any resources (e.g. threads) created when the ;; extent of the servlet custodian
;; servlet is loaded should be within the dynamic (define the-servlet (cached-load servlet-path))
;; extent of the servlet custodian (parameterize ([current-servlet the-servlet]
(define the-servlet (cached-load servlet-path)) [current-namespace (servlet-namespace the-servlet)])
(parameterize ([current-servlet the-servlet] (define manager (servlet-manager the-servlet))
[current-namespace (servlet-namespace the-servlet)]) (parameterize ([current-execution-context (make-execution-context req)])
(define manager (servlet-manager the-servlet)) (define instance-id ((manager-create-instance manager) (exit-handler)))
(parameterize ([current-execution-context (make-execution-context req)]) (parameterize ([current-servlet-instance-id instance-id])
(define instance-id ((manager-create-instance manager) (make-servlet-instance-data servlet-mutex) (exit-handler))) (with-handlers ([(lambda (x) #t)
(parameterize ([current-servlet-instance-id instance-id]) (lambda (exn)
(with-handlers ([(lambda (x) #t) (responders-servlet
(lambda (exn) (request-uri req)
(responders-servlet exn))])
(request-uri req) ((servlet-handler the-servlet) req))))))))
exn))]) servlet-prompt)))
((servlet-handler the-servlet) req))))))))
servlet-prompt)))))
(output-response conn response)) (output-response conn response))
;; default-server-instance-expiration-handler : (request -> response) ;; default-server-instance-expiration-handler : (request -> response)
@ -102,7 +98,6 @@
(define-values (servlet-path _) (url->path uri)) (define-values (servlet-path _) (url->path uri))
(define the-servlet (cached-load servlet-path)) (define the-servlet (cached-load servlet-path))
(define manager (servlet-manager the-servlet)) (define manager (servlet-manager the-servlet))
(define data ((manager-instance-lookup-data manager) instance-id))
(define response (define response
(parameterize ([current-servlet the-servlet] (parameterize ([current-servlet the-servlet]
[current-directory (directory-part servlet-path)] [current-directory (directory-part servlet-path)]
@ -122,15 +117,12 @@
[exn:fail:servlet:instance? [exn:fail:servlet:instance?
(lambda (the-exn) (lambda (the-exn)
(default-servlet-instance-expiration-handler req))]) (default-servlet-instance-expiration-handler req))])
(call-with-semaphore (parameterize ([current-execution-context (make-execution-context req)])
(servlet-instance-data-mutex data) (call-with-continuation-prompt
(lambda () (lambda ()
(parameterize ([current-execution-context (make-execution-context req)]) (define kcb ((manager-continuation-lookup manager) instance-id k-id salt))
(call-with-continuation-prompt ((custodian-box-value kcb) req))
(lambda () servlet-prompt)))))
(define kcb ((manager-continuation-lookup manager) instance-id k-id salt))
((custodian-box-value kcb) req))
servlet-prompt)))))))
(output-response conn response)) (output-response conn response))
;; cached-load : path -> script, namespace ;; cached-load : path -> script, namespace

9
collects/web-server/docs/reference/managers.scrbl
View File

@ -19,15 +19,13 @@ pluggable through the manager interface.
@file{managers/manager.ss} defines the manager interface. It is required by @file{managers/manager.ss} defines the manager interface. It is required by
the users and implementers of managers. 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)] [adjust-timeout! (number? number? . -> . void)]
[instance-lookup-data (number? . -> . any/c)]
[clear-continuations! (number? . -> . void)] [clear-continuations! (number? . -> . void)]
[continuation-store! (number? any/c expiration-handler? . -> . (list/c number? number?))] [continuation-store! (number? any/c expiration-handler? . -> . (list/c number? number?))]
[continuation-lookup (number? number? number? . -> . any/c)])]{ [continuation-lookup (number? number? number? . -> . any/c)])]{
@scheme[create-instance] is called to initialize a instance, to hold the @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 continuations of one servlet session. It is passed
for the server and
a function to call when the instance is expired. It runs the id of the a function to call when the instance is expired. It runs the id of the
instance. instance.
@ -35,9 +33,6 @@ the users and implementers of managers.
instance-id and a number. It is specific to the timeout-based manager instance-id and a number. It is specific to the timeout-based manager
and will be removed. 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[clear-continuations!] expires all the continuations of an instance.
@scheme[continuation-store!] is given an instance-id, a continuation value, @scheme[continuation-store!] is given an instance-id, a continuation value,

18
collects/web-server/managers/lru.ss
View File

@ -30,12 +30,12 @@
(define instances (make-hash-table)) (define instances (make-hash-table))
(define next-instance-id (make-counter)) (define next-instance-id (make-counter))
(define-struct instance (data k-table)) (define-struct instance (k-table))
(define (create-instance data expire-fn) (define (create-instance expire-fn)
(define instance-id (next-instance-id)) (define instance-id (next-instance-id))
(hash-table-put! instances (hash-table-put! instances
instance-id instance-id
(make-instance data (create-k-table))) (make-instance (create-k-table)))
instance-id) instance-id)
(define (adjust-timeout! instance-id secs) (define (adjust-timeout! instance-id secs)
(void)) (void))
@ -56,12 +56,9 @@
(make-k-table (make-counter) (make-hash-table))) (make-k-table (make-counter) (make-hash-table)))
;; Interface ;; Interface
(define (instance-lookup-data instance-id)
(instance-data (instance-lookup instance-id)))
(define (clear-continuations! instance-id) (define (clear-continuations! instance-id)
(match (instance-lookup 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 (hash-table-for-each
htable htable
(match-lambda* (match-lambda*
@ -71,7 +68,7 @@
(define (continuation-store! instance-id k expiration-handler) (define (continuation-store! instance-id k expiration-handler)
(match (instance-lookup instance-id) (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 k-id (next-id-fn))
(define salt (random 100000000)) (define salt (random 100000000))
(hash-table-put! htable (hash-table-put! htable
@ -80,7 +77,7 @@
(list k-id salt)])) (list k-id salt)]))
(define (continuation-lookup instance-id a-k-id a-salt) (define (continuation-lookup instance-id a-k-id a-salt)
(match (instance-lookup instance-id) (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 (match
(hash-table-get htable a-k-id (hash-table-get htable a-k-id
(lambda () (lambda ()
@ -108,7 +105,6 @@
(define the-manager (define the-manager
(make-LRU-manager (wrap create-instance) (make-LRU-manager (wrap create-instance)
adjust-timeout! adjust-timeout!
(wrap instance-lookup-data)
(wrap clear-continuations!) (wrap clear-continuations!)
(wrap continuation-store!) (wrap continuation-store!)
(wrap continuation-lookup) (wrap continuation-lookup)
@ -127,7 +123,7 @@
(hash-table-for-each (hash-table-for-each
instances instances
(match-lambda* (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)) (define empty? (box #t))
(hash-table-for-each (hash-table-for-each
htable htable

4
collects/web-server/managers/manager.ss
View File

@ -4,7 +4,6 @@
(define-struct manager (create-instance (define-struct manager (create-instance
adjust-timeout! adjust-timeout!
instance-lookup-data
clear-continuations! clear-continuations!
continuation-store! continuation-store!
continuation-lookup)) continuation-lookup))
@ -13,9 +12,8 @@
(define-struct (exn:fail:servlet-manager:no-continuation exn:fail) (expiration-handler)) (define-struct (exn:fail:servlet-manager:no-continuation exn:fail) (expiration-handler))
(provide/contract (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)] [adjust-timeout! (number? number? . -> . void)]
[instance-lookup-data (number? . -> . any/c)]
[clear-continuations! (number? . -> . void)] [clear-continuations! (number? . -> . void)]
[continuation-store! (number? any/c expiration-handler? . -> . (list/c number? number?))] [continuation-store! (number? any/c expiration-handler? . -> . (list/c number? number?))]
[continuation-lookup (number? number? number? . -> . any/c)])] [continuation-lookup (number? number? number? . -> . any/c)])]

8
collects/web-server/managers/none.ss
View File

@ -8,10 +8,8 @@
(define-struct (none-manager manager) (instance-expiration-handler)) (define-struct (none-manager manager) (instance-expiration-handler))
(define (create-none-manager (define (create-none-manager
instance-expiration-handler) instance-expiration-handler)
(define the-data (make-thread-cell #f))
(define (create-instance data expire-fn) (define (create-instance expire-fn)
(thread-cell-set! the-data data)
0) 0)
(define (adjust-timeout! instance-id secs) (define (adjust-timeout! instance-id secs)
(void)) (void))
@ -22,9 +20,6 @@
(current-continuation-marks) (current-continuation-marks)
instance-expiration-handler))) instance-expiration-handler)))
(define (instance-lookup-data instance-id)
(thread-cell-ref the-data))
(define (clear-continuations! instance-id) (define (clear-continuations! instance-id)
(instance-lookup instance-id)) (instance-lookup instance-id))
@ -35,7 +30,6 @@
(make-none-manager create-instance (make-none-manager create-instance
adjust-timeout! adjust-timeout!
instance-lookup-data
clear-continuations! clear-continuations!
continuation-store! continuation-store!
continuation-lookup continuation-lookup

21
collects/web-server/managers/timeouts.ss
View File

@ -28,13 +28,12 @@
(define instances (make-hash-table)) (define instances (make-hash-table))
(define next-instance-id (make-counter)) (define next-instance-id (make-counter))
(define-struct instance (data k-table timer)) (define-struct instance (k-table timer))
(define (create-instance data expire-fn) (define (create-instance expire-fn)
(define instance-id (next-instance-id)) (define instance-id (next-instance-id))
(hash-table-put! instances (hash-table-put! instances
instance-id instance-id
(make-instance data (make-instance (create-k-table)
(create-k-table)
(start-timer instance-timer-length (start-timer instance-timer-length
(lambda () (lambda ()
(expire-fn) (expire-fn)
@ -61,13 +60,10 @@
(define (create-k-table) (define (create-k-table)
(make-k-table (make-counter) (make-hash-table))) (make-k-table (make-counter) (make-hash-table)))
;; Interface ;; Interface
(define (instance-lookup-data instance-id)
(instance-data (instance-lookup instance-id)))
(define (clear-continuations! instance-id) (define (clear-continuations! instance-id)
(match (instance-lookup 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 (hash-table-for-each
htable htable
(match-lambda* (match-lambda*
@ -77,7 +73,7 @@
(define (continuation-store! instance-id k expiration-handler) (define (continuation-store! instance-id k expiration-handler)
(match (instance-lookup instance-id) (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 k-id (next-id-fn))
(define salt (random 100000000)) (define salt (random 100000000))
(hash-table-put! htable (hash-table-put! htable
@ -91,7 +87,7 @@
(list k-id salt)])) (list k-id salt)]))
(define (continuation-lookup instance-id a-k-id a-salt) (define (continuation-lookup instance-id a-k-id a-salt)
(match (instance-lookup instance-id) (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 (match
(hash-table-get htable a-k-id (hash-table-get htable a-k-id
(lambda () (lambda ()
@ -114,7 +110,6 @@
(make-timeout-manager create-instance (make-timeout-manager create-instance
adjust-timeout! adjust-timeout!
instance-lookup-data
clear-continuations! clear-continuations!
continuation-store! continuation-store!
continuation-lookup continuation-lookup
@ -124,4 +119,4 @@
continuation-timer-length continuation-timer-length
; Private ; Private
instances instances
next-instance-id))) next-instance-id)))

3
collects/web-server/private/servlet.ss
View File

@ -9,7 +9,6 @@
(define-struct (exn:fail:servlet:instance exn:fail) ()) (define-struct (exn:fail:servlet:instance exn:fail) ())
(define-struct servlet (custodian namespace manager handler)) (define-struct servlet (custodian namespace manager handler))
(define-struct servlet-instance-data (mutex))
(define-struct execution-context (request)) (define-struct execution-context (request))
(define current-servlet (make-parameter #f)) (define current-servlet (make-parameter #f))
@ -28,8 +27,6 @@
[namespace namespace?] [namespace namespace?]
[manager manager?] [manager manager?]
[handler (request? . -> . response?)])] [handler (request? . -> . response?)])]
[struct servlet-instance-data
([mutex semaphore?])]
[struct execution-context [struct execution-context
([request request?])] ([request request?])]
[current-servlet parameter?] [current-servlet parameter?]