From cdb34ca7d32a3151cbe93df571a355b286c0257c Mon Sep 17 00:00:00 2001 From: Vincent Bernardoff Date: Tue, 13 Dec 2016 01:52:55 +0100 Subject: [PATCH] RPC: TLS bugfixes --- src/node/net/RPC_server.ml | 5 +++-- src/node/net/RPC_server.mli | 4 +++- src/node_main.ml | 5 +++-- src/webclient_main.ml | 7 ++++--- 4 files changed, 13 insertions(+), 8 deletions(-) diff --git a/src/node/net/RPC_server.ml b/src/node/net/RPC_server.ml index 07daeb927..ad06f240e 100644 --- a/src/node/net/RPC_server.ml +++ b/src/node/net/RPC_server.ml @@ -54,7 +54,7 @@ let make_cors_headers ?(headers=Cohttp.Header.init ()) "Access-Control-Allow-Origin" [allowed_origin] (* Promise a running RPC server. Takes the port. *) -let launch mode ?pre_hook ?post_hook root cors_allowed_origins cors_allowed_headers = +let launch ?pre_hook ?post_hook ?(host="::") mode root cors_allowed_origins cors_allowed_headers = (* launch the worker *) let cancelation, canceler, _ = Lwt_utils.canceler () in let open Cohttp_lwt_unix in @@ -180,7 +180,8 @@ let launch mode ?pre_hook ?post_hook root cors_allowed_origins cors_allowed_head and conn_closed (_, con) = log_info "connection close %s" (Cohttp.Connection.to_string con) ; shutdown_stream con in - let ctx = Cohttp_lwt_unix_net.init () in + Conduit_lwt_unix.init ~src:host () >>= fun ctx -> + let ctx = Cohttp_lwt_unix_net.init ~ctx () in let stop = cancelation () in let _server = Server.create diff --git a/src/node/net/RPC_server.mli b/src/node/net/RPC_server.mli index 279c3d699..2d196d82e 100644 --- a/src/node/net/RPC_server.mli +++ b/src/node/net/RPC_server.mli @@ -35,9 +35,11 @@ type server another resolution mechanism. Its result is ignored if the return code is [404]. The optional [post_hook] is called if both the [pre_hook] and the serviced answered with a [404] code. *) -val launch : Conduit_lwt_unix.server -> +val launch : ?pre_hook: (string -> string RPC.Answer.answer Lwt.t) -> ?post_hook: (string -> string RPC.Answer.answer Lwt.t) -> + ?host:string -> + Conduit_lwt_unix.server -> unit RPC.directory -> string list -> string list -> diff --git a/src/node_main.ml b/src/node_main.ml index b5cf74b83..3f1a9e1a2 100644 --- a/src/node_main.ml +++ b/src/node_main.ml @@ -454,11 +454,12 @@ let init_node { sandbox ; sandbox_param ; let init_rpc { rpc_addr ; rpc_crt; rpc_key ; cors_origins ; cors_headers } node = match rpc_addr, rpc_crt, rpc_key with - | Some (_addr, port), Some crt, Some key -> + | Some (addr, port), Some crt, Some key -> lwt_log_notice "Starting the RPC server listening on port %d (TLS enabled)." port >>= fun () -> let dir = Node_rpc.build_rpc_directory node in let mode = `TLS_native (`Crt_file_path crt, `Key_file_path key, `No_password, `Port port) in - RPC_server.launch mode dir cors_origins cors_headers >>= fun server -> + let host = Ipaddr.to_string addr in + RPC_server.launch ~host mode dir cors_origins cors_headers >>= fun server -> Lwt.return (Some server) | Some (_addr, port), _, _ -> lwt_log_notice "Starting the RPC server listening on port %d (TLS disabled)." port >>= fun () -> diff --git a/src/webclient_main.ml b/src/webclient_main.ml index 52ca74bfd..575790f8f 100644 --- a/src/webclient_main.ml +++ b/src/webclient_main.ml @@ -149,7 +149,7 @@ let find_static_file path = Some (OCamlRes.Res.find (index path) Webclient_static.root) with Not_found -> None) -let http_proxy port = +let http_proxy mode = let pre_hook path = find_static_file path >>= function | Some body -> @@ -163,7 +163,7 @@ let http_proxy port = | None -> Lwt.return (RPC.Answer.Empty)) >>= fun body -> Lwt.return { RPC.Answer.code = 404 ; body } in - RPC_server.launch ~pre_hook ~post_hook port root [] [] + RPC_server.launch ~pre_hook ~post_hook mode root [] [] let web_port = Client_config.in_both_groups @@ new Config_file.int_cp [ "web" ; "port" ] 8080 @@ -182,7 +182,8 @@ let () = Sys.argv Client_commands.ignore_context>>= fun _no_command -> Random.self_init () ; Sodium.Random.stir () ; - http_proxy web_port#get >>= fun _server -> + (* TODO: add TLS? *) + http_proxy (`TCP (`Port web_port#get)) >>= fun _server -> fst (Lwt.wait ())) (function | Arg.Help help ->