diff --git a/bin/cohttp_server_lwt.ml b/bin/cohttp_server_lwt.ml index 9a6cd112dc..f3d5ac1770 100644 --- a/bin/cohttp_server_lwt.ml +++ b/bin/cohttp_server_lwt.ml @@ -101,7 +101,10 @@ let start_server docroot port host index verbose cert key () = | Some c, Some k -> `TLS (`Crt_file_path c, `Key_file_path k, `No_password, `Port port) | _ -> `TCP (`Port port) in - Server.create ~mode config + Conduit_lwt_unix.init ~src:host () + >>= fun ctx -> + let ctx = Cohttp_lwt_unix_net.init ~ctx () in + Server.create ~ctx ~mode config let lwt_start_server docroot port host index verbose cert key = Lwt_main.run (start_server docroot port host index verbose cert key ()) diff --git a/lwt/cohttp_lwt_unix.ml b/lwt/cohttp_lwt_unix.ml index 8a6982e35b..883229026f 100644 --- a/lwt/cohttp_lwt_unix.ml +++ b/lwt/cohttp_lwt_unix.ml @@ -34,7 +34,7 @@ module Client = struct Cohttp_lwt.Make_client (Cohttp_lwt_unix_io)(Request)(Response)(Cohttp_lwt_unix_net) - let custom_ctx = Cohttp_lwt_unix_net.custom_ctx + let custom_ctx = Cohttp_lwt_unix_net.init end module Server_core = diff --git a/lwt/cohttp_lwt_unix_net.ml b/lwt/cohttp_lwt_unix_net.ml index 93b187d88b..546d3e3fc8 100644 --- a/lwt/cohttp_lwt_unix_net.ml +++ b/lwt/cohttp_lwt_unix_net.ml @@ -22,16 +22,13 @@ open Lwt module IO = Cohttp_lwt_unix_io -type 'a io = 'a Lwt.t -type ic = Lwt_io.input_channel -type oc = Lwt_io.output_channel type ctx = { ctx: Conduit_lwt_unix.ctx; resolver: Resolver_lwt.t; } with sexp_of -let init ?(resolver=Resolver_lwt_unix.system) - ?(ctx=Conduit_lwt_unix.default_ctx) () = +let init ?(ctx=Conduit_lwt_unix.default_ctx) + ?(resolver=Resolver_lwt_unix.system) () = { ctx; resolver } let default_ctx = { @@ -39,9 +36,6 @@ let default_ctx = { ctx = Conduit_lwt_unix.default_ctx; } -let custom_ctx ?(ctx=Conduit_lwt_unix.default_ctx) ?(resolver=Resolver_lwt_unix.system) () = - { ctx; resolver } - let connect_uri ~ctx uri = Resolver_lwt.resolve_uri ~uri ctx.resolver >>= fun endp -> diff --git a/lwt/cohttp_lwt_unix_net.mli b/lwt/cohttp_lwt_unix_net.mli new file mode 100644 index 0000000000..6b1bb2a6f4 --- /dev/null +++ b/lwt/cohttp_lwt_unix_net.mli @@ -0,0 +1,43 @@ + (* + * Copyright (c) 2015 David Sheets + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + * + *) + +(** Basic satisfaction of {! Cohttp_lwt.Net } *) + +module IO : Cohttp.S.IO + with type 'a t = 'a Lwt.t + and type ic = Lwt_io.input_channel + and type oc = Lwt_io.output_channel + and type conn = Conduit_lwt_unix.flow + +type ctx = { + ctx : Conduit_lwt_unix.ctx; + resolver : Resolver_lwt.t; +} with sexp_of + +val init : ?ctx:Conduit_lwt_unix.ctx -> ?resolver:Resolver_lwt.t -> unit -> ctx + +val default_ctx : ctx + +val connect_uri : + ctx:ctx -> + Uri.t -> + (Conduit_lwt_unix.flow * Conduit_lwt_unix.ic * Conduit_lwt_unix.oc) Lwt.t + +val close_in : 'a Lwt_io.channel -> unit +val close_out : 'a Lwt_io.channel -> unit + +val close : 'a Lwt_io.channel -> 'b Lwt_io.channel -> unit