From 90ef97b38bd58c243f83f3b85ee42ab2d5b777fb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Gr=C3=A9goire=20Henry?= Date: Sat, 21 Jul 2018 00:00:05 +0200 Subject: [PATCH] Compiler: by default, enforce the hash declared in `TEZOS_PROTOCOL` --- scripts/archive_protocol.sh | 23 +------- src/lib_protocol_compiler/compiler.ml | 55 +++++++++++++------ .../main_embedded_packer.ml | 5 +- src/lib_protocol_compiler/main_packer.ml | 5 +- src/lib_protocol_updater/updater.ml | 2 +- src/lib_stdlib_unix/lwt_utils_unix.ml | 7 +-- src/lib_stdlib_unix/lwt_utils_unix.mli | 2 +- 7 files changed, 53 insertions(+), 46 deletions(-) diff --git a/scripts/archive_protocol.sh b/scripts/archive_protocol.sh index b43bbf850..725a9843c 100755 --- a/scripts/archive_protocol.sh +++ b/scripts/archive_protocol.sh @@ -21,27 +21,15 @@ if [ -z "$version" ] ; then exit 1 fi -alpha_tmpdir=`mktemp -d` - -cleanup () { - set +e - echo Cleaning up... - [ ! -d "$alpha_tmpdir" ] || rm -rf "$alpha_tmpdir" -} -trap cleanup EXIT INT - -mkdir "$alpha_tmpdir"/src - current_hash_alpha=`jq '.hash' < src/proto_$dir_name/lib_protocol/src/TEZOS_PROTOCOL | tr -d '"'` echo "Computing the protocol hash..." -cp src/proto_${dir_name}/lib_protocol/src/*.ml src/proto_${dir_name}/lib_protocol/src/*.mli "$alpha_tmpdir"/src/ sed -i --follow-symlink \ -e 's/let version_value = "[^"]*"/let version_value = "'${name}'_'${version}'"/' \ - "$alpha_tmpdir"/src/raw_context.ml -grep -v '"hash"' < src/proto_${dir_name}/lib_protocol/src/TEZOS_PROTOCOL > "$alpha_tmpdir"/src/TEZOS_PROTOCOL -long_hash=`./tezos-protocol-compiler -hash-only $alpha_tmpdir/tmp $alpha_tmpdir/src` + src/proto_${dir_name}/lib_protocol/src/raw_context.ml + +long_hash=`./tezos-protocol-compiler -hash-only src/proto_${dir_name}/lib_protocol/src` short_hash=$(echo $long_hash | head -c 8) if [ -d "src/proto_${version}_${short_hash}" ] ; then @@ -74,11 +62,6 @@ sed -i --follow-symlink \ ../$proto_genesis_dir/lib_client/proto_alpha.ml \ ../lib_shell/bench/helpers/proto_alpha.ml -sed -i --follow-symlink \ - -e 's/let name = "[^"]*"/let name = "'${name}'_'${version}'"/' \ - lib_client/proto_alpha.ml \ - lib_protocol/test/helpers/proto_alpha.ml - sed -i --follow-symlink \ -e 's/let version_value = "[^"]*"/let version_value = "'${name}'_'${version}'"/' \ lib_protocol/src/raw_context.ml diff --git a/src/lib_protocol_compiler/compiler.ml b/src/lib_protocol_compiler/compiler.ml index c98c7a90a..63b2a2b35 100644 --- a/src/lib_protocol_compiler/compiler.ml +++ b/src/lib_protocol_compiler/compiler.ml @@ -150,10 +150,14 @@ let main { compile_ml ; pack_objects ; link_shared } = and static = ref false and register = ref false and build_dir = ref None + and output_file = ref None and output_dep = ref false - and hash_only = ref false in + and hash_only = ref false + and check_protocol_hash = ref true in let args_spec = [ - "-hash-only", Arg.Set hash_only, " Don't compile" ; + "-o", Arg.String (fun s -> output_file := Some s), "" ; + "-hash-only", Arg.Set hash_only, " Only display the hash of the protocol and don't compile" ; + "-no-hash-check", Arg.Clear check_protocol_hash, " Don't check that TEZOS_PROTOCOL declares the expected protocol hash (if existent)" ; "-static", Arg.Set static, " Only build the static library (no .cmxs)" ; "-register", Arg.Set register, " Generete the `Registerer` module" ; "-bin-annot", Arg.Set Clflags.binary_annotations, " (see ocamlopt)" ; @@ -164,13 +168,38 @@ let main { compile_ml ; pack_objects ; link_shared } = ] in let usage_msg = Printf.sprintf - "Usage: %s [options] \nOptions are:" + "Usage: %s [options] \nOptions are:" Sys.argv.(0) in Arg.parse args_spec (fun s -> anonymous := s :: !anonymous) usage_msg ; - let (output, source_dir) = + let source_dir = match List.rev !anonymous with - | [ output ; protocol_dir ] -> output, protocol_dir + | [ protocol_dir ] -> protocol_dir | _ -> Arg.usage args_spec usage_msg ; Pervasives.exit 1 in + let announced_hash, protocol = + match Lwt_main.run (Lwt_utils_unix.Protocol.read_dir source_dir) with + | Ok (hash, proto) -> (hash, proto) + | Error err -> + Format.eprintf + "Failed to read TEZOS_PROTOCOL: %a" pp_print_error err ; + exit 2 in + let real_hash = Protocol.hash protocol in + if !hash_only then begin + Format.printf "%a@." Protocol_hash.pp real_hash ; + exit 0 ; + end ; + let hash = + match announced_hash with + | None -> real_hash + | Some hash + when !check_protocol_hash && not (Protocol_hash.equal real_hash hash) -> + Format.eprintf + "Inconsistent hash for protocol in TEZOS_PROTOCOL.@\n\ + Found: %a@\n\ + Expected: %a@." + Protocol_hash.pp hash + Protocol_hash.pp real_hash ; + exit 2 + | Some hash -> hash in let build_dir = match !build_dir with | None -> @@ -178,16 +207,10 @@ let main { compile_ml ; pack_objects ; link_shared } = at_exit (fun () -> Lwt_main.run (Lwt_utils_unix.remove_dir dir)) ; dir | Some dir -> dir in - let hash, protocol = - match Lwt_main.run (Lwt_utils_unix.Protocol.read_dir source_dir) with - | Ok v -> v - | Error err -> - Format.kasprintf Pervasives.failwith - "Failed to read TEZOS_PROTOCOL: %a" pp_print_error err in - if !hash_only then begin - Format.printf "%a@." Protocol_hash.pp hash ; - exit 0 - end ; + let output = + match !output_file with + | Some output -> output + | None -> Format.asprintf "proto_%a" Protocol_hash.pp hash in Lwt_main.run (Lwt_utils_unix.create_dir ~perm:0o755 build_dir) ; Lwt_main.run (Lwt_utils_unix.create_dir ~perm:0o755 (Filename.dirname output)) ; (* Generate the 'functor' *) @@ -256,5 +279,5 @@ let main { compile_ml ; pack_objects ; link_shared } = Format.printf "let intf_digest = %S ;;\n" (Digest.to_hex dintf) end ; - Format.printf "Success: %a@." Protocol_hash.pp hash + Format.printf "Success: %a.@." Protocol_hash.pp hash diff --git a/src/lib_protocol_compiler/main_embedded_packer.ml b/src/lib_protocol_compiler/main_embedded_packer.ml index 7145e6b6e..95d7084aa 100644 --- a/src/lib_protocol_compiler/main_embedded_packer.ml +++ b/src/lib_protocol_compiler/main_embedded_packer.ml @@ -28,7 +28,10 @@ let version = Sys.argv.(2) let hash, sources = match Lwt_main.run (Lwt_utils_unix.Protocol.read_dir srcdir) with - | Ok v -> v + | Ok (None, proto) -> + (Protocol.hash proto, proto) + | Ok (Some hash, proto) -> + (hash, proto) | Error err -> Format.kasprintf Pervasives.failwith "Failed to read TEZOS_PROTOCOL: %a" pp_print_error err diff --git a/src/lib_protocol_compiler/main_packer.ml b/src/lib_protocol_compiler/main_packer.ml index 837da2233..9ba6602a9 100644 --- a/src/lib_protocol_compiler/main_packer.ml +++ b/src/lib_protocol_compiler/main_packer.ml @@ -38,7 +38,10 @@ let () = | _ -> Arg.usage args_spec usage_msg ; Pervasives.exit 1 in let hash, protocol = match Lwt_main.run (Lwt_utils_unix.Protocol.read_dir source_dir) with - | Ok v -> v + | Ok (None, proto) -> + (Protocol.hash proto, proto) + | Ok (Some hash, proto) -> + (hash, proto) | Error err -> Format.kasprintf Pervasives.failwith "Failed to read TEZOS_PROTOCOL: %a" pp_print_error err in diff --git a/src/lib_protocol_updater/updater.ml b/src/lib_protocol_updater/updater.ml index 9d1feddfa..3d8d9a0dd 100644 --- a/src/lib_protocol_updater/updater.ml +++ b/src/lib_protocol_updater/updater.ml @@ -54,7 +54,7 @@ let do_compile hash p = Lwt_utils_unix.Protocol.write_dir source_dir ~hash p >>=? fun () -> let compiler_command = (Sys.executable_name, - Array.of_list [compiler_name; "-register"; plugin_file; source_dir]) in + Array.of_list [ compiler_name ; "-register" ; "-o" ; plugin_file ; source_dir]) in let fd = Unix.(openfile log_file [O_WRONLY; O_CREAT; O_TRUNC] 0o644) in Lwt_process.exec ~stdin:`Close ~stdout:(`FD_copy fd) ~stderr:(`FD_move fd) diff --git a/src/lib_stdlib_unix/lwt_utils_unix.ml b/src/lib_stdlib_unix/lwt_utils_unix.ml index e76020c10..6326288a2 100644 --- a/src/lib_stdlib_unix/lwt_utils_unix.ml +++ b/src/lib_stdlib_unix/lwt_utils_unix.ml @@ -237,12 +237,7 @@ module Protocol = struct match meta.expected_env_version with | None -> V1 | Some v -> v in - let protocol = { expected_env ; components } in - let hash = - match meta.hash with - | None -> hash protocol - | Some hash -> hash in - return (hash, protocol) + return (meta.hash, { expected_env ; components }) open Lwt.Infix diff --git a/src/lib_stdlib_unix/lwt_utils_unix.mli b/src/lib_stdlib_unix/lwt_utils_unix.mli index 9f25465e3..b8e0d2abd 100644 --- a/src/lib_stdlib_unix/lwt_utils_unix.mli +++ b/src/lib_stdlib_unix/lwt_utils_unix.mli @@ -66,7 +66,7 @@ end module Protocol : sig - val read_dir: string -> (Protocol_hash.t * Protocol.t) tzresult Lwt.t + val read_dir: string -> (Protocol_hash.t option * Protocol.t) tzresult Lwt.t val write_dir: string -> ?hash:Protocol_hash.t -> Protocol.t -> unit tzresult Lwt.t