From 71006618d1fbaa5f2c7f7c15835657b1bed93dd6 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?T=C3=B5ivo=20Leedj=C3=A4rv?=
<69477666+tleedjarv@users.noreply.github.com>
Date: Wed, 18 Aug 2021 20:51:34 +0200
Subject: [PATCH] Use accelerated file copy functions, if supported
This patch makes use of various platform- and filesystem-specific
syscalls to accelerate local file copies.
The following syscalls are tried:
* clonefile(2) on macOS (version >= 10.12)
* ioctl FICLONE on Linux (kernel >= 4.5)
(also BTRFS_IOC_CLONE since Linux 2.6.29(?) should work)
* copy_file_range(2) on Linux (kernel >= 4.5) and FreeBSD >= 13
* sendfile(2) on Linux (kernel >= 2.2) and sendfile(3ext) on Solaris
* ioctl FSCTL_DUPLICATE_EXTENTS_TO_FILE on Windows (since Windows
Server 2016 and at least Windows 11 (likely Windows 10))
Fallback to read-write loop is used if none of the above are available
or supported by the filesystem.
---
src/Makefile.OCaml | 2 +-
src/copy.ml | 93 ++++++-
src/copy_stubs.c | 445 +++++++++++++++++++++++++++++++++
src/dune | 2 +-
src/fs.ml | 6 +
src/fsmonitor/windows/Makefile | 2 +-
src/make_tools.ml | 8 +-
src/system/system_generic.ml | 8 +
src/system/system_intf.ml | 10 +
9 files changed, 569 insertions(+), 7 deletions(-)
create mode 100644 src/copy_stubs.c
diff --git a/src/Makefile.OCaml b/src/Makefile.OCaml
index f959047e9..3e96698ac 100644
--- a/src/Makefile.OCaml
+++ b/src/Makefile.OCaml
@@ -87,7 +87,7 @@ OCAMLINCLUDES = -I +unix -I +str
# C objects for both bytecode and native versions
COBJS = osxsupport$(OBJ_EXT) pty$(OBJ_EXT) bytearray_stubs$(OBJ_EXT) \
hash_compat$(OBJ_EXT) props_xattr$(OBJ_EXT) props_acl$(OBJ_EXT) \
- $(WINCOBJS)
+ copy_stubs$(OBJ_EXT) $(WINCOBJS)
####################################################################
### User Interface setup
diff --git a/src/copy.ml b/src/copy.ml
index e463fea51..db5ff306a 100644
--- a/src/copy.ml
+++ b/src/copy.ml
@@ -415,6 +415,86 @@ let readPropsExtDataG root path desc =
(****)
+let copy_size l =
+ let def = 10_485_760L in (* 10 MiB, to get periodic progress feedback *)
+ Int64.to_int @@
+ if Int64.compare l def > 0 then def else l
+
+let rec copyFileAux src dst src_offs len notify =
+ let open Uutil in
+ if len > Filesize.zero then begin
+ let n = Fs.copy_file src dst (Filesize.toInt64 src_offs)
+ (copy_size (Filesize.toInt64 len)) in
+ let n' = Filesize.ofInt n in
+ let () = notify n' in
+ if n > 0 then
+ copyFileAux src dst (Filesize.add src_offs n') (Filesize.sub len n') notify
+ end
+
+let copyFileRange src dst src_offs len fallback notify =
+ let bytesCopied = ref Uutil.Filesize.zero in
+ let copied n =
+ bytesCopied := Uutil.Filesize.add !bytesCopied n;
+ notify n
+ in
+ try
+ copyFileAux src dst src_offs len copied
+ with
+ | Unix.Unix_error ((EINVAL | ENOSYS | EBADF | EXDEV
+ | ESPIPE | ENOTSOCK | EOPNOTSUPP) as err, _, _)
+ | Unix.Unix_error (EUNKNOWNERR -50 (* ERROR_NOT_SUPPORTED *) as err, _, _)
+ | Unix.Unix_error (EUNKNOWNERR -1 as err, _, _)
+ (* The errors above are not expected in the middle of a copy; these
+ indicate that [copy_file] is not supported at all (by the OS or
+ by the filesystem, or for these specific files) and nothing
+ has been copied so far, which makes fallback straight-forward.
+ However, this can't be relied upon. While expected extremely rarely,
+ failure after partial success is to be expected and fallback routine
+ must be able to handle this; so all errors are handled the same. *)
+ | Unix.Unix_error (err, _, _) ->
+ debug (fun () -> Util.msg
+ "Falling back to regular copy: copyFileRange failed [%s]%s\n"
+ (Unix.error_message err)
+ (if !bytesCopied = Uutil.Filesize.zero then "" else
+ " (copied " ^ (Uutil.Filesize.toString !bytesCopied) ^ ")"));
+ fallback !bytesCopied
+
+let copyFile inCh outCh kind len fallback notify =
+ (* Flush the buffered output channel just in case since we're going to
+ manipulate the channel's underlying fd directly. *)
+ flush outCh;
+ let src = Unix.descr_of_in_channel inCh
+ and dst = Unix.descr_of_out_channel outCh in
+ if kind = `DATA && Fs.clone_file src dst then
+ notify len
+ else
+ let tryCopyFileRange src dst src_offs len fallback notify =
+ let fallback' copied =
+ (* Fallback to read-write loop expects that seek positions in input
+ and output fds have not changed. By invariant, if [copyFileRange]
+ succeeded partially then the seek position of output fd was updated
+ accordingly. To not break fallback, the seek position of input fd
+ must be updated by the same amount. *)
+ let open Uutil in
+ if copied <> Filesize.zero then begin
+ let pos =
+ Int64.add (Filesize.toInt64 src_offs) (Filesize.toInt64 copied) in
+ LargeFile.seek_in inCh pos
+ end;
+ fallback ()
+ in
+ copyFileRange src dst src_offs len fallback' notify
+ in
+ match kind with
+ | `DATA -> tryCopyFileRange src dst Uutil.Filesize.zero len fallback notify
+ | `DATA_APPEND offs -> tryCopyFileRange src dst offs len fallback notify
+ | `RESS -> fallback ()
+
+let copyByPath fspathFrom pathFrom fspathTo pathTo =
+ Fs.clone_path
+ (Fspath.concat fspathFrom pathFrom)
+ (Fspath.concat fspathTo pathTo)
+
(* The fds opened in this function normally shouldn't be tracked for extra
cleanup at connection close because this is sequential non-Lwt code. Yet,
there is a risk that code called by [Uutil.showProgress] may include Lwt
@@ -423,18 +503,25 @@ let readPropsExtDataG root path desc =
[closeFile*] functions). *)
let copyContents fspathFrom pathFrom fspathTo pathTo fileKind fileLength ido =
let use_id f = match ido with Some id -> f id | None -> () in
+ if fileKind = `DATA && copyByPath fspathFrom pathFrom fspathTo pathTo then
+ use_id (fun id -> Uutil.showProgress id fileLength "l")
+ else
+ (* Open fds only if copying by path did not work *)
let inFd = openFileIn fspathFrom pathFrom fileKind in
protect
(fun () ->
let outFd = openFileOut fspathTo pathTo fileKind fileLength in
protect
(fun () ->
- Uutil.readWriteBounded inFd outFd fileLength
- (fun l ->
+ let showProgress l =
use_id (fun id ->
(* (Util.msg "Copied file %s (%d bytes)\n" (Path.toString pathFrom) l); *)
if fileKind <> `RESS then Abort.checkAll ();
- Uutil.showProgress id (Uutil.Filesize.ofInt l) "l"));
+ Uutil.showProgress id l "l")
+ in
+ let fallback () = Uutil.readWriteBounded inFd outFd fileLength
+ (fun l -> showProgress (Uutil.Filesize.ofInt l)) in
+ copyFile inFd outFd fileKind fileLength fallback showProgress;
closeFileIn inFd;
closeFileOut outFd;
(* ignore (Sys.command ("ls -l " ^ (Fspath.toString (Fspath.concat fspathTo pathTo)))) *)
diff --git a/src/copy_stubs.c b/src/copy_stubs.c
new file mode 100644
index 000000000..217cfd680
--- /dev/null
+++ b/src/copy_stubs.c
@@ -0,0 +1,445 @@
+/* Unison file synchronizer: src/copy_stubs.c */
+/* Copyright 2021-2025, Tõivo Leedjärv
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation, either version 3 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program. If not, see .
+*/
+
+#include
+#include
+#include
+#include
+
+#if OCAML_VERSION_MAJOR < 5
+#define caml_unix_error unix_error
+#define caml_uerror uerror
+#define caml_win32_maperr win32_maperr
+#endif
+
+
+#include
+
+
+/* ----------------------------------------------- */
+/* Clone a file given source and destination paths */
+/* It must fully complete or fully fail.
+
+ The function must not raise any exceptions.
+
+ Return true for success and false for failure
+ or if the operation is not supported. */
+
+#if defined(__APPLE__)
+
+
+#include
+
+#if defined(MAC_OS_X_VERSION_10_12)
+#include
+#include
+#include
+
+CAMLprim value unison_clone_path(value src, value dst)
+{
+ CAMLparam2(src, dst);
+ char *srcn, *dstn;
+ int status;
+
+ srcn = strdup(String_val(src));
+ dstn = strdup(String_val(dst));
+ caml_release_runtime_system();
+ status = clonefile(srcn, dstn, CLONE_NOFOLLOW | CLONE_NOOWNERCOPY);
+ free(srcn);
+ free(dstn);
+ caml_acquire_runtime_system();
+
+ /* Don't raise an exception, just return false in case of errors */
+ CAMLreturn(Val_bool(status == 0));
+}
+#else /* MAC_OS_X_VERSION_10_12 */
+CAMLprim value unison_clone_path(value src, value dst)
+{
+ CAMLparam2(src, dst);
+ CAMLreturn(Val_false);
+}
+#endif /* MAC_OS_X_VERSION_10_12 */
+
+
+#else /* defined(__APPLE__) */
+
+
+CAMLprim value unison_clone_path(value src, value dst)
+{
+ CAMLparam2(src, dst);
+ CAMLreturn(Val_false);
+}
+
+/* Regarding Windows API: The CopyFile function in Windows API can do file
+ * clones under right conditions. Nevertheless, we can't use that function
+ * since it is not possible to explicitly request cloning (it is possible to
+ * check whether block cloning is supported (see [unison_copy_file]) but it is
+ * not a guarantee that the CopyFile function will actually result in a
+ * cloning operation) and the function will fall back to a normal copy, which
+ * we do not want in this case (even though performance-wise it would be more
+ * like sendfile). */
+
+#endif /* defined(__APPLE__) */
+
+
+/* ----------------------------------------------- */
+/* Clone a file given input and output fd */
+/* It must fully complete or fully fail.
+
+ The function must not raise any exceptions.
+
+ Return true for success and false for failure
+ or if the operation is not supported. */
+
+#if defined(__linux__) || defined(__linux)
+
+
+#include
+
+#if !defined(FICLONE) && defined(_IOW)
+#define FICLONE _IOW(0x94, 9, int)
+#endif
+
+CAMLprim value unison_clone_file(value in_fd, value out_fd)
+{
+ CAMLparam2(in_fd, out_fd);
+
+#ifdef FICLONE
+ caml_release_runtime_system();
+ int status = ioctl(Int_val(out_fd), FICLONE, Int_val(in_fd));
+ caml_acquire_runtime_system();
+
+ /* Don't raise an exception, just return false in case of errors */
+ CAMLreturn(Val_bool(status == 0));
+#else /* defined(FICLONE) */
+ CAMLreturn(Val_false);
+#endif
+}
+
+
+#else /* defined(__linux__) */
+
+
+CAMLprim value unison_clone_file(value in_fd, value out_fd)
+{
+ CAMLparam2(in_fd, out_fd);
+ CAMLreturn(Val_false);
+}
+
+
+#endif /* defined(__linux__) */
+
+
+/* --------------------------------------------------------- */
+/* Copy, or possibly clone, a file given input and output fd */
+/* If operation is not supported by the OS or the filesystem
+ then file offsets must not have been changed at failure.
+ Output file offset must be changed on success.
+
+ The function must return the number of bytes copied.
+
+ On any error, raise a Unix exception based on errno.
+ Raise ENOSYS if the operation is not supported. */
+
+#if defined(__linux__) || defined(__linux)
+
+
+#include
+#include
+#include
+
+CAMLprim value unison_copy_file(value in_fd, value out_fd, value in_offs, value len)
+{
+ CAMLparam4(in_fd, out_fd, in_offs, len);
+ off_t off_i = Int64_val(in_offs);
+ ssize_t ret;
+
+ caml_release_runtime_system();
+#ifdef __NR_copy_file_range
+ /* First, try copy_file_range() */
+ /* Using off_i prevents changing in_fd file offset */
+ ret = syscall(__NR_copy_file_range, Int_val(in_fd), &off_i, Int_val(out_fd), NULL, Long_val(len), 0);
+ if (ret == -1 && (errno == ENOSYS || errno == EBADF || errno == EXDEV))
+#endif /* defined(__NR_copy_file_range) */
+ {
+ /* Second, try sendfile(); this one changes out_fd file offset */
+ ret = sendfile(Int_val(out_fd), Int_val(in_fd), &off_i, Long_val(len));
+ }
+ caml_acquire_runtime_system();
+ if (ret == -1) caml_uerror("copy_file", Nothing);
+
+ CAMLreturn(Val_long(ret));
+}
+
+
+#elif defined(__FreeBSD__)
+
+#include
+#include
+#include
+
+CAMLprim value unison_copy_file(value in_fd, value out_fd, value in_offs, value len)
+{
+ CAMLparam4(in_fd, out_fd, in_offs, len);
+#if __FreeBSD_version >= 1300037
+ off_t off_i = Int64_val(in_offs);
+ ssize_t ret;
+
+ caml_release_runtime_system();
+ /* Using off_i prevents changing in_fd file offset */
+ ret = copy_file_range(Int_val(in_fd), &off_i, Int_val(out_fd), NULL, Long_val(len), 0);
+ caml_acquire_runtime_system();
+ if (ret == -1) caml_uerror("copy_file", Nothing);
+
+ CAMLreturn(Val_long(ret));
+#else /* __FreeBSD_version >= 1300037 */
+ caml_unix_error(ENOSYS, "copy_file", Nothing);
+ CAMLreturn(Val_long(0));
+#endif /* __FreeBSD_version >= 1300037 */
+}
+
+
+#elif defined(__sun) || defined(sun)
+
+
+#include
+
+CAMLprim value unison_copy_file(value in_fd, value out_fd, value in_offs, value len)
+{
+ CAMLparam4(in_fd, out_fd, in_offs, len);
+ off_t off_orig;
+ off_t off = off_orig = Int64_val(in_offs);
+ ssize_t ret;
+
+ caml_release_runtime_system();
+ /* This one changes out_fd file offset */
+ ret = sendfile(Int_val(out_fd), Int_val(in_fd), &off, Long_val(len));
+ caml_acquire_runtime_system();
+ if (ret == -1) {
+ if (off > off_orig) {
+ ret = off - off_orig;
+ } else {
+ caml_uerror("copy_file", Nothing);
+ }
+ }
+
+ CAMLreturn(Val_long(ret));
+}
+
+
+#elif defined(_WIN32)
+
+
+#ifndef UNICODE
+#define UNICODE
+#endif
+#ifndef _UNICODE
+#define _UNICODE
+#endif
+
+#include
+#include
+
+#if defined(__MINGW32__)
+
+/* FIXME: As of January 2025, mingw has does not include type definitions for
+ * FSCTL_GET_INTEGRITY_INFORMATION_BUFFER and DUPLICATE_EXTENTS_DATA (but does
+ * include the definitions of FSCTL constants). If you get a compilation error
+ * about "type redefinition" or similar, just remove the typedefs below. */
+
+#ifndef FILE_SUPPORTS_BLOCK_REFCOUNTING
+#define FILE_SUPPORTS_BLOCK_REFCOUNTING 0x08000000
+#endif
+
+#ifndef FSCTL_GET_INTEGRITY_INFORMATION
+#define FSCTL_GET_INTEGRITY_INFORMATION 0x9027c
+#endif
+
+typedef struct _FSCTL_GET_INTEGRITY_INFORMATION_BUFFER {
+ WORD ChecksumAlgorithm;
+ WORD Reserved;
+ DWORD Flags;
+ DWORD ChecksumChunkSizeInBytes;
+ DWORD ClusterSizeInBytes;
+} FSCTL_GET_INTEGRITY_INFORMATION_BUFFER;
+
+#ifndef FSCTL_DUPLICATE_EXTENTS_TO_FILE
+#define FSCTL_DUPLICATE_EXTENTS_TO_FILE 0x98344
+#endif
+
+typedef struct _DUPLICATE_EXTENTS_DATA {
+ HANDLE FileHandle;
+ LARGE_INTEGER SourceFileOffset;
+ LARGE_INTEGER TargetFileOffset;
+ LARGE_INTEGER ByteCount;
+} DUPLICATE_EXTENTS_DATA;
+
+#endif /* defined(__MINGW32__) */
+
+void unsn_copy_file_error(void)
+{
+ caml_win32_maperr(GetLastError());
+ caml_uerror("copy_file", Nothing);
+}
+
+BOOL unsn_copy_file_supports_cloning(HANDLE h)
+{
+ DWORD flags = 0;
+ return
+ (GetVolumeInformationByHandleW(h, NULL, 0, NULL, NULL, &flags, NULL, 0)
+ && (flags & FILE_SUPPORTS_BLOCK_REFCOUNTING));
+ }
+
+void unsn_copy_file_set_sparse(HANDLE h, BOOL sparse)
+{
+ FILE_SET_SPARSE_BUFFER sp;
+ sp.SetSparse = sparse;
+ if (!DeviceIoControl(h, FSCTL_SET_SPARSE, &sp, sizeof(sp),
+ NULL, 0, NULL, NULL)) {
+ unsn_copy_file_error();
+ }
+}
+
+BOOL unsn_copy_file_get_sparse(HANDLE h)
+{
+ FILE_BASIC_INFO info;
+ if (!GetFileInformationByHandleEx(h, FileBasicInfo, &info, sizeof(info))) {
+ unsn_copy_file_error();
+ }
+ return (info.FileAttributes & FILE_ATTRIBUTE_SPARSE_FILE) != 0;
+}
+
+BOOL unsn_copy_file_api_checked = FALSE;
+BOOL unsn_copy_file_api_available = FALSE;
+
+CAMLprim value unison_copy_file(value in_fd, value out_fd, value in_offs, value len)
+{
+ CAMLparam4(in_fd, out_fd, in_offs, len);
+
+ if (!unsn_copy_file_api_checked) {
+ unsn_copy_file_api_checked = TRUE;
+ unsn_copy_file_api_available =
+ GetProcAddress(GetModuleHandleW(L"kernel32.dll"),
+ "GetVolumeInformationByHandleW") != NULL;
+ }
+ if (!unsn_copy_file_api_available) {
+ caml_unix_error(ENOSYS, "copy_file", Nothing);
+ }
+
+ HANDLE hin = Handle_val(in_fd);
+ HANDLE hout = Handle_val(out_fd);
+
+ if (!unsn_copy_file_supports_cloning(hout)
+ || !unsn_copy_file_supports_cloning(hin)) {
+ caml_unix_error(ENOSYS, "copy_file", Nothing);
+ }
+
+ /* INTEGRITY_INFORMATION contains information about fs cluster size. We make
+ * the assumption that both the source and destination have the same cluster
+ * size (From MSDN: The source and destination files must be on the same ReFS
+ * volume.). */
+ FSCTL_GET_INTEGRITY_INFORMATION_BUFFER intgrty;
+ if (!DeviceIoControl(hin, FSCTL_GET_INTEGRITY_INFORMATION,
+ NULL, 0, &intgrty, sizeof(intgrty), NULL, NULL)) {
+ unsn_copy_file_error();
+ }
+
+ DUPLICATE_EXTENTS_DATA dupl;
+ dupl.FileHandle = hin;
+ dupl.SourceFileOffset.QuadPart = Int64_val(in_offs);
+ if (!SetFilePointerEx(hout, (LARGE_INTEGER){0}, &dupl.TargetFileOffset,
+ FILE_CURRENT)) {
+ unsn_copy_file_error();
+ }
+
+ /* From MSDN: The source and destination regions must begin and end at
+ * a cluster boundary. */
+ if ((dupl.SourceFileOffset.QuadPart % intgrty.ClusterSizeInBytes != 0)
+ || (dupl.TargetFileOffset.QuadPart % intgrty.ClusterSizeInBytes != 0)) {
+ /* FSCTL_DUPLICATE_EXTENTS_TO_FILE would fail anyway if this didn't hold,
+ * but this way we can bail out earlier. */
+ caml_unix_error(EINVAL, "copy_file", Nothing);
+ }
+ dupl.ByteCount.QuadPart = Long_val(len) +
+ intgrty.ClusterSizeInBytes - (Long_val(len) % intgrty.ClusterSizeInBytes);
+
+ /* From MSDN: If the source file is sparse, the destination file must also be
+ * sparse. */
+ BOOL in_is_sparse = unsn_copy_file_get_sparse(hin);
+ BOOL out_is_sparse = unsn_copy_file_get_sparse(hout);
+ /* Based on the wording in MSDN, it is ok if the destination file is sparse
+ * and the source is not, the opposite is not. */
+ if (in_is_sparse && !out_is_sparse) {
+ unsn_copy_file_set_sparse(hout, TRUE);
+ }
+
+ /* From MSDN: The destination region must not extend past the end of file. */
+ LARGE_INTEGER newTargetLen;
+ newTargetLen.QuadPart = dupl.TargetFileOffset.QuadPart + Long_val(len);
+ FILE_STANDARD_INFO fi;
+ if (!GetFileInformationByHandleEx(hout, FileStandardInfo, &fi, sizeof(fi))) {
+ unsn_copy_file_error();
+ }
+ if (fi.EndOfFile.QuadPart < newTargetLen.QuadPart) {
+ /* We want to avoid allocating on disk when extending the file. Make the
+ * destination file temporarily sparse, if it's not already. */
+ if (!out_is_sparse && !in_is_sparse) {
+ unsn_copy_file_set_sparse(hout, TRUE);
+ }
+ FILE_END_OF_FILE_INFO eofi;
+ eofi.EndOfFile = newTargetLen;
+ if (!SetFileInformationByHandle(hout, FileEndOfFileInfo, &eofi, sizeof(eofi))) {
+ unsn_copy_file_error();
+ }
+ /* The destination file was set to sparse when extending it; revert the
+ * sparse status. */
+ if (!out_is_sparse && !in_is_sparse) {
+ unsn_copy_file_set_sparse(hout, FALSE);
+ }
+ }
+
+ caml_release_runtime_system();
+ BOOL res = DeviceIoControl(hout, FSCTL_DUPLICATE_EXTENTS_TO_FILE,
+ &dupl, sizeof(dupl), NULL, 0, NULL, NULL);
+ caml_acquire_runtime_system();
+ if (!res) {
+ unsn_copy_file_error();
+ } else {
+ /* FSCTL_DUPLICATE_EXTENTS_TO_FILE does not advance the destination file
+ * offset. */
+ LARGE_INTEGER copied;
+ copied.QuadPart = Long_val(len);
+ if (!SetFilePointerEx(hout, copied, NULL, FILE_CURRENT)) {
+ unsn_copy_file_error();
+ }
+ }
+
+ CAMLreturn(len);
+}
+
+#else /* defined(__linux__) || defined(__FreeBSD__) || defined(__sun) || defined(_WIN32) */
+
+
+CAMLprim value unison_copy_file(value in_fd, value out_fd, value in_offs, value len)
+{
+ CAMLparam4(in_fd, out_fd, in_offs, len);
+ caml_unix_error(ENOSYS, "copy_file", Nothing);
+ CAMLreturn(Val_long(0));
+}
+
+
+#endif /* defined(__linux__) || defined(__FreeBSD__) || defined (__sun) || defined(_WIN32) */
diff --git a/src/dune b/src/dune
index a8ee5c4e1..5c53b469b 100644
--- a/src/dune
+++ b/src/dune
@@ -9,7 +9,7 @@
-no-strict-sequence)
(foreign_stubs
(language c)
- (names bytearray_stubs osxsupport pty hash_compat props_xattr props_acl))
+ (names bytearray_stubs osxsupport pty hash_compat props_xattr props_acl copy_stubs))
(c_library_flags -lutil)
(libraries str unix lwt_lib bigarray))
diff --git a/src/fs.ml b/src/fs.ml
index 071807941..8dc4c1b49 100644
--- a/src/fs.ml
+++ b/src/fs.ml
@@ -68,6 +68,12 @@ let file_exists f =
(****)
+let clone_path f1 f2 = System.clone_path (path f1) (path f2)
+let clone_file = System.clone_file
+let copy_file = System.copy_file
+
+(****)
+
exception XattrNotSupported = System.XattrNotSupported
let xattr_list f = System.xattr_list (path f)
diff --git a/src/fsmonitor/windows/Makefile b/src/fsmonitor/windows/Makefile
index 80d5b66f1..fba552e25 100644
--- a/src/fsmonitor/windows/Makefile
+++ b/src/fsmonitor/windows/Makefile
@@ -9,7 +9,7 @@ FSMOCAMLOBJS = \
FSMCOBJS = \
bytearray_stubs$(OBJ_EXT) \
system/system_win_stubs$(OBJ_EXT) lwt/lwt_unix_stubs$(OBJ_EXT) \
- props_xattr$(OBJ_EXT) props_acl$(OBJ_EXT)
+ props_xattr$(OBJ_EXT) props_acl$(OBJ_EXT) copy_stubs$(OBJ_EXT)
FSMOCAMLLIBS=unix.cma
# Additional dependencies
diff --git a/src/make_tools.ml b/src/make_tools.ml
index b37fddef7..128918546 100644
--- a/src/make_tools.ml
+++ b/src/make_tools.ml
@@ -109,6 +109,11 @@ let () = if build_macGUI then outp "macuimaybe: macui"
(* Generate backtrace information for exceptions *)
let () = "CAMLFLAGS" <-+= "-g $(INCLFLAGS)"
+(* Use 64-bit file offset if possible (for copy_stubs.c). It is
+ included here unconditionally since OCaml itself has had this
+ defined unconditionally since 2002. *)
+let () = "CAMLCFLAGS" <-+= "-ccopt -D_FILE_OFFSET_BITS=64"
+
let () =
[
"CAMLCFLAGS", "CFLAGS", "-ccopt";
@@ -171,7 +176,8 @@ let () =
end;
if osarch = "SunOS" then begin
(* ACL functions *)
- "CLIBS" <-+= "-cclib -lsec"
+ "CLIBS" <-+= "-cclib -lsec";
+ "CLIBS" <-+= "-cclib -lsendfile";
end;
"building_for" <-- "Building for Unix";
end;
diff --git a/src/system/system_generic.ml b/src/system/system_generic.ml
index fd1a52c22..c248b7f23 100644
--- a/src/system/system_generic.ml
+++ b/src/system/system_generic.ml
@@ -66,6 +66,14 @@ let open_in_bin = open_in_bin
(****)
+external clone_path : string -> string -> bool = "unison_clone_path"
+external clone_file : Unix.file_descr -> Unix.file_descr -> bool =
+ "unison_clone_file"
+external copy_file : Unix.file_descr -> Unix.file_descr -> int64
+ -> int -> int = "unison_copy_file"
+
+(****)
+
let create_process = Unix.create_process
let open_process_in = Unix.open_process_in
let open_process_args_in = Unix.open_process_args_in
diff --git a/src/system/system_intf.ml b/src/system/system_intf.ml
index 7e76a5fbd..8e8bd5351 100644
--- a/src/system/system_intf.ml
+++ b/src/system/system_intf.ml
@@ -44,6 +44,16 @@ val file_exists : fspath -> bool
(****)
+(* [clone_path] does not raise exceptions. *)
+val clone_path : fspath -> fspath -> bool
+(* [clone_file] does not raise exceptions. *)
+val clone_file : Unix.file_descr -> Unix.file_descr -> bool
+(* [copy_file] updates destination file seek position if and only if
+ writing succeeded, returning the number of bytes written. *)
+val copy_file : Unix.file_descr -> Unix.file_descr -> int64 -> int -> int
+
+(****)
+
val hasInodeNumbers : unit -> bool
val hasSymlink : unit -> bool