From 02360ed6050833d5436ea4f1b9b4f10f3783491b Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Sun, 11 Mar 2012 10:29:06 +0100 Subject: 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. --- module/web/server/http.scm | 16 ++++++++++++++-- 1 file 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))) -- cgit v1.2.3