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

Changing current-servlet-instant to TLS

Browse Source 
svn: r676
This commit is contained in:
Jay McCarthy 2005-08-25 17:52:07 +00:00
parent 1efb967dd8
commit 97f7ef11b9
4 changed files with 22 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
collects/web-server/internal-structs.ss
View File

@ -1,24 +0,0 @@
(module internal-structs mzscheme
(provide current-servlet-stuff)
(require "util.ss")
; more here - rename
(define current-servlet-stuff (make-parameter #f (lambda (x) x)))
; servlet-instance = (make-servlet-instance Nat Channel (Hashtable Symbol -> cont))
(provide-define-struct servlet-instance (k-counter channel cont-table))
; config = (make-config host-table script-table instance-table access-table)
(provide-define-struct config (hosts scripts instances access))
; more here - rename
; more here - check if method is needed. (I think it's for purge-table.)
; note: the url is the initial starting url without instance or continuation specific stuff at the end.
; servlet-stuff = (make-servlet-stuff url sym instance-table (response -> void) (instance -> doesn't) method)
(provide-define-struct servlet-stuff (url invoke-id instances output-page resume method))
;; a connection is a structure
;; (make-connection custodian input-port output-port timer boolean)
(provide-define-struct connection (i-port o-port close?))
)

5
collects/web-server/servlet-tables.ss
View File

@ -14,7 +14,7 @@
;; or invoking a continuation. The current-servlet-instance
;; will be in affect for the entire dynamic extent of every
;; continuation associated with that instance.
(define current-servlet-instance (make-parameter #f))
(define current-servlet-instance (make-thread-cell #f))
(define-struct servlet-instance (id k-table custodian context mutex timer))
(define-struct execution-context (connection request suspend))
@ -38,8 +38,7 @@
[create-new-instance! (hash-table? custodian? execution-context? semaphore? timer?
. -> . servlet-instance?)]
[remove-instance! (hash-table? servlet-instance? . -> . any)]
[clear-continuations! (servlet-instance? . -> . any)]
)
[clear-continuations! (servlet-instance? . -> . any)])
;; not found in the instance table
(define-struct (exn:servlet-instance exn) ())

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

@ -30,27 +30,27 @@
;; adjust-timeout! : sec -> void
;; adjust the timeout on the servlet
(define (adjust-timeout! secs)
(reset-timer (servlet-instance-timer (current-servlet-instance))
(reset-timer (servlet-instance-timer (thread-cell-ref 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 (current-servlet-instance))])
(let ([ctxt (servlet-instance-context (thread-cell-ref 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! (current-servlet-instance))
(clear-continuations! (thread-cell-ref current-servlet-instance))
(send/back resp))
;; send/suspend: (url -> response) -> request
;; send a response and apply the continuation to the next request
(define (send/suspend response-generator)
(let/cc k
(let* ([inst (current-servlet-instance)]
(let* ([inst (thread-cell-ref current-servlet-instance)]
[ctxt (servlet-instance-context inst)]
[k-url (store-continuation!
k (request-uri (execution-context-request ctxt))
@ -62,7 +62,7 @@
;; send/forward: (url -> response) -> request
;; clear the continuation table, then behave like send/suspend
(define (send/forward response-generator)
(clear-continuations! (current-servlet-instance))
(clear-continuations! (thread-cell-ref current-servlet-instance))
(send/suspend response-generator))
;; send/suspend/callback : xexpr/callback? -> void

25
collects/web-server/web-server-unit.ss
View File

@ -112,11 +112,12 @@
;; connection managers don't do anything anyways. -robby
;; NOTE: (GregP) should allow the user to pass in a connection-custodian
(define (serve-ports ip op)
(let ([connection-cust (make-custodian)]
[server-cust (make-custodian)])
(parameterize ([current-custodian connection-cust]
(let ([server-cust (make-custodian)])
(parameterize ([current-custodian server-cust]
[current-server-custodian server-cust])
(serve-ports/inner ip op))))
(let ([connection-cust (make-custodian)])
(parameterize ([current-custodian connection-cust])
(serve-ports/inner ip op))))))
;; serve-ports/inner : input-port output-port -> void
;; returns immediately, spawning a thread to handle
@ -464,7 +465,8 @@
the-exn)
(request-method req)))])
(let ([sema (make-semaphore 0)])
(let ([sema (make-semaphore 0)]
[last-inst (thread-cell-ref current-servlet-instance)])
(let/cc suspend
(let* ([servlet-custodian (make-servlet-custodian)]
[inst (create-new-instance!
@ -476,11 +478,11 @@
[real-servlet-path (url-path->path
(paths-servlet (host-paths host-info))
(url-path->string (url-path uri)))]
[servlet-exit-handler (make-servlet-exit-handler inst)])
[servlet-exit-handler (make-servlet-exit-handler inst)])
(parameterize ([current-directory (get-servlet-base-dir real-servlet-path)]
[current-custodian servlet-custodian]
[current-servlet-instance inst]
[exit-handler servlet-exit-handler])
(thread-cell-set! current-servlet-instance inst)
(let-values (;; timer thread must be within the dynamic extent of
;; servlet custodian
[(time-bomb) (start-timer (timeouts-default-servlet
@ -494,8 +496,7 @@
(parameterize ([current-namespace servlet-namespace])
(set-servlet-instance-timer! inst time-bomb)
(with-handlers ([(lambda (x) #t)
(make-servlet-exception-handler inst
host-info)])
(make-servlet-exception-handler inst host-info)])
;; Two possibilities:
;; - module servlet. start : Request -> Void handles
;; output-response via send/finish, etc.
@ -507,6 +508,7 @@
(let ([r (servlet-program req)])
(when (response? r)
(send/back r)))))))))
(thread-cell-set! current-servlet-instance last-inst)
(semaphore-post sema))))
;; make-servlet-exit-handler: servlet-instance -> alpha -> void
@ -579,7 +581,8 @@
host-info))
(request-uri req))
(request-method req)))])
(let* ([inst
(let* ([last-inst (thread-cell-ref current-servlet-instance)]
[inst
(hash-table-get config:instances (first k-ref)
(lambda ()
(raise
@ -592,6 +595,7 @@
; always call a continuation. The exit-handler above ensures that
; the post is done.
(semaphore-wait (servlet-instance-mutex inst))
(thread-cell-set! current-servlet-instance inst)
(set-servlet-instance-context!
inst
(make-execution-context
@ -610,6 +614,7 @@
(raise
(make-exn:servlet-continuation
"" (current-continuation-marks))))))
(thread-cell-set! current-servlet-instance last-inst)
(semaphore-post (servlet-instance-mutex inst))
)))