Merge pull request #1027 from semgrep/master

make Cohttp_lwt_unix.default_ctx lazy

CHANGES.md

@@ -4,6 +4,8 @@
 - cohttp-eio: Improve error handling in example server (talex5 #1023)
 - cohttp-eio: Don't blow up `Server.callback` on client disconnections. (mefyl #1015)
 - http: Fix assertion in `Source.to_string_trim` when `pos <> 0` (mefyl #1017)
+- cohttp-lwt-unix: Don't blow up when certificates are not available and no-network requests are made. (akuhlens #1027)
+  + Makes `cohttp-lwt.S.default_ctx` lazy. 
 
 ## v6.0.0~beta2 (2024-01-05)
 

cohttp-lwt-unix/src/net.ml

@@ -28,10 +28,11 @@ let init ?(ctx = Lazy.force Conduit_lwt_unix.default_ctx)
   { ctx; resolver }
 
 let default_ctx =
-  {
-    resolver = Resolver_lwt_unix.system;
-    ctx = Lazy.force Conduit_lwt_unix.default_ctx;
-  }
+  lazy
+    {
+      resolver = Resolver_lwt_unix.system;
+      ctx = Lazy.force Conduit_lwt_unix.default_ctx;
+    }
 
 type endp = Conduit.endp
 

cohttp-lwt-unix/src/server.ml

@@ -65,7 +65,7 @@ let log_on_exn = function
   | exn -> Log.err (fun m -> m "Unhandled exception: %a" Fmt.exn exn)
 
 let create ?timeout ?backlog ?stop ?(on_exn = log_on_exn)
-    ?(ctx = Net.default_ctx) ?(mode = `TCP (`Port 8080)) spec =
+    ?(ctx = Lazy.force Net.default_ctx) ?(mode = `TCP (`Port 8080)) spec =
   Conduit_lwt_unix.serve ?backlog ?timeout ?stop ~on_exn ~ctx:ctx.Net.ctx ~mode
     (fun flow ic oc ->
       let ic = Input_channel.create ic in

cohttp-lwt-unix/test/test_client.ml

@@ -127,7 +127,8 @@ let test_client uri =
 (* Simple case: The server is known to support pipelining and won't close the
  * connection unexpectantly (timeout or number of requests may be limited). *)
 let test_persistent uri =
-  Connection.Net.resolve ~ctx:Connection.Net.default_ctx
+  Connection.Net.resolve
+    ~ctx:(Lazy.force Connection.Net.default_ctx)
     uri (* resolve hostname. *)
   >>= Connection.connect ~persistent:true
   >>= fun connection ->
@@ -140,7 +141,8 @@ let test_persistent uri =
  * This might result in a massive amount of parallel connections. *)
 let test_non_persistent uri =
   (* the resolved endpoint may be buffered to avoid stressing the resolver: *)
-  Connection.Net.resolve ~ctx:Connection.Net.default_ctx uri >>= fun endp ->
+  Connection.Net.resolve ~ctx:(Lazy.force Connection.Net.default_ctx) uri
+  >>= fun endp ->
   let handler ?headers ?body meth uri =
     Connection.connect ~persistent:false endp >>= fun connection ->
     Connection.call connection ?headers ?body meth uri
@@ -151,7 +153,8 @@ let test_non_persistent uri =
  * not be supported or the server may close the connection unexpectedly.
  * In such a case the pending requests will fail with Connection.Retry. *)
 let test_unknown uri =
-  Connection.Net.resolve ~ctx:Connection.Net.default_ctx uri >>= fun endp ->
+  Connection.Net.resolve ~ctx:(Lazy.force Connection.Net.default_ctx) uri
+  >>= fun endp ->
   (* buffer resolved endp *)
   Connection.connect ~persistent:false endp >>= fun c ->
   let connection = ref c in

cohttp-lwt-unix/test/test_sanity.ml

