From 6d3405a2ae2cc3fe1bcac2baf2c08e5a8ea9d525 Mon Sep 17 00:00:00 2001
From: Antonio Nuno Monteiro <anmonteiro@gmail.com>
Date: Sun, 9 Dec 2018 00:35:27 +0000
Subject: [PATCH] Catch parse errors and hand them to error_handler

refs #18
---
 lib/parse.ml                   |  7 ++++++-
 lib/server_connection.ml       |  3 ++-
 lib_test/simulator.ml          |  1 +
 lib_test/test_httpaf_server.ml | 10 +++++++++-
 4 files changed, 18 insertions(+), 3 deletions(-)

diff --git a/lib/parse.ml b/lib/parse.ml
index d17f443..0082d4d 100644
--- a/lib/parse.ml
+++ b/lib/parse.ml
@@ -310,12 +310,17 @@ module Reader = struct
     ignore (read_with_more t Bigstringaf.empty ~off:0 ~len:0 Complete : int);
   ;;
 
+  let is_parse_failure t =
+    match t.parse_state with
+    | Fail _ -> true
+    | _ -> false
+
   let next t =
     match t.parse_state with
     | Done ->
       if t.closed
       then `Close
       else `Read
-    | Fail    _ -> `Close
+    | Fail failure -> `Error failure
     | Partial _ -> `Read
 end
diff --git a/lib/server_connection.ml b/lib/server_connection.ml
index ee3c653..1f06812 100644
--- a/lib/server_connection.ml
+++ b/lib/server_connection.ml
@@ -195,6 +195,7 @@ let set_error_and_handle ?request t error =
     t.error_handler ?request error (fun headers ->
       Writer.write_response writer (Response.create ~headers status);
       Body.of_faraday (Writer.faraday writer));
+    shutdown_writer t;
   end
 
 let report_exn t exn =
@@ -219,7 +220,7 @@ let advance_request_queue_if_necessary t =
       else if not (Reqd.requires_input reqd)
       then shutdown_reader t
     end
-  end else if Reader.is_closed t.reader
+  end else if Reader.is_closed t.reader && (not (Reader.is_parse_failure t.reader))
   then shutdown t
 
 let _next_read_operation t =
diff --git a/lib_test/simulator.ml b/lib_test/simulator.ml
index 21e7d57..46d6c8f 100644
--- a/lib_test/simulator.ml
+++ b/lib_test/simulator.ml
@@ -25,6 +25,7 @@ let body_to_strings = function
 ;;
 
 let case_to_strings = function
+  | `Raw      r, body -> r @ (body_to_strings body)
   | `Request  r, body -> [request_to_string  r] @ (body_to_strings body)
   | `Response r, body -> [response_to_string r] @ (body_to_strings body)
 
diff --git a/lib_test/test_httpaf_server.ml b/lib_test/test_httpaf_server.ml
index 578dae3..10fb52f 100644
--- a/lib_test/test_httpaf_server.ml
+++ b/lib_test/test_httpaf_server.ml
@@ -26,7 +26,7 @@ let single_get =
     , Simulator.test_server
         ~handler: (basic_handler "")
         ~input:   [(`Request (Request.create `GET "/")), `Empty]
-        ~output:  [(`Response (Response.create `OK)   ), `Empty]
+        ~output:  [(`Response (Response.create `OK)), `Empty]
   ; "single GET, close connection"
     , `Quick
     , Simulator.test_server
@@ -67,6 +67,14 @@ let single_get =
                   , `Fixed ["This is a test ... that involves multiple chunks"] ];
       Alcotest.(check bool "got eof" !got_eof true);
     end
+  ; "single GET, malformed request"
+  , `Quick
+  , Simulator.test_server
+      ~handler: (basic_handler "")
+      ~input:   [ `Raw [ "GET / HTTP/1.1\r\nconnection: close\r\nX-Other-Header : shouldnt_have_space_before_colon\r\n\r\n" ]
+                , `Empty
+                ]
+      ~output:  [(`Response (Response.create `Bad_request)), `Fixed ["400"]]
   ]
 ;;