From 6d41b3d38c94f9c8bbc35ff376f377e7633840e3 Mon Sep 17 00:00:00 2001 From: Vincent Bernardoff Date: Mon, 30 Jan 2017 19:10:16 +0100 Subject: [PATCH] Shell: Improve the CLI of `tezos-node` * Use subcommands: * `tezos_node run` * `tezos_node config` * `tezos_node identity` * Regroup all on-disk data in `--data-dir` * Split `Node_main` in multiple files. * Add DNS resolution for `--net-addr` and `--rpc-addr` * Hardcode `bootstrap.tezos.com` as bootstrap peer(s) * Add `--no-bootstrap-peers` * Rename `--expected-connections` -> `--connections` --- README.md | 173 ++++- src/.merlin | 2 + src/Makefile | 18 +- src/minutils/utils.ml | 51 ++ src/minutils/utils.mli | 5 + src/node/main/node_config_command.ml | 140 ++++ src/node/main/node_config_command.mli | 14 + src/node/main/node_config_file.ml | 398 +++++++++++ src/node/main/node_config_file.mli | 78 +++ src/node/main/node_identity_command.ml | 150 +++++ src/node/main/node_identity_command.mli | 14 + src/node/main/node_identity_file.ml | 86 +++ src/node/main/node_identity_file.mli | 21 + src/node/main/node_run_command.ml | 285 ++++++++ src/node/main/node_run_command.mli | 15 + src/node/main/node_shared_arg.ml | 250 +++++++ src/node/main/node_shared_arg.mli | 44 ++ src/node/net/p2p.ml | 15 +- src/node/net/p2p.mli | 4 +- src/node/net/p2p_types.ml | 40 +- src/node/net/p2p_types.mli | 2 +- src/node/net/p2p_welcome.ml | 5 +- src/node/updater/updater.ml | 16 +- src/node_main.ml | 861 +----------------------- src/utils/error_monad.ml | 12 +- src/utils/logging.ml | 160 +++-- src/utils/logging.mli | 24 +- src/utils/lwt_utils.ml | 67 ++ src/utils/lwt_utils.mli | 20 + test/launch.sh | 2 +- test/test-basic.sh | 2 +- test/test_basic.ml | 5 +- 32 files changed, 2019 insertions(+), 960 deletions(-) create mode 100644 src/node/main/node_config_command.ml create mode 100644 src/node/main/node_config_command.mli create mode 100644 src/node/main/node_config_file.ml create mode 100644 src/node/main/node_config_file.mli create mode 100644 src/node/main/node_identity_command.ml create mode 100644 src/node/main/node_identity_command.mli create mode 100644 src/node/main/node_identity_file.ml create mode 100644 src/node/main/node_identity_file.mli create mode 100644 src/node/main/node_run_command.ml create mode 100644 src/node/main/node_run_command.mli create mode 100644 src/node/main/node_shared_arg.ml create mode 100644 src/node/main/node_shared_arg.mli diff --git a/README.md b/README.md index 55d991134..1511397fa 100644 --- a/README.md +++ b/README.md @@ -61,7 +61,7 @@ Running the node in a sandbox To run a single instance of a Tezos node in sandbox mode: ``` -./tezos-node --sandbox --rpc-addr :::8732 +./tezos-node run --sandbox --rpc-addr localhost:8732 ``` This "sandboxed" node will not participate in the P2P network, but will accept @@ -77,12 +77,12 @@ test network. Use the following command to run a node that will accept incoming connections: ``` -./tezos-node --generate-identity --expected-pow 24. +./tezos-node identity generate 24. ``` -This will first generate a new node identity and compute the associated stamp -of proof-of-work. Then, the node will listen to connections coming in on -`0.0.0.0:9732` (and`[::]:9732`). All used data is stored at +This will first generate a new node identity and compute the +associated stamp of proof-of-work. Then, the node will listen to +connections coming in on `[::]:9732`. All used data is stored at `$HOME/.tezos-node/`. For example, the default configuration file is at `$HOME/.tezos-node/config.json`. @@ -97,7 +97,7 @@ command will generate it and replace the default values with the values from the command line: ``` -./tezos-node --base-dir "$dir" --net-addr 127.0.0.1:9733 +./tezos-node run --data-dir "$dir" --net-addr localhost:9733 ``` The Tezos server has a built-in mechanism to discover peers on the local @@ -108,8 +108,9 @@ initial peers, either by editing the option `net.bootstrap-peers` in the `config.json` file, or by specifying a command line parameter: ``` -./tezos-node --base-dir "$dir" --net-addr 127.0.0.1:2023 \ - --peer 127.0.0.1:2021 --peer 127.0.0.1:2022 +./tezos-node run \ + --data-dir "$dir" --net-addr localhost:2023 \ + --peer localhost:2021 --peer localhost:2022 ``` If `"$dir"/config.json` exists, the command line options override those @@ -119,10 +120,154 @@ to reset or to update the file according to the command line parameters with the following commands line: ``` -./tezos-node --reset-config --base-dir "$dir" --net-addr 127.0.0.1:9733 -./tezos-node --update-config --base-dir "$dir" --net-addr 127.0.0.1:9734 +./tezos-node config reset --data-dir "$dir" --net-addr localhost:9733 +./tezos-node config update --data-dir "$dir" --net-addr localhost:9734 ``` +Configuration options +--------------------- + +Here is an example configuration file with all parameters +specified. Most of the time it uses default values, except for cases +where the default is not explanatory enough (i.e. "bootstrap-peers" is +an empty list by default). Comments are not allowed in JSON, so this +configuration file would not parse. They are just provided here to +help writing your own configuration file if needed. + + +``` +{ + + /* Location of the data dir on disk. */ + + "data-dir": "/home/tezos/my_data_dir" + + /* Configuration of net parameters */ + + "net": { + + /* Floating point number between 0 and 256 that represents a + difficulty, 24 signifies for example that at least 24 leading + zeroes are expected in the hash. */ + + "expected-proof-of-work": 24.5, + + /* List of hosts. Tezos can connect to both IPv6 and IPv4 + hosts. If the port is not specified, default port 9732 will be + assumed. */ + + "bootstrap-peers": ["::1:10732", "::ffff:192.168.1.3:9733", "mynode.tezos.com"], + + /* Specify if the network is closed or not. A closed network + allows only peers listed in "bootstrap-peers". */ + + "closed": false, + + /* Network limits */ + + "limits": { + + /* Delay granted to a peer to perform authentication, in + seconds. */ + + "authentication-timeout": 5, + + /* Strict minimum number of connections (triggers an urgent + maintenance). */ + + "min-connections": 50, + + /* Targeted number of connections to reach when bootstraping / + maintaining. */ + + "expected-connections": 100, + + /* Maximum number of connections (exceeding peers are + disconnected). */ + + "max-connections": 200, + + /* Number above which pending incoming connections are + immediately rejected. */ + + "backlog": 20, + + /* Maximum allowed number of incoming connections that are + pending authentication. */ + + "max-incoming-connections": 20, + + /* Max download and upload speeds in KiB/s. */ + + "max-download-speed": 1024, + "max-upload-speed": 1024, + + /* Size of the buffer passed to read(2). */ + + "read-buffer-size": 16384, + } + }, + + /* Configuration of rpc parameters */ + + "rpc": { + + /* Host to listen to. If the port is not specified, the default + port 8732 will be assumed. */ + + "listen-addr": "localhost:8733", + + /* Cross Origin Resource Sharing parameters, see + https://en.wikipedia.org/wiki/Cross-origin_resource_sharing. */ + + "cors-origin": [], + "cors-headers": [], + + /* Certificate and key files (necessary when TLS is used). */ + + "crt": "tezos-node.crt", + "key": "tezos-node.key" + }, + + /* Configuration of log parameters */ + + "log": { + + /* Output for the logging function. Either "stdout", "stderr" or + the name of a log file . */ + + "output": "tezos-node.log", + + /* Verbosity level: one of 'fatal', 'error', 'warn', 'notice', + 'info', 'debug'. */ + + "level": "info", + + /* Fine-grained logging instructions. Same format as described in + `tezos-node run --help`, DEBUG section. In the example below, + sections "net" and all sections starting by "client" will have + their messages logged up to the debug level, whereas the rest of + log sections will be logged up to the notice level. */ + + "rules": "client* -> debug, net -> debug, * -> notice", + + /* Format for the log file, see + http://ocsigen.org/lwt/dev/api/Lwt_log_core#2_Logtemplates. */ + + "template": "$(date) - $(section): $(message)" + } +} +``` + +Debugging +--------- + +It is possible to set independant log levels for different logging +sections in Tezos, as well as specifying an output file for +logging. See the description of log parameters above as well as +documentation under the DEBUG section diplayed by `tezos-node run +--help'. + JSON/RPC interface ------------------ @@ -134,7 +279,7 @@ Typically, if you are not trying to run a local network and just want to explore the RPC, you would run: ``` -./tezos-node --sandbox --rpc-addr :::8732 +./tezos-node run --sandbox --rpc-addr localhost ``` The RPC interface is self-documented and the `tezos-client` executable is able @@ -163,9 +308,9 @@ Note: you can get the same information, but as a raw JSON object, with a simple HTTP request: ``` -wget --post-data '{ "recursive": true }' -O - http://127.0.0.1:8732/describe -wget --post-data '{ "recursive": true }' -O - http://127.0.0.1:8732/describe/blocks/genesis -wget -O - http://127.0.0.1:8732/describe/blocks/genesis/hash +wget --post-data '{ "recursive": true }' -O - http://localhost:8732/describe +wget --post-data '{ "recursive": true }' -O - http://localhost:8732/describe/blocks/genesis +wget -O - http://localhost:8732/describe/blocks/genesis/hash ``` diff --git a/src/.merlin b/src/.merlin index 1224c6ffd..adbd081bd 100644 --- a/src/.merlin +++ b/src/.merlin @@ -6,6 +6,8 @@ S node/shell B node/shell S node/db B node/db +S node/main +B node/main S minutils B minutils S utils diff --git a/src/Makefile b/src/Makefile index 2eea22a93..2deb4c332 100644 --- a/src/Makefile +++ b/src/Makefile @@ -187,6 +187,7 @@ UTILS_PACKAGES := \ base64 \ calendar \ ezjsonm \ + ipaddr.unix \ mtime.os \ sodium \ zarith \ @@ -330,7 +331,21 @@ NODE_LIB_IMPLS := \ node/shell/node.ml \ node/shell/node_rpc.ml \ +NODE_INTFS := \ + node/main/node_identity_file.mli \ + node/main/node_config_file.mli \ + node/main/node_shared_arg.mli \ + node/main/node_run_command.mli \ + node/main/node_config_command.mli \ + node/main/node_identity_command.mli \ + NODE_IMPLS := \ + node/main/node_identity_file.ml \ + node/main/node_config_file.ml \ + node/main/node_shared_arg.ml \ + node/main/node_run_command.ml \ + node/main/node_config_command.ml \ + node/main/node_identity_command.ml \ node_main.ml \ NODE_PACKAGES := \ @@ -351,11 +366,12 @@ EMBEDDED_NODE_PROTOCOLS := \ NODE_OBJS := \ ${NODE_IMPLS:.ml=.cmx} ${NODE_IMPLS:.ml=.ml.deps} \ + ${NODE_INTFS:.mli=.cmi} ${NODE_INTFS:.mli=.mli.deps} \ ${NODE_LIB_IMPLS:.ml=.cmx} ${NODE_LIB_IMPLS:.ml=.ml.deps} \ ${NODE_LIB_INTFS:.mli=.cmi} ${NODE_LIB_INTFS:.mli=.mli.deps} \ ${TZNODE} ${NODE_OBJS}: PACKAGES=${NODE_PACKAGES} -${NODE_OBJS}: SOURCE_DIRECTORIES=minutils utils compiler node/db node/net node/updater node/shell +${NODE_OBJS}: SOURCE_DIRECTORIES=minutils utils compiler node/db node/net node/updater node/shell node/main ${NODE_OBJS}: TARGET="(node.cmxa)" ${NODE_OBJS}: OPENED_MODULES=Error_monad Hash Utils diff --git a/src/minutils/utils.ml b/src/minutils/utils.ml index db569c68c..180ccf74e 100644 --- a/src/minutils/utils.ml +++ b/src/minutils/utils.ml @@ -86,6 +86,10 @@ let list_rev_sub l n = let list_sub l n = list_rev_sub l n |> List.rev +let list_hd_opt = function + | [] -> None + | h :: _ -> Some h + let display_paragraph ppf description = Format.fprintf ppf "@[%a@]" (Format.pp_print_list ~pp_sep:Format.pp_print_newline @@ -200,3 +204,50 @@ let select n l = | x :: xs -> loop (pred n) (x :: acc) xs in loop n [] l + + +let mem_char s c = + match String.index s c with + | exception Not_found -> false + | _ -> true + +let check_port port = + if mem_char port '[' || mem_char port ']' || mem_char port ':' then + invalid_arg "Utils.parse_addr_port (invalid character in port)" + +let parse_addr_port s = + let len = String.length s in + if len = 0 then + ("", "") + else if s.[0] = '[' then begin (* inline IPv6 *) + match String.rindex s ']' with + | exception Not_found -> + invalid_arg "Utils.parse_addr_port (missing ']')" + | pos -> + let addr = String.sub s 1 (pos - 1) in + let port = + if pos = len - 1 then + "" + else if s.[pos+1] <> ':' then + invalid_arg "Utils.parse_addr_port (unexpected char after ']')" + else + String.sub s (pos + 2) (len - pos - 2) in + check_port port ; + addr, port + end else begin + match String.rindex s ']' with + | _pos -> + invalid_arg "Utils.parse_addr_port (unexpected char ']')" + | exception Not_found -> + match String.index s ':' with + | exception _ -> s, "" + | pos -> + match String.index_from s (pos+1) ':' with + | exception _ -> + let addr = String.sub s 0 pos in + let port = String.sub s (pos + 1) (len - pos - 1) in + check_port port ; + addr, port + | _pos -> + invalid_arg "split_url_port: IPv6 addresses must be bracketed" + end diff --git a/src/minutils/utils.mli b/src/minutils/utils.mli index c22b03aa8..f43c8433d 100644 --- a/src/minutils/utils.mli +++ b/src/minutils/utils.mli @@ -39,6 +39,7 @@ val filter_map: ('a -> 'b option) -> 'a list -> 'b list val list_rev_sub : 'a list -> int -> 'a list (** [list_sub l n] is l capped to max n elements *) val list_sub: 'a list -> int -> 'a list +val list_hd_opt: 'a list -> 'a option val finalize: (unit -> 'a) -> (unit -> unit) -> 'a @@ -66,3 +67,7 @@ module Bounded(E: Set.OrderedType) : sig end val select: int -> 'a list -> 'a * 'a list + +(** [split_url_port uri] is (node, service) where [node] is the DNS or + IP and service is the optional port number or service name. *) +val parse_addr_port: string -> string * string diff --git a/src/node/main/node_config_command.ml b/src/node/main/node_config_command.ml new file mode 100644 index 000000000..2d328f697 --- /dev/null +++ b/src/node/main/node_config_command.ml @@ -0,0 +1,140 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +(** Commands *) + +let show (args : Node_shared_arg.t) = + if not @@ Sys.file_exists args.config_file then + Format.eprintf + "\n\ + Warning: no config file at %s,\n\ + \ displaying the default configuration.\n@." + args.config_file ; + Node_shared_arg.read_and_patch_config_file args >>=? fun cfg -> + Node_config_file.check cfg >>= fun () -> + print_endline @@ Node_config_file.to_string cfg ; + return () + +let reset (args : Node_shared_arg.t) = + if Sys.file_exists args.config_file then + Format.eprintf + "Ignoring previous configuration file: %s.@." + args.config_file ; + Node_shared_arg.read_and_patch_config_file args >>=? fun cfg -> + Node_config_file.check cfg >>= fun () -> + Node_config_file.write args.config_file cfg + +let init (args : Node_shared_arg.t) = + if Sys.file_exists args.config_file then + failwith + "Pre-existant config file at %s, use `reset`." + args.config_file + else + Node_shared_arg.read_and_patch_config_file args >>=? fun cfg -> + Node_config_file.check cfg >>= fun () -> + Node_config_file.write args.config_file cfg + +let update (args : Node_shared_arg.t) = + if not (Sys.file_exists args.config_file) then + failwith + "Missing configuration file at %s. \ + Use `%s config init [options]` to generate a new file" + args.config_file Sys.argv.(0) + else + Node_shared_arg.read_and_patch_config_file args >>=? fun cfg -> + Node_config_file.check cfg >>= fun () -> + Node_config_file.write args.config_file cfg + +(** Main *) + +module Term = struct + + type subcommand = Show | Reset | Init | Update + + let process subcommand args = + let res = + match subcommand with + | Show -> show args + | Reset -> reset args + | Init -> init args + | Update -> update args in + match Lwt_main.run res with + | Ok () -> `Ok () + | Error err -> `Error (false, Format.asprintf "%a" pp_print_error err) + + let subcommand_arg = + let parser = function + | "show" -> `Ok Show + | "reset" -> `Ok Reset + | "init" -> `Ok Init + | "update" -> `Ok Update + | s -> `Error ("invalid argument: " ^ s) + and printer ppf = function + | Show -> Format.fprintf ppf "show" + | Reset -> Format.fprintf ppf "reset" + | Init -> Format.fprintf ppf "init" + | Update -> Format.fprintf ppf "update" in + let open Cmdliner.Arg in + let doc = + "Operation to perform. \ + Possible values: $(b,show), $(b,reset), $(b,init), $(b,save)." in + value & pos 0 (parser, printer) Show & info [] ~docv:"OPERATION" ~doc + + let term = + let open Cmdliner.Term in + ret (const process $ subcommand_arg $ Node_shared_arg.Term.args) + +end + +module Manpage = struct + + let command_description = + "The $(b,config) command is meant to inspect and amend the \ + configuration of the Tezos node. \ + This command is complementary to manually editing the tezos \ + node configuration file. Its arguments are a subset of the $(i,run) \ + command ones." + + let description = [ + `S "DESCRIPTION" ; + `P (command_description ^ " Several operations are possible: "); + `P "$(b,show) reads, parses and displays Tezos current config file. \ + Use this command to see exactly what config file will be used by \ + Tezos. If additional command-line arguments are provided, \ + the displayed configuration will be amended accordingly. \ + This is the default operation." ; + `P "$(b,reset) will overwrite the current configuration file with a \ + factory default one. \ + If additional command-line arguments are provided, \ + they will amend the generated file. \ + It assumes that a configuration file already exists, \ + and will abort otherwise." ; + `P "$(b,init) is like reset but assumes that \ + no configuration file is present, \ + and will abort other otherwise." ; + `P "$(b,save) is the main option to edit the configuration file of Tezos. \ + It will parse command line arguments and add or replace corresponding \ + entries in the Tezos configuration file." + ] + + let man = + description @ + Node_shared_arg.Manpage.args @ + Node_shared_arg.Manpage.bugs + + let info = + Cmdliner.Term.info + ~doc:"Manage node configuration" + ~man + "config" + +end + +let cmd = + Term.term, Manpage.info diff --git a/src/node/main/node_config_command.mli b/src/node/main/node_config_command.mli new file mode 100644 index 000000000..120b45a1c --- /dev/null +++ b/src/node/main/node_config_command.mli @@ -0,0 +1,14 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +val cmd : unit Cmdliner.Term.t * Cmdliner.Term.info + +module Manpage : sig + val command_description: string +end diff --git a/src/node/main/node_config_file.ml b/src/node/main/node_config_file.ml new file mode 100644 index 000000000..07ea8695c --- /dev/null +++ b/src/node/main/node_config_file.ml @@ -0,0 +1,398 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +open P2p_types + +let (//) = Filename.concat + +let home = + try Sys.getenv "HOME" + with Not_found -> "/root" + +let default_data_dir = home // ".tezos-node" +let default_net_port = 9732 +let default_rpc_port = 8732 + +type t = { + data_dir : string ; + net : net ; + rpc : rpc ; + log : log ; +} + +and net = { + expected_pow : float ; + bootstrap_peers : string list ; + listen_addr : string option ; + closed : bool ; + limits : P2p.limits ; +} + +and rpc = { + listen_addr : string option ; + cors_origins : string list ; + cors_headers : string list ; + tls : tls option ; +} + +and tls = { + cert : string ; + key : string ; +} + +and log = { + output : Logging.Output.t ; + default_level : Logging.level ; + rules : string option ; + template : Logging.template ; +} + +let default_net_limits : P2p.limits = { + authentification_timeout = 5. ; + min_connections = 50 ; + expected_connections = 100 ; + max_connections = 200 ; + backlog = 20 ; + max_incoming_connections = 20 ; + max_download_speed = None ; + max_upload_speed = None ; + read_buffer_size = 1 lsl 14 ; + read_queue_size = None ; + write_queue_size = None ; + incoming_app_message_queue_size = None ; + incoming_message_queue_size = None ; + outgoing_message_queue_size = None ; +} + +let default_net = { + expected_pow = 24. ; + bootstrap_peers = ["bootstrap.tezos.com"] ; + listen_addr = Some ("[::]:" ^ string_of_int default_net_port) ; + closed = false ; + limits = default_net_limits ; +} + +let default_rpc = { + listen_addr = None ; + cors_origins = [] ; + cors_headers = [] ; + tls = None ; +} + +let default_log = { + output = Stderr ; + default_level = Notice ; + rules = None ; + template = Logging.default_template ; +} + +let default_config = { + data_dir = default_data_dir ; + net = default_net ; + rpc = default_rpc ; + log = default_log ; +} + +let limit : P2p.limits Data_encoding.t = + let open Data_encoding in + conv + (fun { P2p.authentification_timeout ; + min_connections ; expected_connections ; max_connections ; + backlog ; max_incoming_connections ; + max_download_speed ; max_upload_speed ; + read_buffer_size ; read_queue_size ; write_queue_size ; + incoming_app_message_queue_size ; + incoming_message_queue_size ; outgoing_message_queue_size } -> + ( ( authentification_timeout, min_connections, expected_connections, + max_connections, backlog, max_incoming_connections, + max_download_speed, max_upload_speed) , + ( read_buffer_size, read_queue_size, write_queue_size, + incoming_app_message_queue_size, + incoming_message_queue_size, outgoing_message_queue_size ))) + (fun ( ( authentification_timeout, min_connections, expected_connections, + max_connections, backlog, max_incoming_connections, + max_download_speed, max_upload_speed) , + ( read_buffer_size, read_queue_size, write_queue_size, + incoming_app_message_queue_size, + incoming_message_queue_size, outgoing_message_queue_size ) ) -> + { authentification_timeout ; min_connections ; expected_connections ; + max_connections ; backlog ; max_incoming_connections ; + max_download_speed ; max_upload_speed ; + read_buffer_size ; read_queue_size ; write_queue_size ; + incoming_app_message_queue_size ; + incoming_message_queue_size ; outgoing_message_queue_size }) + (merge_objs + (obj8 + (dft "authentification-timeout" + float default_net_limits.authentification_timeout) + (dft "min-connections" int31 + default_net_limits.min_connections) + (dft "expected-connections" int31 + default_net_limits.expected_connections) + (dft "max-connections" int31 + default_net_limits.max_connections) + (dft "backlog" int31 + default_net_limits.backlog) + (dft "max-incoming-connections" int31 + default_net_limits.max_incoming_connections) + (opt "max-download-speed" int31) + (opt "max-upload-speed" int31)) + (obj6 + (dft "read-buffer-size" int31 + default_net_limits.read_buffer_size) + (opt "read-queue-size" int31) + (opt "write-queue-size" int31) + (opt "incoming-app-message-queue-size" int31) + (opt "incoming-message-queue-size" int31) + (opt "outgoing-message-queue-size" int31))) + +let net = + let open Data_encoding in + conv + (fun { expected_pow ; bootstrap_peers ; + listen_addr ; closed ; limits } -> + ( expected_pow, bootstrap_peers, + listen_addr, closed, limits )) + (fun ( expected_pow, bootstrap_peers, + listen_addr, closed, limits ) -> + { expected_pow ; bootstrap_peers ; + listen_addr ; closed ; limits }) + (obj5 + (dft "expected-proof-or-work" float default_net.expected_pow) + (dft "bootstrap-peers" + (list string) default_net.bootstrap_peers) + (opt "listen-addr" string) + (dft "closed" bool false) + (dft "limits" limit default_net_limits)) + +let rpc : rpc Data_encoding.t = + let open Data_encoding in + conv + (fun { cors_origins ; cors_headers ; listen_addr ; tls } -> + let cert, key = + match tls with + | None -> None, None + | Some { cert ; key } -> Some cert, Some key in + (listen_addr, cors_origins, cors_headers, cert, key )) + (fun (listen_addr, cors_origins, cors_headers, cert, key ) -> + let tls = + match cert, key with + | None, _ | _, None -> None + | Some cert, Some key -> Some { cert ; key } in + { listen_addr ; cors_origins ; cors_headers ; tls }) + (obj5 + (opt "listen-addr" string) + (dft "cors-origin" (list string) default_rpc.cors_origins) + (dft "cors-headers" (list string) default_rpc.cors_headers) + (opt "crt" string) + (opt "key" string)) + +let log = + let open Data_encoding in + conv + (fun {output ; default_level ; rules ; template } -> + (output, default_level, rules, template)) + (fun (output, default_level, rules, template) -> + { output ; default_level ; rules ; template }) + (obj4 + (dft "output" Logging.Output.encoding default_log.output) + (dft "level" Logging.level_encoding default_log.default_level) + (opt "rules" string) + (dft "template" string default_log.template)) + +let encoding = + let open Data_encoding in + conv + (fun { data_dir ; rpc ; net ; log } -> (data_dir, rpc, net, log)) + (fun (data_dir, rpc, net, log) -> { data_dir ; rpc ; net ; log }) + (obj4 + (dft "data-dir" string default_data_dir) + (dft "rpc" rpc default_rpc) + (req "net" net) + (dft "log" log default_log)) + +let read fp = + if Sys.file_exists fp then begin + Data_encoding_ezjsonm.read_file fp >>=? fun json -> + try return (Data_encoding.Json.destruct encoding json) + with exn -> fail (Exn exn) + end else + return default_config + +let write fp cfg = + Lwt_utils.create_dir ~perm:0o700 (Filename.dirname fp) >>= fun () -> + Data_encoding_ezjsonm.write_file fp + (Data_encoding.Json.construct encoding cfg) + +let to_string cfg = + Data_encoding_ezjsonm.to_string + (Data_encoding.Json.construct encoding cfg) + +let update + ?data_dir + ?min_connections + ?expected_connections + ?max_connections + ?max_download_speed + ?max_upload_speed + ?expected_pow + ?bootstrap_peers + ?listen_addr + ?rpc_listen_addr + ?(closed = false) + ?(cors_origins = []) + ?(cors_headers = []) + ?rpc_tls + ?log_output + cfg = + let unopt_list ~default = function + | [] -> default + | l -> l in + let limits : P2p.limits = { + cfg.net.limits with + min_connections = + Utils.unopt + ~default:cfg.net.limits.min_connections + min_connections ; + expected_connections = + Utils.unopt + ~default:cfg.net.limits.expected_connections + expected_connections ; + max_connections = + Utils.unopt + ~default:cfg.net.limits.max_connections + max_connections ; + max_download_speed = + Utils.first_some + max_download_speed cfg.net.limits.max_download_speed ; + max_upload_speed = + Utils.first_some + max_upload_speed cfg.net.limits.max_upload_speed ; + } in + let net : net = { + expected_pow = + Utils.unopt ~default:cfg.net.expected_pow expected_pow ; + bootstrap_peers = + Utils.unopt ~default:cfg.net.bootstrap_peers bootstrap_peers ; + listen_addr = + Utils.first_some listen_addr cfg.net.listen_addr ; + closed = cfg.net.closed || closed ; + limits ; + } + and rpc : rpc = { + listen_addr = + Utils.first_some rpc_listen_addr cfg.rpc.listen_addr ; + cors_origins = + unopt_list ~default:cfg.rpc.cors_origins cors_origins ; + cors_headers = + unopt_list ~default:cfg.rpc.cors_headers cors_headers ; + tls = + Utils.first_some rpc_tls cfg.rpc.tls ; + } + and log : log = { + cfg.log with + output = Utils.unopt ~default:cfg.log.output log_output ; + } + in + { data_dir = Utils.unopt ~default:cfg.data_dir data_dir ; + net ; rpc ; log } + +let resolve_addr ?default_port ?(passive = false) peer = + let addr, port = Utils.parse_addr_port peer in + let node = if addr = "" || addr = "_" then "::" else addr + and service = + match port, default_port with + | "", None -> + invalid_arg "" + | "", Some default_port -> string_of_int default_port + | port, _ -> port in + Lwt_utils.getaddrinfo ~passive ~node ~service + +let resolve_addrs ?default_port ?passive peers = + Lwt_list.fold_left_s begin fun a peer -> + resolve_addr ?default_port ?passive peer >>= fun points -> + Lwt.return (List.rev_append points a) + end [] peers + +let resolve_listening_addrs listen_addr = + resolve_addr + ~default_port:default_net_port + ~passive:true + listen_addr + +let resolve_rpc_listening_addrs listen_addr = + resolve_addr + ~default_port:default_rpc_port + ~passive:true + listen_addr + +let resolve_bootstrap_addrs peers = + resolve_addrs + ~default_port:default_net_port + peers +let check_listening_addr config = + match config.net.listen_addr with + | None -> Lwt.return_unit + | Some addr -> + Lwt.catch begin fun () -> + resolve_listening_addrs addr >>= function + | [] -> + Format.eprintf "Warning: failed to resolve %S\n@." addr ; + Lwt.return_unit + | _ :: _ -> + Lwt.return_unit + end begin function + | (Invalid_argument msg) -> + Format.eprintf "Warning: failed to parse %S:\ %s\n@." addr msg ; + Lwt.return_unit + | exn -> Lwt.fail exn + end + +let check_rpc_listening_addr config = + match config.rpc.listen_addr with + | None -> Lwt.return_unit + | Some addr -> + Lwt.catch begin fun () -> + resolve_rpc_listening_addrs addr >>= function + | [] -> + Format.eprintf "Warning: failed to resolve %S\n@." addr ; + Lwt.return_unit + | _ :: _ -> + Lwt.return_unit + end begin function + | (Invalid_argument msg) -> + Format.eprintf "Warning: failed to parse %S:\ %s\n@." addr msg ; + Lwt.return_unit + | exn -> Lwt.fail exn + end + +let check_bootstrap_peer addr = + Lwt.catch begin fun () -> + resolve_bootstrap_addrs [addr] >>= function + | [] -> + Format.eprintf "Warning: cannot resolve %S\n@." addr ; + Lwt.return_unit + | _ :: _ -> + Lwt.return_unit + end begin function + | (Invalid_argument msg) -> + Format.eprintf "Warning: failed to parse %S:\ %s\n@." addr msg ; + Lwt.return_unit + | exn -> Lwt.fail exn + end + + +let check_bootstrap_peers config = + Lwt_list.iter_p check_bootstrap_peer config.net.bootstrap_peers + +let check config = + check_listening_addr config >>= fun () -> + check_rpc_listening_addr config >>= fun () -> + check_bootstrap_peers config >>= fun () -> + Lwt.return_unit diff --git a/src/node/main/node_config_file.mli b/src/node/main/node_config_file.mli new file mode 100644 index 000000000..db5d377a0 --- /dev/null +++ b/src/node/main/node_config_file.mli @@ -0,0 +1,78 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +open P2p_types + +type t = { + data_dir : string ; + net : net ; + rpc : rpc ; + log : log ; +} + +and net = { + expected_pow : float ; + bootstrap_peers : string list ; + listen_addr : string option ; + closed : bool ; + limits : P2p.limits ; +} + +and rpc = { + listen_addr : string option ; + cors_origins : string list ; + cors_headers : string list ; + tls : tls option ; +} + +and tls = { + cert : string ; + key : string ; +} + +and log = { + output : Logging.Output.t ; + default_level : Logging.level ; + rules : string option ; + template : Logging.template ; +} + +val default_data_dir: string +val default_net_port: int +val default_rpc_port: int +val default_net: net +val default_config: t + +val update: + ?data_dir:string -> + ?min_connections:int -> + ?expected_connections:int -> + ?max_connections:int -> + ?max_download_speed:int -> + ?max_upload_speed:int -> + ?expected_pow:float -> + ?bootstrap_peers:string list -> + ?listen_addr:string -> + ?rpc_listen_addr:string -> + ?closed:bool -> + ?cors_origins:string list -> + ?cors_headers:string list -> + ?rpc_tls:tls -> + ?log_output:Logging.Output.t -> + t -> t + +val to_string: t -> string +val read: string -> t tzresult Lwt.t +val write: string -> t -> unit tzresult Lwt.t + +val resolve_listening_addrs: string -> (P2p_types.addr * int) list Lwt.t +val resolve_rpc_listening_addrs: string -> (P2p_types.addr * int) list Lwt.t +val resolve_bootstrap_addrs: string list -> (P2p_types.addr * int) list Lwt.t + +val check: t -> unit Lwt.t diff --git a/src/node/main/node_identity_command.ml b/src/node/main/node_identity_command.ml new file mode 100644 index 000000000..49333ef8c --- /dev/null +++ b/src/node/main/node_identity_command.ml @@ -0,0 +1,150 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +let (//) = Filename.concat + +(** Commands *) + +let identity_file data_dir = data_dir // Node_identity_file.default_name + +let show { Node_config_file.data_dir } = + Node_identity_file.read (identity_file data_dir) >>=? fun id -> + Format.printf "Gid: %a.@." P2p_types.Gid.pp id.gid ; + return () + +let generate { Node_config_file.data_dir ; net } = + let identity_file = identity_file data_dir in + if Sys.file_exists identity_file then + fail (Node_identity_file.Existent_identity_file identity_file) + else + let target = Crypto_box.make_target net.expected_pow in + Format.eprintf "Generating a new identity... " ; + let id = + P2p.Identity.generate_with_animation Format.err_formatter target in + Node_identity_file.write identity_file id >>=? fun () -> + Format.eprintf + "Stored the new identity (%a) into '%s'.@." + P2p.Gid.pp id.gid identity_file ; + return () + +let check { Node_config_file.data_dir ; net = { expected_pow } } = + Node_identity_file.read + ~expected_pow (identity_file data_dir) >>=? fun id -> + Format.printf + "Gid: %a. Proof of work is higher than %.2f.@." + P2p_types.Gid.pp id.gid expected_pow ; + return () + +(** Main *) + +module Term = struct + + type subcommand = Show | Generate | Check + + let process subcommand data_dir config_file expected_pow = + let res = + begin + match data_dir, config_file with + | None, None -> + return Node_config_file.default_config + | None, Some config_file -> + Node_config_file.read config_file + | Some data_dir, None -> + Node_config_file.read (data_dir // "config.json") >>=? fun cfg -> + return { cfg with data_dir } + | Some data_dir, Some config_file -> + Node_config_file.read config_file >>=? fun cfg -> + return { cfg with data_dir } + end >>=? fun cfg -> + let cfg = Node_config_file.update ?expected_pow cfg in + match subcommand with + | Show -> show cfg + | Generate -> generate cfg + | Check -> check cfg in + match Lwt_main.run res with + | Ok () -> `Ok () + | Error err -> `Error (false, Format.asprintf "%a" pp_print_error err) + + let subcommand_arg = + let parser = function + | "show" -> `Ok Show + | "generate" -> `Ok Generate + | "check" -> `Ok Check + | s -> `Error ("invalid argument: " ^ s) + and printer fmt = function + | Show -> Format.fprintf fmt "show" + | Generate -> Format.fprintf fmt "generate" + | Check -> Format.fprintf fmt "check" in + let doc = + "Operation to perform. \ + Possible values: $(b,show), $(b,generate), $(b,check)." in + let open Cmdliner.Arg in + value & pos 0 (parser, printer) Show & info [] ~docv:"OPERATION" ~doc + + let expected_pow = + let open Cmdliner in + let doc = + "Expected amount of proof-of-work for the node identity. \ + The optional parameter should be a float between 0 and 256, where + 0 disable the proof-of-work mechanism." in + Arg.(value & pos 1 (some float) None & info [] ~docv:"DIFFICULTY" ~doc) + + let term = + Cmdliner.Term.(ret (const process + $ subcommand_arg + $ Node_shared_arg.Term.data_dir + $ Node_shared_arg.Term.config_file + $ expected_pow)) +end + +module Manpage = struct + + let command_description = + "The $(b,identity) command is meant to create and manage node \ + identities. An $(i,identity) uniquely identifies a peer on the \ + network and consists of a cryptographic key pair as well as a \ + proof-of-work stamp that certifies \ + that enough CPU time has been dedicated to produce the identity, \ + to avoid sybil attacks. An identity with enough proof-of-work is \ + required to participate in the Tezos network, therefore this command \ + is necessary to launch Tezos the first time." + + let description = [ + `S "DESCRIPTION" ; + `P (command_description ^ " Several options are possible:"); + `P "$(b,show) reads, parses and displays the current identity of the node. \ + Use this command to see what identity will be used by Tezos. \ + This is the default operation." ; + `P "$(b,generate [difficulty]) generates an identity whose \ + proof of work stamp difficulty is at least equal to $(i,difficulty). \ + The value provided must be a floating point number between 0 and 128. \ + It roughly reflects the numbers of expected leading zeroes in the hash \ + of the identity data-structure. \ + Therefore, a value of 0 means no proof-of-work, and the difficulty \ + doubles for each increment of 1 in the difficulty value." ; + `P "$(b,check [difficulty]) checks that an identity is valid and that its \ + proof of work stamp difficulty is at least equal to $(i,difficulty)." ; + ] + + let man = + description @ + (* [ `S misc_docs ] @ *) + Node_shared_arg.Manpage.bugs + + let info = + Cmdliner.Term.info + ~doc: "Manage node identities" + ~man + "identity" + +end + +let cmd = + Term.term, Manpage.info + diff --git a/src/node/main/node_identity_command.mli b/src/node/main/node_identity_command.mli new file mode 100644 index 000000000..6bf5ac519 --- /dev/null +++ b/src/node/main/node_identity_command.mli @@ -0,0 +1,14 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +val cmd: unit Cmdliner.Term.t * Cmdliner.Term.info + +module Manpage : sig + val command_description: string +end diff --git a/src/node/main/node_identity_file.ml b/src/node/main/node_identity_file.ml new file mode 100644 index 000000000..71e2c4572 --- /dev/null +++ b/src/node/main/node_identity_file.ml @@ -0,0 +1,86 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +let default_name = "identity.json" + +type error += No_identity_file of string +type error += Insufficient_proof_of_work of { expected: float } + +let () = + register_error_kind + `Permanent + ~id:"main.identity.no_file" + ~title:"TODO" + ~description:"TODO" + ~pp:(fun ppf file -> + Format.fprintf ppf + "Cannot read the identity file: `%s`. \ + See `%s identity --help` on how to generate an identity." + file Sys.argv.(0)) + Data_encoding.(obj1 (req "file" string)) + (function No_identity_file file -> Some file | _ -> None) + (fun file -> No_identity_file file) + +let () = + register_error_kind + `Permanent + ~id:"main.identity.insufficient_proof_of_work" + ~title:"TODO" + ~description:"TODO" + ~pp:(fun ppf expected -> + Format.fprintf ppf + "The current identity does not embed a sufficient stamp of proof-of-work. \ + (expected level: %.2f). \ + See `%s identity --help` on how to generate a new identity." + expected Sys.argv.(0)) + Data_encoding.(obj1 (req "expected" float)) + (function Insufficient_proof_of_work { expected } -> Some expected | _ -> None) + (fun expected -> Insufficient_proof_of_work { expected }) + +let read ?expected_pow file = + Lwt_unix.file_exists file >>= function + | false -> + fail (No_identity_file file) + | true -> + Data_encoding_ezjsonm.read_file file >>=? fun json -> + let id = Data_encoding.Json.destruct P2p.Identity.encoding json in + match expected_pow with + | None -> return id + | Some expected -> + let target = Crypto_box.make_target expected in + if (Crypto_box.check_proof_of_work + id.public_key id.proof_of_work_stamp target) then + return id + else + fail (Insufficient_proof_of_work { expected }) + +type error += Existent_identity_file of string + +let () = + register_error_kind + `Permanent + ~id:"main.identity.existent_file" + ~title:"TODO" + ~description:"TODO" + ~pp:(fun ppf file -> + Format.fprintf ppf + "Cannot implicitely overwrite the current identity file: '%s'. \ + See `%s identity --help` on how to generate a new identity." + file Sys.argv.(0)) + Data_encoding.(obj1 (req "file" string)) + (function Existent_identity_file file -> Some file | _ -> None) + (fun file -> Existent_identity_file file) + +let write file identity = + if Sys.file_exists file then + fail (Existent_identity_file file) + else + Lwt_utils.create_dir ~perm:0o700 (Filename.dirname file) >>= fun () -> + Data_encoding_ezjsonm.write_file file + (Data_encoding.Json.construct P2p.Identity.encoding identity) diff --git a/src/node/main/node_identity_file.mli b/src/node/main/node_identity_file.mli new file mode 100644 index 000000000..49bb7af46 --- /dev/null +++ b/src/node/main/node_identity_file.mli @@ -0,0 +1,21 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +val default_name: string + +type error += No_identity_file of string +type error += Insufficient_proof_of_work of { expected: float } + +val read: + ?expected_pow:float -> + string -> P2p.Identity.t tzresult Lwt.t + +type error += Existent_identity_file of string + +val write: string -> P2p.Identity.t -> unit tzresult Lwt.t diff --git a/src/node/main/node_run_command.ml b/src/node/main/node_run_command.ml new file mode 100644 index 000000000..4fe3723f7 --- /dev/null +++ b/src/node/main/node_run_command.ml @@ -0,0 +1,285 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +open Logging.Node.Main + +let genesis = { + Store.time = + Time.of_notation_exn "2016-11-01T00:00:00Z" ; + block = + Block_hash.of_b48check + "grHGHkVfgJb5gPaRd5AtQsa65g9GyLcXgQsHbSnQ5SD5DEp2ctqck" ; + protocol = + Protocol_hash.of_b48check + "4p64VagsbXchSF88eaPy5XrkqMLEjBCaSnaGv2vQkhv8e37Nnqmrd" ; +} + +let (//) = Filename.concat + +let store_dir data_dir = data_dir // "store" +let context_dir data_dir = data_dir // "context" +let protocol_dir data_dir = data_dir // "protocol" +let lock_file data_dir = data_dir // "lock" + +let test_protocol = None + +let init_logger ?verbosity (log_config : Node_config_file.log) = + let open Logging in + begin + match verbosity with + | Some level -> + Lwt_log_core.add_rule "*" level + | None -> + Lwt_log_core.add_rule "*" log_config.default_level ; + let rules = + match Sys.getenv "TEZOS_LOG" with + | rules -> Some rules + | exception Not_found -> + match Sys.getenv "LWT_LOG" with + | rules -> Some rules + | exception Not_found -> log_config.rules in + Utils.iter_option Lwt_log_core.load_rules rules + end ; + Logging.init ~template:log_config.template log_config.output + +let init_node ?sandbox (config : Node_config_file.t) = + let patch_context json ctxt = + let module Proto = (val Updater.get_exn genesis.protocol) in + Lwt_utils.protect begin fun () -> + Proto.configure_sandbox ctxt json + end >|= function + | Error err -> + warn + "@[Error while configuring ecoproto for the sandboxed mode:@ %a@]" + pp_print_error err ; + ctxt + | Ok ctxt -> ctxt in + begin + match sandbox with + | None -> Lwt.return_none + | Some sandbox_param -> + match sandbox_param with + | None -> Lwt.return (Some (patch_context None)) + | Some file -> + Data_encoding_ezjsonm.read_file file >>= function + | Error err -> + lwt_warn + "Can't parse sandbox parameters: %s" file >>= fun () -> + lwt_debug "%a" pp_print_error err >>= fun () -> + Lwt.return (Some (patch_context None)) + | Ok json -> + Lwt.return (Some (patch_context (Some json))) + end >>= fun patch_context -> + begin + match sandbox with + | Some _ -> return None + | None -> + Node_identity_file.read + (config.data_dir // + Node_identity_file.default_name) >>=? fun identity -> + lwt_log_notice + "Peer's global id: %a" + P2p.Gid.pp identity.gid >>= fun () -> + (* TODO "WARN" when pow is below our expectation. *) + begin + match config.net.listen_addr with + | None -> + lwt_log_notice "Not listening to RPC calls." >>= fun () -> + return (None, None) + | Some addr -> + Node_config_file.resolve_listening_addrs addr >>= function + | [] -> + failwith "Cannot resolve RPC listening address: %S" addr + | (addr, port) :: _ -> return (Some addr, Some port) + end >>=? fun (listening_addr, listening_port) -> + Node_config_file.resolve_bootstrap_addrs + config.net.bootstrap_peers >>= fun trusted_points -> + let p2p_config : P2p.config = + { listening_addr ; + listening_port ; + trusted_points ; + peers_file = + (config.data_dir // "peers.json") ; + closed_network = config.net.closed ; + identity ; + proof_of_work_target = + Crypto_box.make_target config.net.expected_pow ; + } + in + return (Some (p2p_config, config.net.limits)) + end >>=? fun p2p_config -> + let node_config : Node.config = { + genesis ; + test_protocol ; + patch_context ; + store_root = store_dir config.data_dir ; + context_root = context_dir config.data_dir ; + p2p = p2p_config ; + } in + Node.create node_config + +let () = + let old_hook = !Lwt.async_exception_hook in + Lwt.async_exception_hook := function + | Ssl.Read_error _ -> () + | exn -> old_hook exn + +let init_rpc (rpc_config: Node_config_file.rpc) node = + match rpc_config.listen_addr with + | None -> + lwt_log_notice "Not listening to RPC calls." >>= fun () -> + return None + | Some addr -> + Node_config_file.resolve_rpc_listening_addrs addr >>= function + | [] -> + failwith "Cannot resolve listening address: %S" addr + | (addr, port) :: _ -> + let host = Ipaddr.V6.to_string addr in + let dir = Node_rpc.build_rpc_directory node in + let mode = + match rpc_config.tls with + | None -> `TCP (`Port port) + | Some { cert ; key } -> + `TLS (`Crt_file_path cert, `Key_file_path key, + `No_password, `Port port) in + lwt_log_notice + "Starting the RPC server listening on port %d%s." + port + (if rpc_config.tls = None then "" else " (TLS enabled)") >>= fun () -> + RPC_server.launch ~host mode dir + rpc_config.cors_origins rpc_config.cors_headers >>= fun server -> + return (Some server) + +let init_signal () = + let handler id = try Lwt_exit.exit id with _ -> () in + ignore (Lwt_unix.on_signal Sys.sigint handler : Lwt_unix.signal_handler_id) + +let run ?verbosity ?sandbox (config : Node_config_file.t) = + Lwt_utils.create_dir config.data_dir >>= fun () -> + Lwt_utils.Lock_file.create + ~unlink_on_exit:true (lock_file config.data_dir) >>=? fun () -> + init_signal () ; + init_logger ?verbosity config.log >>= fun () -> + Updater.init (protocol_dir config.data_dir) ; + lwt_log_notice "Starting the Tezos node..." >>= fun () -> + init_node ?sandbox config >>=? fun node -> + init_rpc config.rpc node >>=? fun rpc -> + lwt_log_notice "The Tezos node is now running!" >>= fun () -> + Lwt_exit.termination_thread >>= fun x -> + lwt_log_notice "Shutting down the Tezos node..." >>= fun () -> + Node.shutdown node >>= fun () -> + lwt_log_notice "Shutting down the RPC server..." >>= fun () -> + Lwt_utils.may RPC_server.shutdown rpc >>= fun () -> + lwt_log_notice "BYE (%d)" x >>= fun () -> + return () + +let process sandbox verbosity args = + let verbosity = + match verbosity with + | [] -> None + | [_] -> Some Logging.Info + | _ -> Some Logging.Debug in + let run = + Node_shared_arg.read_and_patch_config_file args >>=? fun config -> + Lwt_utils.Lock_file.is_locked + (lock_file config.data_dir) >>=? function + | false -> + run ?sandbox ?verbosity config + | true -> failwith "Data directory is locked by another process" in + match Lwt_main.run run with + | Ok () -> `Ok () + | Error err -> `Error (false, Format.asprintf "%a" pp_print_error err) + +module Term = struct + + let verbosity = + let open Cmdliner in + let doc = + "Increase log level. Using $(b,-v) is equivalent to \ + using $(b,TEZOS_LOG='* -> info'), and $(b,-vv) is equivalent to using \ + $(b,TEZOS_LOG='* -> debug')." in + Arg.(value & flag_all & + info ~docs:Node_shared_arg.Manpage.misc_section ~doc ["v"]) + + let sandbox = + let open Cmdliner in + let doc = + "Run the daemon in sandbox mode. P2P is disabled, and constants of \ + the economical protocol can be altered with an optional JSON file. \ + $(b,IMPORTANT): Using sandbox mode affects the node state and \ + subsequent runs of Tezos node must also use sandbox mode. \ + In order to run the node in normal mode afterwards, a full reset \ + must be performed (by removing the node's data directory)." + in + Arg.(value & opt ~vopt:(Some None) (some (some string)) None & + info ~docs:Node_shared_arg.Manpage.misc_section + ~doc ~docv:"FILE.json" ["sandbox"]) + + let term = + Cmdliner.Term.(ret (const process $ sandbox $ verbosity $ + Node_shared_arg.Term.args)) + +end + +module Manpage = struct + + let command_description = + "The $(b,run) command is meant to run the Tezos node. \ + Most of its command line arguments corresponds to config file \ + entries, and will have priority over the latter if used." + + let description = [ + `S "DESCRIPTION" ; + `P command_description ; + ] + + let debug = + let log_sections = String.concat " " (List.rev !Logging.sections) in + [ + `S "DEBUG" ; + `P ("The environment variable $(b,TEZOS_LOG) is used to fine-tune \ + what is going to be logged. The syntax is \ + $(b,TEZOS_LOG='
 ->  [ ; ...]') \ + where section is one of $(i," + ^ log_sections ^ + ") and level is one of $(i,fatal), $(i,error), $(i,warn), \ + $(i,notice), $(i,info) or $(i,debug). \ + A $(b,*) can be used as a wildcard \ + in sections, i.e. $(b, client* -> debug). \ + The rules are matched left to right, \ + therefore the leftmost rule is the most prioritary one." + ) ; + ] + + let examples = + [ + `S "EXAMPLES" ; + `I ("$(b,Run in sandbox mode listening to RPC commands \ + at localhost port 8732)", + "$(mname) run --sandbox --base-dir /custom/data/dir \ + --rpc-addr localhost:8732" ) ; + `I ("$(b,Run a node that accepts network connections)", + "$(mname) run" ) ; + ] + + let man = + description @ + Node_shared_arg.Manpage.args @ + examples @ + Node_shared_arg.Manpage.bugs + + let info = + Cmdliner.Term.info + ~doc:"Run the Tezos node" + ~man + "run" + +end + +let cmd = Term.term, Manpage.info diff --git a/src/node/main/node_run_command.mli b/src/node/main/node_run_command.mli new file mode 100644 index 000000000..0a6d000a0 --- /dev/null +++ b/src/node/main/node_run_command.mli @@ -0,0 +1,15 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +val cmd: unit Cmdliner.Term.t * Cmdliner.Term.info + +module Manpage : sig + val command_description: string + val examples: Cmdliner.Manpage.block list +end diff --git a/src/node/main/node_shared_arg.ml b/src/node/main/node_shared_arg.ml new file mode 100644 index 000000000..b94de88da --- /dev/null +++ b/src/node/main/node_shared_arg.ml @@ -0,0 +1,250 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +open Cmdliner +open P2p_types + +let (//) = Filename.concat + +type t = { + data_dir: string option ; + config_file: string ; + min_connections: int option ; + expected_connections: int option ; + max_connections: int option ; + max_download_speed: int option ; + max_upload_speed: int option ; + expected_pow: float option ; + peers: string list ; + no_bootstrap_peers: bool ; + listen_addr: string option ; + rpc_listen_addr: string option ; + closed: bool ; + cors_origins: string list ; + cors_headers: string list ; + rpc_tls: Node_config_file.tls option ; + log_output: Logging.Output.t option ; +} + +let wrap + data_dir config_file + connections max_download_speed max_upload_speed + listen_addr peers no_bootstrap_peers closed expected_pow + rpc_listen_addr rpc_tls + cors_origins cors_headers log_output = + + let actual_data_dir = + Utils.unopt ~default:Node_config_file.default_data_dir data_dir in + + let config_file = + Utils.unopt ~default:(actual_data_dir // "config.json") config_file in + + let rpc_tls = + Utils.map_option + (fun (cert, key) -> { Node_config_file.cert ; key }) + rpc_tls in + + (* when `--expected-connections` is used, + override all the bounds defined in the configuration file. *) + let min_connections, expected_connections, max_connections = + match connections with + | None -> None, None, None + | Some x -> Some (x/2), Some x, Some (3*x/2) in + + { data_dir ; + config_file ; + min_connections ; + expected_connections ; + max_connections ; + max_download_speed ; + max_upload_speed ; + expected_pow ; + peers ; + no_bootstrap_peers ; + listen_addr ; + rpc_listen_addr ; + closed ; + cors_origins ; + cors_headers ; + rpc_tls ; + log_output ; + } + +module Manpage = struct + + let misc_section = "MISC OPTIONS" + let network_section = "NETWORK OPTIONS" + let rpc_section = "RPC OPTIONS" + + let args = [ + `S network_section ; + `S rpc_section ; + `S misc_section ; + ] + + let bugs = [ + `S "BUGS"; + `P "Check bug reports at https://github.com/tezos/tezos/issues."; + ] + +end + +module Term = struct + + let log_output_converter = + (fun s -> match Logging.Output.of_string s with + | Some res -> `Ok res + | None -> `Error s), + Logging.Output.pp + + (* misc args *) + + let docs = Manpage.misc_section + + let log_output = + let doc = + "Log output. Either $(i,stdout), $(i,stderr), \ + $(i,syslog:) or a file path." in + Arg.(value & opt (some log_output_converter) None & + info ~docs ~docv:"OUTPUT" ~doc ["log-output"]) + + let data_dir = + let doc = + "The directory where the Tezos node will store all its data." in + Arg.(value & opt (some string) None & + info ~docs ~doc ~docv:"DIR" ["data-dir"]) + + let config_file = + let doc = "The main configuration file." in + Arg.(value & opt (some string) None & + info ~docs ~doc ~docv:"FILE" ["config-file"]) + + (* net args *) + + let docs = Manpage.network_section + + let connections = + let doc = + "The number of running connections that we aim for." in + Arg.(value & opt (some int) None & + info ~docs ~doc ~docv:"NUM" ["connections"]) + + let max_download_speed = + let doc = + "The maximum number of bytes read per second." in + Arg.(value & opt (some int) None & + info ~docs ~doc ~docv:"NUM" ["max-download-speed"]) + + let max_upload_speed = + let doc = + "The maximum number of bytes sent per second." in + Arg.(value & opt (some int) None & + info ~docs ~doc ~docv:"NUM" ["max-upload-speed"]) + + let listen_addr = + let doc = + "The TCP address and port at which this instance can be reached." in + Arg.(value & opt (some string) None & + info ~docs ~doc ~docv:"ADDR:PORT" ["net-addr"]) + + let no_bootstrap_peers = + let doc = + "Ignore the peers foud in the config file (or the hardcoded \ + bootstrap peers in the absence of config file)." in + Arg.(value & flag & + info ~docs ~doc ["no-bootstrap-peers"]) + + let peers = + let doc = + "A peer to bootstrap the network from. \ + Can be used several times to add several peers." in + Arg.(value & opt_all string [] & + info ~docs ~doc ~docv:"ADDR:PORT" ["peer"]) + + let expected_pow = + let doc = + "Expected level of proof-of-work for peers identity." in + Arg.(value & opt (some float) None & + info ~docs ~doc ~docv:"FLOAT" ["expected-pow"]) + + let closed = + let doc = + "Only accept connections from the configured bootstrap peers." in + Arg.(value & flag & info ~docs ~doc ["closed"]) + + (* rpc args *) + let docs = Manpage.rpc_section + + let rpc_listen_addr = + let doc = + "The TCP socket address at which this RPC server \ + instance can be reached." in + Arg.(value & opt (some string) None & + info ~docs ~doc ~docv:"ADDR:PORT" ["rpc-addr"]) + + let rpc_tls = + let doc = + "Enable TLS for this RPC server \ + with the provided certificate and key." in + Arg.(value & opt (some (pair string string)) None & + info ~docs ~doc ~docv:"crt,key" ["rpc-tls"]) + + let cors_origins = + let doc = + "CORS origin allowed by the RPC server \ + via Access-Control-Allow-Origin; may be used multiple times" in + Arg.(value & opt_all string [] & + info ~docs ~doc ~docv:"ORIGIN" ["cors-origin"]) + + let cors_headers = + let doc = + "Header reported by Access-Control-Allow-Headers \ + reported during CORS preflighting; may be used multiple times" in + Arg.(value & opt_all string [] & + info ~docs ~doc ~docv:"HEADER" ["cors-header"]) + + let args = + let open Term in + const wrap $ data_dir $ config_file + $ connections + $ max_download_speed $ max_upload_speed + $ listen_addr $ peers $ no_bootstrap_peers $ closed $ expected_pow + $ rpc_listen_addr $ rpc_tls + $ cors_origins $ cors_headers + $ log_output + +end + +let read_and_patch_config_file args = + begin + if Sys.file_exists args.config_file then + Node_config_file.read args.config_file + else + return Node_config_file.default_config + end >>=? fun cfg -> + let { data_dir ; + min_connections ; expected_connections ; max_connections ; + max_download_speed ; max_upload_speed ; + expected_pow ; + peers ; no_bootstrap_peers ; + listen_addr ; closed ; + rpc_listen_addr ; rpc_tls ; + cors_origins ; cors_headers ; + log_output } = args in + let bootstrap_peers = + if no_bootstrap_peers then + peers + else + cfg.net.bootstrap_peers @ peers in + return @@ + Node_config_file.update + ?data_dir ?min_connections ?expected_connections ?max_connections + ?max_download_speed ?max_upload_speed ?expected_pow + ~bootstrap_peers ?listen_addr ?rpc_listen_addr + ~closed ~cors_origins ~cors_headers ?rpc_tls ?log_output cfg diff --git a/src/node/main/node_shared_arg.mli b/src/node/main/node_shared_arg.mli new file mode 100644 index 000000000..dee36d295 --- /dev/null +++ b/src/node/main/node_shared_arg.mli @@ -0,0 +1,44 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +open P2p_types + +type t = { + data_dir: string option ; + config_file: string ; + min_connections: int option ; + expected_connections: int option ; + max_connections: int option ; + max_download_speed: int option ; + max_upload_speed: int option ; + expected_pow: float option ; + peers: string list ; + no_bootstrap_peers: bool ; + listen_addr: string option ; + rpc_listen_addr: string option ; + closed: bool ; + cors_origins: string list ; + cors_headers: string list ; + rpc_tls: Node_config_file.tls option ; + log_output: Logging.Output.t option ; +} + +module Term : sig + val args: t Cmdliner.Term.t + val data_dir: string option Cmdliner.Term.t + val config_file: string option Cmdliner.Term.t +end + +val read_and_patch_config_file: t -> Node_config_file.t tzresult Lwt.t + +module Manpage : sig + val misc_section: string + val args: Cmdliner.Manpage.block list + val bugs: Cmdliner.Manpage.block list +end diff --git a/src/node/net/p2p.ml b/src/node/net/p2p.ml index 94be084e8..559eb6b9a 100644 --- a/src/node/net/p2p.ml +++ b/src/node/net/p2p.ml @@ -29,8 +29,8 @@ type 'msg message_config = 'msg P2p_connection_pool.message_config = { } type config = { - listening_port : port option ; - listening_addr : addr option ; + listening_port : port option; + listening_addr : addr option; trusted_points : Point.t list ; peers_file : string ; closed_network : bool ; @@ -62,10 +62,14 @@ type limits = { } let create_scheduler limits = + let max_upload_speed = + map_option limits.max_upload_speed ~f:(( * ) 1024) in + let max_download_speed = + map_option limits.max_upload_speed ~f:(( * ) 1024) in P2p_io_scheduler.create ~read_buffer_size:limits.read_buffer_size - ?max_upload_speed:limits.max_upload_speed - ?max_download_speed:limits.max_download_speed + ?max_upload_speed + ?max_download_speed ?read_queue_size:limits.read_queue_size ?write_queue_size:limits.write_queue_size () @@ -123,7 +127,8 @@ let may_create_welcome_worker config limits pool = | Some port -> P2p_welcome.run ~backlog:limits.backlog pool - ?addr:config.listening_addr port >>= fun w -> + ?addr:config.listening_addr + port >>= fun w -> Lwt.return (Some w) type ('msg, 'meta) connection = ('msg, 'meta) P2p_connection_pool.connection diff --git a/src/node/net/p2p.mli b/src/node/net/p2p.mli index b74f36fe1..d2cc1c64a 100644 --- a/src/node/net/p2p.mli +++ b/src/node/net/p2p.mli @@ -87,7 +87,7 @@ type limits = { (** Strict minimum number of connections (triggers an urgent maintenance) *) expected_connections : int ; - (** Targeted number of connections to reach when bootstraping / maitening *) + (** Targeted number of connections to reach when bootstraping / maintaining *) max_connections : int ; (** Maximum number of connections (exceeding peers are disconnected) *) @@ -96,7 +96,7 @@ type limits = { (** Argument of [Lwt_unix.accept].*) max_incoming_connections : int ; - (** Maximum not-yet-authentified incoming connections. *) + (** Maximum not-yet-authenticated incoming connections. *) max_download_speed : int option ; (** Hard-limit in the number of bytes received per second. *) diff --git a/src/node/net/p2p_types.ml b/src/node/net/p2p_types.ml index f8b8690fa..87f0619eb 100644 --- a/src/node/net/p2p_types.ml +++ b/src/node/net/p2p_types.ml @@ -83,7 +83,8 @@ type port = int module Point = struct module T = struct - (* A net point (address x port). *) + + (* A net point (address x port). *) type t = addr * port let compare (a1, p1) (a2, p2) = match Ipaddr.V6.compare a1 a2 with @@ -92,7 +93,11 @@ module Point = struct let equal p1 p2 = compare p1 p2 = 0 let hash = Hashtbl.hash let pp ppf (addr, port) = - Format.fprintf ppf "[%a]:%d" Ipaddr.V6.pp_hum addr port + match Ipaddr.v4_of_v6 addr with + | Some addr -> + Format.fprintf ppf "%a:%d" Ipaddr.V4.pp_hum addr port + | None -> + Format.fprintf ppf "[%a]:%d" Ipaddr.V6.pp_hum addr port let pp_opt ppf = function | None -> Format.pp_print_string ppf "none" | Some point -> pp ppf point @@ -100,16 +105,29 @@ module Point = struct let is_local (addr, _) = Ipaddr.V6.is_private addr let is_global (addr, _) = not @@ Ipaddr.V6.is_private addr - let to_sockaddr (addr, port) = Unix.(ADDR_INET (Ipaddr_unix.V6.to_inet_addr addr, port)) + let of_string str = + match String.rindex str ':' with + | exception Not_found -> `Error "not a valid node address (ip:port)" + | pos -> + let len = String.length str in + let addr, port = + String.sub str 0 pos, String.sub str (pos+1) (len - pos - 1) in + let addr = if addr = "" || addr = "_" then "[::]" else addr in + match Ipaddr.of_string_exn addr, int_of_string port with + | exception Failure _ -> `Error "not a valid node address (ip:port)" + | V4 ipv4, port -> `Ok (Ipaddr.v6_of_v4 ipv4, port) + | V6 ipv6, port -> `Ok (ipv6, port) + + let of_string_exn str = + match of_string str with + | `Ok saddr -> saddr + | `Error msg -> invalid_arg msg + + let to_string saddr = Format.asprintf "%a" pp saddr let encoding = - let open Data_encoding in - conv - (fun (addr, port) -> Ipaddr.V6.to_string addr, port) - (fun (addr, port) -> Ipaddr.V6.of_string_exn addr, port) - (obj2 - (req "addr" string) - (req "port" int16)) + Data_encoding.conv to_string of_string_exn Data_encoding.string + end include T @@ -127,6 +145,7 @@ end module Id_point = struct module T = struct + (* A net point (address x port). *) type t = addr * port option let empty = Ipaddr.V6.unspecified, None @@ -157,6 +176,7 @@ module Id_point = struct (obj2 (req "addr" string) (opt "port" int16)) + end include T diff --git a/src/node/net/p2p_types.mli b/src/node/net/p2p_types.mli index a09283a69..7f852f038 100644 --- a/src/node/net/p2p_types.mli +++ b/src/node/net/p2p_types.mli @@ -50,10 +50,10 @@ module Point : sig val compare : t -> t -> int val pp : Format.formatter -> t -> unit val pp_opt : Format.formatter -> t option -> unit + val of_string : string -> [> `Error of string | `Ok of addr * port ] val encoding : t Data_encoding.t val is_local : t -> bool val is_global : t -> bool - val to_sockaddr : t -> Unix.sockaddr module Map : Map.S with type key = t module Set : Set.S with type elt = t module Table : Hashtbl.S with type key = t diff --git a/src/node/net/p2p_welcome.ml b/src/node/net/p2p_welcome.ml index a30dadd29..67d01ada6 100644 --- a/src/node/net/p2p_welcome.ml +++ b/src/node/net/p2p_welcome.ml @@ -44,11 +44,12 @@ let create_listening_socket ~backlog ?(addr = Ipaddr.V6.unspecified) port = let main_socket = Lwt_unix.(socket PF_INET6 SOCK_STREAM 0) in Lwt_unix.(setsockopt main_socket SO_REUSEADDR true) ; Lwt_unix.Versioned.bind_2 - main_socket (Point.to_sockaddr (addr, port)) >>= fun () -> + main_socket + Unix.(ADDR_INET (Ipaddr_unix.V6.to_inet_addr addr, port)) >>= fun () -> Lwt_unix.listen main_socket backlog ; Lwt.return main_socket -let run ~backlog pool ?addr port = +let run ~backlog pool ?addr port = Lwt.catch begin fun () -> create_listening_socket ~backlog ?addr port >>= fun socket -> diff --git a/src/node/updater/updater.ml b/src/node/updater/updater.ml index 608019be4..4e9ce4ed0 100644 --- a/src/node/updater/updater.ml +++ b/src/node/updater/updater.ml @@ -124,14 +124,14 @@ let get hash = (** Compiler *) -let basedir = ref None -let get_basedir () = - match !basedir with +let datadir = ref None +let get_datadir () = + match !datadir with | None -> fatal_error "not initialized" | Some m -> m let init dir = - basedir := Some dir + datadir := Some dir type component = Tezos_compiler.Protocol.component = { name : string ; @@ -164,10 +164,10 @@ let extract dirname hash units = (List.map (fun {name} -> String.capitalize_ascii name) units) let do_compile hash units = - let basedir = get_basedir () in - let source_dir = basedir // Protocol_hash.to_short_b48check hash // "src" in - let log_file = basedir // Protocol_hash.to_short_b48check hash // "LOG" in - let plugin_file = basedir // Protocol_hash.to_short_b48check hash // + let datadir = get_datadir () in + let source_dir = datadir // Protocol_hash.to_short_b48check hash // "src" in + let log_file = datadir // Protocol_hash.to_short_b48check hash // "LOG" in + let plugin_file = datadir // Protocol_hash.to_short_b48check hash // Format.asprintf "protocol_%a.cmxs" Protocol_hash.pp hash in create_files source_dir units >>= fun _files -> diff --git a/src/node_main.ml b/src/node_main.ml index d8c4e64fc..81cc0e395 100644 --- a/src/node_main.ml +++ b/src/node_main.ml @@ -7,838 +7,37 @@ (* *) (**************************************************************************) -module V6 = Ipaddr.V6 - -open Hash -open Error_monad -open Logging.Node.Main - -let (//) = Filename.concat - -let home = - try Sys.getenv "HOME" - with Not_found -> "/root" - -let default_base_dir = home // ".tezos-node" - -let genesis_block = - Block_hash.of_b48check - "grHGHkVfgJb5gPaRd5AtQsa65g9GyLcXgQsHbSnQ5SD5DEp2ctqck" - -let genesis_protocol = - Protocol_hash.of_b48check - "4p64VagsbXchSF88eaPy5XrkqMLEjBCaSnaGv2vQkhv8e37Nnqmrd" - -let test_protocol = - Some (Protocol_hash.of_b48check - "2gagsSEvTKAHRjxAamgSdBNkv39VtNCqpaDXrrH4K8R4KQAAHrhe3") - -let genesis_time = - Time.of_notation_exn "2016-11-01T00:00:00Z" - -let genesis = { - Store.time = genesis_time ; - block = genesis_block ; - protocol = genesis_protocol ; -} - -module Sockaddr = struct - - type t = V6.t * int - - let of_string str = - match String.rindex str ':' with - | exception Not_found -> `Error "not a sockaddr" - | pos -> - let len = String.length str in - let addr, port = - String.sub str 0 pos, String.sub str (pos+1) (len - pos - 1) in - match Ipaddr.of_string_exn addr, int_of_string port with - | exception Failure _ -> `Error "not a sockaddr" - | V4 ipv4, port -> `Ok (Ipaddr.v6_of_v4 ipv4, port) - | V6 ipv6, port -> `Ok (ipv6, port) - - let of_string_exn str = - match of_string str with - | `Ok saddr -> saddr - | `Error msg -> invalid_arg msg - - let pp fmt (ip, port) = Format.fprintf fmt "%a:%d" V6.pp_hum ip port - let to_string saddr = Format.asprintf "%a" pp saddr - - let encoding = - Data_encoding.conv to_string of_string_exn Data_encoding.string - - let converter : t Cmdliner.Arg.converter = of_string, pp - -end - -module Cfg_file = struct - - open Data_encoding - - type t = { - db : db ; - net : net ; - rpc : rpc ; - log : log ; - } - - and db = { - store : string ; - context : string ; - protocol : string ; - } - - and net = { - identity : string ; - expected_pow : float ; - bootstrap_peers : Sockaddr.t list ; - peers_metadata : string ; - listen_addr : Sockaddr.t option ; - closed : bool ; - limits : P2p.limits ; - } - - and rpc = { - listen_addr : Sockaddr.t option ; - cors_origins : string list ; - cors_headers : string list ; - tls : tls option ; - } - - and tls = { - cert : string ; - key : string ; - } - - and log = { - output : Logging.kind ; - default_level : Logging.level ; - rules : string option ; - template : Logging.template ; - } - - let default_net_limits : P2p.limits = { - authentification_timeout = 5. ; - min_connections = 50 ; - expected_connections = 100 ; - max_connections = 200 ; - backlog = 20 ; - max_incoming_connections = 20 ; - max_download_speed = None ; - max_upload_speed = None ; - read_buffer_size = 1 lsl 14 ; - read_queue_size = None ; - write_queue_size = None ; - incoming_app_message_queue_size = None ; - incoming_message_queue_size = None ; - outgoing_message_queue_size = None ; - } - - let default_net base_dir = { - identity = base_dir // "identity.json" ; - expected_pow = 24. ; - bootstrap_peers = [] ; - peers_metadata = base_dir // "peers.json" ; - listen_addr = Some (V6.unspecified, 9732) ; - closed = false ; - limits = default_net_limits ; - } - - let default_rpc = { - listen_addr = None ; - cors_origins = [] ; - cors_headers = [] ; - tls = None ; - } - - let default_log = { - output = Stderr ; - default_level = Notice ; - rules = None ; - template = Logging.default_template ; - } - - let default_db base_dir = { - store = base_dir // "store" ; - context = base_dir // "context" ; - protocol = base_dir // "protocol" ; - } - - let default_config base_dir = { - db = default_db base_dir ; - net = default_net base_dir ; - rpc = default_rpc ; - log = default_log ; - } - - let db = - let default = default_db default_base_dir in - conv - (fun { store ; context ; protocol } -> - (store, context, protocol)) - (fun (store, context, protocol) -> - { store ; context ; protocol }) - (obj3 - (dft "store" string default.store) - (dft "context" string default.context) - (dft "protocol" string default.protocol)) - - let limit : P2p.limits Data_encoding.t = - conv - (fun { P2p.authentification_timeout ; - min_connections ; expected_connections ; max_connections ; - backlog ; max_incoming_connections ; - max_download_speed ; max_upload_speed ; - read_buffer_size ; read_queue_size ; write_queue_size ; - incoming_app_message_queue_size ; - incoming_message_queue_size ; outgoing_message_queue_size } -> - ( ( authentification_timeout, min_connections, expected_connections, - max_connections, backlog, max_incoming_connections, - max_download_speed, max_upload_speed) , - ( read_buffer_size, read_queue_size, write_queue_size, - incoming_app_message_queue_size, - incoming_message_queue_size, outgoing_message_queue_size ))) - (fun ( ( authentification_timeout, min_connections, expected_connections, - max_connections, backlog, max_incoming_connections, - max_download_speed, max_upload_speed) , - ( read_buffer_size, read_queue_size, write_queue_size, - incoming_app_message_queue_size, - incoming_message_queue_size, outgoing_message_queue_size ) ) -> - { authentification_timeout ; min_connections ; expected_connections ; - max_connections ; backlog ; max_incoming_connections ; - max_download_speed ; max_upload_speed ; - read_buffer_size ; read_queue_size ; write_queue_size ; - incoming_app_message_queue_size ; - incoming_message_queue_size ; outgoing_message_queue_size }) - (merge_objs - (obj8 - (dft "authentification_timeout" - float default_net_limits.authentification_timeout) - (dft "min_connections" int31 - default_net_limits.min_connections) - (dft "expected_connections" int31 - default_net_limits.expected_connections) - (dft "max_connections" int31 - default_net_limits.max_connections) - (dft "backlog" int31 - default_net_limits.backlog) - (dft "max_incoming_connections" int31 - default_net_limits.max_incoming_connections) - (opt "max_download_speed" int31) - (opt "max_upload_speed" int31)) - (obj6 - (dft "read_buffer_size" int31 - default_net_limits.read_buffer_size) - (opt "read_queue_size" int31) - (opt "write_queue_size" int31) - (opt "incoming_app_message_queue_size" int31) - (opt "incoming_message_queue_size" int31) - (opt "outgoing_message_queue_size" int31))) - - let net = - let default = default_net default_base_dir in - conv - (fun { identity ; expected_pow ; bootstrap_peers ; peers_metadata ; - listen_addr ; closed ; limits } -> - ( identity, expected_pow, bootstrap_peers, peers_metadata, - listen_addr, closed, limits )) - (fun ( identity, expected_pow, bootstrap_peers, peers_metadata, - listen_addr, closed, limits ) -> - { identity ; expected_pow ; bootstrap_peers ; peers_metadata ; - listen_addr ; closed ; limits }) - (obj7 - (dft "identity" string default.identity) - (dft "expected-proof-or-work" float default.expected_pow) - (dft "bootstrap_peers" - (list Sockaddr.encoding) default.bootstrap_peers) - (dft "peers-metadata" string default.peers_metadata) - (opt "listen-addr" Sockaddr.encoding) - (dft "closed" bool false) - (dft "limits" limit default_net_limits)) - - let rpc : rpc Data_encoding.t = - conv - (fun { cors_origins ; cors_headers ; listen_addr ; tls } -> - let cert, key = - match tls with - | None -> None, None - | Some { cert ; key } -> Some cert, Some key in - (listen_addr, cors_origins, cors_headers, cert, key )) - (fun (listen_addr, cors_origins, cors_headers, cert, key ) -> - let tls = - match cert, key with - | None, _ | _, None -> None - | Some cert, Some key -> Some { cert ; key } in - { listen_addr ; cors_origins ; cors_headers ; tls }) - (obj5 - (opt "listen-addr" Sockaddr.encoding) - (dft "cors-origin" (list string) default_rpc.cors_origins) - (dft "cors-headers" (list string) default_rpc.cors_headers) - (opt "crt" string) - (opt "key" string)) - - let log = - conv - (fun {output ; default_level ; rules ; template } -> - (output, default_level, rules, template)) - (fun (output, default_level, rules, template) -> - { output ; default_level ; rules ; template }) - (obj4 - (dft "output" Logging.kind_encoding default_log.output) - (dft "level" Logging.level_encoding default_log.default_level) - (opt "rules" string) - (dft "template" string default_log.template)) - - let encoding = - conv - (fun { db ; rpc ; net ; log } -> (db, rpc, net, log)) - (fun (db, rpc, net, log) -> { db ; rpc ; net ; log }) - (obj4 - (dft "db" db (default_db default_base_dir)) - (dft "rpc" rpc default_rpc) - (req "net" net) - (dft "log" log default_log)) - - let read fp = - Data_encoding_ezjsonm.read_file fp >>=? fun json -> - try return (Data_encoding.Json.destruct encoding json) - with exn -> fail (Exn exn) - - let write fp cfg = - Data_encoding_ezjsonm.write_file fp - (Data_encoding.Json.construct encoding cfg) - -end - -module Cmdline = struct - - type t = { - sandbox : string option option ; - verbosity : Logging.level option ; - generate_identity : bool ; - write_cfg : 'a 'b 'c 'd. (string * (string -> 'a, 'b, 'c, 'a) format4) option ; - } - - open Cmdliner - - (* cli args *) - let misc_sect = "MISC" - - let base_dir = - let doc = - "The directory where the Tezos node will store all its data." in - Arg.(value & opt (some string) None & - info ~docs:"CONFIG" ~doc ~docv:"DIR" ["base-dir"]) - - let config_file = - let doc = "The main configuration file." in - Arg.(value & opt (some string) None & - info ~docs:"CONFIG" ~doc ~docv:"FILE" ["config-file"]) - - let sandbox = - let doc = - "Run the daemon in a sandbox: P2P is disabled, and constants of \ - the economical protocol might be altered by the optionnal JSON file." - in - Arg.(value & opt ~vopt:(Some None) (some (some string)) None & - info ~docs:"NETWORK" ~doc ~docv:"FILE.json" ["sandbox"]) - - let verbosity = - let doc = - "Increase log level. \ - Use several times to increase log level, e.g. `-vv'." in - Arg.(value & flag_all & info ~docs:misc_sect ~doc ["v"]) - - let reset_config = - let doc = "Overwrite config file with factory defaults." in - Arg.(value & flag & info ~docs:"CONFIG" ~doc ["reset-config"]) - - let update_config = - let doc = "Update config file with values from the command line." in - Arg.(value & flag & info ~docs:"CONFIG" ~doc ["update-config"]) - - let generate_identity = - let doc = - "Generate a new cryptographic identity for the node. \ - It also generates the associated stamp of proof-of-work. \ - See `--expected-pow` for adjusting the required amount of \ - proof-of-work" in - Arg.(value & flag & info ~docs:"CONFIG" ~doc ["generate-identity"]) - - (* net args *) - let expected_connections = - let doc = - "The number of running connections that we must try to maintain - (approximativaly)." in - Arg.(value & opt (some int) None & - info ~docs:"NETWORK" ~doc ~docv:"NUM" ["expected-connections"]) - - let max_download_speed = - let doc = - "The maximum number of bytes read per second." in - Arg.(value & opt (some int) None & - info ~docs:"NETWORK" ~doc ~docv:"NUM" ["max-download-speed"]) - - let max_upload_speed = - let doc = - "The maximum number of bytes sent per second." in - Arg.(value & opt (some int) None & - info ~docs:"NETWORK" ~doc ~docv:"NUM" ["max-upload-speed"]) - - let listen_addr = - let doc = - "The TCP address and port at which this instance can be reached." in - Arg.(value & opt (some Sockaddr.converter) None & - info ~docs:"NETWORK" ~doc ~docv:"ADDR:PORT" ["net-addr"]) - - let peers = - let doc = - "A peer to bootstrap the network from. \ - Can be used several times to add several peers." in - Arg.(value & opt_all Sockaddr.converter [] & - info ~docs:"NETWORK" ~doc ~docv:"ADDR:PORT" ["peer"]) - - let expected_pow = - let doc = - "Expected level of proof-of-work for peers identity." in - Arg.(value & opt (some float) None & - info ~docs:"NETWORK" ~doc ~docv:"FLOAT" ["expected-pow"]) - - let closed = - let doc = - "Only accept connections from the configured bootstrap peers." in - Arg.(value & flag & info ~docs:"NETWORK" ~doc ["closed"]) - - (* rpc args *) - let rpc_listen_addr = - let doc = - "The TCP socket address at which this RPC server \ - instance can be reached." in - Arg.(value & opt (some Sockaddr.converter) None & - info ~docs:"RPC" ~doc ~docv:"ADDR:PORT" ["rpc-addr"]) - - let rpc_tls = - let doc = - "Enable TLS for this RPC server \ - with the provided certificate and key." in - Arg.(value & opt (some (pair string string)) None & - info ~docs:"RPC" ~doc ~docv:"crt,key" ["rpc-tls"]) - - let cors_origins = - let doc = - "CORS origin allowed by the RPC server \ - via Access-Control-Allow-Origin; may be used multiple times" in - Arg.(value & opt_all string [] & - info ~docs:"RPC" ~doc ~docv:"ORIGIN" ["cors-origin"]) - - let cors_headers = - let doc = - "Header reported by Access-Control-Allow-Headers \ - reported during CORS preflighting; may be used multiple times" in - Arg.(value & opt_all string [] & - info ~docs:"RPC" ~doc ~docv:"HEADER" ["cors-header"]) - - exception Fail of string - let fail fmt = - Format.kasprintf (fun msg -> Lwt.fail (Fail msg)) fmt - - let parse - base_dir config_file - sandbox verbosity - expected_connections - max_download_speed max_upload_speed - listen_addr bootstrap_peers closed expected_pow - rpc_listen_addr rpc_tls cors_origins cors_headers - reset_cfg update_cfg generate_identity = - - let actual_base_dir = - match base_dir with - | None -> default_base_dir - | Some dir -> dir in - - let config_file = - match config_file with - | None -> actual_base_dir // "config.json" - | Some file -> file in - - (* When --base-dir is provided, we ignore the `db`, `net.identity` - and `net.peers_metadata` of the configuration file. *) - let db = Utils.map_option Cfg_file.default_db base_dir in - let identity, peers_metadata = - let default_net = Utils.map_option Cfg_file.default_net base_dir in - Utils.map_option - ~f:(fun net -> net.Cfg_file.identity) default_net, - Utils.map_option - ~f:(fun net -> net.Cfg_file.peers_metadata) default_net in - - let read () = - if reset_cfg && update_cfg then - fail "The options --reset-config and --update-config \ - cannot be used together" - else if reset_cfg then - Lwt.return - (Cfg_file.default_config actual_base_dir, true) - else if update_cfg && not (Sys.file_exists config_file) then - fail "Cannot update a non-existant configuration file." - else if not (Sys.file_exists config_file) then - Lwt.return - (Cfg_file.default_config actual_base_dir, true) - else - Cfg_file.read config_file >>= function - | Error err -> - fail - "@[Corrupted configuration file, \ - fix it or use --reset-config.@ %a@]" - pp_print_error err - | Ok cfg -> Lwt.return (cfg, update_cfg) - in - - let verbosity = - match verbosity with - | [] -> None - | [_] -> Some Logging.Info - | _ -> Some Logging.Debug - in - - let rpc_tls = - Utils.map_option - (fun (cert, key) -> { Cfg_file.cert ; key }) - rpc_tls in - - let unopt_list ~default = function - | [] -> default - | l -> l in - - (* when `--expected-connections` is used, - override all the bounds defined in the configuration file. *) - let min_connections, expected_connections, max_connections = - match expected_connections with - | None -> None, None, None - | Some x -> Some (x/2), Some x, Some (3*x/2) in - - try - Lwt_main.run begin - Lwt_utils.create_dir ~perm:0o700 actual_base_dir >>= fun () -> - read () >>= fun (cfg, write_cfg) -> - let db = Utils.unopt ~default:cfg.db db in - let limits : P2p.limits = { - cfg.net.limits with - min_connections = - Utils.unopt - ~default:cfg.net.limits.min_connections - min_connections ; - expected_connections = - Utils.unopt - ~default:cfg.net.limits.expected_connections - expected_connections ; - max_connections = - Utils.unopt - ~default:cfg.net.limits.max_connections - max_connections ; - max_download_speed = - Utils.first_some - max_download_speed cfg.net.limits.max_download_speed ; - max_upload_speed = - Utils.first_some - max_upload_speed cfg.net.limits.max_upload_speed ; - } in - let net : Cfg_file.net = { - identity = - Utils.unopt ~default:cfg.net.identity identity ; - expected_pow = - Utils.unopt ~default:cfg.net.expected_pow expected_pow ; - bootstrap_peers = - unopt_list ~default:cfg.net.bootstrap_peers bootstrap_peers ; - peers_metadata = - Utils.unopt ~default:cfg.net.peers_metadata peers_metadata ; - listen_addr = - Utils.first_some listen_addr cfg.net.listen_addr ; - closed = cfg.net.closed || closed ; - limits ; - } - and rpc : Cfg_file.rpc = { - listen_addr = - Utils.first_some rpc_listen_addr cfg.rpc.listen_addr ; - cors_origins = - unopt_list ~default:cfg.rpc.cors_origins cors_origins ; - cors_headers = - unopt_list ~default:cfg.rpc.cors_headers cors_headers ; - tls = - Utils.first_some rpc_tls cfg.rpc.tls ; - } in - let cfg_file = { Cfg_file.db ; net ; rpc ; log = cfg.log } in - let write_cfg : (string * _ format6) option = - if not write_cfg then None - else if reset_cfg then - Some (config_file, "Reseting configuration file '%s'.") - else if update_cfg then - Some (config_file, "Updating configuration file '%s'.") - else - Some (config_file, "Writing initial configuration file '%s'.") - in - let cmdline = - { sandbox ; verbosity ; generate_identity ; write_cfg } in - Lwt.return (`Ok (cfg_file, cmdline)) - end - with Fail msg -> `Error (false, msg) - - let cmd = - let open Term in - ret (const parse $ base_dir $ config_file - $ sandbox $ verbosity - $ expected_connections - $ max_download_speed $ max_upload_speed - $ listen_addr $ peers $ closed $ expected_pow - $ rpc_listen_addr $ rpc_tls $ cors_origins $ cors_headers - $ reset_config $ update_config $ generate_identity - ), - let doc = "The Tezos daemon" in - let man = [ - `S "NETWORK"; - `S "RPC"; - `S "CONFIG"; - `S misc_sect; - `S "EXAMPLES" ; - `P "Use `$(mname) --sandbox \ - --base-dir /path/to/a/custom/data/dir \ - --rpc-addr :::8732' \ - to run a single instance in sandbox mode, \ - listening to RPC commands at localhost port 8732."; - `P "Use `$(mname)' for a node that accepts network connections."; - `S "BUGS"; `P "Check bug reports at https://github.com/tezos/tezos/issues."; - ] - in - info ~sdocs:misc_sect ~man ~doc "tezos-node" - - let parse () = Term.eval cmd - -end - -let init_logger ?verbosity (log_config : Cfg_file.log) = - let open Logging in - begin - match verbosity with - | Some level -> - Lwt_log_core.add_rule "*" level - | None -> - Lwt_log_core.add_rule "*" log_config.default_level ; - let rules = - match Sys.getenv "TEZOS_LOG" with - | rules -> Some rules - | exception Not_found -> - match Sys.getenv "LWT_LOG" with - | rules -> Some rules - | exception Not_found -> log_config.rules in - Utils.iter_option Lwt_log_core.load_rules rules - end ; - Logging.init ~template:log_config.template log_config.output - -type error += No_identity -type error += Existent_identity_file - -let read_identity target file = - Lwt_unix.file_exists file >>= function - | true -> - Data_encoding_ezjsonm.read_file file >>=? fun json -> - let id = Data_encoding.Json.destruct P2p.Identity.encoding json in - Lwt_utils.unless - (Crypto_box.check_proof_of_work - id.public_key id.proof_of_work_stamp target) - (fun () -> - lwt_warn "The amount of proof-of-work stamp in the node's identity \ - is below your own expectations.") >>= fun () -> - return id - | false -> - fail No_identity - -let init_node ?sandbox (config : Cfg_file.t) = - let patch_context json ctxt = - let module Proto = (val Updater.get_exn genesis_protocol) in - Lwt_utils.protect begin fun () -> - Proto.configure_sandbox ctxt json - end >|= function - | Error err -> - warn - "@[Error while configuring ecoproto for the sandboxed mode:@ %a@]" - pp_print_error err ; - ctxt - | Ok ctxt -> ctxt in - begin - match sandbox with - | None -> Lwt.return_none - | Some sandbox_param -> - match sandbox_param with - | None -> Lwt.return (Some (patch_context None)) - | Some file -> - Data_encoding_ezjsonm.read_file file >>= function - | Error err -> - lwt_warn - "Can't parse sandbox parameters: %s" file >>= fun () -> - lwt_debug "%a" pp_print_error err >>= fun () -> - Lwt.return (Some (patch_context None)) - | Ok json -> - Lwt.return (Some (patch_context (Some json))) - end >>= fun patch_context -> - begin - let open P2p in - match sandbox with - | Some _ -> return None - | None -> - let proof_of_work_target = - Crypto_box.make_target config.net.expected_pow in - read_identity - proof_of_work_target config.net.identity >>=? fun identity -> - lwt_log_notice "Peers' id: %a" P2p.Gid.pp identity.gid >>= fun () -> - let p2p_config : P2p.config = - { listening_port = Utils.map_option snd config.net.listen_addr ; - listening_addr = Utils.map_option fst config.net.listen_addr ; - trusted_points = config.net.bootstrap_peers ; - peers_file = config.net.peers_metadata ; - closed_network = config.net.closed ; - identity ; - proof_of_work_target ; - } - in - return (Some (p2p_config, config.net.limits)) - end >>=? fun p2p_config -> - let node_config : Node.config = { - genesis ; - test_protocol ; - patch_context ; - store_root = config.db.store ; - context_root = config.db.context ; - p2p = p2p_config ; - } in - Node.create node_config +let term = + let open Cmdliner.Term in + ret (const (`Help (`Pager, None))) + +let description = [ + `S "DESCRIPTION" ; + `P "Entry point for initializing, configuring and running a Tezos node." ; + `P Node_identity_command.Manpage.command_description ; + `P Node_run_command.Manpage.command_description ; + `P Node_config_command.Manpage.command_description ; +] + +let man = + description @ + Node_run_command.Manpage.examples + +let info = + Cmdliner.Term.info + ~doc:"The Tezos node" + ~man + "tezos-node" + +let commands = [ + Node_run_command.cmd ; + Node_config_command.cmd ; + Node_identity_command.cmd ; +] let () = - let old_hook = !Lwt.async_exception_hook in - Lwt.async_exception_hook := function - | Ssl.Read_error _ -> () - | exn -> old_hook exn - -let init_rpc (rpc_config: Cfg_file.rpc) node = - match rpc_config.listen_addr with - | None -> - lwt_log_notice "Not listening to RPC calls." >>= fun () -> - Lwt.return_none - | Some (addr, port) -> - let host = Ipaddr.V6.to_string addr in - let dir = Node_rpc.build_rpc_directory node in - let mode = - match rpc_config.tls with - | None -> `TCP (`Port port) - | Some { cert ; key } -> - `TLS (`Crt_file_path cert, `Key_file_path key, - `No_password, `Port port) in - lwt_log_notice - "Starting the RPC server listening on port %d%s." - port - (if rpc_config.tls = None then "" else " (TLS enabled)") >>= fun () -> - RPC_server.launch ~host mode dir - rpc_config.cors_origins rpc_config.cors_headers >>= fun server -> - Lwt.return (Some server) - - -let init_signal () = - let handler id = try Lwt_exit.exit id with _ -> () in - ignore (Lwt_unix.on_signal Sys.sigint handler : Lwt_unix.signal_handler_id) - -module Identity = struct - - let generate (command : Cmdline.t) (config : Cfg_file.t) = - let file = config.net.identity in - if not command.generate_identity then - return () - else if Sys.file_exists file then - fail Existent_identity_file - else - let target = Crypto_box.make_target config.net.expected_pow in - Format.eprintf "Generating a new identity... " ; - let identity = - P2p.Identity.generate_with_animation Format.err_formatter target in - Data_encoding_ezjsonm.write_file file - (Data_encoding.Json.construct P2p.Identity.encoding identity) - >>=? fun () -> - Format.eprintf - "Stored the new identity (%a) into '%s'@." - P2p.Gid.pp identity.gid file ; - return () - -end - -module Node = struct - - let may_write_config (command : Cmdline.t) (config : Cfg_file.t) = - match command.write_cfg with - | None -> return () - | Some (file, fmt) -> - Format.eprintf "%(%s%)@." fmt file ; - Cfg_file.write file config - - let run (command : Cmdline.t) (config : Cfg_file.t) = - may_write_config command config >>=? fun () -> - init_signal () ; - init_logger ?verbosity:command.verbosity config.log >>= fun () -> - Updater.init config.db.protocol ; - lwt_log_notice "Starting the Tezos node..." >>= fun () -> - init_node ?sandbox:command.sandbox config >>=? fun node -> - init_rpc config.rpc node >>= fun rpc -> - lwt_log_notice "The Tezos node is now running!" >>= fun () -> - Lwt_exit.termination_thread >>= fun x -> - lwt_log_notice "Shutting down the Tezos node..." >>= fun () -> - Node.shutdown node >>= fun () -> - lwt_log_notice "Shutting down the RPC server..." >>= fun () -> - Lwt_utils.may RPC_server.shutdown rpc >>= fun () -> - lwt_log_notice "BYE (%d)" x >>= fun () -> - return () - -end - -let main (command : Cmdline.t) (config : Cfg_file.t) = - Random.self_init () ; - Sodium.Random.stir () ; - Identity.generate command config >>=? fun () -> - Node.run command config - -let () = - match Cmdline.parse () with + match Cmdliner.Term.eval_choice (term, info) commands with | `Error _ -> exit 1 - | `Help -> exit 1 + | `Help -> exit 0 | `Version -> exit 1 - | `Ok (config, command) -> - Lwt_main.run begin - main command config >>= function - | Ok () -> Lwt.return_unit - | Error [No_identity] -> - Format.eprintf - "Cannot find the identity file '%s'!\n%a@." - config.net.identity - Utils.display_paragraph - (Format.sprintf - "In order to proceed, Tezos needs a cryptographic identity. \ - You may generate a new identity by running:\n\ - \n\ -    %s --generate-identity --expected-pow %.1f\n\ - where `%.1f` is the expected level of proof-of-work in \ - the stamp associated to the new identity. \ - For quick testing, you may use '--expected-pow 0'." - Sys.argv.(0) - config.net.expected_pow - config.net.expected_pow) ; - exit 2 - | Error [Existent_identity_file] -> - Format.eprintf - "Error: Cannot implicitely overwrite an existing identity.\n\ - \n\ - \ Please remove the old identity file '%s'.@." - config.net.identity ; - exit 2 - | Error err -> - lwt_log_error - "@[Unexpected error while initializing the node:@ %a@]@." - pp_print_error err >>= fun () -> - exit 1 - end + | `Ok () -> exit 0 diff --git a/src/utils/error_monad.ml b/src/utils/error_monad.ml index 95f4f4e27..7419790d3 100644 --- a/src/utils/error_monad.ml +++ b/src/utils/error_monad.ml @@ -295,9 +295,15 @@ module Make() = struct if cond then return () else f () let pp_print_error ppf errors = - Format.fprintf ppf "@[Error, dumping error stack:@,%a@]@." - (Format.pp_print_list pp) - (List.rev errors) + match errors with + | [] -> + Format.fprintf ppf "Unknown error@." + | [error] -> + Format.fprintf ppf "@[Error:@ %a@]@." pp error + | errors -> + Format.fprintf ppf "@[Error, dumping error stack:@,%a@]@." + (Format.pp_print_list pp) + (List.rev errors) type error += Unclassified of string diff --git a/src/utils/logging.ml b/src/utils/logging.ml index fe791833d..0eb2088b9 100644 --- a/src/utils/logging.ml +++ b/src/utils/logging.ml @@ -44,8 +44,11 @@ let ign_log_f (fun msg -> Lwt_log.ign_log ?exn ~section ?location ?logger ~level msg) format +let sections = ref [] + module Make(S : sig val name: string end) : LOG = struct + let () = sections := S.name :: !sections let section = Lwt_log.Section.make S.name let debug fmt = ign_log_f ~section ~level:Lwt_log.Debug fmt @@ -91,81 +94,96 @@ module Webclient = Make(struct let name = "webclient" end) type template = Lwt_log.template let default_template = "$(date) - $(section): $(message)" -type kind = - | Null - | Stdout - | Stderr - | File of string - | Syslog of Lwt_log.syslog_facility +module Output = struct + type t = + | Null + | Stdout + | Stderr + | File of string + | Syslog of Lwt_log.syslog_facility -let kind_encoding = - let open Data_encoding in - conv - (function - | Null -> "/dev/null" - | Stdout -> "stdout" - | Stderr -> "stderr" - | File fp -> fp - | Syslog `Auth -> "syslog:auth" - | Syslog `Authpriv -> "syslog:authpriv" - | Syslog `Cron -> "syslog:cron" - | Syslog `Daemon -> "syslog:daemon" - | Syslog `FTP -> "syslog:ftp" - | Syslog `Kernel -> "syslog:kernel" - | Syslog `Local0 -> "syslog:local0" - | Syslog `Local1 -> "syslog:local1" - | Syslog `Local2 -> "syslog:local2" - | Syslog `Local3 -> "syslog:local3" - | Syslog `Local4 -> "syslog:local4" - | Syslog `Local5 -> "syslog:local5" - | Syslog `Local6 -> "syslog:local6" - | Syslog `Local7 -> "syslog:local7" - | Syslog `LPR -> "syslog:lpr" - | Syslog `Mail -> "syslog:mail" - | Syslog `News -> "syslog:news" - | Syslog `Syslog -> "syslog:syslog" - | Syslog `User -> "syslog:user" - | Syslog `UUCP -> "syslog:uucp" - | Syslog `NTP -> "syslog:ntp" - | Syslog `Security -> "syslog:security" - | Syslog `Console -> "syslog:console") - (function - | "/dev/null" | "null" -> Null - | "stdout" -> Stdout - | "stderr" -> Stderr - | "syslog:auth" -> Syslog `Auth - | "syslog:authpriv" -> Syslog `Authpriv - | "syslog:cron" -> Syslog `Cron - | "syslog:daemon" -> Syslog `Daemon - | "syslog:ftp" -> Syslog `FTP - | "syslog:kernel" -> Syslog `Kernel - | "syslog:local0" -> Syslog `Local0 - | "syslog:local1" -> Syslog `Local1 - | "syslog:local2" -> Syslog `Local2 - | "syslog:local3" -> Syslog `Local3 - | "syslog:local4" -> Syslog `Local4 - | "syslog:local5" -> Syslog `Local5 - | "syslog:local6" -> Syslog `Local6 - | "syslog:local7" -> Syslog `Local7 - | "syslog:lpr" -> Syslog `LPR - | "syslog:mail" -> Syslog `Mail - | "syslog:news" -> Syslog `News - | "syslog:syslog" -> Syslog `Syslog - | "syslog:user" -> Syslog `User - | "syslog:uucp" -> Syslog `UUCP - | "syslog:ntp" -> Syslog `NTP - | "syslog:security" -> Syslog `Security - | "syslog:console" -> Syslog `Console - (* | s when start_with "syslog:" FIXME error or warning. *) - | fp -> - (* TODO check absolute path *) - File fp) - string + let encoding = + let open Data_encoding in + conv + (function + | Null -> "/dev/null" + | Stdout -> "stdout" + | Stderr -> "stderr" + | File fp -> fp + | Syslog `Auth -> "syslog:auth" + | Syslog `Authpriv -> "syslog:authpriv" + | Syslog `Cron -> "syslog:cron" + | Syslog `Daemon -> "syslog:daemon" + | Syslog `FTP -> "syslog:ftp" + | Syslog `Kernel -> "syslog:kernel" + | Syslog `Local0 -> "syslog:local0" + | Syslog `Local1 -> "syslog:local1" + | Syslog `Local2 -> "syslog:local2" + | Syslog `Local3 -> "syslog:local3" + | Syslog `Local4 -> "syslog:local4" + | Syslog `Local5 -> "syslog:local5" + | Syslog `Local6 -> "syslog:local6" + | Syslog `Local7 -> "syslog:local7" + | Syslog `LPR -> "syslog:lpr" + | Syslog `Mail -> "syslog:mail" + | Syslog `News -> "syslog:news" + | Syslog `Syslog -> "syslog:syslog" + | Syslog `User -> "syslog:user" + | Syslog `UUCP -> "syslog:uucp" + | Syslog `NTP -> "syslog:ntp" + | Syslog `Security -> "syslog:security" + | Syslog `Console -> "syslog:console") + (function + | "/dev/null" | "null" -> Null + | "stdout" -> Stdout + | "stderr" -> Stderr + | "syslog:auth" -> Syslog `Auth + | "syslog:authpriv" -> Syslog `Authpriv + | "syslog:cron" -> Syslog `Cron + | "syslog:daemon" -> Syslog `Daemon + | "syslog:ftp" -> Syslog `FTP + | "syslog:kernel" -> Syslog `Kernel + | "syslog:local0" -> Syslog `Local0 + | "syslog:local1" -> Syslog `Local1 + | "syslog:local2" -> Syslog `Local2 + | "syslog:local3" -> Syslog `Local3 + | "syslog:local4" -> Syslog `Local4 + | "syslog:local5" -> Syslog `Local5 + | "syslog:local6" -> Syslog `Local6 + | "syslog:local7" -> Syslog `Local7 + | "syslog:lpr" -> Syslog `LPR + | "syslog:mail" -> Syslog `Mail + | "syslog:news" -> Syslog `News + | "syslog:syslog" -> Syslog `Syslog + | "syslog:user" -> Syslog `User + | "syslog:uucp" -> Syslog `UUCP + | "syslog:ntp" -> Syslog `NTP + | "syslog:security" -> Syslog `Security + | "syslog:console" -> Syslog `Console + (* | s when start_with "syslog:" FIXME error or warning. *) + | fp -> + (* TODO check absolute path *) + File fp) + string + let of_string str = + try + Some (Data_encoding.Json.destruct encoding (`String str)) + with _ -> None -let init ?(template = default_template) kind = + let to_string output = + match Data_encoding.Json.construct encoding output with + | `String res -> res + | #Data_encoding.json -> assert false + + let pp fmt output = + Format.fprintf fmt "%s" (to_string output) +end + +let init ?(template = default_template) output = + let open Output in begin - match kind with + match output with | Stderr -> Lwt.return @@ Lwt_log.channel ~template ~close_mode:`Keep ~channel:Lwt_io.stderr () diff --git a/src/utils/logging.mli b/src/utils/logging.mli index c366f11b9..3f5a008eb 100644 --- a/src/utils/logging.mli +++ b/src/utils/logging.mli @@ -69,13 +69,21 @@ val default_template : template val level_encoding : level Data_encoding.t -type kind = - | Null - | Stdout - | Stderr - | File of string - | Syslog of Lwt_log.syslog_facility +module Output : sig + type t = + | Null + | Stdout + | Stderr + | File of string + | Syslog of Lwt_log.syslog_facility -val kind_encoding : kind Data_encoding.t + val encoding : t Data_encoding.t + val of_string : string -> t option + val to_string : t -> string + val pp : Format.formatter -> t -> unit +end -val init: ?template:template -> kind -> unit Lwt.t + +val init: ?template:template -> Output.t -> unit Lwt.t + +val sections : string list ref diff --git a/src/utils/lwt_utils.ml b/src/utils/lwt_utils.ml index ceb472d13..606c825b6 100644 --- a/src/utils/lwt_utils.ml +++ b/src/utils/lwt_utils.ml @@ -407,3 +407,70 @@ let with_timeout ?(canceler = Canceler.create ()) timeout f = let unless cond f = if cond then Lwt.return () else f () +module Lock_file = struct + let create_inner + lock_command + ?(close_on_exec=true) + ?(unlink_on_exit=false) fn = + protect begin fun () -> + Lwt_unix.openfile fn Unix.[O_CREAT ; O_WRONLY; O_TRUNC] 0o644 >>= fun fd -> + if close_on_exec then Lwt_unix.set_close_on_exec fd ; + Lwt_unix.lockf fd lock_command 0 >>= fun () -> + if unlink_on_exit then + Lwt_main.at_exit (fun () -> Lwt_unix.unlink fn) ; + let pid_str = string_of_int @@ Unix.getpid () in + Lwt_unix.write_string fd pid_str 0 (String.length pid_str) >>= fun _ -> + return () + end + + let create = create_inner Unix.F_TLOCK + + let blocking_create + ?timeout + ?(close_on_exec=true) + ?(unlink_on_exit=false) fn = + let create () = + create_inner Unix.F_LOCK ~close_on_exec ~unlink_on_exit fn in + match timeout with + | None -> create () + | Some duration -> with_timeout duration (fun _ -> create ()) + + let is_locked fn = + if not @@ Sys.file_exists fn then return false else + protect begin fun () -> + Lwt_unix.openfile fn [Unix.O_RDONLY] 0o644 >>= fun fd -> + Lwt.finalize (fun () -> + Lwt.try_bind + (fun () -> Lwt_unix.(lockf fd F_TEST 0)) + (fun () -> return false) + (fun _ -> return true)) + (fun () -> Lwt_unix.close fd) + end + + let get_pid fn = + let open Lwt_io in + protect begin fun () -> + with_file ~mode:Input fn begin fun ic -> + read ic >>= fun content -> + return (int_of_string content) + end + end +end + +let of_sockaddr = function + | Unix.ADDR_UNIX _ -> None + | Unix.ADDR_INET (addr, port) -> + match Ipaddr_unix.of_inet_addr addr with + | V4 addr -> Some (Ipaddr.v6_of_v4 addr, port) + | V6 addr -> Some (addr, port) + +let getaddrinfo ~passive ~node ~service = + let open Lwt_unix in + getaddrinfo node service + ( AI_SOCKTYPE SOCK_STREAM :: + (if passive then [AI_PASSIVE] else []) ) >>= fun addr -> + let points = + Utils.filter_map + (fun { ai_addr } -> of_sockaddr ai_addr) + addr in + Lwt.return points diff --git a/src/utils/lwt_utils.mli b/src/utils/lwt_utils.mli index 14f48cf90..b924ef723 100644 --- a/src/utils/lwt_utils.mli +++ b/src/utils/lwt_utils.mli @@ -69,3 +69,23 @@ val with_timeout: val unless: bool -> (unit -> unit Lwt.t) -> unit Lwt.t +module Lock_file : sig + val create : + ?close_on_exec:bool -> + ?unlink_on_exit:bool -> + string -> unit tzresult Lwt.t + + val blocking_create : + ?timeout:float -> + ?close_on_exec:bool -> + ?unlink_on_exit:bool -> + string -> unit tzresult Lwt.t + + val is_locked : string -> bool tzresult Lwt.t + val get_pid : string -> int tzresult Lwt.t +end + +val getaddrinfo: + passive:bool -> + node:string -> service:string -> + (Ipaddr.V6.t * int) list Lwt.t diff --git a/test/launch.sh b/test/launch.sh index 92f1b9520..698af4b94 100755 --- a/test/launch.sh +++ b/test/launch.sh @@ -2,7 +2,7 @@ COMMAND='gnome-terminal' COUNT=2 for i in $(seq 1 $COUNT) do - SUBCOMMAND="./tezos-node --net-addr :::$((9900 + i)) --local-discovery :::7732 --rpc-addr :::$((8800 + i)) --expected-connections $(($COUNT - 1)) --base-dir /tmp/tezos_$i" + SUBCOMMAND="./tezos-node --net-addr :::$((9900 + i)) --local-discovery :::7732 --rpc-addr :::$((8800 + i)) --expected-connections $(($COUNT - 1)) --data-dir /tmp/tezos_$i" COMMAND="$COMMAND --tab -e '$SUBCOMMAND'" done echo $COMMAND diff --git a/test/test-basic.sh b/test/test-basic.sh index 912a5930c..7603420a2 100755 --- a/test/test-basic.sh +++ b/test/test-basic.sh @@ -18,7 +18,7 @@ NODE=../tezos-node CLIENT="../tezos-client -base-dir ${CLIENT_DIR}" CUSTOM_PARAM="--sandbox ./sandbox.json" -${NODE} --base-dir "${DATA_DIR}" ${CUSTOM_PARAM} --rpc-addr :::8732 > LOG 2>&1 & +${NODE} run --data-dir "${DATA_DIR}" ${CUSTOM_PARAM} --rpc-addr "[::]:8732" > LOG 2>&1 & NODE_PID="$!" sleep 3 diff --git a/test/test_basic.ml b/test/test_basic.ml index e4d5895ba..c5f47f110 100644 --- a/test/test_basic.ml +++ b/test/test_basic.ml @@ -50,9 +50,10 @@ let fork_node () = Unix.create_process Filename.(concat (dirname (Sys.getcwd ())) "tezos-node") [| "tezos-node" ; - "--base-dir"; data_dir ; + "run" ; + "--data-dir"; data_dir ; "--sandbox"; "./sandbox.json"; - "--rpc-addr"; ":::8732" |] + "--rpc-addr"; "[::]:8732" |] null_fd log_fd log_fd in Printf.printf "Created node, pid: %d, log: %s\n%!" pid log_file_name ; at_exit