From 937869da43285887ad828adebd159153f9333567 Mon Sep 17 00:00:00 2001 From: Milo Davis Date: Mon, 15 Jan 2018 22:10:20 -0500 Subject: [PATCH] Client: split admin/debug commands into separate executable --- .gitignore | 1 + Makefile | 2 + src/bin_client/admin_main.ml | 15 ++++ src/bin_client/jbuild | 6 +- src/bin_client/main.ml | 107 +----------------------- src/bin_client/main_lib.ml | 117 +++++++++++++++++++++++++++ src/lib_client_base/client_admin.ml | 23 ++++++ src/lib_client_base/client_admin.mli | 10 +++ src/lib_client_base/client_debug.ml | 102 ++++++++++++++--------- 9 files changed, 237 insertions(+), 146 deletions(-) create mode 100644 src/bin_client/admin_main.ml create mode 100644 src/bin_client/main_lib.ml create mode 100644 src/lib_client_base/client_admin.ml create mode 100644 src/lib_client_base/client_admin.mli diff --git a/.gitignore b/.gitignore index e8553c903..eda2cd6d8 100644 --- a/.gitignore +++ b/.gitignore @@ -10,6 +10,7 @@ _build /tezos-node /tezos-protocol-compiler /tezos-client +/tezos-admin-client /scripts/opam-test-all.sh.DONE diff --git a/Makefile b/Makefile index 4096aa7fd..38d562e32 100644 --- a/Makefile +++ b/Makefile @@ -5,9 +5,11 @@ all: @jbuilder build ${DEV} \ src/bin_node/main.exe \ src/bin_client/main.exe \ + src/bin_client/admin_main.exe \ src/lib_protocol_compiler/main.exe @cp _build/default/src/bin_node/main.exe tezos-node @cp _build/default/src/bin_client/main.exe tezos-client + @cp _build/default/src/bin_client/admin_main.exe tezos-admin-client @cp _build/default/src/lib_protocol_compiler/main.exe tezos-protocol-compiler doc-html: diff --git a/src/bin_client/admin_main.ml b/src/bin_client/admin_main.ml new file mode 100644 index 000000000..3a2d5dae8 --- /dev/null +++ b/src/bin_client/admin_main.ml @@ -0,0 +1,15 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2017. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +(* Where all the user friendliness starts *) +let () = Pervasives.exit (Lwt_main.run ( + Main_lib.main ~only_commands:(Client_debug.commands () + @ Client_admin.commands () + @ Client_network.commands () + @ Client_generic_rpcs.commands) ())) diff --git a/src/bin_client/jbuild b/src/bin_client/jbuild index fb33f3ab6..9b266a2ca 100644 --- a/src/bin_client/jbuild +++ b/src/bin_client/jbuild @@ -1,8 +1,8 @@ (jbuild_version 1) -(executable - ((name main) - (public_name tezos-client) +(executables + ((names (main admin_main)) + (public_names (tezos-client tezos-admin)) (libraries (tezos-base tezos-rpc-http tezos-client-base diff --git a/src/bin_client/main.ml b/src/bin_client/main.ml index 3012f3c09..025ce8caf 100644 --- a/src/bin_client/main.ml +++ b/src/bin_client/main.ml @@ -7,110 +7,5 @@ (* *) (**************************************************************************) -(* Tezos Command line interface - Main Program *) - -let cctxt ~base_dir ~block rpc_config = - Client_commands.make_context ~base_dir ~block ~rpc_config (Client_commands.default_log ~base_dir) - -(* Main (lwt) entry *) -let main () = - Random.self_init () ; - Sodium.Random.stir () ; - Lwt.catch begin fun () -> - let original_args = List.tl (Array.to_list Sys.argv) in - begin - Client_config.parse_config_args - (cctxt ~base_dir:Client_commands.default_base_dir - ~block:Client_commands.default_block - Client_rpcs.default_config) - original_args - >>=? fun (parsed_config_file, parsed_args, remaining) -> - let rpc_config : Client_rpcs.config = { - Client_rpcs.default_config with - host = parsed_config_file.node_addr ; - port = parsed_config_file.node_port ; - tls = parsed_config_file.tls ; - } in - let ctxt = new Client_rpcs.http_ctxt rpc_config in - begin - Client_node_rpcs.Blocks.protocol ctxt parsed_args.block >>= function - | Ok version -> begin - match parsed_args.protocol with - | None -> - return (Some version, Client_commands.commands_for_version version) - | Some given_version -> begin - if not (Protocol_hash.equal version given_version) then - Format.eprintf - "@[Warning:@,\ - The protocol provided via `-protocol` (%a)@,\ - is not the one retrieved from the node (%a).@." - Protocol_hash.pp_short given_version - Protocol_hash.pp_short version ; - return (Some version, Client_commands.commands_for_version given_version) - end - end - | Error errs -> begin - match parsed_args.protocol with - | None -> begin - Format.eprintf - "@[Ignored error:@,Failed to acquire the protocol version from the node@,%a@." - (Format.pp_print_list pp) errs ; - return (None, []) - end - | Some version -> - return (Some version, Client_commands.commands_for_version version) - end - end >>=? fun (_version, commands_for_version) -> - let commands = - Client_generic_rpcs.commands @ - Client_network.commands () @ - Client_keys.commands () @ - Client_protocols.commands () @ - Client_helpers.commands () @ - Client_debug.commands () @ - commands_for_version in - let rpc_config = - if parsed_args.print_timings then - { rpc_config with - logger = RPC_client.timings_logger Format.err_formatter } - else if parsed_args.log_requests - then { rpc_config with logger = RPC_client.full_logger Format.err_formatter } - else rpc_config - in - let client_config = - cctxt ~block:parsed_args.block ~base_dir:parsed_config_file.base_dir rpc_config in - (Cli_entries.dispatch - ~global_options:Client_config.global_options - commands - client_config - remaining) end >>= - Cli_entries.handle_cli_errors - ~stdout:Format.std_formatter - ~stderr:Format.err_formatter - ~global_options:Client_config.global_options - >>= function - | Ok i -> - Lwt.return i - | Error errs -> - Format.eprintf "@[Fatal error:@,%a@." - (Format.pp_print_list Error_monad.pp) errs ; - Lwt.return 1 - end begin function - | Arg.Help help -> - Format.printf "%s%!" help ; - Lwt.return 0 - | Client_commands.Version_not_found -> - Format.eprintf "Unknown protocol version.@." ; - Lwt.return 1 - | Failure message -> - Format.eprintf - "Fatal error: %s@." message ; - Lwt.return 1 - | exn -> - Format.printf "Fatal internal error: %s@." - (Printexc.to_string exn) ; - Lwt.return 1 - end - (* Where all the user friendliness starts *) -let () = Pervasives.exit (Lwt_main.run (main ())) +let () = Pervasives.exit (Lwt_main.run (Main_lib.main ())) diff --git a/src/bin_client/main_lib.ml b/src/bin_client/main_lib.ml new file mode 100644 index 000000000..4cab49c50 --- /dev/null +++ b/src/bin_client/main_lib.ml @@ -0,0 +1,117 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2017. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +(* Tezos Command line interface - Main Program *) + +let cctxt ~base_dir ~block rpc_config = + Client_commands.make_context ~base_dir ~block ~rpc_config (Client_commands.default_log ~base_dir) + +let get_commands_for_version ctxt block protocol = + Client_node_rpcs.Blocks.protocol ctxt block >>= function + | Ok version -> begin + match protocol with + | None -> + return (Some version, Client_commands.commands_for_version version) + | Some given_version -> begin + if not (Protocol_hash.equal version given_version) then + Format.eprintf + "@[Warning:@,\ + The protocol provided via `-protocol` (%a)@,\ + is not the one retrieved from the node (%a).@." + Protocol_hash.pp_short given_version + Protocol_hash.pp_short version ; + return (Some version, Client_commands.commands_for_version given_version) + end + end + | Error errs -> begin + match protocol with + | None -> begin + Format.eprintf + "@[Ignored error:@,Failed to acquire the protocol version from the node@,%a@." + (Format.pp_print_list pp) errs ; + return (None, []) + end + | Some version -> + return (Some version, Client_commands.commands_for_version version) + end + +(* Main (lwt) entry *) +let main ?only_commands () = + Random.self_init () ; + Sodium.Random.stir () ; + Lwt.catch begin fun () -> + let original_args = List.tl (Array.to_list Sys.argv) in + begin + Client_config.parse_config_args + (cctxt ~base_dir:Client_commands.default_base_dir + ~block:Client_commands.default_block + Client_rpcs.default_config) + original_args + >>=? fun (parsed_config_file, parsed_args, remaining) -> + let rpc_config : Client_rpcs.config = { + Client_rpcs.default_config with + host = parsed_config_file.node_addr ; + port = parsed_config_file.node_port ; + tls = parsed_config_file.tls ; + } in + let ctxt = new Client_rpcs.http_ctxt rpc_config in + begin match only_commands with + | None -> + get_commands_for_version ctxt + parsed_args.block + parsed_args.protocol >>|? fun (_version, commands_for_version) -> + Client_generic_rpcs.commands @ + Client_network.commands () @ + Client_keys.commands () @ + Client_protocols.commands () @ + Client_helpers.commands () @ + commands_for_version + | Some commands -> return commands end >>=? fun commands -> + let rpc_config = + if parsed_args.print_timings then + { rpc_config with + logger = RPC_client.timings_logger Format.err_formatter } + else if parsed_args.log_requests + then { rpc_config with logger = RPC_client.full_logger Format.err_formatter } + else rpc_config + in + let client_config = + cctxt ~block:parsed_args.block ~base_dir:parsed_config_file.base_dir rpc_config in + (Cli_entries.dispatch + ~global_options:Client_config.global_options + commands + client_config + remaining) end >>= + Cli_entries.handle_cli_errors + ~stdout:Format.std_formatter + ~stderr:Format.err_formatter + ~global_options:Client_config.global_options + >>= function + | Ok i -> + Lwt.return i + | Error errs -> + Format.eprintf "@[Fatal error:@,%a@." + (Format.pp_print_list Error_monad.pp) errs ; + Lwt.return 1 + end begin function + | Arg.Help help -> + Format.printf "%s%!" help ; + Lwt.return 0 + | Client_commands.Version_not_found -> + Format.eprintf "Unknown protocol version.@." ; + Lwt.return 1 + | Failure message -> + Format.eprintf + "Fatal error: %s@." message ; + Lwt.return 1 + | exn -> + Format.printf "Fatal internal error: %s@." + (Printexc.to_string exn) ; + Lwt.return 1 + end diff --git a/src/lib_client_base/client_admin.ml b/src/lib_client_base/client_admin.ml new file mode 100644 index 000000000..d9b905e73 --- /dev/null +++ b/src/lib_client_base/client_admin.ml @@ -0,0 +1,23 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +let commands () = + let open Cli_entries in + let group = { name = "admin" ; + title = "commands to perform privileged operations on the node" } in + [ + command ~group ~desc: "unmark invalid" + no_options + (prefixes [ "unmark" ; "invalid" ] + @@ Block_hash.param ~name:"block" ~desc:"block to remove from invalid list" + @@ stop) + (fun () block (cctxt : Client_commands.full_context) -> + Client_rpcs.call_err_service0 cctxt Node_rpc_services.Blocks.unmark_invalid block >>=? fun () -> + cctxt#message "Block %a no longer marked invalid" Block_hash.pp block >>= return) ; + ] diff --git a/src/lib_client_base/client_admin.mli b/src/lib_client_base/client_admin.mli new file mode 100644 index 000000000..a471d3d18 --- /dev/null +++ b/src/lib_client_base/client_admin.mli @@ -0,0 +1,10 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +val commands : unit -> (Client_commands.full_context, unit) Cli_entries.command list diff --git a/src/lib_client_base/client_debug.ml b/src/lib_client_base/client_debug.ml index 9b30bc2d4..4b3da078a 100644 --- a/src/lib_client_base/client_debug.ml +++ b/src/lib_client_base/client_debug.ml @@ -47,26 +47,21 @@ let pp_block ppf operations Hex.pp (MBytes.to_hex data) -let stuck_node_report cctxt file = - let ppf = Format.formatter_of_out_channel (open_out file) in - let skip_line () = - Format.pp_print_newline ppf (); - return @@ Format.pp_print_newline ppf () in - let print_title title level = - Format.fprintf ppf "%s %s@.@." (String.init level (fun _ -> '#')) title; - return () in - print_title "Stuck node report:" 1 >>=? fun () -> - return @@ Format.fprintf ppf "Date: %a@;" - Time.pp_hum (Time.now ()) >>=? fun () -> - skip_line () >>=? fun () -> - print_title "Registered protocols:" 2 >>=? fun () -> - return @@ Format.pp_print_list +let print_md_title ppf title level = + Format.fprintf ppf "%s %s@.@." (String.init level (fun _ -> '#')) title + +let skip_line ppf = + Format.pp_print_newline ppf (); + return @@ Format.pp_print_newline ppf () + +let registered_protocols ppf = + Format.pp_print_list ~pp_sep:Format.pp_print_newline (fun ppf (protocol, _) -> Protocol_hash.pp ppf protocol) ppf - (Client_commands.get_versions ()) >>=? fun () -> - skip_line () >>=? fun () -> - print_title "Heads:" 2 >>=? fun () -> + (Client_commands.get_versions ()) + +let print_heads ppf cctxt = Client_rpcs.call_service0 cctxt Node_rpc_services.Blocks.list { include_ops = true ; length = Some 1 ; @@ -83,9 +78,9 @@ let stuck_node_report cctxt file = pp_block ppf blocks) - ppf heads >>=? fun () -> - skip_line () >>=? fun () -> - print_title "Rejected blocks:" 2 >>=? fun () -> + ppf heads + +let print_rejected ppf cctxt = Client_rpcs.call_service0 cctxt Node_rpc_services.Blocks.list_invalid () >>=? fun invalid -> return @@ @@ -108,22 +103,55 @@ let stuck_node_report cctxt file = let commands () = let open Cli_entries in let group = { name = "debug" ; - title = "commands to debug and fix problems with the node" } in + title = "commands to report debug information" } in + let output_arg = + arg + ~doc:"Write output of debug command to file" + ~parameter:"-file" + @@ parameter (fun _ str -> return str) in + let output_to_ppf = function + | None -> Format.std_formatter + | Some file -> Format.formatter_of_out_channel (open_out file) in [ - command ~group ~desc: "debug report" - no_options - (prefixes [ "debug" ; "stuck" ; "node" ] - @@ string ~name:"file" ~desc:"file in which to save report" - @@ stop) - (fun () file (cctxt : Client_commands.full_context) -> - stuck_node_report cctxt file) ; - command ~group ~desc: "unmark invalid" - no_options - (prefixes [ "debug" ; "unmark" ; "invalid" ] - @@ Block_hash.param ~name:"block" ~desc:"block to remove from invalid list" - @@ stop) - (fun () block (cctxt : Client_commands.full_context) -> - Client_rpcs.call_err_service0 cctxt Node_rpc_services.Blocks.unmark_invalid block >>=? fun () -> - cctxt#message "Block %a no longer marked invalid" Block_hash.pp block >>= return - ) + command ~group ~desc: "list protocols" + (args1 output_arg) + (fixed [ "list" ; "registered" ; "protocols" ]) + (fun output (_cctxt : Client_commands.full_context) -> + let ppf = output_to_ppf output in + registered_protocols ppf ; + Format.fprintf ppf "@." ; + return ()) ; + command ~group ~desc: "current heads" + (args1 output_arg) + (fixed [ "list" ; "heads" ]) + (fun output cctxt -> + let ppf = output_to_ppf output in + print_heads ppf cctxt >>=? fun () -> + Format.fprintf ppf "@." ; + return ()) ; + command ~group ~desc: "rejected blocks" + (args1 output_arg) + (fixed [ "list" ; "rejected" ; "blocks" ]) + (fun output cctxt -> + let ppf = output_to_ppf output in + print_rejected ppf cctxt >>|? fun () -> + Format.fprintf ppf "@.") ; + command ~group ~desc: "report on current node state" + (args1 output_arg) + (fixed [ "full" ; "report" ]) + (fun output cctxt -> + let ppf = output_to_ppf output in + print_md_title ppf "Node report:" 1 ; + return @@ Format.fprintf ppf "Date: %a@;" + Time.pp_hum (Time.now ()) >>=? fun () -> + skip_line ppf >>=? fun () -> + print_md_title ppf "Registered protocols:" 2 ; + registered_protocols ppf ; + skip_line ppf >>=? fun () -> + print_md_title ppf "Heads:" 2 ; + print_heads ppf cctxt >>=? fun () -> + skip_line ppf >>=? fun () -> + print_md_title ppf "Rejected blocks:" 2 ; + print_rejected ppf cctxt >>|? fun () -> + Format.fprintf ppf "@.") ; ]