Introducing error when send/suspend like operations used outside of servlet-instance
svn: r857
This commit is contained in:
parent
b57b871b79
commit
c73537ff13
|
@ -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)))))
|
||||
|
||||
;; ************************************************************
|
||||
;; ************************************************************
|
||||
|
|
|
@ -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])
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue
Block a user