Alizter · Oct 21, 2026 · Oct 17, 2026 · rgrinberg · Oct 21, 2026 · Alizter
diff --git a/bench/micro/copyfile.ml b/bench/micro/copyfile.ml
@@ -26,6 +26,6 @@ let () =
   in
   for i = 1 to 10_000 do
     let dst = Path.relative dir (sprintf "dst-%d" i) in
-    Io.copy_file ~chmod ~src ~dst ()
+    Io.copy_file ~overwrite:true ~chmod ~src ~dst ()
   done
 ;;
diff --git a/bin/install_uninstall.ml b/bin/install_uninstall.ml
@@ -345,7 +345,7 @@ module File_ops_real (W : sig
       else Mode.create ~user:(read + write) ~group:read ~other:read ()
     in
     let chmod _ = mode in
-    let plain_copy () = Io.copy_file ~chmod ~src ~dst () in
+    let plain_copy () = Io.copy_file ~overwrite:true ~chmod ~src ~dst () in
     match kind with
     | Substitute -> Artifact_substitution.copy_file ~conf ~src ~dst ~chmod ()
     | Special sf ->

diff --git a/otherlibs/stdune/src/copyfile_stubs.c b/otherlibs/stdune/src/copyfile_stubs.c
@@ -12,12 +12,14 @@
 #include <caml/unixsupport.h>
 
 #include <copyfile.h>
+#include <stdbool.h>
 #include <stdlib.h>
 #include <string.h>
 #include <sys/syslimits.h>
 
-CAMLprim value stdune_copyfile(value v_from, value v_to) {
-  CAMLparam2(v_from, v_to);
+CAMLprim value stdune_copyfile(value v_from, value v_to, value v_overwrite) {
+  CAMLparam3(v_from, v_to, v_overwrite);
+  bool overwrite = Bool_val(v_overwrite);
   caml_unix_check_path(v_from, "copyfile");
   caml_unix_check_path(v_to, "copyfile");
   char from[PATH_MAX];
@@ -44,12 +46,18 @@ CAMLprim value stdune_copyfile(value v_from, value v_to) {
     uerror("realpath", v_from);
   }
   /* nor does it automatically overwrite the target */
-  int ret = unlink(to);
-  if (ret < 0 && errno != ENOENT) {
-    caml_acquire_runtime_system();
-    uerror("unlink", v_to);
+  if (overwrite) {
+    int ret = unlink(to);
+    if (ret < 0 && errno != ENOENT) {
+      caml_acquire_runtime_system();
+      uerror("unlink", v_to);
+    }
+  }
+  copyfile_flags_t flags = COPYFILE_CLONE;
+  if (!overwrite) {
+    flags |= COPYFILE_EXCL;
   }
-  ret = copyfile(real_from, to, NULL, COPYFILE_CLONE);
+  int ret = copyfile(real_from, to, NULL, flags);
   caml_acquire_runtime_system();
   if (ret < 0) {
     uerror("copyfile", v_to);
@@ -77,9 +85,10 @@ CAMLprim value stdune_sendfile(value v_in, value v_out, value v_size) {
 #define KERNEL_VERSION(a, b, c) (((a) << 16) + ((b) << 8) + (c))
 #define FD_val(value) Int_val(value)
 
-CAMLprim value stdune_copyfile(value v_from, value v_to) {
+CAMLprim value stdune_copyfile(value v_from, value v_to, value v_overwrite) {
   (void)v_from;
   (void)v_to;
+  (void)v_overwrite;
   caml_failwith("copyfile: only on macos");
 }
 
@@ -163,9 +172,10 @@ CAMLprim value stdune_sendfile(value v_in, value v_out, value v_size) {
   caml_failwith("sendfile: linux");
 }
 
-CAMLprim value stdune_copyfile(value v_from, value v_to) {
+CAMLprim value stdune_copyfile(value v_from, value v_to, value v_overwrite) {
   (void)v_from;
   (void)v_to;
+  (void)v_overwrite;
   caml_failwith("copyfile: only on macos");
 }
 

diff --git a/otherlibs/stdune/src/io.ml b/otherlibs/stdune/src/io.ml
@@ -88,7 +88,7 @@ let copy_channels =
         Exn.reraise exn)
 ;;
 
-let setup_copy ?(chmod = Fun.id) ~src ~dst () =
+let setup_copy ~overwrite ?(chmod = Fun.id) ~src ~dst () =
   let ic = Stdlib.open_in_bin src in
   let oc =
     try
@@ -98,7 +98,8 @@ let setup_copy ?(chmod = Fun.id) ~src ~dst () =
         |> chmod
         |> Permissions.Mode.to_int
       in
-      Stdlib.open_out_gen [ Open_wronly; Open_creat; Open_trunc; Open_binary ] perm dst
+      let creation = if overwrite then Open_trunc else Open_excl in
+      Stdlib.open_out_gen [ Open_wronly; Open_creat; creation; Open_binary ] perm dst
     with
     | exn ->
       close_in ic;
@@ -111,7 +112,7 @@ module Copyfile = struct
   (* Bindings to mac's fast copy function. It's similar to a hardlink, except
      it does COW when edited. It will also default back to regular copying if
      it fails for w/e reason *)
-  external copyfile : string -> string -> unit = "stdune_copyfile"
+  external copyfile : string -> string -> bool -> unit = "stdune_copyfile"
 
   external sendfile
     :  src:Unix.file_descr
@@ -128,7 +129,7 @@ module Copyfile = struct
   ;;
 
   let sendfile_with_fallback =
-    let setup_copy ?(chmod = Fun.id) ~src ~dst () =
+    let setup_copy ~overwrite ?(chmod = Fun.id) ~src ~dst () =
       match Unix.openfile src [ O_RDONLY; O_CLOEXEC ] 0 with
       | exception Unix.Unix_error (Unix.ENOENT, _, _) -> Error `Src_missing
       | fd_src ->
@@ -152,7 +153,8 @@ module Copyfile = struct
                     |> chmod
                     |> Permissions.Mode.to_int
                   in
-                  Unix.openfile dst [ O_WRONLY; O_CREAT; O_TRUNC; O_CLOEXEC ] dst_perm
+                  let creation = if overwrite then Unix.O_TRUNC else Unix.O_EXCL in
+                  Unix.openfile dst [ O_WRONLY; O_CREAT; creation; O_CLOEXEC ] dst_perm
                 with
                 | fd_dst -> Ok (Fd.unsafe_of_unix_file_descr fd_dst, src_stat.st_size)
                 | exception exn ->
@@ -163,14 +165,14 @@ module Copyfile = struct
               in
               fd_src, fd_dst, src_size))
     in
-    fun ?chmod ~src ~dst () ->
+    fun ~overwrite ?chmod ~src ~dst () ->
       (* All of this exception translation is done for now to maintain the
          same error messages as the other file copying functions.
 
          Eventually, we should stop using exceptions for signalling these
          errors. But that's a bit of a large change since there's a lot of
          exception catching to audit. *)
-      match setup_copy ?chmod ~src ~dst () with
+      match setup_copy ~overwrite ?chmod ~src ~dst () with
       | Error (`Exn exn) -> Exn_with_backtrace.reraise exn
       | Error `Src_is_a_dir -> raise (Sys_error "Is a directory")
       | Error `Dst_is_a_dir ->
@@ -204,7 +206,7 @@ module Copyfile = struct
            Exn.reraise exn)
   ;;
 
-  let copyfile ?chmod ~src ~dst () =
+  let copyfile ~overwrite ?chmod ~src ~dst () =
     let src_stats =
       match Unix.stat src with
       | exception Unix.Unix_error (Unix.ENOENT, _, _) ->
@@ -213,7 +215,7 @@ module Copyfile = struct
       | { st_kind = S_DIR; _ } -> raise (Sys_error "Is a directory")
       | stats -> stats
     in
-    (try copyfile src dst with
+    (try copyfile src dst overwrite with
      | Unix.Unix_error (Unix.EPERM, "unlink", _) ->
        let message = Printf.sprintf "%s: Is a directory" dst in
        raise (Sys_error message)
@@ -230,9 +232,11 @@ module Copyfile = struct
       |> Unix.chmod dst
   ;;
 
-  let copy_file_portable ?chmod ~src ~dst () =
-    Exn.protectx (setup_copy ?chmod ~src ~dst ()) ~finally:close_both ~f:(fun (ic, oc) ->
-      copy_channels ic oc)
+  let copy_file_portable ~overwrite ?chmod ~src ~dst () =
+    Exn.protectx
+      (setup_copy ~overwrite ?chmod ~src ~dst ())
+      ~finally:close_both
+      ~f:(fun (ic, oc) -> copy_channels ic oc)
   ;;
 
   let copy_file_best =
@@ -244,10 +248,10 @@ module Copyfile = struct
 
   let copy_file_impl = ref `Best
 
-  let copy_file ?chmod ~src ~dst () =
+  let copy_file ~overwrite ?chmod ~src ~dst () =
     match !copy_file_impl with
-    | `Portable -> copy_file_portable ?chmod ~src ~dst ()
-    | `Best -> copy_file_best ?chmod ~src ~dst ()
+    | `Portable -> copy_file_portable ~overwrite ?chmod ~src ~dst ()
+    | `Best -> copy_file_best ~overwrite ?chmod ~src ~dst ()
   ;;
 end
 
@@ -409,13 +413,13 @@ struct
   let setup_copy ?chmod ~src ~dst () =
     let src = Path.to_string src in
     let dst = Path.to_string dst in
-    setup_copy ?chmod ~src ~dst ()
+    setup_copy ~overwrite:true ?chmod ~src ~dst ()
   ;;
 
-  let copy_file ?chmod ~src ~dst () =
+  let copy_file ~overwrite ?chmod ~src ~dst () =
     let src = Path.to_string src in
     let dst = Path.to_string dst in
-    Copyfile.copy_file ?chmod ~src ~dst ()
+    Copyfile.copy_file ~overwrite ?chmod ~src ~dst ()
   ;;
 
   let file_line path n =
@@ -466,7 +470,7 @@ end
 
 let portable_symlink ~src ~dst =
   if Stdlib.Sys.win32
-  then copy_file ~src ~dst ()
+  then copy_file ~overwrite:true ~src ~dst ()
   else (
     let src =
       match Path.parent dst with
@@ -527,5 +531,5 @@ let portable_hardlink ~src ~dst =
     (* If we can't make a new hard link because we reached the limit on the
         number of hard links per file, we fall back to copying. We expect
         that this happens very rarely (probably only for empty files). *)
-    copy_file ~src ~dst ()
+    copy_file ~overwrite:true ~src ~dst ()
 ;;
diff --git a/otherlibs/stdune/src/io_intf.ml b/otherlibs/stdune/src/io_intf.ml
@@ -45,8 +45,12 @@ module type S = sig
     -> string list
     -> unit
 
+  (** [copy_file ~overwrite ?chmod ~src ~dst ()] copies [src] to [dst]. When
+      [overwrite] is [false], it fails if [dst] already exists, otherwise allowing
+      overwrites. [chmod] optionally adjusts the permissions. *)
   val copy_file
-    :  ?chmod:(Permissions.Mode.t -> Permissions.Mode.t)
+    :  overwrite:bool
+    -> ?chmod:(Permissions.Mode.t -> Permissions.Mode.t)
     -> src:path
     -> dst:path
     -> unit

diff --git a/otherlibs/stdune/test/io_tests.ml b/otherlibs/stdune/test/io_tests.ml
@@ -120,7 +120,7 @@ let%expect_test "copy file simple" =
   let src = Path.relative dir "initial" in
   let dst = Path.relative dir "final" in
   Io.write_file_exn src "foobarbaz";
-  Io.copy_file ~src ~dst ();
+  Io.copy_file ~overwrite:true ~src ~dst ();
   print_endline (Io.read_file_exn dst);
   [%expect {| foobarbaz |}]
 ;;
@@ -131,7 +131,7 @@ let%expect_test "copy file overwrite" =
   let dst = Path.relative dir "final" in
   Io.write_file_exn src "foobarbaz";
   Io.write_file_exn dst "xxx";
-  Io.copy_file ~src ~dst ();
+  Io.copy_file ~overwrite:true ~src ~dst ();
   print_endline (Io.read_file_exn dst);
   [%expect {| foobarbaz |}]
 ;;
@@ -145,6 +145,7 @@ let%expect_test "copy file chmod" =
   Exn.protect
     ~f:(fun () ->
       Io.copy_file
+        ~overwrite:true
         ~chmod:(fun _ ->
           let open Permissions in
           Mode.create ~user:(read + write) ~group:(read + execute) ~other:read ())
@@ -164,7 +165,7 @@ let%expect_test "copy file - no src" =
   let dir = temp_dir () in
   let src = Path.relative dir "initial" in
   let dst = Path.relative dir "final" in
-  match Io.copy_file ~src ~dst () with
+  match Io.copy_file ~overwrite:true ~src ~dst () with
   | () -> assert false
   | exception Sys_error s ->
     let s =
@@ -180,7 +181,7 @@ let%expect_test "copy file - src is a directory" =
   let src = Path.relative dir "initial" in
   let dst = Path.relative dir "final" in
   Unix.mkdir (Path.to_string src) 0o755;
-  Io.copy_file ~src ~dst ();
+  Io.copy_file ~overwrite:true ~src ~dst ();
   [%expect.unreachable]
 [@@expect.uncaught_exn {| (Sys_error "Is a directory") |}]
 ;;
@@ -192,7 +193,7 @@ let%expect_test "copy file - dst is a directory" =
   Io.write_file_exn src "foobarbaz";
   Unix.mkdir (Path.to_string dst) 0o755;
   Unix.sleepf 0.5;
-  match Io.copy_file ~src ~dst () with
+  match Io.copy_file ~overwrite:true ~src ~dst () with
   | _ -> assert false
   | exception Sys_error s ->
     let s =

diff --git a/src/dune_cache/shared.ml b/src/dune_cache/shared.ml
@@ -105,7 +105,7 @@ let link_even_if_there_are_too_many_links_already ~src ~dst =
       ~f:(function
       | Error e -> raise e
       | Ok temp_file ->
-        Io.copy_file ~src ~dst:temp_file ();
+        Io.copy_file ~overwrite:true ~src ~dst:temp_file ();
         (* This replaces [src], which has too many links already, with a fresh
            copy we've just created in the [temp_file]. *)
         let src = Path.to_string src in
@@ -129,7 +129,7 @@ let store_targets_to ~temp_dir ~(targets : _ Targets.Produced.t) ~mode : unit Or
   let portable_hardlink_or_copy =
     match (mode : Mode.t) with
     | Hardlink -> Io.portable_hardlink
-    | Copy -> fun ~src ~dst -> Io.copy_file ~src ~dst ()
+    | Copy -> fun ~src ~dst -> Io.copy_file ~overwrite:true ~src ~dst ()
   in
   Result.try_with (fun () ->
     (* CR-someday rleshchinskiy: We recreate the directory structure here but it might be
@@ -288,7 +288,7 @@ module File_restore = struct
   ;;
 
   let copy ~src ~dst =
-    (try Io.copy_file ~src ~dst () with
+    (try Io.copy_file ~overwrite:true ~src ~dst () with
      | Sys_error _ -> raise_notrace (E Not_found_in_cache));
     let src = Path.to_string src in
     match Unix.stat src with

diff --git a/src/dune_engine/action_exec.ml b/src/dune_engine/action_exec.ml
@@ -148,7 +148,7 @@ let rec exec t ~ectx ~eenv : unit Fiber.t =
     let dst = Path.build dst in
     let copy_file ~src ~dst =
       Path.parent dst |> Option.iter ~f:Path.mkdir_p;
-      Io.copy_file ~src ~dst ()
+      Io.copy_file ~overwrite:true ~src ~dst ()
     in
     let mkdir ~src:_ ~dst = Path.mkdir_p dst in
     let on_unsupported ~src kind =

diff --git a/src/dune_engine/diff_promotion.ml b/src/dune_engine/diff_promotion.ml
@@ -46,7 +46,9 @@ module File = struct
          ]);
     let chmod = Permissions.add Permissions.write in
     Path.mkdir_p (Path.source (Path.Source.parent_exn dst));
-    match Io.copy_file ~chmod ~src:correction_file ~dst:(Path.source dst) () with
+    match
+      Io.copy_file ~overwrite:true ~chmod ~src:correction_file ~dst:(Path.source dst) ()
+    with
     | () -> ()
     | exception Unix.Unix_error (e, _, _) ->
       User_error.raise
@@ -150,6 +152,7 @@ let register_intermediate how ~source_file ~correction_file =
      Unix.rename (Path.Build.to_string correction_file) (Path.Build.to_string staging)
    | `Copy ->
      Io.copy_file
+       ~overwrite:true
        ~chmod:Permissions.(add write)
        ~src:(Path.build correction_file)
        ~dst:(Path.build staging)

diff --git a/src/dune_engine/sandbox.ml b/src/dune_engine/sandbox.ml
@@ -145,7 +145,9 @@ let copy_recursively =
             (Path.to_string_maybe_quoted src)
         ]
   in
-  let copy_file ~src ~dst = Io.copy_file ~chmod:chmod_file ~src ~dst () in
+  let copy_file ~src ~dst =
+    Io.copy_file ~overwrite:false ~chmod:chmod_file ~src ~dst ()
+  in
   let mkdir_with_perms ~src ~dst =
     let perms =
       (Unix.stat (Path.to_string src)).st_perm |> Permissions.Mode.of_int |> chmod_dir
@@ -203,7 +205,7 @@ let link_function ~(mode : Sandbox_mode.some) =
           dependencies and make them writable. *)
        (* CR-someday: this doesn't work with directory targets *)
        let chmod = Permissions.add Permissions.write in
-       fun src dst -> Io.copy_file ~src ~dst ~chmod ())
+       fun src dst -> Io.copy_file ~overwrite:false ~src ~dst ~chmod ())
 ;;
 
 let link_deps t ~deps =

diff --git a/src/dune_pkg/lock_dir.ml b/src/dune_pkg/lock_dir.ml
@@ -1434,7 +1434,7 @@ module Write_disk = struct
           let child_src = Path.relative_fname (Path.relative src dir) fname in
           let child_dst = dst_of ~dir fname in
           Path.mkdir_p (Path.relative dst dir);
-          Io.copy_file ~src:child_src ~dst:child_dst ())
+          Io.copy_file ~overwrite:true ~src:child_src ~dst:child_dst ())
         ~on_dir:(fun ~dir fname () -> Path.mkdir_p (dst_of ~dir fname))
         ~on_symlink:`Raise
         ()
@@ -1516,7 +1516,7 @@ module Write_disk = struct
               let dst = Path.append_local files_dir local_file in
               Path.mkdir_p (Path.parent_exn dst);
               match original with
-              | Path src -> Io.copy_file ~src ~dst ()
+              | Path src -> Io.copy_file ~overwrite:true ~src ~dst ()
               | Content content -> Io.write_file_exn dst content))));
       rename_old_lock_dir_to_hidden ();
       safely_rename_lock_dir_thunk ~dst:lock_dir_path_external lock_dir_path ();

diff --git a/src/dune_rules/fetch_rules.ml b/src/dune_rules/fetch_rules.ml
@@ -319,7 +319,7 @@ module Copy = struct
         ~on_file:(fun ~dir fname () ->
           let src = Path.relative_fname (Path.relative src_dir dir) fname in
           let dst = Path.relative_fname (Path.relative dst_dir dir) fname in
-          Io.copy_file ~src ~dst ())
+          Io.copy_file ~overwrite:true ~src ~dst ())
         ()
     ;;
   end