balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Shell: Improve the CLI of tezos-node

Browse Source 
* 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`
This commit is contained in:
Vincent Bernardoff 2017-01-30 19:10:16 +01:00 committed by Grégoire Henry
parent dc7c692f87
commit 6d41b3d38c
32 changed files with 2019 additions and 960 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

173
README.md
View File

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

2
src/.merlin
View File

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

18
src/Makefile
View File

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

51
src/minutils/utils.ml
View File

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

5
src/minutils/utils.mli
View File

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

140
src/node/main/node_config_command.ml Normal file
View File

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

14
src/node/main/node_config_command.mli Normal file
View File

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

398
src/node/main/node_config_file.ml Normal file
View File

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

78
src/node/main/node_config_file.mli Normal file
View File

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

150
src/node/main/node_identity_command.ml Normal file
View File

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

14
src/node/main/node_identity_command.mli Normal file
View File

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

86
src/node/main/node_identity_file.ml Normal file
View File

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

21
src/node/main/node_identity_file.mli Normal file
View File

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

285
src/node/main/node_run_command.ml Normal file
View File

@ -0,0 +1,285 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2016. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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='<section> -> <level> [ ; ...]') \
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

15
src/node/main/node_run_command.mli Normal file
View File

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

250
src/node/main/node_shared_arg.ml Normal file
View File

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

44
src/node/main/node_shared_arg.mli Normal file
View File

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

15
src/node/net/p2p.ml
View File

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

4
src/node/net/p2p.mli
View File

@ -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. *)

40
src/node/net/p2p_types.ml
View File

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

2
src/node/net/p2p_types.mli
View File

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

5
src/node/net/p2p_welcome.ml
View File

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

16
src/node/updater/updater.ml
View File

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

861
src/node_main.ml
View File

@ -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
"@[<v 2>Unexpected error while initializing the node:@ %a@]@."
pp_print_error err >>= fun () ->
exit 1
end
| `Ok () -> exit 0

12
src/utils/error_monad.ml
View File

@ -295,9 +295,15 @@ module Make() = struct
if cond then return () else f ()
let pp_print_error ppf errors =
Format.fprintf ppf "@[<v 2>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 "@[<v 2>Error:@ %a@]@." pp error
| errors ->
Format.fprintf ppf "@[<v 2>Error, dumping error stack:@,%a@]@."
(Format.pp_print_list pp)
(List.rev errors)
type error += Unclassified of string

160
src/utils/logging.ml
View File

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

24
src/utils/logging.mli
View File

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

67
src/utils/lwt_utils.ml
View File

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

20
src/utils/lwt_utils.mli
View File

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

2
test/launch.sh
View File

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

2
test/test-basic.sh
View File

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

5
test/test_basic.ml
View File

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