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

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) *)
+  (* network options. *)
-  incoming_addr : string ;
+  node_addr : string ;
-  incoming_port : int ;
+  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 =

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) *)
+  (* network options. *)
-  incoming_addr : string ;
+  node_addr : string ;
-  incoming_port : int ;
+  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 =

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 } ->
+      (fun { base_dir ; node_addr ; node_port ; tls ; web_port } ->
-        (Some incoming_addr, Some incoming_port, Some tls, Some web_port))
+         (base_dir, Some node_addr, Some node_port,
-      (fun (incoming_addr, incoming_port, tls, web_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 node_addr = unopt ~default:default.node_addr node_addr in
-        let incoming_port = unopt ~default:default_cfg.incoming_port incoming_port in
+        let node_port = unopt ~default:default.node_port node_port in
-        let tls = unopt ~default:default_cfg.tls tls in
+        let tls = unopt ~default:default.tls tls in
-        let web_port = unopt ~default:default_cfg.web_port web_port in
+        let web_port = unopt ~default:default.web_port web_port in
-        { default_cfg with
+        { base_dir ; node_addr ; node_port ; tls ; web_port })
-          incoming_addr ; incoming_port ; tls ; web_port })
+      (obj5
-      (obj4
+        (req "base_dir" string)
-        (opt "incoming_addr" string)
+        (opt "node_addr" string)
-        (opt "incoming_port" int16)
+        (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
+    for i = 0 to Array.length argv - 2 do
-      if argv.(i) = name && i <> Array.length argv - 1 then
+      if argv.(i) = name then raise (Found argv.(i+1))
-        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 =
+type cli_args = {
-  let open Lwt in
+  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 parsed_args = ref default_cli_args 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
   (* 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);
+       default: " ^ Client_commands.default_base_dir ;
-    "-config-file", Arg.String (fun x -> cfg := { !cfg with config_file = x }),
+    "-config-file", Arg.String (fun _ -> ( (* preparsed *) )),
       "The main configuration file.\n\
-       default: " ^ Client_commands.(default_cfg.config_file);
+       default: " ^ Client_commands.default_base_dir // "config" ;
-    "-timings", Arg.Bool (fun x -> cfg := { !cfg with print_timings = x }),
+    "-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);
+       default: " ^ string_of_bool default_cli_args.print_timings ;
-    "-force", Arg.Bool (fun x -> cfg := { !cfg with force = x }),
+    "-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);
+       default: " ^ string_of_bool default_cli_args.force ;
-    "-block", Arg.String set_block,
+    "-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);
+       default: " ^ Cfg_file.default.node_addr ;
-    "-port", Arg.Int (fun x -> cfg := { !cfg with incoming_port = x }),
+    "-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);
+       default: " ^ string_of_int Cfg_file.default.node_port ;
-    "-tls", Arg.Bool (fun x -> cfg := { !cfg with tls = x }),
+    "-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
+  let all_args = cli_args @ file_args in
-  catch
+  try
-    (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 ()
+    match dispatch `End with
-          with Sys_error msg ->
+    | `Res res -> (res, !parsed_args)
-            cctxt.Client_commands.error
+    | `Fail exn -> raise exn
-              "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)
+  with
-    (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"))
+      raise (Arg.Help (msg ^ usage all_args ^ "\n"))
   | Arg.Help _ ->
-          Lwt.fail (Arg.Help (usage all_args ^ "\n"))
+      raise (Arg.Help (usage all_args ^ "\n"))
-      | exn -> Lwt.fail exn)
 
-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 }

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 host = cctxt.config.node_addr in
-  let port = cctxt.config.incoming_port 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

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 parsed_config_file, block = Client_config.preparse_args Sys.argv in
-    let cctxt = { cctxt with config } 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
+    let (command, parsed_args) =
       Client_config.parse_args
         (Cli_entries.usage ~commands)
         (Cli_entries.inline_dispatch commands)
-      Sys.argv cctxt >>= fun (command, config) ->
+        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