Client: split admin/debug commands into separate executable
This commit is contained in:
parent
c98426fb02
commit
937869da43
1
.gitignore
vendored
1
.gitignore
vendored
@ -10,6 +10,7 @@ _build
|
||||
/tezos-node
|
||||
/tezos-protocol-compiler
|
||||
/tezos-client
|
||||
/tezos-admin-client
|
||||
|
||||
/scripts/opam-test-all.sh.DONE
|
||||
|
||||
|
2
Makefile
2
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:
|
||||
|
15
src/bin_client/admin_main.ml
Normal file
15
src/bin_client/admin_main.ml
Normal 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) ()))
|
@ -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
|
||||
|
@ -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
117
src/bin_client/main_lib.ml
Normal 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
|
23
src/lib_client_base/client_admin.ml
Normal file
23
src/lib_client_base/client_admin.ml
Normal 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) ;
|
||||
]
|
10
src/lib_client_base/client_admin.mli
Normal file
10
src/lib_client_base/client_admin.mli
Normal 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
|
@ -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 "@.") ;
|
||||
]
|
||||
|
Loading…
Reference in New Issue
Block a user