RPC: TLS bugfixes

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

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 ->

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 () ->

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 ->