Only run codesign if there have been substitutions

CHANGES.md

@@ -81,8 +81,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)

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

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,15 +111,15 @@ 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 =
   { get_vcs = (fun _ -> Memo.return None)
   ; 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
@@ -417,14 +417,17 @@ 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
+
+type status =
+  | Some_substitution
+  | No_substitution
 
 (** The copy algorithm works as follow:
 
@@ -464,10 +467,9 @@ 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 ~status =
     let scanner_state = Scanner.run scanner_state ~buf ~pos ~end_of_data in
     let placeholder_start =
       match scanner_state with
@@ -493,7 +495,7 @@ let parse : type a. input:_ -> mode:a mode -> a Fiber.t =
       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 +511,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
+            ~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)
+          ~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,24 +541,24 @@ 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
+            ~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 ()))
+            Fiber.return status))
       | n ->
         loop scanner_state ~beginning_of_data:0 ~pos:leftover
-          ~end_of_data:(leftover + n))
+          ~end_of_data:(leftover + n) ~status)
   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 No_substitution
+  | n ->
+    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 })
@@ -569,10 +572,13 @@ 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 has_subst with
+  | No_substitution -> Fiber.return ()
+  | Some_substitution -> (
+    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
@@ -612,8 +618,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* () = copy_file_non_atomic ~conf ?chmod ~src ~dst:temp_file () in
-      let+ () = run_sign_hook conf temp_file in
+      let* has_subst =
+        copy_file_non_atomic ~conf ?chmod ~src ~dst: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;

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 *)
   }
 
@@ -67,21 +67,27 @@ 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.
 
     [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
+  -> 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

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 "<memory>")
-       ~input ~output);
+     let+ (_ : Artifact_substitution.status) =
+       Artifact_substitution.copy ~conf:Artifact_substitution.conf_dummy
+         ~input_file:(Path.of_string "<memory>")
+         ~input ~output
+     in
+     ());
   let result = Buffer.contents buf in
   if result <> expected then
     fail