From ce986c4a9ccff62d80b0fa641415ef3ce3450cd8 Mon Sep 17 00:00:00 2001 From: Vincent Bernardoff Date: Fri, 20 Jan 2017 15:25:12 +0100 Subject: [PATCH 01/16] Shell: sign Ack message --- src/node/net/p2p_connection.ml | 134 +++++++++++++++++---------------- test/test_p2p_connection.ml | 10 ++- 2 files changed, 76 insertions(+), 68 deletions(-) diff --git a/src/node/net/p2p_connection.ml b/src/node/net/p2p_connection.ml index 07fbc762a..68674a835 100644 --- a/src/node/net/p2p_connection.ml +++ b/src/node/net/p2p_connection.ml @@ -33,16 +33,51 @@ type error += Decoding_error type error += Myself of Id_point.t type error += Not_enough_proof_of_work of Gid.t -type cryptobox_data = { - channel_key : Crypto_box.channel_key ; - mutable local_nonce : Crypto_box.nonce ; - mutable remote_nonce : Crypto_box.nonce ; -} +module Crypto = struct -let header_length = 2 -let crypto_overhead = 18 (* FIXME import from Sodium.Box. *) -let max_content_length = - 1 lsl (header_length * 8) - crypto_overhead + let header_length = 2 + let crypto_overhead = 18 (* FIXME import from Sodium.Box. *) + let max_content_length = + 1 lsl (header_length * 8) - crypto_overhead + + type data = { + channel_key : Crypto_box.channel_key ; + mutable local_nonce : Crypto_box.nonce ; + mutable remote_nonce : Crypto_box.nonce ; + } + + let write_chunk fd cryptobox_data buf = + let header_buf = MBytes.create header_length in + let local_nonce = cryptobox_data.local_nonce in + cryptobox_data.local_nonce <- Crypto_box.increment_nonce local_nonce ; + let encrypted_message = + Crypto_box.fast_box cryptobox_data.channel_key buf local_nonce in + let encrypted_len = MBytes.length encrypted_message in + fail_unless + (encrypted_len < max_content_length) + Invalid_message_size >>=? fun () -> + MBytes.set_int16 header_buf 0 encrypted_len ; + P2p_io_scheduler.write fd header_buf >>=? fun () -> + P2p_io_scheduler.write fd encrypted_message >>=? fun () -> + return () + + let read_chunk fd cryptobox_data = + let header_buf = MBytes.create header_length in + P2p_io_scheduler.read_full ~len:header_length fd header_buf >>=? fun () -> + let len = MBytes.get_uint16 header_buf 0 in + let buf = MBytes.create len in + P2p_io_scheduler.read_full ~len fd buf >>=? fun () -> + let remote_nonce = cryptobox_data.remote_nonce in + cryptobox_data.remote_nonce <- Crypto_box.increment_nonce remote_nonce ; + match + Crypto_box.fast_box_open cryptobox_data.channel_key buf remote_nonce + with + | None -> + fail Decipher_error + | Some buf -> + return buf + +end module Connection_message = struct @@ -78,11 +113,12 @@ module Connection_message = struct let encoded_message_len = Data_encoding.Binary.length encoding message in fail_unless - (encoded_message_len < max_content_length) + (encoded_message_len < Crypto.max_content_length) Encoding_error >>=? fun () -> - let len = header_length + encoded_message_len in + let len = Crypto.header_length + encoded_message_len in let buf = MBytes.create len in - match Data_encoding.Binary.write encoding message buf header_length with + match Data_encoding.Binary.write + encoding message buf Crypto.header_length with | None -> fail Encoding_error | Some last -> @@ -91,8 +127,9 @@ module Connection_message = struct P2p_io_scheduler.write fd buf let read fd = - let header_buf = MBytes.create header_length in - P2p_io_scheduler.read_full ~len:header_length fd header_buf >>=? fun () -> + let header_buf = MBytes.create Crypto.header_length in + P2p_io_scheduler.read_full + ~len:Crypto.header_length fd header_buf >>=? fun () -> let len = MBytes.get_uint16 header_buf 0 in let buf = MBytes.create len in P2p_io_scheduler.read_full ~len fd buf >>=? fun () -> @@ -109,29 +146,25 @@ end module Ack = struct - type t = bool + type t = Ack | Nack let ack = MBytes.of_string "\255" let nack = MBytes.of_string "\000" - let write fd b = - match b with - | true -> - P2p_io_scheduler.write fd ack - | false -> - P2p_io_scheduler.write fd nack + let write cryptobox_data fd b = + Crypto.write_chunk cryptobox_data fd + (match b with Ack -> ack | Nack -> nack) - let read fd = - let buf = MBytes.create 1 in - P2p_io_scheduler.read_full fd buf >>=? fun () -> + let read fd cryptobox_data = + Crypto.read_chunk fd cryptobox_data >>=? fun buf -> return (buf <> nack) end type authenticated_fd = - P2p_io_scheduler.connection * Connection_info.t * cryptobox_data + P2p_io_scheduler.connection * Connection_info.t * Crypto.data -let kick (fd, _ , _) = - Ack.write fd false >>= fun _ -> +let kick (fd, _ , cryptobox_data) = + Ack.write fd cryptobox_data Nack >>= fun _ -> P2p_io_scheduler.close fd >>= fun _ -> Lwt.return_unit @@ -168,14 +201,14 @@ let authenticate { Connection_info.gid = remote_gid ; versions = msg.versions ; incoming ; id_point ; remote_socket_port ;} in let cryptobox_data = - { channel_key ; local_nonce ; + { Crypto.channel_key ; local_nonce ; remote_nonce = msg.message_nonce } in return (info, (fd, info, cryptobox_data)) type connection = { info : Connection_info.t ; fd : P2p_io_scheduler.connection ; - cryptobox_data : cryptobox_data ; + cryptobox_data : Crypto.data ; } module Reader = struct @@ -188,29 +221,13 @@ module Reader = struct mutable worker: unit Lwt.t ; } - let read_chunk { fd ; cryptobox_data } = - let header_buf = MBytes.create header_length in - P2p_io_scheduler.read_full ~len:header_length fd header_buf >>=? fun () -> - let len = MBytes.get_uint16 header_buf 0 in - let buf = MBytes.create len in - P2p_io_scheduler.read_full ~len fd buf >>=? fun () -> - let remote_nonce = cryptobox_data.remote_nonce in - cryptobox_data.remote_nonce <- Crypto_box.increment_nonce remote_nonce ; - match - Crypto_box.fast_box_open cryptobox_data.channel_key buf remote_nonce - with - | None -> - fail Decipher_error - | Some buf -> - return buf - let rec read_message st buf = return (Data_encoding.Binary.of_bytes st.encoding buf) let rec worker_loop st = Lwt_unix.yield () >>= fun () -> Lwt_utils.protect ~canceler:st.canceler begin fun () -> - read_chunk st.conn >>=? fun buf -> + Crypto.read_chunk st.conn.fd st.conn.cryptobox_data >>=? fun buf -> read_message st buf end >>= function | Ok None -> @@ -258,21 +275,6 @@ module Writer = struct mutable worker: unit Lwt.t ; } - let write_chunk { cryptobox_data ; fd } buf = - let header_buf = MBytes.create header_length in - let local_nonce = cryptobox_data.local_nonce in - cryptobox_data.local_nonce <- Crypto_box.increment_nonce local_nonce ; - let encrypted_message = - Crypto_box.fast_box cryptobox_data.channel_key buf local_nonce in - let encrypted_len = MBytes.length encrypted_message in - fail_unless - (encrypted_len < max_content_length) - Invalid_message_size >>=? fun () -> - MBytes.set_int16 header_buf 0 encrypted_len ; - P2p_io_scheduler.write fd header_buf >>=? fun () -> - P2p_io_scheduler.write fd encrypted_message >>=? fun () -> - return () - let encode_message st msg = try return (Data_encoding.Binary.to_bytes st.encoding msg) with _ -> fail Encoding_error @@ -282,7 +284,7 @@ module Writer = struct Lwt_utils.protect ~canceler:st.canceler begin fun () -> Lwt_pipe.pop st.messages >>= fun (msg, wakener) -> encode_message st msg >>=? fun buf -> - write_chunk st.conn buf >>= fun res -> + Crypto.write_chunk st.conn.fd st.conn.cryptobox_data buf >>= fun res -> iter_option wakener ~f:(fun u -> Lwt.wakeup_later u res) ; Lwt.return res end >>= function @@ -332,11 +334,11 @@ let accept ?incoming_message_queue_size ?outgoing_message_queue_size (fd, info, cryptobox_data) encoding = Lwt_utils.protect begin fun () -> - Ack.write fd true >>=? fun () -> - Ack.read fd - end ~on_error:begin fun err -> + Ack.write fd cryptobox_data Ack >>=? fun () -> + Ack.read fd cryptobox_data + end ~on_error:begin fun _ -> P2p_io_scheduler.close fd >>= fun _ -> - Lwt.return (Error err) + fail Rejected end >>=? fun accepted -> fail_unless accepted Rejected >>=? fun () -> let canceler = Canceler.create () in diff --git a/test/test_p2p_connection.ml b/test/test_p2p_connection.ml index e0d84cbc8..2dda0293a 100644 --- a/test/test_p2p_connection.ml +++ b/test/test_p2p_connection.ml @@ -83,11 +83,17 @@ let simple_msg = let is_rejected = function | Error [P2p_connection.Rejected] -> true - | Ok _ | Error _ -> false + | Ok _ -> false + | Error err -> + log_notice "Error: %a" pp_print_error err ; + false let is_connection_closed = function | Error [P2p_io_scheduler.Connection_closed] -> true - | Ok _ | Error _ -> false + | Ok _ -> false + | Error err -> + log_notice "Error: %a" pp_print_error err ; + false let bytes_encoding = Data_encoding.Variable.bytes From 52fab9528cc65532596859e47b43734728821e38 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Gr=C3=A9goire=20Henry?= Date: Mon, 23 Jan 2017 09:18:56 +0100 Subject: [PATCH 02/16] P2p: add error for invalid authentification --- src/node/net/p2p_connection.ml | 8 ++++++-- src/node/net/p2p_connection.mli | 1 + 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/src/node/net/p2p_connection.ml b/src/node/net/p2p_connection.ml index 68674a835..8c00b04b5 100644 --- a/src/node/net/p2p_connection.ml +++ b/src/node/net/p2p_connection.ml @@ -32,6 +32,7 @@ type error += Rejected type error += Decoding_error type error += Myself of Id_point.t type error += Not_enough_proof_of_work of Gid.t +type error += Invalid_auth module Crypto = struct @@ -336,9 +337,12 @@ let accept Lwt_utils.protect begin fun () -> Ack.write fd cryptobox_data Ack >>=? fun () -> Ack.read fd cryptobox_data - end ~on_error:begin fun _ -> + end ~on_error:begin fun err -> P2p_io_scheduler.close fd >>= fun _ -> - fail Rejected + match err with + | [ P2p_io_scheduler.Connection_closed ] -> fail Rejected + | [ Decipher_error ] -> fail Invalid_auth + | err -> Lwt.return (Error err) end >>=? fun accepted -> fail_unless accepted Rejected >>=? fun () -> let canceler = Canceler.create () in diff --git a/src/node/net/p2p_connection.mli b/src/node/net/p2p_connection.mli index 8d335a68c..890cc6c34 100644 --- a/src/node/net/p2p_connection.mli +++ b/src/node/net/p2p_connection.mli @@ -26,6 +26,7 @@ type error += Decoding_error type error += Rejected type error += Myself of Id_point.t type error += Not_enough_proof_of_work of Gid.t +type error += Invalid_auth type authenticated_fd (** Type of a connection that successfully passed the authentication From 87254788b9a867858917a12c94dd531ab2b6e13a Mon Sep 17 00:00:00 2001 From: damian Date: Wed, 23 Nov 2016 01:54:22 -0800 Subject: [PATCH 03/16] Added Dockerfiles for building and running tezos binaries --- scripts/Dockerfile.binaries.in | 20 ++++++++ scripts/Dockerfile.build_bin.in | 13 +++++ scripts/Dockerfile.build_deps.in | 11 +++++ scripts/create_docker_builder.sh | 39 ++++++--------- scripts/create_docker_with_binaries.sh | 41 ++++++++++++++++ scripts/install_build_deps.sh | 67 ++++++++++++-------------- 6 files changed, 132 insertions(+), 59 deletions(-) create mode 100644 scripts/Dockerfile.binaries.in create mode 100644 scripts/Dockerfile.build_bin.in create mode 100644 scripts/Dockerfile.build_deps.in create mode 100755 scripts/create_docker_with_binaries.sh diff --git a/scripts/Dockerfile.binaries.in b/scripts/Dockerfile.binaries.in new file mode 100644 index 000000000..66eb58b87 --- /dev/null +++ b/scripts/Dockerfile.binaries.in @@ -0,0 +1,20 @@ +FROM alpine:3.4 +# FIXME: I'm currently guessing the version of alpine that the opam image we've +# built the tezos binaries on is based on. if that becomes newer (e.g. alpine +# 3.5), the binaries built on that version of alpine could (will) depend on +# library symbols that won't be in alpine 3.4 + +LABEL distro_style="apk" distro="alpine" distro_long="alpine-3.4" arch="x86_64" operatingsystem="linux" + +RUN apk update && \ + apk upgrade && \ + apk add sudo bash libsodium gmp && \ + adduser -S tezos && \ + echo 'tezos ALL=(ALL:ALL) NOPASSWD:ALL' > /etc/sudoers.d/tezos && \ + chmod 440 /etc/sudoers.d/tezos && \ + chown root:root /etc/sudoers.d/tezos && \ + sed -i.bak 's/^Defaults.*requiretty//g' /etc/sudoers +USER tezos + +ADD built-bin /usr/local/bin +WORKDIR /home/tezos diff --git a/scripts/Dockerfile.build_bin.in b/scripts/Dockerfile.build_bin.in new file mode 100644 index 000000000..dfbc24954 --- /dev/null +++ b/scripts/Dockerfile.build_bin.in @@ -0,0 +1,13 @@ +FROM tezos_build:$base_image + +ADD tezos /home/opam/tezos +ENV HOME /home/opam +WORKDIR $HOME/tezos +RUN sudo HOME="$HOME" opam config exec -- make clean && \ + sudo rm -fr ~/.opam/log && \ + sudo chown -R opam /home/opam +RUN opam config exec -- make +RUN mkdir -p ~/bin && \ + (cp tezos-client tezos-node tezos-protocol-compiler tezos-webclient ~/bin || true) + +WORKDIR $HOME/bin diff --git a/scripts/Dockerfile.build_deps.in b/scripts/Dockerfile.build_deps.in new file mode 100644 index 000000000..db976b328 --- /dev/null +++ b/scripts/Dockerfile.build_deps.in @@ -0,0 +1,11 @@ +FROM ocaml/opam:$base_image +COPY install_build_deps.sh /tmp +COPY tezos-deps.opam /tmp/src/tezos-deps.opam +WORKDIR /tmp +RUN opam config exec -- ./install_build_deps.sh pin && rm -fr ~/.opam/log/ +USER root +ENV HOME /home/opam +RUN opam config exec -- ./install_build_deps.sh depext && rm -fr ~/.opam/log/ +RUN apk add libsodium-dev +USER opam +RUN opam config exec -- ./install_build_deps.sh all && rm -fr ~/.opam/log/ diff --git a/scripts/create_docker_builder.sh b/scripts/create_docker_builder.sh index c89f6328d..0154dc966 100755 --- a/scripts/create_docker_builder.sh +++ b/scripts/create_docker_builder.sh @@ -1,32 +1,23 @@ #! /bin/sh set -x +set -e -dir=$(mktemp -d) -cur_dir="$(dirname "$(readlink -f "$0")")" +dir="$(mktemp -d)" +src_dir="$(dirname "$(readlink -f "$0")")" -image_name=${1:=tezos_build} -ocaml_version=${2:=alpine_ocaml-4.03.0} -image_version=$3 +image_name="${1:-tezos_build}" +base_image="${2:-alpine_ocaml-4.03.0}" +image_version="$3" -docker pull ocaml/opam:${ocaml_version} +docker pull ocaml/opam:"$base_image" -cp ${cur_dir}/install_build_deps.sh ${dir} -cp ${cur_dir}/../src/tezos-deps.opam ${dir} -cat > ${dir}/Dockerfile < Dockerfile.build_deps + +docker build -f Dockerfile.build_deps -t "$image_name:$base_image$image_version" "$dir" diff --git a/scripts/create_docker_with_binaries.sh b/scripts/create_docker_with_binaries.sh new file mode 100755 index 000000000..9f7ee2a2a --- /dev/null +++ b/scripts/create_docker_with_binaries.sh @@ -0,0 +1,41 @@ +#! /bin/sh + +set -x +set -e + +dir="$(mktemp -d)" +src_dir="$(dirname "$(readlink -f "$0")")" + +image_name="${1:-tezos_build}" +base_image="${2:-alpine_ocaml-4.03.0}" +image_version="$3" + +tezos_build_img="tezos_build:$base_image" + +if ! (docker images | grep -- "^tezos_build \+$base_image "); then + echo "Docker image not found: $tezos_build_img" >&2 + echo "Aborting" >&2 + exit 1 + fi + +cd "$dir" + +git clone "$src_dir"/.. "$dir"/tezos +rm -fr "$dir"/tezos/.git + +cp "$src_dir"/Dockerfile.build_bin.in "$dir" +sed Dockerfile.build_bin.in -e 's/$base_image/'"$base_image"'/g' > Dockerfile.build_bin + +docker build -f Dockerfile.build_bin -t "tezos_build_bin:$base_image$image_version" "$dir" + +mkdir -p "$dir"/built-bin +docker run -i --rm -v "$dir"/built-bin:/built-bin "tezos_build_bin:$base_image$image_version" /bin/bash << EOF +sudo cp -v /home/opam/bin/tezos-* /built-bin/ +sudo chown opam:nogroup /built-bin/tezos-* +sudo chmod a+rwx /built-bin/tezos-* +EOF + +cp "$src_dir"/Dockerfile.binaries.in "$dir" +sed Dockerfile.binaries.in -e 's/$base_image/'"$base_image"'/g' > Dockerfile.binaries + +docker build -f Dockerfile.binaries -t "tezos_binaries:$base_image$image_version" "$dir" diff --git a/scripts/install_build_deps.sh b/scripts/install_build_deps.sh index 646a2f4c6..ba6694563 100755 --- a/scripts/install_build_deps.sh +++ b/scripts/install_build_deps.sh @@ -1,39 +1,36 @@ -#!/bin/sh +#! /bin/sh -if ! [ -f 'src/tezos-deps.opam' ]; then - echo - echo " Please run from the project's root directory. Aborting." - echo - exit 1 -fi - -ocaml_version=4.03.0 -if [ "$(ocaml -vnum)" != "$ocaml_version" ]; then - echo - echo " Unexpected compiler version ($(ocaml -vnum))" - echo " You should use ocaml-$ocaml_version." - echo - exit 1 +OCAML_VERSION=4.03.0 +if [ "$(ocaml -vnum)" != "$OCAML_VERSION" ]; then + echo ; + echo " Unexpected compiler version ($(ocaml -vnum))"; + echo " You should use ocaml-$OCAML_VERSION."; + echo ; + exit 1; fi cmd="$1" if [ -z "$cmd" ]; then cmd=all; fi -case "$cmd" in +pin=false +depext=false +install=false + +case $cmd in pin) - pin=yes - ;; + pin=true + ;; depext) - depext=yes - ;; + depext=true + ;; install) - install=yes - ;; + install=true + ;; all) - pin=yes - depext=yes - install=yes - ;; + pin=true + depext=true + install=true + ;; *) echo "Unknown command '$cmd'." echo "Usage: $0 [pin|depext|install|all|]" @@ -43,7 +40,7 @@ esac set -e set -x -if ! [ -z "$pin" ]; then +if "$pin"; then opam pin --yes remove --no-action --dev-repo ocplib-resto || true opam pin --yes add --no-action --dev-repo sodium opam pin --yes add --no-action --dev-repo ocp-ocamlres @@ -56,15 +53,15 @@ if ! [ -z "$pin" ]; then opam pin --yes add --no-action tezos-deps src fi -if ! [ -z "$depext" ]; then - ## In our CI, this rule is executed as user 'root' - ## The other rules are executed as user 'opam'. +if "$depext"; then opam list --installed depext || opam install depext - opam depext tezos-deps + opam depext $DEPEXTOPT tezos-deps fi -if ! [ -z "$install" ]; then - opam install tezos-deps - ## This seems broken in the current opam-repo (2016-12-09) - ## opam install --build-test tezos-deps +if "$install"; then + if opam list --installed tezos-deps ; then + opam upgrade $(opam list -s --required-by tezos-deps | grep -ve '^ocaml *$') + else + opam install tezos-deps + fi fi From d87a6cd55684fe4579488bcbf1586d7773919673 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Gr=C3=A9goire=20Henry?= Date: Sun, 22 Jan 2017 01:59:18 +0100 Subject: [PATCH 04/16] Docker: integration in CI And minor fix: - introduce configuration file for OCaml and alpine versions - add missing `libssl1.0` in docker image - remove the split call to `install_build_deps` (not required anymore) - rename scripts --- .dockerignore | 67 +++++++++++++++++++++++ .gitlab-ci.yml | 56 +++++++++---------- Makefile | 7 +++ scripts/Dockerfile.binaries.in | 22 +++++--- scripts/Dockerfile.build_bin.in | 18 ++---- scripts/Dockerfile.build_deps.in | 19 +++---- scripts/create_build_deps_docker_image.sh | 20 +++++++ scripts/create_docker_builder.sh | 23 -------- scripts/create_docker_image.sh | 41 ++++++++++++++ scripts/create_docker_with_binaries.sh | 41 -------------- scripts/install_build_deps.sh | 10 +++- scripts/version.sh | 4 ++ src/Makefile | 17 +++--- 13 files changed, 208 insertions(+), 137 deletions(-) create mode 100644 .dockerignore create mode 100755 scripts/create_build_deps_docker_image.sh delete mode 100755 scripts/create_docker_builder.sh create mode 100755 scripts/create_docker_image.sh delete mode 100755 scripts/create_docker_with_binaries.sh create mode 100644 scripts/version.sh diff --git a/.dockerignore b/.dockerignore new file mode 100644 index 000000000..cd60a33be --- /dev/null +++ b/.dockerignore @@ -0,0 +1,67 @@ +.git + +tezos-node +tezos-protocol-compiler +tezos-client +tezos-webclient +tezos-attacker + +src/Makefile.local + +src/webclient_static.ml +src/.depend + +src/node/updater/environment_gen +src/node/updater/proto_environment.mli +src/compiler/embedded_cmis.ml + +src/proto/**/_tzbuild +src/proto/register_client_*.ml +src/client/embedded/**/_tzbuild + +src/client/embedded/demo/.depend + +src/client/embedded/bootstrap/.depend +src/client/embedded/bootstrap/concrete_lexer.ml +src/client/embedded/bootstrap/concrete_parser.ml +src/client/embedded/bootstrap/concrete_parser.mli +src/client/embedded/bootstrap/webclient_proto_static.ml +src/client/embedded/bootstrap/main.byte +src/client/embedded/bootstrap/webclient_static/main.js +src/client/embedded/bootstrap/webclient/browser/main.byte +src/client/embedded/bootstrap/webclient/static/main.js +src/client/embedded/bootstrap/webclient/webclient_proto_static.ml + +test/.depend +test/reports + +test/test-store +test/test-state +test/test-context +test/test-basic +test/test-data-encoding +test/test-p2p-io-scheduler +test/test-p2p-connection +test/test-p2p-connection-pool +test/LOG + +**/*~ +**/\#*\# + +**/*.[oa] +**/*.so +**/*~ +**/*.cm[iaoxt] +**/*.cmti +**/*.cmxa +**/*.cmxs +**/*.cmp +**/*.mli.deps +**/*.ml.deps +**/*.mli.deps.byte +**/*.ml.deps.byte + +**/bisect*.out + +**/*.rej +**/*.orig diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 87b7a28df..cb640e4d3 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -1,10 +1,10 @@ variables: - ocaml_image: alpine_ocaml-4.03.0 - build_image_name: ocp_tezos_build + image_name: ocp_tezos + image_id: ${CI_BUILD_REF_NAME} + build_image_name: ${image_name}_build_deps build_image_id: ${CI_BUILD_REF} - build_image: ${build_image_name}:${ocaml_image} -image: ${build_image}_${build_image_id} +image: ${build_image_name}:${build_image_id} stages: - build_deps @@ -21,8 +21,8 @@ build_deps: tags: - docker_builder script: - - ./scripts/create_docker_builder.sh - ${build_image_name} ${ocaml_image} "_${build_image_id}" + - ./scripts/create_build_deps_docker_image.sh + ${build_image_name} ${build_image_id} build: stage: build @@ -137,15 +137,29 @@ test:p2p-connection-pool: - build - build:test -expurge: - stage: expurge +publish:docker: + stage: publish + image: ocp:docker + tags: + - docker_builder + script: + - ./scripts/create_docker_image.sh ${image_name} ${build_image_id} + - docker tag ${image_name}:${build_image_id} + "$CI_REGISTRY_IMAGE:$CI_BUILD_REF_NAME" + - docker login -u gitlab-ci-token -p $CI_BUILD_TOKEN $CI_REGISTRY + - docker push "$CI_REGISTRY_IMAGE:$CI_BUILD_REF_NAME" + - docker rmi "$CI_REGISTRY_IMAGE:$CI_BUILD_REF_NAME" + +publish:github: + image: ocaml/opam + stage: publish tags: - tezos_builder only: - master@tezos/tezos script: - echo "${CI_KH}" > ~/.ssh/known_hosts - - echo "${CI_PK_GITLAB}" > ~/.ssh/id_rsa + - echo "${CI_PK_GITHUB}" > ~/.ssh/id_rsa - chmod 400 ~/.ssh/id_rsa - rm -fr .git/refs/original - git filter-branch --prune-empty --index-filter @@ -162,23 +176,7 @@ expurge: export GIT_AUTHOR_EMAIL="contact@tezos.com" ; fi' HEAD - - git tag ${CI_BUILD_REF}_expurged - - git push git@gitlab.ocamlpro.com:${CI_PROJECT_PATH}.git - -f --tags HEAD:master-expurged - -publish:github: - image: ocaml/opam:${ocaml_image} - stage: publish - tags: - - tezos_builder - only: - - master@tezos/tezos - script: - - echo "${CI_KH}" > ~/.ssh/known_hosts - - echo "${CI_PK_GITHUB}" > ~/.ssh/id_rsa - - chmod 400 ~/.ssh/id_rsa - - git reset ${CI_BUILD_REF}_expurged - - git push git@github.com:tezos/tezos.git -f HEAD:master + - git push git@github.com:OCamlPro/tezos.git -f HEAD:master cleanup: stage: cleanup @@ -186,7 +184,7 @@ cleanup: tags: - docker_builder script: - - docker tag ${build_image}_${build_image_id} - ${build_image}_${CI_PROJECT_NAMESPACE}_${CI_BUILD_REF_NAME} - - docker rmi ${build_image}_${build_image_id} + - docker tag ${build_image_name}:${build_image_id} + ${build_image_name}:${CI_PROJECT_NAMESPACE}_${CI_BUILD_REF_NAME} + - docker rmi ${build_image_name}:${build_image_id} when: always diff --git a/Makefile b/Makefile index dcdf44df4..6522e1c51 100644 --- a/Makefile +++ b/Makefile @@ -6,9 +6,16 @@ clean: ${MAKE} -C src clean ${MAKE} -C test clean +partial-clean: + ${MAKE} -C src partial-clean + ${MAKE} -C test clean + .PHONY: test test: ${MAKE} -C test build-deps: @./scripts/install_build_deps.sh all + +docker-image: + @./scripts/create_docker_image.sh diff --git a/scripts/Dockerfile.binaries.in b/scripts/Dockerfile.binaries.in index 66eb58b87..8831fb436 100644 --- a/scripts/Dockerfile.binaries.in +++ b/scripts/Dockerfile.binaries.in @@ -1,20 +1,24 @@ -FROM alpine:3.4 -# FIXME: I'm currently guessing the version of alpine that the opam image we've -# built the tezos binaries on is based on. if that becomes newer (e.g. alpine -# 3.5), the binaries built on that version of alpine could (will) depend on -# library symbols that won't be in alpine 3.4 +FROM alpine:$alpine_version -LABEL distro_style="apk" distro="alpine" distro_long="alpine-3.4" arch="x86_64" operatingsystem="linux" +LABEL distro_style="apk" distro="alpine" distro_long="alpine-$alpine_version" arch="x86_64" operatingsystem="linux" RUN apk update && \ apk upgrade && \ - apk add sudo bash libsodium gmp && \ + apk add sudo bash libssl1.0 libsodium gmp && \ + rm -f /var/cache/apk/* && \ adduser -S tezos && \ echo 'tezos ALL=(ALL:ALL) NOPASSWD:ALL' > /etc/sudoers.d/tezos && \ chmod 440 /etc/sudoers.d/tezos && \ chown root:root /etc/sudoers.d/tezos && \ - sed -i.bak 's/^Defaults.*requiretty//g' /etc/sudoers + sed -i 's/^Defaults.*requiretty//g' /etc/sudoers USER tezos -ADD built-bin /usr/local/bin +COPY . /home/tezos WORKDIR /home/tezos + +RUN sudo chown root:root bin/* && \ + sudo chmod a+rx bin/* && \ + sudo mv bin/* /usr/local/bin && \ + rmdir bin + +ENTRYPOINT [ "/bin/bash" ] diff --git a/scripts/Dockerfile.build_bin.in b/scripts/Dockerfile.build_bin.in index dfbc24954..cb903902f 100644 --- a/scripts/Dockerfile.build_bin.in +++ b/scripts/Dockerfile.build_bin.in @@ -1,13 +1,7 @@ -FROM tezos_build:$base_image +FROM $base_name:$base_version -ADD tezos /home/opam/tezos -ENV HOME /home/opam -WORKDIR $HOME/tezos -RUN sudo HOME="$HOME" opam config exec -- make clean && \ - sudo rm -fr ~/.opam/log && \ - sudo chown -R opam /home/opam -RUN opam config exec -- make -RUN mkdir -p ~/bin && \ - (cp tezos-client tezos-node tezos-protocol-compiler tezos-webclient ~/bin || true) - -WORKDIR $HOME/bin +COPY . /home/opam/tezos +RUN sudo chown -R opam /home/opam/tezos && \ + opam config exec -- make -C tezos -j4 && \ + mkdir bin && \ + cp tezos/tezos-* bin diff --git a/scripts/Dockerfile.build_deps.in b/scripts/Dockerfile.build_deps.in index db976b328..030511316 100644 --- a/scripts/Dockerfile.build_deps.in +++ b/scripts/Dockerfile.build_deps.in @@ -1,11 +1,8 @@ -FROM ocaml/opam:$base_image -COPY install_build_deps.sh /tmp -COPY tezos-deps.opam /tmp/src/tezos-deps.opam -WORKDIR /tmp -RUN opam config exec -- ./install_build_deps.sh pin && rm -fr ~/.opam/log/ -USER root -ENV HOME /home/opam -RUN opam config exec -- ./install_build_deps.sh depext && rm -fr ~/.opam/log/ -RUN apk add libsodium-dev -USER opam -RUN opam config exec -- ./install_build_deps.sh all && rm -fr ~/.opam/log/ +FROM ocaml/opam:alpine-$alpine_version_ocaml-$ocaml_version + +COPY scripts/install_build_deps.sh scripts/version.sh scripts/ +COPY src/tezos-deps.opam src/ +RUN sudo apk add libsodium-dev && \ + opam config exec -- ./scripts/install_build_deps.sh all \ + rm -fr ~/.opam/log/ \ + "$(opam config exec -- ocamlfind query stdlib)"/topdirs.cmi diff --git a/scripts/create_build_deps_docker_image.sh b/scripts/create_build_deps_docker_image.sh new file mode 100755 index 000000000..144db6b2f --- /dev/null +++ b/scripts/create_build_deps_docker_image.sh @@ -0,0 +1,20 @@ +#! /bin/sh + +set -e +set -x + +script_dir="$(dirname "$(readlink -f "$0")")" +src_dir="$(dirname "$script_dir")" +cd "$src_dir" + +. scripts/version.sh +image_name="${1:-tezos_build_deps}" +image_version="${2:-latest}" + +sed scripts/Dockerfile.build_deps.in \ + -e 's/$alpine_version/'"$alpine_version"'/g' \ + -e 's/$ocaml_version/'"$ocaml_version"'/g' > Dockerfile + +docker build --pull -t "$image_name:$image_version" . + +rm Dockerfile diff --git a/scripts/create_docker_builder.sh b/scripts/create_docker_builder.sh deleted file mode 100755 index 0154dc966..000000000 --- a/scripts/create_docker_builder.sh +++ /dev/null @@ -1,23 +0,0 @@ -#! /bin/sh - -set -x -set -e - -dir="$(mktemp -d)" -src_dir="$(dirname "$(readlink -f "$0")")" - -image_name="${1:-tezos_build}" -base_image="${2:-alpine_ocaml-4.03.0}" -image_version="$3" - -docker pull ocaml/opam:"$base_image" - -cd "$dir" - -cp "$src_dir"/install_build_deps.sh "$dir" -cp "$src_dir"/../src/tezos-deps.opam "$dir" - -cp "$src_dir"/Dockerfile.build_deps.in "$dir" -sed Dockerfile.build_deps.in -e 's/$base_image/'"$base_image"'/g' > Dockerfile.build_deps - -docker build -f Dockerfile.build_deps -t "$image_name:$base_image$image_version" "$dir" diff --git a/scripts/create_docker_image.sh b/scripts/create_docker_image.sh new file mode 100755 index 000000000..eab3e1ee1 --- /dev/null +++ b/scripts/create_docker_image.sh @@ -0,0 +1,41 @@ +#! /bin/sh + +set -e +set -x + +script_dir="$(dirname "$(readlink -f "$0")")" +src_dir="$(dirname "$script_dir")" +cd "$src_dir" + +. scripts/version.sh +image_name="${1:-tezos}" +image_version="${2:-latest}" +build_deps_image_name="$image_name"_build_deps + +echo Building dependencies... +./scripts/create_build_deps_docker_image.sh \ + "$build_deps_image_name" "$image_version" + +cleanup () { + set +e + echo Cleaning up... + [ -z "$tmp_container" ] || docker rm "$tmp_container" + [ -z "$tmp_image" ] || docker rmi "$tmp_image" + rm -rf Dockerfile bin +} +trap cleanup EXIT INT + +sed scripts/Dockerfile.build_bin.in \ + -e 's/$base_name/'"$build_deps_image_name"'/g' \ + -e 's/$base_version/'"$image_version"'/g' > Dockerfile + +echo Building tezos... +tmp_image="$(docker build -q .)" +tmp_container="$(docker run -dit "$tmp_image" true)" + +docker cp "$tmp_container":/home/opam/bin/ bin + +echo Building minimal docker image... +sed scripts/Dockerfile.binaries.in \ + -e 's/$alpine_version/'"$alpine_version"'/g' > Dockerfile +docker build -q -t "$image_name:$image_version" . diff --git a/scripts/create_docker_with_binaries.sh b/scripts/create_docker_with_binaries.sh deleted file mode 100755 index 9f7ee2a2a..000000000 --- a/scripts/create_docker_with_binaries.sh +++ /dev/null @@ -1,41 +0,0 @@ -#! /bin/sh - -set -x -set -e - -dir="$(mktemp -d)" -src_dir="$(dirname "$(readlink -f "$0")")" - -image_name="${1:-tezos_build}" -base_image="${2:-alpine_ocaml-4.03.0}" -image_version="$3" - -tezos_build_img="tezos_build:$base_image" - -if ! (docker images | grep -- "^tezos_build \+$base_image "); then - echo "Docker image not found: $tezos_build_img" >&2 - echo "Aborting" >&2 - exit 1 - fi - -cd "$dir" - -git clone "$src_dir"/.. "$dir"/tezos -rm -fr "$dir"/tezos/.git - -cp "$src_dir"/Dockerfile.build_bin.in "$dir" -sed Dockerfile.build_bin.in -e 's/$base_image/'"$base_image"'/g' > Dockerfile.build_bin - -docker build -f Dockerfile.build_bin -t "tezos_build_bin:$base_image$image_version" "$dir" - -mkdir -p "$dir"/built-bin -docker run -i --rm -v "$dir"/built-bin:/built-bin "tezos_build_bin:$base_image$image_version" /bin/bash << EOF -sudo cp -v /home/opam/bin/tezos-* /built-bin/ -sudo chown opam:nogroup /built-bin/tezos-* -sudo chmod a+rwx /built-bin/tezos-* -EOF - -cp "$src_dir"/Dockerfile.binaries.in "$dir" -sed Dockerfile.binaries.in -e 's/$base_image/'"$base_image"'/g' > Dockerfile.binaries - -docker build -f Dockerfile.binaries -t "tezos_binaries:$base_image$image_version" "$dir" diff --git a/scripts/install_build_deps.sh b/scripts/install_build_deps.sh index ba6694563..c3562b864 100755 --- a/scripts/install_build_deps.sh +++ b/scripts/install_build_deps.sh @@ -1,10 +1,14 @@ #! /bin/sh -OCAML_VERSION=4.03.0 -if [ "$(ocaml -vnum)" != "$OCAML_VERSION" ]; then +script_dir="$(dirname "$(readlink -f "$0")")" +src_dir="$(dirname "$script_dir")" + +. "$script_dir/version.sh" + +if [ "$(ocaml -vnum)" != "$ocaml_version" ]; then echo ; echo " Unexpected compiler version ($(ocaml -vnum))"; - echo " You should use ocaml-$OCAML_VERSION."; + echo " You should use ocaml-$ocaml_version."; echo ; exit 1; fi diff --git a/scripts/version.sh b/scripts/version.sh new file mode 100644 index 000000000..8830b85dc --- /dev/null +++ b/scripts/version.sh @@ -0,0 +1,4 @@ +#! /bin/sh + +alpine_version=3.5 +ocaml_version=4.03.0 diff --git a/src/Makefile b/src/Makefile index 2617fc8af..758de0561 100644 --- a/src/Makefile +++ b/src/Makefile @@ -65,7 +65,7 @@ node/updater/proto_environment.cmi: \ @echo OCAMLOPT ${TARGET} $@ @$(OCAMLOPT) -nopervasives -nostdlib -opaque -I tmp -I node/updater -c $< -clean:: +partial-clean:: rm -f node/updater/proto_environment.mli rm -f node/updater/environment_gen @@ -91,7 +91,7 @@ compiler/embedded_cmis.cmx: compiler/embedded_cmis.cmi compiler/embedded_cmis.ml: ${EMBEDDED_PROTOCOL_LIB_CMIS} @echo OCAMLRES ${TARGET} $(notdir $@) @$(OCAMLRES) -format ocaml -o $@ $^ -clean:: +partial-clean:: rm -f compiler/embedded_cmis.ml rm -rf tmp @@ -368,7 +368,7 @@ ${TZNODE}: minutils.cmxa utils.cmxa compiler.cmxa node.cmxa ${EMBEDDED_NODE_PROT @echo LINK $(notdir $@) @${OCAMLOPT} -linkall -linkpkg ${OCAMLFLAGS} -o $@ $^ -clean:: +partial-clean:: -rm -f proto/*.cm* proto/*.a ## Embedded protocol modules @@ -399,8 +399,6 @@ proto/client_embedded_proto_%.cmxa: \ $(addprefix -I , ${CLIENT_PROTO_INCLUDES}) \ $@ proto/$* - - clean:: rm -f ${TZNODE} @@ -529,7 +527,7 @@ client/embedded/webclient_%.cmx: \ $$(shell find client/embedded/%/webclient/static/) @$(MAKE) -C client/embedded/$* ../webclient_$*.cmx -clean:: +partial-clean:: -for d in $$(ls -d client/embedded/*/) ; do make clean -C $$d ; done -rm -f client/embedded/*.cm* client/embedded/*.o @@ -601,8 +599,9 @@ clean:: ## Cleaning -.PHONY: clean -clean:: +.PHONY: clean partial-clean +clean:: partial-clean +partial-clean:: -find \( -name \*.cm\* -or -name \*.cmp -or -name \*.out -or -name \*~ -or -name \*.o -or -name \*.a \) -delete ## Dependencies @@ -652,6 +651,6 @@ compiler/tezos_compiler.cmo compiler/tezos_compiler.cmx: \ @echo OCAMLDEP ${TARGET} $(notdir $^) @$(OCAMLDEP) $(INCLUDES) $^ > $@ -clean:: +partial-clean:: -rm -f .depend -find \( -name \*.mli.deps -or -name \*.ml.deps \) -delete From 1989ebf1b84daa13735c03db4d44ef6f3927ab39 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Gr=C3=A9goire=20Henry?= Date: Mon, 23 Jan 2017 11:46:56 +0100 Subject: [PATCH 05/16] CI: fix github URL --- .gitlab-ci.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index cb640e4d3..af307db8a 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -176,7 +176,7 @@ publish:github: export GIT_AUTHOR_EMAIL="contact@tezos.com" ; fi' HEAD - - git push git@github.com:OCamlPro/tezos.git -f HEAD:master + - git push git@github.com:tezos/tezos.git -f HEAD:master cleanup: stage: cleanup From 866e7add2f8880cbc3f7d9676978b545d4bdf4fc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Gr=C3=A9goire=20Henry?= Date: Mon, 23 Jan 2017 11:09:33 +0100 Subject: [PATCH 06/16] Shell: improve `Utils` --- src/minutils/utils.ml | 25 ++++++++++++++----- src/minutils/utils.mli | 6 +++-- src/node/net/p2p_connection_pool_types.ml | 2 +- src/node/net/p2p_io_scheduler.ml | 10 ++++---- src/node/shell/node_rpc.ml | 6 ++--- src/node/shell/node_rpc_services.ml | 6 ++--- src/node/shell/state.ml | 3 ++- src/node_main.ml | 30 +++++++++++------------ src/utils/error_monad.ml | 2 +- test/test_p2p_connection_pool.ml | 7 +++--- test/test_state.ml | 2 +- 11 files changed, 58 insertions(+), 41 deletions(-) diff --git a/src/minutils/utils.ml b/src/minutils/utils.ml index bf6f36792..db569c68c 100644 --- a/src/minutils/utils.ml +++ b/src/minutils/utils.ml @@ -9,13 +9,16 @@ module StringMap = Map.Make (String) -let split delim ?(limit = max_int) path = +let split delim ?(dup = true) ?(limit = max_int) path = let l = String.length path in let rec do_slashes acc limit i = if i >= l then List.rev acc else if String.get path i = delim then - do_slashes acc limit (i + 1) + if dup then + do_slashes acc limit (i + 1) + else + do_split acc limit (i + 1) else do_split acc limit i and do_split acc limit i = @@ -55,8 +58,8 @@ let iter_option ~f = function | None -> () | Some x -> f x -let unopt x = function - | None -> x +let unopt ~default = function + | None -> default | Some x -> x let unopt_map ~f ~default = function @@ -85,8 +88,16 @@ let list_sub l n = list_rev_sub l n |> List.rev let display_paragraph ppf description = Format.fprintf ppf "@[%a@]" - (fun ppf words -> List.iter (Format.fprintf ppf "%s@ ") words) - (split ' ' description) + (Format.pp_print_list ~pp_sep:Format.pp_print_newline + (fun ppf line -> + Format.pp_print_list ~pp_sep:Format.pp_print_space + (fun ppf w -> + (* replace   by real spaces... *) + Format.fprintf ppf "%s@ " + (Stringext.replace_all ~pattern:"\xC2\xA0" ~with_:" " w)) + ppf + (split ' ' line))) + (split ~dup:false '\n' description) let rec remove_elem_from_list nb = function | [] -> [] @@ -128,6 +139,8 @@ let rec (--) i j = if j < i then acc else loop (j :: acc) (pred j) in loop [] j +let rec repeat n x = if n <= 0 then [] else x :: repeat (pred n) x + let take_n_unsorted n l = let rec loop acc n = function | [] -> l diff --git a/src/minutils/utils.mli b/src/minutils/utils.mli index 0b3ec0f00..c22b03aa8 100644 --- a/src/minutils/utils.mli +++ b/src/minutils/utils.mli @@ -16,12 +16,12 @@ val split_path: string -> string list (** Splits a string on a delimier character, grouping multiple delimiters, and ignoring delimiters at the beginning and end of string, if [limit] is passed, stops after [limit] split(s). *) -val split: char -> ?limit: int -> string -> string list +val split: char -> ?dup:bool -> ?limit: int -> string -> string list val map_option: f:('a -> 'b) -> 'a option -> 'b option val apply_option: f:('a -> 'b option) -> 'a option -> 'b option val iter_option: f:('a -> unit) -> 'a option -> unit -val unopt: 'a -> 'a option -> 'a +val unopt: default:'a -> 'a option -> 'a val unopt_map: f:('a -> 'b) -> default:'b -> 'a option -> 'b val unopt_list: 'a option list -> 'a list val first_some: 'a option -> 'a option -> 'a option @@ -51,6 +51,8 @@ val (<<) : ('b -> 'c) -> ('a -> 'b) -> 'a -> 'c (** Sequence: [i--j] is the sequence [i;i+1;...;j-1;j] *) val (--) : int -> int -> int list +val repeat: int -> 'a -> 'a list + (** [take_n n l] returns the [n] first elements of [n]. When [compare] is provided, it returns the [n] greatest element of [l]. *) val take_n: ?compare:('a -> 'a -> int) -> int -> 'a list -> 'a list diff --git a/src/node/net/p2p_connection_pool_types.ml b/src/node/net/p2p_connection_pool_types.ml index 2e2bcd5f9..2d48bed66 100644 --- a/src/node/net/p2p_connection_pool_types.ml +++ b/src/node/net/p2p_connection_pool_types.ml @@ -451,7 +451,7 @@ module Gid_info = struct let enc = Data_encoding.list (encoding metadata_encoding) in Data_encoding_ezjsonm.read_file path >|= map_option ~f:(Data_encoding.Json.destruct enc) >|= - unopt [] + unopt ~default:[] let save path metadata_encoding peers = let open Data_encoding in diff --git a/src/node/net/p2p_io_scheduler.ml b/src/node/net/p2p_io_scheduler.ml index 0a0acb087..14c00b357 100644 --- a/src/node/net/p2p_io_scheduler.ml +++ b/src/node/net/p2p_io_scheduler.ml @@ -147,7 +147,7 @@ module Scheduler(IO : IO) = struct canceler = Canceler.create () ; worker = Lwt.return_unit ; counter = Moving_average.create ~init:0 ~alpha ; - max_speed ; quota = unopt 0 max_speed ; + max_speed ; quota = unopt ~default:0 max_speed ; quota_updated = Lwt_condition.create () ; readys = Lwt_condition.create () ; readys_high = Queue.create () ; @@ -358,9 +358,9 @@ let write_now { write_queue } msg = Lwt_pipe.push_now write_queue msg let read_from conn ?pos ?len buf msg = let maxlen = MBytes.length buf in - let pos = unopt 0 pos in + let pos = unopt ~default:0 pos in assert (0 <= pos && pos < maxlen) ; - let len = unopt (maxlen - pos) len in + let len = unopt ~default:(maxlen - pos) len in assert (len <= maxlen - pos) ; match msg with | Ok msg -> @@ -400,8 +400,8 @@ let read conn ?pos ?len buf = let read_full conn ?pos ?len buf = let maxlen = MBytes.length buf in - let pos = unopt 0 pos in - let len = unopt (maxlen - pos) len in + let pos = unopt ~default:0 pos in + let len = unopt ~default:(maxlen - pos) len in assert (0 <= pos && pos < maxlen) ; assert (len <= maxlen - pos) ; let rec loop pos len = diff --git a/src/node/shell/node_rpc.ml b/src/node/shell/node_rpc.ml index d555bcbdd..6082a6a5a 100644 --- a/src/node/shell/node_rpc.ml +++ b/src/node/shell/node_rpc.ml @@ -394,9 +394,9 @@ let build_rpc_directory node = let dir = let implementation (net_id, pred, time, fitness, operations, header) = Node.RPC.block_info node (`Head 0) >>= fun bi -> - let timestamp = Utils.unopt (Time.now ()) time in - let net_id = Utils.unopt bi.net net_id in - let predecessor = Utils.unopt bi.hash pred in + let timestamp = Utils.unopt ~default:(Time.now ()) time in + let net_id = Utils.unopt ~default:bi.net net_id in + let predecessor = Utils.unopt ~default:bi.hash pred in let res = Store.Block.to_bytes { shell = { net_id ; predecessor ; timestamp ; fitness ; operations } ; diff --git a/src/node/shell/node_rpc_services.ml b/src/node/shell/node_rpc_services.ml index ba6be7dcb..393b3ad49 100644 --- a/src/node/shell/node_rpc_services.ml +++ b/src/node/shell/node_rpc_services.ml @@ -524,7 +524,7 @@ let inject_block = (fun (block, blocking, force) -> (block, Some blocking, force)) (fun (block, blocking, force) -> - (block, Utils.unopt true blocking, force)) + (block, Utils.unopt ~default:true blocking, force)) (obj3 (req "data" bytes) (opt "blocking" @@ -557,7 +557,7 @@ let inject_operation = ~input: (conv (fun (block, blocking, force) -> (block, Some blocking, force)) - (fun (block, blocking, force) -> (block, unopt true blocking, force)) + (fun (block, blocking, force) -> (block, unopt ~default:true blocking, force)) (obj3 (req "signedOperationContents" (describe ~title: "Tezos signed operation (hex encoded)" @@ -611,7 +611,7 @@ let inject_protocol = ~input: (conv (fun (proto, blocking, force) -> (rpc_of_proto proto, Some blocking, force)) - (fun (proto, blocking, force) -> (proto_of_rpc proto, unopt true blocking, force)) + (fun (proto, blocking, force) -> (proto_of_rpc proto, unopt ~default:true blocking, force)) (obj3 (req "protocol" (describe ~title: "Tezos protocol" diff --git a/src/node/shell/state.ml b/src/node/shell/state.ml index 2a11aa2a2..584dde856 100644 --- a/src/node/shell/state.ml +++ b/src/node/shell/state.ml @@ -699,7 +699,8 @@ module Valid_block = struct (* TODO check coherency: test_protocol. *) Lwt.return res | None -> - let test_protocol = Utils.unopt genesis.protocol test_protocol in + let test_protocol = + Utils.unopt ~default:genesis.protocol test_protocol in Context.create_genesis_context vstate.index genesis test_protocol >>= fun _context -> Block.db_store vstate.block_db genesis.block { diff --git a/src/node_main.ml b/src/node_main.ml index 84cfdb75e..f9a0543f8 100644 --- a/src/node_main.ml +++ b/src/node_main.ml @@ -207,19 +207,19 @@ module Cfg_file = struct (rpc_addr, cors_origins, cors_headers), log_output) -> let open Utils in - let store = unopt default_cfg.store store in - let context = unopt default_cfg.context context in - let protocol = unopt default_cfg.protocol protocol in + let store = unopt ~default:default_cfg.store store in + let context = unopt ~default:default_cfg.context context in + let protocol = unopt ~default:default_cfg.protocol protocol in let net_addr = map_option sockaddr_of_string_exn net_addr in - let net_addr, net_port = unopt (default_cfg.net_addr, default_cfg.net_port) net_addr in + let net_addr, net_port = unopt ~default:(default_cfg.net_addr, default_cfg.net_port) net_addr in let rpc_addr = map_option sockaddr_of_string_exn rpc_addr in - let peers = unopt [] peers in + let peers = unopt ~default:[] peers in let peers = ListLabels.map peers ~f:sockaddr_of_string_exn in - let peers_cache = unopt default_cfg.peers_cache peers_cache in - let log_output = unopt default_cfg.log_output (map_option log_of_string log_output) in - let min_connections = unopt default_cfg.min_connections min_connections in - let max_connections = unopt default_cfg.max_connections max_connections in - let expected_connections = unopt default_cfg.expected_connections expected_connections in + let peers_cache = unopt ~default:default_cfg.peers_cache peers_cache in + let log_output = unopt ~default:default_cfg.log_output (map_option log_of_string log_output) in + let min_connections = unopt ~default:default_cfg.min_connections min_connections in + let max_connections = unopt ~default:default_cfg.max_connections max_connections in + let expected_connections = unopt ~default:default_cfg.expected_connections expected_connections in (* let local_discovery = map_option local_discovery ~f:mcast_params_of_string in *) { default_cfg with store ; context ; protocol ; @@ -320,8 +320,8 @@ module Cmdline = struct (* local_discovery *) peers closed rpc_addr tls cors_origins cors_headers reset_cfg update_cfg = - let base_dir = Utils.(unopt (unopt default_cfg.base_dir base_dir) sandbox) in - let config_file = Utils.(unopt ((unopt base_dir sandbox) // "config")) config_file in + let base_dir = Utils.(unopt ~default:(unopt ~default:default_cfg.base_dir base_dir) sandbox) in + let config_file = Utils.(unopt ~default:((unopt ~default:base_dir sandbox) // "config")) config_file in let no_config () = warn "Found no config file at %s" config_file; warn "Using factory defaults"; @@ -355,9 +355,9 @@ module Cmdline = struct sandbox = Utils.first_some sandbox cfg.sandbox ; sandbox_param = Utils.first_some sandbox_param cfg.sandbox_param ; log_level = Utils.first_some log_level cfg.log_level ; - min_connections = Utils.unopt cfg.min_connections min_connections ; - max_connections = Utils.unopt cfg.max_connections max_connections ; - expected_connections = Utils.unopt cfg.expected_connections expected_connections ; + min_connections = Utils.unopt ~default:cfg.min_connections min_connections ; + max_connections = Utils.unopt ~default:cfg.max_connections max_connections ; + expected_connections = Utils.unopt ~default:cfg.expected_connections expected_connections ; net_addr = (match net_saddr with None -> cfg.net_addr | Some (addr, _) -> addr) ; net_port = (match net_saddr with None -> cfg.net_port | Some (_, port) -> port) ; (* local_discovery = Utils.first_some local_discovery cfg.local_discovery ; *) diff --git a/src/utils/error_monad.ml b/src/utils/error_monad.ml index 8ff3375ae..45d84349d 100644 --- a/src/utils/error_monad.ml +++ b/src/utils/error_monad.ml @@ -74,7 +74,7 @@ module Make() = struct category ; from_error ; encoding_case ; - pp = Utils.unopt (json_pp encoding) pp } :: !error_kinds + pp = Utils.unopt ~default:(json_pp encoding) pp } :: !error_kinds let register_wrapped_error_kind category ~id ~title ~description ?pp diff --git a/test/test_p2p_connection_pool.ml b/test/test_p2p_connection_pool.ml index bf3e8b20c..1435f2ec9 100644 --- a/test/test_p2p_connection_pool.ml +++ b/test/test_p2p_connection_pool.ml @@ -158,7 +158,7 @@ let make_net points repeat n = let addr = ref Ipaddr.V6.localhost let port = ref (1024 + Random.int 8192) let clients = ref 10 -let repeat = ref 5 +let repeat_connections = ref 5 let spec = Arg.[ @@ -169,7 +169,8 @@ let spec = Arg.[ "--clients", Set_int clients, " Number of concurrent clients." ; - "--repeat", Set_int repeat, " Number of connections/disconnections." ; + "--repeat", Set_int repeat_connections, + " Number of connections/disconnections." ; "-v", Unit (fun () -> Lwt_log_core.(add_rule "p2p.connection-pool" Info)), " Log up to info msgs" ; @@ -186,7 +187,7 @@ let main () = Arg.parse spec anon_fun usage_msg ; let ports = !port -- (!port + !clients - 1) in let points = List.map (fun port -> !addr, port) ports in - Lwt_list.iter_p (make_net points !repeat) (0 -- (!clients - 1)) + Lwt_list.iter_p (make_net points !repeat_connections) (0 -- (!clients - 1)) let () = Sys.catch_break true ; diff --git a/test/test_state.ml b/test/test_state.ml index 4c9c01c2a..c23aab57d 100644 --- a/test/test_state.ml +++ b/test/test_state.ml @@ -39,7 +39,7 @@ let incr_fitness fitness = | [ _ ; fitness ] -> Pervasives.( Data_encoding.Binary.of_bytes Data_encoding.int64 fitness - |> Utils.unopt 0L + |> Utils.unopt ~default:0L |> Int64.succ |> Data_encoding.Binary.to_bytes Data_encoding.int64 ) From 31872eb1b13c1150b143cddc137a68d159f38838 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Gr=C3=A9goire=20Henry?= Date: Mon, 23 Jan 2017 11:09:36 +0100 Subject: [PATCH 07/16] Shell: Improve `Logging` --- src/node_main.ml | 4 +- src/utils/logging.ml | 134 +++++++++++++++++++++++++++---- src/utils/logging.mli | 28 ++++++- test/lib/process.ml | 5 +- test/test_p2p_connection_pool.ml | 5 +- test/test_p2p_io_scheduler.ml | 2 +- 6 files changed, 150 insertions(+), 28 deletions(-) diff --git a/src/node_main.ml b/src/node_main.ml index f9a0543f8..a2c9f9701 100644 --- a/src/node_main.ml +++ b/src/node_main.ml @@ -411,7 +411,7 @@ let init_logger { log_output ; log_level } = | `Stderr -> Logging.init Stderr | `File fp -> Logging.init (File fp) | `Null -> Logging.init Null - | `Syslog -> Logging.init Syslog + | `Syslog -> Logging.init (Syslog `Local1) let init_node { sandbox ; sandbox_param ; @@ -533,7 +533,7 @@ let init_signal () = let main cfg = Random.self_init () ; Sodium.Random.stir () ; - init_logger cfg; + init_logger cfg >>= fun () -> Updater.init cfg.protocol; lwt_log_notice "Starting the Tezos node..." >>= fun () -> init_node cfg >>=? fun node -> diff --git a/src/utils/logging.ml b/src/utils/logging.ml index b41340dbf..fe791833d 100644 --- a/src/utils/logging.ml +++ b/src/utils/logging.ml @@ -7,6 +7,8 @@ (* *) (**************************************************************************) +open Lwt.Infix + module type LOG = sig val debug: ('a, Format.formatter, unit, unit) format4 -> 'a @@ -86,32 +88,134 @@ module Client = struct end module Webclient = Make(struct let name = "webclient" end) -let template = "$(date) $(name)[$(pid)]: $(message)" - -let default_logger () = - Lwt_log.channel ~template ~close_mode:`Keep ~channel:Lwt_io.stderr () +type template = Lwt_log.template +let default_template = "$(date) - $(section): $(message)" type kind = | Null | Stdout | Stderr | File of string - | Syslog - | Manual of Lwt_log.logger + | Syslog of Lwt_log.syslog_facility -let init kind = - let logger = +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 init ?(template = default_template) kind = + begin match kind with | Stderr -> - default_logger () + Lwt.return @@ + Lwt_log.channel ~template ~close_mode:`Keep ~channel:Lwt_io.stderr () | Stdout -> + Lwt.return @@ Lwt_log.channel ~template ~close_mode:`Keep ~channel:Lwt_io.stdout () | File file_name -> - Lwt_main.run (Lwt_log.file ~file_name ~template ()) + Lwt_log.file ~file_name ~template () | Null -> + Lwt.return @@ Lwt_log.null - | Syslog -> - Printf.eprintf "Warning: log_kind \"syslog\" not yet implemented.\n%!"; - default_logger () - | Manual logger -> logger in - Lwt_log.default := logger + | Syslog facility -> + Lwt.return @@ + Lwt_log.syslog ~template ~facility () + end >>= fun logger -> + Lwt_log.default := logger ; + Lwt.return_unit + +type level = Lwt_log_core.level = + | Debug + (** Debugging message. They can be automatically removed by the + syntax extension. *) + | Info + (** Informational message. Suitable to be displayed when the + program is in verbose mode. *) + | Notice + (** Same as {!Info}, but is displayed by default. *) + | Warning + (** Something strange happend *) + | Error + (** An error message, which should not means the end of the + program. *) + | Fatal + +let level_encoding = + let open Data_encoding in + conv + (function + | Fatal -> "fatal" + | Error -> "error" + | Warning -> "warning" + | Notice -> "notice" + | Info -> "info" + | Debug -> "debug") + (function + | "error" -> Error + | "warn" -> Warning + | "notice" -> Notice + | "info" -> Info + | "debug" -> Debug + | "fatal" -> Fatal + | _ -> invalid_arg "Logging.level") + string diff --git a/src/utils/logging.mli b/src/utils/logging.mli index fb999b7b0..c366f11b9 100644 --- a/src/utils/logging.mli +++ b/src/utils/logging.mli @@ -48,12 +48,34 @@ module Webclient : LOG module Make(S: sig val name: string end) : LOG +type level = Lwt_log_core.level = + | Debug + (** Debugging message. They can be automatically removed by the + syntax extension. *) + | Info + (** Informational message. Suitable to be displayed when the + program is in verbose mode. *) + | Notice + (** Same as {!Info}, but is displayed by default. *) + | Warning + (** Something strange happend *) + | Error + (** An error message, which should not means the end of the + program. *) + | Fatal + +type template = Lwt_log.template +val default_template : template + +val level_encoding : level Data_encoding.t + type kind = | Null | Stdout | Stderr | File of string - | Syslog - | Manual of Lwt_log.logger + | Syslog of Lwt_log.syslog_facility -val init: kind -> unit +val kind_encoding : kind Data_encoding.t + +val init: ?template:template -> kind -> unit Lwt.t diff --git a/test/lib/process.ml b/test/lib/process.ml index 2a60b2bbc..5a314237d 100644 --- a/test/lib/process.ml +++ b/test/lib/process.ml @@ -19,11 +19,8 @@ let detach ?(prefix = "") f = | 0 -> Random.self_init () ; let template = Format.asprintf "%s$(section): $(message)" prefix in - let logger = - Lwt_log.channel - ~template ~close_mode:`Keep ~channel:Lwt_io.stderr () in - Logging.init (Manual logger) ; Lwt_main.run begin + Logging.init ~template Stderr >>= fun () -> lwt_log_notice "PID: %d" (Unix.getpid ()) >>= fun () -> f () end ; diff --git a/test/test_p2p_connection_pool.ml b/test/test_p2p_connection_pool.ml index 1435f2ec9..f46541a47 100644 --- a/test/test_p2p_connection_pool.ml +++ b/test/test_p2p_connection_pool.ml @@ -182,6 +182,7 @@ let spec = Arg.[ let main () = let open Utils in + Logging.init Stderr >>= fun () -> let anon_fun num_peers = raise (Arg.Bad "No anonymous argument.") in let usage_msg = "Usage: %s .\nArguments are:" in Arg.parse spec anon_fun usage_msg ; @@ -191,7 +192,5 @@ let main () = let () = Sys.catch_break true ; - try - Logging.init Stderr ; - Lwt_main.run @@ main () + try Lwt_main.run @@ main () with _ -> () diff --git a/test/test_p2p_io_scheduler.ml b/test/test_p2p_io_scheduler.ml index e41fca204..0db147c3d 100644 --- a/test/test_p2p_io_scheduler.ml +++ b/test/test_p2p_io_scheduler.ml @@ -140,7 +140,7 @@ let run ?max_download_speed ?max_upload_speed ~read_buffer_size ?read_queue_size ?write_queue_size addr port time n = - Logging.init Stderr ; + Logging.init Stderr >>= fun () -> listen ?port addr >>= fun (main_socket, port) -> let server = Process.detach ~prefix:"server " begin fun () -> From a65ad526202e5abd0c5e41e364fbe263350d7858 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Gr=C3=A9goire=20Henry?= Date: Mon, 23 Jan 2017 11:09:39 +0100 Subject: [PATCH 08/16] Shell: improve `Lwt_utils` --- src/utils/lwt_utils.ml | 16 ++++++++++------ src/utils/lwt_utils.mli | 2 ++ 2 files changed, 12 insertions(+), 6 deletions(-) diff --git a/src/utils/lwt_utils.ml b/src/utils/lwt_utils.ml index 00f857ab9..ceb472d13 100644 --- a/src/utils/lwt_utils.ml +++ b/src/utils/lwt_utils.ml @@ -346,12 +346,14 @@ let remove_dir dir = Lwt.return () let rec create_dir ?(perm = 0o755) dir = - if Sys.file_exists dir then - Lwt.return () - else begin - create_dir (Filename.dirname dir) >>= fun () -> - Lwt_unix.mkdir dir perm - end + Lwt_unix.file_exists dir >>= function + | false -> + create_dir (Filename.dirname dir) >>= fun () -> + Lwt_unix.mkdir dir perm + | true -> + Lwt_unix.stat dir >>= function + | {st_kind = S_DIR} -> Lwt.return_unit + | _ -> failwith "Not a directory" let create_file ?(perm = 0o644) name content = Lwt_unix.openfile name Unix.([O_TRUNC; O_CREAT; O_WRONLY]) perm >>= fun fd -> @@ -402,4 +404,6 @@ let with_timeout ?(canceler = Canceler.create ()) timeout f = Canceler.cancel canceler >>= fun () -> fail Timeout +let unless cond f = + if cond then Lwt.return () else f () diff --git a/src/utils/lwt_utils.mli b/src/utils/lwt_utils.mli index 78cf995a2..14f48cf90 100644 --- a/src/utils/lwt_utils.mli +++ b/src/utils/lwt_utils.mli @@ -67,3 +67,5 @@ val with_timeout: ?canceler:Canceler.t -> float -> (Canceler.t -> 'a tzresult Lwt.t) -> 'a tzresult Lwt.t +val unless: bool -> (unit -> unit Lwt.t) -> unit Lwt.t + From 5e1eddf681b40d9883dbc10c4d7d5fdbb142ec59 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Gr=C3=A9goire=20Henry?= Date: Mon, 23 Jan 2017 11:09:45 +0100 Subject: [PATCH 09/16] Shell: Use Error_monad in `Data_encoding_ezjsonm` --- src/Makefile | 4 +-- src/client/client_aliases.ml | 8 ++--- .../embedded/bootstrap/client_proto_nonces.ml | 9 ++--- .../mining/client_mining_endorsement.ml | 8 ++--- .../bootstrap/mining/client_mining_forge.ml | 8 ++--- src/node/net/p2p_connection_pool.ml | 20 +++++------ src/node/net/p2p_connection_pool_types.ml | 8 +++-- src/node/net/p2p_connection_pool_types.mli | 4 +-- src/node_main.ml | 10 +++--- src/utils/data_encoding_ezjsonm.ml | 35 ++++++++++--------- src/utils/data_encoding_ezjsonm.mli | 6 ++-- src/utils/error_monad.ml | 25 +++++++++---- src/utils/error_monad.mli | 7 ++++ test/lib/assert.ml | 10 ++++++ test/lib/assert.mli | 4 +++ test/test_data_encoding.ml | 14 ++++---- 16 files changed, 109 insertions(+), 71 deletions(-) diff --git a/src/Makefile b/src/Makefile index 2617fc8af..e91e9af96 100644 --- a/src/Makefile +++ b/src/Makefile @@ -168,12 +168,12 @@ UTILS_LIB_INTFS := \ UTILS_LIB_IMPLS := \ utils/base48.ml \ utils/cli_entries.ml \ + utils/error_monad_sig.ml \ + utils/error_monad.ml \ utils/data_encoding_ezjsonm.ml \ utils/time.ml \ utils/hash.ml \ utils/crypto_box.ml \ - utils/error_monad_sig.ml \ - utils/error_monad.ml \ utils/lwt_exit.ml \ utils/logging.ml \ utils/lwt_utils.ml \ diff --git a/src/client/client_aliases.ml b/src/client/client_aliases.ml index 1a80cc78c..b4899d5de 100644 --- a/src/client/client_aliases.ml +++ b/src/client/client_aliases.ml @@ -88,10 +88,10 @@ module Alias = functor (Entity : Entity) -> struct let filename = filename () in if not (Sys.file_exists filename) then return [] else Data_encoding_ezjsonm.read_file filename >>= function - | None -> + | Error _ -> cctxt.Client_commands.error "couldn't to read the %s alias file" Entity.name - | Some json -> + | Ok json -> match Data_encoding.Json.destruct encoding json with | exception _ -> (* TODO print_error *) cctxt.Client_commands.error @@ -132,8 +132,8 @@ module Alias = functor (Entity : Entity) -> struct let filename = filename () in let json = Data_encoding.Json.construct encoding list in Data_encoding_ezjsonm.write_file filename json >>= function - | false -> fail (Failure "Json.write_file") - | true -> return ()) + | Error _ -> fail (Failure "Json.write_file") + | Ok () -> return ()) (fun exn -> cctxt.Client_commands.error "could not write the %s alias file: %s." diff --git a/src/client/embedded/bootstrap/client_proto_nonces.ml b/src/client/embedded/bootstrap/client_proto_nonces.ml index a9acf47f3..26e8af42a 100644 --- a/src/client/embedded/bootstrap/client_proto_nonces.ml +++ b/src/client/embedded/bootstrap/client_proto_nonces.ml @@ -29,8 +29,9 @@ let load cctxt = Lwt.return [] else Data_encoding_ezjsonm.read_file filename >>= function - | None -> cctxt.Client_commands.error "couldn't to read the nonces file" - | Some json -> + | Error _ -> + cctxt.Client_commands.error "couldn't to read the nonces file" + | Ok json -> match Data_encoding.Json.destruct encoding json with | exception _ -> (* TODO print_error *) cctxt.Client_commands.error "didn't understand the nonces file" @@ -51,8 +52,8 @@ let save cctxt list = let filename = filename () in let json = Data_encoding.Json.construct encoding list in Data_encoding_ezjsonm.write_file filename json >>= function - | false -> failwith "Json.write_file" - | true -> return ()) + | Error _ -> failwith "Json.write_file" + | Ok () -> return ()) (fun exn -> cctxt.Client_commands.error "could not write the nonces file: %s." (Printexc.to_string exn)) diff --git a/src/client/embedded/bootstrap/mining/client_mining_endorsement.ml b/src/client/embedded/bootstrap/mining/client_mining_endorsement.ml index 0d268a2c4..a9d005cf7 100644 --- a/src/client/embedded/bootstrap/mining/client_mining_endorsement.ml +++ b/src/client/embedded/bootstrap/mining/client_mining_endorsement.ml @@ -51,9 +51,9 @@ end = struct let filename = filename () in if not (Sys.file_exists filename) then return LevelMap.empty else Data_encoding_ezjsonm.read_file filename >>= function - | None -> + | Error _ -> cctxt.Client_commands.error "couldn't to read the endorsement file" - | Some json -> + | Ok json -> match Data_encoding.Json.destruct encoding json with | exception _ -> (* TODO print_error *) cctxt.Client_commands.error "didn't understand the endorsement file" @@ -69,8 +69,8 @@ end = struct let filename = filename () in let json = Data_encoding.Json.construct encoding map in Data_encoding_ezjsonm.write_file filename json >>= function - | false -> failwith "Json.write_file" - | true -> return ()) + | Error _ -> failwith "Json.write_file" + | Ok () -> return ()) (fun exn -> cctxt.Client_commands.error "could not write the endorsement file: %s." (Printexc.to_string exn)) diff --git a/src/client/embedded/bootstrap/mining/client_mining_forge.ml b/src/client/embedded/bootstrap/mining/client_mining_forge.ml index 3ea587027..e21ee087d 100644 --- a/src/client/embedded/bootstrap/mining/client_mining_forge.ml +++ b/src/client/embedded/bootstrap/mining/client_mining_forge.ml @@ -171,9 +171,9 @@ end = struct let filename = filename () in if not (Sys.file_exists filename) then return LevelMap.empty else Data_encoding_ezjsonm.read_file filename >>= function - | None -> + | Error _ -> failwith "couldn't to read the block file" - | Some json -> + | Ok json -> match Data_encoding.Json.destruct encoding json with | exception _ -> (* TODO print_error *) failwith "didn't understand the block file" @@ -189,8 +189,8 @@ end = struct let filename = filename () in let json = Data_encoding.Json.construct encoding map in Data_encoding_ezjsonm.write_file filename json >>= function - | false -> failwith "Json.write_file" - | true -> return ()) + | Error _ -> failwith "Json.write_file" + | Ok () -> return ()) (fun exn -> Error_monad.failwith "could not write the block file: %s." diff --git a/src/node/net/p2p_connection_pool.ml b/src/node/net/p2p_connection_pool.ml index dc437985a..53826a029 100644 --- a/src/node/net/p2p_connection_pool.ml +++ b/src/node/net/p2p_connection_pool.ml @@ -634,16 +634,16 @@ let create config meta_config message_config io_sched = events ; } in List.iter (Points.set_trusted pool) config.trusted_points ; - Lwt.catch - (fun () -> - Gid_info.File.load config.peers_file meta_config.encoding) - (fun _ -> - (* TODO log error *) - Lwt.return_nil) >>= fun gids -> - List.iter - (fun gi -> Gid.Table.add pool.known_gids (Gid_info.gid gi) gi) - gids ; - Lwt.return pool + Gid_info.File.load config.peers_file meta_config.encoding >>= function + | Ok gids -> + List.iter + (fun gi -> Gid.Table.add pool.known_gids (Gid_info.gid gi) gi) + gids ; + Lwt.return pool + | Error err -> + log_error "@[Failed to parsed peers file:@ %a@]" + pp_print_error err ; + Lwt.return pool let destroy pool = Point.Table.fold (fun _point pi acc -> diff --git a/src/node/net/p2p_connection_pool_types.ml b/src/node/net/p2p_connection_pool_types.ml index 2d48bed66..d2d0bec6c 100644 --- a/src/node/net/p2p_connection_pool_types.ml +++ b/src/node/net/p2p_connection_pool_types.ml @@ -449,9 +449,11 @@ module Gid_info = struct let load path metadata_encoding = let enc = Data_encoding.list (encoding metadata_encoding) in - Data_encoding_ezjsonm.read_file path >|= - map_option ~f:(Data_encoding.Json.destruct enc) >|= - unopt ~default:[] + if Sys.file_exists path then + Data_encoding_ezjsonm.read_file path >>=? fun json -> + return (Data_encoding.Json.destruct enc json) + else + return [] let save path metadata_encoding peers = let open Data_encoding in diff --git a/src/node/net/p2p_connection_pool_types.mli b/src/node/net/p2p_connection_pool_types.mli index 8c2c3a584..be56dcd56 100644 --- a/src/node/net/p2p_connection_pool_types.mli +++ b/src/node/net/p2p_connection_pool_types.mli @@ -256,10 +256,10 @@ module Gid_info : sig module File : sig val load : string -> 'meta Data_encoding.t -> - ('conn, 'meta) gid_info list Lwt.t + ('conn, 'meta) gid_info list tzresult Lwt.t val save : string -> 'meta Data_encoding.t -> - ('conn, 'meta) gid_info list -> bool Lwt.t + ('conn, 'meta) gid_info list -> unit tzresult Lwt.t end end diff --git a/src/node_main.ml b/src/node_main.ml index a2c9f9701..0d6ea52ad 100644 --- a/src/node_main.ml +++ b/src/node_main.ml @@ -238,8 +238,8 @@ module Cfg_file = struct let read fp = Data_encoding_ezjsonm.read_file fp >|= function - | None -> None - | Some json -> Some (Data_encoding.Json.destruct t json) + | Error _ -> None + | Ok json -> Some (Data_encoding.Json.destruct t json) let from_json json = Data_encoding.Json.destruct t json let write out cfg = @@ -439,12 +439,12 @@ let init_node | None -> Lwt.return (Some (patch_context None)) | Some file -> Data_encoding_ezjsonm.read_file file >>= function - | None -> + | Error _ -> lwt_warn "Can't parse sandbox parameters. (%s)" file >>= fun () -> Lwt.return (Some (patch_context None)) - | Some _ as json -> - Lwt.return (Some (patch_context json)) + | Ok json -> + Lwt.return (Some (patch_context (Some json))) end >>= fun patch_context -> let net_params = let open P2p in diff --git a/src/utils/data_encoding_ezjsonm.ml b/src/utils/data_encoding_ezjsonm.ml index 0b3c36ebf..8fb4ffcc8 100644 --- a/src/utils/data_encoding_ezjsonm.ml +++ b/src/utils/data_encoding_ezjsonm.ml @@ -7,6 +7,8 @@ (* *) (**************************************************************************) +open Error_monad + let to_root = function | `O ctns -> `O ctns | `A ctns -> `A ctns @@ -35,22 +37,21 @@ let from_stream (stream: string Lwt_stream.t) = let write_file file json = let json = to_root json in - let open Lwt in - catch - (fun () -> - Lwt_io.(with_file ~mode:Output file (fun chan -> - let str = to_string json in - write chan str >>= fun _ -> - return true))) - (fun _ -> return false) + protect begin fun () -> + Lwt_io.with_file ~mode:Output file begin fun chan -> + let str = to_string json in + Lwt_io.write chan str >>= fun _ -> + return () + end + end let read_file file = - let open Lwt in - catch - (fun () -> - Lwt_io.(with_file ~mode:Input file (fun chan -> - read chan >>= fun str -> - return (Some (Ezjsonm.from_string str :> Data_encoding.json))))) - (fun _ -> - (* TODO log error or use Error_monad. *) - return None) + protect begin fun () -> + Lwt_io.with_file ~mode:Input file begin fun chan -> + Lwt_io.read chan >>= fun str -> + return (Ezjsonm.from_string str :> Data_encoding.json) + end + end + +let () = + Error_monad.json_to_string := to_string diff --git a/src/utils/data_encoding_ezjsonm.mli b/src/utils/data_encoding_ezjsonm.mli index a195f10a0..51b41776b 100644 --- a/src/utils/data_encoding_ezjsonm.mli +++ b/src/utils/data_encoding_ezjsonm.mli @@ -7,6 +7,8 @@ (* *) (**************************************************************************) +open Error_monad + (** Read a JSON document from a string. *) val from_string : string -> (Data_encoding.json, string) result @@ -20,7 +22,7 @@ val from_stream : string Lwt_stream.t -> (Data_encoding.json, string) result Lwt val to_string : Data_encoding.json -> string (** Loads a JSON file in memory *) -val read_file : string -> Data_encoding.json option Lwt.t +val read_file : string -> Data_encoding.json tzresult Lwt.t (** (Over)write a JSON file from in memory data *) -val write_file : string -> Data_encoding.json -> bool Lwt.t +val write_file : string -> Data_encoding.json -> unit tzresult Lwt.t diff --git a/src/utils/error_monad.ml b/src/utils/error_monad.ml index 45d84349d..e67c27b9c 100644 --- a/src/utils/error_monad.ml +++ b/src/utils/error_monad.ml @@ -16,10 +16,13 @@ type error_category = [ `Branch | `Temporary | `Permanent ] type 'err full_error_category = [ error_category | `Wrapped of 'err -> error_category ] +(* HACK: forward reference from [Data_encoding_ezjsonm] *) +let json_to_string = ref (fun _ -> "") + let json_pp encoding ppf x = Format.pp_print_string ppf @@ - Data_encoding_ezjsonm.to_string @@ - Data_encoding.Json.(construct encoding x) + !json_to_string @@ + Data_encoding.Json.construct encoding x module Make() = struct @@ -174,11 +177,6 @@ module Make() = struct let fail s = Lwt.return (Error [ s ]) - let protect ~on_error t = - t >>= function - | Ok res -> return res - | Error err -> on_error err - let (>>?) v f = match v with | Error _ as err -> err @@ -325,6 +323,11 @@ let () = error_kinds := Error_kind { id; from_error ; category; encoding_case ; pp } :: !error_kinds +let protect ~on_error t = + t >>= function + | Ok res -> return res + | Error err -> on_error err + end include Make() @@ -340,6 +343,14 @@ let error_exn s = Error [ Exn s ] let trace_exn exn f = trace (Exn exn) f let record_trace_exn exn f = record_trace (Exn exn) f +let protect ?on_error t = + Lwt.catch t (fun exn -> fail (Exn exn)) >>= function + | Ok res -> return res + | Error err -> + match on_error with + | Some f -> f err + | None -> Lwt.return (Error err) + let pp_exn ppf exn = pp ppf (Exn exn) let () = diff --git a/src/utils/error_monad.mli b/src/utils/error_monad.mli index 11e607101..141dedd47 100644 --- a/src/utils/error_monad.mli +++ b/src/utils/error_monad.mli @@ -26,6 +26,10 @@ val failwith : ('a, Format.formatter, unit, 'b tzresult Lwt.t) format4 -> 'a +val protect : + ?on_error: (error list -> 'a tzresult Lwt.t) -> + (unit -> 'a tzresult Lwt.t) -> 'a tzresult Lwt.t + val error_exn : exn -> 'a tzresult val record_trace_exn : exn -> 'a tzresult -> 'a tzresult val trace_exn : exn -> 'b tzresult Lwt.t -> 'b tzresult Lwt.t @@ -35,3 +39,6 @@ type error += Exn of exn type error += Unclassified of string module Make() : Error_monad_sig.S + +(**/**) +val json_to_string : (Data_encoding.json -> string) ref diff --git a/test/lib/assert.ml b/test/lib/assert.ml index 8201fdf82..707179f0f 100644 --- a/test/lib/assert.ml +++ b/test/lib/assert.ml @@ -14,6 +14,16 @@ include Kaputt.Assertion let format_msg = function None -> None | Some msg -> Some (msg ^ "\n") +let is_error ?(msg="") x = + match x with + | Error _ -> () + | Ok _ -> fail "Error _" "Ok _" msg + +let is_ok ?(msg="") x = + match x with + | Ok _ -> () + | Error _ -> fail "Ok _" "Error _" msg + let equal_persist_list ?msg l1 l2 = let msg = format_msg msg in let pr_persist l = diff --git a/test/lib/assert.mli b/test/lib/assert.mli index 28ee6a19f..7c01a393c 100644 --- a/test/lib/assert.mli +++ b/test/lib/assert.mli @@ -8,8 +8,12 @@ (**************************************************************************) open Hash +open Error_monad include (module type of struct include Kaputt.Assertion end) +val is_ok : ?msg:string -> 'a tzresult -> unit +val is_error : ?msg:string -> 'a tzresult -> unit + val fail_msg : ('a, Format.formatter, unit, 'b) format4 -> 'a val fail : string -> string -> ('a, Format.formatter, unit, 'b) format4 -> 'a diff --git a/test/test_data_encoding.ml b/test/test_data_encoding.ml index 848419be9..1d264c358 100644 --- a/test/test_data_encoding.ml +++ b/test/test_data_encoding.ml @@ -110,11 +110,11 @@ let test_json testdir = let f_str = to_string v in Assert.equal_string ~msg:__LOC__ f_str "[\n 42\n]"; read_file (testdir // "NONEXISTINGFILE") >>= fun rf -> - Assert.is_none ~msg:__LOC__ rf; + Assert.is_error ~msg:__LOC__ rf ; write_file file v >>= fun success -> - Assert.is_true ~msg:__LOC__ success; + Assert.is_ok ~msg:__LOC__ success ; read_file file >>= fun opt -> - Assert.is_some ~msg:__LOC__ opt; + Assert.is_ok ~msg:__LOC__ opt ; Lwt.return () type t = A of int | B of string | C of int | D of string | E @@ -269,8 +269,8 @@ let test_json_input testdir = |} in Data_encoding_ezjsonm.read_file file >>= function - None -> Assert.fail_msg "Cannot parse \"good.json\"." - | Some json -> + | Error _ -> Assert.fail_msg "Cannot parse \"good.json\"." + | Ok json -> let (id, value, popup) = Json.destruct enc json in Assert.equal_string ~msg:__LOC__ "file" id; Assert.equal_string ~msg:__LOC__ "File" value; @@ -295,8 +295,8 @@ let test_json_input testdir = |} in Data_encoding_ezjsonm.read_file file >>= function - None -> Assert.fail_msg "Cannot parse \"unknown.json\"." - | Some json -> + | Error _ -> Assert.fail_msg "Cannot parse \"unknown.json\"." + | Ok json -> Assert.test_fail ~msg:__LOC__ (fun () -> ignore (Json.destruct enc json)) (function From 3a70d88fe606355e0121a74fa03932f364288b66 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Gr=C3=A9goire=20Henry?= Date: Mon, 23 Jan 2017 11:09:48 +0100 Subject: [PATCH 10/16] Shell: animated generation of `P2p.Identity` --- src/node/net/p2p_types.ml | 47 ++++++++++++++++++++++++++++++++++++-- src/node/net/p2p_types.mli | 6 +++++ src/utils/crypto_box.ml | 17 ++++++++++---- src/utils/crypto_box.mli | 2 +- 4 files changed, 64 insertions(+), 8 deletions(-) diff --git a/src/node/net/p2p_types.ml b/src/node/net/p2p_types.ml index 5ed7ded49..f8b8690fa 100644 --- a/src/node/net/p2p_types.ml +++ b/src/node/net/p2p_types.ml @@ -193,12 +193,55 @@ module Identity = struct (req "secret_key" Crypto_box.secret_key_encoding) (req "proof_of_work_stamp" Crypto_box.nonce_encoding)) - let generate target = + let generate ?max target = let secret_key, public_key, gid = Crypto_box.random_keypair () in let proof_of_work_stamp = - Crypto_box.generate_proof_of_work public_key target in + Crypto_box.generate_proof_of_work ?max public_key target in { gid ; public_key ; secret_key ; proof_of_work_stamp } + let animation = [| + "|.....|" ; + "|o....|" ; + "|oo...|" ; + "|ooo..|" ; + "|.ooo.|" ; + "|..ooo|" ; + "|...oo|" ; + "|....o|" ; + "|.....|" ; + "|.....|" ; + "|.....|" ; + "|.....|" ; + |] + + let init = String.make (String.length animation.(0)) '\ ' + let clean = String.make (String.length animation.(0)) '\b' + let animation = Array.map (fun x -> clean ^ x) animation + let animation_size = Array.length animation + let duration = 1200 / animation_size + + let generate_with_animation ppf target = + Format.fprintf ppf "%s%!" init ; + let count = ref 10000 in + let rec loop n = + let start = Mtime.counter () in + Format.fprintf ppf "%s%!" animation.(n mod animation_size); + try generate ~max:!count target + with Not_found -> + let time = Mtime.to_ms (Mtime.count start) in + count := + if time <= 0. then + !count * 10 + else + !count * duration / int_of_float time ; + loop (n+1) + in + let id = loop 0 in + Format.fprintf ppf "%s%s\n%!" clean init ; + id + + let generate target = generate target + end module Connection_info = struct diff --git a/src/node/net/p2p_types.mli b/src/node/net/p2p_types.mli index f85ed323a..a09283a69 100644 --- a/src/node/net/p2p_types.mli +++ b/src/node/net/p2p_types.mli @@ -94,6 +94,12 @@ module Identity : sig val generate : Crypto_box.target -> t (** [generate target] is a freshly minted identity whose proof of work stamp difficulty is at least equal to [target]. *) + + val generate_with_animation : + Format.formatter -> Crypto_box.target -> t + (** [generate_with_animation ppf target] is a freshly minted identity + whose proof of work stamp difficulty is at least equal to [target]. *) + end diff --git a/src/utils/crypto_box.ml b/src/utils/crypto_box.ml index e8d58a80d..8e9cefe63 100644 --- a/src/utils/crypto_box.ml +++ b/src/utils/crypto_box.ml @@ -71,11 +71,18 @@ let check_proof_of_work pk nonce target = ] in compare_target hash target -let generate_proof_of_work pk target = - let rec loop nonce = - if check_proof_of_work pk nonce target then nonce - else loop (increment_nonce nonce) in - loop (random_nonce ()) +let generate_proof_of_work ?max pk target = + let may_interupt = + match max with + | None -> (fun _ -> ()) + | Some max -> (fun cpt -> if max < cpt then raise Not_found) in + let rec loop nonce cpt = + may_interupt cpt ; + if check_proof_of_work pk nonce target then + nonce + else + loop (increment_nonce nonce) (cpt + 1) in + loop (random_nonce ()) 0 let public_key_encoding = let open Data_encoding in diff --git a/src/utils/crypto_box.mli b/src/utils/crypto_box.mli index 0ae416919..cbeedd440 100644 --- a/src/utils/crypto_box.mli +++ b/src/utils/crypto_box.mli @@ -38,5 +38,5 @@ val fast_box : channel_key -> MBytes.t -> nonce -> MBytes.t val fast_box_open : channel_key -> MBytes.t -> nonce -> MBytes.t option val check_proof_of_work : public_key -> nonce -> target -> bool -val generate_proof_of_work : public_key -> target -> nonce +val generate_proof_of_work : ?max:int -> public_key -> target -> nonce From 197ac28f0b584b439c9c2014a50b0f502662fb26 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Gr=C3=A9goire=20Henry?= Date: Mon, 23 Jan 2017 11:09:51 +0100 Subject: [PATCH 11/16] Shell: Add `Cryptobox.target_of_float` [target_of_float f] is `2 ^ (256 - f)`. --- src/node/net/p2p.ml | 2 +- src/utils/crypto_box.ml | 39 ++++++++++++++++++++++----------------- src/utils/crypto_box.mli | 2 +- 3 files changed, 24 insertions(+), 19 deletions(-) diff --git a/src/node/net/p2p.ml b/src/node/net/p2p.ml index 87d9352b3..b5713b0a1 100644 --- a/src/node/net/p2p.ml +++ b/src/node/net/p2p.ml @@ -224,7 +224,7 @@ end module Fake = struct - let id = Identity.generate Crypto_box.default_target + let id = Identity.generate (Crypto_box.make_target 0.) let empty_stat = { Stat.total_sent = 0 ; total_recv = 0 ; diff --git a/src/utils/crypto_box.ml b/src/utils/crypto_box.ml index 8e9cefe63..d3d1d4a0a 100644 --- a/src/utils/crypto_box.ml +++ b/src/utils/crypto_box.ml @@ -15,7 +15,7 @@ type secret_key = Sodium.Box.secret_key type public_key = Sodium.Box.public_key type channel_key = Sodium.Box.channel_key type nonce = Sodium.Box.nonce -type target = int64 list (* used as unsigned intergers... *) +type target = Z.t exception TargetNot256Bit module Public_key_hash = Hash.Make_Blake2B (Base48) (struct @@ -44,24 +44,29 @@ let fast_box_open ck msg nonce = try Some (Sodium.Box.Bigbytes.fast_box_open ck msg nonce) with | Sodium.Verification_failure -> None -let make_target target = - if List.length target > 8 then raise TargetNot256Bit ; - target - -(* Compare a SHA256 hash to a 256bits-target prefix. - The prefix is a list of "unsigned" int64. *) let compare_target hash target = - let hash = Hash.Generic_hash.to_string hash in - let rec check offset = function - | [] -> true - | x :: xs -> - Compare.Uint64.(EndianString.BigEndian.get_int64 hash offset <= x) - && check (offset + 8) xs in - check 0 target + let hash = Z.of_bits (Hash.Generic_hash.to_string hash) in + Z.compare hash target <= 0 -let default_target = - (* FIXME we use an easy target until we allow custom configuration. *) - [ Int64.shift_left 1L 48 ] +let make_target f = + if f < 0. || 256. < f then invalid_arg "Cryptobox.target_of_float" ; + let frac, shift = modf f in + let shift = int_of_float shift in + let m = + Z.of_int64 @@ + if frac = 0. then + Int64.(pred (shift_left 1L 54)) + else + Int64.of_float (2. ** (54. -. frac)) + in + if shift < 202 then + Z.logor + (Z.shift_left m (202 - shift)) + (Z.pred @@ Z.shift_left Z.one (202 - shift)) + else + Z.shift_right m (shift - 202) + +let default_target = make_target 24. let check_proof_of_work pk nonce target = let hash = diff --git a/src/utils/crypto_box.mli b/src/utils/crypto_box.mli index cbeedd440..487f3f56f 100644 --- a/src/utils/crypto_box.mli +++ b/src/utils/crypto_box.mli @@ -16,8 +16,8 @@ val increment_nonce : ?step:int -> nonce -> nonce val nonce_encoding : nonce Data_encoding.t type target -val make_target : (* unsigned *) Int64.t list -> target val default_target : target +val make_target : float -> target type secret_key type public_key From 5266671c72a52cee5e4880676ba7b2d0cdc7872e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Gr=C3=A9goire=20Henry?= Date: Mon, 23 Jan 2017 22:01:18 +0100 Subject: [PATCH 12/16] Fix POW --- test/test_p2p_connection.ml | 5 ++--- test/test_p2p_connection_pool.ml | 2 +- 2 files changed, 3 insertions(+), 4 deletions(-) diff --git a/test/test_p2p_connection.ml b/test/test_p2p_connection.ml index 2dda0293a..c0d6dbf19 100644 --- a/test/test_p2p_connection.ml +++ b/test/test_p2p_connection.ml @@ -14,14 +14,13 @@ open Error_monad open P2p_types include Logging.Make (struct let name = "test-p2p-connection" end) -let proof_of_work_target = - Crypto_box.make_target [Int64.shift_left 1L 48] +let proof_of_work_target = Crypto_box.make_target 16. let id1 = Identity.generate proof_of_work_target let id2 = Identity.generate proof_of_work_target let id0 = (* Luckilly, this will be an insuficient proof of work! *) - Identity.generate (Crypto_box.make_target []) + Identity.generate (Crypto_box.make_target 0.) let versions = Version.[{ name = "TEST" ; minor = 0 ; major = 0 }] diff --git a/test/test_p2p_connection_pool.ml b/test/test_p2p_connection_pool.ml index f46541a47..4663e9a5e 100644 --- a/test/test_p2p_connection_pool.ml +++ b/test/test_p2p_connection_pool.ml @@ -126,7 +126,7 @@ let run_net config repeat points addr port = let make_net points repeat n = let point, points = Utils.select n points in - let proof_of_work_target = Crypto_box.make_target [] in + let proof_of_work_target = Crypto_box.make_target 0. in let identity = Identity.generate proof_of_work_target in let config = P2p_connection_pool.{ identity ; From c87e88d84d5b9e8b0dfd43de44efdefdcdfc72c7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Gr=C3=A9goire=20Henry?= Date: Mon, 23 Jan 2017 11:09:55 +0100 Subject: [PATCH 13/16] Shell: minor fix in RPC description --- src/node/shell/node_rpc_services.ml | 103 ++++++++++++++-------------- 1 file changed, 51 insertions(+), 52 deletions(-) diff --git a/src/node/shell/node_rpc_services.ml b/src/node/shell/node_rpc_services.ml index 393b3ad49..b64dd2540 100644 --- a/src/node/shell/node_rpc_services.ml +++ b/src/node/shell/node_rpc_services.ml @@ -555,25 +555,23 @@ let inject_operation = RPCs ubder /blocks/prevalidation for more details on the \ prevalidation context." ~input: - (conv - (fun (block, blocking, force) -> (block, Some blocking, force)) - (fun (block, blocking, force) -> (block, unopt ~default:true blocking, force)) - (obj3 - (req "signedOperationContents" - (describe ~title: "Tezos signed operation (hex encoded)" - bytes)) - (opt "blocking" - (describe - ~description: - "Should the RPC wait for the operation to be \ - (pre-)validated before to answer. (default: true)" - bool)) - (opt "force" - (describe - ~description: - "Should we inject operation that are \"branch_refused\" \ - or \"branch_delayed\". (default: false)" - bool)))) + (obj3 + (req "signedOperationContents" + (describe ~title: "Tezos signed operation (hex encoded)" + bytes)) + (dft "blocking" + (describe + ~description: + "Should the RPC wait for the operation to be \ + (pre-)validated before to answer. (default: true)" + bool) + true) + (opt "force" + (describe + ~description: + "Should we inject operation that are \"branch_refused\" \ + or \"branch_delayed\". (default: false)" + bool))) ~output: (Error.wrap @@ describe @@ -582,21 +580,6 @@ let inject_operation = RPC.Path.(root / "inject_operation") let inject_protocol = - let proto = - (list - (obj3 - (req "name" - (describe ~title:"OCaml module name" - string)) - (opt "interface" - (describe - ~description:"Content of the .mli file" - string)) - (req "implementation" - (describe - ~description:"Content of the .ml file" - string)))) - in let proto_of_rpc = List.map (fun (name, interface, implementation) -> { Tezos_compiler.Protocol.name; interface; implementation }) @@ -605,28 +588,44 @@ let inject_protocol = List.map (fun { Tezos_compiler.Protocol.name; interface; implementation } -> (name, interface, implementation)) in + let proto = + conv + rpc_of_proto + proto_of_rpc + (list + (obj3 + (req "name" + (describe ~title:"OCaml module name" + string)) + (opt "interface" + (describe + ~description:"Content of the .mli file" + string)) + (req "implementation" + (describe + ~description:"Content of the .ml file" + string)))) + in RPC.service ~description: "Inject a protocol in node. Returns the ID of the protocol." ~input: - (conv - (fun (proto, blocking, force) -> (rpc_of_proto proto, Some blocking, force)) - (fun (proto, blocking, force) -> (proto_of_rpc proto, unopt ~default:true blocking, force)) - (obj3 - (req "protocol" - (describe ~title: "Tezos protocol" - proto)) - (opt "blocking" - (describe - ~description: - "Should the RPC wait for the protocol to be \ - validated before to answer. (default: true)" - bool)) - (opt "force" - (describe - ~description: - "Should we inject protocol that is invalid. (default: false)" - bool)))) + (obj3 + (req "protocol" + (describe ~title: "Tezos protocol" + proto)) + (dft "blocking" + (describe + ~description: + "Should the RPC wait for the protocol to be \ + validated before to answer. (default: true)" + bool) + true) + (opt "force" + (describe + ~description: + "Should we inject protocol that is invalid. (default: false)" + bool))) ~output: (Error.wrap @@ describe From 5ee3581d6087dbedf44d9bf2e6cd68b24e740143 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Gr=C3=A9goire=20Henry?= Date: Mon, 23 Jan 2017 11:09:59 +0100 Subject: [PATCH 14/16] P2p: fix in `P2p_maintenance` --- src/node/net/p2p_maintenance.ml | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/node/net/p2p_maintenance.ml b/src/node/net/p2p_maintenance.ml index 2cae195dc..1ff34c9f0 100644 --- a/src/node/net/p2p_maintenance.ml +++ b/src/node/net/p2p_maintenance.ml @@ -79,6 +79,7 @@ let rec try_to_contact let contactable = connectable st start_time max_to_contact in if contactable = [] then + Lwt_unix.yield () >>= fun () -> Lwt.return_false else List.fold_left @@ -111,11 +112,11 @@ let rec maintain st = and too_few_connections st n_connected = let Pool pool = st.pool in (* too few connections, try and contact many peers *) - lwt_debug "Too few connections (%d)" n_connected >>= fun () -> + lwt_log_notice "Too few connections (%d)" n_connected >>= fun () -> let min_to_contact = st.bounds.min_target - n_connected in let max_to_contact = st.bounds.max_target - n_connected in - try_to_contact st min_to_contact max_to_contact >>= fun continue -> - if not continue then begin + try_to_contact st min_to_contact max_to_contact >>= fun success -> + if success then begin maintain st end else begin (* not enough contacts, ask the pals of our pals, From 2da0c83b5a898d986218011f4f775b5fcf305206 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Gr=C3=A9goire=20Henry?= Date: Mon, 23 Jan 2017 11:10:02 +0100 Subject: [PATCH 15/16] P2p: postpone the first maintenance step. --- src/node/net/p2p.ml | 3 +-- src/node/net/p2p.mli | 2 +- src/node/shell/node.ml | 31 ++++++++++++++++++------------- src/node/shell/tezos_p2p.ml | 4 ++-- src/node/shell/tezos_p2p.mli | 2 +- 5 files changed, 23 insertions(+), 19 deletions(-) diff --git a/src/node/net/p2p.ml b/src/node/net/p2p.ml index b5713b0a1..94be084e8 100644 --- a/src/node/net/p2p.ml +++ b/src/node/net/p2p.ml @@ -261,9 +261,8 @@ type ('msg, 'meta) t = { } type ('msg, 'meta) net = ('msg, 'meta) t -let bootstrap ~config ~limits meta_cfg msg_cfg = +let create ~config ~limits meta_cfg msg_cfg = Real.create ~config ~limits meta_cfg msg_cfg >>= fun net -> - Real.maintain net () >>= fun () -> Lwt.return { gid = Real.gid net ; maintain = Real.maintain net ; diff --git a/src/node/net/p2p.mli b/src/node/net/p2p.mli index 06b3dc93e..b74f36fe1 100644 --- a/src/node/net/p2p.mli +++ b/src/node/net/p2p.mli @@ -124,7 +124,7 @@ type ('msg, 'meta) net = ('msg, 'meta) t val faked_network : ('msg, 'meta) net (** Main network initialisation function *) -val bootstrap : +val create : config:config -> limits:limits -> 'meta meta_config -> 'msg message_config -> ('msg, 'meta) net Lwt.t diff --git a/src/node/shell/node.ml b/src/node/shell/node.ml index e54e5d678..aa8d16c55 100644 --- a/src/node/shell/node.ml +++ b/src/node/shell/node.ml @@ -211,7 +211,10 @@ let init_p2p net_params = Lwt.return Tezos_p2p.faked_network | Some (config, limits) -> lwt_log_notice "bootstraping network..." >>= fun () -> - Tezos_p2p.bootstrap config limits + Tezos_p2p.create config limits >>= fun p2p -> + Lwt.async (fun () -> Tezos_p2p.maintain p2p) ; + Lwt.return p2p + let create ~genesis ~store_root ~context_root ?test_protocol ?patch_context net_params = @@ -234,11 +237,12 @@ let create end >>=? fun global_net -> Validator.activate validator global_net >>= fun global_validator -> let cleanup () = + Tezos_p2p.shutdown p2p >>= fun () -> Lwt.join [ Validator.shutdown validator ; Discoverer.shutdown discoverer ] >>= fun () -> State.store state in - + let canceler = Lwt_utils.Canceler.create () in lwt_log_info "starting worker..." >>= fun () -> let worker = let handle_msg peer msg = @@ -249,22 +253,23 @@ let create Lwt.return_unit in let rec worker_loop () = - Tezos_p2p.recv p2p >>= fun (peer, msg) -> + Lwt_utils.protect ~canceler begin fun () -> + Tezos_p2p.recv p2p >>= return + end >>=? fun (peer, msg) -> handle_msg peer msg >>= fun () -> worker_loop () in - Lwt.catch - worker_loop - (function - | Queue.Empty -> cleanup () - | exn -> - lwt_log_error "unexpected exception in worker\n%s" - (Printexc.to_string exn) >>= fun () -> - Tezos_p2p.shutdown p2p >>= fun () -> - cleanup ()) + worker_loop () >>= function + | Error [Lwt_utils.Canceled] | Ok () -> + cleanup () + | Error err -> + lwt_log_error + "@[Unexpected error in worker@ %a@]" + pp_print_error err >>= fun () -> + cleanup () in let shutdown () = lwt_log_info "stopping worker..." >>= fun () -> - Tezos_p2p.shutdown p2p >>= fun () -> + Lwt_utils.Canceler.cancel canceler >>= fun () -> worker >>= fun () -> lwt_log_info "stopped" in diff --git a/src/node/shell/tezos_p2p.ml b/src/node/shell/tezos_p2p.ml index 0b4ef48d2..26ffe1d3a 100644 --- a/src/node/shell/tezos_p2p.ml +++ b/src/node/shell/tezos_p2p.ml @@ -106,8 +106,8 @@ and msg_cfg : _ P2p.message_config = { type net = (Message.t, Metadata.t) P2p.net -let bootstrap ~config ~limits = - P2p.bootstrap ~config ~limits meta_cfg msg_cfg +let create ~config ~limits = + P2p.create ~config ~limits meta_cfg msg_cfg let broadcast = P2p.broadcast let try_send = P2p.try_send diff --git a/src/node/shell/tezos_p2p.mli b/src/node/shell/tezos_p2p.mli index db1344baa..0f1111e40 100644 --- a/src/node/shell/tezos_p2p.mli +++ b/src/node/shell/tezos_p2p.mli @@ -8,7 +8,7 @@ type net val faked_network : net (** Main network initialisation function *) -val bootstrap : config:config -> limits:limits -> net Lwt.t +val create : config:config -> limits:limits -> net Lwt.t (** A maintenance operation : try and reach the ideal number of peers *) val maintain : net -> unit Lwt.t From b228904bc72943bc639bbca18097f5c460ae01ca Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Gr=C3=A9goire=20Henry?= Date: Mon, 23 Jan 2017 11:10:07 +0100 Subject: [PATCH 16/16] Node: more CLI argument --- README.md | 39 +- src/node/net/p2p_connection_pool_types.ml | 2 +- src/node/shell/node.ml | 12 +- src/node/shell/node.mli | 18 +- src/node_main.ml | 1105 +++++++++++++-------- test/test-basic.sh | 8 +- test/test_basic.ml | 4 +- 7 files changed, 737 insertions(+), 451 deletions(-) diff --git a/README.md b/README.md index 433ee3895..55d991134 100644 --- a/README.md +++ b/README.md @@ -61,7 +61,7 @@ Running the node in a sandbox To run a single instance of a Tezos node in sandbox mode: ``` -./tezos-node --sandbox /path/to/a/custom/data/dir --rpc-addr :::8732 +./tezos-node --sandbox --rpc-addr :::8732 ``` This "sandboxed" node will not participate in the P2P network, but will accept @@ -77,20 +77,22 @@ test network. Use the following command to run a node that will accept incoming connections: ``` -./tezos-node +./tezos-node --generate-identity --expected-pow 24. ``` -The node will listen to connections coming in on `0.0.0.0:9732` (and -`[::]:9732`). All used data is stored at `$HOME/.tezos-node/`. For example, -the default configuration file is at `$HOME/.tezos-node/config`. +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 +`$HOME/.tezos-node/`. For example, the default configuration file is +at `$HOME/.tezos-node/config.json`. To run multiple nodes on the same machine, you can duplicate and edit -`$HOME/.tezos-node/config` while making sure they don't share paths to the +`$HOME/.tezos-node/config.json` while making sure they don't share paths to the database or any other data file (cf. options `db.store` ; `db.context` ; -`net.peers` and `protocol.dir`). +`db.protocol`, `net.peers-metadata` and `net.identity`). You could also let Tezos generate a config file by specifying options on the -command line. For instance, if `$dir/config` does not exist, the following +command line. For instance, if `$dir/config.json` does not exist, the following command will generate it and replace the default values with the values from the command line: @@ -102,20 +104,23 @@ The Tezos server has a built-in mechanism to discover peers on the local network (using UDP packets broadcasted on port 7732). If this mechanism is not sufficient, one can provide Tezos with a list of -initial peers, either by editing the option `net.bootstrap.peers` in the -`config` file, or by specifying a command line parameter: +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 ``` -If `"$dir"/config` exists, the command line options override those read in the -config file. Tezos won't modify the content of an existing `"$dir"/config` -file. +If `"$dir"/config.json` exists, the command line options override those +read in the config file. By default, Tezos won't modify the content of an +existing `"$dir"/config.json` file. But, you may explicit ask the node +to reset or to update the file according to the command line parameters +with the following commands line: ``` -./tezos-node --config-file "$dir"/config +./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 ``` @@ -129,7 +134,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 /path/to/a/custom/data/dir --rpc-addr :::8732 +./tezos-node --sandbox --rpc-addr :::8732 ``` The RPC interface is self-documented and the `tezos-client` executable is able @@ -151,7 +156,7 @@ You might also want the JSON schema describing the expected input and output of a RPC. For instance: ``` -./tezos-client rpc schema /block/genesis/hash +./tezos-client rpc schema /blocks/genesis/hash ``` Note: you can get the same information, but as a raw JSON object, with a simple @@ -170,4 +175,4 @@ The minimal CLI client Work in progress. -See `./tezos-client -help` for available commands. \ No newline at end of file +See `./tezos-client -help` for available commands. diff --git a/src/node/net/p2p_connection_pool_types.ml b/src/node/net/p2p_connection_pool_types.ml index d2d0bec6c..dabbc5a96 100644 --- a/src/node/net/p2p_connection_pool_types.ml +++ b/src/node/net/p2p_connection_pool_types.ml @@ -449,7 +449,7 @@ module Gid_info = struct let load path metadata_encoding = let enc = Data_encoding.list (encoding metadata_encoding) in - if Sys.file_exists path then + if path <> "/dev/null" && Sys.file_exists path then Data_encoding_ezjsonm.read_file path >>=? fun json -> return (Data_encoding.Json.destruct enc json) else diff --git a/src/node/shell/node.ml b/src/node/shell/node.ml index aa8d16c55..6adccc162 100644 --- a/src/node/shell/node.ml +++ b/src/node/shell/node.ml @@ -215,9 +215,17 @@ let init_p2p net_params = Lwt.async (fun () -> Tezos_p2p.maintain p2p) ; Lwt.return p2p +type config = { + genesis: Store.genesis ; + store_root: string ; + context_root: string ; + test_protocol: Protocol_hash.t option ; + patch_context: (Context.t -> Context.t Lwt.t) option ; + p2p: (P2p.config * P2p.limits) option ; +} -let create - ~genesis ~store_root ~context_root ?test_protocol ?patch_context net_params = +let create { genesis ; store_root ; context_root ; + test_protocol ; patch_context ; p2p = net_params } = lwt_debug "-> Node.create" >>= fun () -> init_p2p net_params >>= fun p2p -> lwt_log_info "reading state..." >>= fun () -> diff --git a/src/node/shell/node.mli b/src/node/shell/node.mli index 997b71ca9..c21398043 100644 --- a/src/node/shell/node.mli +++ b/src/node/shell/node.mli @@ -9,14 +9,16 @@ type t -val create: - genesis:Store.genesis -> - store_root:string -> - context_root:string -> - ?test_protocol:Protocol_hash.t -> - ?patch_context:(Context.t -> Context.t Lwt.t) -> - (P2p.config * P2p.limits) option -> - t tzresult Lwt.t +type config = { + genesis: Store.genesis ; + store_root: string ; + context_root: string ; + test_protocol: Protocol_hash.t option ; + patch_context: (Context.t -> Context.t Lwt.t) option ; + p2p: (P2p.config * P2p.limits) option ; +} + +val create: config -> t tzresult Lwt.t module RPC : sig diff --git a/src/node_main.ml b/src/node_main.ml index 0d6ea52ad..8fd695584 100644 --- a/src/node_main.ml +++ b/src/node_main.ml @@ -9,9 +9,18 @@ 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" @@ -33,357 +42,557 @@ let genesis = { protocol = genesis_protocol ; } -let (//) = Filename.concat +module Sockaddr = struct -let home = - try Sys.getenv "HOME" - with Not_found -> "/root" + type t = V6.t * int -let default_base_dir = home // ".tezos-node" + 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) -type cfg = { - (* cli *) - base_dir : string ; - sandbox : string option ; - sandbox_param : string option ; + let of_string_exn str = + match of_string str with + | `Ok saddr -> saddr + | `Error msg -> invalid_arg msg - (* db *) + 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 ; - - (* net *) - min_connections : int ; - max_connections : int ; - expected_connections : int ; - net_addr : V6.t ; - net_port : int ; - (* local_discovery : (string * int) option ; *) - peers : (V6.t * int) list ; - peers_cache : string ; - closed : bool ; - - (* rpc *) - rpc_addr : (V6.t * int) option ; - cors_origins : string list ; - cors_headers : string list ; - rpc_crt : string option ; - rpc_key : string option ; - - (* log *) - log_output : [`Stderr | `File of string | `Syslog | `Null] ; - log_level : Lwt_log.level option ; } -let default_cfg_of_base_dir base_dir = { - (* cli *) - base_dir ; - sandbox = None ; - sandbox_param = None ; + 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 ; + } - (* db *) - store = base_dir // "store" ; - context = base_dir // "context" ; - protocol = base_dir // "protocol" ; + and rpc = { + listen_addr : Sockaddr.t option ; + cors_origins : string list ; + cors_headers : string list ; + tls : tls option ; + } - (* net *) - min_connections = 4 ; - max_connections = 400 ; - expected_connections = 20 ; - net_addr = V6.unspecified ; - net_port = 9732 ; - (* local_discovery = None ; *) - peers = [] ; - closed = false ; - peers_cache = base_dir // "peers_cache" ; + and tls = { + cert : string ; + key : string ; + } - (* rpc *) - rpc_addr = None ; - cors_origins = [] ; - cors_headers = ["content-type"] ; - rpc_crt = None ; - rpc_key = None ; + and log = { + output : Logging.kind ; + default_level : Logging.level ; + rules : string option ; + template : Logging.template ; + } - (* log *) - log_output = `Stderr ; - log_level = None ; -} + 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_cfg = default_cfg_of_base_dir default_base_dir + 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, 8732) ; + closed = false ; + limits = default_net_limits ; + } -let log_of_string s = match Utils.split ':' ~limit:2 s with - | ["stderr"] -> `Stderr - | ["file"; fn] -> `File fn - | ["syslog"] -> `Syslog - | ["null"] -> `Null - | _ -> invalid_arg "log_of_string" + let default_rpc = { + listen_addr = None ; + cors_origins = [] ; + cors_headers = [] ; + tls = None ; + } -let string_of_log = function - | `Stderr -> "stderr" - | `File fn -> "file:" ^ fn - | `Syslog -> "syslog" - | `Null -> "null" + let default_log = { + output = Stderr ; + default_level = Notice ; + rules = None ; + template = Logging.default_template ; + } -let sockaddr_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 default_db base_dir = { + store = base_dir // "store" ; + context = base_dir // "context" ; + protocol = base_dir // "protocol" ; + } -let sockaddr_of_string_exn str = - match sockaddr_of_string str with - | `Ok saddr -> saddr - | `Error msg -> invalid_arg msg - -let pp_sockaddr fmt (ip, port) = Format.fprintf fmt "%a:%d" V6.pp_hum ip port -let string_of_sockaddr saddr = Format.asprintf "%a" pp_sockaddr saddr - -let mcast_params_of_string s = match Utils.split ':' s with - | [iface; port] -> iface, int_of_string port - | _ -> invalid_arg "mcast_params_of_string" - -module Cfg_file = struct - open Data_encoding + let default_config base_dir = { + db = default_db base_dir ; + net = default_net base_dir ; + rpc = default_rpc ; + log = default_log ; + } let db = - obj3 - (opt "store" string) - (opt "context" string) - (opt "protocol" string) + 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 = - obj7 - (opt "min-connections" uint16) - (opt "max-connections" uint16) - (opt "expected-connections" uint16) - (opt "addr" string) - (* (opt "local-discovery" string) *) - (opt "peers" (list string)) - (dft "closed" bool false) - (opt "peers-cache" string) + 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 = - obj3 - (opt "addr" string) - (dft "cors-origin" (list string) []) - (dft "cors-header" (list string) []) + 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 = - obj1 - (opt "output" string) - - let t = conv - (fun { store ; context ; protocol ; - min_connections ; max_connections ; expected_connections ; - net_addr ; net_port ; - (* local_discovery ; *) - peers ; - closed ; peers_cache ; rpc_addr ; cors_origins ; cors_headers ; log_output } -> - let net_addr = string_of_sockaddr (net_addr, net_port) in - (* let local_discovery = Utils.map_option local_discovery *) - (* ~f:(fun (iface, port) -> iface ^ ":" ^ string_of_int port) *) - (* in *) - let rpc_addr = Utils.map_option string_of_sockaddr rpc_addr in - let peers = ListLabels.map peers ~f:string_of_sockaddr in - let log_output = string_of_log log_output in - ((Some store, Some context, Some protocol), - (Some min_connections, Some max_connections, Some expected_connections, - Some net_addr, - (* local_discovery, *) - Some peers, closed, Some peers_cache), - (rpc_addr, cors_origins, cors_headers), - Some log_output)) - (fun ( - (store, context, protocol), - (min_connections, max_connections, expected_connections, net_addr, - (* local_discovery, *) - peers, closed, peers_cache), - (rpc_addr, cors_origins, cors_headers), - log_output) -> - let open Utils in - let store = unopt ~default:default_cfg.store store in - let context = unopt ~default:default_cfg.context context in - let protocol = unopt ~default:default_cfg.protocol protocol in - let net_addr = map_option sockaddr_of_string_exn net_addr in - let net_addr, net_port = unopt ~default:(default_cfg.net_addr, default_cfg.net_port) net_addr in - let rpc_addr = map_option sockaddr_of_string_exn rpc_addr in - let peers = unopt ~default:[] peers in - let peers = ListLabels.map peers ~f:sockaddr_of_string_exn in - let peers_cache = unopt ~default:default_cfg.peers_cache peers_cache in - let log_output = unopt ~default:default_cfg.log_output (map_option log_of_string log_output) in - let min_connections = unopt ~default:default_cfg.min_connections min_connections in - let max_connections = unopt ~default:default_cfg.max_connections max_connections in - let expected_connections = unopt ~default:default_cfg.expected_connections expected_connections in - (* let local_discovery = map_option local_discovery ~f:mcast_params_of_string in *) - { default_cfg with - store ; context ; protocol ; - min_connections ; max_connections ; expected_connections ; - net_addr ; net_port ; - (* local_discovery ; *) - peers ; closed ; peers_cache ; - rpc_addr ; cors_origins ; cors_headers ; log_output ; - } - ) + (fun {output ; default_level ; rules ; template } -> + (output, default_level, rules, template)) + (fun (output, default_level, rules, template) -> + { output ; default_level ; rules ; template }) (obj4 - (req "db" db) + (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) - (req "rpc" rpc) - (req "log" log)) + (dft "log" log default_log)) let read fp = - Data_encoding_ezjsonm.read_file fp >|= function - | Error _ -> None - | Ok json -> Some (Data_encoding.Json.destruct t json) + 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) - let from_json json = Data_encoding.Json.destruct t json - let write out cfg = - Utils.write_file ~bin:false out - (Data_encoding.Json.construct t cfg |> - Data_encoding_ezjsonm.to_string) end module Cmdline = struct - open Cmdliner - (* custom converters *) - let sockaddr_converter = sockaddr_of_string, pp_sockaddr + 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 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"]) + 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, data is stored in a custom directory)." in - Arg.(value & opt (some string) None & info ~docs:"NETWORK" ~doc ~docv:"DIR" ["sandbox"]) - let sandbox_param = - let doc = "Custom parameter for the economical protocol." in - Arg.(value & opt (some string) None & info ~docs:"NETWORK" ~doc ["sandbox-param"]) - let v = - let doc = "Increase log level. Use several times to increase log level, e.g. `-vv'." in + 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"]) - (* net args *) - let min_connections = - let doc = "The number of connections below which aggressive peer discovery mode is entered." in - Arg.(value & opt (some int) None & info ~docs:"NETWORK" ~doc ~docv:"NUM" ["min-connections"]) - let max_connections = - let doc = "The number of connections above which some connections will be closed." in - Arg.(value & opt (some int) None & info ~docs:"NETWORK" ~doc ~docv:"NUM" ["max-connections"]) - let expected_connections = - let doc = "The minimum number of connections to be ensured by the cruise control." in - Arg.(value & opt (some int) None & info ~docs:"NETWORK" ~doc ~docv:"NUM" ["expected-connections"]) - let net_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 local_discovery = *) - (* let doc = "Automatic discovery of peers on the local network." in *) - (* Arg.(value & opt (some @@ pair string int) None & info ~docs:"NETWORK" ~doc ~docv:"IFACE:PORT" ["local-discovery"]) *) - 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 closed = - let doc = "Only accept connections from the bootstrap peers." in - Arg.(value & flag & info ~docs:"NETWORK" ~doc ["closed"]) + 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_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_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 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 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"]) + 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"]) - let parse base_dir config_file sandbox sandbox_param log_level - min_connections max_connections expected_connections - net_saddr - (* local_discovery *) - peers closed rpc_addr tls cors_origins cors_headers reset_cfg update_cfg = + exception Fail of string + let fail fmt = + Format.kasprintf (fun msg -> Lwt.fail (Fail msg)) fmt - let base_dir = Utils.(unopt ~default:(unopt ~default:default_cfg.base_dir base_dir) sandbox) in - let config_file = Utils.(unopt ~default:((unopt ~default:base_dir sandbox) // "config")) config_file in - let no_config () = - warn "Found no config file at %s" config_file; - warn "Using factory defaults"; - default_cfg_of_base_dir base_dir - in - let corrupted_config msg = - log_error "Config file %s corrupted: %s" config_file msg; - warn "Using factory defaults"; - default_cfg_of_base_dir base_dir - in - let cfg = - match Utils.read_file ~bin:false config_file |> Data_encoding_ezjsonm.from_string with - | exception _ -> no_config () - | Error msg -> corrupted_config msg - | Ok cfg -> try Cfg_file.from_json cfg with - | Invalid_argument msg - | Failure msg -> corrupted_config msg - in - let log_level = match List.length log_level with - | 0 -> None - | 1 -> Some Lwt_log.Info - | _ -> Some Lwt_log.Debug - in - let rpc_crt, rpc_key = match tls with - | None -> None, None - | Some (crt, key) -> Some crt, Some key - in - let cfg = - { cfg with - base_dir ; - sandbox = Utils.first_some sandbox cfg.sandbox ; - sandbox_param = Utils.first_some sandbox_param cfg.sandbox_param ; - log_level = Utils.first_some log_level cfg.log_level ; - min_connections = Utils.unopt ~default:cfg.min_connections min_connections ; - max_connections = Utils.unopt ~default:cfg.max_connections max_connections ; - expected_connections = Utils.unopt ~default:cfg.expected_connections expected_connections ; - net_addr = (match net_saddr with None -> cfg.net_addr | Some (addr, _) -> addr) ; - net_port = (match net_saddr with None -> cfg.net_port | Some (_, port) -> port) ; - (* local_discovery = Utils.first_some local_discovery cfg.local_discovery ; *) - peers = (match peers with [] -> cfg.peers | _ -> peers) ; - closed = closed || cfg.closed ; - rpc_addr = Utils.first_some rpc_addr cfg.rpc_addr ; - cors_origins = (match cors_origins with [] -> cfg.cors_origins | _ -> cors_origins) ; - cors_headers = (match cors_headers with [] -> cfg.cors_headers | _ -> cors_headers) ; - rpc_crt ; - rpc_key ; - log_output = cfg.log_output ; - } - in - if update_cfg then Cfg_file.write config_file cfg; - `Ok (config_file, reset_cfg, update_cfg, cfg) + 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 $ sandbox_param $ v - $ min_connections $ max_connections $ expected_connections - $ net_addr - (* $ local_discovery *) - $ peers $ closed - $ rpc_addr $ rpc_tls $ cors_origins $ cors_headers - $ reset_config $ update_config + $ 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 = [ @@ -392,7 +601,9 @@ module Cmdline = struct `S "CONFIG"; `S misc_sect; `S "EXAMPLES" ; - `P "Use `$(mname) --sandbox /path/to/a/custom/data/dir --rpc-addr :::8732' \ + `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."; @@ -402,172 +613,232 @@ module Cmdline = struct info ~sdocs:misc_sect ~man ~doc "tezos-node" let parse () = Term.eval cmd + end -let init_logger { log_output ; log_level } = +let init_logger ?verbosity (log_config : Cfg_file.log) = let open Logging in - Utils.iter_option log_level ~f:(Lwt_log_core.add_rule "*") ; - match log_output with - | `Stderr -> Logging.init Stderr - | `File fp -> Logging.init (File fp) - | `Null -> Logging.init Null - | `Syslog -> Logging.init (Syslog `Local1) + 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 ; sandbox_param ; - store ; context ; - min_connections ; max_connections ; expected_connections ; - net_port ; peers ; peers_cache ; closed } = +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.catch - (fun () -> - Proto.configure_sandbox ctxt json >|= function - | Error _ -> - warn "Error while configuring ecoproto for the sandboxed mode." ; - ctxt - | Ok ctxt -> ctxt) - (fun exn -> - warn "Error while configuring ecoproto for the sandboxed mode. (%s)" - (Printexc.to_string exn) ; - Lwt.return ctxt) 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 _ -> + | Some sandbox_param -> match sandbox_param with | None -> Lwt.return (Some (patch_context None)) | Some file -> Data_encoding_ezjsonm.read_file file >>= function - | Error _ -> + | Error err -> lwt_warn - "Can't parse sandbox parameters. (%s)" file >>= fun () -> + "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 -> - let net_params = + begin let open P2p in match sandbox with - | Some _ -> None + | Some _ -> return None | None -> - (* TODO add parameters... *) - let authentification_timeout = 5. - and backlog = 20 - and max_incoming_connections = 20 - and max_download_speed = None - and max_upload_speed = None - and read_buffer_size = 1 lsl 14 - and read_queue_size = None - and write_queue_size = None - and incoming_app_message_queue_size = None - and incoming_message_queue_size = None - and outgoing_message_queue_size = None in - let limits = - { 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 ; - } - in - (* TODO add parameters... *) - let identity = P2p.Identity.generate Crypto_box.default_target - and listening_addr = None - and proof_of_work_target = Crypto_box.default_target in - let config = - { listening_port = Some net_port ; - listening_addr ; + 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 ; - trusted_points = peers ; - peers_file = peers_cache ; - closed_network = closed ; proof_of_work_target ; } in - Some (config, limits) in - Node.create - ~genesis - ~store_root:store - ~context_root:context - ?test_protocol - ?patch_context - net_params + 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 init_rpc { rpc_addr ; rpc_crt; rpc_key ; cors_origins ; cors_headers } node = - match rpc_addr, rpc_crt, rpc_key with - | Some (addr, port), Some crt, Some key -> - lwt_log_notice "Starting the RPC server listening on port %d (TLS enabled)." port >>= fun () -> - let dir = Node_rpc.build_rpc_directory node in - let mode = `TLS (`Crt_file_path crt, `Key_file_path key, `No_password, `Port port) in - let host = Ipaddr.V6.to_string addr in - let () = - let old_hook = !Lwt.async_exception_hook in - Lwt.async_exception_hook := function - | Ssl.Read_error _ -> () - | exn -> old_hook exn in - RPC_server.launch ~host mode dir cors_origins cors_headers >>= fun server -> - Lwt.return (Some server) - | Some (_addr, port), _, _ -> - lwt_log_notice "Starting the RPC server listening on port %d (TLS disabled)." port >>= fun () -> - let dir = Node_rpc.build_rpc_directory node in - RPC_server.launch (`TCP (`Port port)) dir cors_origins cors_headers >>= fun server -> - Lwt.return (Some server) - | _ -> +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 + 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) -let main cfg = +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 () ; - init_logger cfg >>= fun () -> - Updater.init cfg.protocol; - lwt_log_notice "Starting the Tezos node..." >>= fun () -> - init_node cfg >>=? fun node -> - init_rpc cfg node >>= fun rpc -> - init_signal (); - 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 () + Identity.generate command config >>=? fun () -> + Node.run command config let () = match Cmdline.parse () with | `Error _ -> exit 1 | `Help -> exit 1 | `Version -> exit 1 - | `Ok (config_file, was_reset, updated, cfg) -> - if was_reset then log_notice "Overwriting %s with factory defaults." config_file; - if updated then log_notice "Updated %s from command line arguments." config_file; + | `Ok (config, command) -> Lwt_main.run begin - if not @@ Sys.file_exists cfg.base_dir then begin - Unix.mkdir cfg.base_dir 0o700; - log_notice "Created base directory %s." cfg.base_dir - end; - log_notice "Using config file %s." config_file; - if not @@ Sys.file_exists config_file then begin - Cfg_file.write config_file cfg; - log_notice "Created config file %s." config_file - end; - main cfg >>= function + 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 "%a@." Error_monad.pp_print_error err + lwt_log_error + "@[Unexpected error while initializing the node:@ %a@]@." + pp_print_error err >>= fun () -> + exit 1 end diff --git a/test/test-basic.sh b/test/test-basic.sh index 5ca301f7b..301a1bd49 100755 --- a/test/test-basic.sh +++ b/test/test-basic.sh @@ -5,8 +5,8 @@ set -e DIR=$(dirname "$0") cd "${DIR}" -DATA_DIR=$(mktemp -d /tmp/tezos_node.XXXXXXXXXX) -CLIENT_DIR=$(mktemp -d /tmp/tezos_client.XXXXXXXXXX) +DATA_DIR="$(mktemp -td tezos_node.XXXXXXXXXX)" +CLIENT_DIR="$(mktemp -td tezos_client.XXXXXXXXXX)" cleanup() { rm -fr ${DATA_DIR} ${CLIENT_DIR} @@ -17,8 +17,8 @@ trap cleanup EXIT QUIT INT NODE=../tezos-node CLIENT="../tezos-client -base-dir ${CLIENT_DIR}" -CUSTOM_PARAM="--sandbox-param ./sandbox.json" -${NODE} --sandbox "${DATA_DIR}" ${CUSTOM_PARAM} --rpc-addr :::8732 > LOG 2>&1 & +CUSTOM_PARAM="--sandbox ./sandbox.json" +${NODE} --base-dir "${DATA_DIR}" ${CUSTOM_PARAM} --rpc-addr :::8732 > LOG 2>&1 & NODE_PID="$!" sleep 3 diff --git a/test/test_basic.ml b/test/test_basic.ml index 2337ce546..e4d5895ba 100644 --- a/test/test_basic.ml +++ b/test/test_basic.ml @@ -50,8 +50,8 @@ let fork_node () = Unix.create_process Filename.(concat (dirname (Sys.getcwd ())) "tezos-node") [| "tezos-node" ; - "--sandbox"; data_dir ; - "--sandbox-param"; "./sandbox.json"; + "--base-dir"; data_dir ; + "--sandbox"; "./sandbox.json"; "--rpc-addr"; ":::8732" |] null_fd log_fd log_fd in Printf.printf "Created node, pid: %d, log: %s\n%!" pid log_file_name ;