http.server: extend handle-client-error so that it responds with 400 Bad Request if the request is invalid

basis/http/server/server-docs.factor

@@ -1,5 +1,5 @@
-USING: assocs help.markup help.syntax http io.servers kernel
-math strings urls vocabs.refresh ;
+USING: assocs continuations help.markup help.syntax http http.server.requests
+io.servers kernel math strings urls vocabs.refresh ;
 USE: html.forms ! needed for $link in param
 IN: http.server
 
@@ -39,6 +39,10 @@ HELP: post-request?
 HELP: responder-nesting
 { $description "A sequence of " { $snippet "{ path responder }" } " pairs." } ;
 
+HELP: handle-client-error
+{ $values { "error" error } }
+{ $description "Handles an error that may have occurred during the processing of a request. The rules are: 1) if the error is caused by an empty request line, it is silenced because it is a redundant dummy request issued by certain browsers. 2) if the error is a " { $link request-error } " then it is logged and the client is served a 400 Bad Request. 3) all other errors are thrown upwards." } ;
+
 HELP: http-server
 { $class-description "The class of HTTP servers. New instances are created by calling " { $link <http-server> } "." } ;
 

basis/http/server/server.factor

@@ -2,8 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel accessors sequences arrays namespaces splitting
 vocabs.loader destructors assocs debugger continuations
-combinators combinators.short-circuit vocabs.refresh tools.time math
-present vectors hashtables
+combinators combinators.short-circuit vocabs.refresh
+tools.time math present vectors hashtables
 io
 io.sockets
 io.sockets.secure
@@ -29,7 +29,6 @@ html.streams
 html
 mime.types
 math.order
-peg
 xml.writer
 vocabs ;
 IN: http.server
@@ -224,9 +223,13 @@ SYMBOL: request-limit
 
 request-limit [ 64 1024 * ] initialize
 
+LOG: httpd-bad-request NOTICE
+
 : handle-client-error ( error -- )
-    dup { [ bad-request-line? ] [ parse-error>> got>> empty? ] } 1&&
-    [ drop ] [ rethrow ] if ;
+    dup request-error? [
+        dup { [ bad-request-line? ] [ parse-error>> got>> empty? ] } 1&&
+        [ drop ] [ httpd-bad-request <400> write-response ] if
+    ] [ rethrow ] if ;
 
 M: http-server handle-client*
     drop [