From 1fe67f40c6f9f7ed038483a555912d58bdf117ac Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Thir=C3=A9?= Date: Fri, 3 Jan 2025 18:00:14 +0100 Subject: [PATCH 1/2] Ensure shutdown function does not raise exception on ENOTCONN --- src/lwt_ssl.ml | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/lwt_ssl.ml b/src/lwt_ssl.ml index b178b94..f82e574 100644 --- a/src/lwt_ssl.ml +++ b/src/lwt_ssl.ml @@ -166,7 +166,10 @@ let ssl_shutdown (fd, s) = Plain -> Lwt.return_unit | SSL s -> repeat_call fd (fun () -> Ssl.shutdown s) -let shutdown (fd, _) cmd = Lwt_unix.shutdown fd cmd +let shutdown (fd, _) cmd = + try Lwt_unix.shutdown fd cmd + with + | Unix.Unix_error (Unix.ENOTCONN, _, _) -> () let close_notify = function | (_, Plain) as s -> From 3da4bc3151a17ee71e1e8a201bd12f2c3f5b9c84 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Thir=C3=A9?= Date: Sat, 4 Jan 2025 11:17:43 +0100 Subject: [PATCH 2/2] Move the shutdown function into Lwt --- src/lwt_ssl.ml | 19 ++++++++++++++----- src/lwt_ssl.mli | 2 +- 2 files changed, 15 insertions(+), 6 deletions(-) diff --git a/src/lwt_ssl.ml b/src/lwt_ssl.ml index f82e574..2c50469 100644 --- a/src/lwt_ssl.ml +++ b/src/lwt_ssl.ml @@ -167,13 +167,22 @@ let ssl_shutdown (fd, s) = | SSL s -> repeat_call fd (fun () -> Ssl.shutdown s) let shutdown (fd, _) cmd = - try Lwt_unix.shutdown fd cmd - with - | Unix.Unix_error (Unix.ENOTCONN, _, _) -> () + Lwt.finalize + (fun () -> + Lwt.catch + (fun () -> + Lwt_unix.shutdown fd cmd; + Lwt.return_unit) + (function + (* Occurs if the peer closes the connection first. *) + | Unix.Unix_error (Unix.ENOTCONN, _, _) -> Lwt.return_unit + | exn -> Lwt.reraise exn)[@ocaml.warning "-4"]) + (fun () -> + Lwt_unix.close fd) let close_notify = function | (_, Plain) as s -> - shutdown s Unix.SHUTDOWN_SEND; + shutdown s Unix.SHUTDOWN_SEND >>= fun () -> Lwt.return_true | (fd, SSL s) -> repeat_call fd (fun () -> Ssl.close_notify s) @@ -184,7 +193,7 @@ let abort (fd, _) = Lwt_unix.abort fd let shutdown_and_close s = ssl_shutdown s >>= fun () -> - Lwt.wrap2 shutdown s Unix.SHUTDOWN_ALL >>= fun () -> + shutdown s Unix.SHUTDOWN_ALL >>= fun () -> close s let out_channel_of_descr ?buffer s = diff --git a/src/lwt_ssl.mli b/src/lwt_ssl.mli index ac91ee0..0b7f8e1 100644 --- a/src/lwt_ssl.mli +++ b/src/lwt_ssl.mli @@ -68,7 +68,7 @@ val write_bytes : socket -> Lwt_bytes.t -> int -> int -> int Lwt.t val wait_read : socket -> unit Lwt.t val wait_write : socket -> unit Lwt.t -val shutdown : socket -> Unix.shutdown_command -> unit +val shutdown : socket -> Unix.shutdown_command -> unit Lwt.t val close : socket -> unit Lwt.t val in_channel_of_descr : ?buffer:Lwt_bytes.t -> socket -> Lwt_io.input_channel