summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2012-03-11 10:29:06 +0100
committerAndy Wingo <wingo@pobox.com>2012-03-11 10:29:06 +0100
commit02360ed6050833d5436ea4f1b9b4f10f3783491b (patch)
treeaf45c70cfeaf54ffe72daef6264cc2574501dc42
parent9adbf27f4e0656f489c8c9fa941da023ee4201ec (diff)
downloadguile-02360ed6050833d5436ea4f1b9b4f10f3783491b.tar.gz
web server http: 400 Bad Request on bad requests
* module/web/server/http.scm (bad-request, http-read): If an exception is raised while reading a response, write out a 400 Bad Request response before closing the port.
-rw-r--r--module/web/server/http.scm16
1 files changed, 14 insertions, 2 deletions
diff --git a/module/web/server/http.scm b/module/web/server/http.scm
index a9a90499e..cda44f4aa 100644
--- a/module/web/server/http.scm
+++ b/module/web/server/http.scm
@@ -1,6 +1,6 @@
;;; Web I/O: HTTP
-;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010, 2011, 2012 Free Software Foundation, Inc.
;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public
@@ -69,6 +69,11 @@
(poll-set-add! poll-set socket *events*)
(make-http-server socket 0 poll-set)))
+(define (bad-request port)
+ (write-response (build-response #:version '(1 . 0) #:code 400
+ #:headers '((content-length . 0)))
+ port))
+
;; -> (client request body | #f #f #f)
(define (http-read server)
(let* ((poll-set (http-poll-set server)))
@@ -123,7 +128,14 @@
req
(read-request-body req))))
(lambda (k . args)
- (false-if-exception (close-port port)))))))))))))
+ (define-syntax-rule (cleanup-catch statement)
+ (catch #t
+ (lambda () statement)
+ (lambda (k . args)
+ (format (current-error-port) "In ~a:\n" 'statement)
+ (print-exception (current-error-port) #f k args))))
+ (cleanup-catch (bad-request port))
+ (cleanup-catch (close-port port)))))))))))))
(define (keep-alive? response)
(let ((v (response-version response)))