Client: split admin/debug commands into separate executable

This commit is contained in:
Milo Davis 2018-01-15 22:10:20 -05:00 committed by Benjamin Canou
parent c98426fb02
commit 937869da43
9 changed files with 237 additions and 146 deletions

1
.gitignore vendored
View File

@ -10,6 +10,7 @@ _build
/tezos-node
/tezos-protocol-compiler
/tezos-client
/tezos-admin-client
/scripts/opam-test-all.sh.DONE

View File

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

View File

@ -0,0 +1,15 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2017. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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) ()))

View File

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

View File

@ -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
"@[<v 2>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
"@[<v 2>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 "@[<v 2>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 ()))

117
src/bin_client/main_lib.ml Normal file
View File

@ -0,0 +1,117 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2017. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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
"@[<v 2>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
"@[<v 2>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 "@[<v 2>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

View File

@ -0,0 +1,23 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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) ;
]

View File

@ -0,0 +1,10 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
val commands : unit -> (Client_commands.full_context, unit) Cli_entries.command list

View File

@ -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 () =
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 () 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
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 "@.") ;
]