Skip to content

Commit

Permalink
Merge pull request #1027 from semgrep/master
Browse files Browse the repository at this point in the history
make Cohttp_lwt_unix.default_ctx lazy
  • Loading branch information
mseri authored May 3, 2024
2 parents 5efbcec + e588cec commit c2b2271
Show file tree
Hide file tree
Showing 11 changed files with 23 additions and 17 deletions.
2 changes: 2 additions & 0 deletions CHANGES.md
Original file line number Diff line number Diff line change
Expand Up @@ -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)

Expand Down
9 changes: 5 additions & 4 deletions cohttp-lwt-unix/src/net.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
2 changes: 1 addition & 1 deletion cohttp-lwt-unix/src/server.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
9 changes: 6 additions & 3 deletions cohttp-lwt-unix/test/test_client.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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 ->
Expand All @@ -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
Expand All @@ -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
Expand Down
2 changes: 1 addition & 1 deletion cohttp-lwt-unix/test/test_sanity.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion cohttp-lwt-unix/test/test_sanity_noisy.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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 ->
Expand Down
2 changes: 1 addition & 1 deletion cohttp-lwt/src/client.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion cohttp-lwt/src/connection.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
6 changes: 3 additions & 3 deletions cohttp-lwt/src/connection_cache.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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;
Expand Down
2 changes: 1 addition & 1 deletion cohttp-lwt/src/s.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion cohttp-mirage/src/net.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down

0 comments on commit c2b2271

Please sign in to comment.