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

exception handling

Browse Source 
svn: r2140
This commit is contained in:
Jay McCarthy 2006-02-06 17:14:09 +00:00
parent a6f8344c09
commit 647fc4e58a
1 changed files with 77 additions and 62 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -114,59 +114,64 @@
;; ************************************************** ;; **************************************************
;; output-response: connection response -> void ;; output-response: connection response -> void
(define (ext:output-response conn resp) (define (ext:output-response conn resp)
(call-with-semaphore (connection-mutex conn) (if (connection-close? conn)
(lambda () (raise 'output-response "Attempt to output on closed connection.")
(output-response conn resp) (with-handlers ([exn? (lambda (exn)
(flush-output (connection-o-port conn))))) (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) (define (output-response conn resp)
(cond (cond
[(response/full? resp) [(response/full? resp)
(output-response/basic (output-response/basic
conn resp (response/full->size resp) conn resp (response/full->size resp)
(lambda (o-port) (lambda (o-port)
(for-each (for-each
(lambda (str) (display str o-port)) (lambda (str) (display str o-port))
(response/full-body resp))))] (response/full-body resp))))]
[(response/incremental? resp) [(response/incremental? resp)
(output-response/incremental conn resp)] (output-response/incremental conn resp)]
[(and (pair? resp) (bytes? (car resp))) [(and (pair? resp) (bytes? (car resp)))
(output-response/basic (output-response/basic
conn conn
(make-response/basic 200 "Okay" (current-seconds) (car resp) '()) (make-response/basic 200 "Okay" (current-seconds) (car resp) '())
(apply + (map (apply + (map
(lambda (c) (lambda (c)
(if (string? c) (if (string? c)
(string-length c) (string-length c)
(bytes-length c))) (bytes-length c)))
(cdr resp))) (cdr resp)))
(lambda (o-port) (lambda (o-port)
(for-each (for-each
(lambda (str) (display str o-port)) (lambda (str) (display str o-port))
(cdr resp))))] (cdr resp))))]
[else [else
;; TODO: make a real exception for this. ;; TODO: make a real exception for this.
(with-handlers (with-handlers
([exn:invalid-xexpr? ([exn:invalid-xexpr?
(lambda (exn) (lambda (exn)
(output-response/method (output-response/method
conn conn
(xexpr-exn->response exn resp) (xexpr-exn->response exn resp)
'ignored))] 'ignored))]
[exn? (lambda (exn) [exn? (lambda (exn)
(raise exn))]) (raise exn))])
(let ([str (and (validate-xexpr resp) (xexpr->string resp))]) (let ([str (and (validate-xexpr resp) (xexpr->string resp))])
(output-response/basic (output-response/basic
conn conn
(make-response/basic 200 (make-response/basic 200
"Okay" "Okay"
(current-seconds) (current-seconds)
TEXT/HTML-MIME-TYPE TEXT/HTML-MIME-TYPE
'()) '())
(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
@ -181,10 +186,15 @@
;; ************************************************** ;; **************************************************
;; output-file: connection path symbol bytes -> void ;; output-file: connection path symbol bytes -> void
(define (ext:output-file conn file-path method mime-type) (define (ext:output-file conn file-path method mime-type)
(call-with-semaphore (connection-mutex conn) (if (connection-close? conn)
(lambda () (raise 'output-response "Attempt to output on closed connection.")
(output-file conn file-path method mime-type) (with-handlers ([exn? (lambda (exn)
(flush-output (connection-o-port conn))))) (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) (define (output-file conn file-path method mime-type)
(output-headers conn 200 "Okay" (output-headers conn 200 "Okay"
@ -202,10 +212,15 @@
;; 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 (ext:output-response/method conn resp meth) (define (ext:output-response/method conn resp meth)
(call-with-semaphore (connection-mutex conn) (if (connection-close? conn)
(lambda () (raise 'output-response "Attempt to output on closed connection.")
(output-response/method conn resp meth) (with-handlers ([exn? (lambda (exn)
(flush-output (connection-o-port conn))))) (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) (define (output-response/method conn resp meth)
(cond (cond