feature: use clonefile on macos (#7210)

Use mac's [clonefile] instead of manually copying. [clonefile] is like
hardlink but it will copy-on-write when edited.

Signed-off-by: Rudi Grinberg <[email protected]>

bench/micro/copyfile.ml

@@ -0,0 +1,14 @@
+open Stdune
+
+let dir = Temp.create Dir ~prefix:"copyfile" ~suffix:"bench"
+
+let contents = String.make 50_000 '0'
+
+let () =
+  let src = Path.relative dir "initial" in
+  Io.write_file (Path.relative dir "initial") contents;
+  let chmod _ = 444 in
+  for i = 1 to 10_000 do
+    let dst = Path.relative dir (sprintf "dst-%d" i) in
+    Io.copy_file ~chmod ~src ~dst ()
+  done

bench/micro/dune

@@ -1,3 +1,8 @@
+(executable
+ (name copyfile)
+ (modules copyfile)
+ (libraries stdune))
+
 (executable
  (name main)
  (modules main)

otherlibs/stdune/src/copyfile_stubs.c

@@ -0,0 +1,69 @@
+#include <caml/fail.h>
+#include <caml/memory.h>
+#include <caml/mlvalues.h>
+
+#if defined(__APPLE__)
+#define _DARWIN_C_SOURCE
+
+#include <caml/alloc.h>
+#include <caml/threads.h>
+#include <caml/unixsupport.h>
+
+#include <copyfile.h>
+#include <errno.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);
+  caml_unix_check_path(v_from, "copyfile");
+  caml_unix_check_path(v_to, "copyfile");
+  char from[PATH_MAX];
+  char to[PATH_MAX];
+  char real_from[PATH_MAX];
+  int from_len = caml_string_length(v_from);
+  int to_len = caml_string_length(v_to);
+  memcpy(from, String_val(v_from), from_len);
+  memcpy(to, String_val(v_to), to_len);
+  from[from_len] = '\0';
+  to[to_len] = '\0';
+
+  caml_release_runtime_system();
+  /* clonefile doesn't follow symlinks automatically */
+  char *realpath_result = realpath(from, real_from);
+  if (realpath_result == NULL) {
+    caml_acquire_runtime_system();
+    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);
+  }
+  ret = copyfile(real_from, to, NULL, COPYFILE_CLONE);
+  caml_acquire_runtime_system();
+  if (ret < 0) {
+    uerror("copyfile", v_to);
+  }
+  CAMLreturn(Val_unit);
+}
+
+CAMLprim value stdune_is_darwin(value v_unit) {
+  CAMLparam1(v_unit);
+  CAMLreturn(Val_true);
+}
+
+#else
+
+CAMLprim value stdune_copyfile(value v_from, value v_to) {
+  caml_failwith("copyfile: only on macos");
+}
+
+CAMLprim value stdune_is_darwin(value v_unit) {
+  CAMLparam1(v_unit);
+  CAMLreturn(Val_false);
+}
+
+#endif

otherlibs/stdune/src/dune

@@ -12,6 +12,6 @@
   (re_export dune_filesystem_stubs))
  (foreign_stubs
   (language c)
-  (names wait3_stubs))
+  (names wait3_stubs copyfile_stubs))
  (instrumentation
   (backend bisect_ppx)))

otherlibs/stdune/src/io.ml

@@ -248,10 +248,39 @@ struct
     in
     (ic, oc)
 
+  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 available : unit -> bool = "stdune_is_darwin"
+  end
+
   let copy_file ?chmod ~src ~dst () =
     Exn.protectx (setup_copy ?chmod ~src ~dst ()) ~finally:close_both
       ~f:(fun (ic, oc) -> copy_channels ic oc)
 
+  let copy_file =
+    match Copyfile.available () with
+    | false -> copy_file
+    | true -> (
+      fun ?chmod ~src ~dst () ->
+        let src = Path.to_string src in
+        let dst = Path.to_string dst in
+        (try Copyfile.copyfile src dst with
+        | Unix.Unix_error (Unix.EPERM, "unlink", _) ->
+          let message = Printf.sprintf "%s: Is a directory" dst in
+          raise (Sys_error message)
+        | Unix.Unix_error (Unix.ENOENT, "realpath", _) ->
+          let message =
+            Printf.sprintf "error: %s: No such file or directory" src
+          in
+          raise (Sys_error message));
+        match chmod with
+        | None -> ()
+        | Some chmod -> (Unix.stat src).st_perm |> chmod |> Unix.chmod dst)
+
   let file_line path n =
     with_file_in ~binary:false path ~f:(fun ic ->
         for _ = 1 to n - 1 do