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

Fixing conn mutexes and adding ssd

Browse Source 
svn: r632
This commit is contained in:
Jay McCarthy 2005-08-22 15:35:32 +00:00
parent 5e0b886ee6
commit a257bb310b
2 changed files with 52 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

59
collects/web-server/response.ss
View File

@ -74,14 +74,22 @@
. any)] . any)]
)] )]
[response? (any/c . -> . boolean?)] [response? (any/c . -> . boolean?)]
[output-response (connection? any/c . -> . any)] [rename ext:output-response output-response (connection? any/c . -> . any)]
[output-response/method (connection? response? symbol? . -> . any)] [rename ext:output-response/method output-response/method (connection? response? symbol? . -> . any)]
[output-file (connection? path? symbol? bytes? . -> . any)] [rename ext:output-file output-file (connection? path? symbol? bytes? . -> . any)]
[TEXT/HTML-MIME-TYPE bytes?] [TEXT/HTML-MIME-TYPE bytes?]
) )
(define (ext:output-response conn resp)
(call-with-semaphore (connection-mutex conn)
(lambda () (output-response conn resp))))
(define (ext:output-response/method conn resp meth)
(call-with-semaphore (connection-mutex conn)
(lambda () (output-response/method conn resp meth))))
(define (ext:output-file conn file-path method mime-type)
(call-with-semaphore (connection-mutex conn)
(lambda () (output-file conn file-path method mime-type))))
;; Table 1. head responses: ;; Table 1. head responses:
; ------------------------------------------------------------------------------ ; ------------------------------------------------------------------------------
@ -176,14 +184,9 @@
(define DAYS (define DAYS
#("Sun" "Mon" "Tue" "Wed" "Thu" "Fri" "Sat")) #("Sun" "Mon" "Tue" "Wed" "Thu" "Fri" "Sat"))
;; ************************************************** ;; **************************************************
;; output-response: connection response -> void ;; output-response: connection response -> void
(define (output-response conn resp) (define (output-response conn resp)
(call-with-semaphore
(connection-mutex conn)
(lambda ()
(cond (cond
[(response/full? resp) [(response/full? resp)
(output-response/basic (output-response/basic
@ -230,7 +233,7 @@
(add1 (string-length str)) (add1 (string-length str))
(lambda (o-port) (lambda (o-port)
(display str o-port) (display str o-port)
(newline o-port)))))])))) (newline o-port)))))]))
;; response/full->size: response/full -> number ;; response/full->size: response/full -> number
;; compute the size for a response/full ;; compute the size for a response/full
@ -245,32 +248,26 @@
;; ************************************************** ;; **************************************************
;; output-file: connection path symbol bytes -> void ;; output-file: connection path symbol bytes -> void
(define (output-file conn file-path method mime-type) (define (output-file conn file-path method mime-type)
(call-with-semaphore (output-headers conn 200 "Okay"
(connection-mutex conn) `(("Content-length: " ,(file-size file-path)))
(lambda () (file-or-directory-modify-seconds file-path)
(output-headers conn 200 "Okay" mime-type)
`(("Content-length: " ,(file-size file-path))) (when (eq? method 'get)
(file-or-directory-modify-seconds file-path) ; Give it one second per byte.
mime-type) (adjust-connection-timeout! conn (file-size file-path))
(when (eq? method 'get) (call-with-input-file file-path
; Give it one second per byte. (lambda (i-port) (copy-port i-port (connection-o-port conn))))))
(adjust-connection-timeout! conn (file-size file-path))
(call-with-input-file file-path
(lambda (i-port) (copy-port i-port (connection-o-port conn))))))))
;; ************************************************** ;; **************************************************
;; output-response/method: connection response/full symbol -> void ;; output-response/method: connection response/full symbol -> void
;; If it is a head request output headers only, otherwise output as usual ;; If it is a head request output headers only, otherwise output as usual
(define (output-response/method conn resp meth) (define (output-response/method conn resp meth)
(call-with-semaphore (cond
(connection-mutex conn) [(eqv? meth 'head)
(lambda () (output-headers/response conn resp `(("Content-length: "
(cond ,(response/full->size resp))))]
[(eqv? meth 'head) [else
(output-headers/response conn resp `(("Content-length: " (output-response conn resp)]))
,(response/full->size resp))))]
[else
(output-response conn resp)]))))
;; ************************************************** ;; **************************************************
;; output-headers/response: connection response (listof (listof string)) -> void ;; output-headers/response: connection response (listof (listof string)) -> void

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

@ -15,15 +15,13 @@
(send/suspend ((string? . -> . any/c) . -> . request?)) (send/suspend ((string? . -> . any/c) . -> . request?))
(send/forward ((string? . -> . any/c) . -> . request?)) (send/forward ((string? . -> . any/c) . -> . request?))
;;; validate-xexpr/callback is not checked anywhere: ;;; validate-xexpr/callback is not checked anywhere:
(send/suspend/callback (xexpr/callback? . -> . any)) (send/suspend/callback (xexpr/callback? . -> . any)))
)
(provide (provide
(all-from "servlet-helpers.ss") send/suspend/dispatch
(all-from "xexpr-callback.ss") (all-from "servlet-helpers.ss")
) (all-from "xexpr-callback.ss"))
;; ************************************************************ ;; ************************************************************
;; EXPORTS ;; EXPORTS
@ -45,13 +43,12 @@
(define (send/suspend response-generator) (define (send/suspend response-generator)
(let/cc k (let/cc k
(let* ([inst (current-servlet-instance)] (let* ([inst (current-servlet-instance)]
[ctxt (servlet-instance-context inst)]) [ctxt (servlet-instance-context inst)]
(output-response [k-url (store-continuation!
(execution-context-connection ctxt) k (request-uri (execution-context-request ctxt))
(response-generator inst)]
(store-continuation! [response (response-generator k-url)])
k (request-uri (execution-context-request ctxt)) (output-response (execution-context-connection ctxt) response)
inst)))
((execution-context-suspend ctxt))))) ((execution-context-suspend ctxt)))))
;; send/forward: (url -> response) -> request ;; send/forward: (url -> response) -> request
@ -63,11 +60,19 @@
;; send/suspend/callback : xexpr/callback? -> void ;; send/suspend/callback : xexpr/callback? -> void
;; send/back a response with callbacks in it; send/suspend those callbacks. ;; send/back a response with callbacks in it; send/suspend those callbacks.
(define (send/suspend/callback p-exp) (define (send/suspend/callback p-exp)
(send/suspend/dispatch
(lambda (embed/url)
(replace-procedures p-exp embed/url))))
;; send/suspend/dispatch : ((proc -> url) -> response) -> request
;; send/back a response generated from a procedure that may convert
;; procedures to continuation urls
(define (send/suspend/dispatch response-generator)
(let/cc k0 (let/cc k0
(send/back (send/back
(replace-procedures (response-generator
p-exp (lambda (proc) (lambda (proc)
(let/cc k1 (k0 (proc (send/suspend k1))))))))) (let/cc k1 (k0 (proc (send/suspend k1)))))))))
;; ************************************************************ ;; ************************************************************