From aa8394c171d53a5e3ff0e63b399d34969db38187 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Mon, 15 Dec 2014 18:59:11 -0500 Subject: [PATCH 1/5] conn alias for lwt servers --- lwt/cohttp_lwt.ml | 14 ++++++++------ lwt/cohttp_lwt.mli | 7 ++++--- 2 files changed, 12 insertions(+), 9 deletions(-) diff --git a/lwt/cohttp_lwt.ml b/lwt/cohttp_lwt.ml index 7825fc6b7d..290804082c 100644 --- a/lwt/cohttp_lwt.ml +++ b/lwt/cohttp_lwt.ml @@ -219,14 +219,15 @@ module type Server = sig type ctx with sexp_of val default_ctx : ctx + type conn = IO.conn * Cohttp.Connection.t + type t = { callback : - (IO.conn * Cohttp.Connection.t) -> + conn -> Cohttp.Request.t -> Cohttp_lwt_body.t -> (Cohttp.Response.t * Cohttp_lwt_body.t) Lwt.t; - conn_closed: - (IO.conn * Cohttp.Connection.t) -> unit -> unit; + conn_closed: conn -> unit -> unit; } val resolve_local_file : docroot:string -> uri:Uri.t -> string @@ -273,14 +274,15 @@ module Make_server(IO:Cohttp.S.IO with type 'a t = 'a Lwt.t) type ctx = Net.ctx with sexp_of let default_ctx = Net.default_ctx + type conn = IO.conn * Cohttp.Connection.t + type t = { callback : - (IO.conn * Cohttp.Connection.t) -> + conn -> Cohttp.Request.t -> Cohttp_lwt_body.t -> (Cohttp.Response.t * Cohttp_lwt_body.t) Lwt.t; - conn_closed: - (IO.conn * Cohttp.Connection.t) -> unit -> unit; + conn_closed: conn -> unit -> unit; } module Transfer_IO = Transfer_io.Make(IO) diff --git a/lwt/cohttp_lwt.mli b/lwt/cohttp_lwt.mli index b29e7b4944..381a21ae86 100644 --- a/lwt/cohttp_lwt.mli +++ b/lwt/cohttp_lwt.mli @@ -161,14 +161,15 @@ module type Server = sig type ctx with sexp_of val default_ctx : ctx + type conn = IO.conn * Cohttp.Connection.t + type t = { callback : - (IO.conn * Cohttp.Connection.t) -> + conn -> Cohttp.Request.t -> Cohttp_lwt_body.t -> (Cohttp.Response.t * Cohttp_lwt_body.t) Lwt.t; - conn_closed: - (IO.conn * Cohttp.Connection.t) -> unit -> unit; + conn_closed: conn -> unit -> unit; } (** Resolve a URI and a docroot into a concrete local filename. *) From b08ca10db0cdc69968254e88e701af65b2fb976e Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Mon, 15 Dec 2014 19:23:09 -0500 Subject: [PATCH 2/5] create constructor for lwt servers --- lwt/cohttp_lwt.ml | 8 ++++++++ lwt/cohttp_lwt.mli | 5 +++++ 2 files changed, 13 insertions(+) diff --git a/lwt/cohttp_lwt.ml b/lwt/cohttp_lwt.ml index 290804082c..3a565086a9 100644 --- a/lwt/cohttp_lwt.ml +++ b/lwt/cohttp_lwt.ml @@ -230,6 +230,11 @@ module type Server = sig conn_closed: conn -> unit -> unit; } + val create : ?conn_closed:(conn -> unit -> unit) + -> callback:(conn -> Cohttp.Request.t -> Cohttp_lwt_body.t + -> (Cohttp.Response.t * Cohttp_lwt_body.t) Lwt.t) + -> t + val resolve_local_file : docroot:string -> uri:Uri.t -> string val respond : @@ -285,6 +290,9 @@ module Make_server(IO:Cohttp.S.IO with type 'a t = 'a Lwt.t) conn_closed: conn -> unit -> unit; } + let create ?(conn_closed=(fun _ -> ignore)) ~callback = + { conn_closed ; callback } + module Transfer_IO = Transfer_io.Make(IO) let resolve_local_file ~docroot ~uri = diff --git a/lwt/cohttp_lwt.mli b/lwt/cohttp_lwt.mli index 381a21ae86..db2bc443ad 100644 --- a/lwt/cohttp_lwt.mli +++ b/lwt/cohttp_lwt.mli @@ -172,6 +172,11 @@ module type Server = sig conn_closed: conn -> unit -> unit; } + val create : ?conn_closed:(conn -> unit -> unit) + -> callback:(conn -> Cohttp.Request.t -> Cohttp_lwt_body.t + -> (Cohttp.Response.t * Cohttp_lwt_body.t) Lwt.t) + -> t + (** Resolve a URI and a docroot into a concrete local filename. *) val resolve_local_file : docroot:string -> uri:Uri.t -> string From d57a692f70e6d7fb4b1bb64bc6239707af058a4c Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Mon, 15 Dec 2014 19:38:12 -0500 Subject: [PATCH 3/5] rename create -> make --- lwt/cohttp_lwt.ml | 4 ++-- lwt/cohttp_lwt.mli | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/lwt/cohttp_lwt.ml b/lwt/cohttp_lwt.ml index 3a565086a9..db44f5e235 100644 --- a/lwt/cohttp_lwt.ml +++ b/lwt/cohttp_lwt.ml @@ -230,7 +230,7 @@ module type Server = sig conn_closed: conn -> unit -> unit; } - val create : ?conn_closed:(conn -> unit -> unit) + val make : ?conn_closed:(conn -> unit -> unit) -> callback:(conn -> Cohttp.Request.t -> Cohttp_lwt_body.t -> (Cohttp.Response.t * Cohttp_lwt_body.t) Lwt.t) -> t @@ -290,7 +290,7 @@ module Make_server(IO:Cohttp.S.IO with type 'a t = 'a Lwt.t) conn_closed: conn -> unit -> unit; } - let create ?(conn_closed=(fun _ -> ignore)) ~callback = + let make ?(conn_closed=(fun _ -> ignore)) ~callback = { conn_closed ; callback } module Transfer_IO = Transfer_io.Make(IO) diff --git a/lwt/cohttp_lwt.mli b/lwt/cohttp_lwt.mli index db2bc443ad..59a72d82e2 100644 --- a/lwt/cohttp_lwt.mli +++ b/lwt/cohttp_lwt.mli @@ -172,7 +172,7 @@ module type Server = sig conn_closed: conn -> unit -> unit; } - val create : ?conn_closed:(conn -> unit -> unit) + val make : ?conn_closed:(conn -> unit -> unit) -> callback:(conn -> Cohttp.Request.t -> Cohttp_lwt_body.t -> (Cohttp.Response.t * Cohttp_lwt_body.t) Lwt.t) -> t From 668deddeab03508152da8b7806b3fea0d2a2280b Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Mon, 15 Dec 2014 19:44:23 -0500 Subject: [PATCH 4/5] Server.t should be abstract in the lwt backend --- bin/cohttp_server_lwt.ml | 2 +- lib_test/test_net_lwt_client_and_server.ml | 2 +- lib_test/test_net_lwt_server.ml | 2 +- lwt/cohttp_lwt.ml | 9 +-------- lwt/cohttp_lwt.mli | 9 +-------- 5 files changed, 5 insertions(+), 19 deletions(-) diff --git a/bin/cohttp_server_lwt.ml b/bin/cohttp_server_lwt.ml index ceeb330420..751ab33d19 100644 --- a/bin/cohttp_server_lwt.ml +++ b/bin/cohttp_server_lwt.ml @@ -140,7 +140,7 @@ let start_server docroot port host index verbose cert key () = printf "connection %s closed\n%!" (Sexplib.Sexp.to_string_hum (Conduit_lwt_unix.sexp_of_flow ch)) in let callback = handler ~info ~docroot ~verbose ~index in - let config = { Server.callback; conn_closed } in + let config = Server.make ~callback ~conn_closed in let mode = match cert, key with | Some c, Some k -> `TLS (`Crt_file_path c, `Key_file_path k, `No_password, `Port port) | _ -> `TCP (`Port port) diff --git a/lib_test/test_net_lwt_client_and_server.ml b/lib_test/test_net_lwt_client_and_server.ml index fe4a550f7d..c25e36217f 100644 --- a/lib_test/test_net_lwt_client_and_server.ml +++ b/lib_test/test_net_lwt_client_and_server.ml @@ -44,7 +44,7 @@ let make_server () = lwt ctx = Conduit_lwt_unix.init ~src:address () in let ctx = Cohttp_lwt_unix_net.init ~ctx () in let mode = `TCP (`Port port) in - let config = { Server.callback; conn_closed } in + let config = Server.make ~callback ~conn_closed in Server.create ~ctx ~mode config let not_none n t fn = diff --git a/lib_test/test_net_lwt_server.ml b/lib_test/test_net_lwt_server.ml index 804801ceeb..4ed31ebb01 100644 --- a/lib_test/test_net_lwt_server.ml +++ b/lib_test/test_net_lwt_server.ml @@ -94,7 +94,7 @@ let make_server () = let conn_closed (ch,conn_id) () = Printf.eprintf "conn %s closed\n%!" (Connection.to_string conn_id) in - let config = { Server.callback; conn_closed } in + let config = Server.make ~callback ~conn_closed in let ctx = Cohttp_lwt_unix_net.init () in let port = 8081 in let tcp_mode = `TCP (`Port port) in diff --git a/lwt/cohttp_lwt.ml b/lwt/cohttp_lwt.ml index db44f5e235..9d8e61174e 100644 --- a/lwt/cohttp_lwt.ml +++ b/lwt/cohttp_lwt.ml @@ -221,14 +221,7 @@ module type Server = sig type conn = IO.conn * Cohttp.Connection.t - type t = { - callback : - conn -> - Cohttp.Request.t -> - Cohttp_lwt_body.t -> - (Cohttp.Response.t * Cohttp_lwt_body.t) Lwt.t; - conn_closed: conn -> unit -> unit; - } + type t val make : ?conn_closed:(conn -> unit -> unit) -> callback:(conn -> Cohttp.Request.t -> Cohttp_lwt_body.t diff --git a/lwt/cohttp_lwt.mli b/lwt/cohttp_lwt.mli index 59a72d82e2..99564bea4e 100644 --- a/lwt/cohttp_lwt.mli +++ b/lwt/cohttp_lwt.mli @@ -163,14 +163,7 @@ module type Server = sig type conn = IO.conn * Cohttp.Connection.t - type t = { - callback : - conn -> - Cohttp.Request.t -> - Cohttp_lwt_body.t -> - (Cohttp.Response.t * Cohttp_lwt_body.t) Lwt.t; - conn_closed: conn -> unit -> unit; - } + type t val make : ?conn_closed:(conn -> unit -> unit) -> callback:(conn -> Cohttp.Request.t -> Cohttp_lwt_body.t From b90189d3e92b3577ad6950ebe0806f7895a73c6c Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Mon, 15 Dec 2014 20:21:40 -0500 Subject: [PATCH 5/5] simplify conn_closed callback --- bin/cohttp_server_lwt.ml | 2 +- lib_test/test_net_lwt_client_and_server.ml | 3 +-- lib_test/test_net_lwt_server.ml | 2 +- lwt/cohttp_lwt.ml | 9 +++++---- lwt/cohttp_lwt.mli | 2 +- 5 files changed, 9 insertions(+), 9 deletions(-) diff --git a/bin/cohttp_server_lwt.ml b/bin/cohttp_server_lwt.ml index 751ab33d19..dfa226ce0d 100644 --- a/bin/cohttp_server_lwt.ml +++ b/bin/cohttp_server_lwt.ml @@ -136,7 +136,7 @@ let string_of_sockaddr = function let start_server docroot port host index verbose cert key () = printf "Listening for HTTP request on: %s %d\n" host port; let info = sprintf "Served by Cohttp/Lwt listening on %s:%d" host port in - let conn_closed (ch,conn) () = + let conn_closed (ch,conn) = printf "connection %s closed\n%!" (Sexplib.Sexp.to_string_hum (Conduit_lwt_unix.sexp_of_flow ch)) in let callback = handler ~info ~docroot ~verbose ~index in diff --git a/lib_test/test_net_lwt_client_and_server.ml b/lib_test/test_net_lwt_client_and_server.ml index c25e36217f..a720ca92c1 100644 --- a/lib_test/test_net_lwt_client_and_server.ml +++ b/lib_test/test_net_lwt_client_and_server.ml @@ -40,11 +40,10 @@ let make_server () = Server.respond_string ~status:`OK ~body:"nodrain" () |_ -> exit 0 in - let conn_closed _ () = () in lwt ctx = Conduit_lwt_unix.init ~src:address () in let ctx = Cohttp_lwt_unix_net.init ~ctx () in let mode = `TCP (`Port port) in - let config = Server.make ~callback ~conn_closed in + let config = Server.make ~callback in Server.create ~ctx ~mode config let not_none n t fn = diff --git a/lib_test/test_net_lwt_server.ml b/lib_test/test_net_lwt_server.ml index 4ed31ebb01..9670cb6e63 100644 --- a/lib_test/test_net_lwt_server.ml +++ b/lib_test/test_net_lwt_server.ml @@ -91,7 +91,7 @@ let make_server () = let fname = Server.resolve_file ~docroot:"." ~uri:(Request.uri req) in Server.respond_file ~fname () in - let conn_closed (ch,conn_id) () = + let conn_closed (ch,conn_id) = Printf.eprintf "conn %s closed\n%!" (Connection.to_string conn_id) in let config = Server.make ~callback ~conn_closed in diff --git a/lwt/cohttp_lwt.ml b/lwt/cohttp_lwt.ml index 9d8e61174e..17ca1a20ec 100644 --- a/lwt/cohttp_lwt.ml +++ b/lwt/cohttp_lwt.ml @@ -223,7 +223,7 @@ module type Server = sig type t - val make : ?conn_closed:(conn -> unit -> unit) + val make : ?conn_closed:(conn -> unit) -> callback:(conn -> Cohttp.Request.t -> Cohttp_lwt_body.t -> (Cohttp.Response.t * Cohttp_lwt_body.t) Lwt.t) -> t @@ -280,10 +280,10 @@ module Make_server(IO:Cohttp.S.IO with type 'a t = 'a Lwt.t) Cohttp.Request.t -> Cohttp_lwt_body.t -> (Cohttp.Response.t * Cohttp_lwt_body.t) Lwt.t; - conn_closed: conn -> unit -> unit; + conn_closed: conn -> unit; } - let make ?(conn_closed=(fun _ -> ignore)) ~callback = + let make ?(conn_closed=ignore) ~callback = { conn_closed ; callback } module Transfer_IO = Transfer_io.Make(IO) @@ -330,6 +330,7 @@ module Make_server(IO:Cohttp.S.IO with type 'a t = 'a Lwt.t) let callback spec = let daemon_callback io_id ic oc = let conn_id = Connection.create () in + let conn_closed () = spec.conn_closed (io_id,conn_id) in let read_m = Lwt_mutex.create () in (* If the request is HTTP version 1.0 then the request stream should be considered closed after the first request/response. *) @@ -375,7 +376,7 @@ module Make_server(IO:Cohttp.S.IO with type 'a t = 'a Lwt.t) ) req_stream in (* Clean up resources when the response stream terminates and call * the user callback *) - Lwt_stream.on_terminate res_stream (spec.conn_closed (io_id,conn_id)); + Lwt_stream.on_terminate res_stream conn_closed; (* Transmit the responses *) for_lwt (res,body) in res_stream do let flush = Response.flush res in diff --git a/lwt/cohttp_lwt.mli b/lwt/cohttp_lwt.mli index 99564bea4e..82cb7fe4b0 100644 --- a/lwt/cohttp_lwt.mli +++ b/lwt/cohttp_lwt.mli @@ -165,7 +165,7 @@ module type Server = sig type t - val make : ?conn_closed:(conn -> unit -> unit) + val make : ?conn_closed:(conn -> unit) -> callback:(conn -> Cohttp.Request.t -> Cohttp_lwt_body.t -> (Cohttp.Response.t * Cohttp_lwt_body.t) Lwt.t) -> t