Introducing error when send/suspend like operations used outside of servlet-instance

svn: r857
This commit is contained in:
Jay McCarthy 2005-09-15 17:01:04 +00:00
parent b57b871b79
commit c73537ff13
3 changed files with 179 additions and 167 deletions

View File

@ -209,6 +209,8 @@
(paths-servlet (host-paths host-info))
(url-path->string (url-path uri)))]
[the-servlet (cached-load real-servlet-path)])
(let ([last-inst (thread-cell-ref current-servlet-instance)])
(thread-cell-set! current-servlet-instance #f)
(with-handlers ([exn:servlet:instance?
(lambda (the-exn)
(output-response/method
@ -218,8 +220,7 @@
[exn:servlet:continuation?
(lambda (the-exn)
((exn:servlet:continuation-expiration-handler the-exn) req))])
(let* ([last-inst (thread-cell-ref current-servlet-instance)]
[inst
(let* ([inst
(hash-table-get config:instances uk-instance
(lambda ()
(raise
@ -255,9 +256,8 @@
(make-exn:servlet:continuation
"" (current-continuation-marks)
k-expiration-handler)))))
(thread-cell-set! current-servlet-instance last-inst)
(semaphore-post (servlet-instance-mutex inst))
)))))
(semaphore-post (servlet-instance-mutex inst))))
(thread-cell-set! current-servlet-instance last-inst)))))
;; ************************************************************
;; ************************************************************

View File

@ -4,6 +4,7 @@
(lib "list.ss")
"timer.ss")
(provide (struct exn:servlet:instance ())
(struct exn:servlet:current-instance ())
(struct exn:servlet:continuation (expiration-handler))
(struct servlet (handler namespace instance-expiration-handler))
(struct execution-context (connection request suspend))
@ -46,6 +47,8 @@
(define-struct (exn:servlet:instance exn) ())
;; not found in the continuatin table
(define-struct (exn:servlet:continuation exn) (expiration-handler))
;; not in dynamic extent of servlet
(define-struct (exn:servlet:current-instance exn) ())
(define-values (make-k-table reset-k-table get-k-id!)
(let ([id-slot 'next-k-id])

View File

@ -32,23 +32,32 @@
(define current-servlet-continuation-expiration-handler
(make-parameter #f))
;; get-current-servlet-instance : -> servlet
(define (get-current-servlet-instance)
(let ([inst (thread-cell-ref current-servlet-instance)])
(unless inst
(raise (make-exn:servlet:current-instance
"(lib \"servlet.ss\" \"web-server\") used outside the dynamic-extent of a servlet-instance"
(current-continuation-marks))))
inst))
;; adjust-timeout! : sec -> void
;; adjust the timeout on the servlet
(define (adjust-timeout! secs)
(reset-timer (servlet-instance-timer (thread-cell-ref current-servlet-instance))
(reset-timer (servlet-instance-timer (get-current-servlet-instance))
secs))
;; send/back: response -> void
;; send a response and don't clear the continuation table
(define (send/back resp)
(let ([ctxt (servlet-instance-context (thread-cell-ref current-servlet-instance))])
(let ([ctxt (servlet-instance-context (get-current-servlet-instance))])
(output-response (execution-context-connection ctxt) resp)
((execution-context-suspend ctxt))))
;; send/finish: response -> void
;; send a response and clear the continuation table
(define (send/finish resp)
(clear-continuations! (thread-cell-ref current-servlet-instance))
(clear-continuations! (get-current-servlet-instance))
; If we readjust the timeout to something small, the session will expire shortly
; we cannot wait for send/back to return, because it doesn't
; Also, we cannot get the initial-connection-timeout variable from here
@ -61,7 +70,7 @@
(define send/suspend
(opt-lambda (response-generator [expiration-handler (current-servlet-continuation-expiration-handler)])
(let/cc k
(let* ([inst (thread-cell-ref current-servlet-instance)]
(let* ([inst (get-current-servlet-instance)]
[ctxt (servlet-instance-context inst)]
[k-url (store-continuation!
k expiration-handler
@ -75,7 +84,7 @@
;; clear the continuation table, then behave like send/suspend
(define send/forward
(opt-lambda (response-generator [expiration-handler (current-servlet-continuation-expiration-handler)])
(clear-continuations! (thread-cell-ref current-servlet-instance))
(clear-continuations! (get-current-servlet-instance))
(send/suspend response-generator expiration-handler)))
;; send/suspend/callback : xexpr/callback? -> void