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

no class, no exp. handler bug

Browse Source 
svn: r3099
This commit is contained in:
Jay McCarthy 2006-05-28 23:53:41 +00:00
parent f9c7a1dd6e
commit eb3033b11c
6 changed files with 135 additions and 130 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
collects/web-server/dispatch-servlets.ss
View File

@ -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)

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

@ -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)))

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

@ -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)))

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

@ -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)))

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

@ -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."))))

8
collects/web-server/servlet.ss
View File

@ -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)