diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 382f343560..bd2d33d524 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -118,6 +118,11 @@ unit:crypto: script: - dune build @src/lib_crypto/runtest +unit:stdlib_unix: + <<: *test_definition + script: + - dune build @src/lib_stdlib_unix/runtest + unit:protocol_environment: <<: *test_definition script: @@ -133,6 +138,11 @@ unit:shell: script: - dune build @src/lib_shell/runtest +unit:protocol_compiler: + <<: *test_definition + script: + - dune build @src/lib_protocol_compiler/runtest + unit:src/bin_client: <<: *test_definition script: diff --git a/CHANGES.md b/CHANGES.md index b60b9a16c2..7d96da37ac 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,3 +1,12 @@ +# Version 7.3 + +- Fixed a case where the number of open file descriptors was not correctly limited. + This could result in the node crashing due to being out of file descriptors. + +- Set a limit to the length of some incoming messages which previously did not have one. + +- Fixed some value encodings which were missing cases. + # Version 7.2 - Fixed an error that could cause baking to fail when validating some smart contracts. diff --git a/docs/doc_gen/node_helpers.ml b/docs/doc_gen/node_helpers.ml index eb80c24f8d..fcc7f7e162 100644 --- a/docs/doc_gen/node_helpers.ml +++ b/docs/doc_gen/node_helpers.ml @@ -46,6 +46,7 @@ let with_node f = user_activated_upgrades = []; user_activated_protocol_overrides = []; patch_context = None; + data_dir = dir; store_root = dir / "store"; context_root = dir / "context"; protocol_root = dir / "protocol"; diff --git a/docs/releases/version-7.rst b/docs/releases/version-7.rst index 3812c7286f..cc24ea9d86 100644 --- a/docs/releases/version-7.rst +++ b/docs/releases/version-7.rst @@ -1,6 +1,6 @@ .. _version-7: -Version 7.2 +Version 7.3 =========== Version 7.0 notably introduces the multinetwork node. @@ -12,18 +12,20 @@ Version 7.2 fixes an issue that could cause baking to fail when validating some smart contracts, and fixes how arguments are passed by the tezos-docker-manager.sh script when using Docker images. +Version 7.3 fixes a couple of security issues. + Update Instructions ------------------- To update from sources:: git fetch - git checkout v7.2 + git checkout v7.3 make build-deps eval $(opam env) make -If you are using Docker instead, use the ``v7.2`` Docker images of Tezos. +If you are using Docker instead, use the ``v7.3`` Docker images of Tezos. New Versioning Scheme --------------------- @@ -44,7 +46,7 @@ Additionnally, we provide a ``latest-release`` branch which will always be equal to the latest release. Release candidates are not considered to be releases in this sense, so ``latest-release`` will never point to a release candidate. In other words, ``latest-release`` points -to the latest stable release. Currently, it thus points to version 7.2. +to the latest stable release. Currently, it thus points to version 7.3. If you are used to the ``mainnet`` and ``mainnet-staging`` branches, you can consider release candidates to be the new ``mainnet-staging`` @@ -54,8 +56,8 @@ branch. Note for Remote Signer Users ---------------------------- -Note for users of ``tezos-signer``: the 7.0 (or 7.1, or 7.2) client, baker, endorser -and accuser need the 7.0 signer (or 7.1, or 7.2) to work. They are in particular not +Note for users of ``tezos-signer``: the 7.0 (or above) client, baker, endorser +and accuser need the 7.0 signer (or above) to work. They are in particular not compatible with the ``mainnet`` version of ``tezos-signer``. So remember to update your remote signer too! @@ -77,6 +79,16 @@ this script has been renamed ``tezos-docker-manager.sh``. The ``alphanet.sh`` script is still available in the Docker image for the auto-update mechanism. See :ref:`howtoget` for more information. +Changelog — Version 7.3 +----------------------- + +- Fixed a case where the number of open file descriptors was not correctly limited. + This could result in the node crashing due to being out of file descriptors. + +- Set a limit to the length of some incoming messages which previously did not have one. + +- Fixed some value encodings which were missing cases. + Changelog — Version 7.2 ----------------------- diff --git a/docs/user/key-management.rst b/docs/user/key-management.rst index 00de8b2fbc..3facfae03d 100644 --- a/docs/user/key-management.rst +++ b/docs/user/key-management.rst @@ -31,25 +31,19 @@ Tezos Wallet app ~~~~~~~~~~~~~~~~ Now on the client we can import the keys (make sure the device is -in the Tezos Wallet app): - -:: +in the Tezos Wallet app):: ./tezos-client list connected ledgers You can follow the instructions to import the ledger private key and you can choose between the root or a derived address. -We can confirm the addition by listing known addresses. - -:: +We can confirm the addition by listing known addresses:: ./tezos-client import secret key my_ledger ledger://tz1XXXXXXXXXX ./tezos-client list known addresses Optional: we can check that our ledger signs correctly using the -following command and confirming on the device: - -:: +following command and confirming on the device:: tezos-client show ledger path ledger://tz1XXXXXXXXXX @@ -72,13 +66,13 @@ only to bake for increasing levels. This prevents signing blocks at levels below the latest block signed. -If you have tried the app on some network (Zeronet, Mainnet,...) and want to use it on another -network you might need to reset this level with the command: - -:: +If you have tried the app on some network (Zeronet, Mainnet,...) and want to +use it on another network you might need to reset this level with the command:: - tezos-client set ledger high watermark for ledger://tz1XXXXXXXXXX to 0 + tezos-client setup ledger to bake for my_ledger +More details can be found on the `Tezos Ledger app +`_. .. _signer: @@ -195,8 +189,6 @@ We strongly advice you to first **make a backup** and then transfer your tokens to a new pair of keys imported from a ledger (see :ref:`ledger`). -Check the balance with: - -:: +Check the balance with:: tezos-client get balance for alice diff --git a/docs/user/mockup.rst b/docs/user/mockup.rst index 7f1ee0d885..64b8650b55 100644 --- a/docs/user/mockup.rst +++ b/docs/user/mockup.rst @@ -176,21 +176,44 @@ You can now edit the files ``bootstrap-accounts.json`` and --protocol-constants protocol-constants.json \ --bootstrap-accounts bootstrap-accounts.json +Setting protocol constants for the mockup mode +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Let's look at the contents of the ``protocol-constants.json`` file as produced +by the ``config init mockup`` of ``config show mockup`` commands. The following +was generated using the Carthage protocol: + +.. code-block:: JSON + + { "hard_gas_limit_per_operation": "1040000", + "hard_gas_limit_per_block": "10400000", + "hard_storage_limit_per_operation": "60000", + "cost_per_byte": "1000", + "chain_id": "NetXynUjJNZm7wi", + "initial_timestamp": "1970-01-01T00:00:00Z" } + +By modifying the two first fields, a user can easily create a mockup environment +with bumped up (or down) gas limits and storage limit. A invariant should be +that the gas limit per block should be greater or equal to the gas limit per +operation. The ``cost_per_byte`` is used to compute the amount of tokens to be +burnt proportionally to the fresh storage consumed by the execution of an +operation. The ``chain_id`` is used to prevent replay of operations between +chains. You can pick a chain id for your mockup environment using the following +command: -Chain id -~~~~~~~~ +:: -The `chain id` is one particular chain parameter that is also accessible from -the command line at mockup creation. + $ tezos-client compute chain id from seed -For that, you need to use the `chain-id-seed` command-line switch, which will in -turn initialize a valid `chain id`. The mockup creation command now becomes +For instance, the following command: :: - tezos-client --protocol ProtoALphaALphaALphaALphaALphaALphaALphaALphaDdp3zK \ - --base-dir /tmp/mockup create mockup --chain-id-seed myseed + $ tezos-client compute chain id from seed strudel + +yields the chain id ``NetXwWbjfCqBTLV``. -Among the response output to this command, there is a valid chain id -`Chain id is NetXi1dwBfm6F4Y` initialized from your input. +The last field, ``initial_timestamp``, is the creation time of the first block +of the chain. This date string follows the ISO-8601 standard format, which be +generated by `date --iso-8601=seconds`. diff --git a/instructions.md b/instructions.md new file mode 100644 index 0000000000..9f48bdc23a --- /dev/null +++ b/instructions.md @@ -0,0 +1,14 @@ +This is a mirror of vbot@bench_context on nomadic's remote. +Here are the instructions : + +- Retrieve the data-dirs located at `data/ioana` on comanche ({full,archive}_store_BLAktkWruUqXNgHAiR7kLh4dMP96mGmQANDGagdHAsTXfqgvfiR_933914.tar.gz) and their md5 checks; +- Also, copy the blocks you'll validate locally using the patched baker (/data/ioana/blocks_above_933913 on comanche); +- Extract the data-dir somewhere, this will be your bench's initial state; +- Checkout vbot@bench_context on nomadic's remote; +- Generate a p2p identity in the data-dir: `./tezos-node identity generate --data-dir ` (this can be your real "ready-to-use" initial state backup); +- Start a node with no connections : `./tezos-node run --rpc-addr :8732 --no-bootstrap-peers --connections 0 --data-dir `; +- Start the baker : `./tezos-baker-006-PsCARTHA run with local node `. + +This should simulate 2 RO (node + baker) and 1 RW (validator process) allowing you to bench. I also logged in the baker the time spent trying to validate the next block. + +A short explanation of the fake baker: instead of producing blocks out of the blue, the fake baker reads already produced blocks on mainnet (in the provided file), try to simulate the operations as it would have done if it was normally producing blocks (thus using the RO instance), and inject it to the node that will also validate it in its RW instance. diff --git a/src/bin_client/main_admin.ml b/src/bin_client/main_admin.ml index 85eaac9238..22f147f695 100644 --- a/src/bin_client/main_admin.ml +++ b/src/bin_client/main_admin.ml @@ -38,8 +38,4 @@ let select_commands _ _ = Client_rpc_commands.commands; Client_event_logging_commands.commands () ]) -let () = - Client_main_run.run - ~log:(Log.fatal_error "%s") - (module Client_config) - ~select_commands +let () = Client_main_run.run (module Client_config) ~select_commands diff --git a/src/bin_client/main_client.ml b/src/bin_client/main_client.ml index 14c29a94a5..e792f2547a 100644 --- a/src/bin_client/main_client.ml +++ b/src/bin_client/main_client.ml @@ -159,8 +159,4 @@ let select_commands ctxt {chain; block; protocol; _} = @ Mockup_commands.commands () @ commands_for_version -let () = - Client_main_run.run - ~log:(Log.fatal_error "%s") - (module Client_config) - ~select_commands +let () = Client_main_run.run (module Client_config) ~select_commands diff --git a/src/bin_node/main.ml b/src/bin_node/main.ml index fb0d4c8825..fb005b3f17 100644 --- a/src/bin_node/main.ml +++ b/src/bin_node/main.ml @@ -31,11 +31,6 @@ let () = prerr_endline "Non-64 bit architectures are not supported." ; exit 1 ) -let () = - let log s = Node_logging.fatal_error "%s" s in - Lwt_exit.exit_on ~log Sys.sigint ; - Lwt_exit.exit_on ~log Sys.sigterm - let () = if Filename.basename Sys.argv.(0) = Updater.compiler_name then ( try @@ -48,7 +43,20 @@ let () = let () = if Filename.basename Sys.argv.(0) = "tezos-validator" then ( - try Stdlib.exit (Lwt_main.run @@ Validator.main ()) + try + let is_valid_directory = + Array.length Sys.argv = 3 + && Sys.argv.(1) = "--socket-dir" + && Sys.file_exists Sys.argv.(2) + && Sys.is_directory Sys.argv.(2) + in + if not is_valid_directory then + invalid_arg + "Invalid arguments provided for the validator: expected \ + 'tezos-validator --socket-dir '." ; + Stdlib.exit + ( Lwt_main.run @@ Lwt_exit.wrap_and_forward + @@ Validator.main ~socket_dir:Sys.argv.(2) () ) with exn -> Format.eprintf "%a\n%!" Opterrors.report_error exn ; Stdlib.exit 1 ) diff --git a/src/bin_node/node_config_file.ml b/src/bin_node/node_config_file.ml index b1d5c1f356..c393dc3e22 100644 --- a/src/bin_node/node_config_file.ml +++ b/src/bin_node/node_config_file.ml @@ -279,7 +279,7 @@ and p2p = { limits : P2p.limits; disable_mempool : bool; enable_testchain : bool; - greylisting_config : P2p_point_state.Info.greylisting_config; + reconnection_config : P2p_point_state.Info.reconnection_config; } and rpc = { @@ -335,7 +335,7 @@ let default_p2p = limits = default_p2p_limits; disable_mempool = false; enable_testchain = false; - greylisting_config = P2p_point_state.Info.default_greylisting_config; + reconnection_config = P2p_point_state.Info.default_reconnection_config; } let default_rpc = @@ -552,7 +552,7 @@ let p2p = limits; disable_mempool; enable_testchain; - greylisting_config } -> + reconnection_config } -> ( expected_pow, bootstrap_peers, listen_addr, @@ -561,7 +561,7 @@ let p2p = limits, disable_mempool, enable_testchain, - greylisting_config )) + reconnection_config )) (fun ( expected_pow, bootstrap_peers, listen_addr, @@ -570,7 +570,7 @@ let p2p = limits, disable_mempool, enable_testchain, - greylisting_config ) -> + reconnection_config ) -> { expected_pow; bootstrap_peers; @@ -580,7 +580,7 @@ let p2p = limits; disable_mempool; enable_testchain; - greylisting_config; + reconnection_config; }) (obj9 (dft @@ -642,9 +642,11 @@ let p2p = (let open P2p_point_state.Info in dft "greylisting_config" - ~description:"The greylisting policy." - greylisting_config_encoding - default_greylisting_config)) + ~description: + "The reconnection policy regulates the frequency with which the \ + node tries to reconnect to an old known peer." + reconnection_config_encoding + default_reconnection_config)) let rpc : rpc Data_encoding.t = let open Data_encoding in @@ -1005,6 +1007,63 @@ let () = (function Invalid_content (p, e) -> Some (p, e) | _ -> None) (fun (p, e) -> Invalid_content (p, e)) +module Event = struct + include Internal_event.Simple + + let section = ["node"; "main"] + + let level = Internal_event.Warning + + let cannot_convert_to_ipv4 = + Internal_event.Simple.declare_1 + ~section + ~level + ~name:"cannot_convert_to_ipv4" + ~msg:"failed to convert {addr} to an ipv4 address" + ~pp1:(fun ppf -> Format.fprintf ppf "%S") + ("addr", Data_encoding.string) + + let cannot_resolve_listening_addr = + Internal_event.Simple.declare_1 + ~section + ~level + ~name:"cannot_resolve_listening_addr" + ~msg:"failed to resolve {addr}" + ~pp1:(fun ppf -> Format.fprintf ppf "%S") + ("addr", Data_encoding.string) + + let cannot_parse_listening_addr = + Internal_event.Simple.declare_2 + ~section + ~level + ~name:"cannot_parse_listening_addr" + ~msg:"failed to parse {addr}: {msg}" + ~pp1:(fun ppf -> Format.fprintf ppf "%S") + ("addr", Data_encoding.string) + ~pp2:(fun ppf -> Format.fprintf ppf "%s") + ("msg", Data_encoding.string) + + let cannot_resolve_discovery_addr = + Internal_event.Simple.declare_1 + ~section + ~level + ~name:"cannot_resolve_discovery_addr" + ~msg:"failed to resolve {addr}" + ~pp1:(fun ppf -> Format.fprintf ppf "%S") + ("addr", Data_encoding.string) + + let cannot_parse_discovery_addr = + Internal_event.Simple.declare_2 + ~section + ~level + ~name:"cannot_parse_discovery_addr" + ~msg:"failed to parse {addr}: {msg}" + ~pp1:(fun ppf -> Format.fprintf ppf "%S") + ("addr", Data_encoding.string) + ~pp2:(fun ppf -> Format.fprintf ppf "%s") + ("msg", Data_encoding.string) +end + let string_of_json_encoding_error exn = Format.asprintf "%a" (Json_encoding.print_error ?print_unknown:None) exn @@ -1080,7 +1139,7 @@ let update ?data_dir ?min_connections ?expected_connections ?max_connections limits; disable_mempool = cfg.p2p.disable_mempool || disable_mempool; enable_testchain = cfg.p2p.enable_testchain || enable_testchain; - greylisting_config = cfg.p2p.greylisting_config; + reconnection_config = cfg.p2p.reconnection_config; } and rpc : rpc = { @@ -1136,6 +1195,18 @@ let update ?data_dir ?min_connections ?expected_connections ?max_connections in return {cfg with data_dir; p2p; rpc; log; shell; blockchain_network} +let to_ipv4 ipv6_l = + let convert_or_warn (ipv6, port) = + let ipv4 = Ipaddr.v4_of_v6 ipv6 in + match ipv4 with + | None -> + Event.(emit cannot_convert_to_ipv4) (Ipaddr.V6.to_string ipv6) + >>= fun () -> Lwt.return_none + | Some ipv4 -> + Lwt.return_some (ipv4, port) + in + Lwt_list.filter_map_s convert_or_warn ipv6_l + let resolve_addr ~default_addr ?default_port ?(passive = false) peer = let (addr, port) = P2p_point.Id.parse_addr_port peer in let node = if addr = "" || addr = "_" then default_addr else addr @@ -1164,21 +1235,7 @@ let resolve_discovery_addrs discovery_addr = ~default_port:default_discovery_port ~passive:true discovery_addr - >>= fun addrs -> - let rec to_ipv4 acc = function - | [] -> - Lwt.return (List.rev acc) - | (ip, port) :: xs -> ( - match Ipaddr.v4_of_v6 ip with - | Some v -> - to_ipv4 ((v, port) :: acc) xs - | None -> - Format.eprintf - "Warning: failed to convert %S to an ipv4 address@." - (Ipaddr.V6.to_string ip) ; - to_ipv4 acc xs ) - in - to_ipv4 [] addrs + >>= fun addrs -> to_ipv4 addrs let resolve_listening_addrs listen_addr = resolve_addr @@ -1207,14 +1264,12 @@ let check_listening_addrs config = resolve_listening_addrs addr >>= function | [] -> - Format.eprintf "Warning: failed to resolve %S\n@." addr ; - Lwt.return_unit + Event.(emit cannot_resolve_listening_addr) addr | _ :: _ -> Lwt.return_unit) (function | Invalid_argument msg -> - Format.eprintf "Warning: failed to parse %S: %s\n@." addr msg ; - Lwt.return_unit + Event.(emit cannot_parse_listening_addr) (addr, msg) | exn -> Lwt.fail exn) @@ -1228,14 +1283,12 @@ let check_discovery_addr config = resolve_discovery_addrs addr >>= function | [] -> - Format.eprintf "Warning: failed to resolve %S\n@." addr ; - Lwt.return_unit + Event.(emit cannot_resolve_discovery_addr) addr | _ :: _ -> Lwt.return_unit) (function | Invalid_argument msg -> - Format.eprintf "Warning: failed to parse %S: %s\n@." addr msg ; - Lwt.return_unit + Event.(emit cannot_parse_discovery_addr) (addr, msg) | exn -> Lwt.fail exn) diff --git a/src/bin_node/node_config_file.mli b/src/bin_node/node_config_file.mli index c7877bcc66..f7ddc9a17f 100644 --- a/src/bin_node/node_config_file.mli +++ b/src/bin_node/node_config_file.mli @@ -64,7 +64,7 @@ and p2p = { limits : P2p.limits; disable_mempool : bool; enable_testchain : bool; - greylisting_config : P2p_point_state.Info.greylisting_config; + reconnection_config : P2p_point_state.Info.reconnection_config; } and rpc = { diff --git a/src/bin_node/node_reconstruct_command.ml b/src/bin_node/node_reconstruct_command.ml index 3d03589637..900f24bc74 100644 --- a/src/bin_node/node_reconstruct_command.ml +++ b/src/bin_node/node_reconstruct_command.ml @@ -2,7 +2,7 @@ (* *) (* Open Source License *) (* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* Copyright (c) 2018 Nomadic Labs. *) +(* Copyright (c) 2018 Nomadic Labs. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) diff --git a/src/bin_node/node_reconstruct_command.mli b/src/bin_node/node_reconstruct_command.mli index 8aaeb509e4..7bd1a74570 100644 --- a/src/bin_node/node_reconstruct_command.mli +++ b/src/bin_node/node_reconstruct_command.mli @@ -2,7 +2,7 @@ (* *) (* Open Source License *) (* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* Copyright (c) 2018 Nomadic Labs. *) +(* Copyright (c) 2018 Nomadic Labs. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) diff --git a/src/bin_node/node_run_command.ml b/src/bin_node/node_run_command.ml index 2a77182300..3c4c3d560b 100644 --- a/src/bin_node/node_run_command.ml +++ b/src/bin_node/node_run_command.ml @@ -209,7 +209,7 @@ let init_node ?sandbox ?checkpoint ~singleprocess (config : Node_config_file.t) peers_file = config.data_dir // Node_data_version.default_peers_file_name; private_mode = config.p2p.private_mode; - greylisting_config = config.p2p.greylisting_config; + reconnection_config = config.p2p.reconnection_config; identity; proof_of_work_target = Crypto_box.make_target config.p2p.expected_pow; trust_discovered_peers = sandbox <> None; @@ -244,6 +244,7 @@ let init_node ?sandbox ?checkpoint ~singleprocess (config : Node_config_file.t) user_activated_protocol_overrides = config.blockchain_network.user_activated_protocol_overrides; patch_context; + data_dir = config.data_dir; store_root = Node_data_version.store_dir config.data_dir; context_root = Node_data_version.context_dir config.data_dir; protocol_root = Node_data_version.protocol_dir config.data_dir; @@ -363,33 +364,37 @@ let run ?verbosity ?sandbox ?checkpoint ~singleprocess | Error _ as err -> Lwt.return err) >>=? fun node -> + let node_downer = + Lwt_exit.register_clean_up_callback ~loc:__LOC__ (fun _ -> + Event.(emit shutting_down_node) () >>= fun () -> Node.shutdown node) + in init_rpc config.rpc node >>=? fun rpc -> + let rpc_downer = + Lwt_exit.register_clean_up_callback + ~loc:__LOC__ + ~after:node_downer + (fun _ -> + Event.(emit shutting_down_rpc_server) () + >>= fun () -> Lwt_list.iter_p RPC_server.shutdown rpc) + in Event.(emit node_is_ready) () >>= fun () -> - Lwt_exit.( - wrap_promise @@ retcode_of_unit_result_lwt @@ Lwt_utils.never_ending ()) - >>= fun retcode -> - (* Clean-shutdown code *) - Lwt_exit.termination_thread - >>= fun exit_code -> - Event.(emit shutting_down_node) () - >>= fun () -> - Node.shutdown node - >>= fun () -> - Event.(emit shutting_down_rpc_server) () - >>= fun () -> - Lwt_list.iter_p RPC_server.shutdown rpc - >>= fun () -> - Event.(emit bye) exit_code - >>= fun () -> Internal_event_unix.close () >>= fun () -> return retcode + let _ = + Lwt_exit.register_clean_up_callback + ~loc:__LOC__ + ~after:rpc_downer + (fun exit_status -> + Event.(emit bye) exit_status >>= fun () -> Internal_event_unix.close ()) + in + Lwt_utils.never_ending () let process sandbox verbosity checkpoint singleprocess args = let verbosity = let open Internal_event in match verbosity with [] -> None | [_] -> Some Info | _ -> Some Debug in - let run = + let main_promise = Node_shared_arg.read_and_patch_config_file ~ignore_bootstrap_peers: (match sandbox with Some _ -> true | None -> false) @@ -434,14 +439,17 @@ let process sandbox verbosity checkpoint singleprocess args = | true -> failwith "Data directory is locked by another process" in - match Lwt_main.run run with - | Ok (0 | 2) -> - (* 2 means that we exit by a signal that was handled *) - `Ok () - | Ok _ -> - `Error (false, "") - | Error err -> - `Error (false, Format.asprintf "%a" pp_print_error err) + Lwt_main.run + ( Lwt_exit.wrap_and_error main_promise + >>= function + | Ok (Ok _) -> + Lwt_exit.exit_and_wait 0 >>= fun _ -> Lwt.return (`Ok ()) + | Ok (Error err) -> + Lwt_exit.exit_and_wait 2 + >>= fun _ -> + Lwt.return (`Error (false, Format.asprintf "%a" pp_print_error err)) + | Error exit_status -> + Lwt.return (`Error (false, Format.asprintf "Exited %d" exit_status)) ) module Term = struct let verbosity = diff --git a/src/bin_node/node_snapshot_command.ml b/src/bin_node/node_snapshot_command.ml index 53d3b0a5db..62b91f18d3 100644 --- a/src/bin_node/node_snapshot_command.ml +++ b/src/bin_node/node_snapshot_command.ml @@ -2,7 +2,7 @@ (* *) (* Open Source License *) (* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* Copyright (c) 2018 Nomadic Labs. *) +(* Copyright (c) 2018 Nomadic Labs. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) diff --git a/src/bin_node/node_snapshot_command.mli b/src/bin_node/node_snapshot_command.mli index 8aaeb509e4..7bd1a74570 100644 --- a/src/bin_node/node_snapshot_command.mli +++ b/src/bin_node/node_snapshot_command.mli @@ -2,7 +2,7 @@ (* *) (* Open Source License *) (* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* Copyright (c) 2018 Nomadic Labs. *) +(* Copyright (c) 2018 Nomadic Labs. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) diff --git a/src/bin_signer/main_signer.ml b/src/bin_signer/main_signer.ml index 722f9765c7..630226d9f0 100644 --- a/src/bin_signer/main_signer.ml +++ b/src/bin_signer/main_signer.ml @@ -388,7 +388,4 @@ module C = struct end let () = - Client_main_run.run - ~log:(Log.fatal_error "%s") - (module C) - ~select_commands:(fun _ _ -> return_nil) + Client_main_run.run (module C) ~select_commands:(fun _ _ -> return_nil) diff --git a/src/bin_validation/main_validator.ml b/src/bin_validation/main_validator.ml index 1d1cd1e7ca..b42dd34c29 100644 --- a/src/bin_validation/main_validator.ml +++ b/src/bin_validation/main_validator.ml @@ -23,4 +23,28 @@ (* *) (*****************************************************************************) -let () = Stdlib.exit (Lwt_main.run @@ Validator.main ()) +let () = + let socket_dir = ref None in + let args = + Arg. + [ ( "--socket-dir", + String + (fun s -> + if not (Sys.file_exists s && Sys.is_directory s) then + raise + (Arg.Bad + (Format.sprintf "File '%s' is not a valid directory" s)) + else socket_dir := Some s), + {| + When provided, the validator will communicate through a socket located + at '/tezos-validation-socket-' where is the + tezos-validator's process identifier. By default, the validator will + communicate through its standard input and output.|} + ) ] + in + let usage_msg = Format.sprintf "tezos-validator [--socket-dir ]" in + Arg.parse + args + (fun s -> raise (Arg.Bad (Format.sprintf "Unexpected argument: %s" s))) + usage_msg ; + Stdlib.exit (Lwt_main.run @@ Validator.main ?socket_dir:!socket_dir ()) diff --git a/src/bin_validation/validator.ml b/src/bin_validation/validator.ml index 7d620a2548..1173edf311 100644 --- a/src/bin_validation/validator.ml +++ b/src/bin_validation/validator.ml @@ -23,6 +23,138 @@ (* *) (*****************************************************************************) +type status = + | Initialized + | Dynload_protocol of Protocol_hash.t + | Validation_request of Block_header.t + | Commit_genesis_request of Block_hash.t + | Initialization_request + | Fork_test_chain_request of Block_header.t + | Termination_request + | Terminated + +let status_pp ppf = function + | Initialized -> + Format.fprintf ppf "Validator initialized and listening" + | Dynload_protocol h -> + Format.fprintf ppf "Dynamic loading of protocol %a" Protocol_hash.pp h + | Validation_request bh -> + Format.fprintf + ppf + "Validating block %a" + Block_hash.pp + (Block_header.hash bh) + | Commit_genesis_request h -> + Format.fprintf ppf "Committing genesis block %a" Block_hash.pp h + | Initialization_request -> + Format.fprintf ppf "Initializing validator's environment" + | Fork_test_chain_request bh -> + Format.fprintf + ppf + "Forking test chain at block %a" + Block_hash.pp + (Block_header.hash bh) + | Termination_request -> + Format.fprintf ppf "Terminating external validator" + | Terminated -> + Format.fprintf ppf "Validator terminated" + +type s = status Time.System.stamped + +module Validator_event_definition = struct + let name = "external_validator" + + type t = s + + let encoding = + let open Data_encoding in + Time.System.stamped_encoding + @@ union + [ case + (Tag 0) + ~title:"Initialized" + empty + (function Initialized -> Some () | _ -> None) + (fun () -> Initialized); + case + (Tag 1) + ~title:"Dynload protocol" + Protocol_hash.encoding + (function Dynload_protocol h -> Some h | _ -> None) + (fun h -> Dynload_protocol h); + case + (Tag 2) + ~title:"Validation request" + Block_header.encoding + (function Validation_request h -> Some h | _ -> None) + (fun h -> Validation_request h); + case + (Tag 3) + ~title:"Commit genesis request" + Block_hash.encoding + (function Commit_genesis_request h -> Some h | _ -> None) + (fun h -> Commit_genesis_request h); + case + (Tag 4) + ~title:"Initialization request" + empty + (function Initialization_request -> Some () | _ -> None) + (fun () -> Initialization_request); + case + (Tag 5) + ~title:"Fork test chain request" + Block_header.encoding + (function Fork_test_chain_request h -> Some h | _ -> None) + (fun h -> Fork_test_chain_request h); + case + (Tag 6) + ~title:"Termination request" + empty + (function Termination_request -> Some () | _ -> None) + (fun () -> Termination_request); + case + (Tag 7) + ~title:"Terminated" + empty + (function Terminated -> Some () | _ -> None) + (fun () -> Terminated) ] + + let pp ~short:_ ppf (status : t) = + Format.fprintf ppf "%a" status_pp status.data + + let doc = "External validator status." + + let level (status : t) = + match status.data with + | Initialized | Terminated -> + Internal_event.Info + | Dynload_protocol _ + | Validation_request _ + | Commit_genesis_request _ + | Initialization_request + | Fork_test_chain_request _ + | Termination_request -> + Internal_event.Debug +end + +module Validator_event = Internal_event.Make (Validator_event_definition) + +let lwt_emit (status : status) = + let time = Systime_os.now () in + Validator_event.emit + ~section: + (Internal_event.Section.make_sanitized [Validator_event_definition.name]) + (fun () -> Time.System.stamp ~time status) + >>= function + | Ok () -> + Lwt.return_unit + | Error el -> + Format.kasprintf + Lwt.fail_with + "External_validator_event.emit: %a" + pp_print_error + el + let ( // ) = Filename.concat let load_protocol proto protocol_root = @@ -31,10 +163,12 @@ let load_protocol proto protocol_root = let cmxs_file = protocol_root // Protocol_hash.to_short_b58check proto - // Format.asprintf "protocol_%a" Protocol_hash.pp proto + // Format.asprintf "protocol_%a.cmxs" Protocol_hash.pp proto in try - Dynlink.loadfile_private (cmxs_file ^ ".cmxs") ; + lwt_emit (Dynload_protocol proto) + >>= fun () -> + Dynlink.loadfile_private cmxs_file ; return_unit with Dynlink.Error err -> Format.ksprintf @@ -50,14 +184,22 @@ let inconsistent_handshake msg = Block_validator_errors.( Validation_process_failed (Inconsistent_handshake msg)) -let run stdin stdout = - External_validation.recv stdin Data_encoding.Variable.bytes +let handshake input output = + External_validation.send + output + Data_encoding.Variable.bytes + External_validation.magic + >>= fun () -> + External_validation.recv input Data_encoding.Variable.bytes >>= fun magic -> fail_when (not (Bytes.equal magic External_validation.magic)) (inconsistent_handshake "bad magic") - >>=? fun () -> - External_validation.recv stdin External_validation.parameters_encoding + +let init input = + lwt_emit Initialization_request + >>= fun () -> + External_validation.recv input External_validation.parameters_encoding >>= fun { context_root; protocol_root; sandbox_parameters; @@ -71,8 +213,24 @@ let run stdin stdout = ~patch_context:(Patch_context.patch_context genesis sandbox_param) context_root >>= fun context_index -> + Lwt.return + ( context_index, + protocol_root, + genesis, + user_activated_upgrades, + user_activated_protocol_overrides ) + +let run input output = + handshake input output + >>=? fun () -> + init input + >>= fun ( context_index, + protocol_root, + genesis, + user_activated_upgrades, + user_activated_protocol_overrides ) -> let rec loop () = - External_validation.recv stdin External_validation.request_encoding + External_validation.recv input External_validation.request_encoding >>= (function | External_validation.Validate { chain_id; @@ -80,6 +238,8 @@ let run stdin stdout = predecessor_block_header; operations; max_operations_ttl } -> + lwt_emit (Validation_request block_header) + >>= fun () -> Error_monad.protect (fun () -> let pred_context_hash = predecessor_block_header.shell.context @@ -124,11 +284,13 @@ let run stdin stdout = Lwt.return result) >>= fun res -> External_validation.send - stdout + output (Error_monad.result_encoding Block_validation.result_encoding) res >>= return | External_validation.Commit_genesis {chain_id} -> + lwt_emit (Commit_genesis_request genesis.block) + >>= fun () -> Error_monad.protect (fun () -> Context.commit_genesis context_index @@ -138,20 +300,22 @@ let run stdin stdout = >>= fun commit -> return commit) >>=? fun commit -> External_validation.send - stdout + output (Error_monad.result_encoding Context_hash.encoding) commit >>= return | External_validation.Init -> External_validation.send - stdout + output (Error_monad.result_encoding Data_encoding.empty) (Ok ()) >>= return | External_validation.Fork_test_chain {context_hash; forked_header} -> - Context.checkout context_index context_hash - >>= (function + lwt_emit (Fork_test_chain_request forked_header) + >>= (fun () -> + Context.checkout context_index context_hash + >>= function | Some ctxt -> Block_validation.init_test_chain ctxt forked_header >>= (function @@ -167,23 +331,24 @@ let run stdin stdout = Lwt.return result) >>= fun result -> External_validation.send - stdout + output (Error_monad.result_encoding Block_header.encoding) result | None -> External_validation.send - stdout + output (Error_monad.result_encoding Data_encoding.empty) (error (Block_validator_errors.Failed_to_checkout_context context_hash))) >>= return | External_validation.Terminate -> - Lwt_io.flush_all () >>= fun () -> exit 0 + Lwt_io.flush_all () + >>= fun () -> lwt_emit Termination_request >>= fun () -> exit 0 | External_validation.Restore_context_integrity -> let res = Context.restore_integrity context_index in External_validation.send - stdout + output (Error_monad.result_encoding Data_encoding.(option int31)) res >>= return) @@ -191,18 +356,37 @@ let run stdin stdout = in loop () -let main () = - let stdin = Lwt_io.of_fd ~mode:Input Lwt_unix.stdin in - let stdout = Lwt_io.of_fd ~mode:Output Lwt_unix.stdout in +let main ?socket_dir () = + let canceler = Lwt_canceler.create () in + ( match socket_dir with + | Some socket_dir -> + Internal_event_unix.init () + >>= fun () -> + let pid = Unix.getpid () in + let socket_path = + External_validation.socket_path ~data_dir:socket_dir ~pid + in + External_validation.create_socket_connect ~canceler ~socket_path + >>= fun socket_process -> + let socket_in = Lwt_io.of_fd ~mode:Input socket_process in + let socket_out = Lwt_io.of_fd ~mode:Output socket_process in + Lwt.return (socket_in, socket_out) + | None -> + Lwt.return (Lwt_io.stdin, Lwt_io.stdout) ) + >>= fun (in_channel, out_channel) -> + lwt_emit Initialized + >>= fun () -> Lwt.catch - (fun () -> run stdin stdout >>=? fun () -> return 0) + (fun () -> + run in_channel out_channel + >>=? fun () -> Lwt_canceler.cancel canceler >>= fun () -> return 0) (fun e -> Lwt.return (error_exn e)) >>= function | Ok v -> - Lwt.return v + lwt_emit Terminated >>= fun () -> Lwt.return v | Error _ as errs -> External_validation.send - stdout + out_channel (Error_monad.result_encoding Data_encoding.unit) errs >>= fun () -> Lwt.return 1 diff --git a/src/lib_base/network_version.mli b/src/lib_base/network_version.mli index cfa84577c2..5f486b7a2b 100644 --- a/src/lib_base/network_version.mli +++ b/src/lib_base/network_version.mli @@ -34,19 +34,37 @@ val pp : Format.formatter -> t -> unit val encoding : t Data_encoding.t -(** [announced supported] computes the network protocol version - announced on peer connection, given the [supported] versions for - the higher-level messages. *) +(** Get the network protocol version to announce on peer connection. + + Use the highest [distributed_db_versions] and the highest [p2p_versions]. + The version also contains the [chain_name] since it is used to prevent + peers from different networks to communicate. + + Neither [distributed_db_versions] nor [p2p_versions] can be empty. *) val announced : chain_name:Distributed_db_version.Name.t -> distributed_db_versions:Distributed_db_version.t list -> p2p_versions:P2p_version.t list -> t -(** [select acceptables remote] computes network protocol version to - be used on a given connection where [remote] is version announced - by the remote peer, and [acceptables] the locally accepted - versions for the higher-level messages. *) +(** Try to find a version which is supported both by us and a peer. + + Usage: [select ~chain_name ~distributed_db_versions ~p2p_versions remote_version] + + If the chain name of [remote_version] is not equal to [chain_name], + there is no compatible version. + + [distributed_db_versions] is the list of distributed database versions + supported by the node. + If the highest supported version is lesser or equal to the remote version, + use this highest supported version. + Otherwise, there is no compatible version. + + Similarly, [p2p_versions] is the list of peer-to-peer versions + supported by the node. The rules to find a compatible version are the same + as the ones for [distributed_db_versions]. + + If there is no compatible version, return a [P2p_rejection.Rejecting] error. *) val select : chain_name:Distributed_db_version.Name.t -> distributed_db_versions:Distributed_db_version.t list -> diff --git a/src/lib_base/p2p_point.ml b/src/lib_base/p2p_point.ml index 0a4a08c6ed..3363d01587 100644 --- a/src/lib_base/p2p_point.ml +++ b/src/lib_base/p2p_point.ml @@ -281,7 +281,7 @@ end module Info = struct type t = { trusted : bool; - greylisted_until : Time.System.t; + reconnection_time : Time.System.t option; state : State.t; last_failed_connection : Time.System.t option; last_rejected_connection : (P2p_peer_id.t * Time.System.t) option; @@ -300,7 +300,7 @@ module Info = struct about past events." @@ conv (fun { trusted; - greylisted_until; + reconnection_time; state; last_failed_connection; last_rejected_connection; @@ -310,7 +310,7 @@ module Info = struct last_miss } -> let p2p_peer_id = State.of_p2p_peer_id state in ( trusted, - greylisted_until, + reconnection_time, state, p2p_peer_id, last_failed_connection, @@ -320,7 +320,7 @@ module Info = struct last_seen, last_miss )) (fun ( trusted, - greylisted_until, + reconnection_time, state, p2p_peer_id, last_failed_connection, @@ -332,7 +332,7 @@ module Info = struct let state = State.of_peerid_state state p2p_peer_id in { trusted; - greylisted_until; + reconnection_time; state; last_failed_connection; last_rejected_connection; @@ -343,7 +343,7 @@ module Info = struct }) (obj10 (req "trusted" bool) - (dft "greylisted_until" Time.System.encoding Time.System.epoch) + (opt "greylisted_until" Time.System.encoding) (req "state" State.encoding) (opt "p2p_peer_id" P2p_peer_id.encoding) (opt "last_failed_connection" Time.System.encoding) diff --git a/src/lib_base/p2p_point.mli b/src/lib_base/p2p_point.mli index 6f9b1c0875..dab4a169b8 100644 --- a/src/lib_base/p2p_point.mli +++ b/src/lib_base/p2p_point.mli @@ -87,7 +87,7 @@ end module Info : sig type t = { trusted : bool; - greylisted_until : Time.System.t; + reconnection_time : Time.System.t option; state : State.t; last_failed_connection : Time.System.t option; last_rejected_connection : (P2p_peer_id.t * Time.System.t) option; diff --git a/src/lib_base/p2p_rejection.ml b/src/lib_base/p2p_rejection.ml index a5dcb0182e..438dcff7e0 100644 --- a/src/lib_base/p2p_rejection.ml +++ b/src/lib_base/p2p_rejection.ml @@ -53,6 +53,23 @@ let pp ppf motive = | Unknown_motive error_code -> Format.fprintf ppf "Rejected for unknown reason, code (%i)" error_code +let pp_short ppf motive = + match motive with + | No_motive -> + Format.fprintf ppf "No motive" + | Too_many_connections -> + Format.fprintf ppf "Too many connections" + | Already_connected -> + Format.fprintf ppf "Already connected" + | Unknown_chain_name -> + Format.fprintf ppf "Unknown chain name" + | Deprecated_distributed_db_version -> + Format.fprintf ppf "Deprecated ddb version" + | Deprecated_p2p_version -> + Format.fprintf ppf "Deprecated p2p version" + | Unknown_motive error_code -> + Format.fprintf ppf "unknown code (%i)" error_code + let encoding = let open Data_encoding in conv diff --git a/src/lib_base/p2p_rejection.mli b/src/lib_base/p2p_rejection.mli index a8ec7abec3..e34a359ebd 100644 --- a/src/lib_base/p2p_rejection.mli +++ b/src/lib_base/p2p_rejection.mli @@ -38,6 +38,8 @@ type t = val pp : Format.formatter -> t -> unit +val pp_short : Format.formatter -> t -> unit + val encoding : t Data_encoding.t type error += Rejecting of {motive : t} diff --git a/src/lib_client_base_unix/client_config.ml b/src/lib_client_base_unix/client_config.ml index bf676f04d0..c7d464f727 100644 --- a/src/lib_client_base_unix/client_config.ml +++ b/src/lib_client_base_unix/client_config.ml @@ -561,21 +561,19 @@ let commands config_file cfg (protocol_hash_opt : Protocol_hash.t option) = >>=? fun mockup -> let (module Mockup) = mockup in let json_pp encoding ppf value = - Format.fprintf + Data_encoding.Json.pp ppf - "%a" - Data_encoding.Json.pp (Data_encoding.Json.construct encoding value) in Mockup.default_bootstrap_accounts cctxt >>=? fun bootstrap_accounts_string -> cctxt#message - "Default value of --%s:\n%s" + "@[Default value of --%s:@,%s@]" mockup_bootstrap_accounts bootstrap_accounts_string >>= fun () -> cctxt#message - "Default value of --%s:\n%a" + "@[Default value of --%s:@,%a@]" mockup_protocol_constants (json_pp Mockup.protocol_constants_encoding) Mockup.default_protocol_constants diff --git a/src/lib_client_base_unix/client_context_unix.ml b/src/lib_client_base_unix/client_context_unix.ml index ac692f783d..35623ff4d6 100644 --- a/src/lib_client_base_unix/client_context_unix.ml +++ b/src/lib_client_base_unix/client_context_unix.ml @@ -158,7 +158,7 @@ class unix_ui : Client_context.ui = object method sleep f = Lwt_unix.sleep f - method exit : 'a. int -> 'a = fun i -> Lwt_exit.exit i + method exit : 'a. int -> 'a = fun i -> Lwt_exit.exit_and_raise i method now = Tezos_stdlib_unix.Systime_os.now end diff --git a/src/lib_client_base_unix/client_main_run.ml b/src/lib_client_base_unix/client_main_run.ml index 7adfae6385..a80e2fe34e 100644 --- a/src/lib_client_base_unix/client_main_run.ml +++ b/src/lib_client_base_unix/client_main_run.ml @@ -179,7 +179,6 @@ let setup_mockup_rpc_client_config Tezos_mockup.Persistence.init_mockup_context_by_protocol_hash ~cctxt ~protocol_hash - ~chain_id:None ~constants_overrides_json:None ~bootstrap_accounts_json:None in @@ -415,12 +414,10 @@ let main (module C : M) ~select_commands = Internal_event_unix.close () >>= fun () -> Lwt.return retcode (* Where all the user friendliness starts *) -let run ?log (module M : M) +let run (module M : M) ~(select_commands : RPC_client_unix.http_ctxt -> Client_config.cli_args -> Client_context.full Clic.command list tzresult Lwt.t) = - Lwt_exit.exit_on ?log Sys.sigint ; - Lwt_exit.exit_on ?log Sys.sigterm ; - Stdlib.exit @@ Lwt_main.run @@ Lwt_exit.wrap_promise + Stdlib.exit @@ Lwt_main.run @@ Lwt_exit.wrap_and_forward @@ main (module M) ~select_commands diff --git a/src/lib_client_base_unix/client_main_run.mli b/src/lib_client_base_unix/client_main_run.mli index 3f65ffa40f..f4ae89d504 100644 --- a/src/lib_client_base_unix/client_main_run.mli +++ b/src/lib_client_base_unix/client_main_run.mli @@ -78,7 +78,6 @@ sig end val run : - ?log:(string -> unit) -> (module M) -> select_commands:(RPC_client_unix.http_ctxt -> Client_config.cli_args -> diff --git a/src/lib_micheline/micheline_parser.ml b/src/lib_micheline/micheline_parser.ml index e42b0da60f..7fe64222fd 100644 --- a/src/lib_micheline/micheline_parser.ml +++ b/src/lib_micheline/micheline_parser.ml @@ -2,7 +2,7 @@ (* *) (* Open Source License *) (* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* Copyright (c) 2018 Nomadic Labs. *) +(* Copyright (c) 2018 Nomadic Labs. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) diff --git a/src/lib_mockup/mockup_args.ml b/src/lib_mockup/mockup_args.ml index 647392e417..72549c396b 100644 --- a/src/lib_mockup/mockup_args.ml +++ b/src/lib_mockup/mockup_args.ml @@ -23,15 +23,13 @@ (* *) (*****************************************************************************) +let choose ~default ~from_config_file = + match from_config_file with None -> default | Some cid -> cid + module Chain_id = struct let of_string s = Chain_id.hash_string ~key:"mockup" [s] let dummy = of_string "chain" - let choose ~from_command_line ~from_config_file = - match (from_command_line, from_config_file) with - | (None, None) -> - dummy - | (Some cid, (None | Some _)) | (None, Some cid) -> - cid + let choose = choose ~default:dummy end diff --git a/src/lib_mockup/mockup_args.mli b/src/lib_mockup/mockup_args.mli index c88b6a8950..9ef4a1789a 100644 --- a/src/lib_mockup/mockup_args.mli +++ b/src/lib_mockup/mockup_args.mli @@ -37,15 +37,12 @@ module Chain_id : sig *) val dummy : Chain_id.t - (** [choose ~from_command_line ~from_config_file] - ** chooses a valid chain_id from two options. + (** [choose ~from_config_file] + ** produces a valid chain id from the optionally given one. ** ** The value from the command line, if any, has highest precedence, over the ** one from the config file. ** When both values are [None], it uses the {!dummy}. *) - val choose : - from_command_line:Chain_id.t option -> - from_config_file:Chain_id.t option -> - Chain_id.t + val choose : from_config_file:Chain_id.t option -> Chain_id.t end diff --git a/src/lib_mockup/persistence.ml b/src/lib_mockup/persistence.ml index 465ed2fce0..a99f2c0e41 100644 --- a/src/lib_mockup/persistence.ml +++ b/src/lib_mockup/persistence.ml @@ -102,29 +102,22 @@ let default_mockup_context : ~parameters:Mockup.default_parameters ~constants_overrides_json:None ~bootstrap_accounts_json:None - ~chain_id:None >>=? fun rpc_context -> return (mockup, rpc_context) let init_mockup_context_by_protocol_hash : cctxt:Tezos_client_base.Client_context.full -> protocol_hash:Protocol_hash.t -> - chain_id:Chain_id.t option -> constants_overrides_json:Data_encoding.json option -> bootstrap_accounts_json:Data_encoding.json option -> (Registration.mockup_environment * Registration.mockup_context) tzresult Lwt.t = - fun ~cctxt - ~protocol_hash - ~chain_id - ~constants_overrides_json - ~bootstrap_accounts_json -> + fun ~cctxt ~protocol_hash ~constants_overrides_json ~bootstrap_accounts_json -> get_registered_mockup (Some protocol_hash) >>=? fun mockup -> let (module Mockup) = mockup in Mockup.init ~cctxt ~parameters:Mockup.default_parameters - ~chain_id ~constants_overrides_json ~bootstrap_accounts_json >>=? fun menv -> return (mockup, menv) @@ -200,8 +193,7 @@ let classify_base_dir base_dir = else Base_dir_is_nonempty let create_mockup ~(cctxt : Tezos_client_base.Client_context.full) - ~protocol_hash ~chain_id ~constants_overrides_json ~bootstrap_accounts_json - = + ~protocol_hash ~constants_overrides_json ~bootstrap_accounts_json = let base_dir = cctxt#get_base_dir in let create_base_dir () = Tezos_stdlib_unix.Lwt_utils_unix.create_dir base_dir @@ -221,18 +213,11 @@ let create_mockup ~(cctxt : Tezos_client_base.Client_context.full) "%s is not empty, please specify a fresh base directory" base_dir ) >>=? fun () -> - ( match chain_id with - | None -> - Lwt.return_unit - | Some chain_id -> - cctxt#message "Chain id is %a" Chain_id.pp chain_id ) - >>= fun () -> init_mockup_context_by_protocol_hash ~cctxt ~protocol_hash ~constants_overrides_json ~bootstrap_accounts_json - ~chain_id >>=? fun (_mockup_env, (chain_id, rpc_context)) -> let mockup_dir = Filename.concat base_dir mockup_dirname in Tezos_stdlib_unix.Lwt_utils_unix.create_dir mockup_dir diff --git a/src/lib_mockup/persistence.mli b/src/lib_mockup/persistence.mli index 14c0ce5281..d39e585c70 100644 --- a/src/lib_mockup/persistence.mli +++ b/src/lib_mockup/persistence.mli @@ -37,7 +37,6 @@ val default_mockup_context : val init_mockup_context_by_protocol_hash : cctxt:Tezos_client_base.Client_context.full -> protocol_hash:Protocol_hash.t -> - chain_id:Chain_id.t option -> constants_overrides_json:Data_encoding.json option -> bootstrap_accounts_json:Data_encoding.json option -> (Registration.mockup_environment * Registration.mockup_context) tzresult @@ -55,7 +54,6 @@ val get_mockup_context_from_disk : val create_mockup : cctxt:Tezos_client_base.Client_context.full -> protocol_hash:Protocol_hash.t -> - chain_id:Chain_id.t option -> constants_overrides_json:Data_encoding.json option -> bootstrap_accounts_json:Data_encoding.json option -> unit tzresult Lwt.t diff --git a/src/lib_mockup/registration.ml b/src/lib_mockup/registration.ml index 7847c92749..513f32383b 100644 --- a/src/lib_mockup/registration.ml +++ b/src/lib_mockup/registration.ml @@ -64,7 +64,6 @@ module type Mockup_sig = sig val init : cctxt:Tezos_client_base.Client_context.full -> parameters:parameters -> - chain_id:Chain_id.t option -> constants_overrides_json:Data_encoding.json option -> bootstrap_accounts_json:Data_encoding.json option -> mockup_context tzresult Lwt.t diff --git a/src/lib_mockup/registration.mli b/src/lib_mockup/registration.mli index 8a70a6906e..586b684e46 100644 --- a/src/lib_mockup/registration.mli +++ b/src/lib_mockup/registration.mli @@ -63,7 +63,6 @@ module type Mockup_sig = sig val init : cctxt:Tezos_client_base.Client_context.full -> parameters:parameters -> - chain_id:Chain_id.t option -> constants_overrides_json:Data_encoding.json option -> bootstrap_accounts_json:Data_encoding.json option -> mockup_context tzresult Lwt.t diff --git a/src/lib_p2p/p2p.ml b/src/lib_p2p/p2p.ml index 34aec8f630..d59c839eba 100644 --- a/src/lib_p2p/p2p.ml +++ b/src/lib_p2p/p2p.ml @@ -39,7 +39,7 @@ type config = { identity : P2p_identity.t; proof_of_work_target : Crypto_box.target; trust_discovered_peers : bool; - greylisting_config : P2p_point_state.Info.greylisting_config; + reconnection_config : P2p_point_state.Info.reconnection_config; } type limits = { @@ -98,7 +98,7 @@ let create_connect_handler config limits pool msg_cfg conn_meta_cfg io_sched proof_of_work_target = config.proof_of_work_target; listening_port = config.listening_port; private_mode = config.private_mode; - greylisting_config = config.greylisting_config; + reconnection_config = config.reconnection_config; min_connections = limits.min_connections; max_connections = limits.max_connections; max_incoming_connections = limits.max_incoming_connections; diff --git a/src/lib_p2p/p2p.mli b/src/lib_p2p/p2p.mli index 7fbb4402fb..807d84b8a3 100644 --- a/src/lib_p2p/p2p.mli +++ b/src/lib_p2p/p2p.mli @@ -94,15 +94,15 @@ type config = { private_mode : bool; (** If [true], only open outgoing/accept incoming connections to/from peers whose addresses are in [trusted_peers], and inform - these peers that the identity of this node should be revealed to + these peers that the identity of this node should not be revealed to the rest of the network. *) identity : P2p_identity.t; (** Cryptographic identity of the peer. *) proof_of_work_target : Crypto_box.target; (** Expected level of proof of work of peers' identity. *) trust_discovered_peers : bool; (** If [true], peers discovered on the local network will be trusted. *) - greylisting_config : P2p_point_state.Info.greylisting_config; - (** The greylisting configuration. *) + reconnection_config : P2p_point_state.Info.reconnection_config; + (** The reconnection delat configuration. *) } (** Network capacities *) diff --git a/src/lib_p2p/p2p_connect_handler.ml b/src/lib_p2p/p2p_connect_handler.ml index f7205518ac..a6e63220f2 100644 --- a/src/lib_p2p/p2p_connect_handler.ml +++ b/src/lib_p2p/p2p_connect_handler.ml @@ -37,7 +37,7 @@ type config = { identity : P2p_identity.t; connection_timeout : Time.System.Span.t; authentication_timeout : Time.System.Span.t; - greylisting_config : P2p_point_state.Info.greylisting_config; + reconnection_config : P2p_point_state.Info.reconnection_config; proof_of_work_target : Crypto_box.target; listening_port : P2p_addr.port option; } @@ -130,7 +130,7 @@ let create_connection t p2p_conn id_point point_info peer_info Option.iter (P2p_point_state.set_disconnected ~timestamp - t.config.greylisting_config) + t.config.reconnection_config) point_info ; t.log (Disconnection peer_id) ; P2p_peer_state.set_disconnected ~timestamp peer_info ; @@ -242,13 +242,12 @@ let raw_authenticate t ?point_info canceler fd point = >>= fun () -> may_register_my_id_point t.pool err ; t.log (Authentication_failed point) ; - ( if incoming then P2p_point.Table.remove t.incoming point - else + ( if not incoming then let timestamp = Systime_os.now () in Option.iter (P2p_point_state.set_disconnected ~timestamp - t.config.greylisting_config) + t.config.reconnection_config) point_info ) ; Lwt.return_error err) >>=? fun (info, auth_fd) -> @@ -294,16 +293,6 @@ let raw_authenticate t ?point_info canceler fd point = (* we have a slot, checking if point and peer are acceptable *) is_acceptable t connection_point_info peer_info incoming version in - (* To Verify : the thread must ? not be interrupted between - point removal from incoming and point registration into - active connection to prevent flooding attack. - incoming_connections + active_connection must reflect/dominate - the actual number of ongoing connections. - On the other hand, if we wait too long for Ack, we will reject - incoming connections, thus giving an entry point for dos attack - by giving late Nack. - *) - if incoming then P2p_point.Table.remove t.incoming point ; Option.iter (fun point_info -> (* set the point to private or not, depending on the [info] gathered @@ -334,7 +323,7 @@ let raw_authenticate t ?point_info canceler fd point = (P2p_point_state.set_disconnected ~timestamp ~requested:true - t.config.greylisting_config) + t.config.reconnection_config) point_info ) ; match motive with | Unknown_chain_name @@ -395,7 +384,8 @@ let raw_authenticate t ?point_info canceler fd point = | P2p_errors.Rejected_by_nack {alternative_points = Some points; motive} :: _ -> - Events.(emit connection_rejected_by_peers) (point, motive, points) + Events.(emit connection_rejected_by_peers) + (point, info.peer_id, motive, points) >>= fun () -> P2p_pool.register_list_of_new_points ~medium:"Nack" @@ -413,7 +403,7 @@ let raw_authenticate t ?point_info canceler fd point = Option.iter (P2p_point_state.set_disconnected ~timestamp - t.config.greylisting_config) + t.config.reconnection_config) connection_point_info ; P2p_peer_state.set_disconnected ~timestamp peer_info ; Lwt.return_error err) @@ -473,13 +463,21 @@ let accept t fd point = P2p_point.Table.add t.incoming point canceler ; Lwt_utils.dont_wait (fun exc -> - Format.eprintf "Uncaught exception: %s\n%!" (Printexc.to_string exc)) + P2p_point.Table.remove t.incoming point ; + P2p_pool.greylist_addr t.pool (fst point) ; + Format.eprintf + "Uncaught exception on incoming connection from %a: %s\n%!" + P2p_point.Id.pp + point + (Printexc.to_string exc)) (fun () -> with_timeout ~canceler (Systime_os.sleep t.config.authentication_timeout) (fun canceler -> authenticate t canceler fd point) - >>= fun _ -> Lwt.return_unit) + >>= fun _ -> + P2p_point.Table.remove t.incoming point ; + Lwt.return_unit) let fail_unless_disconnected_point point_info = match P2p_point_state.get point_info with @@ -530,7 +528,7 @@ let connect ?timeout t point = let timestamp = Systime_os.now () in P2p_point_state.set_disconnected ~timestamp - t.config.greylisting_config + t.config.reconnection_config point_info ; P2p_fd.close fd >>= (function diff --git a/src/lib_p2p/p2p_connect_handler.mli b/src/lib_p2p/p2p_connect_handler.mli index 465a966df4..f038dd376d 100644 --- a/src/lib_p2p/p2p_connect_handler.mli +++ b/src/lib_p2p/p2p_connect_handler.mli @@ -72,7 +72,7 @@ type config = { (** Maximum time allowed to the establishment of a connection. *) authentication_timeout : Time.System.Span.t; (** Maximum time allowed to the establishment of a connection. *) - greylisting_config : P2p_point_state.Info.greylisting_config; + reconnection_config : P2p_point_state.Info.reconnection_config; (** Delay granted to a peer to perform authentication. *) proof_of_work_target : Crypto_box.target; (** The greylisting configuration. *) diff --git a/src/lib_p2p/p2p_directory.ml b/src/lib_p2p/p2p_directory.ml index b1e1194600..58b48c0fc8 100644 --- a/src/lib_p2p/p2p_directory.ml +++ b/src/lib_p2p/p2p_directory.ml @@ -41,7 +41,7 @@ let info_of_point_info i = { trusted = trusted i; state; - greylisted_until = greylisted_until i; + reconnection_time = reconnection_time i; last_failed_connection = last_failed_connection i; last_rejected_connection = last_rejected_connection i; last_established_connection = last_established_connection i; diff --git a/src/lib_p2p/p2p_events.ml b/src/lib_p2p/p2p_events.ml index 5d930f9875..9c48ac9869 100644 --- a/src/lib_p2p/p2p_events.ml +++ b/src/lib_p2p/p2p_events.ml @@ -193,14 +193,17 @@ module P2p_connect_handler = struct ("errors", Error_monad.trace_encoding) let connection_rejected_by_peers = - declare_3 + declare_4 ~section ~name:"connection_rejected_by_peers" ~msg: - "connection to {point} rejected by peer. Reason {reason}. Peer list \ - received: {points}" + "connection to {point} rejected by peer {peer}. Reason {reason}. Peer \ + list received: {points}" ~level:Debug + ~pp2:P2p_peer.Id.pp_short + ~pp3:P2p_rejection.pp_short ("point", P2p_point.Id.encoding) + ("peer", P2p_peer.Id.encoding) ("reason", P2p_rejection.encoding) ("points", Data_encoding.list P2p_point.Id.encoding) @@ -285,7 +288,7 @@ module P2p_fd = struct ~name:"create_fd" ~msg:"cnx:{connection_id}:create fd" ~level:Debug - ("connection_id", Data_encoding.int16) + ("connection_id", Data_encoding.int31) let close_fd = declare_3 @@ -293,9 +296,9 @@ module P2p_fd = struct ~name:"close_fd" ~msg:"cnx:{connection_id}:close fd (stats : {nread}/{nwrit})" ~level:Debug - ("connection_id", Data_encoding.int16) - ("nread", Data_encoding.int16) - ("nwrit", Data_encoding.int16) + ("connection_id", Data_encoding.int31) + ("nread", Data_encoding.int31) + ("nwrit", Data_encoding.int31) let try_read = declare_2 @@ -303,8 +306,8 @@ module P2p_fd = struct ~name:"try_read" ~msg:"cnx:{connection_id}:try read {length}" ~level:Debug - ("connection_id", Data_encoding.int16) - ("length", Data_encoding.int16) + ("connection_id", Data_encoding.int31) + ("length", Data_encoding.int31) let try_write = declare_2 @@ -312,8 +315,8 @@ module P2p_fd = struct ~name:"try_write" ~msg:"cnx:{connection_id}:try write {length}" ~level:Debug - ("connection_id", Data_encoding.int16) - ("length", Data_encoding.int16) + ("connection_id", Data_encoding.int31) + ("length", Data_encoding.int31) let read_fd = declare_3 @@ -321,9 +324,9 @@ module P2p_fd = struct ~name:"read_fd" ~msg:"cnx:{connection_id}:read {nread} ({nread_total})" ~level:Debug - ("connection_id", Data_encoding.int16) - ("nread", Data_encoding.int16) - ("nread_total", Data_encoding.int16) + ("connection_id", Data_encoding.int31) + ("nread", Data_encoding.int31) + ("nread_total", Data_encoding.int31) let written_fd = declare_3 @@ -331,9 +334,9 @@ module P2p_fd = struct ~name:"written_fd" ~msg:"cnx:{connection_id}:written {nwrit} ({nwrit_total})" ~level:Debug - ("connection_id", Data_encoding.int16) - ("nwrit", Data_encoding.int16) - ("nwrit_total", Data_encoding.int16) + ("connection_id", Data_encoding.int31) + ("nwrit", Data_encoding.int31) + ("nwrit_total", Data_encoding.int31) let connect_fd = declare_2 @@ -341,7 +344,7 @@ module P2p_fd = struct ~name:"connect" ~msg:"cnx:{connection_id}:connect {socket}" ~level:Debug - ("connection_id", Data_encoding.int16) + ("connection_id", Data_encoding.int31) ("socket", Data_encoding.string) let accept_fd = @@ -350,7 +353,7 @@ module P2p_fd = struct ~name:"accept" ~msg:"cnx:{connection_id}:accept {socket}" ~level:Debug - ("connection_id", Data_encoding.int16) + ("connection_id", Data_encoding.int31) ("socket", Data_encoding.string) end @@ -373,7 +376,7 @@ module P2p_maintainance = struct ~name:"too_few_connections_maintenance" ~msg:"too few connections ({connections})" ~level:Notice - ("connections", Data_encoding.int16) + ("connections", Data_encoding.int31) let too_many_connections = declare_1 @@ -381,7 +384,7 @@ module P2p_maintainance = struct ~name:"too_many_connections_maintenance" ~msg:"too many connections (will kill {connections})" ~level:Debug - ("connections", Data_encoding.int16) + ("connections", Data_encoding.int31) end module P2p_welcome = struct @@ -416,3 +419,114 @@ module P2p_welcome = struct ~level:Error ("exception", Error_monad.error_encoding) end + +module P2p_io_scheduler = struct + include Internal_event.Simple + + let section = ["p2p"; "io-scheduler"] + + let connection_closed = + declare_3 + ~section + ~name:"connection_closed_scheduler" + ~msg:"connection closed {direction} ({connection_id},{name})" + ~level:Debug + ("direction", Data_encoding.string) + ("connection_id", Data_encoding.int31) + ("name", Data_encoding.string) + + let unexpected_error = + declare_4 + ~section + ~name:"unexpected_error_scheduler" + ~msg: + "unexpected error in connection ({direction}: \ + {connection_id},{name}): {error}" + ~level:Error + ~pp4:pp_print_error_first + ("direction", Data_encoding.string) + ("connection_id", Data_encoding.int31) + ("name", Data_encoding.string) + ("error", Error_monad.trace_encoding) + + let wait_quota = + declare_1 + ~section + ~name:"scheduler_wait_quota" + ~msg:"wait_quota ({name})" + ~level:Debug + ("name", Data_encoding.string) + + let wait = + declare_1 + ~section + ~name:"scheduler_wait" + ~msg:"wait ({name})" + ~level:Debug + ("name", Data_encoding.string) + + let handle_connection = + declare_3 + ~section + ~name:"handle_connection" + ~msg:"handle {len} ({connection_id},{name})" + ~level:Debug + ("len", Data_encoding.int31) + ("connection_id", Data_encoding.int31) + ("name", Data_encoding.string) + + let create_connection = + declare_2 + ~section + ~name:"create_connection_scheduler" + ~msg:"create connection ({connection_id},{name})" + ~level:Debug + ("connection_id", Data_encoding.int31) + ("name", Data_encoding.string) + + let update_quota = + declare_1 + ~section + ~name:"update_quota" + ~msg:"update quota {name}" + ~level:Debug + ("name", Data_encoding.string) + + let reset_quota = + declare_0 ~section ~name:"reset_quota" ~msg:"reset quota" ~level:Debug () + + let create = + declare_0 ~section ~name:"create_connection" ~msg:"create" ~level:Debug () + + let register = + declare_1 + ~section + ~name:"register_connection" + ~msg:"register_connection {connection_id}" + ~level:Debug + ("connection_id", Data_encoding.int31) + + let close = + declare_1 + ~section + ~name:"close_connection" + ~msg:"close {connection_id}" + ~level:Debug + ("connection_id", Data_encoding.int31) + + let shutdown = + declare_1 + ~section + ~name:"shutdown_connection" + ~msg:"shutdown {name}" + ~level:Debug + ("name", Data_encoding.string) + + let shutdown_scheduler = + declare_0 + ~section + ~name:"shutdown_scheduler" + ~msg:"shutdown scheduler" + ~level:Debug + () +end diff --git a/src/lib_p2p/p2p_io_scheduler.ml b/src/lib_p2p/p2p_io_scheduler.ml index 1959d21b35..ed2e818583 100644 --- a/src/lib_p2p/p2p_io_scheduler.ml +++ b/src/lib_p2p/p2p_io_scheduler.ml @@ -25,9 +25,15 @@ (* TODO decide whether we need to preallocate buffers or not. *) -include Internal_event.Legacy_logging.Make (struct - let name = "p2p.io-scheduler" -end) +module Events = struct + include P2p_events.P2p_io_scheduler + + let emit_dont_wait e p = + Lwt_utils.dont_wait + (fun exc -> + Format.eprintf "Uncaught exception: %s\n%!" (Printexc.to_string exc)) + (fun () -> emit e p) +end let alpha = 0.2 @@ -75,7 +81,7 @@ module Scheduler (IO : IO) = struct let cancel (conn : connection) err = Lwt_utils.unless conn.closed (fun () -> - lwt_debug "Connection closed (%d, %s) " conn.id IO.name + Events.(emit connection_closed) ("cancel", conn.id, IO.name) >>= fun () -> conn.closed <- true ; Lwt.catch @@ -110,14 +116,14 @@ module Scheduler (IO : IO) = struct let check_quota st = if st.max_speed <> None && st.quota < 0 then - lwt_debug "scheduler.wait_quota(%s)" IO.name + Events.(emit wait_quota) IO.name >>= fun () -> Lwt_condition.wait st.quota_updated else Lwt_unix.yield () let rec worker_loop st = check_quota st >>= fun () -> - lwt_debug "scheduler.wait(%s)" IO.name + Events.(emit wait) IO.name >>= fun () -> Lwt.pick [Lwt_canceler.cancellation st.canceler; wait_data st] >>= fun () -> @@ -135,15 +141,10 @@ module Scheduler (IO : IO) = struct | Error (Exn Lwt_pipe.Closed :: _ as err) | Error (Exn (Unix.Unix_error ((EBADF | ETIMEDOUT), _, _)) :: _ as err) -> - lwt_debug "Connection closed (pop: %d, %s)" conn.id IO.name + Events.(emit connection_closed) ("pop", conn.id, IO.name) >>= fun () -> cancel conn err >>= fun () -> worker_loop st | Error err -> - lwt_log_error - "@[Unexpected error in connection (pop: %d, %s):@ %a@]" - conn.id - IO.name - pp_print_error - err + Events.(emit unexpected_error) ("pop", conn.id, IO.name, err) >>= fun () -> cancel conn err >>= fun () -> worker_loop st | Ok msg -> conn.current_push <- @@ -154,19 +155,14 @@ module Scheduler (IO : IO) = struct | Error (P2p_errors.Connection_closed :: _ as err) | Error (Exn (Unix.Unix_error (EBADF, _, _)) :: _ as err) | Error (Exn Lwt_pipe.Closed :: _ as err) -> - lwt_debug "Connection closed (push: %d, %s)" conn.id IO.name + Events.(emit connection_closed) ("push", conn.id, IO.name) >>= fun () -> cancel conn err >>= fun () -> return_unit | Error err -> - lwt_log_error - "@[Unexpected error in connection (push: %d, %s):@ %a@]" - conn.id - IO.name - pp_print_error - err + Events.(emit unexpected_error) ("push", conn.id, IO.name, err) >>= fun () -> cancel conn err >>= fun () -> Lwt.return_error err ) ; let len = Bytes.length msg in - lwt_debug "Handle: %d (%d, %s)" len conn.id IO.name + Events.(emit handle_connection) (len, conn.id, IO.name) >>= fun () -> Moving_average.add st.counter len ; st.quota <- st.quota - len ; @@ -198,7 +194,7 @@ module Scheduler (IO : IO) = struct st let create_connection st in_param out_param canceler id = - debug "scheduler(%s).create_connection (%d)" IO.name id ; + Events.(emit_dont_wait create_connection (id, IO.name)) ; let conn = { id; @@ -216,7 +212,7 @@ module Scheduler (IO : IO) = struct waiter st conn ; conn let update_quota st = - debug "scheduler(%s).update_quota" IO.name ; + Events.(emit_dont_wait update_quota IO.name) ; Option.iter (fun quota -> st.quota <- min st.quota 0 + quota ; @@ -233,11 +229,8 @@ module Scheduler (IO : IO) = struct Queue.transfer tmp st.readys_low ) let shutdown st = - lwt_debug "--> scheduler(%s).shutdown" IO.name - >>= fun () -> Lwt_canceler.cancel st.canceler - >>= fun () -> - st.worker >>= fun () -> lwt_debug "<-- scheduler(%s).shutdown" IO.name + >>= fun () -> st.worker >>= fun () -> Events.(emit shutdown) IO.name end module ReadScheduler = Scheduler (struct @@ -325,7 +318,7 @@ and t = { } let reset_quota st = - debug "--> reset quota" ; + Events.(emit_dont_wait reset_quota ()) ; let {Moving_average.average = current_inflow; _} = Moving_average.stat st.read_scheduler.counter and {Moving_average.average = current_outflow; _} = @@ -347,7 +340,7 @@ let reset_quota st = let create ?max_upload_speed ?max_download_speed ?read_queue_size ?write_queue_size ~read_buffer_size () = - log_info "--> create" ; + Events.(emit_dont_wait create ()) ; let st = { closed = false; @@ -437,7 +430,7 @@ let register st fd = } in P2p_fd.Table.add st.connected conn.fd conn ; - log_info "--> register (%d)" id ; + (* Events.(emit register) id) *) conn let write ?canceler {write_queue; _} msg = @@ -522,8 +515,6 @@ let stat {read_conn; write_conn; _} = let close ?timeout conn = let id = P2p_fd.id conn.fd in - lwt_log_info "--> close (%d)" id - >>= fun () -> P2p_fd.Table.remove conn.sched.connected conn.fd ; Lwt_pipe.close conn.write_queue ; ( match timeout with @@ -536,14 +527,12 @@ let close ?timeout conn = (fun canceler -> return (Lwt_canceler.cancellation canceler)) ) >>=? fun _ -> conn.write_conn.current_push - >>= fun res -> lwt_log_info "<-- close (%d)" id >>= fun () -> Lwt.return res + >>= fun res -> Events.(emit close) id >>= fun () -> Lwt.return res let iter_connection {connected; _} f = P2p_fd.Table.iter (fun _ conn -> f conn) connected let shutdown ?timeout st = - lwt_log_info "--> shutdown" - >>= fun () -> st.closed <- true ; ReadScheduler.shutdown st.read_scheduler >>= fun () -> @@ -553,6 +542,6 @@ let shutdown ?timeout st = Lwt.return_unit >>= fun () -> WriteScheduler.shutdown st.write_scheduler - >>= fun () -> lwt_log_info "<-- shutdown" + >>= fun () -> Events.(emit shutdown_scheduler) () let id conn = P2p_fd.id conn.fd diff --git a/src/lib_p2p/p2p_maintenance.ml b/src/lib_p2p/p2p_maintenance.ml index 3ff616a62c..aec91cb22b 100644 --- a/src/lib_p2p/p2p_maintenance.ml +++ b/src/lib_p2p/p2p_maintenance.ml @@ -93,7 +93,7 @@ let classify pool private_mode start_time seen_points point pi = match P2p_point_state.Info.last_miss pi with | Some last when Time.System.(start_time < last) - || P2p_point_state.Info.greylisted ~now pi -> + || P2p_point_state.Info.can_reconnect ~now pi -> `Seen | last -> `Candidate last ) diff --git a/src/lib_p2p/p2p_message.ml b/src/lib_p2p/p2p_message.ml index 03983dacea..26074858ed 100644 --- a/src/lib_p2p/p2p_message.ml +++ b/src/lib_p2p/p2p_message.ml @@ -35,28 +35,52 @@ type 'msg t = let encoding msg_encoding = let open Data_encoding in dynamic_size - @@ union + (* MAX SIZE: + 4(size of size info) + + MAX SIZE of encoding *) + @@ union (* MAX SIZE: max MAX SIZE of cases *) ~tag_size:`Uint16 - ( [ case + ( [ (* MAX SIZE: 2(tag) + Note that tags can be 1 or 2 bytes depending on the size of the + union. This union is of unknown size because it depends on + [msg_encoding]. As a result, we assume a maximum tag size of 2 + bytes. *) + case (Tag 0x01) ~title:"Disconnect" (obj1 (req "kind" (constant "Disconnect"))) (function Disconnect -> Some () | _ -> None) (fun () -> Disconnect); + (* MAX SIZE: 2(tag) *) case (Tag 0x02) ~title:"Bootstrap" (obj1 (req "kind" (constant "Bootstrap"))) (function Bootstrap -> Some () | _ -> None) (fun () -> Bootstrap); + (* MAX SIZE: + 2(tag) + + (100(list length) + * ((8(number of IPv6 chunks) * 4(size of IPv6 chunks)) + + 7(IPv6 chunk separators) + + 1(port separator) + + 5(size of port number)) + = 2102 + *) case (Tag 0x03) ~title:"Advertise" (obj2 - (req "id" (Variable.list P2p_point.Id.encoding)) + (req "id" (Variable.list ~max_length:100 P2p_point.Id.encoding)) (req "kind" (constant "Advertise"))) (function Advertise points -> Some (points, ()) | _ -> None) (fun (points, ()) -> Advertise points); + (* MAX SIZE: + 2(tag) + + (8 * 4) + 7 + 1 + 5 (point) + + 16 (peer) + = 63 + *) case (Tag 0x04) ~title:"Swap_request" @@ -70,6 +94,12 @@ let encoding msg_encoding = | _ -> None) (fun (point, peer_id, ()) -> Swap_request (point, peer_id)); + (* MAX SIZE: + 2(tag) + + (8 * 4) + 7 + 1 + 5 (point) + + 16 (peer) + = 63 + *) case (Tag 0x05) ~title:"Swap_ack" diff --git a/src/lib_p2p/p2p_point_state.ml b/src/lib_p2p/p2p_point_state.ml index 78ace67ae9..d967081721 100644 --- a/src/lib_p2p/p2p_point_state.ml +++ b/src/lib_p2p/p2p_point_state.ml @@ -44,13 +44,18 @@ let pp ppf = function Format.fprintf ppf "disconnected" module Info = struct - type greylisting_config = { + type reconnection_config = { factor : float; initial_delay : Time.System.Span.t; disconnection_delay : Time.System.Span.t; increase_cap : Time.System.Span.t; } + type reconnection_info = { + delay : Time.System.Span.t; + end_time : Time.System.t; + } + type 'data t = { point : Id.t; mutable trusted : bool; @@ -61,8 +66,7 @@ module Info = struct (P2p_peer.Id.t * Time.System.t) option; mutable known_public : bool; mutable last_disconnection : (P2p_peer.Id.t * Time.System.t) option; - mutable greylisting_delay : Time.System.Span.t; - mutable greylisting_end : Time.System.t; + mutable reconnection_info : reconnection_info option; events : Pool_event.t Ringo.Ring.t; watchers : Pool_event.t Lwt_watcher.input; } @@ -73,7 +77,7 @@ module Info = struct let log_size = 100 - let default_greylisting_config = + let default_reconnection_config = { factor = 1.2; initial_delay = Ptime.Span.of_int_s 1; @@ -81,7 +85,7 @@ module Info = struct increase_cap = Ptime.Span.of_int_s 172800 (* 2 days *); } - let greylisting_config_encoding = + let reconnection_config_encoding = let open Data_encoding in conv (fun {factor; initial_delay; disconnection_delay; increase_cap} -> @@ -92,36 +96,36 @@ module Info = struct (dft "factor" ~description: - "The factor by which the greylisting delay is increased when an \ - already greylisted peer is greylisted again. This value should \ - be set to 1 for a linear back-off and to >1 for an exponential \ - back-off." + "The factor by which the reconnection delay is increased when a \ + peer that was previously disconnected is disconnected again. \ + This value should be set to 1 for a linear back-off and to >1 \ + for an exponential back-off." float - default_greylisting_config.factor) + default_reconnection_config.factor) (dft "initial-delay" ~description: - "The span of time a peer is greylisted for when it is first \ - greylisted." + "The span of time a peer is disconnected for when it is first \ + disconnected." Time.System.Span.encoding - default_greylisting_config.initial_delay) + default_reconnection_config.initial_delay) (dft "disconnection-delay" ~description: - "The span of time a peer is greylisted for when it is \ - greylisted as the result of an abrupt disconnection." + "The span of time a peer is disconnected for when it is \ + disconnected as the result of an error." Time.System.Span.encoding - default_greylisting_config.disconnection_delay) + default_reconnection_config.disconnection_delay) (dft "increase-cap" ~description: - "The maximum amount by which the greylisting is extended. This \ + "The maximum amount by which the reconnection is extended. This \ limits the rate of the exponential back-off, which eventually \ becomes linear when it reaches this limit. This limit is set \ - to avoid reaching the End-of-Time when repeatedly greylisting \ + to avoid reaching the End-of-Time when repeatedly reconnection \ a peer." Time.System.Span.encoding - default_greylisting_config.increase_cap)) + default_reconnection_config.increase_cap)) let create ?(trusted = false) addr port = { @@ -134,8 +138,7 @@ module Info = struct last_disconnection = None; known_public = false; events = Ringo.Ring.create log_size; - greylisting_delay = Ptime.Span.of_int_s 1; - greylisting_end = Time.System.epoch; + reconnection_info = None; watchers = Lwt_watcher.create_input (); } @@ -147,6 +150,8 @@ module Info = struct let unset_trusted gi = gi.trusted <- false + let reset_reconnection_delay gi = gi.reconnection_info <- None + let last_established_connection s = s.last_established_connection let last_disconnection s = s.last_disconnection @@ -157,9 +162,17 @@ module Info = struct let known_public s = s.known_public - let greylisted ~now s = Time.System.compare now s.greylisting_end <= 0 + let can_reconnect ~now {reconnection_info; _} = + (* TODO : use Option.map_default when will be available *) + match reconnection_info with + | None -> + false + | Some gr -> + Time.System.compare now gr.end_time <= 0 - let greylisted_until s = s.greylisting_end + let reconnection_time {reconnection_info; _} = + (* TODO : use Option.map_default when will be available *) + match reconnection_info with None -> None | Some gr -> Some gr.end_time let last_seen s = Time.System.recent @@ -246,35 +259,45 @@ let set_running ~timestamp point_info peer_id data = let maxed_time_add t s = match Ptime.add_span t s with Some t -> t | None -> Ptime.max -let set_greylisted greylisting_config timestamp point_info = - point_info.Info.greylisting_end <- - maxed_time_add timestamp point_info.Info.greylisting_delay ; - point_info.greylisting_delay <- - (let new_delay = - Time.System.Span.multiply_exn - greylisting_config.Info.factor - point_info.greylisting_delay - in - if Ptime.Span.compare greylisting_config.Info.increase_cap new_delay > 0 - then new_delay - else greylisting_config.Info.increase_cap) - -let set_disconnected ~timestamp ?(requested = false) greylisting_config +let set_reconnection_delay reconnection_config timestamp point_info = + let disconnection_delay = + match point_info.Info.reconnection_info with + | None -> + reconnection_config.Info.initial_delay + | Some gr -> + gr.delay + in + let end_time = maxed_time_add timestamp disconnection_delay in + let delay = + let new_delay = + Time.System.Span.multiply_exn + reconnection_config.Info.factor + disconnection_delay + in + if Ptime.Span.compare reconnection_config.Info.increase_cap new_delay > 0 + then new_delay + else reconnection_config.Info.increase_cap + in + point_info.Info.reconnection_info <- Some {delay; end_time} + +let set_disconnected ~timestamp ?(requested = false) reconnection_config point_info = let event : Pool_event.kind = match point_info.Info.state with | Requested _ -> - set_greylisted greylisting_config timestamp point_info ; + set_reconnection_delay reconnection_config timestamp point_info ; point_info.last_failed_connection <- Some timestamp ; Request_rejected None | Accepted {current_peer_id; _} -> - set_greylisted greylisting_config timestamp point_info ; + set_reconnection_delay reconnection_config timestamp point_info ; point_info.last_rejected_connection <- Some (current_peer_id, timestamp) ; Request_rejected (Some current_peer_id) | Running {current_peer_id; _} -> - point_info.greylisting_delay <- greylisting_config.Info.initial_delay ; - point_info.greylisting_end <- - maxed_time_add timestamp greylisting_config.Info.disconnection_delay ; + let delay = reconnection_config.Info.initial_delay in + let end_time = + maxed_time_add timestamp reconnection_config.Info.disconnection_delay + in + point_info.reconnection_info <- Some {delay; end_time} ; point_info.last_disconnection <- Some (current_peer_id, timestamp) ; if requested then Disconnection current_peer_id else External_disconnection current_peer_id diff --git a/src/lib_p2p/p2p_point_state.mli b/src/lib_p2p/p2p_point_state.mli index eecd3dc75c..8c28a15151 100644 --- a/src/lib_p2p/p2p_point_state.mli +++ b/src/lib_p2p/p2p_point_state.mli @@ -45,16 +45,16 @@ module Info : sig val compare : 'conn point_info -> 'conn point_info -> int - type greylisting_config = { + type reconnection_config = { factor : float; initial_delay : Time.System.Span.t; disconnection_delay : Time.System.Span.t; increase_cap : Time.System.Span.t; } - val default_greylisting_config : greylisting_config + val default_reconnection_config : reconnection_config - val greylisting_config_encoding : greylisting_config Data_encoding.encoding + val reconnection_config_encoding : reconnection_config Data_encoding.encoding (** [create ~trusted addr port] is a freshly minted point_info. If [trusted] is true, this point is considered trusted and will @@ -100,9 +100,17 @@ module Info : sig *) val last_miss : 'conn point_info -> Time.System.t option - val greylisted : now:Time.System.t -> 'conn point_info -> bool + (* [reset_reconnection_delay] Reset the reconnection_delay for this point + practically allowing the node to try the connection immediately *) + val reset_reconnection_delay : 'conn point_info -> unit - val greylisted_until : 'conn point_info -> Time.System.t + (* [can_reconnect] Check if a point is greylisted w.r.t. the current time *) + val can_reconnect : now:Time.System.t -> 'conn point_info -> bool + + (* [reconnection_time] Return the time at which the node can try to + reconnect with this point, Or None if the point is already in state + running or can be recontacted immediately *) + val reconnection_time : 'conn point_info -> Time.System.t option val point : 'conn point_info -> Id.t @@ -133,9 +141,11 @@ val set_running : val set_private : 'conn Info.t -> bool -> unit +(* [set_disconnected] Change the state of a peer upon disconnection and + set the reconnection delay accordingly *) val set_disconnected : timestamp:Time.System.t -> ?requested:bool -> - Info.greylisting_config -> + Info.reconnection_config -> 'conn Info.t -> unit diff --git a/src/lib_p2p/test/process.ml b/src/lib_p2p/test/process.ml index 3c57ddd8a3..ccebda4437 100644 --- a/src/lib_p2p/test/process.ml +++ b/src/lib_p2p/test/process.ml @@ -2,6 +2,7 @@ (* *) (* Open Source License *) (* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* Copyright (c) 2020 Nomadic Labs, *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) @@ -34,7 +35,7 @@ let log_f ~level format = Format.ikfprintf (fun _ -> Lwt.return_unit) Format.std_formatter format else Format.kasprintf (fun msg -> Lwt_log.log ~section ~level msg) format -let lwt_debug fmt = log_f ~level:Lwt_log.Debug fmt +let _lwt_debug fmt = log_f ~level:Lwt_log.Debug fmt let lwt_log_notice fmt = log_f ~level:Lwt_log.Notice fmt @@ -48,81 +49,240 @@ exception Signaled of int exception Stopped of int -let handle_error f = - Lwt.catch f (fun exn -> Lwt.return_error [Exn exn]) +let dummy_encoding flags : 'a Data_encoding.encoding = + let flags = Option.value ~default:[] flags in + Data_encoding.conv + (fun a -> Marshal.to_bytes a flags) + (fun buf -> Marshal.from_bytes buf 0) + Data_encoding.bytes + +let write ~value_encoding ~flags outch v = + let value_encoding = + Option.value ~default:(dummy_encoding flags) value_encoding + in + protect + (fun () -> + ( match Data_encoding.Binary.to_bytes value_encoding v with + | Ok encoded_v -> + Lwt_io.write_value outch encoded_v + | Error err -> + Stdlib.failwith + @@ Format.asprintf + "Value encoding failed %a" + Data_encoding.Binary.pp_write_error + err ) + >>= return) + ~on_error:(fun err -> + Lwt.return @@ Error (Exn (Failure ("write error " ^ __LOC__)) :: err)) + +let read ~value_encoding ~flags inch = + let value_encoding = + Option.value ~default:(dummy_encoding flags) value_encoding + in + protect + (fun () -> + Lwt_io.read_value inch + >>= fun encoded_v -> + ( match Data_encoding.Binary.of_bytes value_encoding encoded_v with + | Ok decoded_v -> + Lwt.return decoded_v + | Error err -> + Stdlib.failwith + @@ Format.asprintf + "Value encoding failed %a" + Data_encoding.Binary.pp_read_error + err ) + >>= return) + ~on_error:(fun err -> + Lwt.return @@ Error (Exn (Failure ("read error " ^ __LOC__)) :: err)) + +let received_result ~value_encoding ~flags child_exit = + let value_encoding = + Option.some @@ Error_monad.result_encoding + @@ Option.value ~default:(dummy_encoding flags) value_encoding + in + read ~value_encoding ~flags child_exit >>= function - | Ok () -> - Lwt.return_unit + | Ok (Ok _ as res) | (Error _ as res) | Ok (Error _ as res) -> Lwt.return res + +let send_result ~value_encoding ~flags child_exit result = + let value_encoding = + Option.some @@ Error_monad.result_encoding + @@ Option.value ~default:(dummy_encoding flags) value_encoding + in + write ~value_encoding ~flags child_exit result + +let handle_result ~value_encoding ~flags canceler f child_exit = + protect + ~canceler + (fun () -> + f () + >>=? fun v -> + send_result ~value_encoding ~flags child_exit (Ok v) + >>=? fun () -> return 0) + ~on_error:(fun err -> + lwt_log_error + "@[Detached process ended with error.@[%a@]@]@." + pp_print_error + err + >>= fun () -> + send_result ~value_encoding ~flags child_exit (Error err) + >>=? fun () -> return 0) + >>= function + | Ok exit_code -> + Lwt.return exit_code | Error err -> - lwt_debug "%a" pp_print_error err >>= fun () -> exit 1 + lwt_log_error + "@[Unexpected error when handling detached function result: \ + @[%a@]@]@." + Error_monad.pp_print_error + err + >>= fun () -> Lwt.return 255 module Channel = struct - type ('a, 'b) t = Lwt_io.input_channel * Lwt_io.output_channel + type ('a, 'b) t = { + inch : Lwt_io.input_channel; + outch : Lwt_io.output_channel; + input_encoding : 'b Data_encoding.encoding option; + output_encoding : 'a Data_encoding.encoding option; + flags : Marshal.extern_flags list option; + } - let push (_, outch) v = + (** Creating the endpoint from input and output channel. + If no encoding is given, the values will be serialized using hte + Marshal module, with the given flags (if any is provided) + *) + let make ?input_encoding ?output_encoding ?flags inch outch = + {inch; outch; input_encoding; output_encoding; flags} + + let push {outch; output_encoding; flags; _} v = Lwt.catch - (fun () -> Lwt_io.write_value outch v >>= Lwt.return_ok) + (fun () -> + let value_encoding = output_encoding in + write ~value_encoding ~flags outch v) (fun exn -> Lwt.return_error [Exn exn]) - let pop (inch, _) = + let pop {inch; input_encoding; flags; _} = Lwt.catch - (fun () -> Lwt_io.read_value inch >>= Lwt.return_ok) + (fun () -> + let value_encoding = input_encoding in + read ~value_encoding ~flags inch) (fun exn -> Lwt.return_error [Exn exn]) end -let wait pid = +let terminate pid = + (try Unix.kill pid Sys.sigkill with _ -> ()) ; + ignore (Lwt_unix.waitpid [] pid) + +let wait ~value_encoding ~flags pid result_ch = Lwt.catch (fun () -> Lwt_unix.waitpid [] pid >>= function | (_, Lwt_unix.WEXITED 0) -> - Lwt.return_ok () + received_result ~value_encoding ~flags result_ch | (_, Lwt_unix.WEXITED n) -> - Lwt.return_error [Exn (Exited n)] + Lwt.return (error (Exn (Exited n))) | (_, Lwt_unix.WSIGNALED n) -> - Lwt.return_error [Exn (Signaled n)] + Lwt.return (error (Exn (Signaled n))) | (_, Lwt_unix.WSTOPPED n) -> - Lwt.return_error [Exn (Stopped n)]) + Lwt.return (error (Exn (Stopped n)))) (function | Lwt.Canceled -> - Unix.kill pid Sys.sigkill ; Lwt.return_ok () + terminate pid ; Error_monad.fail Canceled | exn -> - Lwt.return_error [Exn exn]) + Error_monad.fail (Exn exn)) -type ('a, 'b) t = { - termination : unit tzresult Lwt.t; +type ('a, 'b, 'c) t = { + termination : 'c tzresult Lwt.t; channel : ('b, 'a) Channel.t; + prefix : string; + input_encoding : 'b Data_encoding.encoding option; + output_encoding : 'a Data_encoding.encoding option; + value_encoding : 'c Data_encoding.encoding option; } let template = "$(date) - $(section): $(message)" -let detach ?(prefix = "") f = +let detach ?(prefix = "") ?canceler ?input_encoding ?output_encoding + ?value_encoding ?flags + (f : ('sent, 'received) Channel.t -> 'result tzresult Lwt.t) : + ('sent, 'received, 'result) t tzresult Lwt.t = + let canceler = Option.value ~default:(Lwt_canceler.create ()) canceler in Lwt_io.flush_all () >>= fun () -> - let (main_in, child_out) = Lwt_io.pipe () in - let (child_in, main_out) = Lwt_io.pipe () in - match Lwt_unix.fork () with - | 0 -> - Lwt_log.default := - Lwt_log.channel ~template ~close_mode:`Keep ~channel:Lwt_io.stderr () ; - Random.self_init () ; - let template = Format.asprintf "%s$(message)" prefix in - Lwt_main.run - ( Lwt_io.close main_in - >>= fun () -> - Lwt_io.close main_out - >>= fun () -> - Lwt_log.default := - Lwt_log.channel ~template ~close_mode:`Keep ~channel:Lwt_io.stderr () ; - lwt_log_notice "PID: %d" (Unix.getpid ()) - >>= fun () -> handle_error (fun () -> f (child_in, child_out)) ) ; - exit 0 - | pid -> - let termination = wait pid in - Lwt_io.close child_in - >>= fun () -> - Lwt_io.close child_out - >>= fun () -> Lwt.return {termination; channel = (main_in, main_out)} + protect + ~canceler + (fun () -> + let (main_in, child_out) = Lwt_io.pipe () in + let (child_in, main_out) = Lwt_io.pipe () in + let (main_result, child_exit) = Lwt_io.pipe () in + match Lwt_unix.fork () with + | 0 -> + Lwt_log.default := + Lwt_log.channel + ~template + ~close_mode:`Keep + ~channel:Lwt_io.stderr + () ; + Random.self_init () ; + (* Lwt_main.run *) + (let template = Format.asprintf "%s$(message)" prefix in + Lwt_io.close main_in + >>= fun () -> + Lwt_io.close main_out + >>= fun () -> + Lwt_io.close main_result + >>= fun () -> + Lwt_log.default := + Lwt_log.channel + ~template + ~close_mode:`Keep + ~channel:Lwt_io.stderr + () ; + lwt_log_notice "PID: %d" (Unix.getpid ()) + >>= fun () -> + handle_result + ~value_encoding + ~flags + canceler + (fun () -> + let chans = + Channel.make + ?input_encoding + ?output_encoding + child_in + child_out + in + f chans) + child_exit) + >>= exit + | pid -> + Lwt_canceler.on_cancel canceler (fun () -> + terminate pid ; Lwt.return_unit) ; + let termination = wait ~value_encoding ~flags pid main_result in + Lwt_io.close child_in + >>= fun () -> + Lwt_io.close child_out + >>= fun () -> + Lwt_io.close child_exit + >>= fun () -> + return + { + termination; + channel = + Channel.make + ?input_encoding:output_encoding + ?output_encoding:input_encoding + main_in + main_out; + prefix; + input_encoding; + output_encoding; + value_encoding; + }) + ~on_error:(fun err -> + Lwt_canceler.cancel canceler >>= fun _ -> Lwt.return (Error err)) let signal_name = let names = @@ -157,11 +317,150 @@ let signal_name = in fun n -> List.assoc n names +let print_errors plist = + Lwt_list.partition_p + (fun (_i, _prefix, p) -> + match p with Ok _ -> Lwt.return_true | _ -> Lwt.return_false) + plist + >>= fun (ok_list, errlist) -> + lwt_log_error + "@[Processes @[%a@] finished successfully.@]" + (fun ppf -> + List.iter (fun (i, pref, _) -> + Format.fprintf ppf "%d(%s)" i (String.trim pref))) + ok_list + >>= fun () -> + let (exnlist, errlist) = + List.partition + (fun (_i, _prefix, p) -> + match p with Error [Exn _] -> true | _ -> false) + errlist + in + Lwt_list.iter_s + (fun (i, prefix, p) -> + let prefix = String.trim prefix in + match p with + | Ok _ -> + Lwt.return_unit + | Error [Exn (Exited n)] -> + lwt_log_error + "@[Process %d (%s) finished with exit code %d@]" + i + prefix + n + | Error [Exn (Signaled n)] -> + lwt_log_error + "@[Process %d (%s) was killed by a SIG%s !@]" + i + prefix + (signal_name n) + | Error [Exn (Stopped n)] -> + lwt_log_error + "@[Process %d (%s) was stopped by a SIG%s !@]" + i + prefix + (signal_name n) + | Error err -> + lwt_log_error + "@[Process %d (%s) failed with error:@ @[ %a @]@]" + i + prefix + pp_print_error + err) + exnlist + >>= fun () -> + let (canceled_list, errlist) = + List.partition + (fun (_i, _prefix, p) -> + match p with + | Error [(Canceled | Exn Lwt.Canceled)] -> + true + | _ -> + false) + errlist + in + ( match canceled_list with + | [] -> + Lwt.return_unit + | _ -> + lwt_log_error + "@[ Following processes have been canceled @[%a@].@]" + (fun ppf -> + List.iter (fun (i, pref, _) -> + Format.fprintf ppf "@ %d(%s)" i (String.trim pref))) + canceled_list ) + >>= fun () -> + Lwt_list.iter_s + (fun (i, prefix, p) -> + let prefix = String.trim prefix in + match p with + | Ok _ -> + Lwt.return_unit + | Error err -> + lwt_log_error + "@[Process %d (%s) failed with error:@ @[ %a @]@]" + i + prefix + pp_print_error + err) + errlist + +let send {channel; _} v = Channel.push channel v + +let receive {channel; _} = Channel.pop channel + +let wait_result {termination; _} : 'result tzresult Lwt.t = termination + +type error += Par of (int * string * error) list + +let () = + register_recursive_error_kind + `Temporary + ~id:"parallel_errors" + ~title:"Parallel errors" + ~description: + "An error occured in at least one thread of a paralle\n execution." + ~pp:(fun ppf s -> + Format.fprintf + ppf + "@[%a@]@." + (Format.pp_print_list (fun ppf (i, prefix, err) -> + let prefix = String.trim prefix in + Format.fprintf + ppf + "@[at process %d (%s),@ @[%a@]@]" + i + prefix + pp_print_error + [err])) + s) + Data_encoding.( + fun error_encoding -> + obj1 + (req + "error_list" + (list + (obj3 + (req "processor" int16) + (req "prefix" string) + (req "error" error_encoding))))) + (function Par lst -> Some lst | _ -> None) + (fun lst -> Par lst) + +let join (plist : 'a Lwt.t list) = + Lwt_list.map_s (fun (p : 'a Lwt.t) -> p) plist + +let join_process (plist : ('a, 'b, 'c) t list) = + Lwt_list.map_p + (fun {termination; prefix; _} -> + termination >>= fun t -> Lwt.return (prefix, t)) + plist + (** Wait for all processes to terminate. If a node terminates with an error, all remaining processes are canceled and an exception is raised *) -let wait_all processes = +let wait_all_results (processes : ('a, 'b, 'c) t list) = let rec loop processes = match processes with | [] -> @@ -173,39 +472,55 @@ let wait_all processes = let rec handle = function | [] -> loop remaining - | Ok () :: finished -> + | Ok _ :: finished -> handle finished | Error err :: _ -> - Lwt.return_some (err, remaining) + Lwt.return_some + ( err, + List.map + (fun remain -> remain >>= fun _ -> return_unit) + remaining ) in handle finished ) in - loop (List.map (fun p -> p.termination) processes) + let terminations = List.map (fun p -> p.termination) processes in + loop terminations >>= function | None -> - lwt_log_info "All done!" >>= fun () -> Lwt.return_ok () - | Some ([Exn (Exited n)], remaining) -> - lwt_log_error "Early error!" - >>= fun () -> - List.iter Lwt.cancel remaining ; - join_ep remaining - >>= fun _ -> failwith "A process finished with error %d !" n - | Some ([Exn (Signaled n)], remaining) -> - lwt_log_error "Early error!" + lwt_log_info "All done!" >>= fun () -> - List.iter Lwt.cancel remaining ; - join_ep remaining - >>= fun _ -> failwith "A process was killed by a SIG%s !" (signal_name n) - | Some ([Exn (Stopped n)], remaining) -> - lwt_log_error "Early error!" - >>= fun () -> - List.iter Lwt.cancel remaining ; - join_ep remaining - >>= fun _ -> - failwith "A process was stopped by a SIG%s !" (signal_name n) - | Some (err, remaining) -> - lwt_log_error "@[Unexpected error!@,%a@]" pp_print_error err + join terminations + >>= fun terminated -> + return + @@ List.map (function Ok a -> a | Error _ -> assert false) terminated + | Some (_err, remaining) -> + lwt_log_error "Early error! Canceling remaining process." >>= fun () -> List.iter Lwt.cancel remaining ; - join_ep remaining - >>= fun _ -> failwith "A process finished with an unexpected error !" + join_process processes + >>= fun terminated -> + let terminated = + List.mapi (fun i (prefix, a) -> (i, prefix, a)) terminated + in + let errors = + List.filter_map + (function + | (_, _, Ok _) -> + None + | (i, prefix, Error (err :: _)) -> + Some (i, prefix, err) + | (i, prefix, Error []) -> + Some + ( i, + prefix, + Exn + (Invalid_argument "process returned an empty error trace") + )) + terminated + in + print_errors terminated >>= fun _ -> Lwt.return @@ error (Par errors) + +let wait_all pl = + wait_all_results pl + >>= function + | Ok _ -> return_unit | Error err -> failwith "%a" pp_print_error err diff --git a/src/lib_p2p/test/process.mli b/src/lib_p2p/test/process.mli index 105bb10d6a..7a617718d1 100644 --- a/src/lib_p2p/test/process.mli +++ b/src/lib_p2p/test/process.mli @@ -23,26 +23,118 @@ (* *) (*****************************************************************************) +(** {1} Function evaluation in a detached process + + This library uses a process detached in a separated unix thread to + execute a given function, with bidirectional communication channels + and transmission of the function result at the end of the + execution. + + The communication channels does not require a data encoding, but + the data encoding can be given. In absence of data encoding the + Marshal mecanism will be used. Be aware that extensible types, like + error or exception cannot be safely exchanged between processes. + + Flags for Marshal serialisation can be passed at the creation of + the detached process. + + *) open Error_monad exception Exited of int +(** Endpoint of a bidirectionnal channel. *) module Channel : sig - type ('a, 'b) t + (** A bidirectionnal channel endpoint. *) + type ('sent, 'received) t - val push : ('a, 'b) t -> 'a -> unit tzresult Lwt.t + (** Asynchronously sending a value *) + val push : ('sent, 'received) t -> 'sent -> unit tzresult Lwt.t - val pop : ('a, 'b) t -> 'b tzresult Lwt.t + (** Waiting for a value. *) + val pop : ('sent, 'received) t -> 'received tzresult Lwt.t end -type ('a, 'b) t = { - termination : unit tzresult Lwt.t; - channel : ('b, 'a) Channel.t; -} +(** Detached process. *) +type ('sent, 'received, 'result) t + +(** Executing a function in a detached process. + [prefix] will be used in detached process logs. + On canceling of [canceler], the detached process will be killed by + SIGKILL. + + [input_encoding] and [output_encoding], if provided, will be used + to exchange values between the main thread and the detached thread + [input_encoding] is for values received by the detached thread. + [output_encoding] is for values sent by the detached thread. + In absence of data encoding the Marshal mecanism will be used. + Be aware that extensible types, like error or exception cannot be + safely exchanged between processes. + + [value_encoding] is for the encoding of the result of the detached + function. + The Error_monad encapsulation part of the value computed by the + detached function will be safely encoded, even without encoding + for the ['result] type. Ie if the detached function end with an + error, the error will safely be serialized-deserialised. + + If no encoding is given, the values will be serialized using hte + Marshal module, with the given [flags] (if any is provided). + + *) val detach : ?prefix:string -> - (('a, 'b) Channel.t -> unit tzresult Lwt.t) -> - ('a, 'b) t Lwt.t + ?canceler:Lwt_canceler.t -> + ?input_encoding:'received Data_encoding.encoding -> + ?output_encoding:'sent Data_encoding.encoding -> + ?value_encoding:'result Data_encoding.encoding -> + ?flags:Marshal.extern_flags list -> + (('sent, 'received) Channel.t -> 'result tzresult Lwt.t) -> + ('sent, 'received, 'result) t tzresult Lwt.t + +(** Sending a data to the detached process *) +val send : ('a, 'received, 'c) t -> 'received -> unit tzresult Lwt.t + +(** Receiving a data from the detached process. + This call is blocking. + *) +val receive : ('sent, 'b, 'c) t -> 'sent tzresult Lwt.t + +(** Receiving the result of the detached function. + This call is blocking. + *) +val wait_result : ('a, 'b, 'result) t -> 'result tzresult Lwt.t + +(** {2} Working with list of detached process *) + +(** Gathering a list of error happening in parallel. + First value is the number of the detached process, + Second value is its prefix, + Third value is the error returned by the process. + *) +type error += Par of (int * string * error) list + +(** Waiting for all the detached function to finish, unless one + of the function return an error. + + If all detached functions succesfully compute a value, return the list of + values. + + If at least one function end with en error, cancel all the + unfinished process, and return a [Par] error gathering the list of + errors for unsuccesful process. + + *) +val wait_all_results : ('a, 'b, 'c) t list -> 'c list tzresult Lwt.t + +(** Waiting for all the detached function to finish, unless one + of the function return an error. + + If all detached functions succesfully compute a value, return unit. + + If at least one function end with en error, cancel all the + unfinished process, and fail with a message containing all the errors. -val wait_all : ('a, 'b) t list -> unit tzresult Lwt.t + *) +val wait_all : ('a, 'b, 'c) t list -> unit tzresult Lwt.t diff --git a/src/lib_p2p/test/test_p2p_io_scheduler.ml b/src/lib_p2p/test/test_p2p_io_scheduler.ml index 7af2bc27c2..4fb14b9b54 100644 --- a/src/lib_p2p/test/test_p2p_io_scheduler.ml +++ b/src/lib_p2p/test/test_p2p_io_scheduler.ml @@ -2,6 +2,7 @@ (* *) (* Open Source License *) (* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* Copyright (c) 2020 Nomadic Labs, *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) @@ -165,7 +166,9 @@ let run ?display_client_stat ?max_download_speed ?max_upload_speed >>= fun () -> listen ?port addr >>= fun (main_socket, port) -> - Process.detach ~prefix:"server: " (fun _ -> + Process.detach + ~prefix:"server: " + (fun (_ : (unit, unit) Process.Channel.t) -> server ?display_client_stat ?max_download_speed @@ -173,7 +176,7 @@ let run ?display_client_stat ?max_download_speed ?max_upload_speed ?read_queue_size main_socket n) - >>= fun server_node -> + >>=? fun server_node -> let client n = let prefix = Printf.sprintf "client(%d): " n in Process.detach ~prefix (fun _ -> @@ -187,8 +190,8 @@ let run ?display_client_stat ?max_download_speed ?max_upload_speed >>= fun () -> client ?max_upload_speed ?write_queue_size addr port time n) in - Lwt_list.map_p client (1 -- n) - >>= fun client_nodes -> Process.wait_all (server_node :: client_nodes) + Error_monad.map_s client (1 -- n) + >>=? fun client_nodes -> Process.wait_all (server_node :: client_nodes) let () = Random.self_init () diff --git a/src/lib_p2p/test/test_p2p_pool.ml b/src/lib_p2p/test/test_p2p_pool.ml index 8eeef2fd2c..7124606e43 100644 --- a/src/lib_p2p/test/test_p2p_pool.ml +++ b/src/lib_p2p/test/test_p2p_pool.ml @@ -2,7 +2,7 @@ (* *) (* Open Source License *) (* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* Copyright (c) 2019 Nomadic Labs, *) +(* Copyright (c) 2019-2020 Nomadic Labs, *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) @@ -87,6 +87,7 @@ let conn_meta_config : metadata P2p_params.conn_meta_config = private_node = (fun _ -> false); } +(** Syncing inside the detached process *) let sync iteration ch = incr iteration ; lwt_debug "Sync iteration %i" !iteration @@ -94,12 +95,11 @@ let sync iteration ch = Process.Channel.push ch () >>=? fun () -> Process.Channel.pop ch >>=? fun () -> return_unit -(** Syncing everyone until one node fails to sync *) +(** Syncing from the main process everyone until one node fails to sync *) let rec sync_nodes nodes = - iter_p (fun {Process.channel; _} -> Process.Channel.pop channel) nodes + Error_monad.iter_p (fun p -> Process.receive p) nodes >>=? fun () -> - iter_p (fun {Process.channel; _} -> Process.Channel.push channel ()) nodes - >>=? fun () -> sync_nodes nodes + iter_p (fun p -> Process.send p ()) nodes >>=? fun () -> sync_nodes nodes let sync_nodes nodes = sync_nodes nodes @@ -109,9 +109,10 @@ let sync_nodes nodes = | Error _ as err -> Lwt.return err +(**Detach a process with a p2p_pool and a welcome worker. *) let detach_node ?(prefix = "") ?timeout ?(min_connections : int option) ?max_connections ?max_incoming_connections ?p2p_versions - ?(msg_config = msg_config) f trusted_points all_points addr port = + ?(msg_config = msg_config) canceler f trusted_points all_points addr port = let trusted_points = List.filter (fun p -> not (P2p_point.Id.equal (addr, port) p)) @@ -129,7 +130,7 @@ let detach_node ?(prefix = "") ?timeout ?(min_connections : int option) proof_of_work_target; listening_port = Some port; private_mode; - greylisting_config = P2p_point_state.Info.default_greylisting_config; + reconnection_config = P2p_point_state.Info.default_reconnection_config; min_connections = unopt min_connections; max_connections = unopt max_connections; max_incoming_connections = unopt max_incoming_connections; @@ -152,12 +153,16 @@ let detach_node ?(prefix = "") ?timeout ?(min_connections : int option) max_known_peer_ids = None; } in - (* swap_linger = Time.System.Span.of_seconds_exn 0. ; *) Process.detach ~prefix: - (Format.asprintf "%s%a: " prefix P2p_peer.Id.pp_short identity.peer_id) + (Format.asprintf + "%s%a:%d: " + prefix + P2p_peer.Id.pp_short + identity.peer_id + port) + ~canceler (fun channel -> - let canceler = Lwt_canceler.create () in let timer ti = Lwt_unix.sleep ti >>= fun () -> lwt_debug "Process timeout" in @@ -222,10 +227,20 @@ let detach_node ?(prefix = "") ?timeout ?(min_connections : int option) P2p_io_scheduler.shutdown sched >>= fun () -> lwt_log_info "Bye.@." >>= fun () -> return_unit)) +(**Detach one process per id in [points], each with a p2p_pool and a + welcome worker. + + Most arguments are the same as for [detach_node] but they are + function that specify the value of the argument for a given position + in the list of points, allowing to specify the characteristics of + each detached node. + + *) let detach_nodes ?prefix ?timeout ?min_connections ?max_connections ?max_incoming_connections ?p2p_versions ?msg_config run_node ?(trusted = fun _ points -> points) points = - Lwt_list.mapi_p + let canceler = Lwt_canceler.create () in + Lwt_list.mapi_s (fun n _ -> let prefix = Option.map (fun f -> f n) prefix in let p2p_versions = Option.map (fun f -> f n) p2p_versions in @@ -244,6 +259,7 @@ let detach_nodes ?prefix ?timeout ?min_connections ?max_connections ?max_connections ?max_incoming_connections ?msg_config + canceler (run_node n) (trusted n points) other_points @@ -251,6 +267,8 @@ let detach_nodes ?prefix ?timeout ?min_connections ?max_connections port) points >>= fun nodes -> + Lwt.return @@ Error_monad.map2 (fun p _p -> p) nodes nodes + >>=? fun nodes -> Lwt.ignore_result (sync_nodes nodes) ; Process.wait_all nodes diff --git a/src/lib_p2p/test/test_p2p_socket.ml b/src/lib_p2p/test/test_p2p_socket.ml index 695750bb1c..138de851a2 100644 --- a/src/lib_p2p/test/test_p2p_socket.ml +++ b/src/lib_p2p/test/test_p2p_socket.ml @@ -2,7 +2,7 @@ (* *) (* Open Source License *) (* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* Copyright (c) 2019 Nomadic Labs, *) +(* Copyright (c) 2019-2020 Nomadic Labs, *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) @@ -84,10 +84,9 @@ let sync ch = >>=? fun () -> Process.Channel.pop ch >>=? fun () -> return_unit let rec sync_nodes nodes = - iter_p (fun {Process.channel; _} -> Process.Channel.pop channel) nodes + iter_p (fun p -> Process.receive p) nodes >>=? fun () -> - iter_p (fun {Process.channel; _} -> Process.Channel.push channel ()) nodes - >>=? fun () -> sync_nodes nodes + iter_p (fun p -> Process.send p ()) nodes >>=? fun () -> sync_nodes nodes let sync_nodes nodes = sync_nodes nodes @@ -104,7 +103,7 @@ let run_nodes client server = let sched = P2p_io_scheduler.create ~read_buffer_size:(1 lsl 12) () in server channel sched main_socket >>=? fun () -> P2p_io_scheduler.shutdown sched >>= fun () -> return_unit) - >>= fun server_node -> + >>=? fun server_node -> Process.detach ~prefix:"client: " (fun channel -> Lwt_utils_unix.safe_close main_socket >>= (function @@ -117,7 +116,7 @@ let run_nodes client server = let sched = P2p_io_scheduler.create ~read_buffer_size:(1 lsl 12) () in client channel sched !addr port >>=? fun () -> P2p_io_scheduler.shutdown sched >>= fun () -> return_unit) - >>= fun client_node -> + >>=? fun client_node -> let nodes = [server_node; client_node] in Lwt.ignore_result (sync_nodes nodes) ; Process.wait_all nodes diff --git a/src/lib_protocol_compiler/dune_protocol.template b/src/lib_protocol_compiler/dune_protocol.template index 3b032e74ba..d2d592d849 100644 --- a/src/lib_protocol_compiler/dune_protocol.template +++ b/src/lib_protocol_compiler/dune_protocol.template @@ -53,7 +53,7 @@ include Tezos_raw_protocol_%%LIB_VERSION%%.Main (library_flags (:standard -linkall)) (flags (:standard -nopervasives -nostdlib -w +a-4-6-7-9-29-32-40..42-44-45-48 - -warn-error -a+8 + -warn-error +a -open Tezos_protocol_environment_%%LIB_VERSION%%__Environment -open Pervasives -open Error_monad)) @@ -73,7 +73,7 @@ include Tezos_raw_protocol_%%LIB_VERSION%%.Main tezos-protocol-environment-sigs tezos_raw_protocol_%%LIB_VERSION%%) (flags -w "+a-4-6-7-9-29-40..42-44-45-48" - -warn-error "-a+8" + -warn-error "+a" -nopervasives) (modules Protocol)) @@ -85,7 +85,7 @@ include Tezos_raw_protocol_%%LIB_VERSION%%.Main tezos-protocol-environment-sigs tezos_raw_protocol_%%LIB_VERSION%%) (flags -w "+a-4-6-7-9-29-40..42-44-45-48" - -warn-error "-a+8" + -warn-error "+a" -nopervasives) (modules Functor)) @@ -97,7 +97,7 @@ include Tezos_raw_protocol_%%LIB_VERSION%%.Main tezos-protocol-updater tezos-protocol-environment) (flags (:standard -w +a-4-6-7-9-29-32-40..42-44-45-48 - -warn-error -a+8)) + -warn-error +a)) (modules Registerer)) (alias diff --git a/src/lib_protocol_environment/environment_V0.ml b/src/lib_protocol_environment/environment_V0.ml index 6222ad845a..34122c4354 100644 --- a/src/lib_protocol_environment/environment_V0.ml +++ b/src/lib_protocol_environment/environment_V0.ml @@ -2,7 +2,7 @@ (* *) (* Open Source License *) (* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* Copyright (c) 2018 Nomadic Labs. *) +(* Copyright (c) 2018 Nomadic Labs. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) diff --git a/src/lib_protocol_environment/environment_V0.mli b/src/lib_protocol_environment/environment_V0.mli index 32bbdca952..0bdbf3b876 100644 --- a/src/lib_protocol_environment/environment_V0.mli +++ b/src/lib_protocol_environment/environment_V0.mli @@ -2,7 +2,7 @@ (* *) (* Open Source License *) (* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* Copyright (c) 2018 Nomadic Labs. *) +(* Copyright (c) 2018 Nomadic Labs. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) diff --git a/src/lib_protocol_environment/environment_protocol_T.ml b/src/lib_protocol_environment/environment_protocol_T.ml index e8e7d6f9ad..e992b3ec94 100644 --- a/src/lib_protocol_environment/environment_protocol_T.ml +++ b/src/lib_protocol_environment/environment_protocol_T.ml @@ -2,7 +2,7 @@ (* *) (* Open Source License *) (* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* Copyright (c) 2018 Nomadic Labs. *) +(* Copyright (c) 2018 Nomadic Labs. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) diff --git a/src/lib_protocol_environment/environment_protocol_T_V0.ml b/src/lib_protocol_environment/environment_protocol_T_V0.ml index cd2686d700..dabd2ff47b 100644 --- a/src/lib_protocol_environment/environment_protocol_T_V0.ml +++ b/src/lib_protocol_environment/environment_protocol_T_V0.ml @@ -2,7 +2,7 @@ (* *) (* Open Source License *) (* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* Copyright (c) 2018 Nomadic Labs. *) +(* Copyright (c) 2018 Nomadic Labs. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) diff --git a/src/lib_protocol_updater/updater.ml b/src/lib_protocol_updater/updater.ml index bd46135e17..581dd3c9ea 100644 --- a/src/lib_protocol_updater/updater.ml +++ b/src/lib_protocol_updater/updater.ml @@ -35,7 +35,7 @@ let get_datadir () = match !datadir with | None -> fatal_error "Node not initialized" ; - Lwt_exit.exit 1 + Lwt_exit.exit_and_raise 1 | Some m -> m diff --git a/src/lib_shell/block_validator_process.ml b/src/lib_shell/block_validator_process.ml index 9d7dfb02f2..1006f11df8 100644 --- a/src/lib_shell/block_validator_process.ml +++ b/src/lib_shell/block_validator_process.ml @@ -2,7 +2,7 @@ (* *) (* Open Source License *) (* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* Copyright (c) 2018 Nomadic Labs. *) +(* Copyright (c) 2018 Nomadic Labs. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) @@ -33,6 +33,7 @@ type validator_environment = { type validator_kind = | Internal : Context.index -> validator_kind | External : { + data_dir : string; context_root : string; protocol_root : string; process_path : string; @@ -153,23 +154,55 @@ end module External_validator_process = struct include Block_validator_process_state.External_validator_events + type validator_process = { + process : Lwt_process.process_none; + stdin : Lwt_io.output_channel; + stdout : Lwt_io.input_channel; + canceler : Lwt_canceler.t; + } + type t = { + data_dir : string; context_root : string; protocol_root : string; genesis : Genesis.t; user_activated_upgrades : User_activated.upgrades; user_activated_protocol_overrides : User_activated.protocol_overrides; process_path : string; - mutable validator_process : Lwt_process.process_full option; + mutable validator_process : validator_process option; lock : Lwt_mutex.t; sandbox_parameters : Data_encoding.json option; } let send_request vp request result_encoding = let start_process () = + let canceler = Lwt_canceler.create () in + (* We assume that there is only one validation process per socket *) + (* TODO spawn the socket in $XDG_RUNTIME_DIR while making sure + it's portable *) let process = - Lwt_process.open_process_full (vp.process_path, [|"tezos-validator"|]) + Lwt_process.open_process_none + (vp.process_path, [|"tezos-validator"; "--socket-dir"; vp.data_dir|]) + in + let socket_path = + External_validation.socket_path ~data_dir:vp.data_dir ~pid:process#pid in + External_validation.create_socket_listen + ~canceler + ~max_requests:1 + ~socket_path + >>= fun process_socket -> + Lwt_unix.accept process_socket + >>= fun (process_socket, _) -> + (* As the external validation process is now started, we can + unlink the named socket. Indeed, the file descriptor will + remain valid until at least one process keep it open. This + method mimics an anonymous file descriptor without relying on + Linux specific features. *) + Lwt_unix.unlink socket_path + >>= fun () -> + let process_stdin = Lwt_io.of_fd ~mode:Output process_socket in + let process_stdout = Lwt_io.of_fd ~mode:Input process_socket in lwt_emit (Validator_started process#pid) >>= fun () -> let parameters = @@ -183,29 +216,41 @@ module External_validator_process = struct vp.user_activated_protocol_overrides; } in - vp.validator_process <- Some process ; + vp.validator_process <- + Some + {process; stdin = process_stdin; stdout = process_stdout; canceler} ; External_validation.send - process#stdin + process_stdin Data_encoding.Variable.bytes External_validation.magic >>= fun () -> + External_validation.recv process_stdout Data_encoding.Variable.bytes + >>= fun magic -> + fail_when + (not (Bytes.equal magic External_validation.magic)) + (Block_validator_errors.Validation_process_failed + (Inconsistent_handshake "bad magic")) + >>=? fun () -> External_validation.send - process#stdin + process_stdin External_validation.parameters_encoding parameters - >>= fun () -> Lwt.return process + >>= fun () -> return (process, process_stdin, process_stdout) in ( match vp.validator_process with - | Some process -> ( + | Some {process; stdin = process_stdin; stdout = process_stdout; canceler} + -> ( match process#state with | Running -> - Lwt.return process + return (process, process_stdin, process_stdout) | Exited status -> + Lwt_canceler.cancel canceler + >>= fun () -> vp.validator_process <- None ; lwt_emit (Process_status status) >>= fun () -> start_process () ) | None -> start_process () ) - >>= fun process -> + >>=? fun (process, process_stdin, process_stdout) -> Lwt.catch (fun () -> (* Make sure that the promise is not canceled between a send and recv *) @@ -214,11 +259,11 @@ module External_validator_process = struct lwt_timed_emit (Request request) >>= fun event_start -> External_validation.send - process#stdin + process_stdin External_validation.request_encoding request >>= fun () -> - External_validation.recv_result process#stdout result_encoding + External_validation.recv_result process_stdout result_encoding >>= fun res -> lwt_emit (Request_result (request, event_start)) >>= fun () -> Lwt.return res)) @@ -240,12 +285,13 @@ module External_validator_process = struct let init ({genesis; user_activated_upgrades; user_activated_protocol_overrides} : - validator_environment) context_root protocol_root process_path + validator_environment) data_dir context_root protocol_root process_path sandbox_parameters = lwt_emit Init >>= fun () -> let validator = { + data_dir; context_root; protocol_root; genesis; @@ -297,12 +343,12 @@ module External_validator_process = struct lwt_emit Close >>= fun () -> match vp.validator_process with - | Some process -> + | Some {process; stdin = process_stdin; canceler; _} -> let request = External_validation.Terminate in lwt_emit (Request request) >>= fun () -> External_validation.send - process#stdin + process_stdin External_validation.request_encoding request >>= fun () -> @@ -313,6 +359,8 @@ module External_validator_process = struct | _ -> process#terminate ; Lwt.return_unit) >>= fun () -> + Lwt_canceler.cancel canceler + >>= fun () -> vp.validator_process <- None ; Lwt.return_unit | None -> @@ -329,9 +377,12 @@ let init : validator_environment -> validator_kind -> t tzresult Lwt.t = (module Internal_validator_process) in return (E {validator_process; validator}) - | External {context_root; protocol_root; process_path; sandbox_parameters} -> + | External + {data_dir; context_root; protocol_root; process_path; sandbox_parameters} + -> External_validator_process.init validator_environment + data_dir context_root protocol_root process_path diff --git a/src/lib_shell/block_validator_process.mli b/src/lib_shell/block_validator_process.mli index 925c078a5d..0567bb905c 100644 --- a/src/lib_shell/block_validator_process.mli +++ b/src/lib_shell/block_validator_process.mli @@ -2,7 +2,7 @@ (* *) (* Open Source License *) (* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* Copyright (c) 2018 Nomadic Labs. *) +(* Copyright (c) 2018 Nomadic Labs. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) @@ -45,6 +45,7 @@ type validator_environment = { type validator_kind = | Internal : Context.index -> validator_kind | External : { + data_dir : string; context_root : string; protocol_root : string; process_path : string; diff --git a/src/lib_shell/block_validator_process_state.ml b/src/lib_shell/block_validator_process_state.ml index b71ef98e4e..5a4e775b1e 100644 --- a/src/lib_shell/block_validator_process_state.ml +++ b/src/lib_shell/block_validator_process_state.ml @@ -2,7 +2,7 @@ (* *) (* Open Source License *) (* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* Copyright (c) 2018 Nomadic Labs. *) +(* Copyright (c) 2018 Nomadic Labs. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) @@ -154,11 +154,17 @@ module External_validator_events = struct "The process terminated abnormally with value %i" i | WSIGNALED i -> - Format.fprintf ppf "The process was killed by signal %i" i + Format.fprintf + ppf + "The process was killed by signal %s" + (Lwt_exit.signal_name i) | WSTOPPED i -> - Format.fprintf ppf "The process was stopped by signal %i" i ) + Format.fprintf + ppf + "The process was stopped by signal %s" + (Lwt_exit.signal_name i) ) | Validator_started pid -> - Format.fprintf ppf "Block validator started on pid %i " pid + Format.fprintf ppf "Block validator started with pid %i" pid | Request r -> Format.fprintf ppf "Request for %a" External_validation.request_pp r | Request_result (req, start_time) -> diff --git a/src/lib_shell/node.ml b/src/lib_shell/node.ml index 879cb9e0e0..9652fc9563 100644 --- a/src/lib_shell/node.ml +++ b/src/lib_shell/node.ml @@ -92,6 +92,7 @@ type config = { sandboxed_chain_name : Distributed_db_version.Name.t; user_activated_upgrades : User_activated.upgrades; user_activated_protocol_overrides : User_activated.protocol_overrides; + data_dir : string; store_root : string; context_root : string; protocol_root : string; @@ -274,6 +275,7 @@ let create ?(sandboxed = false) ?sandbox_parameters ~singleprocess sandboxed_chain_name; user_activated_upgrades; user_activated_protocol_overrides; + data_dir; store_root; context_root; protocol_root; @@ -310,6 +312,7 @@ let create ?(sandboxed = false) ?sandbox_parameters ~singleprocess validator_environment (External { + data_dir; context_root; protocol_root; process_path = Sys.executable_name; diff --git a/src/lib_shell/node.mli b/src/lib_shell/node.mli index f0963d7627..236156c867 100644 --- a/src/lib_shell/node.mli +++ b/src/lib_shell/node.mli @@ -33,6 +33,7 @@ type config = { sandboxed_chain_name : Distributed_db_version.Name.t; user_activated_upgrades : User_activated.upgrades; user_activated_protocol_overrides : User_activated.protocol_overrides; + data_dir : string; store_root : string; context_root : string; protocol_root : string; diff --git a/src/lib_shell/patch_context.ml b/src/lib_shell/patch_context.ml index a59cbde00c..fe997b5fa4 100644 --- a/src/lib_shell/patch_context.ml +++ b/src/lib_shell/patch_context.ml @@ -2,7 +2,7 @@ (* *) (* Open Source License *) (* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* Copyright (c) 2018 Nomadic Labs. *) +(* Copyright (c) 2018 Nomadic Labs. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) diff --git a/src/lib_shell/patch_context.mli b/src/lib_shell/patch_context.mli index d06d3f6f8a..e4976f7977 100644 --- a/src/lib_shell/patch_context.mli +++ b/src/lib_shell/patch_context.mli @@ -2,7 +2,7 @@ (* *) (* Open Source License *) (* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* Copyright (c) 2018 Nomadic Labs. *) +(* Copyright (c) 2018 Nomadic Labs. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) diff --git a/src/lib_shell/snapshots.ml b/src/lib_shell/snapshots.ml index 1f73079eb9..25f16ebddf 100644 --- a/src/lib_shell/snapshots.ml +++ b/src/lib_shell/snapshots.ml @@ -2,7 +2,7 @@ (* *) (* Open Source License *) (* Copyright (c) 2019 Dynamic Ledger Solutions, Inc. *) -(* Copyright (c) 2019 Nomadic Labs. *) +(* Copyright (c) 2019 Nomadic Labs. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) diff --git a/src/lib_shell/snapshots.mli b/src/lib_shell/snapshots.mli index ab2e5965ee..da07f72842 100644 --- a/src/lib_shell/snapshots.mli +++ b/src/lib_shell/snapshots.mli @@ -2,7 +2,7 @@ (* *) (* Open Source License *) (* Copyright (c) 2019 Dynamic Ledger Solutions, Inc. *) -(* Copyright (c) 2019 Nomadic Labs. *) +(* Copyright (c) 2019 Nomadic Labs. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) diff --git a/src/lib_shell/test/test_node.ml b/src/lib_shell/test/test_node.ml index 785dd85f29..e6f48635ac 100644 --- a/src/lib_shell/test/test_node.ml +++ b/src/lib_shell/test/test_node.ml @@ -40,6 +40,7 @@ let init_config (* (f : 'a -> unit -> unit Lwt.t) *) f test_dir switch () : sandboxed_chain_name = Distributed_db_version.Name.zero; user_activated_upgrades = []; user_activated_protocol_overrides = []; + data_dir = test_dir; store_root = test_dir; context_root = test_dir; protocol_root = test_dir; @@ -64,7 +65,7 @@ let default_p2p : P2p.config = identity = P2p_identity.generate (Crypto_box.make_target 0.); proof_of_work_target = Crypto_box.default_target; trust_discovered_peers = false; - greylisting_config = P2p_point_state.Info.default_greylisting_config; + reconnection_config = P2p_point_state.Info.default_reconnection_config; } let default_p2p_limits : P2p.limits = diff --git a/src/lib_shell_services/block_validator_errors.ml b/src/lib_shell_services/block_validator_errors.ml index 2d8f970172..a719b7f406 100644 --- a/src/lib_shell_services/block_validator_errors.ml +++ b/src/lib_shell_services/block_validator_errors.ml @@ -2,7 +2,7 @@ (* *) (* Open Source License *) (* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* Copyright (c) 2018 Nomadic Labs. *) +(* Copyright (c) 2018 Nomadic Labs. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) diff --git a/src/lib_shell_services/block_validator_errors.mli b/src/lib_shell_services/block_validator_errors.mli index 585b1bfd2a..e1d9809473 100644 --- a/src/lib_shell_services/block_validator_errors.mli +++ b/src/lib_shell_services/block_validator_errors.mli @@ -2,7 +2,7 @@ (* *) (* Open Source License *) (* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* Copyright (c) 2018 Nomadic Labs. *) +(* Copyright (c) 2018 Nomadic Labs. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) diff --git a/src/lib_stdlib_unix/lwt_exit.ml b/src/lib_stdlib_unix/lwt_exit.ml index ed17a96fb8..120908dbc1 100644 --- a/src/lib_stdlib_unix/lwt_exit.ml +++ b/src/lib_stdlib_unix/lwt_exit.ml @@ -1,7 +1,7 @@ (*****************************************************************************) (* *) (* Open Source License *) -(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* Copyright (c) 2020 Nomadic Labs *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) @@ -23,37 +23,117 @@ (* *) (*****************************************************************************) -exception Exit - -let (termination_thread, exit_wakener) = Lwt.wait () - -let exit x = Lwt.wakeup exit_wakener x ; raise Exit - -let () = - Lwt.async_exception_hook := - function - | Exit -> - () - | e -> - let backtrace = Printexc.get_backtrace () in - let pp_exn_trace ppf backtrace = - if String.length backtrace <> 0 then - Format.fprintf - ppf - "@,Backtrace:@, @[%a@]" - Format.pp_print_text - backtrace +open Lwt.Infix + +(* 1. clean-up callback registration/unregistration *) + +(* Identifiers are used for unregistering clean-up callbacks *) +type clean_up_callback_id = int + +let clean_up_callback_id_counter = ref min_int + +let new_clean_up_callback_id () = + incr clean_up_callback_id_counter ; + !clean_up_callback_id_counter + +(* clean-up callbacks are stored in a reference to a map *) +module Callbacks_map = Map.Make (Int) + +type callback = { + callback : int -> unit Lwt.t; + after : clean_up_callback_id option; + loc : string; +} + +let clean_up_callbacks : callback Callbacks_map.t ref = ref Callbacks_map.empty + +(* adding and removing clean-up callbacks affects the global reference map *) +let register_clean_up_callback ?after ~loc callback = + let id = new_clean_up_callback_id () in + let callback = {callback; after; loc} in + clean_up_callbacks := Callbacks_map.add id callback !clean_up_callbacks ; + id + +let unregister_clean_up_callback id = + clean_up_callbacks := Callbacks_map.remove id !clean_up_callbacks + +(* 2. clean-up *) + +(* cleaning-up is just calling all the clean-up callbacks, note that the + function is not exported: it cannot be called directly, it can only be + triggered as a side effect to calling [exit_and_raise] or [exit_and_wait] *) +let clean_up status = + let callbacks = Callbacks_map.to_seq !clean_up_callbacks in + clean_up_callbacks := Callbacks_map.empty ; + let promises : unit Lwt.t Callbacks_map.t = + Seq.fold_left + (fun promises (id, {callback; after; loc}) -> + let pre = + match after with + | None -> + Lwt.return_unit + | Some after -> ( + match Callbacks_map.find_opt after promises with + | None -> + (* This can happen if the callback was unregistered *) + Lwt.return_unit + | Some p -> + p ) in - (* TODO Improve this *) - Format.eprintf - "@[@[Uncaught (asynchronous) exception (%d):@ %s@]%a@]@.%!" - (Unix.getpid ()) - (Printexc.to_string e) - pp_exn_trace - backtrace ; - Lwt.wakeup exit_wakener 1 - -let signals = + let promise = + Lwt.catch + (fun () -> pre >>= fun () -> callback status) + (fun exc -> + Format.eprintf + "Exit: uncaught exception during clean-up (%s): %s\n%!" + loc + (Printexc.to_string exc) ; + Lwt.return_unit) + in + Callbacks_map.add id promise promises) + Callbacks_map.empty + callbacks + in + Lwt.join (List.of_seq @@ Seq.map snd @@ Callbacks_map.to_seq promises) + +(* 3. synchronisation primitives *) + +(* [clean_up_starts] an exported promise that resolves when the clean-up starts. + [start_exiting] a non-exported resolver for the promise *) +let (clean_up_starts, start_clean_up) = Lwt.wait () + +(* [clean_up_ends] is a promise that resolves once the clean-up is finished. *) +let clean_up_ends = + clean_up_starts + >>= fun status -> clean_up status >>= fun () -> Lwt.return status + +(* 4. exiting *) + +(* simple exit is not exported, it is just to factor out exiting *) +let exit n = + match Lwt.state clean_up_starts with + | Sleep -> + Lwt.wakeup start_clean_up n + | Return _ -> + () + | Fail _ -> + assert false + +(* [exit_and_raise] is meant to be used deep inside the program after having + witnessed, say, a fatal error. It raises an exception so that it can be used + anywhere in the program. *) +let exit_and_raise n = exit n ; raise Exit + +(* [exit_and_wait] is meant to be used near the main invocation of the program, + right inside of [Lwt_main.run] but presumably after [wrap_and_error]. *) +let exit_and_wait n = exit n ; clean_up_ends + +(* 5. signals *) + +type signal_setup = {soft : (int * string) list; hard : (int * string) list} + +(** Known signals and their names *) +let all_signal_names = let open Sys in [ (sigabrt, "ABRT"); (sigalrm, "ALRM"); @@ -84,60 +164,179 @@ let signals = (sigxcpu, "XCPU"); (sigxfsz, "XFSZ") ] -let set_exit_handler ?(log = Format.eprintf "%s\n%!") signal = - match List.assoc_opt signal signals with - | None -> - Format.kasprintf - invalid_arg - "Killable.set_exit_handler: unknown signal %d" - signal +(** recovering the name of a signal *) +let signal_name signal = + match List.assoc_opt signal all_signal_names with | Some name -> - let handler signal = - try - Format.kasprintf - log - "Received the %s signal, triggering shutdown." - name ; - exit signal - with _ -> () - in - ignore (Lwt_unix.on_signal signal handler : Lwt_unix.signal_handler_id) - -(* Which signals is the program meant to exit on *) -let signals_to_exit_on = ref [] - -let exit_on ?log signal = - if List.mem signal !signals_to_exit_on then - Format.kasprintf - Stdlib.failwith - "Killable.exit_on: already registered signal %d" - signal - else ( - signals_to_exit_on := signal :: !signals_to_exit_on ; - set_exit_handler ?log signal ) - -type outcome = Resolved of int | Exited of int - -let retcode_of_unit_result_lwt p = - let open Lwt.Infix in - p - >>= function - | Error e -> - (* TODO: print *) ignore e ; Lwt.return 1 - | Ok () -> - Lwt.return 0 - -let wrap_promise (p : int Lwt.t) = - let open Lwt.Infix in - Lwt.choose - [(p >|= fun v -> Resolved v); (termination_thread >|= fun s -> Exited s)] - >>= function - | Resolved r -> - Lwt.return r - | Exited s -> - (*TODO: what are the correct expected behaviour here?*) - if List.mem s !signals_to_exit_on then ( - (* Exit because of signal *) - Lwt.cancel p ; Lwt.return 2 ) - else (* Other exit *) - Stdlib.exit 3 + name + | None -> + Format.asprintf "%d" signal + +let make_signal_setup ~soft ~hard = + try + let soft = List.map (fun signal -> (signal, signal_name signal)) soft in + let hard = List.map (fun signal -> (signal, signal_name signal)) hard in + {soft; hard} + with Not_found -> raise (Invalid_argument "Lwt_exit.make_signal_setup") + +let default_signal_setup = + make_signal_setup ~soft:[Sys.sigint; Sys.sigterm] ~hard:[] + +let sleep_span s = Lwt_unix.sleep (Ptime.Span.to_float_s s) + +let set_already_received_once double_signal_safety already_received_once name = + if Ptime.Span.(equal double_signal_safety zero) then ( + Format.eprintf "%s: send signal again to force-quit.\n%!" name ; + already_received_once := true ) + else + Lwt_utils.dont_wait + (fun _exc -> assert false) + (fun () -> + (* Wait one second for safety, then set force-quitting *) + sleep_span double_signal_safety + >>= fun () -> + Format.eprintf "%s: send signal again to force-quit.\n%!" name ; + already_received_once := true ; + Lwt.return_unit) + +let default_double_signal_safety = Option.get @@ Ptime.Span.of_float_s 1.0 + +(* soft handling: trigger an exit on first signal, immediately terminate + process on second signal *) +let set_soft_handler ?(double_signal_safety = default_double_signal_safety) + signal name = + let already_received_once = ref false in + Lwt_unix.on_signal signal (fun _signal -> + if !already_received_once then ( + Format.eprintf + "%s: signal received again, forcing immediate termination.\n%!" + name ; + Stdlib.exit 1 ) + else + match Lwt.state clean_up_starts with + | Sleep -> + Format.eprintf "%s: triggering shutdown.\n%!" name ; + exit 1 ; + set_already_received_once + double_signal_safety + already_received_once + name + | Return _ -> + Format.eprintf "%s: already in shutdown.\n%!" name ; + set_already_received_once + double_signal_safety + already_received_once + name + | Fail _ -> + assert false) + +(* hard handling: immediately terminate process *) +let set_hard_handler signal name = + Lwt_unix.on_signal signal (fun _signal -> + Format.eprintf "%s: force-quiting.\n%!" name ; + Stdlib.exit 1) + +let setup_signal_handlers ?double_signal_safety signal_setup = + let soft_handler_ids = + List.fold_left + (fun acc (signal, name) -> + set_soft_handler ?double_signal_safety signal name :: acc) + [] + signal_setup.soft + in + let all_handler_ids = + List.fold_left + (fun acc (signal, name) -> set_hard_handler signal name :: acc) + soft_handler_ids + signal_setup.hard + in + all_handler_ids + +let unset_handlers = List.iter Lwt_unix.disable_signal_handler + +(* 6. internal synchronisation *) + +let wait_for_clean_up max_clean_up_time = + (match Lwt.state clean_up_starts with Return _ -> () | _ -> assert false) ; + match Lwt.state clean_up_ends with + | Fail _ -> + assert false + | Return _ -> + Lwt.pause () + | Sleep -> + ( match max_clean_up_time with + | None -> + (* without timeout: just wait *) + clean_up_ends >>= fun _ -> Lwt.return_unit + | Some s -> + (* with timeout: pick first to finish *) + Lwt.pick [(clean_up_ends >>= fun _ -> Lwt.return_unit); sleep_span s] + ) + (* pause in case timeout and clean-up needs to deal with cancellation *) + >>= Lwt.pause + +(* 7. main interface: wrapping promises *) + +(* take a promise and wrap it in `Ok` but also watch for exiting and wrap that + in `Error` *) +let wrap_and_error ?(signal_setup = default_signal_setup) ?double_signal_safety + ?max_clean_up_time p = + let handler_ids = setup_signal_handlers ?double_signal_safety signal_setup in + Lwt.try_bind + (fun () -> + (* Watch out for both [p] and the start of clean-up *) + Lwt.choose [p >>= Lwt.return_ok; clean_up_starts >>= Lwt.return_error]) + (function + | Ok v -> + ( match Lwt.state clean_up_starts with + | Sleep -> + () + | _ -> + assert false ) ; + unset_handlers handler_ids ; Lwt.return (Ok v) + | Error status -> + ( match Lwt.state clean_up_starts with + | Return s -> + assert (s = status) + | _ -> + assert false ) ; + Lwt.cancel p ; + wait_for_clean_up max_clean_up_time + >>= fun () -> unset_handlers handler_ids ; Lwt.return (Error status)) + (function + | Exit -> ( + (* When [Exit] bubbles from the wrapped promise, maybe it called + [exit_and_raise] *) + Lwt.pause () + >>= fun () -> + match Lwt.state clean_up_starts with + | Return status -> + wait_for_clean_up max_clean_up_time + >>= fun () -> + unset_handlers handler_ids ; Lwt.return (Error status) + | Fail _ -> + assert false + | Sleep -> + exit 2 ; + Format.eprintf + "Exit: exit because of uncaught exception: %s\n%!" + (Printexc.to_string Exit) ; + wait_for_clean_up max_clean_up_time + >>= fun () -> unset_handlers handler_ids ; Lwt.return (Error 2) ) + | exc -> + exit 2 ; + Format.eprintf + "Exit: exit because of uncaught exception: %s\n%!" + (Printexc.to_string exc) ; + wait_for_clean_up max_clean_up_time + >>= fun () -> unset_handlers handler_ids ; Lwt.return (Error 2)) + +(* same but exit on error *) +let wrap_and_exit ?signal_setup ?double_signal_safety ?max_clean_up_time p = + wrap_and_error ?max_clean_up_time ?double_signal_safety ?signal_setup p + >>= function Ok v -> Lwt.return v | Error status -> Stdlib.exit status + +(* same but just return exit status *) +let wrap_and_forward ?signal_setup ?double_signal_safety ?max_clean_up_time p = + wrap_and_error ?max_clean_up_time ?double_signal_safety ?signal_setup p + >>= function Ok v -> Lwt.return v | Error status -> Lwt.return status diff --git a/src/lib_stdlib_unix/lwt_exit.mli b/src/lib_stdlib_unix/lwt_exit.mli index c6732e3b62..8dec10df3a 100644 --- a/src/lib_stdlib_unix/lwt_exit.mli +++ b/src/lib_stdlib_unix/lwt_exit.mli @@ -1,7 +1,7 @@ (*****************************************************************************) (* *) (* Open Source License *) -(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* Copyright (c) 2020 Nomadic Labs *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) @@ -23,23 +23,219 @@ (* *) (*****************************************************************************) -(** A global thread that resumes the first time {!exit} is called - anywhere in the program. Called by the main to wait for any other - thread in the system to call {!exit}. *) -val termination_thread : int Lwt.t +(** [Lwt_exit] provides helpers to handle: -(** Awakens the {!termination_thread} with the given return value, and - raises an exception that cannot be caught, except by a - catch-all. Should only be called once. *) -val exit : int -> 'a + - OS signals, + - cleaning-up before exiting, and + - exiting. -(** [exit_on signal] sets a signal handler for [signal] that exits cleanly using - the [exit] function above. *) -val exit_on : ?log:(string -> unit) -> int -> unit + Specifically, this module allows users to (1) register clean-up callbacks + and (2) trigger a soft exit. When a soft exit is triggered, the clean-up + callbacks are called. The process exits once all the clean-up callbacks + calls have resolved. *) -val retcode_of_unit_result_lwt : (unit, 'a) Result.result Lwt.t -> int Lwt.t +(** A global promise that resolves when clean-up starts. Note that there is no + way to "just" start clean-up. Specifically, it is only possible to start the + clean-up as a side-effect of triggering an exit. *) +val clean_up_starts : int Lwt.t -(** [wrap_promise p] is a promise [w] that resolves when either [p] resolves, or - when [termination_thread] resolves. In the latter case, [p] is canceled, - giving it a chance to clean up resources. *) -val wrap_promise : int Lwt.t -> int Lwt.t +(** A global promise that resolves when clean-up ends. *) +val clean_up_ends : int Lwt.t + +(** Attaching and detaching callbacks. *) + +type clean_up_callback_id + +(** [register_clean_up_callback f] registers [f] to be called as part of the + clean-up. Typically this is used to flush outputs, rollback/commit pending + changes, gracefully close connections with peers, etc. + + The call to [f] receives an argument [n] that indicates the status the + process will exit with at the end of clean-up: [0] is for success, [1] for + interruption by signals, [2] for uncaught exceptions, other values are also + available. + + The argument [after], if passed, delays the call to this callback until + the one identified by [after] has resovled. + + Once clean-up has started, this function has no effect. + + The promise returned by this callback may be canceled if it takes too long + to complete. (See [max_clean_up_time] below.) *) +val register_clean_up_callback : + ?after:clean_up_callback_id -> + loc:string -> + (int -> unit Lwt.t) -> + clean_up_callback_id + +(** [unregister_clean_up_callback cid] removes the callback with id [cid] from + the set of functions to call for cleaning up. + + Once clean-up has started, this function has no effect. *) +val unregister_clean_up_callback : clean_up_callback_id -> unit + +(** Example use: + + [let p = open_resource r in + let clean_p = register_clean_up_callback (fun _ -> close_resource p) in + let rec feed () = + read () >>= fun v -> + push_to_resource p >>= fun () -> + feed () + in + feed () >>= fun () -> + close_resource p >>= fun () -> + unregister_clean_up_callback clean_p; + Lwt.return ()] +*) + +(** [exit_and_raise n] triggers a soft exit (including clean-up) and raises + [Exit]. This is intended for use deep inside the program, at a place that + wants to trigger an exit after observing, say, a fatal error. *) +val exit_and_raise : int -> 'a + +(** [exit_and_wait n] triggers a soft exit (including clean-up) and stays + pending until it is finished. This is intended to be used directly within + [Lwt_main.run] for a clean exit. *) +val exit_and_wait : int -> int Lwt.t + +(** Managing signals *) + +(** A soft signal handler is one that triggers clean-up. + + After the clean-up has started, and after a safety period has elapsed, + sending the same soft-handled signal a second time terminates the + process immediately. The safety period is set by the parameter to + + A hard signal handler is one that terminates the process immediately. + + IMPORTANT: a hard exit can leave open files in inconsistent states. *) + +type signal_setup + +(** [make_signal_setup ~soft ~hard] is a signal setup with [soft] as soft + signals and [hard] as hard signals. + + @raise [Invalid_argument] if a signal is not one of [Sys.sig*]*) +val make_signal_setup : soft:int list -> hard:int list -> signal_setup + +(** [default_signal_setup] is + [make_signal_setup ~soft:[Sys.sigint; Sys.sigterm] ~hard:[]]. + + Note that pressing Ctrl-C sends [SIGINT] to the process whilst shutting it + down through systemd sends [SIGTERM]. This is the reasoning behind the + default: both of those signals should be handled softly. *) +val default_signal_setup : signal_setup + +(** [signal_name signal] is the name of [signal]. + E.g., [signal_name Sys.sigterm] is ["TERM"]. *) +val signal_name : int -> string + +(** [wrap_and_exit p] is a promise [q] that behaves as follows: + + If [exit_and_raise] is called before [p] is resolved, then the process + terminates as soon as the clean-up has ended. As a result, the [q] never + resolves. + + If [p] is fulfilled with value [v] (and [exit_and_raise] was not called) + then [q] also is fulfilled with [v]. + + If [p] is rejected (and [exit_and_raise] was not called), a soft-exit with + status [2] is triggered and the process terminates as soon as the clean-up + has ended. + + In addition, [wrap_and_exit p] sets up the signal handlers described above. + This can cause calls to [exit_and_raise]. + + The optional argument [max_clean_up_time] limits the time the clean-up phase + is allowed to run for. If any of the clean-up callbacks is still pending + when [max_clean_up_time] has elapsed, then the pending callbacks are + [cancel]ed, then, after a [Lwt.pause], the process exits. + + The optional argument [double_signal_safety] (defaults to one (1) second) + is the grace period after sending one of the softly-handled signal before + sending the same signal is handled as hard. + + The optional argument [signal_setup] (defaults to [default_signal_setup]) + sets up soft and hard handlers at the beginning and clears them when [q] + resolves. + + Intended use: + [Stdlib.exit @@ Lwt_main.run begin + Lwt_exit.wrap_and_exit (init ()) >>= fun v -> + Lwt_exit.wrap_and_exit (main v) >>= fun v -> + Lwt_exit.wrap_and_exit (shutdown v) >>= fun () -> + exit_and_wait 0 (* clean exit afterwards *) + end] +*) +val wrap_and_exit : + ?signal_setup:signal_setup -> + ?double_signal_safety:Ptime.Span.t -> + ?max_clean_up_time:Ptime.Span.t -> + 'a Lwt.t -> + 'a Lwt.t + +(** [wrap_and_error p] is similar to [wrap_and_exit p] but it resolves to + [Error status] instead of exiting with [status]. When it resolves with + [Error _] (i.e., if a soft-exit has been triggered), clean-up has already + ended. + + Intended use: + [Stdlib.exit @@ Lwt_main.run begin + Lwt_exit.wrap_and_error (init ()) >>= function + | Error exit_status -> + Format.eprintf "Initialisation failed\n%!"; + Lwt.return exit_status + | Ok v -> + Lwt_exit.wrap_and_error (main v) >>= function + | Error exit_status -> + Format.eprintf "Processing failed\n%!"; + Lwt.return exit_status + | Ok v -> + Lwt_exit.wrap_and_error (shutdown ()) >>= function + | Error exit_status -> + Format.eprintf "Shutdown failed\n%!"; + Lwt.return exit_status + | Ok () -> + exit_and_wait 0 >>= fun _ -> + Lwt.return 0 + end] +*) +val wrap_and_error : + ?signal_setup:signal_setup -> + ?double_signal_safety:Ptime.Span.t -> + ?max_clean_up_time:Ptime.Span.t -> + 'a Lwt.t -> + ('a, int) result Lwt.t + +(** [wrap_and_forward p] is similar to [wrap_and_error p] except that it + collapses [Ok _] and [Error _]. + + Note that, in general, you can expect the status [0] to come from a + successfully resolved [p]. However, It could also be because of a soft-exit + with status [0]. As a result, you cannot be certain, based on the status + alone, whether clean-up callbacks have been called. + + Intended use: + [Stdlib.exit @@ Lwt_main.run begin + Lwt_exit.wrap_and_forward (main ()) >>= function + | 0 -> + Format.printf "I'm done, bye!\n%!"; + Lwt.return 0 + | 1 -> (* signaling *) + Format.printf "Shutdown complete\n"; + Lwt.return 1 + | 2 -> (* uncaught exception *) + Format.printf "An error occurred.\n"; + Format.printf "Please check %s\n" log_file; + Format.printf "And consider reporting the issue\n%!"; + Lwt.return 2 + | _ -> assert false + end] +*) +val wrap_and_forward : + ?signal_setup:signal_setup -> + ?double_signal_safety:Ptime.Span.t -> + ?max_clean_up_time:Ptime.Span.t -> + int Lwt.t -> + int Lwt.t diff --git a/src/lib_stdlib_unix/test/.ocamlformat b/src/lib_stdlib_unix/test/.ocamlformat new file mode 100644 index 0000000000..8278a132e3 --- /dev/null +++ b/src/lib_stdlib_unix/test/.ocamlformat @@ -0,0 +1,12 @@ +version=0.10 +wrap-fun-args=false +let-binding-spacing=compact +field-space=loose +break-separators=after-and-docked +sequence-style=separator +doc-comments=before +margin=80 +module-item-spacing=sparse +parens-tuple=always +parens-tuple-patterns=always +break-string-literals=newlines-and-wrap diff --git a/src/lib_stdlib_unix/test/dune b/src/lib_stdlib_unix/test/dune new file mode 100644 index 0000000000..3810c77e5e --- /dev/null +++ b/src/lib_stdlib_unix/test/dune @@ -0,0 +1,117 @@ +(executables + (names + test_lwt_exit_exit + test_lwt_exit_exit_escape + test_lwt_exit_return + test_lwt_exit_after + test_lwt_exit_signal + test_lwt_exit_clean_up + test_lwt_exit_unregister_clean_up + test_lwt_exit_unregister_clean_up_with_after + test_lwt_exit_raise + test_lwt_exit_raise_exit + ) + (libraries tezos-stdlib-unix + tezos-stdlib + lwt.unix) + (flags (:standard -open Tezos_stdlib_unix))) + +(alias + (name buildtest) + (deps test_lwt_exit_exit.exe)) + +(alias + (name runtest_lwt_exit_exit) + (action (run %{exe:test_lwt_exit_exit.exe}))) + +(alias + (name buildtest) + (deps test_lwt_exit_exit_escape.exe)) + +(alias + (name runtest_lwt_exit_exit_escape) + (action (run %{exe:test_lwt_exit_exit_escape.exe}))) + +(alias + (name buildtest) + (deps test_lwt_exit_return.exe)) + +(alias + (name runtest_lwt_exit_return) + (action (run %{exe:test_lwt_exit_return.exe}))) + +(alias + (name buildtest) + (deps test_lwt_exit_after.exe)) + +(alias + (name runtest_lwt_exit_after) + (action (run %{exe:test_lwt_exit_after.exe}))) + +(alias + (name buildtest) + (deps test_lwt_exit_signal.exe)) + +(alias + (name runtest_lwt_exit_signal) + (action (run %{exe:test_lwt_exit_signal.exe}))) + +(alias + (name buildtest) + (deps test_lwt_exit_clean_up.exe)) + +(alias + (name runtest_lwt_exit_clean_up) + (action (run %{exe:test_lwt_exit_clean_up.exe}))) + +(alias + (name buildtest) + (deps test_lwt_exit_unregister_clean_up.exe)) + +(alias + (name runtest_test_lwt_exit_unregister_clean_up) + (action (run %{exe:test_lwt_exit_unregister_clean_up.exe}))) + +(alias + (name buildtest) + (deps test_lwt_exit_unregister_clean_up_with_after.exe)) + +(alias + (name runtest_test_lwt_exit_unregister_clean_up_with_after) + (action (run %{exe:test_lwt_exit_unregister_clean_up_with_after.exe}))) + +(alias + (name buildtest) + (deps test_lwt_exit_raise.exe)) + +(alias + (name runtest_test_lwt_exit_raise) + (action (run %{exe:test_lwt_exit_raise.exe}))) + +(alias + (name buildtest) + (deps test_lwt_exit_raise_exit.exe)) + +(alias + (name runtest_test_lwt_exit_raise_exit) + (action (run %{exe:test_lwt_exit_raise_exit.exe}))) + +(alias + (name runtest) + (package tezos-stdlib-unix) + (deps (alias runtest_lwt_exit_exit) + (alias runtest_lwt_exit_exit_escape) + (alias runtest_lwt_exit_return) + (alias runtest_lwt_exit_after) + (alias runtest_lwt_exit_signal) + (alias runtest_lwt_exit_clean_up) + (alias runtest_test_lwt_exit_unregister_clean_up) + (alias runtest_test_lwt_exit_unregister_clean_up_with_after) + (alias runtest_test_lwt_exit_raise) + (alias runtest_test_lwt_exit_raise_exit) + )) + +(alias + (name runtest_lint) + (deps (glob_files *.ml{,i})) + (action (run %{lib:tezos-tooling:lint.sh} %{deps}))) diff --git a/src/lib_stdlib_unix/test/test_lwt_exit_after.ml b/src/lib_stdlib_unix/test/test_lwt_exit_after.ml new file mode 100644 index 0000000000..e2b89d11e3 --- /dev/null +++ b/src/lib_stdlib_unix/test/test_lwt_exit_after.ml @@ -0,0 +1,65 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Lwt.Infix + +let r = ref 0 + +let first = + Lwt_exit.register_clean_up_callback ~loc:__LOC__ (fun _ -> + Lwt_unix.sleep 0.2 + >>= fun () -> + assert (!r = 0) ; + incr r ; + Lwt.return_unit) + +let second = + Lwt_exit.register_clean_up_callback ~after:first ~loc:__LOC__ (fun _ -> + Lwt_unix.sleep 0.1 + >>= fun () -> + assert (!r = 1) ; + incr r ; + Lwt.return_unit) + +let _third = + Lwt_exit.register_clean_up_callback ~after:second ~loc:__LOC__ (fun _ -> + assert (!r = 2) ; + incr r ; + Lwt.return_unit) + +let () = + match + Lwt_main.run + @@ Lwt_exit.wrap_and_error + (let (_ : unit Lwt.t) = + Lwt_unix.sleep 0.1 >>= fun () -> Lwt_exit.exit_and_raise 3 + in + fst @@ Lwt.task ()) + with + | Ok _ -> + assert false + | Error _ -> + assert (!r = 3) ; + exit 0 diff --git a/src/lib_stdlib_unix/test/test_lwt_exit_clean_up.ml b/src/lib_stdlib_unix/test/test_lwt_exit_clean_up.ml new file mode 100644 index 0000000000..5948933179 --- /dev/null +++ b/src/lib_stdlib_unix/test/test_lwt_exit_clean_up.ml @@ -0,0 +1,48 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Lwt.Infix + +let r = ref 0 + +let _ = + Lwt_exit.register_clean_up_callback ~loc:__LOC__ (fun s -> + Lwt_unix.sleep 0.01 + >>= fun () -> + r := s ; + Lwt.return_unit) + +let () = + match + Lwt_main.run + @@ Lwt_exit.wrap_and_error + (Lwt_unix.sleep 0.01 >>= fun () -> Lwt_exit.exit_and_raise 10) + with + | Error 10 -> + assert (!r = 10) + | Error _ -> + assert false + | Ok _ -> + assert false diff --git a/src/lib_stdlib_unix/test/test_lwt_exit_exit.ml b/src/lib_stdlib_unix/test/test_lwt_exit_exit.ml new file mode 100644 index 0000000000..05c32e2cd7 --- /dev/null +++ b/src/lib_stdlib_unix/test/test_lwt_exit_exit.ml @@ -0,0 +1,40 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Lwt.Infix + +let () = + match + Lwt_main.run + @@ Lwt_exit.wrap_and_error + ( Lwt.pause () + >>= fun () -> + (try Lwt_exit.exit_and_raise 3 with Exit -> ()) ; + Tezos_stdlib.Lwt_utils.never_ending () ) + with + | Error 3 -> + () + | Error _ | Ok () -> + assert false diff --git a/src/lib_stdlib_unix/test/test_lwt_exit_exit_escape.ml b/src/lib_stdlib_unix/test/test_lwt_exit_exit_escape.ml new file mode 100644 index 0000000000..dbee594576 --- /dev/null +++ b/src/lib_stdlib_unix/test/test_lwt_exit_exit_escape.ml @@ -0,0 +1,42 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Lwt.Infix + +(** Even when not caught, a call to [exit_and_raise] should propagate the + error code correctly. *) +let () = + match + Lwt_main.run + @@ Lwt_exit.wrap_and_error + ( Lwt.pause () + >>= fun () -> + Lwt_exit.exit_and_raise 3 + >>= fun () -> Tezos_stdlib.Lwt_utils.never_ending () ) + with + | Error 3 -> + () + | Error _ | Ok () -> + assert false diff --git a/src/lib_stdlib_unix/test/test_lwt_exit_raise.ml b/src/lib_stdlib_unix/test/test_lwt_exit_raise.ml new file mode 100644 index 0000000000..321ae42eb1 --- /dev/null +++ b/src/lib_stdlib_unix/test/test_lwt_exit_raise.ml @@ -0,0 +1,40 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Lwt.Infix + +let () = + match + Lwt_main.run + @@ Lwt_exit.wrap_and_error + ( Lwt.pause () + >>= fun () -> + raise Not_found >>= fun () -> Tezos_stdlib.Lwt_utils.never_ending () + ) + with + | Error 2 -> + () + | Error _ | Ok () -> + assert false diff --git a/src/lib_stdlib_unix/test/test_lwt_exit_raise_exit.ml b/src/lib_stdlib_unix/test/test_lwt_exit_raise_exit.ml new file mode 100644 index 0000000000..482a5144b0 --- /dev/null +++ b/src/lib_stdlib_unix/test/test_lwt_exit_raise_exit.ml @@ -0,0 +1,39 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Lwt.Infix + +let () = + match + Lwt_main.run + @@ Lwt_exit.wrap_and_error + ( Lwt.pause () + >>= fun () -> + raise Exit >>= fun () -> Tezos_stdlib.Lwt_utils.never_ending () ) + with + | Error 2 -> + () + | Error _ | Ok () -> + assert false diff --git a/src/lib_stdlib_unix/test/test_lwt_exit_return.ml b/src/lib_stdlib_unix/test/test_lwt_exit_return.ml new file mode 100644 index 0000000000..7077d655ed --- /dev/null +++ b/src/lib_stdlib_unix/test/test_lwt_exit_return.ml @@ -0,0 +1,36 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Lwt.Infix + +let () = + match + Lwt_main.run + @@ Lwt_exit.wrap_and_error (Lwt.pause () >>= fun () -> Lwt.return ()) + with + | Ok () -> + () + | Error _ -> + assert false diff --git a/src/lib_stdlib_unix/test/test_lwt_exit_signal.ml b/src/lib_stdlib_unix/test/test_lwt_exit_signal.ml new file mode 100644 index 0000000000..221687c796 --- /dev/null +++ b/src/lib_stdlib_unix/test/test_lwt_exit_signal.ml @@ -0,0 +1,235 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Lwt.Infix + +let devnull = Lwt_main.run (Lwt_unix.openfile "/dev/null" [O_WRONLY] 0) + +(* A signal setup with both soft and hard exits to test both behaviours *) +let signal_setup = + Lwt_exit.make_signal_setup ~soft:[Sys.sigint; Sys.sigterm] ~hard:[Sys.sigusr1] + +let default_double_signal_safety = Option.get @@ Ptime.Span.of_float_s 0.1 + +let short_max_clean_up_time = Option.get @@ Ptime.Span.of_float_s 0.04 + +let child_main ?double_signal_safety ?max_clean_up_time () = + let double_signal_safety = + Option.value double_signal_safety ~default:default_double_signal_safety + in + Lwt_unix.dup2 devnull Lwt_unix.stderr ; + let r = ref 10 in + let _ = + Lwt_exit.register_clean_up_callback ~loc:__LOC__ (fun _ -> + Lwt_unix.sleep 0.02 + >>= fun () -> + r := 11 ; + Lwt_unix.sleep 0.05 + >>= fun () -> + r := 12 ; + Lwt_unix.sleep 0.2 >>= fun () -> Lwt.return ()) + in + Stdlib.exit @@ Lwt_main.run + @@ ( Lwt_exit.wrap_and_error + ?max_clean_up_time + ~double_signal_safety + ~signal_setup + (Tezos_stdlib.Lwt_utils.never_ending ()) + >>= function + | Ok () -> + Lwt.return 3 + | Error 1 -> + Lwt.return !r + | Error status -> + Lwt.return status ) + +let main () = + (* test INT *) + match Lwt_unix.fork () with + | 0 -> + child_main () + | pid -> ( + Lwt_main.run + (let s : unit Lwt.t = + Lwt_unix.sleep 0.01 + >>= fun () -> Unix.kill pid Sys.sigint ; Lwt.return () + in + Lwt_unix.waitpid [] pid + >|= fun (_, status) -> + Lwt.cancel s ; + match status with + | WEXITED 12 -> + () + | WEXITED _ -> + assert false + | WSIGNALED _ -> + assert false + | WSTOPPED _ -> + assert false) ; + (* test INT short clean-up time *) + match Lwt_unix.fork () with + | 0 -> + child_main ~max_clean_up_time:short_max_clean_up_time () + | pid -> ( + Lwt_main.run + (let s : unit Lwt.t = + Lwt_unix.sleep 0.01 + >>= fun () -> Unix.kill pid Sys.sigint ; Lwt.return () + in + Lwt_unix.waitpid [] pid + >|= fun (_, status) -> + Lwt.cancel s ; + match status with + | WEXITED 11 -> + () + | WEXITED _ -> + assert false + | WSIGNALED _ -> + assert false + | WSTOPPED _ -> + assert false) ; + (* test INT-short-sleep-INT *) + match Lwt_unix.fork () with + | 0 -> + child_main () + | pid -> ( + Lwt_main.run + (let s : unit Lwt.t = + Lwt_unix.sleep 0.01 + >>= fun () -> + Unix.kill pid Sys.sigint ; + Lwt_unix.sleep 0.02 + >>= fun () -> Unix.kill pid Sys.sigint ; Lwt.return () + in + Lwt_unix.waitpid [] pid + >|= fun (_, status) -> + Lwt.cancel s ; + match status with + | WEXITED 12 -> + () + | WEXITED _ -> + assert false + | WSIGNALED _ -> + assert false + | WSTOPPED _ -> + assert false) ; + (* test INT-long-sleep-INT *) + match Lwt_unix.fork () with + | 0 -> + child_main () + | pid -> ( + Lwt_main.run + (let s : unit Lwt.t = + Lwt_unix.sleep 0.01 + >>= fun () -> + Unix.kill pid Sys.sigint ; + Lwt_unix.sleep 0.11 + >>= fun () -> Unix.kill pid Sys.sigint ; Lwt.return () + in + Lwt_unix.waitpid [] pid + >|= fun (_, status) -> + Lwt.cancel s ; + match status with + | WEXITED 1 -> + () + | WEXITED _ -> + assert false + | WSIGNALED _ -> + assert false + | WSTOPPED _ -> + assert false) ; + (* test no double-signal safety *) + match Lwt_unix.fork () with + | 0 -> + child_main ~double_signal_safety:Ptime.Span.zero () + | pid -> ( + Lwt_main.run + (let s : unit Lwt.t = + Lwt_unix.sleep 0.01 + >>= fun () -> + Unix.kill pid Sys.sigint ; + Lwt_unix.sleep 0.02 + >>= fun () -> + Unix.kill pid Sys.sigint ; Lwt.return_unit + in + Lwt_unix.waitpid [] pid + >|= fun (_, status) -> + Lwt.cancel s ; + match status with + | WEXITED 1 -> + () + | WEXITED _ -> + assert false + | WSIGNALED _ -> + assert false + | WSTOPPED _ -> + assert false) ; + (* test USR1 (hard) *) + match Lwt_unix.fork () with + | 0 -> + child_main () + | pid -> ( + Lwt_main.run + (let s : unit Lwt.t = + Lwt_unix.sleep 0.01 + >>= fun () -> + Unix.kill pid Sys.sigusr1 ; Lwt.return () + in + Lwt_unix.waitpid [] pid + >|= fun (_, status) -> + Lwt.cancel s ; + match status with + | WEXITED 1 -> + () + | WEXITED _ -> + assert false + | WSIGNALED _ -> + assert false + | WSTOPPED _ -> + assert false) ; + (* test KILL *) + match Lwt_unix.fork () with + | 0 -> + child_main () + | pid -> + Lwt_main.run + (let s : unit Lwt.t = + Lwt_unix.sleep 0.01 + >>= fun () -> + Unix.kill pid Sys.sigkill ; Lwt.return () + in + Lwt_unix.waitpid [] pid + >|= fun (_, status) -> + Lwt.cancel s ; + match status with + | WEXITED _ -> + assert false + | WSIGNALED _ -> + () + | WSTOPPED _ -> + assert false) ; + () ) ) ) ) ) ) + +let () = main () ; Stdlib.exit 0 diff --git a/src/lib_stdlib_unix/test/test_lwt_exit_unregister_clean_up.ml b/src/lib_stdlib_unix/test/test_lwt_exit_unregister_clean_up.ml new file mode 100644 index 0000000000..e8cd245ce9 --- /dev/null +++ b/src/lib_stdlib_unix/test/test_lwt_exit_unregister_clean_up.ml @@ -0,0 +1,51 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Lwt.Infix + +let r = ref 0 + +let clean_up_callback_id = + Lwt_exit.register_clean_up_callback ~loc:__LOC__ (fun s -> + Lwt_unix.sleep 0.01 + >>= fun () -> + r := s ; + Lwt.return_unit) + +let () = + match + Lwt_main.run + @@ Lwt_exit.wrap_and_error + ( Lwt_unix.sleep 0.01 + >>= fun () -> + Lwt_exit.unregister_clean_up_callback clean_up_callback_id ; + Lwt_unix.sleep 0.01 >>= fun () -> Lwt_exit.exit_and_raise 10 ) + with + | Error 10 -> + assert (!r = 0) + | Error _ -> + assert false + | Ok _ -> + assert false diff --git a/src/lib_stdlib_unix/test/test_lwt_exit_unregister_clean_up_with_after.ml b/src/lib_stdlib_unix/test/test_lwt_exit_unregister_clean_up_with_after.ml new file mode 100644 index 0000000000..2f191868fa --- /dev/null +++ b/src/lib_stdlib_unix/test/test_lwt_exit_unregister_clean_up_with_after.ml @@ -0,0 +1,61 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Lwt.Infix + +let r = ref 2 + +let clean_up_callback_id = + Lwt_exit.register_clean_up_callback ~loc:__LOC__ (fun _ -> + Lwt_unix.sleep 0.01 + >>= fun () -> + r := !r * 3 ; + Lwt.return_unit) + +let _ = + Lwt_exit.register_clean_up_callback + ~loc:__LOC__ + ~after:clean_up_callback_id + (fun _ -> + Lwt_unix.sleep 0.01 + >>= fun () -> + r := !r * 5 ; + Lwt.return_unit) + +let () = + match + Lwt_main.run + @@ Lwt_exit.wrap_and_error + ( Lwt_unix.sleep 0.01 + >>= fun () -> + Lwt_exit.unregister_clean_up_callback clean_up_callback_id ; + Lwt_unix.sleep 0.01 >>= fun () -> Lwt_exit.exit_and_raise 10 ) + with + | Error 10 -> + assert (!r = 10) + | Error _ -> + assert false + | Ok _ -> + assert false diff --git a/src/lib_storage/context.ml b/src/lib_storage/context.ml index ae6979ab28..f746ae13f4 100644 --- a/src/lib_storage/context.ml +++ b/src/lib_storage/context.ml @@ -130,9 +130,13 @@ module Node = struct type entry = {kind : kind; name : M.step; node : Hash.t} + let s = Irmin.Type.(string_of `Int64) + + let pre_hash_v = Irmin.Type.(unstage (pre_hash s)) + (* Irmin 1.4 uses int64 to store string lengths *) let step_t = - let pre_hash = Irmin.Type.(pre_hash (string_of `Int64)) in + let pre_hash = Irmin.Type.(stage @@ fun x -> pre_hash_v x) in Irmin.Type.like M.step_t ~pre_hash let metadata_t = @@ -176,14 +180,16 @@ module Node = struct let import t = List.map import_entry (M.list t) - let pre_hash entries = Irmin.Type.pre_hash entries_t entries + let pre_hash_entries = Irmin.Type.(unstage (pre_hash entries_t)) + + let pre_hash entries = pre_hash_entries entries end include M let pre_hash_v1 x = V1.pre_hash (V1.import x) - let t = Irmin.Type.(like t ~pre_hash:pre_hash_v1) + let t = Irmin.Type.(like t ~pre_hash:(stage @@ fun x -> pre_hash_v1 x)) end module Commit = struct @@ -191,19 +197,23 @@ module Commit = struct module V1 = Irmin.Private.Commit.V1 (M) include M - let pre_hash_v1 t = Irmin.Type.pre_hash V1.t (V1.import t) + let pre_hash_v1_t = Irmin.Type.(unstage (pre_hash V1.t)) + + let pre_hash_v1 t = pre_hash_v1_t (V1.import t) - let t = Irmin.Type.like t ~pre_hash:pre_hash_v1 + let t = Irmin.Type.(like t ~pre_hash:(stage @@ fun x -> pre_hash_v1 x)) end module Contents = struct type t = string - let pre_hash_v1 x = - let ty = Irmin.Type.(pair (string_of `Int64) unit) in - Irmin.Type.(pre_hash ty) (x, ()) + let ty = Irmin.Type.(pair (string_of `Int64) unit) - let t = Irmin.Type.(like ~pre_hash:pre_hash_v1 string) + let pre_hash_ty = Irmin.Type.(unstage (pre_hash ty)) + + let pre_hash_v1 x = pre_hash_ty (x, ()) + + let t = Irmin.Type.(like string ~pre_hash:(stage @@ fun x -> pre_hash_v1 x)) let merge = Irmin.Merge.(idempotent (Irmin.Type.option t)) end @@ -227,6 +237,7 @@ type index = { path : string; repo : Store.Repo.t; patch_context : (context -> context tzresult Lwt.t) option; + readonly : bool; } and context = {index : index; parents : Store.Commit.t list; tree : Store.tree} @@ -255,11 +266,15 @@ let restore_integrity ?ppf index = "unable to fix the corrupted context: %d bad entries detected" n) +let syncs index = Store.sync index.repo + let exists index key = + if index.readonly then syncs index ; Store.Commit.of_hash index.repo (Hash.of_context_hash key) >|= function None -> false | Some _ -> true let checkout index key = + if index.readonly then syncs index ; Store.Commit.of_hash index.repo (Hash.of_context_hash key) >>= function | None -> @@ -416,14 +431,21 @@ let fork_test_chain v ~protocol ~expiration = (*-- Initialisation ----------------------------------------------------------*) -let init ?patch_context ?mapsize:_ ?readonly root = +let init ?patch_context ?mapsize:_ ?(readonly = false) root = Store.Repo.v - (Irmin_pack.config ?readonly ?index_log_size:!index_log_size root) + (Irmin_pack.config ~readonly ?index_log_size:!index_log_size root) >>= fun repo -> - let v = {path = root; repo; patch_context} in + let v = {path = root; repo; patch_context; readonly} in Lwt.return v -let close index = Store.Repo.close index.repo +let with_timer f = + let t0 = Sys.time () in + f () >|= fun () -> + Sys.time () -. t0 + +let close index = + with_timer (fun () -> Store.Repo.close index.repo) + >|= fun t -> Fmt.epr "closing index %f" t let get_branch chain_id = Format.asprintf "%a" Chain_id.pp chain_id diff --git a/src/lib_storage/context_dump.ml b/src/lib_storage/context_dump.ml index 32656ded1b..2205d226f0 100644 --- a/src/lib_storage/context_dump.ml +++ b/src/lib_storage/context_dump.ml @@ -2,7 +2,7 @@ (* *) (* Open Source License *) (* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* Copyright (c) 2018-2020 Nomadic Labs. *) +(* Copyright (c) 2018-2020 Nomadic Labs. *) (* Copyright (c) 2018-2020 Tarides *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) diff --git a/src/lib_storage/tezos-storage.opam b/src/lib_storage/tezos-storage.opam index cf6c964fae..06eab97025 100644 --- a/src/lib_storage/tezos-storage.opam +++ b/src/lib_storage/tezos-storage.opam @@ -21,4 +21,11 @@ build: [ ["dune" "build" "-p" name "-j" jobs] ["dune" "runtest" "-p" name "-j" jobs] {with-test} ] + +pin-depends: [ + "index.dev" "git+https://github.com/mirage/index#master" + "irmin.dev" "git+https://github.com/mirage/irmin#master" + "irmin-pack.dev" "git+https://github.com/mirage/irmin#master" +] + synopsis: "Tezos: low-level key-value store for `tezos-node`" diff --git a/src/lib_validation/block_validation.ml b/src/lib_validation/block_validation.ml index c1dd757d80..2bced3850c 100644 --- a/src/lib_validation/block_validation.ml +++ b/src/lib_validation/block_validation.ml @@ -2,7 +2,7 @@ (* *) (* Open Source License *) (* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* Copyright (c) 2018 Nomadic Labs. *) +(* Copyright (c) 2018 Nomadic Labs. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) diff --git a/src/lib_validation/block_validation.mli b/src/lib_validation/block_validation.mli index d4fc8fc3e2..a13d12f749 100644 --- a/src/lib_validation/block_validation.mli +++ b/src/lib_validation/block_validation.mli @@ -2,7 +2,7 @@ (* *) (* Open Source License *) (* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* Copyright (c) 2018 Nomadic Labs. *) +(* Copyright (c) 2018 Nomadic Labs. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) diff --git a/src/lib_validation/dune b/src/lib_validation/dune index f2f73ca1ea..ebbbe8cfec 100644 --- a/src/lib_validation/dune +++ b/src/lib_validation/dune @@ -5,12 +5,14 @@ tezos-storage tezos-shell-context tezos-shell-services - tezos-protocol-updater) + tezos-protocol-updater + tezos-stdlib-unix) (flags (:standard -open Tezos_base__TzPervasives -open Tezos_storage -open Tezos_shell_context -open Tezos_shell_services - -open Tezos_protocol_updater))) + -open Tezos_protocol_updater + -open Tezos_stdlib_unix))) (alias (name runtest_lint) diff --git a/src/lib_validation/external_validation.ml b/src/lib_validation/external_validation.ml index 15b6ea6537..f0f901820a 100644 --- a/src/lib_validation/external_validation.ml +++ b/src/lib_validation/external_validation.ml @@ -227,3 +227,37 @@ let recv pout encoding = let buf = Bytes.create count in Lwt_io.read_into_exactly pout buf 0 count >>= fun () -> Lwt.return (Data_encoding.Binary.of_bytes_exn encoding buf) + +let socket_path ~data_dir ~pid = + let filename = Format.sprintf "tezos-validation-socket-%d" pid in + Filename.concat data_dir filename + +(* To get optimized socket communication of processes on the same + machine, we use Unix domain sockets: ADDR_UNIX. *) +let make_socket socket_path = Unix.ADDR_UNIX socket_path + +let create_socket ~canceler = + Lwt.catch + (fun () -> + let socket = Lwt_unix.socket PF_UNIX SOCK_STREAM 0o000 in + Lwt_canceler.on_cancel canceler (fun () -> + Lwt_utils_unix.safe_close socket >>= fun _ -> Lwt.return_unit) ; + Lwt_unix.setsockopt socket SO_REUSEADDR true ; + Lwt.return socket) + (fun exn -> + Format.printf "Error creating a socket" ; + Lwt.fail exn) + +let create_socket_listen ~canceler ~max_requests ~socket_path = + create_socket ~canceler + >>= fun socket -> + Lwt_unix.bind socket (make_socket socket_path) + >>= fun () -> + Lwt_unix.listen socket max_requests ; + Lwt.return socket + +let create_socket_connect ~canceler ~socket_path = + create_socket ~canceler + >>= fun socket -> + Lwt_unix.connect socket (make_socket socket_path) + >>= fun () -> Lwt.return socket diff --git a/src/lib_validation/external_validation.mli b/src/lib_validation/external_validation.mli index 71beb3430e..0e765cb3ea 100644 --- a/src/lib_validation/external_validation.mli +++ b/src/lib_validation/external_validation.mli @@ -63,3 +63,14 @@ val recv : Lwt_io.input_channel -> 'a Data_encoding.t -> 'a Lwt.t val recv_result : Lwt_io.input_channel -> 'a Data_encoding.t -> 'a tzresult Lwt.t + +val socket_path : data_dir:string -> pid:int -> string + +val create_socket_listen : + canceler:Lwt_canceler.t -> + max_requests:int -> + socket_path:string -> + Lwt_unix.file_descr Lwt.t + +val create_socket_connect : + canceler:Lwt_canceler.t -> socket_path:string -> Lwt_unix.file_descr Lwt.t diff --git a/src/lib_version/version.ml b/src/lib_version/version.ml index 82ea0bf315..90104885fe 100644 --- a/src/lib_version/version.ml +++ b/src/lib_version/version.ml @@ -42,6 +42,6 @@ let to_string {major; minor; additional_info} = string_of_int major ^ "." ^ string_of_int minor ^ string_of_additional_info additional_info -let current = {major = 7; minor = 2; additional_info = Dev} +let current = {major = 7; minor = 3; additional_info = Dev} let current_string = to_string current diff --git a/src/proto_000_Ps9mPmXa/lib_protocol/dune.inc b/src/proto_000_Ps9mPmXa/lib_protocol/dune.inc index e808f42930..ceb848c7cf 100644 --- a/src/proto_000_Ps9mPmXa/lib_protocol/dune.inc +++ b/src/proto_000_Ps9mPmXa/lib_protocol/dune.inc @@ -67,7 +67,7 @@ include Tezos_raw_protocol_000_Ps9mPmXa.Main (library_flags (:standard -linkall)) (flags (:standard -nopervasives -nostdlib -w +a-4-6-7-9-29-32-40..42-44-45-48 - -warn-error -a+8 + -warn-error +a -open Tezos_protocol_environment_000_Ps9mPmXa__Environment -open Pervasives -open Error_monad)) @@ -89,7 +89,7 @@ include Tezos_raw_protocol_000_Ps9mPmXa.Main tezos-protocol-environment-sigs tezos_raw_protocol_000_Ps9mPmXa) (flags -w "+a-4-6-7-9-29-40..42-44-45-48" - -warn-error "-a+8" + -warn-error "+a" -nopervasives) (modules Protocol)) @@ -101,7 +101,7 @@ include Tezos_raw_protocol_000_Ps9mPmXa.Main tezos-protocol-environment-sigs tezos_raw_protocol_000_Ps9mPmXa) (flags -w "+a-4-6-7-9-29-40..42-44-45-48" - -warn-error "-a+8" + -warn-error "+a" -nopervasives) (modules Functor)) @@ -113,7 +113,7 @@ include Tezos_raw_protocol_000_Ps9mPmXa.Main tezos-protocol-updater tezos-protocol-environment) (flags (:standard -w +a-4-6-7-9-29-32-40..42-44-45-48 - -warn-error -a+8)) + -warn-error +a)) (modules Registerer)) (alias diff --git a/src/proto_001_PtCJ7pwo/lib_protocol/dune.inc b/src/proto_001_PtCJ7pwo/lib_protocol/dune.inc index 0020af187f..2a51cedd5a 100644 --- a/src/proto_001_PtCJ7pwo/lib_protocol/dune.inc +++ b/src/proto_001_PtCJ7pwo/lib_protocol/dune.inc @@ -259,7 +259,7 @@ include Tezos_raw_protocol_001_PtCJ7pwo.Main (library_flags (:standard -linkall)) (flags (:standard -nopervasives -nostdlib -w +a-4-6-7-9-29-32-40..42-44-45-48 - -warn-error -a+8 + -warn-error +a -open Tezos_protocol_environment_001_PtCJ7pwo__Environment -open Pervasives -open Error_monad)) @@ -345,7 +345,7 @@ include Tezos_raw_protocol_001_PtCJ7pwo.Main tezos-protocol-environment-sigs tezos_raw_protocol_001_PtCJ7pwo) (flags -w "+a-4-6-7-9-29-40..42-44-45-48" - -warn-error "-a+8" + -warn-error "+a" -nopervasives) (modules Protocol)) @@ -357,7 +357,7 @@ include Tezos_raw_protocol_001_PtCJ7pwo.Main tezos-protocol-environment-sigs tezos_raw_protocol_001_PtCJ7pwo) (flags -w "+a-4-6-7-9-29-40..42-44-45-48" - -warn-error "-a+8" + -warn-error "+a" -nopervasives) (modules Functor)) @@ -369,7 +369,7 @@ include Tezos_raw_protocol_001_PtCJ7pwo.Main tezos-protocol-updater tezos-protocol-environment) (flags (:standard -w +a-4-6-7-9-29-32-40..42-44-45-48 - -warn-error -a+8)) + -warn-error +a)) (modules Registerer)) (alias diff --git a/src/proto_002_PsYLVpVv/lib_protocol/dune.inc b/src/proto_002_PsYLVpVv/lib_protocol/dune.inc index c1e33a25b3..da31a4104d 100644 --- a/src/proto_002_PsYLVpVv/lib_protocol/dune.inc +++ b/src/proto_002_PsYLVpVv/lib_protocol/dune.inc @@ -259,7 +259,7 @@ include Tezos_raw_protocol_002_PsYLVpVv.Main (library_flags (:standard -linkall)) (flags (:standard -nopervasives -nostdlib -w +a-4-6-7-9-29-32-40..42-44-45-48 - -warn-error -a+8 + -warn-error +a -open Tezos_protocol_environment_002_PsYLVpVv__Environment -open Pervasives -open Error_monad)) @@ -345,7 +345,7 @@ include Tezos_raw_protocol_002_PsYLVpVv.Main tezos-protocol-environment-sigs tezos_raw_protocol_002_PsYLVpVv) (flags -w "+a-4-6-7-9-29-40..42-44-45-48" - -warn-error "-a+8" + -warn-error "+a" -nopervasives) (modules Protocol)) @@ -357,7 +357,7 @@ include Tezos_raw_protocol_002_PsYLVpVv.Main tezos-protocol-environment-sigs tezos_raw_protocol_002_PsYLVpVv) (flags -w "+a-4-6-7-9-29-40..42-44-45-48" - -warn-error "-a+8" + -warn-error "+a" -nopervasives) (modules Functor)) @@ -369,7 +369,7 @@ include Tezos_raw_protocol_002_PsYLVpVv.Main tezos-protocol-updater tezos-protocol-environment) (flags (:standard -w +a-4-6-7-9-29-32-40..42-44-45-48 - -warn-error -a+8)) + -warn-error +a)) (modules Registerer)) (alias diff --git a/src/proto_003_PsddFKi3/lib_protocol/dune.inc b/src/proto_003_PsddFKi3/lib_protocol/dune.inc index 3b19bf1f7d..b2e2808ce4 100644 --- a/src/proto_003_PsddFKi3/lib_protocol/dune.inc +++ b/src/proto_003_PsddFKi3/lib_protocol/dune.inc @@ -262,7 +262,7 @@ include Tezos_raw_protocol_003_PsddFKi3.Main (library_flags (:standard -linkall)) (flags (:standard -nopervasives -nostdlib -w +a-4-6-7-9-29-32-40..42-44-45-48 - -warn-error -a+8 + -warn-error +a -open Tezos_protocol_environment_003_PsddFKi3__Environment -open Pervasives -open Error_monad)) @@ -349,7 +349,7 @@ include Tezos_raw_protocol_003_PsddFKi3.Main tezos-protocol-environment-sigs tezos_raw_protocol_003_PsddFKi3) (flags -w "+a-4-6-7-9-29-40..42-44-45-48" - -warn-error "-a+8" + -warn-error "+a" -nopervasives) (modules Protocol)) @@ -361,7 +361,7 @@ include Tezos_raw_protocol_003_PsddFKi3.Main tezos-protocol-environment-sigs tezos_raw_protocol_003_PsddFKi3) (flags -w "+a-4-6-7-9-29-40..42-44-45-48" - -warn-error "-a+8" + -warn-error "+a" -nopervasives) (modules Functor)) @@ -373,7 +373,7 @@ include Tezos_raw_protocol_003_PsddFKi3.Main tezos-protocol-updater tezos-protocol-environment) (flags (:standard -w +a-4-6-7-9-29-32-40..42-44-45-48 - -warn-error -a+8)) + -warn-error +a)) (modules Registerer)) (alias diff --git a/src/proto_004_Pt24m4xi/lib_protocol/dune.inc b/src/proto_004_Pt24m4xi/lib_protocol/dune.inc index d1d00b8693..0ffeb27576 100644 --- a/src/proto_004_Pt24m4xi/lib_protocol/dune.inc +++ b/src/proto_004_Pt24m4xi/lib_protocol/dune.inc @@ -262,7 +262,7 @@ include Tezos_raw_protocol_004_Pt24m4xi.Main (library_flags (:standard -linkall)) (flags (:standard -nopervasives -nostdlib -w +a-4-6-7-9-29-32-40..42-44-45-48 - -warn-error -a+8 + -warn-error +a -open Tezos_protocol_environment_004_Pt24m4xi__Environment -open Pervasives -open Error_monad)) @@ -349,7 +349,7 @@ include Tezos_raw_protocol_004_Pt24m4xi.Main tezos-protocol-environment-sigs tezos_raw_protocol_004_Pt24m4xi) (flags -w "+a-4-6-7-9-29-40..42-44-45-48" - -warn-error "-a+8" + -warn-error "+a" -nopervasives) (modules Protocol)) @@ -361,7 +361,7 @@ include Tezos_raw_protocol_004_Pt24m4xi.Main tezos-protocol-environment-sigs tezos_raw_protocol_004_Pt24m4xi) (flags -w "+a-4-6-7-9-29-40..42-44-45-48" - -warn-error "-a+8" + -warn-error "+a" -nopervasives) (modules Functor)) @@ -373,7 +373,7 @@ include Tezos_raw_protocol_004_Pt24m4xi.Main tezos-protocol-updater tezos-protocol-environment) (flags (:standard -w +a-4-6-7-9-29-32-40..42-44-45-48 - -warn-error -a+8)) + -warn-error +a)) (modules Registerer)) (alias diff --git a/src/proto_005_PsBABY5H/lib_protocol/dune.inc b/src/proto_005_PsBABY5H/lib_protocol/dune.inc index ddfeb6f5fe..db294a86db 100644 --- a/src/proto_005_PsBABY5H/lib_protocol/dune.inc +++ b/src/proto_005_PsBABY5H/lib_protocol/dune.inc @@ -265,7 +265,7 @@ include Tezos_raw_protocol_005_PsBABY5H.Main (library_flags (:standard -linkall)) (flags (:standard -nopervasives -nostdlib -w +a-4-6-7-9-29-32-40..42-44-45-48 - -warn-error -a+8 + -warn-error +a -open Tezos_protocol_environment_005_PsBABY5H__Environment -open Pervasives -open Error_monad)) @@ -353,7 +353,7 @@ include Tezos_raw_protocol_005_PsBABY5H.Main tezos-protocol-environment-sigs tezos_raw_protocol_005_PsBABY5H) (flags -w "+a-4-6-7-9-29-40..42-44-45-48" - -warn-error "-a+8" + -warn-error "+a" -nopervasives) (modules Protocol)) @@ -365,7 +365,7 @@ include Tezos_raw_protocol_005_PsBABY5H.Main tezos-protocol-environment-sigs tezos_raw_protocol_005_PsBABY5H) (flags -w "+a-4-6-7-9-29-40..42-44-45-48" - -warn-error "-a+8" + -warn-error "+a" -nopervasives) (modules Functor)) @@ -377,7 +377,7 @@ include Tezos_raw_protocol_005_PsBABY5H.Main tezos-protocol-updater tezos-protocol-environment) (flags (:standard -w +a-4-6-7-9-29-32-40..42-44-45-48 - -warn-error -a+8)) + -warn-error +a)) (modules Registerer)) (alias diff --git a/src/proto_005_PsBabyM1/lib_protocol/dune.inc b/src/proto_005_PsBabyM1/lib_protocol/dune.inc index ef64f383a3..686bf9380b 100644 --- a/src/proto_005_PsBabyM1/lib_protocol/dune.inc +++ b/src/proto_005_PsBabyM1/lib_protocol/dune.inc @@ -265,7 +265,7 @@ include Tezos_raw_protocol_005_PsBabyM1.Main (library_flags (:standard -linkall)) (flags (:standard -nopervasives -nostdlib -w +a-4-6-7-9-29-32-40..42-44-45-48 - -warn-error -a+8 + -warn-error +a -open Tezos_protocol_environment_005_PsBabyM1__Environment -open Pervasives -open Error_monad)) @@ -353,7 +353,7 @@ include Tezos_raw_protocol_005_PsBabyM1.Main tezos-protocol-environment-sigs tezos_raw_protocol_005_PsBabyM1) (flags -w "+a-4-6-7-9-29-40..42-44-45-48" - -warn-error "-a+8" + -warn-error "+a" -nopervasives) (modules Protocol)) @@ -365,7 +365,7 @@ include Tezos_raw_protocol_005_PsBabyM1.Main tezos-protocol-environment-sigs tezos_raw_protocol_005_PsBabyM1) (flags -w "+a-4-6-7-9-29-40..42-44-45-48" - -warn-error "-a+8" + -warn-error "+a" -nopervasives) (modules Functor)) @@ -377,7 +377,7 @@ include Tezos_raw_protocol_005_PsBabyM1.Main tezos-protocol-updater tezos-protocol-environment) (flags (:standard -w +a-4-6-7-9-29-32-40..42-44-45-48 - -warn-error -a+8)) + -warn-error +a)) (modules Registerer)) (alias diff --git a/src/proto_006_PsCARTHA/bin_accuser/main_accuser_006_PsCARTHA.ml b/src/proto_006_PsCARTHA/bin_accuser/main_accuser_006_PsCARTHA.ml index 7d62c0d1a9..adc3cf7128 100644 --- a/src/proto_006_PsCARTHA/bin_accuser/main_accuser_006_PsCARTHA.ml +++ b/src/proto_006_PsCARTHA/bin_accuser/main_accuser_006_PsCARTHA.ml @@ -40,8 +40,4 @@ let select_commands _ _ = (Clic.map_command (new Protocol_client_context.wrap_full)) (Delegate_commands.accuser_commands ())) -let () = - Client_main_run.run - ~log:(Log.fatal_error "%s") - (module Client_config) - ~select_commands +let () = Client_main_run.run (module Client_config) ~select_commands diff --git a/src/proto_006_PsCARTHA/bin_baker/main_baker_006_PsCARTHA.ml b/src/proto_006_PsCARTHA/bin_baker/main_baker_006_PsCARTHA.ml index 74396f881f..d3584e1cd5 100644 --- a/src/proto_006_PsCARTHA/bin_baker/main_baker_006_PsCARTHA.ml +++ b/src/proto_006_PsCARTHA/bin_baker/main_baker_006_PsCARTHA.ml @@ -40,8 +40,4 @@ let select_commands _ _ = (Clic.map_command (new Protocol_client_context.wrap_full)) (Delegate_commands.baker_commands ())) -let () = - Client_main_run.run - ~log:(Log.fatal_error "%s") - (module Client_config) - ~select_commands +let () = Client_main_run.run (module Client_config) ~select_commands diff --git a/src/proto_006_PsCARTHA/bin_endorser/main_endorser_006_PsCARTHA.ml b/src/proto_006_PsCARTHA/bin_endorser/main_endorser_006_PsCARTHA.ml index 89c2871488..01581e07fd 100644 --- a/src/proto_006_PsCARTHA/bin_endorser/main_endorser_006_PsCARTHA.ml +++ b/src/proto_006_PsCARTHA/bin_endorser/main_endorser_006_PsCARTHA.ml @@ -40,8 +40,4 @@ let select_commands _ _ = (Clic.map_command (new Protocol_client_context.wrap_full)) (Delegate_commands.endorser_commands ())) -let () = - Client_main_run.run - ~log:(Log.fatal_error "%s") - (module Client_config) - ~select_commands +let () = Client_main_run.run (module Client_config) ~select_commands diff --git a/src/proto_006_PsCARTHA/lib_client/mockup.ml b/src/proto_006_PsCARTHA/lib_client/mockup.ml index 1284f7c947..8868e43467 100644 --- a/src/proto_006_PsCARTHA/lib_client/mockup.ml +++ b/src/proto_006_PsCARTHA/lib_client/mockup.ml @@ -39,6 +39,7 @@ type protocol_constants_overrides = { hard_storage_limit_per_operation : Z.t option; cost_per_byte : Protocol.Tez_repr.t option; chain_id : Chain_id.t option; + timestamp : Time.Protocol.t option; } type parsed_account_repr = { @@ -112,25 +113,29 @@ let protocol_constants_overrides_encoding = p.hard_gas_limit_per_block, p.hard_storage_limit_per_operation, p.cost_per_byte, - p.chain_id )) + p.chain_id, + p.timestamp )) (fun ( hard_gas_limit_per_operation, hard_gas_limit_per_block, hard_storage_limit_per_operation, cost_per_byte, - chain_id ) -> + chain_id, + timestamp ) -> { hard_gas_limit_per_operation; hard_gas_limit_per_block; hard_storage_limit_per_operation; cost_per_byte; chain_id; + timestamp; }) - (obj5 + (obj6 (opt "hard_gas_limit_per_operation" z) (opt "hard_gas_limit_per_block" z) (opt "hard_storage_limit_per_operation" z) (opt "cost_per_byte" Protocol.Tez_repr.encoding) - (opt "chain_id" Chain_id.encoding)) + (opt "chain_id" Chain_id.encoding) + (opt "initial_timestamp" Time.Protocol.encoding)) let default_mockup_parameters : mockup_protocol_parameters = let open Tezos_protocol_006_PsCARTHA_parameters in @@ -155,6 +160,7 @@ let default_mockup_protocol_constants : protocol_constants_overrides = Some default.constants.hard_storage_limit_per_operation; cost_per_byte = Some default.constants.cost_per_byte; chain_id = Some Tezos_mockup_registration.Mockup_args.Chain_id.dummy; + timestamp = Some default_mockup_parameters.initial_timestamp; } (* Use the wallet to convert a bootstrap account's public key @@ -234,6 +240,7 @@ let protocol_constants_no_overrides = hard_storage_limit_per_operation = None; cost_per_byte = None; chain_id = None; + timestamp = None; } let apply_protocol_overrides (cctxt : Tezos_client_base.Client_context.full) @@ -365,27 +372,16 @@ let initial_context (header : Block_header.shell_header) let mem_init : cctxt:Tezos_client_base.Client_context.full -> parameters:mockup_protocol_parameters -> - chain_id:Chain_id.t option -> constants_overrides_json:Data_encoding.json option -> bootstrap_accounts_json:Data_encoding.json option -> (Chain_id.t * Tezos_protocol_environment.rpc_context) tzresult Lwt.t = - fun ~cctxt - ~parameters - ~chain_id - ~constants_overrides_json - ~bootstrap_accounts_json -> + fun ~cctxt ~parameters ~constants_overrides_json ~bootstrap_accounts_json -> let hash = Block_hash.of_b58check_exn "BLockGenesisGenesisGenesisGenesisGenesisCCCCCeZiLHU" in - let shell = - Forge.make_shell - ~level:0l - ~predecessor:hash - ~timestamp:parameters.initial_timestamp - ~fitness:(Protocol.Fitness_repr.from_int64 0L) - ~operations_hash:Operation_list_list_hash.zero - in + (* Need to read this Json file before since timestamp modification may be in + there *) ( match constants_overrides_json with | None -> return protocol_constants_no_overrides @@ -401,6 +397,20 @@ let mem_init : (Data_encoding.Json.print_error ?print_unknown:None) error ) ) >>=? fun protocol_overrides -> + let default = parameters.initial_timestamp in + let timestamp = Option.value ~default protocol_overrides.timestamp in + ( if not @@ Time.Protocol.equal default timestamp then + cctxt#message "@[initial_timestamp: %a@]" Time.Protocol.pp_hum timestamp + else Lwt.return_unit ) + >>= fun () -> + let shell = + Forge.make_shell + ~level:0l + ~predecessor:hash + ~timestamp + ~fitness:(Protocol.Fitness_repr.from_int64 0L) + ~operations_hash:Operation_list_list_hash.zero + in apply_protocol_overrides cctxt protocol_overrides parameters.constants >>=? fun protocol_custom -> ( match bootstrap_accounts_json with @@ -444,7 +454,6 @@ let mem_init : >>=? fun context -> let chain_id = Tezos_mockup_registration.Mockup_args.Chain_id.choose - ~from_command_line:chain_id ~from_config_file:protocol_overrides.chain_id in return diff --git a/src/proto_006_PsCARTHA/lib_client_commands/client_proto_mockup_commands.ml b/src/proto_006_PsCARTHA/lib_client_commands/client_proto_mockup_commands.ml index bf6d0e5e84..d126bc898b 100644 --- a/src/proto_006_PsCARTHA/lib_client_commands/client_proto_mockup_commands.ml +++ b/src/proto_006_PsCARTHA/lib_client_commands/client_proto_mockup_commands.ml @@ -49,29 +49,16 @@ let load_json_file (cctxt : Protocol_client_context.full) json_file = >>=? fun json_string -> return (Some (Ezjsonm.from_string json_string :> Data_encoding.json)) -let chain_id_seed_arg = - Clic.arg - ~doc:"chain id seed to generate a valid mockup chain id" - ~long:"chain-id-seed" - ~placeholder:"string" - (Clic.parameter (fun _ x -> return x)) - let create_mockup_command_handler - (chain_id_seed_arg, constants_overrides_file, bootstrap_accounts_file) + (constants_overrides_file, bootstrap_accounts_file) (cctxt : Protocol_client_context.full) = load_json_file cctxt constants_overrides_file >>=? fun constants_overrides_json -> load_json_file cctxt bootstrap_accounts_file >>=? fun bootstrap_accounts_json -> - let chain_id = - Option.map - Tezos_mockup_registration.Mockup_args.Chain_id.of_string - chain_id_seed_arg - in Tezos_mockup.Persistence.create_mockup ~cctxt:(cctxt :> Tezos_client_base.Client_context.full) ~protocol_hash:Protocol.hash - ~chain_id ~constants_overrides_json ~bootstrap_accounts_json >>=? fun () -> @@ -82,7 +69,7 @@ let create_mockup_command : Protocol_client_context.full Clic.command = command ~group:Tezos_mockup_commands.Mockup_commands.group ~desc:"Create a mockup environment." - (args3 chain_id_seed_arg protocol_constants_arg bootstrap_accounts_arg) + (args2 protocol_constants_arg bootstrap_accounts_arg) (prefixes ["create"; "mockup"] @@ stop) create_mockup_command_handler diff --git a/src/proto_006_PsCARTHA/lib_delegate/block_repr.ml b/src/proto_006_PsCARTHA/lib_delegate/block_repr.ml new file mode 100644 index 0000000000..846e6ec07c --- /dev/null +++ b/src/proto_006_PsCARTHA/lib_delegate/block_repr.ml @@ -0,0 +1,200 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs, *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +type contents = {header : Block_header.t; operations : Operation.t list list} + +type metadata = { + message : string option; + max_operations_ttl : int; + last_allowed_fork_level : Int32.t; + block_metadata : Bytes.t; + operations_metadata : Bytes.t list list; +} + +type block = { + hash : Block_hash.t; + contents : contents; + mutable metadata : metadata option; + (* allows updating metadata field when loading cemented metadata *) +} + +type t = block + +let contents_encoding = + let open Data_encoding in + conv + (fun {header; operations} -> (header, operations)) + (fun (header, operations) -> {header; operations}) + (obj2 + (req "header" (dynamic_size Block_header.encoding)) + (req "operations" (list (list (dynamic_size Operation.encoding))))) + +let metadata_encoding : metadata Data_encoding.t = + let open Data_encoding in + conv + (fun { message; + max_operations_ttl; + last_allowed_fork_level; + block_metadata; + operations_metadata } -> + ( message, + max_operations_ttl, + last_allowed_fork_level, + block_metadata, + operations_metadata )) + (fun ( message, + max_operations_ttl, + last_allowed_fork_level, + block_metadata, + operations_metadata ) -> + { + message; + max_operations_ttl; + last_allowed_fork_level; + block_metadata; + operations_metadata; + }) + (obj5 + (opt "message" string) + (req "max_operations_ttl" uint16) + (req "last_allowed_fork_level" int32) + (req "block_metadata" bytes) + (req "operations_metadata" (list (list bytes)))) + +let encoding = + let open Data_encoding in + conv + (fun {hash; contents; metadata} -> (hash, contents, metadata)) + (fun (hash, contents, metadata) -> {hash; contents; metadata}) + (dynamic_size + ~kind:`Uint30 + (obj3 + (req "hash" Block_hash.encoding) + (req "contents" contents_encoding) + (varopt "metadata" metadata_encoding))) + +let pp_json fmt b = + let json = Data_encoding.Json.construct encoding b in + Data_encoding.Json.pp fmt json + +(* Contents accessors *) + +let hash blk = blk.hash + +let header blk = blk.contents.header + +let operations blk = blk.contents.operations + +let shell_header blk = blk.contents.header.Block_header.shell + +let level blk = blk.contents.header.Block_header.shell.level + +let proto_level blk = blk.contents.header.Block_header.shell.proto_level + +let predecessor blk = blk.contents.header.Block_header.shell.predecessor + +let timestamp blk = blk.contents.header.Block_header.shell.timestamp + +let validation_passes blk = + blk.contents.header.Block_header.shell.validation_passes + +let fitness blk = blk.contents.header.Block_header.shell.fitness + +let context blk = blk.contents.header.Block_header.shell.context + +let protocol_data blk = blk.contents.header.Block_header.protocol_data + +(* Metadata accessors *) + +let metadata blk = blk.metadata + +let message metadata = metadata.message + +let max_operations_ttl metadata = metadata.max_operations_ttl + +let last_allowed_fork_level metadata = metadata.last_allowed_fork_level + +let block_metadata metadata = metadata.block_metadata + +let operations_metadata metadata = metadata.operations_metadata + +let check_block_consistency ?genesis_hash ?pred_block block = + (* TODO add proper errors *) + let block_header = header block in + let block_hash = hash block in + let result_hash = Block_header.hash block_header in + fail_unless + ( Block_hash.equal block_hash result_hash + || Option.fold + ~some:(fun genesis_hash -> Block_hash.equal block_hash genesis_hash) + ~none:false + genesis_hash ) + (Exn + (Failure + (Format.asprintf + "Inconsistent block: inconsistent hash found for block %ld. \ + Expected %a, got %a" + (level block) + Block_hash.pp + block_hash + Block_hash.pp + result_hash))) + >>=? fun () -> + Option.fold pred_block ~none:return_unit ~some:(fun pred_block -> + fail_unless + ( Block_hash.equal (hash pred_block) (predecessor block) + && Compare.Int32.(level block = Int32.succ (level pred_block)) ) + (Exn + (Failure + (Format.asprintf + "Inconsistent block: inconsistent predecessor found for \ + block %a (%ld) - expected: %a vs got: %a" + Block_hash.pp + block_hash + (level block) + Block_hash.pp + (hash pred_block) + Block_hash.pp + (predecessor block))))) + >>=? fun () -> return_unit + +let read_next_block fd = + (* Read length *) + let length_bytes = Bytes.create 4 in + Lwt_utils_unix.read_bytes ~pos:0 ~len:4 fd length_bytes + >>= fun () -> + let block_length_int32 = Bytes.get_int32_be length_bytes 0 in + let block_length = Int32.to_int block_length_int32 in + let block_bytes = Bytes.create (4 + block_length) in + Lwt_utils_unix.read_bytes ~pos:4 ~len:block_length fd block_bytes + >>= fun () -> + Bytes.set_int32_be block_bytes 0 block_length_int32 ; + Lwt.return + (Data_encoding.Binary.of_bytes_exn encoding block_bytes, 4 + block_length) + +let read_next_block_opt fd = + Lwt.catch + (fun () -> read_next_block fd >>= fun b -> Lwt.return_some b) + (fun _exn -> Lwt.return_none) diff --git a/src/proto_006_PsCARTHA/lib_delegate/client_baking_forge.ml b/src/proto_006_PsCARTHA/lib_delegate/client_baking_forge.ml index d3cf6e6ed0..696e0d40c8 100644 --- a/src/proto_006_PsCARTHA/lib_delegate/client_baking_forge.ml +++ b/src/proto_006_PsCARTHA/lib_delegate/client_baking_forge.ml @@ -23,6 +23,8 @@ (* *) (*****************************************************************************) +[@@@ocaml.warning "-32"] + open Protocol open Alpha_context open Protocol_client_context @@ -54,8 +56,7 @@ let default_minimal_nanotez_per_gas_unit = Z.of_int 100 let default_minimal_nanotez_per_byte = Z.of_int 1000 -type slot = - Time.Protocol.t * (Client_baking_blocks.block_info * int * public_key_hash) +type slot = Client_baking_blocks.block_info type state = { context_path : string; @@ -74,12 +75,27 @@ type state = { minimal_nanotez_per_byte : Z.t; (* truly mutable *) mutable best_slot : slot option; + get_next_block : unit -> Block_repr.t Lwt.t; } let create_state ?(minimal_fees = default_minimal_fees) ?(minimal_nanotez_per_gas_unit = default_minimal_nanotez_per_gas_unit) ?(minimal_nanotez_per_byte = default_minimal_nanotez_per_byte) context_path - index nonces_location delegates constants = + index nonces_location delegates constants block_file = + Lwt_unix.openfile block_file [Unix.O_RDONLY] 0o644 + >>= fun fd -> + let get_next_block () = + Lwt.catch + (fun () -> + Block_repr.read_next_block fd >>= fun (block, _) -> Lwt.return block) + (function + | End_of_file -> + Format.printf "No more blocks to read, exiting...@." ; + exit 0 + | exn -> + Lwt.fail exn) + in + Lwt.return { context_path; index; @@ -90,6 +106,7 @@ let create_state ?(minimal_fees = default_minimal_fees) minimal_nanotez_per_gas_unit; minimal_nanotez_per_byte; best_slot = None; + get_next_block; } let get_delegates cctxt state = @@ -172,58 +189,26 @@ let compute_endorsing_power cctxt ~chain ~block operations = 0 operations -let inject_block cctxt ?(force = false) ?seed_nonce_hash ~chain ~shell_header - ~priority ~delegate_pkh ~delegate_sk ~level operations = +let inject_block (cctxt : #Protocol_client_context.full) ?(force = false) ?seed_nonce_hash ~chain ~shell_header ~priority:_ ~signed_header ~level:_ operations = + ignore seed_nonce_hash ; + let signed_header = + Data_encoding.Binary.to_bytes_exn + Alpha_context.Block_header.encoding + signed_header + in assert_valid_operations_hash shell_header operations >>=? fun () -> - let block = `Hash (shell_header.Tezos_base.Block_header.predecessor, 0) in - forge_block_header - cctxt - ~chain - block - delegate_sk - shell_header - priority - seed_nonce_hash - >>=? fun signed_header -> - (* Record baked blocks to prevent double baking *) - let open Client_baking_highwatermarks in - cctxt#with_lock (fun () -> - Client_baking_files.resolve_location cctxt ~chain `Block - >>=? fun block_location -> - may_inject_block cctxt block_location ~delegate:delegate_pkh level - >>=? function - | true -> - record_block cctxt block_location ~delegate:delegate_pkh level - >>=? fun () -> return_true - | false -> - lwt_log_error - Tag.DSL.( - fun f -> - f "Level %a : previously baked" - -% t event "double_bake_near_miss" - -% a level_tag level) - >>= fun () -> return force) - >>=? function - | false -> - fail (Level_previously_baked level) - | true -> - Shell_services.Injection.block - cctxt - ~force - ~chain - signed_header - operations - >>=? fun block_hash -> - lwt_log_info - Tag.DSL.( - fun f -> - f "Client_baking_forge.inject_block: inject %a" - -% t event "inject_baked_block" - -% a Block_hash.Logging.tag block_hash - -% t signed_header_tag signed_header - -% t operations_tag operations) - >>= fun () -> return block_hash + Shell_services.Injection.block cctxt ~force ~chain signed_header operations + >>=? fun block_hash -> + lwt_log_info + Tag.DSL.( + fun f -> + f "Client_baking_forge.inject_block: inject %a" + -% t event "inject_baked_block" + -% a Block_hash.Logging.tag block_hash + -% t signed_header_tag signed_header + -% t operations_tag operations) + >>= fun () -> return block_hash type error += Failed_to_preapply of Tezos_base.Operation.t * error list @@ -765,206 +750,24 @@ let forge_block cctxt ?force ?operations ?(best_effort = operations = None) ?(minimal_nanotez_per_byte = default_minimal_nanotez_per_byte) ?timestamp ?mempool ?context_path ?seed_nonce_hash ~chain ~priority ~delegate_pkh ~delegate_sk block = - (* making the arguments usable *) - unopt_operations cctxt chain mempool operations - >>=? fun operations_arg -> - compute_endorsing_power cctxt ~chain ~block operations_arg - >>=? fun endorsing_power -> - decode_priority cctxt chain block ~priority ~endorsing_power - >>=? fun (priority, minimal_timestamp) -> - unopt_timestamp ?force timestamp minimal_timestamp - >>=? fun timestamp -> - (* get basic building blocks *) - let protocol_data = forge_faked_protocol_data ~priority ~seed_nonce_hash in - Alpha_services.Constants.all cctxt (chain, block) - >>=? fun Constants. - { parametric = {hard_gas_limit_per_block; endorsers_per_block; _}; - _ } -> - classify_operations - cctxt - ~chain - ~hard_gas_limit_per_block - ~block - ~minimal_fees - ~minimal_nanotez_per_gas_unit - ~minimal_nanotez_per_byte - operations_arg - >>=? fun (operations, overflowing_ops) -> - (* Ensure that we retain operations up to the quota *) - let quota : Environment.Updater.quota list = Main.validation_passes in - let endorsements = - List.sub (List.nth operations endorsements_index) endorsers_per_block - in - let votes = - retain_operations_up_to_quota - (List.nth operations votes_index) - (List.nth quota votes_index) - in - let anonymous = - retain_operations_up_to_quota - (List.nth operations anonymous_index) - (List.nth quota anonymous_index) - in - (* Size/Gas check already occurred in classify operations *) - let managers = List.nth operations managers_index in - let operations = [endorsements; votes; anonymous; managers] in - ( match context_path with - | None -> - Alpha_block_services.Helpers.Preapply.block - cctxt - ~chain - ~block - ~timestamp - ~sort - ~protocol_data - operations - >>=? fun (shell_header, result) -> - let operations = - List.map (fun l -> List.map snd l.Preapply_result.applied) result - in - (* everything went well (or we don't care about errors): GO! *) - if best_effort || all_ops_valid result then - return (shell_header, operations) - (* some errors (and we care about them) *) - else - let result = - List.fold_left merge_preapps Preapply_result.empty result - in - Lwt.return_error @@ List.filter_map (error_of_op result) operations_arg - | Some context_path -> - assert sort ; - assert best_effort ; - Context.init ~readonly:true context_path - >>= fun index -> - Client_baking_blocks.info cctxt ~chain block - >>=? fun bi -> - Alpha_services.Constants.all cctxt (chain, `Head 0) - >>=? fun constants -> - Client_baking_files.resolve_location cctxt ~chain `Nonce - >>=? fun nonces_location -> - let state = - { - context_path; - index; - nonces_location; - constants; - delegates = []; - best_slot = None; - minimal_fees = default_minimal_fees; - minimal_nanotez_per_gas_unit = default_minimal_nanotez_per_gas_unit; - minimal_nanotez_per_byte = default_minimal_nanotez_per_byte; - } - in - filter_and_apply_operations - cctxt - state - ~chain - ~block - ~priority - ~protocol_data - bi - (operations, overflowing_ops) - >>=? fun ( final_context, - (validation_result, _), - operations, - min_valid_timestamp ) -> - let current_protocol = bi.next_protocol in - let context = - Shell_context.unwrap_disk_context validation_result.context - in - Context.get_protocol context - >>= fun next_protocol -> - if Protocol_hash.equal current_protocol next_protocol then - finalize_block_header - final_context.header - ~timestamp:min_valid_timestamp - validation_result - operations - >>= function - | Error (Forking_test_chain :: _) -> - Alpha_block_services.Helpers.Preapply.block - cctxt - ~chain - ~block - ~timestamp:min_valid_timestamp - ~sort - ~protocol_data - operations - >>=? fun (shell_header, _result) -> - return (shell_header, List.map (List.map forge) operations) - | Error _ as errs -> - Lwt.return errs - | Ok shell_header -> - return (shell_header, List.map (List.map forge) operations) - else - lwt_log_notice - Tag.DSL.( - fun f -> - f "New protocol detected: using shell validation" - -% t event "shell_prevalidation_notice") - >>= fun () -> - Alpha_block_services.Helpers.Preapply.block - cctxt - ~chain - ~block - ~timestamp:min_valid_timestamp - ~sort - ~protocol_data - operations - >>=? fun (shell_header, _result) -> - return (shell_header, List.map (List.map forge) operations) ) - >>=? fun (shell_header, operations) -> - (* Now for some logging *) - let total_op_count = List.length operations_arg in - let valid_op_count = List.length (List.concat operations) in - lwt_log_notice - Tag.DSL.( - fun f -> - f - "found %d valid operations (%d refused) for timestamp %a (fitness %a)" - -% t event "found_valid_operations" - -% s valid_ops valid_op_count - -% s refused_ops (total_op_count - valid_op_count) - -% a timestamp_tag (Time.System.of_protocol_exn timestamp) - -% a fitness_tag shell_header.fitness) - >>= fun () -> - ( match Environment.wrap_error (Raw_level.of_int32 shell_header.level) with - | Ok level -> - return level - | Error errs as err -> - lwt_log_error - Tag.DSL.( - fun f -> - f "Error on raw_level conversion : %a" - -% t event "block_injection_failed" - -% a errs_tag errs) - >>= fun () -> Lwt.return err ) - >>=? fun level -> - inject_block - cctxt - ?force - ~chain - ~shell_header - ~priority - ?seed_nonce_hash - ~delegate_pkh - ~delegate_sk - ~level - operations - >>= function - | Ok hash -> - return hash - | Error errs as error -> - lwt_log_error - Tag.DSL.( - fun f -> - f - "@[Error while injecting block@ @[Included operations : \ - %a@]@ %a@]" - -% t event "block_injection_failed" - -% a raw_operations_tag (List.concat operations) - -% a errs_tag errs) - >>= fun () -> Lwt.return error + ignore cctxt ; + ignore force ; + ignore operations ; + ignore best_effort ; + ignore sort ; + ignore minimal_fees ; + ignore minimal_nanotez_per_gas_unit ; + ignore minimal_nanotez_per_byte ; + ignore timestamp ; + ignore mempool ; + ignore context_path ; + ignore seed_nonce_hash ; + ignore chain ; + ignore priority ; + ignore delegate_pkh ; + ignore delegate_sk ; + ignore block ; + assert false let shell_prevalidation (cctxt : #Protocol_client_context.full) ~chain ~block ~timestamp seed_nonce_hash operations @@ -1096,195 +899,57 @@ let fetch_operations (cctxt : #Protocol_client_context.full) ~chain (** Given a delegate baking slot [build_block] constructs a full block with consistent operations that went through the client-side validation *) -let build_block ~user_activated_upgrades cctxt state seed_nonce_hash - ((slot_timestamp, (bi, priority, delegate)) as slot) = +let build_block ~user_activated_upgrades:_ cctxt state _ bi = let chain = `Hash bi.Client_baking_blocks.chain_id in let block = `Hash (bi.hash, 0) in - Alpha_services.Helpers.current_level cctxt ~offset:1l (chain, block) - >>=? fun next_level -> - let seed_nonce_hash = - if next_level.Level.expected_commitment then Some seed_nonce_hash else None + let rec loop () = + state.get_next_block () + >>= fun block -> + if Compare.Int32.(Block_repr.level block <= Raw_level.to_int32 bi.level) + then loop () + else Lwt.return block in - Client_keys.Public_key_hash.name cctxt delegate - >>=? fun name -> - lwt_debug - Tag.DSL.( - fun f -> - f "Try baking after %a (slot %d) for %s (%a)" - -% t event "try_baking" - -% a Block_hash.Logging.tag bi.hash - -% s bake_priority_tag priority - -% s Client_keys.Logging.tag name - -% a timestamp_tag (Time.System.of_protocol_exn slot_timestamp)) - >>= fun () -> - fetch_operations cctxt ~chain slot - >>=? function - | None -> - lwt_log_notice - Tag.DSL.( - fun f -> - f - "Received a new head while waiting for operations. Aborting \ - this block." - -% t event "new_head_received") - >>= fun () -> return_none - | Some (operations, timestamp) -> ( - let hard_gas_limit_per_block = - state.constants.parametric.hard_gas_limit_per_block - in - classify_operations - cctxt - ~chain - ~hard_gas_limit_per_block - ~minimal_fees:state.minimal_fees - ~minimal_nanotez_per_gas_unit:state.minimal_nanotez_per_gas_unit - ~minimal_nanotez_per_byte:state.minimal_nanotez_per_byte - ~block - operations - >>=? fun (operations, overflowing_ops) -> - let next_version = - match - Tezos_base.Block_header.get_forced_protocol_upgrade - ~user_activated_upgrades - ~level:(Raw_level.to_int32 next_level.Level.level) - with - | None -> - bi.next_protocol - | Some hash -> - hash - in - if Protocol_hash.(Protocol.hash <> next_version) then - (* Let the shell validate this *) - shell_prevalidation - cctxt - ~chain - ~block - ~timestamp - seed_nonce_hash - operations - slot - else - let protocol_data = - forge_faked_protocol_data ~priority ~seed_nonce_hash - in - filter_and_apply_operations - cctxt - state - ~chain - ~block - ~priority - ~protocol_data - bi - (operations, overflowing_ops) - >>= function - | Error errs -> - lwt_log_error - Tag.DSL.( - fun f -> - f - "Client-side validation: error while filtering invalid \ - operations :@\n\ - @[%a@]" - -% t event "client_side_validation_error" - -% a errs_tag errs) - >>= fun () -> - lwt_log_notice - Tag.DSL.( - fun f -> - f "Building a block using shell validation" - -% t event "shell_prevalidation_notice") - >>= fun () -> - shell_prevalidation - cctxt - ~chain - ~block - ~timestamp - seed_nonce_hash - operations - slot - | Ok - (final_context, (validation_result, _), operations, valid_timestamp) - -> - ( if - Time.System.(Systime_os.now () < of_protocol_exn valid_timestamp) - then - lwt_log_notice - Tag.DSL.( - fun f -> - f "[%a] not ready to inject yet, waiting until %a" - -% a timestamp_tag (Systime_os.now ()) - -% a - timestamp_tag - (Time.System.of_protocol_exn valid_timestamp) - -% t event "waiting_before_injection") - >>= fun () -> - match Client_baking_scheduling.sleep_until valid_timestamp with - | None -> - Lwt.return_unit - | Some timeout -> - timeout - else Lwt.return_unit ) - >>= fun () -> - lwt_debug - Tag.DSL.( - fun f -> - f - "Try forging locally the block header for %a (slot %d) \ - for %s (%a)" - -% t event "try_forging" - -% a Block_hash.Logging.tag bi.hash - -% s bake_priority_tag priority - -% s Client_keys.Logging.tag name - -% a timestamp_tag (Time.System.of_protocol_exn timestamp)) - >>= fun () -> - let current_protocol = bi.next_protocol in - let context = - Shell_context.unwrap_disk_context validation_result.context - in - Context.get_protocol context - >>= fun next_protocol -> - if Protocol_hash.equal current_protocol next_protocol then - finalize_block_header - final_context.header - ~timestamp:valid_timestamp - validation_result - operations - >>= function - | Error (Forking_test_chain :: _) -> - shell_prevalidation - cctxt - ~chain - ~block - ~timestamp - seed_nonce_hash - operations - slot - | Error _ as errs -> - Lwt.return errs - | Ok shell_header -> - let raw_ops = List.map (List.map forge) operations in - return_some - ( bi, - priority, - shell_header, - raw_ops, - delegate, - seed_nonce_hash ) - else - lwt_log_notice - Tag.DSL.( - fun f -> - f "New protocol detected: using shell validation" - -% t event "shell_prevalidation_notice") - >>= fun () -> - shell_prevalidation - cctxt - ~chain - ~block - ~timestamp - seed_nonce_hash - operations - slot ) + loop () + >>= fun {Block_repr.contents = {header; operations}; _} -> + let {Tezos_base.Block_header.shell; protocol_data} = header in + let protocol_data = + Data_encoding.Binary.of_bytes_exn + Protocol.block_header_data_encoding + protocol_data + in + let convert_op {Tezos_base.Operation.shell; proto} = + let protocol_data = + Data_encoding.Binary.of_bytes_exn Protocol.operation_data_encoding proto + in + ({shell; protocol_data} : packed_operation) + in + let ops_raw = operations in + let operations = List.map (fun l -> List.map convert_op l) operations in + let now = Systime_os.now () in + filter_and_apply_operations + cctxt + state + ~chain + ~block + bi + ~priority:protocol_data.contents.priority + ~protocol_data + (operations, []) + >>=? fun _ -> + let tthen = Systime_os.now () in + Format.printf + "[%a] validated block in %a@." + Time.System.pp_hum + tthen + Time.System.Span.pp_hum + (Ptime.diff tthen now) ; + return_some + ( bi, + protocol_data.contents.priority, + shell, + ops_raw, + {Block_header.shell; protocol_data}, + protocol_data.contents.seed_nonce_hash ) (** [bake cctxt state] create a single block when woken up to do so. All the necessary information is available in the @@ -1296,16 +961,14 @@ let bake ~user_activated_upgrades (cctxt : #Protocol_client_context.full) assert false (* unreachable *) | Some slot -> return slot ) - >>=? fun slot -> + >>=? fun info -> let seed_nonce = generate_seed_nonce () in let seed_nonce_hash = Nonce.hash seed_nonce in - build_block ~user_activated_upgrades cctxt state seed_nonce_hash slot + build_block ~user_activated_upgrades cctxt state seed_nonce_hash info >>=? function - | Some (head, priority, shell_header, operations, delegate, seed_nonce_hash) + | Some (head, priority, shell_header, operations, signed_header, seed_nonce_hash) -> ( let level = Raw_level.succ head.level in - Client_keys.Public_key_hash.name cctxt delegate - >>=? fun name -> lwt_log_info Tag.DSL.( fun f -> @@ -1314,11 +977,8 @@ let bake ~user_activated_upgrades (cctxt : #Protocol_client_context.full) -% s bake_priority_tag priority -% a fitness_tag shell_header.fitness -% s Client_keys.Logging.tag name - -% a Block_hash.Logging.predecessor_tag shell_header.predecessor - -% t Signature.Public_key_hash.Logging.tag delegate) + -% a Block_hash.Logging.predecessor_tag shell_header.predecessor) >>= fun () -> - Client_keys.get_key cctxt delegate - >>=? fun (_, _, delegate_sk) -> inject_block cctxt ~chain @@ -1326,8 +986,7 @@ let bake ~user_activated_upgrades (cctxt : #Protocol_client_context.full) ~shell_header ~priority ?seed_nonce_hash - ~delegate_pkh:delegate - ~delegate_sk + ~signed_header ~level operations >>= function @@ -1343,19 +1002,20 @@ let bake ~user_activated_upgrades (cctxt : #Protocol_client_context.full) -% a errs_tag errs) >>= fun () -> return_unit | Ok block_hash -> + let int32_level_tag = + Tag.def ~doc:"Level" "level" (fun fmt i -> + Format.fprintf fmt "%ld" i) + in lwt_log_notice Tag.DSL.( fun f -> - f - "Injected block %a for %s after %a (level %a, priority %d, \ - fitness %a, operations %a)." + f "injected %a (%a, prio=%d) after %a (%a), operations %a)." -% t event "injected_block" -% a Block_hash.Logging.tag block_hash - -% s Client_keys.Logging.tag name - -% a Block_hash.Logging.tag shell_header.predecessor - -% a level_tag level + -% a int32_level_tag shell_header.level -% s bake_priority_tag priority - -% a fitness_tag shell_header.fitness + -% a Block_hash.Logging.tag info.hash + -% a level_tag info.level -% a operations_tag operations) >>= fun () -> ( if seed_nonce_hash <> None then @@ -1523,7 +1183,8 @@ let reveal_potential_nonces (cctxt : #Client_context.full) constants ~chain the [delegates] *) let create (cctxt : #Protocol_client_context.full) ~user_activated_upgrades ?minimal_fees ?minimal_nanotez_per_gas_unit ?minimal_nanotez_per_byte - ?max_priority ~chain ~context_path delegates block_stream = + ?max_priority ~chain ~blocks_file ~context_path delegates block_stream = + ignore max_priority ; let state_maker bi = Alpha_services.Constants.all cctxt (chain, `Head 0) >>=? fun constants -> @@ -1535,7 +1196,6 @@ let create (cctxt : #Protocol_client_context.full) ~user_activated_upgrades >>=? fun () -> Client_baking_files.resolve_location cctxt ~chain `Nonce >>=? fun nonces_location -> - let state = create_state ?minimal_fees ?minimal_nanotez_per_gas_unit @@ -1545,40 +1205,15 @@ let create (cctxt : #Protocol_client_context.full) ~user_activated_upgrades nonces_location delegates constants - in - return state + blocks_file + >>= return in - let event_k cctxt state new_head = - reveal_potential_nonces - cctxt - state.constants - ~chain - ~block:(`Hash (new_head.Client_baking_blocks.hash, 0)) - >>= fun _ignore_nonce_err -> - compute_best_slot_on_current_level ?max_priority cctxt state new_head - >>=? fun slot -> - state.best_slot <- slot ; - return_unit - in - let compute_timeout state = - match state.best_slot with - | None -> - (* No slot, just wait for new blocks which will give more info *) - Lwt_utils.never_ending () - | Some (timestamp, _) -> ( - match Client_baking_scheduling.sleep_until timestamp with - | None -> - Lwt.return_unit - | Some timeout -> - timeout ) - in - let timeout_k cctxt state () = - bake cctxt ~user_activated_upgrades ~chain state - >>=? fun () -> - (* Stopping the timeout and waiting for the next block *) - state.best_slot <- None ; - return_unit + let event_k _cctxt state new_head = + state.best_slot <- Some new_head ; + bake cctxt ~user_activated_upgrades ~chain state >>=? fun () -> return_unit in + let compute_timeout _state = Lwt_utils.never_ending () in + let timeout_k _cctxt _state () = return_unit in Client_baking_scheduling.main ~name:"baker" ~cctxt diff --git a/src/proto_006_PsCARTHA/lib_delegate/client_baking_forge.mli b/src/proto_006_PsCARTHA/lib_delegate/client_baking_forge.mli index c1182e3560..98b57c933d 100644 --- a/src/proto_006_PsCARTHA/lib_delegate/client_baking_forge.mli +++ b/src/proto_006_PsCARTHA/lib_delegate/client_baking_forge.mli @@ -32,24 +32,6 @@ open Alpha_context reveal the aforementioned nonce during the next cycle. *) val generate_seed_nonce : unit -> Nonce.t -(** [inject_block cctxt blk ?force ~priority ~timestamp ~fitness - ~seed_nonce ~src_sk ops] tries to inject a block in the node. If - [?force] is set, the fitness check will be bypassed. [priority] - will be used to compute the baking slot (level is - precomputed). [src_sk] is used to sign the block header. *) -val inject_block : - #Protocol_client_context.full -> - ?force:bool -> - ?seed_nonce_hash:Nonce_hash.t -> - chain:Chain_services.chain -> - shell_header:Block_header.shell_header -> - priority:int -> - delegate_pkh:Signature.Public_key_hash.t -> - delegate_sk:Client_keys.sk_uri -> - level:Raw_level.t -> - Operation.raw list list -> - Block_hash.t tzresult Lwt.t - type error += Failed_to_preapply of Tezos_base.Operation.t * error list (** [forge_block cctxt ?fee_threshold ?force ?operations ?best_effort @@ -100,6 +82,7 @@ val create : ?minimal_nanotez_per_byte:Z.t -> ?max_priority:int -> chain:Chain_services.chain -> + blocks_file:string -> context_path:string -> public_key_hash list -> Client_baking_blocks.block_info tzresult Lwt_stream.t -> diff --git a/src/proto_006_PsCARTHA/lib_delegate/client_baking_scheduling.ml b/src/proto_006_PsCARTHA/lib_delegate/client_baking_scheduling.ml index a8b5363da5..d1589c3362 100644 --- a/src/proto_006_PsCARTHA/lib_delegate/client_baking_scheduling.ml +++ b/src/proto_006_PsCARTHA/lib_delegate/client_baking_scheduling.ml @@ -120,7 +120,7 @@ let main ~(name : string) ~(cctxt : #Protocol_client_context.full) (* event construction *) let timeout = compute_timeout state in Lwt.choose - [ (Lwt_exit.termination_thread >|= fun _ -> `Termination); + [ (Lwt_exit.clean_up_starts >|= fun _ -> `Termination); (timeout >|= fun timesup -> `Timeout timesup); (get_event () >|= fun e -> `Event e) ] >>= function diff --git a/src/proto_006_PsCARTHA/lib_delegate/client_daemon.ml b/src/proto_006_PsCARTHA/lib_delegate/client_daemon.ml index f2eb38b62e..ac55f38912 100644 --- a/src/proto_006_PsCARTHA/lib_delegate/client_daemon.ml +++ b/src/proto_006_PsCARTHA/lib_delegate/client_daemon.ml @@ -37,7 +37,7 @@ let rec retry (cctxt : #Protocol_client_context.full) ?max_delay ~delay ~factor >>= fun () -> Lwt.pick [ (Lwt_unix.sleep delay >|= fun () -> `Continue); - (Lwt_exit.termination_thread >|= fun _ -> `Killed) ] + (Lwt_exit.clean_up_starts >|= fun _ -> `Killed) ] >>= function | `Killed -> Lwt.return err @@ -123,8 +123,7 @@ let monitor_fork_testchain (cctxt : #Protocol_client_context.full) (* Got a testchain for a different protocol, skipping *) in Lwt.pick - [ (Lwt_exit.termination_thread >>= fun _ -> failwith "Interrupted..."); - loop () ] + [(Lwt_exit.clean_up_starts >>= fun _ -> failwith "Interrupted..."); loop ()] >>=? fun () -> cctxt#message "Test chain forked." >>= fun () -> return_unit module Endorser = struct @@ -153,13 +152,8 @@ end module Baker = struct let run (cctxt : #Protocol_client_context.full) ?minimal_fees ?minimal_nanotez_per_gas_unit ?minimal_nanotez_per_byte ?max_priority - ~chain ~context_path ~keep_alive delegates = + ~chain ~context_path ~keep_alive:_ ~blocks_file delegates = let process () = - Config_services.user_activated_upgrades cctxt - >>=? fun user_activated_upgrades -> - ( if chain = `Test then monitor_fork_testchain cctxt ~cleanup_nonces:true - else return_unit ) - >>=? fun () -> Client_baking_blocks.monitor_heads ~next_protocols:(Some [Protocol.hash]) cctxt @@ -169,21 +163,18 @@ module Baker = struct >>= fun () -> Client_baking_forge.create cctxt - ~user_activated_upgrades + ~user_activated_upgrades:[] ?minimal_fees ?minimal_nanotez_per_gas_unit ?minimal_nanotez_per_byte ?max_priority ~chain + ~blocks_file ~context_path delegates block_stream in - Client_confirmations.wait_for_bootstrapped - ~retry:(retry cctxt ~delay:1. ~factor:1.5 ~tries:5) - cctxt - >>=? fun () -> - if keep_alive then retry_on_disconnection cctxt process else process () + process () end module Accuser = struct diff --git a/src/proto_006_PsCARTHA/lib_delegate/client_daemon.mli b/src/proto_006_PsCARTHA/lib_delegate/client_daemon.mli index 0573aed814..76596c1979 100644 --- a/src/proto_006_PsCARTHA/lib_delegate/client_daemon.mli +++ b/src/proto_006_PsCARTHA/lib_delegate/client_daemon.mli @@ -46,6 +46,7 @@ module Baker : sig chain:Chain_services.chain -> context_path:string -> keep_alive:bool -> + blocks_file:string -> public_key_hash list -> unit tzresult Lwt.t end diff --git a/src/proto_006_PsCARTHA/lib_delegate/delegate_commands.ml b/src/proto_006_PsCARTHA/lib_delegate/delegate_commands.ml index f7bcf06e67..6a0de834ff 100644 --- a/src/proto_006_PsCARTHA/lib_delegate/delegate_commands.ml +++ b/src/proto_006_PsCARTHA/lib_delegate/delegate_commands.ml @@ -35,6 +35,11 @@ let directory_parameter = failwith "Directory doesn't exist: '%s'" p else return p) +let file_parameter = + Clic.parameter (fun _ p -> + if not (Sys.file_exists p) then failwith "File '%s' doesn't exist" p + else return p) + let mempool_arg = Clic.arg ~long:"mempool" @@ -259,6 +264,7 @@ let baker_commands () = ~name:"context_path" ~desc:"Path to the node data directory (e.g. $HOME/.tezos-node)" directory_parameter + @@ param ~name:"blocks_file" ~desc:"Path to blocks" file_parameter @@ seq_of_param Client_keys.Public_key_hash.alias_param ) (fun ( pidfile, max_priority, @@ -267,6 +273,7 @@ let baker_commands () = minimal_nanotez_per_byte, keep_alive ) node_path + blocks_file delegates cctxt -> may_lock_pidfile pidfile @@ -284,6 +291,7 @@ let baker_commands () = ?max_priority ~context_path:(Filename.concat node_path "context") ~keep_alive + ~blocks_file (List.map snd delegates)) ] let endorser_commands () = diff --git a/src/proto_006_PsCARTHA/lib_protocol/dune.inc b/src/proto_006_PsCARTHA/lib_protocol/dune.inc index 014ed162d6..42e48cd42b 100644 --- a/src/proto_006_PsCARTHA/lib_protocol/dune.inc +++ b/src/proto_006_PsCARTHA/lib_protocol/dune.inc @@ -265,7 +265,7 @@ include Tezos_raw_protocol_006_PsCARTHA.Main (library_flags (:standard -linkall)) (flags (:standard -nopervasives -nostdlib -w +a-4-6-7-9-29-32-40..42-44-45-48 - -warn-error -a+8 + -warn-error +a -open Tezos_protocol_environment_006_PsCARTHA__Environment -open Pervasives -open Error_monad)) @@ -353,7 +353,7 @@ include Tezos_raw_protocol_006_PsCARTHA.Main tezos-protocol-environment-sigs tezos_raw_protocol_006_PsCARTHA) (flags -w "+a-4-6-7-9-29-40..42-44-45-48" - -warn-error "-a+8" + -warn-error "+a" -nopervasives) (modules Protocol)) @@ -365,7 +365,7 @@ include Tezos_raw_protocol_006_PsCARTHA.Main tezos-protocol-environment-sigs tezos_raw_protocol_006_PsCARTHA) (flags -w "+a-4-6-7-9-29-40..42-44-45-48" - -warn-error "-a+8" + -warn-error "+a" -nopervasives) (modules Functor)) @@ -377,7 +377,7 @@ include Tezos_raw_protocol_006_PsCARTHA.Main tezos-protocol-updater tezos-protocol-environment) (flags (:standard -w +a-4-6-7-9-29-32-40..42-44-45-48 - -warn-error -a+8)) + -warn-error +a)) (modules Registerer)) (alias diff --git a/src/proto_alpha/bin_accuser/main_accuser_alpha.ml b/src/proto_alpha/bin_accuser/main_accuser_alpha.ml index 7d62c0d1a9..adc3cf7128 100644 --- a/src/proto_alpha/bin_accuser/main_accuser_alpha.ml +++ b/src/proto_alpha/bin_accuser/main_accuser_alpha.ml @@ -40,8 +40,4 @@ let select_commands _ _ = (Clic.map_command (new Protocol_client_context.wrap_full)) (Delegate_commands.accuser_commands ())) -let () = - Client_main_run.run - ~log:(Log.fatal_error "%s") - (module Client_config) - ~select_commands +let () = Client_main_run.run (module Client_config) ~select_commands diff --git a/src/proto_alpha/bin_baker/main_baker_alpha.ml b/src/proto_alpha/bin_baker/main_baker_alpha.ml index 74396f881f..d3584e1cd5 100644 --- a/src/proto_alpha/bin_baker/main_baker_alpha.ml +++ b/src/proto_alpha/bin_baker/main_baker_alpha.ml @@ -40,8 +40,4 @@ let select_commands _ _ = (Clic.map_command (new Protocol_client_context.wrap_full)) (Delegate_commands.baker_commands ())) -let () = - Client_main_run.run - ~log:(Log.fatal_error "%s") - (module Client_config) - ~select_commands +let () = Client_main_run.run (module Client_config) ~select_commands diff --git a/src/proto_alpha/bin_endorser/main_endorser_alpha.ml b/src/proto_alpha/bin_endorser/main_endorser_alpha.ml index 89c2871488..01581e07fd 100644 --- a/src/proto_alpha/bin_endorser/main_endorser_alpha.ml +++ b/src/proto_alpha/bin_endorser/main_endorser_alpha.ml @@ -40,8 +40,4 @@ let select_commands _ _ = (Clic.map_command (new Protocol_client_context.wrap_full)) (Delegate_commands.endorser_commands ())) -let () = - Client_main_run.run - ~log:(Log.fatal_error "%s") - (module Client_config) - ~select_commands +let () = Client_main_run.run (module Client_config) ~select_commands diff --git a/src/proto_alpha/lib_client/mockup.ml b/src/proto_alpha/lib_client/mockup.ml index 617a4d0eed..b00de7f857 100644 --- a/src/proto_alpha/lib_client/mockup.ml +++ b/src/proto_alpha/lib_client/mockup.ml @@ -39,6 +39,7 @@ type protocol_constants_overrides = { hard_storage_limit_per_operation : Z.t option; cost_per_byte : Protocol.Tez_repr.t option; chain_id : Chain_id.t option; + timestamp : Time.Protocol.t option; } type parsed_account_repr = { @@ -112,25 +113,29 @@ let protocol_constants_overrides_encoding = p.hard_gas_limit_per_block, p.hard_storage_limit_per_operation, p.cost_per_byte, - p.chain_id )) + p.chain_id, + p.timestamp )) (fun ( hard_gas_limit_per_operation, hard_gas_limit_per_block, hard_storage_limit_per_operation, cost_per_byte, - chain_id ) -> + chain_id, + timestamp ) -> { hard_gas_limit_per_operation; hard_gas_limit_per_block; hard_storage_limit_per_operation; cost_per_byte; chain_id; + timestamp; }) - (obj5 + (obj6 (opt "hard_gas_limit_per_operation" z) (opt "hard_gas_limit_per_block" z) (opt "hard_storage_limit_per_operation" z) (opt "cost_per_byte" Protocol.Tez_repr.encoding) - (opt "chain_id" Chain_id.encoding)) + (opt "chain_id" Chain_id.encoding) + (opt "initial_timestamp" Time.Protocol.encoding)) let default_mockup_parameters : mockup_protocol_parameters = let parameters = @@ -154,6 +159,7 @@ let default_mockup_protocol_constants : protocol_constants_overrides = Some default.constants.hard_storage_limit_per_operation; cost_per_byte = Some default.constants.cost_per_byte; chain_id = Some Tezos_mockup_registration.Mockup_args.Chain_id.dummy; + timestamp = Some default_mockup_parameters.initial_timestamp; } (* Use the wallet to convert a bootstrap account's public key @@ -233,6 +239,7 @@ let protocol_constants_no_overrides = hard_storage_limit_per_operation = None; cost_per_byte = None; chain_id = None; + timestamp = None; } let apply_protocol_overrides (cctxt : Tezos_client_base.Client_context.full) @@ -363,27 +370,16 @@ let initial_context (header : Block_header.shell_header) let mem_init : cctxt:Tezos_client_base.Client_context.full -> parameters:mockup_protocol_parameters -> - chain_id:Chain_id.t option -> constants_overrides_json:Data_encoding.json option -> bootstrap_accounts_json:Data_encoding.json option -> (Chain_id.t * Tezos_protocol_environment.rpc_context) tzresult Lwt.t = - fun ~cctxt - ~parameters - ~chain_id - ~constants_overrides_json - ~bootstrap_accounts_json -> + fun ~cctxt ~parameters ~constants_overrides_json ~bootstrap_accounts_json -> let hash = Block_hash.of_b58check_exn "BLockGenesisGenesisGenesisGenesisGenesisCCCCCeZiLHU" in - let shell = - Forge.make_shell - ~level:0l - ~predecessor:hash - ~timestamp:parameters.initial_timestamp - ~fitness:(Protocol.Fitness_repr.from_int64 0L) - ~operations_hash:Operation_list_list_hash.zero - in + (* Need to read this Json file before since timestamp modification may be in + there *) ( match constants_overrides_json with | None -> return protocol_constants_no_overrides @@ -399,6 +395,20 @@ let mem_init : (Data_encoding.Json.print_error ?print_unknown:None) error ) ) >>=? fun protocol_overrides -> + let default = parameters.initial_timestamp in + let timestamp = Option.value ~default protocol_overrides.timestamp in + ( if not @@ Time.Protocol.equal default timestamp then + cctxt#message "@[initial_timestamp: %a@]" Time.Protocol.pp_hum timestamp + else Lwt.return_unit ) + >>= fun () -> + let shell = + Forge.make_shell + ~level:0l + ~predecessor:hash + ~timestamp + ~fitness:(Protocol.Fitness_repr.from_int64 0L) + ~operations_hash:Operation_list_list_hash.zero + in apply_protocol_overrides cctxt protocol_overrides parameters.constants >>=? fun protocol_custom -> ( match bootstrap_accounts_json with @@ -442,7 +452,6 @@ let mem_init : >>=? fun context -> let chain_id = Tezos_mockup_registration.Mockup_args.Chain_id.choose - ~from_command_line:chain_id ~from_config_file:protocol_overrides.chain_id in return diff --git a/src/proto_alpha/lib_client_commands/client_proto_mockup_commands.ml b/src/proto_alpha/lib_client_commands/client_proto_mockup_commands.ml index bf6d0e5e84..d126bc898b 100644 --- a/src/proto_alpha/lib_client_commands/client_proto_mockup_commands.ml +++ b/src/proto_alpha/lib_client_commands/client_proto_mockup_commands.ml @@ -49,29 +49,16 @@ let load_json_file (cctxt : Protocol_client_context.full) json_file = >>=? fun json_string -> return (Some (Ezjsonm.from_string json_string :> Data_encoding.json)) -let chain_id_seed_arg = - Clic.arg - ~doc:"chain id seed to generate a valid mockup chain id" - ~long:"chain-id-seed" - ~placeholder:"string" - (Clic.parameter (fun _ x -> return x)) - let create_mockup_command_handler - (chain_id_seed_arg, constants_overrides_file, bootstrap_accounts_file) + (constants_overrides_file, bootstrap_accounts_file) (cctxt : Protocol_client_context.full) = load_json_file cctxt constants_overrides_file >>=? fun constants_overrides_json -> load_json_file cctxt bootstrap_accounts_file >>=? fun bootstrap_accounts_json -> - let chain_id = - Option.map - Tezos_mockup_registration.Mockup_args.Chain_id.of_string - chain_id_seed_arg - in Tezos_mockup.Persistence.create_mockup ~cctxt:(cctxt :> Tezos_client_base.Client_context.full) ~protocol_hash:Protocol.hash - ~chain_id ~constants_overrides_json ~bootstrap_accounts_json >>=? fun () -> @@ -82,7 +69,7 @@ let create_mockup_command : Protocol_client_context.full Clic.command = command ~group:Tezos_mockup_commands.Mockup_commands.group ~desc:"Create a mockup environment." - (args3 chain_id_seed_arg protocol_constants_arg bootstrap_accounts_arg) + (args2 protocol_constants_arg bootstrap_accounts_arg) (prefixes ["create"; "mockup"] @@ stop) create_mockup_command_handler diff --git a/src/proto_alpha/lib_delegate/client_baking_scheduling.ml b/src/proto_alpha/lib_delegate/client_baking_scheduling.ml index a8b5363da5..d1589c3362 100644 --- a/src/proto_alpha/lib_delegate/client_baking_scheduling.ml +++ b/src/proto_alpha/lib_delegate/client_baking_scheduling.ml @@ -120,7 +120,7 @@ let main ~(name : string) ~(cctxt : #Protocol_client_context.full) (* event construction *) let timeout = compute_timeout state in Lwt.choose - [ (Lwt_exit.termination_thread >|= fun _ -> `Termination); + [ (Lwt_exit.clean_up_starts >|= fun _ -> `Termination); (timeout >|= fun timesup -> `Timeout timesup); (get_event () >|= fun e -> `Event e) ] >>= function diff --git a/src/proto_alpha/lib_delegate/client_daemon.ml b/src/proto_alpha/lib_delegate/client_daemon.ml index f2eb38b62e..88caa24322 100644 --- a/src/proto_alpha/lib_delegate/client_daemon.ml +++ b/src/proto_alpha/lib_delegate/client_daemon.ml @@ -37,7 +37,7 @@ let rec retry (cctxt : #Protocol_client_context.full) ?max_delay ~delay ~factor >>= fun () -> Lwt.pick [ (Lwt_unix.sleep delay >|= fun () -> `Continue); - (Lwt_exit.termination_thread >|= fun _ -> `Killed) ] + (Lwt_exit.clean_up_starts >|= fun _ -> `Killed) ] >>= function | `Killed -> Lwt.return err @@ -123,8 +123,7 @@ let monitor_fork_testchain (cctxt : #Protocol_client_context.full) (* Got a testchain for a different protocol, skipping *) in Lwt.pick - [ (Lwt_exit.termination_thread >>= fun _ -> failwith "Interrupted..."); - loop () ] + [(Lwt_exit.clean_up_starts >>= fun _ -> failwith "Interrupted..."); loop ()] >>=? fun () -> cctxt#message "Test chain forked." >>= fun () -> return_unit module Endorser = struct diff --git a/src/proto_alpha/lib_protocol/dune.inc b/src/proto_alpha/lib_protocol/dune.inc index 2d699843c5..847a6a9c8a 100644 --- a/src/proto_alpha/lib_protocol/dune.inc +++ b/src/proto_alpha/lib_protocol/dune.inc @@ -265,7 +265,7 @@ include Tezos_raw_protocol_alpha.Main (library_flags (:standard -linkall)) (flags (:standard -nopervasives -nostdlib -w +a-4-6-7-9-29-32-40..42-44-45-48 - -warn-error -a+8 + -warn-error +a -open Tezos_protocol_environment_alpha__Environment -open Pervasives -open Error_monad)) @@ -353,7 +353,7 @@ include Tezos_raw_protocol_alpha.Main tezos-protocol-environment-sigs tezos_raw_protocol_alpha) (flags -w "+a-4-6-7-9-29-40..42-44-45-48" - -warn-error "-a+8" + -warn-error "+a" -nopervasives) (modules Protocol)) @@ -365,7 +365,7 @@ include Tezos_raw_protocol_alpha.Main tezos-protocol-environment-sigs tezos_raw_protocol_alpha) (flags -w "+a-4-6-7-9-29-40..42-44-45-48" - -warn-error "-a+8" + -warn-error "+a" -nopervasives) (modules Functor)) @@ -377,7 +377,7 @@ include Tezos_raw_protocol_alpha.Main tezos-protocol-updater tezos-protocol-environment) (flags (:standard -w +a-4-6-7-9-29-32-40..42-44-45-48 - -warn-error -a+8)) + -warn-error +a)) (modules Registerer)) (alias diff --git a/src/proto_demo_counter/lib_protocol/dune.inc b/src/proto_demo_counter/lib_protocol/dune.inc index 03a2a087ab..6751033d6b 100644 --- a/src/proto_demo_counter/lib_protocol/dune.inc +++ b/src/proto_demo_counter/lib_protocol/dune.inc @@ -85,7 +85,7 @@ include Tezos_raw_protocol_demo_counter.Main (library_flags (:standard -linkall)) (flags (:standard -nopervasives -nostdlib -w +a-4-6-7-9-29-32-40..42-44-45-48 - -warn-error -a+8 + -warn-error +a -open Tezos_protocol_environment_demo_counter__Environment -open Pervasives -open Error_monad)) @@ -113,7 +113,7 @@ include Tezos_raw_protocol_demo_counter.Main tezos-protocol-environment-sigs tezos_raw_protocol_demo_counter) (flags -w "+a-4-6-7-9-29-40..42-44-45-48" - -warn-error "-a+8" + -warn-error "+a" -nopervasives) (modules Protocol)) @@ -125,7 +125,7 @@ include Tezos_raw_protocol_demo_counter.Main tezos-protocol-environment-sigs tezos_raw_protocol_demo_counter) (flags -w "+a-4-6-7-9-29-40..42-44-45-48" - -warn-error "-a+8" + -warn-error "+a" -nopervasives) (modules Functor)) @@ -137,7 +137,7 @@ include Tezos_raw_protocol_demo_counter.Main tezos-protocol-updater tezos-protocol-environment) (flags (:standard -w +a-4-6-7-9-29-32-40..42-44-45-48 - -warn-error -a+8)) + -warn-error +a)) (modules Registerer)) (alias diff --git a/src/proto_demo_counter/lib_protocol/header.ml b/src/proto_demo_counter/lib_protocol/header.ml index 5c08b95845..f68e63ecec 100644 --- a/src/proto_demo_counter/lib_protocol/header.ml +++ b/src/proto_demo_counter/lib_protocol/header.ml @@ -2,7 +2,7 @@ (* *) (* Open Source License *) (* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* Copyright (c) 2018 Nomadic Labs. *) +(* Copyright (c) 2018 Nomadic Labs. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) diff --git a/src/proto_demo_counter/lib_protocol/header.mli b/src/proto_demo_counter/lib_protocol/header.mli index 1ef60f3099..8c0b7903ea 100644 --- a/src/proto_demo_counter/lib_protocol/header.mli +++ b/src/proto_demo_counter/lib_protocol/header.mli @@ -2,7 +2,7 @@ (* *) (* Open Source License *) (* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* Copyright (c) 2018 Nomadic Labs. *) +(* Copyright (c) 2018 Nomadic Labs. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) diff --git a/src/proto_demo_counter/lib_protocol/receipt.ml b/src/proto_demo_counter/lib_protocol/receipt.ml index 3506c5b6df..a54ab290d7 100644 --- a/src/proto_demo_counter/lib_protocol/receipt.ml +++ b/src/proto_demo_counter/lib_protocol/receipt.ml @@ -2,7 +2,7 @@ (* *) (* Open Source License *) (* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* Copyright (c) 2018 Nomadic Labs. *) +(* Copyright (c) 2018 Nomadic Labs. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) diff --git a/src/proto_demo_counter/lib_protocol/receipt.mli b/src/proto_demo_counter/lib_protocol/receipt.mli index 925d9b2d42..b0ba90ecd6 100644 --- a/src/proto_demo_counter/lib_protocol/receipt.mli +++ b/src/proto_demo_counter/lib_protocol/receipt.mli @@ -2,7 +2,7 @@ (* *) (* Open Source License *) (* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* Copyright (c) 2018 Nomadic Labs. *) +(* Copyright (c) 2018 Nomadic Labs. *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) diff --git a/src/proto_demo_noops/lib_protocol/dune.inc b/src/proto_demo_noops/lib_protocol/dune.inc index 05fb01ab43..66acd9c927 100644 --- a/src/proto_demo_noops/lib_protocol/dune.inc +++ b/src/proto_demo_noops/lib_protocol/dune.inc @@ -61,7 +61,7 @@ include Tezos_raw_protocol_demo_noops.Main (library_flags (:standard -linkall)) (flags (:standard -nopervasives -nostdlib -w +a-4-6-7-9-29-32-40..42-44-45-48 - -warn-error -a+8 + -warn-error +a -open Tezos_protocol_environment_demo_noops__Environment -open Pervasives -open Error_monad)) @@ -81,7 +81,7 @@ include Tezos_raw_protocol_demo_noops.Main tezos-protocol-environment-sigs tezos_raw_protocol_demo_noops) (flags -w "+a-4-6-7-9-29-40..42-44-45-48" - -warn-error "-a+8" + -warn-error "+a" -nopervasives) (modules Protocol)) @@ -93,7 +93,7 @@ include Tezos_raw_protocol_demo_noops.Main tezos-protocol-environment-sigs tezos_raw_protocol_demo_noops) (flags -w "+a-4-6-7-9-29-40..42-44-45-48" - -warn-error "-a+8" + -warn-error "+a" -nopervasives) (modules Functor)) @@ -105,7 +105,7 @@ include Tezos_raw_protocol_demo_noops.Main tezos-protocol-updater tezos-protocol-environment) (flags (:standard -w +a-4-6-7-9-29-32-40..42-44-45-48 - -warn-error -a+8)) + -warn-error +a)) (modules Registerer)) (alias diff --git a/src/proto_genesis/lib_protocol/dune.inc b/src/proto_genesis/lib_protocol/dune.inc index b15bdee82b..d0b98f3482 100644 --- a/src/proto_genesis/lib_protocol/dune.inc +++ b/src/proto_genesis/lib_protocol/dune.inc @@ -67,7 +67,7 @@ include Tezos_raw_protocol_genesis.Main (library_flags (:standard -linkall)) (flags (:standard -nopervasives -nostdlib -w +a-4-6-7-9-29-32-40..42-44-45-48 - -warn-error -a+8 + -warn-error +a -open Tezos_protocol_environment_genesis__Environment -open Pervasives -open Error_monad)) @@ -89,7 +89,7 @@ include Tezos_raw_protocol_genesis.Main tezos-protocol-environment-sigs tezos_raw_protocol_genesis) (flags -w "+a-4-6-7-9-29-40..42-44-45-48" - -warn-error "-a+8" + -warn-error "+a" -nopervasives) (modules Protocol)) @@ -101,7 +101,7 @@ include Tezos_raw_protocol_genesis.Main tezos-protocol-environment-sigs tezos_raw_protocol_genesis) (flags -w "+a-4-6-7-9-29-40..42-44-45-48" - -warn-error "-a+8" + -warn-error "+a" -nopervasives) (modules Functor)) @@ -113,7 +113,7 @@ include Tezos_raw_protocol_genesis.Main tezos-protocol-updater tezos-protocol-environment) (flags (:standard -w +a-4-6-7-9-29-32-40..42-44-45-48 - -warn-error -a+8)) + -warn-error +a)) (modules Registerer)) (alias diff --git a/src/proto_genesis_carthagenet/lib_protocol/dune.inc b/src/proto_genesis_carthagenet/lib_protocol/dune.inc index 8de516a76e..fd5c6358f7 100644 --- a/src/proto_genesis_carthagenet/lib_protocol/dune.inc +++ b/src/proto_genesis_carthagenet/lib_protocol/dune.inc @@ -67,7 +67,7 @@ include Tezos_raw_protocol_genesis_carthagenet.Main (library_flags (:standard -linkall)) (flags (:standard -nopervasives -nostdlib -w +a-4-6-7-9-29-32-40..42-44-45-48 - -warn-error -a+8 + -warn-error +a -open Tezos_protocol_environment_genesis_carthagenet__Environment -open Pervasives -open Error_monad)) @@ -89,7 +89,7 @@ include Tezos_raw_protocol_genesis_carthagenet.Main tezos-protocol-environment-sigs tezos_raw_protocol_genesis_carthagenet) (flags -w "+a-4-6-7-9-29-40..42-44-45-48" - -warn-error "-a+8" + -warn-error "+a" -nopervasives) (modules Protocol)) @@ -101,7 +101,7 @@ include Tezos_raw_protocol_genesis_carthagenet.Main tezos-protocol-environment-sigs tezos_raw_protocol_genesis_carthagenet) (flags -w "+a-4-6-7-9-29-40..42-44-45-48" - -warn-error "-a+8" + -warn-error "+a" -nopervasives) (modules Functor)) @@ -113,7 +113,7 @@ include Tezos_raw_protocol_genesis_carthagenet.Main tezos-protocol-updater tezos-protocol-environment) (flags (:standard -w +a-4-6-7-9-29-32-40..42-44-45-48 - -warn-error -a+8)) + -warn-error +a)) (modules Registerer)) (alias diff --git a/tests_python/client/client.py b/tests_python/client/client.py index a43242b8ff..8937fe3344 100644 --- a/tests_python/client/client.py +++ b/tests_python/client/client.py @@ -92,9 +92,8 @@ def __init__(self, if endpoint is not None: connectivity_options += ['-endpoint', endpoint] - client = [client_path] + client = [client_path, '-base-dir', base_dir] if mode is None or mode == "client": - client.extend(['-base-dir', base_dir]) client.extend(connectivity_options) elif mode == "mockup": client.extend(['-mode', mode]) @@ -131,9 +130,8 @@ def run_generic(self, Fails with `CalledProcessError` if command fails """ client = self._admin_client if admin else self._client - base_dir_arg = ['-base-dir', self.base_dir] trace_opt = ['-l'] if trace else [] - cmd = client + base_dir_arg + trace_opt + params + cmd = client + trace_opt + params print(format_command(cmd)) @@ -370,14 +368,6 @@ def call(self, res = self.run(cmd) return client_output.TransferResult(res) - def set_base_dir(self, base_dir: str): - """ - Args: - base_dir(str): The new base directory to use (--base-dir arg) - """ - assert base_dir is not None - self.base_dir = base_dir - def set_delegate(self, account1: str, account2: str, @@ -800,16 +790,13 @@ def create_mockup(self, protocol: str, check: bool = True, protocol_constants_file: str = None, - bootstrap_accounts_file: str = None, - chain_id_seed: str = None)\ + bootstrap_accounts_file: str = None)\ -> client_output.CreateMockup: cmd = ['--protocol', protocol, 'create', 'mockup'] if protocol_constants_file is not None: cmd += ["--protocol-constants", protocol_constants_file] if bootstrap_accounts_file is not None: cmd += ["--bootstrap-accounts", bootstrap_accounts_file] - if chain_id_seed is not None: - cmd += ["--chain-id-seed", chain_id_seed] (stdout, stderr, exit_code) = self.run_generic(cmd, check=check) return client_output.CreateMockup(stdout, stderr, exit_code) diff --git a/tests_python/client/client_output.py b/tests_python/client/client_output.py index c13dd3b36b..a342e3650d 100644 --- a/tests_python/client/client_output.py +++ b/tests_python/client/client_output.py @@ -1,6 +1,7 @@ """Structured representation of client output.""" import json import re +from enum import auto, Enum, unique from typing import List, Dict # TODO This is incomplete. Add additional attributes and result classes as @@ -370,6 +371,23 @@ def __init__(self, client_output: str): self.mockup_protocols = re.findall(pattern, client_output) +@unique +class CreateMockupResult(Enum): + """ + Possible behaviors of `tezos-client create mockup` + """ + + ALREADY_INITIALIZED = auto() + DIR_NOT_EMPTY = auto() + OK = auto() + + def to_return_code(self) -> int: + """ The expected return code of the client when 'self' is returned """ + if self == CreateMockupResult.OK: + return 0 + return 1 + + class CreateMockup: """Result of 'create mockup' command.""" @@ -387,24 +405,22 @@ def __init__(self, client_stdout: str, client_stderr: str, exit_code): # - the output channel itself (stdout/stderr) # aka, where to look for the pattern # - the result to set in self.create_mockup_result - # - the expected exit code of the test outputs = [ - (r"^\S+ is not a directory\.$", client_stderr, "is_not_dir", 1), (r"^ \S+ is not empty, please specify a fresh base directory$", - client_stderr, "dir_not_empty", 1), + client_stderr, CreateMockupResult.DIR_NOT_EMPTY), (r"^ \S+ is already initialized as a mockup directory$", - client_stderr, "already_initialized", 1), - (r"^Created mockup client base dir in \S+$", client_stdout, "ok", - 0), + client_stderr, CreateMockupResult.ALREADY_INITIALIZED), + (r"^Created mockup client base dir in \S+$", client_stdout, + CreateMockupResult.OK), ] for outp in outputs: pattern = re.compile(outp[0], re.MULTILINE) out_channel = outp[1] - result_code = outp[2] - expected_exit_code = outp[3] + result = outp[2] + expected_exit_code = result.to_return_code() if re.search(pattern, out_channel) is not None: - self.create_mockup_result = result_code + self.create_mockup_result = result if exit_code != expected_exit_code: raise InvalidExitCode(exit_code) return diff --git a/tests_python/launchers/sandbox.py b/tests_python/launchers/sandbox.py index 6c22617a28..d7867159c4 100644 --- a/tests_python/launchers/sandbox.py +++ b/tests_python/launchers/sandbox.py @@ -85,7 +85,6 @@ def __init__(self, self.p2p = p2p self.num_peers = num_peers self.clients = {} # type: Dict[int, Client] - self.mockup_client = None self.nodes = {} # type: Dict[int, Node] # bakers for each protocol self.bakers = {} # type: Dict[str, Dict[int, Baker]] @@ -151,13 +150,35 @@ def _instanciate_client(self, use_tls: Tuple[str, str] = None, branch: str = "", client_factory: Callable = Client): - local_admin_client = self._wrap_path(CLIENT_ADMIN, branch) - local_client = self._wrap_path(CLIENT, branch) scheme = 'https' if use_tls else 'http' endpoint = f'{scheme}://localhost:{rpc_port}' - client = client_factory(local_client, local_admin_client, - endpoint=endpoint) - return client + return self.create_client(branch=branch, + client_factory=client_factory, + endpoint=endpoint) + + def create_client(self, + branch: str = "", + client_factory: Callable = Client, + **kwargs) -> Client: + """ + Creates a new client. Because this method doesn't require a Node, + it is appropriate for tests that do not need a node, such as + those of the mockup client. + + This client isn't registered in the Sandbox. It means the caller + has to perform the cleanup itself by calling the client cleanup method. + + Args: + branch (str): sub-dir where to lookup the node and client + binary, default = "". Allows execution of different + versions of nodes. + client_factory (Callable): the constructor of clients. Defaults to + Client. Allows e.g. regression testing. + **kwargs: arguments passed to client_factory + """ + local_admin_client = self._wrap_path(CLIENT_ADMIN, branch) + local_client = self._wrap_path(CLIENT, branch) + return client_factory(local_client, local_admin_client, **kwargs) def get_new_client(self, node: Node, @@ -294,23 +315,6 @@ def add_node(self, self.init_client(client, node, config_client) - def add_mockup_client(self, - branch: str = "", - client_factory: Callable = Client) -> None: - """ Set up new mockup client - - Args: - branch (str): sub-dir where to lookup the node and client - binary, default = "". Allows execution of different - versions of nodes. - client_factory (Callable): the constructor of clients. Defaults to - Client. Allows e.g. regression testing. - """ - local_admin_client = self._wrap_path(CLIENT_ADMIN, branch) - local_client = self._wrap_path(CLIENT, branch) - self.mockup_client = client_factory(local_client, local_admin_client, - mode="mockup") - def add_baker(self, node_id: int, account: str, diff --git a/tests_python/tests/conftest.py b/tests_python/tests/conftest.py index a90b772ead..d9f14b83ef 100644 --- a/tests_python/tests/conftest.py +++ b/tests_python/tests/conftest.py @@ -6,6 +6,7 @@ parameter. """ import os +import tempfile from typing import Optional, Iterator, List import pytest from pytest_regtest import register_converter_pre, deregister_converter_pre, \ @@ -14,6 +15,7 @@ from tools import constants, paths, utils from tools.client_regression import ClientRegression from client.client import Client +from client.client_output import CreateMockupResult @pytest.fixture(scope="session", autouse=True) @@ -237,3 +239,26 @@ def simple_client(): client = Client(client_path, client_admin_path) yield client client.cleanup() + + +@pytest.fixture(params=constants.MOCKUP_PROTOCOLS) +def mockup_client(request, sandbox: Sandbox) -> Iterator[Client]: + """ + Returns a mockup client with its persistent directory created + + This is done in two steps, because we want to create the mockup + with a client that doesn't have "--mode mockup" (as per + the public documentation) but we want to return a + client that has "--mode mockup" and uses the base-dir created + in the first step. + + There is no way around this pattern. If you want to create + a mockup using custom arguments; you MUST do the same + as this method. + """ + with tempfile.TemporaryDirectory(prefix='tezos-client.') as base_dir: + unmanaged_client = sandbox.create_client(base_dir=base_dir) + res = unmanaged_client.create_mockup( + protocol=request.param).create_mockup_result + assert res == CreateMockupResult.OK + yield sandbox.create_client(base_dir=base_dir, mode="mockup") diff --git a/tests_python/tests/test_mockup.py b/tests_python/tests/test_mockup.py index 681165e1db..4f7c3d17d9 100644 --- a/tests_python/tests/test_mockup.py +++ b/tests_python/tests/test_mockup.py @@ -1,83 +1,46 @@ """ This file tests the mockup mode (tezos-client --mode mockup). In this mode the client does not need a node running. - In the tests fiddling with --base-dir, make sure to - call client.py's set_base_dir method prior to doing - queries. + Make sure to either use the fixture mockup_client or + to mimick it if you want a mockup with custom parameters. + + Care is taken not to leave any base_dir dangling after + tests are finished. Please continue doing this. """ import json import os import re +import shutil import tempfile -from typing import Any, Iterator, Optional, Tuple, List +from pathlib import Path +from typing import Any, Optional, Tuple import pytest from launchers.sandbox import Sandbox from client.client import Client +from client.client_output import CreateMockupResult -from tools.constants import ALPHA +from tools.constants import MOCKUP_PROTOCOLS -_PROTO = ALPHA _BA_FLAG = "bootstrap-accounts" _PC_FLAG = "protocol-constants" -@pytest.fixture -def mockup_client(sandbox: Sandbox) -> Client: - """ - If you don't know what you're doing, you likely want - the next fixture, not this one. - """ - sandbox.add_mockup_client() - client = sandbox.mockup_client - assert client is not None - return client - - -@pytest.fixture -def base_dir_n_mockup(mockup_client: Client) -> Iterator[Tuple[str, Client]]: - """ - This is THE fixture to use when 1/ you're unsure or 2/ you're doing - a positive test (i.e. a test which must succeed, in an - environment where things are expected to work). - - In this scenario, you likely want to call this fixture - and retrieve solely it's second value like this: - - `_, mockup_client = base_dir_n_mockup` - """ - with tempfile.TemporaryDirectory(prefix='tezos-client.') as base_dir: - mockup_client.set_base_dir(base_dir) - res = mockup_client.create_mockup(protocol=_PROTO).create_mockup_result - assert res == 'ok' - yield (base_dir, mockup_client) # yield instead of return: so that - # 'with' block is exited during teardown, see - # https://docs.pytest.org/en/latest/fixture.html#fixture-finalization-executing-teardown-code - - @pytest.mark.client -def test_list_mockup_protocols(mockup_client: Client): +def test_list_mockup_protocols(sandbox: Sandbox): """ Executes `tezos-client list mockup protocols` The call must succeed and return a non empty list. """ - protocols = mockup_client.list_mockup_protocols().mockup_protocols - assert protocols[0] == _PROTO - - -@pytest.mark.client -def test_create_mockup_file_exists(mockup_client: Client): - """ Executes `tezos-client --base-dir /tmp/mdir create mockup` - when /tmp/mdir is a file, whereas a directory is expected. - The call must fail. - """ - with tempfile.NamedTemporaryFile(prefix='tezos-client.') as tmp_file: - mockup_client.set_base_dir(tmp_file.name) - res = mockup_client.create_mockup(protocol=_PROTO, - check=False) - assert res.exit_code == 1 and res.create_mockup_result == 'is_not_dir' + try: + client = sandbox.create_client() + protocols = client.list_mockup_protocols().mockup_protocols + assert protocols + finally: + shutil.rmtree(client.base_dir) @pytest.mark.client -def test_create_mockup_dir_exists_nonempty(mockup_client: Client): +@pytest.mark.parametrize('proto', MOCKUP_PROTOCOLS) +def test_create_mockup_dir_exists_nonempty(sandbox: Sandbox, proto: str): """ Executes `tezos-client --base-dir /tmp/mdir create mockup` when /tmp/mdir is a non empty directory which is NOT a mockup directory. The call must fail. @@ -86,20 +49,17 @@ def test_create_mockup_dir_exists_nonempty(mockup_client: Client): # Make the directory not empty with open(os.path.join(base_dir, "whatever"), "w") as handle: handle.write("") - mockup_client.set_base_dir(base_dir) - res = mockup_client.create_mockup(protocol=_PROTO, - check=False).create_mockup_result - assert res == 'dir_not_empty' + unmanaged_client = sandbox.create_client(base_dir=base_dir) + res = unmanaged_client.create_mockup(protocol=proto, + check=False).create_mockup_result + assert res == CreateMockupResult.DIR_NOT_EMPTY @pytest.mark.client -def test_create_mockup_fresh_dir(mockup_client: Client): - """ Executes `tezos-client --base-dir /tmp/mdir create mockup` - when /tmp/mdir is fresh and retrieves known addresses. - Calls must succeed. +def test_retrieve_addresses(mockup_client: Client): + """ Retrieves known addresses of a fresh mockup. + The call must succeed. """ - res = mockup_client.create_mockup(protocol=_PROTO).create_mockup_result - assert res == 'ok' addresses = mockup_client.get_known_addresses().wallet assert addresses == { 'bootstrap1': 'tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx', @@ -110,27 +70,34 @@ def test_create_mockup_fresh_dir(mockup_client: Client): } +def _get_mockup_proto(mockup_client): + """ The current protocol of a mockup client """ + json_data = mockup_client.rpc(verb="get", + path="/chains/main/blocks/head/protocols") + return json_data["protocol"] + + @pytest.mark.client def test_create_mockup_already_initialized(mockup_client: Client): """ Executes `tezos-client --base-dir /tmp/mdir create mockup` when /tmp/mdir is not fresh. The call must fail. """ - res = mockup_client.create_mockup(protocol=_PROTO).create_mockup_result - assert res == 'ok' - res = mockup_client.create_mockup(protocol=_PROTO, + proto = _get_mockup_proto(mockup_client) + # mockup was created already by fixture, try to create it second time: + res = mockup_client.create_mockup(protocol=proto, check=False).create_mockup_result - assert res == 'already_initialized' + # it should fail: + assert res == CreateMockupResult.ALREADY_INITIALIZED @pytest.mark.client -def test_transfer(base_dir_n_mockup: Tuple[str, Client]): +def test_transfer(mockup_client: Client): """ Executes `tezos-client --base-dir /tmp/mdir -M mockup transfer 1 from bootstrap1 to bootstrap2` in a valid mockup environment. The call must succeed and the balances must be updated correctly. """ - _, mockup_client = base_dir_n_mockup giver = "bootstrap1" receiver = "bootstrap2" transferred = 1.0 @@ -145,34 +112,43 @@ def test_transfer(base_dir_n_mockup: Tuple[str, Client]): assert receiver_balance_after == receiver_balance_before + transferred +@pytest.mark.parametrize('proto', MOCKUP_PROTOCOLS) # It's impossible to guess values of chain_id, these ones have been -# obtained by looking at the output of the test test_chain_id_seed. +# obtained by looking at the output of `compute chain id from seed` @pytest.mark.parametrize('chain_id', [ "NetXcqTGZX74DxG", "NetXaFDF7xZQCpR", "NetXkKbtqncJcAz", "NetXjjE5cZUeWPy", "NetXi7C1pyLhQNe" ]) +@pytest.mark.parametrize('initial_timestamp', [ + "2020-07-21T17:11:10+02:00", "1970-01-01T00:00:00Z" +]) @pytest.mark.client -def test_create_mockup_custom_constants(mockup_client: Client, chain_id: str): +def test_create_mockup_custom_constants(sandbox: Sandbox, + proto: str, + chain_id: str, + initial_timestamp: str): """ Tests `tezos-client create mockup` --protocols-constants argument The call must succeed. Args: mockup_client: the client to use chain_id (str): the string to pass for field `chain_id` + initial_timestamp(str): an ISO-8601 formatted date string """ # Use another directory so that the constants change takes effect with tempfile.TemporaryDirectory(prefix='tezos-client.') as base_dir,\ tempfile.NamedTemporaryFile(prefix='tezos-custom-constants', mode='w+t') as json_file: json_data = {"hard_gas_limit_per_operation": "400000", - "chain_id": chain_id} + "chain_id": chain_id, + "initial_timestamp": initial_timestamp} json.dump(json_data, json_file) json_file.flush() - mockup_client.set_base_dir(base_dir) - res = mockup_client.create_mockup( - protocol=_PROTO, + unmanaged_client = sandbox.create_client(base_dir=base_dir) + res = unmanaged_client.create_mockup( + protocol=proto, protocol_constants_file=json_file.name).create_mockup_result - assert res == "ok" + assert res == CreateMockupResult.OK def _create_accounts_list(): @@ -204,7 +180,8 @@ def add_account(name: str, sk_uri: str, amount: str): @pytest.mark.client -def test_create_mockup_custom_bootstrap_accounts(mockup_client): +@pytest.mark.parametrize('proto', MOCKUP_PROTOCOLS) +def test_create_mockup_custom_bootstrap_accounts(sandbox: Sandbox, proto: str): """ Tests `tezos-client create mockup` --bootstrap-accounts argument The call must succeed. """ @@ -216,120 +193,86 @@ def test_create_mockup_custom_bootstrap_accounts(mockup_client): mode='w+t') as json_file: json.dump(accounts_list, json_file) json_file.flush() - mockup_client.set_base_dir(base_dir) - res = mockup_client.create_mockup( - protocol=_PROTO, + # Follow pattern of mockup_client fixture: + unmanaged_client = sandbox.create_client(base_dir=base_dir) + res = unmanaged_client.create_mockup( + protocol=proto, bootstrap_accounts_file=json_file.name).create_mockup_result - assert res == "ok" - addresses_result = mockup_client.get_known_addresses() + assert res == CreateMockupResult.OK + mock_client = sandbox.create_client(base_dir=base_dir, mode="mockup") + addresses_result = mock_client.get_known_addresses() names_sent = sorted([account["name"] for account in accounts_list]) names_witnessed = sorted(list(addresses_result.wallet.keys())) assert names_sent == names_witnessed @pytest.mark.client -def test_transfer_bad_base_dir(mockup_client: Client): +@pytest.mark.parametrize('proto', MOCKUP_PROTOCOLS) +def test_transfer_bad_base_dir(sandbox: Sandbox, proto: str): """ Executes `tezos-client --base-dir /tmp/mdir create mockup` when /tmp/mdir looks like a dubious base directory. Checks that a warning is printed. """ - with tempfile.TemporaryDirectory(prefix='tezos-client.') as base_dir: - # Create a FILE named "mockup", whereas a directory is expected; - # so that the base_dir is invalid - with open(os.path.join(base_dir, "mockup"), "w") as handle: - handle.write("") - mockup_client.set_base_dir(base_dir) + try: + unmanaged_client = sandbox.create_client() + res = unmanaged_client.create_mockup( + protocol=proto).create_mockup_result + assert res == CreateMockupResult.OK + base_dir = unmanaged_client.base_dir + mockup_dir = os.path.join(base_dir, "mockup") + + # A valid mockup has a directory named "mockup", in its directory: + assert os.path.isdir(mockup_dir) + mock_client = sandbox.create_client(base_dir=base_dir, mode="mockup") + # Delete this directory: + shutil.rmtree(mockup_dir) + # And put a file instead: + Path(os.path.join(mockup_dir)).touch() + + # Now execute a command cmd = ["transfer", "1", "from", "bootstrap1", "to", "bootstrap2"] - (_, err_output, _) = mockup_client.run_generic(cmd, check=False) + (_, err_output, _) = mock_client.run_generic(cmd, check=False) # See # https://gitlab.com/tezos/tezos/-/merge_requests/1760#note_329071488 # for the content being matched searched = "Some commands .* might not work correctly." + # Witness that warning is printed: assert re.search( searched, err_output), f"'{searched}' not matched in error output" - - -def _create_mockup_chain_id_seed(mockup_client, - seed: Optional[str] = None) -> str: - """ Creates a mockup specifying `chain-id-seed` - and returns the computed chain id. - - Args: - mockup_client: the client to use - seed (str): the string to pass to chain_id_seed - Returns: - The chain id computed - """ - with tempfile.TemporaryDirectory(prefix='tezos-client.') as base_dir: - mockup_client.set_base_dir(base_dir) - res = mockup_client.create_mockup(protocol=_PROTO, chain_id_seed=seed) - assert res.create_mockup_result == "ok" - assert res.chain_id is not None, "Absent chain id value from command" - return res.chain_id - - -@pytest.mark.parametrize('chain_id_seed,chain_id_value', [ - ("", "NetXjDm9eYUvhif"), - ("0", "NetXjjE5cZUeWPy"), - ("main", "NetXaFDF7xZQCpR"), - ("test", "NetXkKbtqncJcAz"), - ("whatever", "NetXi7C1pyLhQNe"), - ("longerlongerlongerseed", "NetXdhGxXRpN8i8"), - ("⚠unicode♥one", "NetXNrs2NkmLRfW")]) -@pytest.mark.client -def test_chain_id_seed(mockup_client, chain_id_seed, chain_id_value): - """ Executes `tezos-client create mockup --chain-id-seed chain_id_seed """ - chain_id = _create_mockup_chain_id_seed(mockup_client, chain_id_seed) - assert chain_id == chain_id_value, \ - f"""Unexpected chain id for seed: {chain_id_seed} -expected {chain_id_value} instead of {chain_id}""" - - -@pytest.mark.client -def test_chain_id_seed_matters(mockup_client): - """ Executes `tezos-client create mockup --chain-id-seed - with different seeds and checks that the obtained chain id - indeed differ. - """ - seeds = ["1234", "main", "test", "0", "whatever"] - chain_ids: List[str] = [] - for seed in seeds: - chain_id = _create_mockup_chain_id_seed(mockup_client, seed) - in_there = chain_ids.index(chain_id) if chain_id in chain_ids else None - if in_there: - yielder = seeds[in_there] - assert False, f"Seeds '{yielder}' and '{seed}''"\ - f" produce the same chain_id: {chain_id}" - chain_ids.append(chain_id) + finally: + shutil.rmtree(base_dir) @pytest.mark.client -def test_config_show_mockup(base_dir_n_mockup): +def test_config_show_mockup(mockup_client: Client): """ Executes `tezos-client config show mockup` in a state where it should succeed. """ - _, mockup_client = base_dir_n_mockup - mockup_client.run_generic(["config", "show", "mockup"]) + proto = _get_mockup_proto(mockup_client) + mockup_client.run_generic(["--protocol", proto, + "config", "show", "mockup"]) @pytest.mark.client -def test_config_show_mockup_fail(mockup_client): +def test_config_show_mockup_fail(mockup_client: Client): """ Executes `tezos-client config show mockup` when base dir is NOT a mockup. It should fail as this is dangerous (the default base directory could contain sensitive data, such as private keys) """ + shutil.rmtree(mockup_client.base_dir) # See test_config_init_mockup_fail + # for a variant of how to make the base dir invalid for the mockup mode _, _, return_code = mockup_client.run_generic(["config", "show", "mockup"], check=False) assert return_code != 0 @pytest.mark.client -def test_config_init_mockup(base_dir_n_mockup): +def test_config_init_mockup(mockup_client: Client): """ Executes `tezos-client config init mockup` in a state where it should succeed. """ - _, mockup_client = base_dir_n_mockup + proto = _get_mockup_proto(mockup_client) # We cannot use NamedTemporaryFile because `config init mockup` # does not overwrite files. Because NamedTemporaryFile creates the file # it would make the test fail. @@ -337,6 +280,7 @@ def test_config_init_mockup(base_dir_n_mockup): pc_json_file = tempfile.mktemp(prefix='tezos-proto-consts') # 1/ call `config init mockup` mockup_client.run([ + "--protocol", proto, "config", "init", "mockup", f"--{_BA_FLAG}", ba_json_file, f"--{_PC_FLAG}", pc_json_file ]) @@ -347,28 +291,41 @@ def test_config_init_mockup(base_dir_n_mockup): with open(pc_json_file) as handle: json.load(handle) - # Cleanup of tempfile.mktemp + # Cleanup os.remove(ba_json_file) os.remove(pc_json_file) @pytest.mark.client -def test_config_init_mockup_fail(mockup_client): +def test_config_init_mockup_fail(mockup_client: Client): """ Executes `tezos-client config init mockup` when base dir is NOT a mockup. It should fail as this is dangerous (the default base directory could contain sensitive data, such as private keys) """ - with tempfile.NamedTemporaryFile( - prefix='tezos-bootstrap-accounts', - mode='w+t') as ba_json_file, tempfile.NamedTemporaryFile( - prefix='tezos-proto-consts', mode='w+t') as pc_json_file: - cmd = [ - "config", "init", "mockup", f"--{_BA_FLAG}", ba_json_file.name, - f"--{_PC_FLAG}", pc_json_file.name - ] - _, _, return_code = mockup_client.run_generic(cmd, check=False) - assert return_code != 0 + proto = _get_mockup_proto(mockup_client) + ba_json_file = tempfile.mktemp(prefix='tezos-bootstrap-accounts') + pc_json_file = tempfile.mktemp(prefix='tezos-proto-consts') + cmd = [ + "--protocol", proto, + "config", "init", "mockup", f"--{_BA_FLAG}", ba_json_file, + f"--{_PC_FLAG}", pc_json_file + ] + + # A valid mockup has a directory named "mockup" in its base_dir: + mockup_dir = os.path.join(mockup_client.base_dir, "mockup") + assert os.path.isdir(mockup_dir) + # Delete this directory, so that the base_dir is not a valid mockup + # base dir anymore: + shutil.rmtree(mockup_dir) # See test_config_show_mockup_fail above + # for a variant of how to make the base_dir invalid for the mockup mode + + _, _, return_code = mockup_client.run_generic(cmd, + check=False) + assert return_code != 0 + # Check the test doesn't leak directories: + assert not os.path.exists(ba_json_file) + assert not os.path.exists(pc_json_file) def _try_json_loads(flag: str, string: str) -> Any: @@ -380,16 +337,23 @@ def _try_json_loads(flag: str, string: str) -> Any: {string}""") -def _get_state_using_config_init_mockup(mockup_client) -> Tuple[str, str]: +def _get_state_using_config_init_mockup(mock_client: Client)\ + -> Tuple[str, str]: """ - Calls `config init mockup` on `m_client` and returns + Calls `config init mockup` on a mockup client and returns the strings of the bootstrap accounts and the protocol constants + + Note that because this a mockup specific operation, the `mock_client` + parameter must be in mockup mode; do not give a vanilla client. """ + proto = _get_mockup_proto(mock_client) + ba_json_file = tempfile.mktemp(prefix='tezos-bootstrap-accounts') pc_json_file = tempfile.mktemp(prefix='tezos-proto-consts') - mockup_client.run([ + mock_client.run([ + "--protocol", proto, "config", "init", "mockup", f"--{_BA_FLAG}", ba_json_file, f"--{_PC_FLAG}", pc_json_file ]) @@ -406,11 +370,15 @@ def _get_state_using_config_init_mockup(mockup_client) -> Tuple[str, str]: return (ba_str, pc_str) -def _get_state_using_config_show_mockup(mockup_client) -> Tuple[str, str]: +def _get_state_using_config_show_mockup(mock_client: Client)\ + -> Tuple[str, str]: """ - Calls `config show mockup` on `mockup_client` and returns + Calls `config show mockup` on a mockup client and returns the strings of the bootstrap accounts and the protocol constants, by parsing standard output. + + Note that because this a mockup specific operation, the `mock_client` + parameter must be in mockup mode; do not give a vanilla client. """ def _find_line_starting_with(strings, searched) -> int: i = 0 @@ -439,12 +407,15 @@ def _parse_config_init_output(string: str) -> Tuple[str, str]: pc_json = string[proto_constants_index + len(tagline2) + 1:] return (bc_json, pc_json) - stdout = mockup_client.run(["config", "show", "mockup"]) + proto = _get_mockup_proto(mock_client) + stdout = mock_client.run(["--protocol", proto, + "config", "show", "mockup"]) return _parse_config_init_output(stdout) def _test_create_mockup_init_show_roundtrip( - mockup_client, + sandbox: Sandbox, + proto: str, read_initial_state, read_final_state, bootstrap_json: Optional[str] = None, @@ -479,18 +450,23 @@ def _test_create_mockup_init_show_roundtrip( with open(ba_file, 'w') as handle: handle.write(bootstrap_json) - res = mockup_client.create_mockup( - protocol=_PROTO, - bootstrap_accounts_file=ba_file, - protocol_constants_file=pc_file).create_mockup_result + with tempfile.TemporaryDirectory(prefix='tezos-client.') as base_dir: + # Follow pattern of mockup_client fixture: + unmanaged_client = sandbox.create_client(base_dir=base_dir) + res = unmanaged_client.create_mockup( + protocol=proto, + bootstrap_accounts_file=ba_file, + protocol_constants_file=pc_file).create_mockup_result + assert res == CreateMockupResult.OK + mock_client = sandbox.create_client(base_dir=base_dir, + mode="mockup") + (ba_str, pc_str) = read_initial_state(mock_client) finally: if pc_file is not None: os.remove(pc_file) if ba_file is not None: os.remove(ba_file) - assert res == 'ok' - (ba_str, pc_str) = read_initial_state(mockup_client) # 2/ Check the json obtained is valid by building json objects ba_sent = _try_json_loads(_BA_FLAG, ba_str) pc_sent = _try_json_loads(_PC_FLAG, pc_str) @@ -503,22 +479,27 @@ def _test_create_mockup_init_show_roundtrip( prefix='tezos-client.') as base_dir, tempfile.NamedTemporaryFile( prefix='tezos-bootstrap-accounts', mode='w+t') as ba_json_file, tempfile.NamedTemporaryFile( - prefix='tezos-proto-consts', mode='w+t') as pc_json_file: + prefix='tezos-proto-consts', mode='w+t') as pc_json_file,\ + tempfile.TemporaryDirectory(prefix='tezos-client.') as base_dir: ba_json_file.write(ba_str) ba_json_file.flush() pc_json_file.write(pc_str) pc_json_file.flush() - mockup_client.set_base_dir(base_dir) - res = mockup_client.create_mockup( - protocol=_PROTO, - protocol_constants_file=pc_json_file.name, - bootstrap_accounts_file=ba_json_file.name).create_mockup_result - assert res == "ok" - - # 4/ Retrieve state again - (ba_received_str, pc_received_str) = read_final_state(mockup_client) + with tempfile.TemporaryDirectory(prefix='tezos-client.') as base_dir: + # Follow pattern of mockup_client fixture: + unmanaged_client = sandbox.create_client(base_dir=base_dir) + res = unmanaged_client.create_mockup( + protocol=proto, + protocol_constants_file=pc_json_file.name, + bootstrap_accounts_file=ba_json_file.name).create_mockup_result + assert res == CreateMockupResult.OK + mock_client = sandbox.create_client(base_dir=base_dir, + mode="mockup") + # 4/ Retrieve state again + (ba_received_str, pc_received_str) =\ + read_final_state(mock_client) # Convert it to json objects (check that json is valid) ba_received = _try_json_loads(_BA_FLAG, ba_received_str) @@ -539,16 +520,25 @@ def _gen_assert_msg(flag, sent, received): @pytest.mark.client +@pytest.mark.parametrize('proto', MOCKUP_PROTOCOLS) @pytest.mark.parametrize('initial_bootstrap_accounts', [None, json.dumps(_create_accounts_list())]) +@pytest.mark.parametrize( + 'protocol_constants', + [None, + json.dumps( + {'chain_id': "NetXaFDF7xZQCpR", + 'initial_timestamp': "2020-07-21T17:11:10+02:00"})]) @pytest.mark.parametrize( 'read_initial_state', [_get_state_using_config_show_mockup, _get_state_using_config_init_mockup]) @pytest.mark.parametrize( 'read_final_state', [_get_state_using_config_show_mockup, _get_state_using_config_init_mockup]) -def test_create_mockup_config_show_init_roundtrip(mockup_client, +def test_create_mockup_config_show_init_roundtrip(sandbox: Sandbox, + proto: str, initial_bootstrap_accounts, + protocol_constants, read_initial_state, read_final_state): """ 1/ Create a mockup, using possibly custom bootstrap_accounts @@ -562,15 +552,17 @@ def test_create_mockup_config_show_init_roundtrip(mockup_client, This is a roundtrip test using a matrix. """ - _test_create_mockup_init_show_roundtrip(mockup_client, read_initial_state, + _test_create_mockup_init_show_roundtrip(sandbox, + proto, + read_initial_state, read_final_state, - initial_bootstrap_accounts) + initial_bootstrap_accounts, + protocol_constants) -def test_transfer_rpc(base_dir_n_mockup): +def test_transfer_rpc(mockup_client: Client): """ Variant of test_transfer that uses RPCs to get the balances. """ - _, mockup_client = base_dir_n_mockup giver = "bootstrap1" receiver = "bootstrap2" transferred = 1.0 diff --git a/tests_python/tools/constants.py b/tests_python/tools/constants.py index d582df0626..35e74cc733 100644 --- a/tests_python/tools/constants.py +++ b/tests_python/tools/constants.py @@ -68,6 +68,9 @@ CARTHAGE = "PsCARTHAGazKbHtnKfLzQg3kms52kSRpgnDY982a9oYsSXRLQEb" CARTHAGE_DAEMON = "006-PsCARTHA" +# Protocols supported by the mockup mode +MOCKUP_PROTOCOLS = [ALPHA, CARTHAGE] + TEZOS_CRT = """ Certificate: Data: diff --git a/tezt/lib_tezos/client.ml b/tezt/lib_tezos/client.ml index 55baf9908f..6fcc2fd8a8 100644 --- a/tezt/lib_tezos/client.ml +++ b/tezt/lib_tezos/client.ml @@ -140,7 +140,7 @@ module Admin = struct spawn_command client ?node - ["connect"; "address"; "[::1]:" ^ string_of_int (Node.net_port peer)] + ["connect"; "address"; "127.0.0.1:" ^ string_of_int (Node.net_port peer)] let connect_address ?node ~peer client = spawn_connect_address ?node ~peer client |> Process.check diff --git a/tezt/lib_tezos/node.ml b/tezt/lib_tezos/node.ml index 15fe9984e8..5357b20e13 100644 --- a/tezt/lib_tezos/node.ml +++ b/tezt/lib_tezos/node.ml @@ -184,7 +184,7 @@ let spawn_config_init ?(network = "sandbox") ?net_port ?rpc_port ?history_mode node ( "config" :: "init" :: "--data-dir" :: node.data_dir :: "--network" :: network :: "--net-addr" - :: ("[::1]:" ^ string_of_int node.net_port) + :: ("127.0.0.1:" ^ string_of_int node.net_port) :: "--rpc-addr" :: ("localhost:" ^ string_of_int node.rpc_port) ::