diff --git a/src/client/client_config.ml b/src/client/client_config.ml index 62af71802..21560a74e 100644 --- a/src/client/client_config.ml +++ b/src/client/client_config.ml @@ -128,8 +128,8 @@ let parse_args ?version usage dispatcher = ~current:(ref 0) Sys.argv args (anon dispatch) (usage base_args) ; Lwt.return () with Sys_error msg -> - Printf.eprintf "Error: can't read the configuration file: %s\n%!" msg; - exit 1 + Cli_entries.error + "Error: can't read the configuration file: %s\n%!" msg end else begin try (* parse once again with contextual options *) @@ -139,9 +139,8 @@ let parse_args ?version usage dispatcher = file_group#write config_file#get ; Lwt.return () with Sys_error msg -> - Printf.eprintf - "Warning: can't create the default configuration file: %s\n%!" msg ; - Lwt.return () + Cli_entries.warning + "Warning: can't create the default configuration file: %s\n%!" msg end) >>= fun () -> begin match dispatch `End with | `Res res -> @@ -161,7 +160,7 @@ let preparse name argv = None with Found s -> Some s -let preparse_args () : Node_rpc_services.Blocks.block = +let preparse_args () : Node_rpc_services.Blocks.block Lwt.t = begin match preparse "-base-dir" Sys.argv with | None -> () @@ -174,11 +173,13 @@ let preparse_args () : Node_rpc_services.Blocks.block = end ; begin if Sys.file_exists config_file#get then try - file_group#read config_file#get ; + (file_group#read config_file#get ; + Lwt.return ()) with Sys_error msg -> - Printf.eprintf "Error: can't read the configuration file: %s\n%!" msg; - exit 1 - end ; + Cli_entries.error + "Error: can't read the configuration file: %s\n%!" msg + else Lwt.return () + end >>= fun () -> begin match preparse "-addr" Sys.argv with | None -> () @@ -186,17 +187,20 @@ let preparse_args () : Node_rpc_services.Blocks.block = end ; begin match preparse "-port" Sys.argv with - | None -> () + | None -> Lwt.return () | Some port -> - try incoming_port#set (int_of_string port) + try + incoming_port#set (int_of_string port) ; + Lwt.return () with _ -> - Printf.eprintf "Error: can't parse the -port option: %S.\n%!" port ; - exit 1 end ; + Cli_entries.error + "Error: can't parse the -port option: %S.\n%!" port + end >>= fun () -> match preparse "-block" Sys.argv with - | None -> `Prevalidation + | None -> Lwt.return `Prevalidation | Some x -> match Node_rpc_services.Blocks.parse_block x with | Error _ -> - Printf.eprintf "Error: can't parse the -block option: %S.\n%!" x ; - exit 1 - | Ok b -> b + Cli_entries.error + "Error: can't parse the -block option: %S.\n%!" x + | Ok b -> Lwt.return b diff --git a/src/client/client_generic_rpcs.ml b/src/client/client_generic_rpcs.ml index 22509b65a..a31473050 100644 --- a/src/client/client_generic_rpcs.ml +++ b/src/client/client_generic_rpcs.ml @@ -272,12 +272,12 @@ let list url () = Format.pp_print_list (fun ppf (n,t) -> display ppf ([ n ], tpath @ [ n ], t)) in - Format.printf "@ @[Available services:@ @ %a@]@." - display (args, args, tree) ; + Cli_entries.message "@ @[Available services:@ @ %a@]@." + display (args, args, tree) >>= fun () -> if !collected_args <> [] then - Format.printf "@,@[Dynamic parameter description:@ @ %a@]@." - (Format.pp_print_list display_arg) !collected_args ; - return () + Cli_entries.message "@,@[Dynamic parameter description:@ @ %a@]@." + (Format.pp_print_list display_arg) !collected_args + else Lwt.return () let schema url () = @@ -285,14 +285,12 @@ let schema url () = let open RPC.Description in Client_node_rpcs.describe ~recurse:false args >>= function | Static { service = Some { input ; output } } -> - Printf.printf "Input schema:\n%s\nOutput schema:\n%s\n%!" + Cli_entries.message "Input schema:\n%s\nOutput schema:\n%s\n%!" (Data_encoding.Json.to_string (Json_schema.to_json input)) - (Data_encoding.Json.to_string (Json_schema.to_json output)); - return () + (Data_encoding.Json.to_string (Json_schema.to_json output)) | _ -> - Printf.printf - "No service found at this URL (but this is a valid prefix)\n%!" ; - return () + Cli_entries.message + "No service found at this URL (but this is a valid prefix)\n%!" let fill_in schema = let open Json_schema in @@ -311,13 +309,11 @@ let call url () = error "%s" msg | Ok json -> Client_node_rpcs.get_json args json >>= fun json -> - Printf.printf "Output:\n%s\n%!" (Data_encoding.Json.to_string json) ; - return () + Cli_entries.message "Output:\n%s\n%!" (Data_encoding.Json.to_string json) end | _ -> - Printf.printf - "No service found at this URL (but this is a valid prefix)\n%!" ; - return () + Cli_entries.message + "No service found at this URL (but this is a valid prefix)\n%!" let () = let open Cli_entries in diff --git a/src/client/embedded/bootstrap/client_proto_contracts.ml b/src/client/embedded/bootstrap/client_proto_contracts.ml index d48d540e9..8f496e4cd 100644 --- a/src/client/embedded/bootstrap/client_proto_contracts.ml +++ b/src/client/embedded/bootstrap/client_proto_contracts.ml @@ -179,6 +179,5 @@ let commands () = @@ RawContractAlias.alias_param @@ stop) (fun (_, contract) () -> - Format.printf "%a\n%!" Contract.pp contract ; - Lwt.return ()) ; + Cli_entries.message "%a\n%!" Contract.pp contract) ; ] diff --git a/src/client/embedded/bootstrap/client_proto_programs.ml b/src/client/embedded/bootstrap/client_proto_programs.ml index a7cabf824..6edacffa2 100644 --- a/src/client/embedded/bootstrap/client_proto_programs.ml +++ b/src/client/embedded/bootstrap/client_proto_programs.ml @@ -207,8 +207,7 @@ let commands () = @@ stop) (fun (_, program) () -> Program.to_source program >>= fun source -> - Format.printf "%s\n" source ; - Lwt.return ()) ; + Cli_entries.message "%s\n" source) ; command ~group: "programs" ~desc: "ask the node to run a program" @@ -225,7 +224,7 @@ let commands () = if !trace_stack then Client_proto_rpcs.Helpers.trace_code (block ()) program (storage, input) >>= function | Ok (storage, output, trace) -> - Format.printf "@[@[storage@,%a@]@,@[output@,%a@]@,@[trace@,%a@]@]@." + Cli_entries.message "@[@[storage@,%a@]@,@[output@,%a@]@,@[trace@,%a@]@]@." (print_ir (fun _ -> false)) storage (print_ir (fun _ -> false)) output (Format.pp_print_list @@ -235,18 +234,16 @@ let commands () = loc gas (Format.pp_print_list (print_ir (fun _ -> false))) stack)) - trace ; - Lwt.return () + trace | Error errs -> pp_print_error Format.err_formatter errs ; error "error running program" else Client_proto_rpcs.Helpers.run_code (block ()) program (storage, input) >>= function | Ok (storage, output) -> - Format.printf "@[@[storage@,%a@]@,@[output@,%a@]@]@." + Cli_entries.message "@[@[storage@,%a@]@,@[output@,%a@]@]@." (print_ir (fun _ -> false)) storage - (print_ir (fun _ -> false)) output ; - Lwt.return () + (print_ir (fun _ -> false)) output | Error errs -> pp_print_error Format.err_formatter errs ; error "error running program") ; @@ -267,10 +264,10 @@ let commands () = print_program (fun l -> List.mem_assoc l type_map) Format.std_formatter program ; - Format.printf "@." ; - List.iter + Cli_entries.message "@." >>= fun () -> + Lwt_list.iter_s (fun (loc, (before, after)) -> - Format.printf + Cli_entries.message "%3d@[ : [ @[%a ]@]@,-> [ @[%a ]@]@]@." loc (Format.pp_print_list (print_ir (fun _ -> false))) @@ -278,8 +275,8 @@ let commands () = (Format.pp_print_list (print_ir (fun _ -> false))) after) (List.sort compare type_map) - end ; - Lwt.return () + end + else Lwt.return () | Error errs -> pp_print_error Format.err_formatter errs ; error "ill-typed program") ; diff --git a/src/client/embedded/bootstrap/mining/client_mining_main.ml b/src/client/embedded/bootstrap/mining/client_mining_main.ml index 9e8c33156..0236939af 100644 --- a/src/client/embedded/bootstrap/mining/client_mining_main.ml +++ b/src/client/embedded/bootstrap/mining/client_mining_main.ml @@ -68,15 +68,16 @@ let reveal_block_nonces ?force block_hashes = | Error _ -> Lwt.fail Not_found) (fun _ -> - Format.eprintf "Cannot find block %a in the chain. (ignoring)@." - Block_hash.pp_short hash ; + Cli_entries.warning + "Cannot find block %a in the chain. (ignoring)@." + Block_hash.pp_short hash >>= fun () -> Lwt.return_none)) block_hashes >>= fun block_infos -> map_filter_s (fun (bi : Client_mining_blocks.block_info) -> Client_proto_nonces.find bi.hash >>= function | None -> - Format.eprintf "Cannot find nonces for block %a (ignoring)@." - Block_hash.pp_short bi.hash ; + Cli_entries.warning "Cannot find nonces for block %a (ignoring)@." + Block_hash.pp_short bi.hash >>= fun () -> return None | Some nonce -> return (Some (bi.hash, (bi.level.level, nonce)))) @@ -93,8 +94,8 @@ let reveal_nonces ?force () = Client_proto_nonces.find bi.hash >>= function | None -> return None | Some nonce -> - Format.eprintf "Found nonce for %a (level: %a)@." - Block_hash.pp_short bi.hash Level.pp bi.level ; + Cli_entries.warning "Found nonce for %a (level: %a)@." + Block_hash.pp_short bi.hash Level.pp bi.level >>= fun () -> return (Some (bi.hash, (bi.level.level, nonce)))) block_infos >>=? fun blocks -> do_reveal ?force block blocks diff --git a/src/client_main.ml b/src/client_main.ml index b74ad2e56..1ab0e9ec3 100644 --- a/src/client_main.ml +++ b/src/client_main.ml @@ -38,7 +38,7 @@ let main () = Sodium.Random.stir () ; catch (fun () -> - let block = Client_config.preparse_args () in + Client_config.preparse_args () >>= fun block -> Lwt.catch (fun () -> Client_node_rpcs.Blocks.protocol block)