http.server.requests: system for read-request for reporting errors

The idea is that read-request throws request-error if something is
wrong with the request. handle-client* can then catch it and respond
with 400 bad request. This way you can differentiate between bad
requests and requests that causes the HTTP server to crash.

basis/http/server/requests/requests-docs.factor

@@ -3,7 +3,13 @@ IN: http.server.requests
 
 HELP: read-request
 { $values { "request" request } }
-{ $description "Reads a HTTP requests from the input stream." } ;
+{ $description "Reads a HTTP requests from the input stream. If the request is not valid or can not be parsed, then a " { $link request-error } " is thrown." } ;
+
+HELP: request-error
+{ $class-description "Thrown by " { $link read-request } " if the HTTP request was invalid." } ;
+
+HELP: bad-request-line
+{ $class-description "Thrown by " { $link read-request } " if the HTTP requests request line could not be parsed." } ;
 
 ARTICLE: "http.server.requests" "Deserializing HTTP requests"
 "The " { $vocab-link "http.server.requests" } " reads requests from the " { $link input-stream } " and creates " { $link request } " tuples." ;

basis/http/server/requests/requests-tests.factor

@@ -1,5 +1,5 @@
-USING: accessors assocs http http.server http.server.requests
+USING: accessors assocs continuations http http.server http.server.requests
-io.streams.limited io.streams.string kernel multiline namespaces sequences
+io.streams.limited io.streams.string kernel multiline namespaces peg sequences
 splitting tools.test urls ;
 IN: http.server.requests.tests
 
@@ -99,6 +99,42 @@ hello
     [ filename>> ] [ headers>> ] bi
 ] unit-test
 
+! Error handling
+! If the incoming request is not valid, read-request should throw an
+! appropriate error.
+STRING: test-multipart/form-data-missing-boundary
+POST / HTTP/1.1
+Accept: */*
+Accept-Encoding: gzip, deflate
+Connection: keep-alive
+Content-Length: 151
+Content-Type: multipart/form-data; abcd
+Host: localhost:8000
+User-Agent: HTTPie/0.9.0-dev
+
+--768de80194d942619886d23f1337aa15
+Content-Disposition: form-data; name="text"; filename="upload.txt"
+
+hello
+--768de80194d942619886d23f1337aa15--
+
+;
+{ t } [
+    [
+        test-multipart/form-data-missing-boundary string>request
+    ] [ no-boundary? ] recover
+] unit-test
+
+! Relative urls are invalid.
+{ "foo" } [
+    [ "GET foo HTTP/1.1" string>request ] [ path>> ] recover
+] unit-test
+
+! Empty request lines
+{ t } [
+    [ "" string>request ] [ parse-error>> parse-error? ] recover
+] unit-test
+
 ! RFC 2616: Section 4.1
 ! In the interest of robustness, servers SHOULD ignore any empty
 ! line(s) received where a Request-Line is expected. In other words, if

basis/http/server/requests/requests.factor

@@ -1,18 +1,27 @@
-USING: accessors combinators http http.parsers io io.crlf io.encodings
+USING: accessors combinators continuations http http.parsers io io.crlf
-io.encodings.binary io.streams.limited kernel math.order math.parser
+io.encodings io.encodings.binary io.streams.limited kernel math.order
-namespaces sequences splitting urls urls.encoding ;
+math.parser namespaces sequences splitting urls urls.encoding ;
 FROM: mime.multipart => parse-multipart ;
 IN: http.server.requests
 
-ERROR: no-boundary ;
+ERROR: request-error ;
 
-: check-absolute ( url -- url )
+ERROR: no-boundary < request-error ;
-    dup path>> "/" head? [ "Bad request: URL" throw ] unless ; inline
+
+ERROR: invalid-path < request-error path ;
+
+ERROR: bad-request-line < request-error parse-error ;
+
+: check-absolute ( url -- )
+    path>> dup "/" head? [ drop ] [ invalid-path ] if ; inline
+
+: parse-request-line-safe ( string -- triple )
+    [ parse-request-line ] [ nip bad-request-line ] recover ;
 
 : read-request-line ( request -- request )
     read-?crlf [ dup "" = ] [ drop read-?crlf ] while
-    parse-request-line first3
+    parse-request-line-safe first3
-    [ >>method ] [ >url check-absolute >>url ] [ >>version ] tri* ;
+    [ >>method ] [ >url dup check-absolute >>url ] [ >>version ] tri* ;
 
 : read-request-header ( request -- request )
     read-header >>header ;

basis/http/server/server-tests.factor

@@ -1,6 +1,6 @@
 USING: accessors assocs continuations http http.server
-io.encodings.utf8 io.encodings.binary io.streams.string kernel
+http.server.requests io.encodings.utf8 io.encodings.binary io.streams.string
-math peg sequences tools.test urls ;
+kernel math peg sequences tools.test urls ;
 IN: http.server.tests
 
 [ t ] [ [ \ + first ] [ <500> ] recover response? ] unit-test
@@ -82,7 +82,9 @@ IN: http.server.tests
 ! Don't rethrow parse-errors with an empty request string. They are
 ! expected from certain browsers when the server serves a certificate
 ! that the browser can't verify.
-{ } [ 0 "" f <parse-error> handle-client-error ] unit-test
+{ } [
+    0 "" f <parse-error> \ bad-request-line boa handle-client-error
+] unit-test
 
 [
     0 "not empty" f <parse-error> handle-client-error

basis/http/server/server.factor

@@ -225,7 +225,8 @@ SYMBOL: request-limit
 request-limit [ 64 1024 * ] initialize
 
 : handle-client-error ( error -- )
-    dup { [ parse-error? ] [ got>> empty? ] } 1&& [ drop ] [ rethrow ] if ;
+    dup { [ bad-request-line? ] [ parse-error>> got>> empty? ] } 1&&
+    [ drop ] [ rethrow ] if ;
 
 M: http-server handle-client*
     drop [