From b7e9ace8fcd2e07f3923a427d2bee8dd1e7cbf70 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Reynir=20Bj=C3=B6rnsson?= Date: Fri, 5 Jan 2024 13:43:10 +0100 Subject: [PATCH 1/2] H2: shutdown the connection once finished --- src/http_lwt_client.ml | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/http_lwt_client.ml b/src/http_lwt_client.ml index 80f2b9b..1fd99dc 100644 --- a/src/http_lwt_client.ml +++ b/src/http_lwt_client.ml @@ -214,8 +214,7 @@ let single_h2_request ?config fd scheme user_pass host meth path headers body f Lwt.wakeup_later notify_finished v; w := true in - let on_eof response data () = wakeup (Ok (response, data)) - in + let on_eof response data () = wakeup (Ok (response, data)) in let response_handler response response_body = let response : response = { version = { major = 2 ; minor = 0 } ; @@ -268,7 +267,9 @@ let single_h2_request ?config fd scheme user_pass host meth path headers body f | Some body -> H2.Body.Writer.write_string request_body body | None -> ()); H2.Body.Writer.close request_body; - finished + finished >|= fun res -> + H2.Client_connection.shutdown connection; + res let alpn_protocol = function | `Plain _ -> None From 976bb80d5e90f8b4bab685dc174ab7c985f4b5a0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Reynir=20Bj=C3=B6rnsson?= Date: Fri, 5 Jan 2024 16:39:37 +0100 Subject: [PATCH 2/2] Use Lwt.finalize to shutdown H2 client connection --- src/http_lwt_client.ml | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/src/http_lwt_client.ml b/src/http_lwt_client.ml index 1fd99dc..cf99138 100644 --- a/src/http_lwt_client.ml +++ b/src/http_lwt_client.ml @@ -267,9 +267,11 @@ let single_h2_request ?config fd scheme user_pass host meth path headers body f | Some body -> H2.Body.Writer.write_string request_body body | None -> ()); H2.Body.Writer.close request_body; - finished >|= fun res -> - H2.Client_connection.shutdown connection; - res + Lwt.finalize + (fun () -> finished) + (fun () -> + H2.Client_connection.shutdown connection; + Lwt.return_unit) let alpn_protocol = function | `Plain _ -> None