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

Commiting new interface version, with new timeout semantics

Browse Source 
svn: r862
This commit is contained in:
Jay McCarthy 2005-09-15 23:17:39 +00:00
parent f28927d3b1
commit 490010bd3a
3 changed files with 12 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -247,8 +247,7 @@
(make-execution-context (make-execution-context
conn req (lambda () (suspend #t)))) conn req (lambda () (suspend #t))))
(increment-timer (servlet-instance-timer inst) (increment-timer (servlet-instance-timer inst)
(timeouts-default-servlet (servlet-connection-interval-timeout the-servlet))
(host-timeouts host-info)))
(let-values ([(k k-expiration-handler k-salt) (let-values ([(k k-expiration-handler k-salt)
(apply values (apply values
(hash-table-get (hash-table-get
@ -330,6 +329,8 @@
[(unit/sig? s) [(unit/sig? s)
(make-servlet (v0.servlet->v1.lambda s) (make-servlet (v0.servlet->v1.lambda s)
(current-namespace) (current-namespace)
(timeouts-default-servlet
(host-timeouts host-info))
(make-default-servlet-instance-expiration-handler host-info))] (make-default-servlet-instance-expiration-handler host-info))]
; FIX - reason about exceptions from dynamic require (catch and report if not already) ; FIX - reason about exceptions from dynamic require (catch and report if not already)
;; module servlet ;; module servlet
@ -342,13 +343,16 @@
[start (dynamic-require module-name 'start)]) [start (dynamic-require module-name 'start)])
(make-servlet (v1.module->v1.lambda timeout start) (make-servlet (v1.module->v1.lambda timeout start)
(current-namespace) (current-namespace)
(timeouts-default-servlet
(host-timeouts host-info))
(make-default-servlet-instance-expiration-handler host-info)))] (make-default-servlet-instance-expiration-handler host-info)))]
[(v2) ; XXX: Undocumented [(v2-transitional) ; XXX: Undocumented
(let ([timeout (dynamic-require module-name 'timeout)] (let ([timeout (dynamic-require module-name 'timeout)]
[instance-expiration-handler (dynamic-require module-name 'instance-expiration-handler)] [instance-expiration-handler (dynamic-require module-name 'instance-expiration-handler)]
[start (dynamic-require module-name 'start)]) [start (dynamic-require module-name 'start)])
(make-servlet (v1.module->v1.lambda timeout start) (make-servlet (v1.module->v1.lambda timeout start)
(current-namespace) (current-namespace)
timeout
instance-expiration-handler))] instance-expiration-handler))]
[else [else
(raise (format "unknown servlet version ~e" version))]))] (raise (format "unknown servlet version ~e" version))]))]
@ -356,6 +360,8 @@
[(response? s) [(response? s)
(make-servlet (v0.response->v1.lambda s a-path) (make-servlet (v0.response->v1.lambda s a-path)
(current-namespace) (current-namespace)
(timeouts-default-servlet
(host-timeouts host-info))
(make-default-servlet-instance-expiration-handler host-info))] (make-default-servlet-instance-expiration-handler host-info))]
[else [else
(raise 'load-servlet/path "Loading ~e produced ~n~e~n instead of a servlet." a-path s)]))))) (raise 'load-servlet/path "Loading ~e produced ~n~e~n instead of a servlet." a-path s)])))))

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

@ -66,6 +66,7 @@
(lambda () (lambda ()
(make-servlet the-servlet (make-servlet the-servlet
(i:make-servlet-namespace) (i:make-servlet-namespace)
30
(lambda (request) (lambda (request)
`(html (head "Return to the interaction window.") `(html (head "Return to the interaction window.")
(body (p "Return to the interaction window."))))))) (body (p "Return to the interaction window.")))))))

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

@ -6,7 +6,7 @@
(provide (struct exn:servlet:instance ()) (provide (struct exn:servlet:instance ())
(struct exn:servlet:no-current-instance ()) (struct exn:servlet:no-current-instance ())
(struct exn:servlet:continuation (expiration-handler)) (struct exn:servlet:continuation (expiration-handler))
(struct servlet (handler namespace instance-expiration-handler)) (struct servlet (handler namespace connection-interval-timeout instance-expiration-handler))
(struct execution-context (connection request suspend)) (struct execution-context (connection request suspend))
(struct servlet-instance (id k-table custodian context mutex timer)) (struct servlet-instance (id k-table custodian context mutex timer))
current-servlet-instance) current-servlet-instance)
@ -17,7 +17,7 @@
;; will be in affect for the entire dynamic extent of every ;; will be in affect for the entire dynamic extent of every
;; continuation associated with that instance. ;; continuation associated with that instance.
(define current-servlet-instance (make-thread-cell #f)) (define current-servlet-instance (make-thread-cell #f))
(define-struct servlet (handler namespace instance-expiration-handler)) (define-struct servlet (handler namespace connection-interval-timeout instance-expiration-handler))
(define-struct servlet-instance (id k-table custodian context mutex timer)) (define-struct servlet-instance (id k-table custodian context mutex timer))
(define-struct execution-context (connection request suspend)) (define-struct execution-context (connection request suspend))