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

correcting bug related to help-desk versus standalone

Browse Source 
svn: r2148
This commit is contained in:
Jay McCarthy 2006-02-06 19:34:07 +00:00
parent 9d54462ffb
commit 2b5797c2b1
2 changed files with 26 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -111,17 +111,21 @@
(define DAYS
#("Sun" "Mon" "Tue" "Wed" "Thu" "Fri" "Sat"))
(define (ext:wrap f)
(lambda (conn . args)
(if (connection-close? conn)
(error 'output-response "Attempt to write to closed connection.")
(with-handlers ([exn? (lambda (exn)
(kill-connection! conn)
(raise exn))])
(call-with-semaphore (connection-mutex conn)
(lambda ()
(apply f conn args)
(flush-output (connection-o-port conn))))))))
;; **************************************************
;; output-response: connection response -> void
(define (ext:output-response conn resp)
(with-handlers ([exn? (lambda (exn)
(kill-connection! conn)
(raise exn))])
(call-with-semaphore (connection-mutex conn)
(lambda ()
(output-response conn resp)
(flush-output (connection-o-port conn))))))
(define (output-response conn resp)
(cond
[(response/full? resp)
@ -171,6 +175,9 @@
(display str o-port)
(newline o-port)))))]))
(define ext:output-response
(ext:wrap output-response))
;; response/full->size: response/full -> number
;; compute the size for a response/full
(define (response/full->size resp/f)
@ -183,15 +190,6 @@
;; **************************************************
;; output-file: connection path symbol bytes -> void
(define (ext:output-file conn file-path method mime-type)
(with-handlers ([exn? (lambda (exn)
(kill-connection! conn)
(raise exn))])
(call-with-semaphore (connection-mutex conn)
(lambda ()
(output-file conn file-path method mime-type)
(flush-output (connection-o-port conn))))))
(define (output-file conn file-path method mime-type)
(output-headers conn 200 "Okay"
`(("Content-length: " ,(file-size file-path)))
@ -204,18 +202,12 @@
(call-with-input-file file-path
(lambda (i-port) (copy-port i-port (connection-o-port conn)))))))
(define ext:output-file
(ext:wrap output-file))
;; **************************************************
;; output-response/method: connection response/full symbol -> void
;; If it is a head request output headers only, otherwise output as usual
(define (ext:output-response/method conn resp meth)
(with-handlers ([exn? (lambda (exn)
(kill-connection! conn)
(raise exn))])
(call-with-semaphore (connection-mutex conn)
(lambda ()
(output-response/method conn resp meth)
(flush-output (connection-o-port conn))))))
(define (output-response/method conn resp meth)
(cond
[(eqv? meth 'head)
@ -224,6 +216,9 @@
[else
(output-response conn resp)]))
(define ext:output-response/method
(ext:wrap output-response/method))
;; **************************************************
;; output-headers/response: connection response (listof (listof string)) -> void
;; Write the headers for a response to an output port

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

@ -95,7 +95,6 @@
ip op (current-custodian) #f)])
(with-handlers ([exn:fail:network?
(lambda (e)
(set-connection-close?! conn #t)
(kill-connection! conn)
(raise e))])
(serve-connection conn port-addresses))))))
@ -105,9 +104,12 @@
(define (serve-connection conn port-addresses)
(let connection-loop ()
(let-values ([(req close?) (config:read-request conn config:port port-addresses)])
(set-connection-close?! conn close?)
(unless close?
(set-connection-close?! conn #f))
(adjust-connection-timeout! conn config:initial-connection-timeout)
(config:dispatch conn req)
(when close?
(set-connection-close?! conn #t))
(cond
[(connection-close? conn) (kill-connection! conn)]
[else (connection-loop)]))))))