commit
61bea21033
@ -85,6 +85,10 @@ let incoming_port = in_both_groups @@
|
||||
new int_cp [ "port" ] ~short_name:"P" 8732
|
||||
"The TCP port at which the node's RPC server can be reached."
|
||||
|
||||
let tls = in_both_groups @@
|
||||
new bool_cp [ "tls" ] false
|
||||
"Use TLS to connect to node."
|
||||
|
||||
(* Version specific options *)
|
||||
|
||||
let contextual_options : (unit -> unit) ref Protocol_hash_table.t =
|
||||
@ -191,6 +195,11 @@ let preparse_args argv cctxt : Node_rpc_services.Blocks.block Lwt.t =
|
||||
"Error: can't read the configuration file: %s\n%!" msg
|
||||
else Lwt.return ()
|
||||
end >>= fun () ->
|
||||
begin
|
||||
match preparse "-tls" argv with
|
||||
| None -> ()
|
||||
| Some _ -> tls#set true
|
||||
end ;
|
||||
begin
|
||||
match preparse "-addr" argv with
|
||||
| None -> ()
|
||||
|
@ -24,10 +24,12 @@ let cpt = ref 0
|
||||
let make_request cctxt service json =
|
||||
incr cpt ;
|
||||
let cpt = !cpt in
|
||||
let serv = "http://" ^ Client_config.incoming_addr#get
|
||||
^ ":" ^ string_of_int Client_config.incoming_port#get in
|
||||
let string_uri = String.concat "/" (serv :: service) in
|
||||
let uri = Uri.of_string string_uri in
|
||||
let scheme = if Client_config.tls#get then "https" else "http" in
|
||||
let host = Client_config.incoming_addr#get in
|
||||
let port = Client_config.incoming_port#get in
|
||||
let path = String.concat "/" service in
|
||||
let uri = Uri.make ~scheme ~host ~port ~path () in
|
||||
let string_uri = Uri.to_string uri in
|
||||
let reqbody = Data_encoding_ezjsonm.to_string json in
|
||||
let tzero = Unix.gettimeofday () in
|
||||
catch
|
||||
|
@ -42,11 +42,14 @@ let main () =
|
||||
Lwt.catch
|
||||
(fun () ->
|
||||
Client_node_rpcs.Blocks.protocol cctxt block)
|
||||
(fun _ ->
|
||||
cctxt.message
|
||||
"\n\
|
||||
The connection to the RPC server failed, \
|
||||
using the default protocol version.\n" >>= fun () ->
|
||||
(fun exn ->
|
||||
cctxt.warning
|
||||
"Error trying to acquire the protocol version from the node: %s."
|
||||
(match exn with
|
||||
| Failure msg -> msg
|
||||
| exn -> Printexc.to_string exn) >>= fun () ->
|
||||
cctxt.warning
|
||||
"Using the default protocol version." >>= fun () ->
|
||||
Lwt.return Client_bootstrap.Client_proto_main.protocol)
|
||||
>>= fun version ->
|
||||
let commands =
|
||||
@ -81,7 +84,7 @@ let main () =
|
||||
Format.eprintf "Command failed, %s.\n%!" message ;
|
||||
Lwt.return 1
|
||||
| Failure message ->
|
||||
Format.eprintf "%s\n%!" message ;
|
||||
Format.eprintf "Fatal error: %s\n%!" message ;
|
||||
Lwt.return 1
|
||||
| exn ->
|
||||
Format.printf "Fatal internal error: %s\n%!"
|
||||
|
@ -53,8 +53,8 @@ let make_cors_headers ?(headers=Cohttp.Header.init ())
|
||||
Cohttp.Header.add_multi cors_headers
|
||||
"Access-Control-Allow-Origin" [allowed_origin]
|
||||
|
||||
(* Promise a running RPC server. Takes the port. *)
|
||||
let launch port ?pre_hook ?post_hook root cors_allowed_origins cors_allowed_headers =
|
||||
(* Promise a running RPC server. *)
|
||||
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,9 +180,8 @@ let launch port ?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
|
||||
lwt_log_info "create server listening on port %d" port >>= fun () ->
|
||||
let ctx = Cohttp_lwt_unix_net.init () in
|
||||
let mode = `TCP (`Port port) 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
|
||||
|
@ -12,13 +12,13 @@
|
||||
(** A handle on the server worker. *)
|
||||
type server
|
||||
|
||||
(** Promise a running RPC serve ; takes the port. To call
|
||||
an RPC at /p/a/t/h/ in the provided service, one must call the URI
|
||||
/call/p/a/t/h/. Calling /list/p/a/t/h/ will list the services
|
||||
prefixed by /p/a/t/h/, if any. Calling /schema/p/a/t/h/ will
|
||||
describe the input and output of the service, if it is
|
||||
callable. Calling /pipe will read a sequence of services to call in
|
||||
sequence from the request body, see {!pipe_encoding}.
|
||||
(** Promise a running RPC server. To call an RPC at /p/a/t/h/ in the
|
||||
provided service, one must call the URI /call/p/a/t/h/. Calling
|
||||
/list/p/a/t/h/ will list the services prefixed by /p/a/t/h/, if
|
||||
any. Calling /schema/p/a/t/h/ will describe the input and output
|
||||
of the service, if it is callable. Calling /pipe will read a
|
||||
sequence of services to call in sequence from the request body,
|
||||
see {!pipe_encoding}.
|
||||
|
||||
The arguments cors_allowed_origins and cors_allowed_headers define
|
||||
the cross-origin resource sharing using the headers
|
||||
@ -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 : int ->
|
||||
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 ->
|
||||
@ -46,8 +48,8 @@ val launch : int ->
|
||||
(** Kill an RPC server. *)
|
||||
val shutdown : server -> unit Lwt.t
|
||||
|
||||
(** Retrieve the root service of the server *)
|
||||
(** Retrieve the root service of the server. *)
|
||||
val root_service : server -> unit RPC.directory
|
||||
|
||||
(** Change the root service of the server *)
|
||||
(** Change the root service of the server. *)
|
||||
val set_root_service : server -> unit RPC.directory -> unit
|
||||
|
@ -65,6 +65,8 @@ type cfg = {
|
||||
rpc_addr : (Ipaddr.t * int) option ;
|
||||
cors_origins : string list ;
|
||||
cors_headers : string list ;
|
||||
rpc_crt : string option ;
|
||||
rpc_key : string option ;
|
||||
|
||||
(* log *)
|
||||
log_output : [`Stderr | `File of string | `Syslog | `Null] ;
|
||||
@ -97,6 +99,8 @@ let default_cfg_of_base_dir base_dir = {
|
||||
rpc_addr = None ;
|
||||
cors_origins = [] ;
|
||||
cors_headers = ["content-type"] ;
|
||||
rpc_crt = None ;
|
||||
rpc_key = None ;
|
||||
|
||||
(* log *)
|
||||
log_output = `Stderr ;
|
||||
@ -280,8 +284,11 @@ module Cmdline = struct
|
||||
|
||||
(* rpc args *)
|
||||
let rpc_addr =
|
||||
let doc = "The TCP socket address at which this RPC server instance can be reached" in
|
||||
let doc = "The TCP socket address at which this RPC server instance can be reached." in
|
||||
Arg.(value & opt (some sockaddr_converter) None & info ~docs:"RPC" ~doc ~docv:"ADDR:PORT" ["rpc-addr"])
|
||||
let rpc_tls =
|
||||
let doc = "Enable TLS for this RPC server with the provided certificate and key." in
|
||||
Arg.(value & opt (some (pair string string)) None & info ~docs:"RPC" ~doc ~docv:"crt,key" ["rpc-tls"])
|
||||
let cors_origins =
|
||||
let doc = "CORS origin allowed by the RPC server via Access-Control-Allow-Origin; may be used multiple times" in
|
||||
Arg.(value & opt_all string [] & info ~docs:"RPC" ~doc ~docv:"ORIGIN" ["cors-origin"])
|
||||
@ -291,7 +298,8 @@ module Cmdline = struct
|
||||
|
||||
let parse base_dir config_file sandbox sandbox_param log_level
|
||||
min_connections max_connections expected_connections
|
||||
net_saddr local_discovery peers closed rpc_addr cors_origins cors_headers reset_cfg update_cfg =
|
||||
net_saddr local_discovery peers closed rpc_addr tls cors_origins cors_headers reset_cfg update_cfg =
|
||||
|
||||
let base_dir = Utils.(unopt (unopt default_cfg.base_dir base_dir) sandbox) in
|
||||
let config_file = Utils.(unopt ((unopt base_dir sandbox) // "config")) config_file in
|
||||
let no_config () =
|
||||
@ -317,6 +325,10 @@ module Cmdline = struct
|
||||
| 1 -> Some Lwt_log.Info
|
||||
| _ -> Some Lwt_log.Debug
|
||||
in
|
||||
let rpc_crt, rpc_key = match tls with
|
||||
| None -> None, None
|
||||
| Some (crt, key) -> Some crt, Some key
|
||||
in
|
||||
let cfg =
|
||||
{ cfg with
|
||||
base_dir ;
|
||||
@ -334,6 +346,8 @@ module Cmdline = struct
|
||||
rpc_addr = Utils.first_some rpc_addr cfg.rpc_addr ;
|
||||
cors_origins = (match cors_origins with [] -> cfg.cors_origins | _ -> cors_origins) ;
|
||||
cors_headers = (match cors_headers with [] -> cfg.cors_headers | _ -> cors_headers) ;
|
||||
rpc_crt ;
|
||||
rpc_key ;
|
||||
log_output = cfg.log_output ;
|
||||
}
|
||||
in
|
||||
@ -346,7 +360,7 @@ module Cmdline = struct
|
||||
$ sandbox $ sandbox_param $ v
|
||||
$ min_connections $ max_connections $ expected_connections
|
||||
$ net_addr $ local_discovery $ peers $ closed
|
||||
$ rpc_addr $ cors_origins $ cors_headers
|
||||
$ rpc_addr $ rpc_tls $ cors_origins $ cors_headers
|
||||
$ reset_config $ update_config
|
||||
),
|
||||
let doc = "The Tezos daemon" in
|
||||
@ -438,16 +452,28 @@ let init_node { sandbox ; sandbox_param ;
|
||||
?patch_context
|
||||
net_params
|
||||
|
||||
let init_rpc { rpc_addr ; cors_origins ; cors_headers } node =
|
||||
match rpc_addr with
|
||||
| None ->
|
||||
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 ->
|
||||
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 (`Crt_file_path crt, `Key_file_path key, `No_password, `Port port) in
|
||||
let host = Ipaddr.to_string addr in
|
||||
let () =
|
||||
let old_hook = !Lwt.async_exception_hook in
|
||||
Lwt.async_exception_hook := function
|
||||
| Ssl.Read_error _ -> ()
|
||||
| exn -> old_hook exn 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 () ->
|
||||
let dir = Node_rpc.build_rpc_directory node in
|
||||
RPC_server.launch (`TCP (`Port port)) dir cors_origins cors_headers >>= fun server ->
|
||||
Lwt.return (Some server)
|
||||
| _ ->
|
||||
lwt_log_notice "Not listening to RPC calls." >>= fun () ->
|
||||
Lwt.return None
|
||||
| Some (_addr, port) ->
|
||||
lwt_log_notice "Starting the RPC server listening on port %d." port >>= fun () ->
|
||||
let dir = Node_rpc.build_rpc_directory node in
|
||||
RPC_server.launch port dir cors_origins cors_headers >>= fun server ->
|
||||
Lwt.return (Some server)
|
||||
|
||||
let init_signal () =
|
||||
let handler id = try Lwt_exit.exit id with _ -> () in
|
||||
|
@ -18,6 +18,7 @@ depends: [
|
||||
"calendar"
|
||||
"cohttp" {>= "0.21" }
|
||||
"config-file"
|
||||
"conduit" {= "0.14.0" } # Version 0.14.1 doas not compile with `ssl` (17/01/02)
|
||||
"git"
|
||||
"git-unix"
|
||||
"irmin-watcher" (* for `irmin.unix` *)
|
||||
@ -31,6 +32,7 @@ depends: [
|
||||
"tyxml"
|
||||
"js_of_ocaml"
|
||||
"sodium" {>= "0.3.0"}
|
||||
"ssl"
|
||||
"kaputt" # { test }
|
||||
"bisect_ppx" # { test }
|
||||
]
|
||||
|
@ -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 ->
|
||||
|
Loading…
Reference in New Issue
Block a user