From 65594df37aa96469cc48deae2dace76ef3540ddf Mon Sep 17 00:00:00 2001 From: Etienne Millon Date: Fri, 14 Oct 2022 11:15:22 +0200 Subject: [PATCH 1/4] Artifact_substitution.copy: return a boolean Signed-off-by: Etienne Millon --- src/dune_rules/artifact_substitution.ml | 35 ++++++++++--------- src/dune_rules/artifact_substitution.mli | 6 ++-- .../artifact_substitution.ml | 10 ++++-- 3 files changed, 29 insertions(+), 22 deletions(-) diff --git a/src/dune_rules/artifact_substitution.ml b/src/dune_rules/artifact_substitution.ml index 4a93a960ad4..a61c7980caf 100644 --- a/src/dune_rules/artifact_substitution.ml +++ b/src/dune_rules/artifact_substitution.ml @@ -417,14 +417,13 @@ let buf_len = max_len let buf = Bytes.create buf_len -type _ mode = - | Test : bool mode - | Copy : +type mode = + | Test + | Copy of { input_file : Path.t ; output : bytes -> int -> int -> unit ; conf : conf } - -> unit mode (** The copy algorithm works as follow: @@ -464,10 +463,10 @@ output the replacement | | | | \--------------------------------------------------------------------------/ v} *) -let parse : type a. input:_ -> mode:a mode -> a Fiber.t = - fun ~input ~mode -> +let parse ~input ~mode = let open Fiber.O in - let rec loop scanner_state ~beginning_of_data ~pos ~end_of_data : a Fiber.t = + let rec loop scanner_state ~beginning_of_data ~pos ~end_of_data ~has_seen_subs + = let scanner_state = Scanner.run scanner_state ~buf ~pos ~end_of_data in let placeholder_start = match scanner_state with @@ -509,13 +508,14 @@ let parse : type a. input:_ -> mode:a mode -> a Fiber.t = let s = encode_replacement ~len ~repl:s in output (Bytes.unsafe_of_string s) 0 len; let pos = placeholder_start + len in - loop Scan0 ~beginning_of_data:pos ~pos ~end_of_data) + loop Scan0 ~beginning_of_data:pos ~pos ~end_of_data + ~has_seen_subs:true) | None -> (* Restart just after [prefix] since we know for sure that a placeholder cannot start before that. *) loop Scan0 ~beginning_of_data:placeholder_start ~pos:(placeholder_start + prefix_len) - ~end_of_data) + ~end_of_data ~has_seen_subs) | scanner_state -> ( (* We reached the end of the buffer: move the leftover data back to the beginning of [buf] and refill the buffer *) @@ -538,6 +538,7 @@ let parse : type a. input:_ -> mode:a mode -> a Fiber.t = (* There might still be another placeholder after this invalid one with a length that is too long *) loop Scan0 ~beginning_of_data:0 ~pos:prefix_len ~end_of_data:leftover + ~has_seen_subs | _ -> ( match mode with | Test -> Fiber.return false @@ -545,17 +546,15 @@ let parse : type a. input:_ -> mode:a mode -> a Fiber.t = (* Nothing more to read; [leftover] is definitely not the beginning of a placeholder, send it and end the copy *) output buf 0 leftover; - Fiber.return ())) + Fiber.return has_seen_subs)) | n -> loop scanner_state ~beginning_of_data:0 ~pos:leftover - ~end_of_data:(leftover + n)) + ~end_of_data:(leftover + n) ~has_seen_subs) in match input buf 0 buf_len with - | 0 -> ( - match mode with - | Test -> Fiber.return false - | Copy _ -> Fiber.return ()) - | n -> loop Scan0 ~beginning_of_data:0 ~pos:0 ~end_of_data:n + | 0 -> Fiber.return false + | n -> + loop Scan0 ~beginning_of_data:0 ~pos:0 ~end_of_data:n ~has_seen_subs:false let copy ~conf ~input_file ~input ~output = parse ~input ~mode:(Copy { conf; input_file; output }) @@ -612,7 +611,9 @@ let copy_file ~conf ?chmod ?(delete_dst_if_it_is_a_directory = false) ~src ~dst Fiber.finalize (fun () -> let open Fiber.O in - let* () = copy_file_non_atomic ~conf ?chmod ~src ~dst:temp_file () in + let* (_ : bool) = + copy_file_non_atomic ~conf ?chmod ~src ~dst:temp_file () + in let+ () = run_sign_hook conf temp_file in replace_if_different ~delete_dst_if_it_is_a_directory ~src:temp_file ~dst) ~finally:(fun () -> diff --git a/src/dune_rules/artifact_substitution.mli b/src/dune_rules/artifact_substitution.mli index e1afe582276..ec11e947c5b 100644 --- a/src/dune_rules/artifact_substitution.mli +++ b/src/dune_rules/artifact_substitution.mli @@ -72,13 +72,15 @@ val copy_file : [output] functions from the OCaml standard library. [input_file] is used only for debugging purposes. It must be the name of the - source file. *) + source file. + + Return whether a substitution happened. *) val copy : conf:conf -> input_file:Path.t -> input:(Bytes.t -> int -> int -> int) -> output:(Bytes.t -> int -> int -> unit) - -> unit Fiber.t + -> bool Fiber.t (** Produce the string that would replace the placeholder with the given value .*) val encode_replacement : len:int -> repl:string -> string diff --git a/test/unit-tests/artifact_substitution/artifact_substitution.ml b/test/unit-tests/artifact_substitution/artifact_substitution.ml index bb5a075830d..a1686574c64 100644 --- a/test/unit-tests/artifact_substitution/artifact_substitution.ml +++ b/test/unit-tests/artifact_substitution/artifact_substitution.ml @@ -136,6 +136,7 @@ let test input = Fiber.run ~iter:(fun () -> assert false) (let ofs = ref 0 in + let open Fiber.O in let input buf pos len = let to_copy = min len (String.length input - !ofs) in Bytes.blit_string ~src:input ~dst:buf ~src_pos:!ofs ~dst_pos:pos @@ -144,9 +145,12 @@ let test input = to_copy in let output = Buffer.add_subbytes buf in - Artifact_substitution.copy ~conf:Artifact_substitution.conf_dummy - ~input_file:(Path.of_string "") - ~input ~output); + let+ (_ : bool) = + Artifact_substitution.copy ~conf:Artifact_substitution.conf_dummy + ~input_file:(Path.of_string "") + ~input ~output + in + ()); let result = Buffer.contents buf in if result <> expected then fail From d319f05ce7442fe77667b9e27efe052c7a8fa706 Mon Sep 17 00:00:00 2001 From: Etienne Millon Date: Fri, 14 Oct 2022 11:52:34 +0200 Subject: [PATCH 2/4] Only run codesign if there have been substitutions This ensures that we're not running `codesign` in cases we don't strictly need it. This in turn prevents a regression in macos+nix, where the codesign binary is not in PATH. Closes #6226 Signed-off-by: Etienne Millon --- CHANGES.md | 4 ++-- src/dune_rules/artifact_substitution.ml | 12 ++++++------ 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 6bcf22067df..7bf79cbd7ee 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -79,8 +79,8 @@ Coq's standard library by including `(stdlib no)`. (#6165 #6164, fixes #6163, @ejgallego @Alizter @LasseBlaauwbroek) -- on macOS, sign executables produced by artifact substitution (#6137, fixes - #5650, @emillon) +- on macOS, sign executables produced by artifact substitution (#6137, #6231, + fixes #5650, fixes #6226, @emillon) - Added an (aliases ...) field to the (rules ...) stanza which allows the specification of multiple aliases per rule (#6194, @Alizter) diff --git a/src/dune_rules/artifact_substitution.ml b/src/dune_rules/artifact_substitution.ml index a61c7980caf..1d92e765cdb 100644 --- a/src/dune_rules/artifact_substitution.ml +++ b/src/dune_rules/artifact_substitution.ml @@ -568,10 +568,10 @@ let copy_file_non_atomic ~conf ?chmod ~src ~dst () = Fiber.return ()) (fun () -> copy ~conf ~input_file:src ~input:(input ic) ~output:(output oc)) -let run_sign_hook conf file = - match conf.sign_hook with - | Some hook -> hook file - | None -> Fiber.return () +let run_sign_hook conf ~has_subst file = + match (conf.sign_hook, has_subst) with + | Some hook, true -> hook file + | _ -> Fiber.return () (** This is just an optimisation: skip the renaming if the destination exists and has the right digest. The optimisation is useful to avoid unnecessary @@ -611,10 +611,10 @@ let copy_file ~conf ?chmod ?(delete_dst_if_it_is_a_directory = false) ~src ~dst Fiber.finalize (fun () -> let open Fiber.O in - let* (_ : bool) = + let* has_subst = copy_file_non_atomic ~conf ?chmod ~src ~dst:temp_file () in - let+ () = run_sign_hook conf temp_file in + let+ () = run_sign_hook conf ~has_subst temp_file in replace_if_different ~delete_dst_if_it_is_a_directory ~src:temp_file ~dst) ~finally:(fun () -> Path.unlink_no_err temp_file; From df11db135ec7c31d6e29d5a269f2300e8714a14c Mon Sep 17 00:00:00 2001 From: Etienne Millon Date: Mon, 17 Oct 2022 10:04:41 +0200 Subject: [PATCH 3/4] Compute sign hook lazily Signed-off-by: Etienne Millon --- src/dune_rules/artifact_substitution.ml | 19 +++++++++++-------- src/dune_rules/artifact_substitution.mli | 2 +- 2 files changed, 12 insertions(+), 9 deletions(-) diff --git a/src/dune_rules/artifact_substitution.ml b/src/dune_rules/artifact_substitution.ml index 1d92e765cdb..74b1e130fe0 100644 --- a/src/dune_rules/artifact_substitution.ml +++ b/src/dune_rules/artifact_substitution.ml @@ -48,7 +48,7 @@ type conf = ; get_location : Section.t -> Package.Name.t -> Path.t ; get_config_path : configpath -> Path.t option ; hardcoded_ocaml_path : hardcoded_ocaml_path - ; sign_hook : (Path.t -> unit Fiber.t) option + ; sign_hook : (Path.t -> unit Fiber.t) option Lazy.t } let mac_codesign_hook ~codesign path = @@ -74,7 +74,7 @@ let conf_of_context (context : Context.t option) = ; get_location = (fun _ _ -> Code_error.raise "no context available" []) ; get_config_path = (fun _ -> Code_error.raise "no context available" []) ; hardcoded_ocaml_path = Hardcoded [] - ; sign_hook = None + ; sign_hook = lazy None } | Some context -> let get_location = Install.Section.Paths.get_local_location context.name in @@ -87,7 +87,7 @@ let conf_of_context (context : Context.t option) = let install_dir = Path.build (Path.Build.relative install_dir "lib") in Hardcoded (install_dir :: context.default_ocamlpath) in - let sign_hook = sign_hook_of_context context in + let sign_hook = lazy (sign_hook_of_context context) in { get_vcs = Source_tree.nearest_vcs ; get_location ; get_config_path @@ -111,7 +111,7 @@ let conf_for_install ~relocatable ~default_ocamlpath ~stdlib_dir ~roots ~context | Sourceroot -> None | Stdlib -> Some stdlib_dir in - let sign_hook = sign_hook_of_context context in + let sign_hook = lazy (sign_hook_of_context context) in { get_location; get_vcs; get_config_path; hardcoded_ocaml_path; sign_hook } let conf_dummy = @@ -119,7 +119,7 @@ let conf_dummy = ; get_location = (fun _ _ -> Path.root) ; get_config_path = (fun _ -> None) ; hardcoded_ocaml_path = Hardcoded [] - ; sign_hook = None + ; sign_hook = lazy None } let to_dyn = function @@ -569,9 +569,12 @@ let copy_file_non_atomic ~conf ?chmod ~src ~dst () = (fun () -> copy ~conf ~input_file:src ~input:(input ic) ~output:(output oc)) let run_sign_hook conf ~has_subst file = - match (conf.sign_hook, has_subst) with - | Some hook, true -> hook file - | _ -> Fiber.return () + match has_subst with + | false -> Fiber.return () + | true -> ( + match Lazy.force conf.sign_hook with + | Some hook -> hook file + | None -> Fiber.return ()) (** This is just an optimisation: skip the renaming if the destination exists and has the right digest. The optimisation is useful to avoid unnecessary diff --git a/src/dune_rules/artifact_substitution.mli b/src/dune_rules/artifact_substitution.mli index ec11e947c5b..5cb166d24b2 100644 --- a/src/dune_rules/artifact_substitution.mli +++ b/src/dune_rules/artifact_substitution.mli @@ -26,7 +26,7 @@ type conf = private ; get_config_path : configpath -> Path.t option ; hardcoded_ocaml_path : hardcoded_ocaml_path (** Initial prefix of installation when relocatable chosen *) - ; sign_hook : (Path.t -> unit Fiber.t) option + ; sign_hook : (Path.t -> unit Fiber.t) option Lazy.t (** Called on binary after if has been edited *) } From 4838ed09dae9dabb48118cca405ca73f0058387b Mon Sep 17 00:00:00 2001 From: Etienne Millon Date: Mon, 17 Oct 2022 10:15:02 +0200 Subject: [PATCH 4/4] Return a status type instead of a plain bool Signed-off-by: Etienne Millon --- bin/install_uninstall.ml | 9 ++++-- src/dune_rules/artifact_substitution.ml | 30 +++++++++++-------- src/dune_rules/artifact_substitution.mli | 8 +++-- .../artifact_substitution.ml | 2 +- 4 files changed, 30 insertions(+), 19 deletions(-) diff --git a/bin/install_uninstall.ml b/bin/install_uninstall.ml index bf059b7c7ec..29ddbf139dd 100644 --- a/bin/install_uninstall.ml +++ b/bin/install_uninstall.ml @@ -696,9 +696,12 @@ let install_uninstall ~what = match special_file with | _ when not create_install_files -> Fiber.return true - | None -> - Dune_rules.Artifact_substitution.test_file - ~src:entry.src () + | None -> ( + let open Dune_rules.Artifact_substitution in + let+ status = test_file ~src:entry.src () in + match status with + | Some_substitution -> true + | No_substitution -> false) | Some Special_file.META | Some Special_file.Dune_package -> Fiber.return true diff --git a/src/dune_rules/artifact_substitution.ml b/src/dune_rules/artifact_substitution.ml index 74b1e130fe0..b13ae3b9009 100644 --- a/src/dune_rules/artifact_substitution.ml +++ b/src/dune_rules/artifact_substitution.ml @@ -425,6 +425,10 @@ type mode = ; conf : conf } +type status = + | Some_substitution + | No_substitution + (** The copy algorithm works as follow: {v @@ -465,8 +469,7 @@ output the replacement | | v} *) let parse ~input ~mode = let open Fiber.O in - let rec loop scanner_state ~beginning_of_data ~pos ~end_of_data ~has_seen_subs - = + let rec loop scanner_state ~beginning_of_data ~pos ~end_of_data ~status = let scanner_state = Scanner.run scanner_state ~buf ~pos ~end_of_data in let placeholder_start = match scanner_state with @@ -492,7 +495,7 @@ let parse ~input ~mode = match decode placeholder with | Some t -> ( match mode with - | Test -> Fiber.return true + | Test -> Fiber.return Some_substitution | Copy { output; input_file; conf } -> let* s = eval t ~conf in (if !Clflags.debug_artifact_substitution then @@ -509,13 +512,13 @@ let parse ~input ~mode = output (Bytes.unsafe_of_string s) 0 len; let pos = placeholder_start + len in loop Scan0 ~beginning_of_data:pos ~pos ~end_of_data - ~has_seen_subs:true) + ~status:Some_substitution) | None -> (* Restart just after [prefix] since we know for sure that a placeholder cannot start before that. *) loop Scan0 ~beginning_of_data:placeholder_start ~pos:(placeholder_start + prefix_len) - ~end_of_data ~has_seen_subs) + ~end_of_data ~status) | scanner_state -> ( (* We reached the end of the buffer: move the leftover data back to the beginning of [buf] and refill the buffer *) @@ -538,23 +541,24 @@ let parse ~input ~mode = (* There might still be another placeholder after this invalid one with a length that is too long *) loop Scan0 ~beginning_of_data:0 ~pos:prefix_len ~end_of_data:leftover - ~has_seen_subs + ~status | _ -> ( match mode with - | Test -> Fiber.return false + | Test -> Fiber.return No_substitution | Copy { output; _ } -> (* Nothing more to read; [leftover] is definitely not the beginning of a placeholder, send it and end the copy *) output buf 0 leftover; - Fiber.return has_seen_subs)) + Fiber.return status)) | n -> loop scanner_state ~beginning_of_data:0 ~pos:leftover - ~end_of_data:(leftover + n) ~has_seen_subs) + ~end_of_data:(leftover + n) ~status) in match input buf 0 buf_len with - | 0 -> Fiber.return false + | 0 -> Fiber.return No_substitution | n -> - loop Scan0 ~beginning_of_data:0 ~pos:0 ~end_of_data:n ~has_seen_subs:false + loop Scan0 ~beginning_of_data:0 ~pos:0 ~end_of_data:n + ~status:No_substitution let copy ~conf ~input_file ~input ~output = parse ~input ~mode:(Copy { conf; input_file; output }) @@ -570,8 +574,8 @@ let copy_file_non_atomic ~conf ?chmod ~src ~dst () = let run_sign_hook conf ~has_subst file = match has_subst with - | false -> Fiber.return () - | true -> ( + | No_substitution -> Fiber.return () + | Some_substitution -> ( match Lazy.force conf.sign_hook with | Some hook -> hook file | None -> Fiber.return ()) diff --git a/src/dune_rules/artifact_substitution.mli b/src/dune_rules/artifact_substitution.mli index 5cb166d24b2..1e762d33f93 100644 --- a/src/dune_rules/artifact_substitution.mli +++ b/src/dune_rules/artifact_substitution.mli @@ -67,6 +67,10 @@ val copy_file : -> unit -> unit Fiber.t +type status = + | Some_substitution + | No_substitution + (** Generic version of [copy_file]. Rather than filenames, it takes an input and output functions. Their semantic must match the ones of the [input] and [output] functions from the OCaml standard library. @@ -80,10 +84,10 @@ val copy : -> input_file:Path.t -> input:(Bytes.t -> int -> int -> int) -> output:(Bytes.t -> int -> int -> unit) - -> bool Fiber.t + -> status Fiber.t (** Produce the string that would replace the placeholder with the given value .*) val encode_replacement : len:int -> repl:string -> string (** Test if a file contains a substitution placeholder. *) -val test_file : src:Path.t -> unit -> bool Fiber.t +val test_file : src:Path.t -> unit -> status Fiber.t diff --git a/test/unit-tests/artifact_substitution/artifact_substitution.ml b/test/unit-tests/artifact_substitution/artifact_substitution.ml index a1686574c64..d21aaba51ea 100644 --- a/test/unit-tests/artifact_substitution/artifact_substitution.ml +++ b/test/unit-tests/artifact_substitution/artifact_substitution.ml @@ -145,7 +145,7 @@ let test input = to_copy in let output = Buffer.add_subbytes buf in - let+ (_ : bool) = + let+ (_ : Artifact_substitution.status) = Artifact_substitution.copy ~conf:Artifact_substitution.conf_dummy ~input_file:(Path.of_string "") ~input ~output