diff --git a/src/client/client_commands.ml b/src/client/client_commands.ml index 6ff258e32..6eb580370 100644 --- a/src/client/client_commands.ml +++ b/src/client/client_commands.ml @@ -11,20 +11,21 @@ type ('a, 'b) lwt_format = ('a, Format.formatter, unit, 'b Lwt.t) format4 type cfg = { - (* cli options *) - base_dir : string ; - config_file : string ; - print_timings : bool ; - force : bool ; - block : Node_rpc_services.Blocks.block ; - (* network options (cli and config file) *) - incoming_addr : string ; - incoming_port : int ; + (* network options. *) + node_addr : string ; + node_port : int ; tls : bool ; (* webclient options *) web_port : int ; + + (* misc options *) + base_dir : string ; + print_timings : bool ; + force : bool ; + block : Node_rpc_services.Blocks.block ; + } type context = @@ -41,26 +42,25 @@ type command = (context, unit) Cli_entries.command let (//) = Filename.concat +let default_cfg_of_base_dir base_dir = { + base_dir ; + print_timings = false ; + force = false ; + block = `Prevalidation ; + + node_addr = "127.0.0.1" ; + node_port = 8732 ; + tls = false ; + + web_port = 8080 ; +} + let home = try Sys.getenv "HOME" with Not_found -> "/root" let default_base_dir = home // ".tezos-client" -let default_cfg_of_base_dir base_dir = { - base_dir ; - config_file = base_dir // "config"; - print_timings = false ; - force = false ; - block = `Prevalidation ; - - incoming_addr = "127.0.0.1" ; - incoming_port = 8732 ; - tls = false ; - - web_port = 8080 ; -} - let default_cfg = default_cfg_of_base_dir default_base_dir let make_context ?(config = default_cfg) log = diff --git a/src/client/client_commands.mli b/src/client/client_commands.mli index e19c19d55..d69450af1 100644 --- a/src/client/client_commands.mli +++ b/src/client/client_commands.mli @@ -11,20 +11,21 @@ type ('a, 'b) lwt_format = ('a, Format.formatter, unit, 'b Lwt.t) format4 type cfg = { - (* cli options *) - base_dir : string ; - config_file : string ; - print_timings : bool ; - force : bool ; - block : Node_rpc_services.Blocks.block ; - (* network options (cli and config file) *) - incoming_addr : string ; - incoming_port : int ; + (* network options. *) + node_addr : string ; + node_port : int ; tls : bool ; (* webclient options *) web_port : int ; + + (* misc options *) + base_dir : string ; + print_timings : bool ; + force : bool ; + block : Node_rpc_services.Blocks.block ; + } type context = diff --git a/src/client/client_config.ml b/src/client/client_config.ml index 9fe141455..90cfc0c4a 100644 --- a/src/client/client_config.ml +++ b/src/client/client_config.ml @@ -9,26 +9,44 @@ (* Tezos Command line interface - Configuration and Arguments Parsing *) -open Client_commands +let (//) = Filename.concat module Cfg_file = struct + + type t = { + base_dir: string ; + node_addr: string ; + node_port: int ; + tls: bool ; + web_port: int ; + } + + let default = { + base_dir = Client_commands.default_base_dir ; + node_addr = "127.0.0.1" ; + node_port = 8732 ; + tls = false ; + web_port = 8080 ; + } + open Data_encoding let encoding = conv - (fun { incoming_addr ; incoming_port ; tls ; web_port } -> - (Some incoming_addr, Some incoming_port, Some tls, Some web_port)) - (fun (incoming_addr, incoming_port, tls, web_port) -> + (fun { base_dir ; node_addr ; node_port ; tls ; web_port } -> + (base_dir, Some node_addr, Some node_port, + Some tls, Some web_port)) + (fun (base_dir, node_addr, node_port, tls, web_port) -> let open Utils in - let incoming_addr = unopt ~default:default_cfg.incoming_addr incoming_addr in - let incoming_port = unopt ~default:default_cfg.incoming_port incoming_port in - let tls = unopt ~default:default_cfg.tls tls in - let web_port = unopt ~default:default_cfg.web_port web_port in - { default_cfg with - incoming_addr ; incoming_port ; tls ; web_port }) - (obj4 - (opt "incoming_addr" string) - (opt "incoming_port" int16) + let node_addr = unopt ~default:default.node_addr node_addr in + let node_port = unopt ~default:default.node_port node_port in + let tls = unopt ~default:default.tls tls in + let web_port = unopt ~default:default.web_port web_port in + { base_dir ; node_addr ; node_port ; tls ; web_port }) + (obj5 + (req "base_dir" string) + (opt "node_addr" string) + (opt "node_port" int16) (opt "tls" bool) (opt "web_port" int16)) @@ -43,185 +61,176 @@ module Cfg_file = struct Utils.write_file ~bin:false out (Data_encoding.Json.construct encoding cfg |> Data_encoding_ezjsonm.to_string) + end exception Found of string + let preparse name argv = try - for i = 0 to Array.length argv - 1 do - if argv.(i) = name && i <> Array.length argv - 1 then - raise (Found argv.(i+1)) + for i = 0 to Array.length argv - 2 do + if argv.(i) = name then raise (Found argv.(i+1)) done ; None with Found s -> Some s +let preparse_bool name argv = + try + for i = 0 to Array.length argv - 1 do + if argv.(i) = name then raise (Found "") + done ; + false + with Found _ -> true + +let preparse_args argv = + let base_dir = + match preparse "-base-dir" argv with + | None -> Client_commands.default_base_dir + | Some base_dir -> base_dir in + let config_file = + match preparse "-config-file" argv with + | None -> base_dir // "config" + | Some config_file -> config_file in + let config_dir = Filename.dirname config_file in + let cfg = + if not (Sys.file_exists config_file) then + { Cfg_file.default with base_dir = base_dir } + else + match + Utils.read_file ~bin:false config_file + |> Data_encoding_ezjsonm.from_string + with + | exception (Sys_error msg) -> + Format.eprintf + "Error: can't read the configuration file: %s\n%s@." + config_file msg ; + exit 1 + | exception _ -> + Format.eprintf "Warning: config file not found@." ; + { Cfg_file.default with base_dir = base_dir } + | Error msg -> + Format.eprintf + "Error: can't parse the configuration file: %s\n%s@." + config_file msg ; + exit 1 + | Ok cfg_json -> + try Cfg_file.from_json cfg_json + with exn -> + Format.eprintf + "Error: can't parse the configuration file: %s\n%a@." + config_file (fun ppf exn -> Json_encoding.print_error ppf exn) exn ; + exit 1 in + let tls = cfg.tls || preparse_bool "-tls" argv in + let node_addr = + match preparse "-addr" argv with + | None -> cfg.node_addr + | Some node_addr -> node_addr in + let node_port = + match preparse "-port" argv with + | None -> cfg.node_port + | Some port -> + try int_of_string port + with _ -> + Format.eprintf + "Error: can't parse the -port option: %S.@." port ; + exit 1 in + let block = + match preparse "-block" Sys.argv with + | None -> Client_commands.default_cfg.block + | Some block -> + match Node_rpc_services.Blocks.parse_block block with + | Error _ -> + Format.eprintf + "Error: can't parse the -block option: %S.@." + block ; + exit 1 + | Ok block -> block in + let cfg = { cfg with tls ; node_port ; node_addr } in + if Sys.file_exists base_dir && not (Sys.is_directory base_dir) then begin + Format.eprintf "Error: %s is not a directory.@." base_dir ; + exit 1 ; + end ; + IO.mkdir base_dir ; + if Sys.file_exists config_dir && not (Sys.is_directory config_dir) then begin + Format.eprintf "Error: %s is not a directory.@." config_dir ; + exit 1 ; + end ; + IO.mkdir config_dir ; + if not (Sys.file_exists config_file) then Cfg_file.write config_file cfg ; + (cfg, block) + (* Entry point *) -let parse_args ?(extra = (fun _cfg -> [])) usage dispatcher argv cctxt = - let open Lwt in +type cli_args = { + block: Node_rpc_services.Blocks.block ; + print_timings: bool ; + force: bool ; +} + +let default_cli_args = { + block = Client_commands.default_cfg.block ; + print_timings = false ; + force = false ; +} + +let parse_args usage dispatcher argv = (* Init config reference which will be updated as args are parsed *) - let cfg = ref cctxt.Client_commands.config in - let set_block x = - match Node_rpc_services.Blocks.parse_block x with - | Error _ -> raise (Arg.Bad "Can't parse -block") - | Ok block -> cfg := { !cfg with block } - in + let parsed_args = ref default_cli_args in (* Command-line only args (not in config file) *) let cli_args = [ - "-base-dir", Arg.String (fun x -> cfg := { !cfg with base_dir = x }), + "-base-dir", Arg.String (fun _ -> ( (* preparsed *) )), "The directory where the Tezos client will store all its data.\n\ - default: " ^ Client_commands.(default_cfg.base_dir); - "-config-file", Arg.String (fun x -> cfg := { !cfg with config_file = x }), + default: " ^ Client_commands.default_base_dir ; + "-config-file", Arg.String (fun _ -> ( (* preparsed *) )), "The main configuration file.\n\ - default: " ^ Client_commands.(default_cfg.config_file); - "-timings", Arg.Bool (fun x -> cfg := { !cfg with print_timings = x }), + default: " ^ Client_commands.default_base_dir // "config" ; + "-timings", + Arg.Bool (fun x -> parsed_args := { !parsed_args with print_timings = x }), "Show RPC request times.\n\ - default: " ^ string_of_bool Client_commands.(default_cfg.print_timings); - "-force", Arg.Bool (fun x -> cfg := { !cfg with force = x }), + default: " ^ string_of_bool default_cli_args.print_timings ; + "-force", + Arg.Bool (fun x -> parsed_args := { !parsed_args with force = x }), "Show less courtesy than the average user.\n\ - default: " ^ string_of_bool Client_commands.(default_cfg.force); - "-block", Arg.String set_block, + default: " ^ string_of_bool default_cli_args.force ; + "-block", Arg.String (fun _ -> ( (* preparsed *) )), "The block on which to apply contextual commands.\n\ - default: " ^ Node_rpc_services.Blocks.to_string Client_commands.(default_cfg.block); + default: " ^ Node_rpc_services.Blocks.to_string default_cli_args.block ; ] in (* Command-line args which can be set in config file as well *) let file_args = [ (* Network options *) - "-addr", Arg.String (fun x -> cfg := { !cfg with incoming_addr = x }), + "-addr", Arg.String (fun _ -> ( (* preparsed *) )), "The IP address at which the node's RPC server can be reached.\n\ - default: " ^ Client_commands.(default_cfg.incoming_addr); - "-port", Arg.Int (fun x -> cfg := { !cfg with incoming_port = x }), + default: " ^ Cfg_file.default.node_addr ; + "-port", Arg.Int (fun _ -> ( (* preparsed *) )), "The TCP port at which the node's RPC server can be reached.\n\ - default: " ^ string_of_int Client_commands.(default_cfg.incoming_port); - "-tls", Arg.Bool (fun x -> cfg := { !cfg with tls = x }), + default: " ^ string_of_int Cfg_file.default.node_port ; + "-tls", Arg.Bool (fun _ -> ( (* preparsed *) )), "Use TLS to connect to node.\n\ - default: " ^ string_of_bool Client_commands.(default_cfg.tls); + default: " ^ string_of_bool Cfg_file.default.tls ; ] in - let all_args = cli_args @ file_args @ (extra cfg) in - catch - (fun () -> - let args = ref all_args in - let anon dispatch n = match dispatch (`Arg n) with - | `Nop -> () - | `Args nargs -> args := nargs @ !args - | `Fail exn -> raise exn - | `Res _ -> assert false in - Arg.parse_argv_dynamic - ~current:(ref 0) argv args (anon (dispatcher ())) "\000" ; - let dispatch = dispatcher () in - (if Sys.file_exists !cfg.config_file then begin - try - (* Parse config file and init [cfg] with options defined in it *) - let config_file = !cfg.config_file in - Cfg_file.read config_file >>= begin function - | Error _err -> - cctxt.Client_commands.error - "Error: can't parse the configuration file: %s\n%!" - config_file - | Ok c -> - cfg := c ; - Lwt.return () - end >>= fun () -> - (* parse once again to overwrite file options by cli ones *) - Arg.parse_argv_dynamic - ~current:(ref 0) argv args (anon dispatch) "\000" ; - Lwt.return () - with Sys_error msg -> - cctxt.Client_commands.error - "Error: can't read the configuration file: %s\n%!" msg - end else begin - try - (* parse once again with contextual options *) - Arg.parse_argv_dynamic - ~current:(ref 0) argv args (anon dispatch) "\000" ; - Lwt_utils.create_dir (Filename.dirname !cfg.config_file) - >>= fun () -> - Cfg_file.write !cfg.config_file !cfg ; - Lwt.return () - with Sys_error msg -> - cctxt.Client_commands.warning - "Warning: can't create the default configuration file: %s\n%!" - msg - end) >>= fun () -> - begin match dispatch `End with - | `Res res -> Lwt.return (res, !cfg) - | `Fail exn -> fail exn - | `Nop | `Args _ -> assert false - end) - (function - | Arg.Bad msg -> - (* FIXME: this is an ugly hack to circumvent [Arg] - spuriously printing options at the end of the error - message. *) - let msg = List.hd (Utils.split '\000' msg) in - Lwt.fail (Arg.Help (msg ^ usage all_args ^ "\n")) - | Arg.Help _ -> - Lwt.fail (Arg.Help (usage all_args ^ "\n")) - | exn -> Lwt.fail exn) + let all_args = cli_args @ file_args in + try + let args = ref all_args in + let anon dispatch n = match dispatch (`Arg n) with + | `Nop -> () + | `Args nargs -> args := nargs @ !args + | `Fail exn -> raise exn + | `Res _ -> assert false in + let dispatch = dispatcher () in + Arg.parse_argv_dynamic + ~current:(ref 0) argv args (anon dispatch) "\000" ; + match dispatch `End with + | `Res res -> (res, !parsed_args) + | `Fail exn -> raise exn + | `Nop | `Args _ -> assert false + with + | Arg.Bad msg -> + (* FIXME: this is an ugly hack to circumvent [Arg] + spuriously printing options at the end of the error + message. *) + let msg = List.hd (Utils.split '\000' msg) in + raise (Arg.Help (msg ^ usage all_args ^ "\n")) + | Arg.Help _ -> + raise (Arg.Help (usage all_args ^ "\n")) -let preparse_args argv cctxt : cfg Lwt.t = - let cfg = - match preparse "-base-dir" argv with - | None -> default_cfg - | Some base_dir -> default_cfg_of_base_dir base_dir - in - let cfg = - match preparse "-config-file" argv with - | None -> cfg - | Some config_file -> { cfg with config_file } - in - let no_config () = - cctxt.Client_commands.warning - "Warning: config file not found\n%!" in - let corrupted_config msg = - cctxt.Client_commands.error - "Error: can't parse the configuration file: %s\n%s\n%!" - cfg.config_file msg in - begin - if Sys.file_exists cfg.config_file then try - match - Utils.read_file ~bin:false cfg.config_file - |> Data_encoding_ezjsonm.from_string - with - | exception _ -> - no_config () >>= fun () -> - Lwt.return cfg - | Error msg -> corrupted_config msg - | Ok cfg_json -> - try Lwt.return (Cfg_file.from_json cfg_json) with - | Invalid_argument msg - | Failure msg -> corrupted_config msg - with Sys_error msg -> - cctxt.Client_commands.error - "Error: can't read the configuration file: %s\n%!" msg - else Lwt.return cfg - end >>= fun cfg -> - let cfg = - match preparse "-tls" argv with - | None -> cfg - | Some _ -> { cfg with tls = true } - in - let cfg = - match preparse "-addr" argv with - | None -> cfg - | Some incoming_addr -> { cfg with incoming_addr } - in - begin - match preparse "-port" argv with - | None -> Lwt.return cfg - | Some port -> - try - let incoming_port = int_of_string port in - Lwt.return { cfg with incoming_port } - with _ -> - cctxt.Client_commands.error - "Error: can't parse the -port option: %S.\n%!" port - end >>= fun cfg -> - match preparse "-block" Sys.argv with - | None -> Lwt.return cfg - | Some x -> - match Node_rpc_services.Blocks.parse_block x with - | Error _ -> - cctxt.Client_commands.error - "Error: can't parse the -block option: %S.\n%!" x - | Ok block -> Lwt.return { cfg with block } diff --git a/src/client/client_node_rpcs.ml b/src/client/client_node_rpcs.ml index d1ef7f894..a55c29152 100644 --- a/src/client/client_node_rpcs.ml +++ b/src/client/client_node_rpcs.ml @@ -25,8 +25,8 @@ let make_request cctxt meth service json = incr cpt ; let cpt = !cpt in let scheme = if cctxt.config.tls then "https" else "http" in - let host = cctxt.config.incoming_addr in - let port = cctxt.config.incoming_port in + let host = cctxt.config.node_addr in + let port = cctxt.config.node_port in let path = String.concat "/" service in let uri = Uri.make ~scheme ~host ~port ~path () in let string_uri = Uri.to_string uri in diff --git a/src/client_main.ml b/src/client_main.ml index 168d499df..5e3a86a63 100644 --- a/src/client_main.ml +++ b/src/client_main.ml @@ -40,8 +40,7 @@ let main () = Random.self_init () ; Sodium.Random.stir () ; Lwt.catch begin fun () -> - Client_config.preparse_args Sys.argv cctxt >>= fun config -> - let cctxt = { cctxt with config } in + let parsed_config_file, block = Client_config.preparse_args Sys.argv in Lwt.catch begin fun () -> Client_node_rpcs.Blocks.protocol cctxt cctxt.config.block >>= fun version -> Lwt.return (Some version, Client_commands.commands_for_version version) @@ -60,10 +59,21 @@ let main () = Client_protocols.commands () @ Client_helpers.commands () @ commands_for_version in - Client_config.parse_args - (Cli_entries.usage ~commands) - (Cli_entries.inline_dispatch commands) - Sys.argv cctxt >>= fun (command, config) -> + let (command, parsed_args) = + Client_config.parse_args + (Cli_entries.usage ~commands) + (Cli_entries.inline_dispatch commands) + Sys.argv in + let config : Client_commands.cfg = { + base_dir = parsed_config_file.base_dir ; + print_timings = parsed_args.print_timings ; + force = parsed_args.force ; + block ; + node_addr = parsed_config_file.node_addr ; + node_port = parsed_config_file.node_port ; + tls = parsed_config_file.tls ; + web_port = Client_commands.default_cfg.web_port ; + } in command { cctxt with config } >>= fun () -> Lwt.return 0 end begin function