From 1403516e038da25573be08281d3f783335008b6f Mon Sep 17 00:00:00 2001 From: Sven Anderson Date: Tue, 19 Dec 2017 14:30:34 +0100 Subject: [PATCH 1/3] Add log warnings for uncaught exceptions Lwt.ignore_result doesn't catch exceptions, which can result in uncatchable exceptions, because these exceptions would be handled by Lwt.async_exception_hook. As a follow up to PR #589 this change makes sure all exceptions are caught and a warning log message is produced. --- cohttp-lwt-unix/src/debug.ml | 8 +++++++- cohttp-lwt-unix/src/net.ml | 15 ++++++++++----- cohttp-lwt-unix/src/server.ml | 19 +++++++++++++------ cohttp-mirage/src/client.ml | 6 +++++- 4 files changed, 35 insertions(+), 13 deletions(-) diff --git a/cohttp-lwt-unix/src/debug.ml b/cohttp-lwt-unix/src/debug.ml index aeae0ea9a5..61e3506d9e 100644 --- a/cohttp-lwt-unix/src/debug.ml +++ b/cohttp-lwt-unix/src/debug.ml @@ -28,7 +28,13 @@ let default_reporter () = let k _ = let write () = Lwt_io.write Lwt_io.stderr (fmtr_flush ()) in let unblock () = over (); Lwt.return_unit in - Lwt.finalize write unblock |> Lwt.ignore_result; + Lwt.ignore_result @@ Lwt.catch + (fun () -> Lwt.finalize write unblock) + (fun e -> + Logs.warn (fun f -> + f "Flushing stderr failed: %s" (Printexc.to_string e)); + Lwt.return_unit + ); k () in msgf @@ fun ?header:_ ?tags:_ fmt -> diff --git a/cohttp-lwt-unix/src/net.ml b/cohttp-lwt-unix/src/net.ml index 503b8dad52..a0d2665423 100644 --- a/cohttp-lwt-unix/src/net.ml +++ b/cohttp-lwt-unix/src/net.ml @@ -17,7 +17,7 @@ (* Miscellaneous net-helpers used by Cohttp. Ideally, these will disappear * into some connection-management framework such as andrenth/release *) -open Lwt +open Lwt.Infix module IO = Io @@ -42,10 +42,15 @@ let connect_uri ~ctx uri = >>= fun client -> Conduit_lwt_unix.connect ~ctx:ctx.ctx client -let close c = Lwt.catch (fun () -> Lwt_io.close c) (fun _ -> return_unit) +let close c = Lwt.catch + (fun () -> Lwt_io.close c) + (fun e -> + Logs.warn (fun f -> f "Closing channel failed: %s" (Printexc.to_string e)); + Lwt.return_unit + ) -let close_in ic = ignore_result (close ic) +let close_in ic = Lwt.ignore_result (close ic) -let close_out oc = ignore_result (close oc) +let close_out oc = Lwt.ignore_result (close oc) -let close ic oc = ignore_result (close ic >>= fun () -> close oc) +let close ic oc = Lwt.ignore_result (close ic >>= fun () -> close oc) diff --git a/cohttp-lwt-unix/src/server.ml b/cohttp-lwt-unix/src/server.ml index 0efc09469b..f028ea5714 100644 --- a/cohttp-lwt-unix/src/server.ml +++ b/cohttp-lwt-unix/src/server.ml @@ -2,7 +2,7 @@ module Server_core = Cohttp_lwt.Make_server (Io) include Server_core -open Lwt +open Lwt.Infix let blank_uri = Uri.of_string "" @@ -17,8 +17,8 @@ let respond_file ?headers ~fname () = (* Check this isnt a directory first *) (fname |> Lwt_unix.stat >>= fun s -> if Unix.(s.st_kind <> S_REG) - then fail Isnt_a_file - else return_unit) >>= fun () -> + then Lwt.fail Isnt_a_file + else Lwt.return_unit) >>= fun () -> let count = 16384 in Lwt_io.open_file ~buffer:(Lwt_bytes.create count) @@ -32,16 +32,23 @@ let respond_file ?headers ~fname () = | buf -> Some buf) (fun exn -> Lwt_log.ign_debug ~exn ("Error resolving file " ^ fname); - return_none) + Lwt.return_none) ) in Lwt.on_success (Lwt_stream.closed stream) (fun () -> - ignore_result (Lwt_io.close ic)); + Lwt.ignore_result @@ Lwt.catch + (fun () -> Lwt_io.close ic) + (fun e -> + Logs.warn (fun f -> + f "Closing channel failed: %s" (Printexc.to_string e)); + Lwt.return_unit + ) + ); let body = Cohttp_lwt.Body.of_stream stream in let mime_type = Magic_mime.lookup fname in let headers = Cohttp.Header.add_opt_unless_exists headers "content-type" mime_type in let res = Cohttp.Response.make ~status:`OK ~encoding ~headers () in - return (res, body) + Lwt.return (res, body) ) (function | Unix.Unix_error(Unix.ENOENT,_,_) | Isnt_a_file -> respond_not_found () diff --git a/cohttp-mirage/src/client.ml b/cohttp-mirage/src/client.ml index 623bb3556e..dd5ea62059 100644 --- a/cohttp-mirage/src/client.ml +++ b/cohttp-mirage/src/client.ml @@ -47,7 +47,11 @@ module Net_IO = struct let close_out _ = () let close ic _oc = Lwt.ignore_result @@ Lwt.catch (fun () -> Channel.close ic) - (fun e -> Lwt.return @@ Ok ()) + (fun e -> + Logs.warn (fun f -> + f "Closing channel failed: %s" (Printexc.to_string e)); + Lwt.return @@ Ok () + ) end let ctx resolver conduit = { Net_IO.resolver; conduit } From 38ef18e654572e7e5e28d4041694d8f53e57d8ab Mon Sep 17 00:00:00 2001 From: Marcello Seri Date: Thu, 13 Dec 2018 17:06:47 +0100 Subject: [PATCH 2/3] server: use the source specific Log module --- cohttp-lwt-unix/src/server.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cohttp-lwt-unix/src/server.ml b/cohttp-lwt-unix/src/server.ml index 88696e9581..1e5e0382c5 100644 --- a/cohttp-lwt-unix/src/server.ml +++ b/cohttp-lwt-unix/src/server.ml @@ -34,7 +34,7 @@ let respond_file ?headers ~fname () = | "" -> None | buf -> Some buf) (fun exn -> - Logs.debug + Log.debug (fun m -> m "Error resolving file %s (%s)" fname (Printexc.to_string exn)); @@ -44,7 +44,7 @@ let respond_file ?headers ~fname () = Lwt.ignore_result @@ Lwt.catch (fun () -> Lwt_io.close ic) (fun e -> - Logs.warn (fun f -> + Log.warn (fun f -> f "Closing channel failed: %s" (Printexc.to_string e)); Lwt.return_unit ) From 5f5840fb2d4d0ce820add2086d07ff76d6f26d3c Mon Sep 17 00:00:00 2001 From: Marcello Seri Date: Thu, 13 Dec 2018 17:13:54 +0100 Subject: [PATCH 3/3] debug: fix error from resolving merge conflicts --- cohttp-lwt-unix/src/debug.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cohttp-lwt-unix/src/debug.ml b/cohttp-lwt-unix/src/debug.ml index a12aa055cc..23d77c48ea 100644 --- a/cohttp-lwt-unix/src/debug.ml +++ b/cohttp-lwt-unix/src/debug.ml @@ -31,7 +31,7 @@ let default_reporter () = let write () = Lwt_io.write Lwt_io.stderr (fmtr_flush ()) in let unblock () = over (); Lwt.return_unit in Lwt.ignore_result @@ Lwt.catch - (fun () -> Lwt.finalize write unblock : unit Lwt.t) + (fun () -> (Lwt.finalize write unblock : unit Lwt.t)) (fun e -> Logs.warn (fun f -> f "Flushing stderr failed: %s" (Printexc.to_string e));