Send bug report to client, if we encounter an internal error

(e.g. testing new handler)
This commit is contained in:
interp 2002-09-04 10:38:14 +00:00
parent 65e8af2952
commit 688d576b96
1 changed files with 21 additions and 6 deletions

View File

@ -153,7 +153,15 @@
#f ; No request yet. #f ; No request yet.
"Request parsing error -- report to client maintainer." "Request parsing error -- report to client maintainer."
(condition-stuff c)))) (condition-stuff c))))
(else ((error? c)
;; try to send bug report to client
(values #f
(apply make-http-error-response http-status/internal-error
#f ; don't know
(format #f
"Internal error occured while processing request")
c)))
(else ; there's no else...
(decline)))) (decline))))
(lambda () (lambda ()
(let ((initial-req (parse-http-request sock options))) (let ((initial-req (parse-http-request sock options)))
@ -320,13 +328,20 @@
(define (send-http-response request response input-port output-port options) (define (send-http-response request response input-port output-port options)
(if (not (v0.9-request? request)) (if request
(send-http-headers response output-port)) (begin
(if (not (v0.9-request? request))
(send-http-headers response output-port))
(if (not (string=? (request:method request) "HEAD")) (if (not (string=? (request:method request) "HEAD"))
(display-http-body (response-body response) input-port output-port options)) (display-http-body (response-body response) input-port output-port options))
(http-log request (response-code response))) (http-log request (response-code response)))
(begin
;; We have a bad request error. Try to report this headerless.
(display-http-body (response-body response) input-port output-port options)
;; no CLF-logging
)))
(define (send-http-header-fields headers port) (define (send-http-header-fields headers port)
(for-each (lambda (pair) (for-each (lambda (pair)