diff --git a/CHANGES.md b/CHANGES.md index 0922d5f0..cd9be572 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,3 +1,10 @@ +## Unreleased + +* change the type of `Conduit_lwt_tls.X509.default_authenticator` and + `Conduit_lwt_unix.default_ctx` to be lazy, avoiding various side-effects + (system interactions, logging) due to constructing these values at + initialisation time. (@craigfe, #395) + ## v4.0.0 (2021-04-15) * conduit-mirage: replace the alias `X509_lwt.priv` by diff --git a/src/conduit-lwt-unix/conduit_lwt_tls.real.ml b/src/conduit-lwt-unix/conduit_lwt_tls.real.ml index 148345bc..8c7b1cf7 100644 --- a/src/conduit-lwt-unix/conduit_lwt_tls.real.ml +++ b/src/conduit-lwt-unix/conduit_lwt_tls.real.ml @@ -23,9 +23,10 @@ module X509 = struct type authenticator = X509.Authenticator.t let default_authenticator = - match Ca_certs.authenticator () with - | Ok a -> a - | Error (`Msg msg) -> failwith msg + lazy + (match Ca_certs.authenticator () with + | Ok a -> a + | Error (`Msg msg) -> failwith msg) end module Client = struct diff --git a/src/conduit-lwt-unix/conduit_lwt_tls.real.mli b/src/conduit-lwt-unix/conduit_lwt_tls.real.mli index a7d0f783..8eba4d40 100644 --- a/src/conduit-lwt-unix/conduit_lwt_tls.real.mli +++ b/src/conduit-lwt-unix/conduit_lwt_tls.real.mli @@ -23,7 +23,7 @@ module X509 : sig type authenticator = X509.Authenticator.t - val default_authenticator : authenticator + val default_authenticator : authenticator Lazy.t end module Client : sig diff --git a/src/conduit-lwt-unix/conduit_lwt_unix.ml b/src/conduit-lwt-unix/conduit_lwt_unix.ml index 2d3bd2a0..208d202b 100644 --- a/src/conduit-lwt-unix/conduit_lwt_unix.ml +++ b/src/conduit-lwt-unix/conduit_lwt_unix.ml @@ -149,14 +149,16 @@ let flow_of_fd fd sa = TCP { fd; ip = Ipaddr_unix.of_inet_addr ip; port } let default_ctx = - { - src = None; - tls_own_key = `None; - tls_authenticator = Conduit_lwt_tls.X509.default_authenticator; - } + lazy + { + src = None; + tls_own_key = `None; + tls_authenticator = Lazy.force Conduit_lwt_tls.X509.default_authenticator; + } let init ?src ?(tls_own_key = `None) - ?(tls_authenticator = Conduit_lwt_tls.X509.default_authenticator) () = + ?(tls_authenticator = Lazy.force Conduit_lwt_tls.X509.default_authenticator) + () = match src with | None -> Lwt.return { src = None; tls_own_key; tls_authenticator } | Some host -> ( diff --git a/src/conduit-lwt-unix/conduit_lwt_unix.mli b/src/conduit-lwt-unix/conduit_lwt_unix.mli index cdcb032f..1fb1d9d9 100644 --- a/src/conduit-lwt-unix/conduit_lwt_unix.mli +++ b/src/conduit-lwt-unix/conduit_lwt_unix.mli @@ -153,7 +153,7 @@ type ctx [@@deriving sexp_of] (** {2 Connection and listening} *) -val default_ctx : ctx +val default_ctx : ctx Lazy.t (** Default context that listens on all source addresses with no TLS certificate associated with the Conduit *) diff --git a/tests/conduit-lwt-unix/cdtest_tls.ml b/tests/conduit-lwt-unix/cdtest_tls.ml index 122b0449..e47ea118 100644 --- a/tests/conduit-lwt-unix/cdtest_tls.ml +++ b/tests/conduit-lwt-unix/cdtest_tls.ml @@ -49,7 +49,7 @@ let perform () = let client = `TLS (`Hostname "", `IP Ipaddr.(V6 V6.localhost), `Port port) in - Conduit_lwt_unix.(connect ~ctx:default_ctx client) + Conduit_lwt_unix.(connect ~ctx:(Lazy.force default_ctx) client) >>= fun (_flow, ic, oc) -> Lwt_log.notice "Connected!" >>= fun () -> Lwt_io.write oc "hello" >>= fun () ->