From 0345a622bfb6d9b775038e4a0269045ac331579a Mon Sep 17 00:00:00 2001 From: Aaron Dufour Date: Tue, 31 Mar 2020 12:05:06 +0800 Subject: [PATCH 1/6] Fix replacing non-trailing headers --- lib/headers.ml | 6 +++--- lib_test/test_httpaf.ml | 9 ++++++++- 2 files changed, 11 insertions(+), 4 deletions(-) diff --git a/lib/headers.ml b/lib/headers.ml index 6c5320c..ff6fce0 100644 --- a/lib/headers.ml +++ b/lib/headers.ml @@ -95,9 +95,9 @@ let replace t name value = if CI.equal needle name then ( if seen - then loop t name nv true - else nv::loop t name nv true) - else nv'::loop t name nv seen + then loop t needle nv true + else nv::loop t needle nv true) + else nv'::loop t needle nv seen in try loop t name (name,value) false with Local -> t diff --git a/lib_test/test_httpaf.ml b/lib_test/test_httpaf.ml index 223e586..333565b 100644 --- a/lib_test/test_httpaf.ml +++ b/lib_test/test_httpaf.ml @@ -126,6 +126,13 @@ module Headers = struct "a" "d"); + check "replace middle element" + ~expect:["e", "f"; "c", "z"; "a", "b"] + (Headers.replace + (Headers.of_list ["e", "f"; "c", "d"; "a", "b"]) + "c" + "z"); + check "remove multiple trailing elements" ~expect:["c", "d"; "a", "d"] (Headers.replace @@ -994,7 +1001,7 @@ module Client_connection = struct let tests = [ "GET" , `Quick, test_get ; "Response EOF", `Quick, test_response_eof - ; "report_exn" , `Quick, test_report_exn + ; "report_exn" , `Quick, test_report_exn ; "input_shrunk", `Quick, test_input_shrunk ] end From 09c3774a1020b335ba6e70a8a8ca81b98f862df9 Mon Sep 17 00:00:00 2001 From: Spiros Eliopoulos Date: Thu, 2 Apr 2020 18:23:09 -0400 Subject: [PATCH 2/6] optional-thunk: implement an optional thunk module This module implements an option value specialized for thunks. It uses the identity function as a special value to represent none, which means that a "some" value cannot be constructed using the identity function. --- lib/optional_thunk.ml | 11 +++++++++++ lib/optional_thunk.mli | 9 +++++++++ 2 files changed, 20 insertions(+) create mode 100644 lib/optional_thunk.ml create mode 100644 lib/optional_thunk.mli diff --git a/lib/optional_thunk.ml b/lib/optional_thunk.ml new file mode 100644 index 0000000..5a8cf96 --- /dev/null +++ b/lib/optional_thunk.ml @@ -0,0 +1,11 @@ +type t = unit -> unit + +let none = Sys.opaque_identity (fun () -> ()) +let some f = + if f == none + then failwith "Optional_thunk: this function is not representable as a some value"; + f + +let is_none t = t == none +let is_some t = not (is_none t) +let unchecked_value t = t diff --git a/lib/optional_thunk.mli b/lib/optional_thunk.mli new file mode 100644 index 0000000..dd36f50 --- /dev/null +++ b/lib/optional_thunk.mli @@ -0,0 +1,9 @@ +type t + +val none : t +val some : (unit -> unit) -> t + +val is_none : t -> bool +val is_some : t -> bool + +val unchecked_value : t -> unit -> unit From 367db0115e6e38fe96e4f877ededf360d4cd1c21 Mon Sep 17 00:00:00 2001 From: Spiros Eliopoulos Date: Thu, 2 Apr 2020 18:28:52 -0400 Subject: [PATCH 3/6] optional-thunk: use Optional_thunk in Server_connection --- lib/server_connection.ml | 34 +++++++++++++++++----------------- 1 file changed, 17 insertions(+), 17 deletions(-) diff --git a/lib/server_connection.ml b/lib/server_connection.ml index fbaaa8b..d57b5c4 100644 --- a/lib/server_connection.ml +++ b/lib/server_connection.ml @@ -64,12 +64,10 @@ type t = ; request_queue : Reqd.t Queue.t (* invariant: If [request_queue] is not empty, then the head of the queue has already had [request_handler] called on it. *) - ; mutable wakeup_writer : (unit -> unit) - ; mutable wakeup_reader : (unit -> unit) + ; mutable wakeup_writer : Optional_thunk.t + ; mutable wakeup_reader : Optional_thunk.t } -let default_wakeup = Sys.opaque_identity (fun () -> ()) - let is_closed t = Reader.is_closed t.reader && Writer.is_closed t.writer @@ -85,35 +83,37 @@ let current_reqd_exn t = let yield_reader t k = if is_closed t then failwith "on_wakeup_reader on closed conn" - else if not (t.wakeup_reader == default_wakeup); + else if Optional_thunk.is_some t.wakeup_reader then failwith "yield_reader: only one callback can be registered at a time" - else t.wakeup_reader <- k + else t.wakeup_reader <- Optional_thunk.some k ;; let wakeup_reader t = let f = t.wakeup_reader in - t.wakeup_reader <- default_wakeup; - f () + t.wakeup_reader <- Optional_thunk.none; + Optional_thunk.unchecked_value f () ;; let on_wakeup_writer t k = if is_closed t then failwith "on_wakeup_writer on closed conn" - else if not (t.wakeup_writer == default_wakeup) + else if Optional_thunk.is_some t.wakeup_writer then failwith "yield_writer: only one callback can be registered at a time" - else t.wakeup_writer <- k + else t.wakeup_writer <- Optional_thunk.some k ;; let wakeup_writer t = let f = t.wakeup_writer in - t.wakeup_writer <- default_wakeup; - f () + t.wakeup_writer <- Optional_thunk.none; + Optional_thunk.unchecked_value f () ;; let transfer_writer_callback t reqd = - let f = t.wakeup_writer in - t.wakeup_writer <- default_wakeup; - Reqd.on_more_output_available reqd f + if Optional_thunk.is_some t.wakeup_writer + then ( + let f = t.wakeup_writer in + t.wakeup_writer <- Optional_thunk.none; + Reqd.on_more_output_available reqd (Optional_thunk.unchecked_value f)) ;; let default_error_handler ?request:_ error handle = @@ -149,8 +149,8 @@ let create ?(config=Config.default) ?(error_handler=default_error_handler) reque ; request_handler = request_handler ; error_handler = error_handler ; request_queue - ; wakeup_writer = default_wakeup - ; wakeup_reader = default_wakeup + ; wakeup_writer = Optional_thunk.none + ; wakeup_reader = Optional_thunk.none } let shutdown_reader t = From a28322bea9010f1f91a4a7f887830a9cb6ca207c Mon Sep 17 00:00:00 2001 From: Spiros Eliopoulos Date: Thu, 2 Apr 2020 18:37:22 -0400 Subject: [PATCH 4/6] optional-thunk: Use Optional_thunk in body This is just used for the ready_to_write callback. The read callbacks are already guarded by a bool. --- lib/body.ml | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) diff --git a/lib/body.ml b/lib/body.ml index dbca1c3..cdbc513 100644 --- a/lib/body.ml +++ b/lib/body.ml @@ -37,13 +37,12 @@ type _ t = ; mutable write_final_if_chunked : bool ; mutable on_eof : unit -> unit ; mutable on_read : Bigstringaf.t -> off:int -> len:int -> unit - ; mutable when_ready_to_write : unit -> unit + ; mutable when_ready_to_write : Optional_thunk.t ; buffered_bytes : int ref } let default_on_eof = Sys.opaque_identity (fun () -> ()) let default_on_read = Sys.opaque_identity (fun _ ~off:_ ~len:_ -> ()) -let default_ready_to_write = Sys.opaque_identity (fun () -> ()) let of_faraday faraday = { faraday @@ -51,7 +50,7 @@ let of_faraday faraday = ; write_final_if_chunked = true ; on_eof = default_on_eof ; on_read = default_on_read - ; when_ready_to_write = default_ready_to_write + ; when_ready_to_write = Optional_thunk.none ; buffered_bytes = ref 0 } @@ -79,8 +78,8 @@ let schedule_bigstring t ?off ?len (b:Bigstringaf.t) = let ready_to_write t = let callback = t.when_ready_to_write in - t.when_ready_to_write <- default_ready_to_write; - callback () + t.when_ready_to_write <- Optional_thunk.none; + Optional_thunk.unchecked_value callback () let flush t kontinue = Faraday.flush t.faraday kontinue; @@ -145,11 +144,11 @@ let close_reader t = ;; let when_ready_to_write t callback = - if not (t.when_ready_to_write == default_ready_to_write) - then failwith "Body.when_ready_to_write: only one callback can be registered at a time" - else if is_closed t + if is_closed t then callback () - else t.when_ready_to_write <- callback + else if Optional_thunk.is_some t.when_ready_to_write + then failwith "Body.when_ready_to_write: only one callback can be registered at a time" + else t.when_ready_to_write <- Optional_thunk.some callback let transfer_to_writer_with_encoding t ~encoding writer = let faraday = t.faraday in From 01f7bcf2316545642a632114370056fe715897f3 Mon Sep 17 00:00:00 2001 From: Spiros Eliopoulos Date: Thu, 2 Apr 2020 18:40:17 -0400 Subject: [PATCH 5/6] optional-thunk: use Optional_thunk in Reqd --- lib/reqd.ml | 16 +++++++--------- 1 file changed, 7 insertions(+), 9 deletions(-) diff --git a/lib/reqd.ml b/lib/reqd.ml index f598f5b..87dbbea 100644 --- a/lib/reqd.ml +++ b/lib/reqd.ml @@ -35,7 +35,7 @@ type error = [ `Bad_request | `Bad_gateway | `Internal_server_error | `Exn of exn ] type response_state = - | Waiting of (unit -> unit) ref + | Waiting of Optional_thunk.t ref | Complete of Response.t | Streaming of Response.t * [`write] Body.t @@ -78,8 +78,6 @@ type t = ; mutable error_code : [`Ok | error ] } -let default_waiting = Sys.opaque_identity (fun () -> ()) - let create error_handler request request_body writer response_body_buffer = { request ; request_body @@ -87,14 +85,14 @@ let create error_handler request request_body writer response_body_buffer = ; response_body_buffer ; error_handler ; persistent = Request.persistent_connection request - ; response_state = Waiting (ref default_waiting) + ; response_state = Waiting (ref Optional_thunk.none) ; error_code = `Ok } let done_waiting when_done_waiting = let f = !when_done_waiting in - when_done_waiting := default_waiting; - f () + when_done_waiting := Optional_thunk.none; + Optional_thunk.unchecked_value f () let request { request; _ } = request let request_body { request_body; _ } = request_body @@ -213,9 +211,9 @@ let error_code t = let on_more_output_available t f = match t.response_state with | Waiting when_done_waiting -> - if not (!when_done_waiting == default_waiting) then - failwith "httpaf.Reqd.on_more_output_available: only one callback can be registered at a time"; - when_done_waiting := f + if Optional_thunk.is_some !when_done_waiting + then failwith "httpaf.Reqd.on_more_output_available: only one callback can be registered at a time"; + when_done_waiting := Optional_thunk.some f | Streaming(_, response_body) -> Body.when_ready_to_write response_body f | Complete _ -> From 1e5dcee51b6737231112268c1708be6d8a442388 Mon Sep 17 00:00:00 2001 From: Spiros Eliopoulos Date: Fri, 3 Apr 2020 11:12:31 -0400 Subject: [PATCH 6/6] call-if-some: add Optional_thunk.call_if_some and use it Replace calls to to `Optional_thunk.unchecked_value f ()` with `Optional_think.call_if_some f`. Sounds safer, and if the none type ever changes representation no call sites need to change. --- lib/body.ml | 2 +- lib/optional_thunk.ml | 1 + lib/optional_thunk.mli | 1 + lib/reqd.ml | 2 +- lib/server_connection.ml | 4 ++-- 5 files changed, 6 insertions(+), 4 deletions(-) diff --git a/lib/body.ml b/lib/body.ml index cdbc513..f1a13db 100644 --- a/lib/body.ml +++ b/lib/body.ml @@ -79,7 +79,7 @@ let schedule_bigstring t ?off ?len (b:Bigstringaf.t) = let ready_to_write t = let callback = t.when_ready_to_write in t.when_ready_to_write <- Optional_thunk.none; - Optional_thunk.unchecked_value callback () + Optional_thunk.call_if_some callback let flush t kontinue = Faraday.flush t.faraday kontinue; diff --git a/lib/optional_thunk.ml b/lib/optional_thunk.ml index 5a8cf96..6d6d822 100644 --- a/lib/optional_thunk.ml +++ b/lib/optional_thunk.ml @@ -8,4 +8,5 @@ let some f = let is_none t = t == none let is_some t = not (is_none t) +let call_if_some t = t () let unchecked_value t = t diff --git a/lib/optional_thunk.mli b/lib/optional_thunk.mli index dd36f50..8894520 100644 --- a/lib/optional_thunk.mli +++ b/lib/optional_thunk.mli @@ -6,4 +6,5 @@ val some : (unit -> unit) -> t val is_none : t -> bool val is_some : t -> bool +val call_if_some : t -> unit val unchecked_value : t -> unit -> unit diff --git a/lib/reqd.ml b/lib/reqd.ml index 87dbbea..c74b4f9 100644 --- a/lib/reqd.ml +++ b/lib/reqd.ml @@ -92,7 +92,7 @@ let create error_handler request request_body writer response_body_buffer = let done_waiting when_done_waiting = let f = !when_done_waiting in when_done_waiting := Optional_thunk.none; - Optional_thunk.unchecked_value f () + Optional_thunk.call_if_some f let request { request; _ } = request let request_body { request_body; _ } = request_body diff --git a/lib/server_connection.ml b/lib/server_connection.ml index d57b5c4..7fb9d93 100644 --- a/lib/server_connection.ml +++ b/lib/server_connection.ml @@ -91,7 +91,7 @@ let yield_reader t k = let wakeup_reader t = let f = t.wakeup_reader in t.wakeup_reader <- Optional_thunk.none; - Optional_thunk.unchecked_value f () + Optional_thunk.call_if_some f ;; let on_wakeup_writer t k = @@ -105,7 +105,7 @@ let on_wakeup_writer t k = let wakeup_writer t = let f = t.wakeup_writer in t.wakeup_writer <- Optional_thunk.none; - Optional_thunk.unchecked_value f () + Optional_thunk.call_if_some f ;; let transfer_writer_callback t reqd =