balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Client: do no pat parse the config file and Sys.argv twice.

Browse Source
This commit is contained in:
Grégoire Henry 2017-03-31 00:42:13 +02:00
parent 1879c4359f
commit 852ba95a3c
5 changed files with 227 additions and 207 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
src/client/client_commands.ml
View File

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

19
src/client/client_commands.mli
View File

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

343
src/client/client_config.ml
View File

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

4
src/client/client_node_rpcs.ml
View File

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

22
src/client_main.ml
View File

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