@@ -78,7 +78,7 @@ let check_logs test () =
 
 let ts =
   Cohttp_lwt_unix_test.test_server_s server (fun uri ->
-      let ctx = Cohttp_lwt_unix.Net.default_ctx in
+      let ctx = Lazy.force Cohttp_lwt_unix.Net.default_ctx in
       let t () =
         Client.get ~ctx uri >>= fun (_, body) ->
         body |> Body.to_string >|= fun body -> assert_equal body message

cohttp-lwt-unix/test/test_sanity_noisy.ml

@@ -35,7 +35,7 @@ let server_noisy =
 
 let ts_noisy =
   Cohttp_lwt_unix_test.test_server_s ~port:10193 server_noisy (fun uri ->
-      let ctx = Cohttp_lwt_unix.Net.default_ctx in
+      let ctx = Lazy.force Cohttp_lwt_unix.Net.default_ctx in
       let empty_chunk () =
         Client.get ~ctx uri >>= fun (_, body) ->
         body |> Body.to_string >|= fun body ->

cohttp-lwt/src/client.ml

@@ -51,7 +51,7 @@ module Make (Connection : S.Connection) = struct
     let body = Body.of_string (Uri.encoded_of_query params) in
     post ?ctx ~chunked:false ~headers ~body uri
 
-  let callv ?(ctx = Net.default_ctx) uri reqs =
+  let callv ?(ctx = Lazy.force Net.default_ctx) uri reqs =
     let mutex = Lwt_mutex.create () in
     Net.resolve ~ctx uri >>= Connection.connect ~ctx >>= fun connection ->
     Lwt.return

cohttp-lwt/src/connection.ml

@@ -264,7 +264,7 @@ module Make (Net : S.Net) : S.Connection with module Net = Net = struct
     | Connecting _ -> assert false
 
   let create ?(finalise = fun _ -> Lwt.return_unit) ?persistent
-      ?(ctx = Net.default_ctx) endp =
+      ?(ctx = Lazy.force Net.default_ctx) endp =
     let persistent =
       match persistent with
       | None -> `Unknown

cohttp-lwt/src/connection_cache.ml

@@ -18,7 +18,7 @@ end = struct
 
   let call = Fun.id
 
-  let create ?(ctx = Net.default_ctx) () ?headers ?body meth uri =
+  let create ?(ctx = Lazy.force Net.default_ctx) () ?headers ?body meth uri =
     Net.resolve ~ctx uri
     (* TODO: Support chunked encoding without ~persistent:true ? *)
     >>= Connection.connect ~ctx ~persistent:true
@@ -85,8 +85,8 @@ end = struct
     depth : int;
   }
 
-  let create ?(ctx = Net.default_ctx) ?(keep = 60_000_000_000L) ?(retry = 2)
-      ?(parallel = 4) ?(depth = 100) () =
+  let create ?(ctx = Lazy.force Net.default_ctx) ?(keep = 60_000_000_000L)
+      ?(retry = 2) ?(parallel = 4) ?(depth = 100) () =
     {
       cache = Hashtbl.create ~random:true 10;
       ctx;

cohttp-lwt/src/s.ml

@@ -34,7 +34,7 @@ module type Net = sig
       installed on the system, [cohttp]/[conduit] tries the usual ([*:80]) or
       the specified port by the user in a non-secured way. *)
 
-  val default_ctx : ctx
+  val default_ctx : ctx Lazy.t
 
   val resolve : ctx:ctx -> Uri.t -> endp IO.t
   (** [resolve ~ctx uri] resolves [uri] into an endpoint description. This is

cohttp-mirage/src/net.ml

@@ -18,7 +18,7 @@ struct
   let sexp_of_ctx { resolver; _ } = R.sexp_of_t resolver
 
   let default_ctx =
-    { resolver = R.localhost; conduit = None; authenticator = None }
+    lazy { resolver = R.localhost; conduit = None; authenticator = None }
 
   type endp = Conduit.endp