275 lines
8.3 KiB
OCaml
275 lines
8.3 KiB
OCaml
(**************************************************************************)
|
|
(* *)
|
|
(* Copyright (c) 2014 - 2017. *)
|
|
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
|
|
(* *)
|
|
(* All rights reserved. No warranty, explicit or implicit, provided. *)
|
|
(* *)
|
|
(**************************************************************************)
|
|
|
|
(* Tezos Command line interface - Configuration and Arguments Parsing *)
|
|
|
|
type error += Invalid_block_argument of string
|
|
type error += Invalid_protocol_argument of string
|
|
type error += Invalid_port_arg of string
|
|
let () =
|
|
register_error_kind
|
|
`Branch
|
|
~id: "badBlockArgument"
|
|
~title: "Bad Block Argument"
|
|
~description: "Block argument could not be parsed"
|
|
~pp:
|
|
(fun ppf s ->
|
|
Format.fprintf ppf "Value provided for -block flag (%s) could not be parsed" s)
|
|
Data_encoding.(obj1 (req "value" string))
|
|
(function Invalid_block_argument s -> Some s | _ -> None)
|
|
(fun s -> Invalid_block_argument s) ;
|
|
register_error_kind
|
|
`Branch
|
|
~id: "badProtocolArgument"
|
|
~title: "Bad Protocol Argument"
|
|
~description: "Protocol argument could not be parsed"
|
|
~pp:
|
|
(fun ppf s ->
|
|
Format.fprintf ppf "Value provided for -protocol flag (%s) does not correspond to any known protocol" s)
|
|
Data_encoding.(obj1 (req "value" string))
|
|
(function Invalid_protocol_argument s -> Some s | _ -> None)
|
|
(fun s -> Invalid_protocol_argument s) ;
|
|
register_error_kind
|
|
`Branch
|
|
~id: "invalidPortArgument"
|
|
~title: "Bad Port Argument"
|
|
~description: "Port argument could not be parsed"
|
|
~pp:
|
|
(fun ppf s ->
|
|
Format.fprintf ppf "Value provided for -port flag (%s) could not be parsed" s)
|
|
Data_encoding.(obj1 (req "value" string))
|
|
(function Invalid_port_arg s -> Some s | _ -> None)
|
|
(fun s -> Invalid_port_arg s)
|
|
|
|
|
|
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 { base_dir ; node_addr ; node_port ; tls ; web_port } ->
|
|
(base_dir, Some node_addr, Some node_port,
|
|
Some tls, Some web_port))
|
|
(fun (base_dir, node_addr, node_port, tls, web_port) ->
|
|
let node_addr = Option.unopt ~default:default.node_addr node_addr in
|
|
let node_port = Option.unopt ~default:default.node_port node_port in
|
|
let tls = Option.unopt ~default:default.tls tls in
|
|
let web_port = Option.unopt ~default:default.web_port web_port in
|
|
{ base_dir ; node_addr ; node_port ; tls ; web_port })
|
|
(obj5
|
|
(req "base_dir" string)
|
|
(opt "node_addr" string)
|
|
(opt "node_port" int16)
|
|
(opt "tls" bool)
|
|
(opt "web_port" int16))
|
|
|
|
let from_json json =
|
|
Data_encoding.Json.destruct encoding json
|
|
|
|
let read fp =
|
|
Data_encoding_ezjsonm.read_file fp >>=? fun json ->
|
|
return (from_json json)
|
|
|
|
let write out cfg =
|
|
Utils.write_file ~bin:false out
|
|
(Data_encoding.Json.construct encoding cfg |>
|
|
Data_encoding_ezjsonm.to_string)
|
|
|
|
end
|
|
|
|
type cli_args = {
|
|
block: Node_rpc_services.Blocks.block ;
|
|
protocol: Protocol_hash.t option ;
|
|
print_timings: bool ;
|
|
log_requests: bool ;
|
|
}
|
|
|
|
let default_cli_args = {
|
|
block = Client_commands.default_block ;
|
|
protocol = None ;
|
|
print_timings = false ;
|
|
log_requests = false ;
|
|
}
|
|
|
|
|
|
open Cli_entries
|
|
|
|
let string_parameter : (string, Client_commands.full_context) parameter =
|
|
parameter (fun _ x -> return x)
|
|
|
|
let block_parameter =
|
|
parameter
|
|
(fun _ block -> match Node_rpc_services.Blocks.parse_block block with
|
|
| Error _ -> fail (Invalid_block_argument block)
|
|
| Ok block -> return block)
|
|
|
|
let protocol_parameter =
|
|
parameter
|
|
(fun _ arg ->
|
|
try
|
|
let (hash,_commands) =
|
|
List.find (fun (hash,_commands) ->
|
|
(Protocol_hash.to_short_b58check hash) = arg
|
|
) (Client_commands.get_versions ())
|
|
in
|
|
return (Some hash)
|
|
with Not_found -> fail (Invalid_protocol_argument arg)
|
|
)
|
|
|
|
(* Command-line only args (not in config file) *)
|
|
let base_dir_arg =
|
|
default_arg
|
|
~parameter:"-base-dir"
|
|
~doc:"The directory where the Tezos client will store all its data."
|
|
~default:Client_commands.default_base_dir
|
|
string_parameter
|
|
let config_file_arg =
|
|
arg
|
|
~parameter:"-config-file"
|
|
~doc:"The main configuration file."
|
|
string_parameter
|
|
let timings_switch =
|
|
switch
|
|
~parameter:"-timings"
|
|
~doc:"Show RPC request times if present."
|
|
let block_arg =
|
|
default_arg
|
|
~parameter:"-block"
|
|
~doc:"The block on which to apply contextual commands."
|
|
~default:(Node_rpc_services.Blocks.to_string default_cli_args.block)
|
|
block_parameter
|
|
let protocol_arg =
|
|
arg
|
|
~parameter:"-protocol"
|
|
~doc:"Use contextual commands of a specific protocol."
|
|
protocol_parameter
|
|
let log_requests_switch =
|
|
switch
|
|
~parameter:"-log-requests"
|
|
~doc:"Causes all requests and responses to the node to be logged."
|
|
|
|
(* Command-line args which can be set in config file as well *)
|
|
let addr_arg =
|
|
default_arg
|
|
~parameter:"-addr"
|
|
~doc:"The IP address of the node."
|
|
~default:Cfg_file.default.node_addr
|
|
string_parameter
|
|
let port_arg =
|
|
default_arg
|
|
~parameter:"-port"
|
|
~doc:"The RPC port of the node."
|
|
~default:(string_of_int Cfg_file.default.node_port)
|
|
(parameter
|
|
(fun _ x -> try
|
|
return (int_of_string x)
|
|
with Failure _ ->
|
|
fail (Invalid_port_arg x)))
|
|
let tls_switch =
|
|
switch
|
|
~parameter:"-tls"
|
|
~doc:"Use TLS to connect to node."
|
|
|
|
let global_options =
|
|
args9 base_dir_arg
|
|
config_file_arg
|
|
timings_switch
|
|
block_arg
|
|
protocol_arg
|
|
log_requests_switch
|
|
addr_arg
|
|
port_arg
|
|
tls_switch
|
|
|
|
let parse_config_args (ctx : Client_commands.full_context) argv =
|
|
parse_initial_options
|
|
global_options
|
|
ctx
|
|
argv >>|?
|
|
fun ((base_dir,
|
|
config_file,
|
|
timings,
|
|
block,
|
|
protocol,
|
|
log_requests,
|
|
node_addr,
|
|
node_port,
|
|
tls), remaining) ->
|
|
let config_file =
|
|
match config_file with
|
|
| None -> base_dir // "config"
|
|
| Some config_file -> config_file in
|
|
let config_dir = Filename.dirname config_file in
|
|
let protocol =
|
|
match protocol with
|
|
| None -> None
|
|
| Some p -> p
|
|
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 || tls 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 ;
|
|
Utils.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 ;
|
|
Utils.mkdir config_dir ;
|
|
if not (Sys.file_exists config_file) then Cfg_file.write config_file cfg ;
|
|
(cfg, { block ; print_timings = timings ; log_requests ; protocol }, remaining)
|