Skip to content

Commit

Permalink
Use accelerated file copy functions, if supported
Browse files Browse the repository at this point in the history
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)
 * sendfile(2) on Linux (kernel >= 2.2) and sendfile(3ext) on Solaris

Fallback to read-write loop is used if none of the above are available
or supported by the filesystem.
  • Loading branch information
tleedjarv committed Aug 20, 2021
1 parent 23cfae9 commit aca4da5
Show file tree
Hide file tree
Showing 4 changed files with 264 additions and 4 deletions.
9 changes: 7 additions & 2 deletions src/Makefile.OCaml
Original file line number Diff line number Diff line change
Expand Up @@ -102,6 +102,8 @@ buildexecutable::
# Generate backtrace information for exceptions
CAMLFLAGS+=-g

CCFLAGS+=-ccopt -D_FILE_OFFSET_BITS=64

INCLFLAGS=-I lwt -I ubase -I system
DEP_INCLFLAGS=-I lwt -I ubase -I system
CAMLFLAGS+=$(INCLFLAGS)
Expand Down Expand Up @@ -145,6 +147,9 @@ else
CLIBS+=-cclib -lutil
endif
endif
ifeq ($(OSARCH),solaris)
CLIBS+=-cclib -lsendfile
endif
buildexecutable::
@echo Building for Unix
endif
Expand Down Expand Up @@ -226,7 +231,7 @@ OCAMLOBJS+=main.cmo
# File extensions will be substituted for the native code version
OCAMLLIBS+=unix.cma str.cma bigarray.cma

COBJS+=osxsupport$(OBJ_EXT) pty$(OBJ_EXT) bytearray_stubs$(OBJ_EXT) hash_compat$(OBJ_EXT)
COBJS+=osxsupport$(OBJ_EXT) pty$(OBJ_EXT) bytearray_stubs$(OBJ_EXT) hash_compat$(OBJ_EXT) copy_stubs$(OBJ_EXT)

########################################################################
### User Interface setup
Expand Down Expand Up @@ -432,7 +437,7 @@ fswatch.cmi : ubase/prefs.cmi

%.o %.obj: %.c
@echo "$(CAMLC): $< ---> $@"
$(CAMLC) $(CAMLFLAGS) -ccopt $(OUTPUT_SEL)$(CWD)/$@ -c $(CWD)/$<
$(CAMLC) $(CAMLFLAGS) $(CCFLAGS) -ccopt $(OUTPUT_SEL)$(CWD)/$@ -c $(CWD)/$<

$(NAME)$(EXEC_EXT): $(CAMLOBJS) $(COBJS)
@echo Linking $@
Expand Down
60 changes: 59 additions & 1 deletion src/copy.ml
Original file line number Diff line number Diff line change
Expand Up @@ -280,15 +280,73 @@ let setFileinfo fspathTo pathTo realPathTo update desc =

(****)

(* [unsn_clone_path] does not raise exceptions. *)
external clone_path : string -> string -> bool = "unsn_clone_path"
(* [unsn_clone_file] does not raise exceptions. *)
external clone_file : Unix.file_descr -> Unix.file_descr -> bool = "unsn_clone_file"
external copy_file : Unix.file_descr -> Unix.file_descr -> int64
-> int -> int = "unsn_copy_file"

let copyByPath fspathFrom pathFrom fspathTo pathTo =
clone_path
(Fspath.toString (Fspath.concat fspathFrom pathFrom))
(Fspath.toString (Fspath.concat fspathTo pathTo))

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 offs len notify =
let open Uutil in
if len > Filesize.zero then
let n = copy_file src dst (Filesize.toInt64 offs)
(copy_size (Filesize.toInt64 len)) in
let () = notify n in
if n > 0 then
let n' = Filesize.ofInt n in
copyFileAux src dst (Filesize.add offs n') (Filesize.sub len n') notify

let copyFileRange src dst offs len fallback notify =
try
copyFileAux src dst offs len notify
with
| Unix.Unix_error ((EINVAL | ENOSYS | EBADF | EXDEV
| ESPIPE | ENOTSOCK | EOPNOTSUPP), _, _)
| Unix.Unix_error (EUNKNOWNERR -1, _, _) ->
(* These errors 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.
Fallback to read-write loop expects that seek positions in
input and output fds have not changed. *)
fallback notify

let copyFile inCh outCh kind len fallback notify =
let src = Unix.descr_of_in_channel inCh
and dst = Unix.descr_of_out_channel outCh in
if kind = `DATA && clone_file src dst then
notify (Uutil.Filesize.toInt len)
else
match kind with
| `DATA -> copyFileRange src dst Uutil.Filesize.zero len fallback notify
| `DATA_APPEND offs -> copyFileRange src dst offs len fallback notify
| `RESS -> fallback notify

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
let fallback = Uutil.readWriteBounded inFd outFd fileLength in
copyFile inFd outFd fileKind fileLength fallback
(fun l ->
use_id (fun id ->
(* (Util.msg "Copied file %s (%d bytes)\n" (Path.toString pathFrom) l); *)
Expand Down
197 changes: 197 additions & 0 deletions src/copy_stubs.c
Original file line number Diff line number Diff line change
@@ -0,0 +1,197 @@
/* Unison file synchronizer: src/copy_stubs.c */
/* Copyright 2021, 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 <http://www.gnu.org/licenses/>.
*/

#include <caml/memory.h>
#include <caml/mlvalues.h>
#include <caml/threads.h>
#include <caml/unixsupport.h>

#include <errno.h>


/* ----------------------------------------------- */
/* Clone a file given source and destination paths */
/* It must fully complete or fully fail. */

#if defined(__APPLE__)


#include <AvailabilityMacros.h>

#if defined(MAC_OS_X_VERSION_10_12)
#include <string.h>
#include <sys/attr.h>
#include <sys/clonefile.h>

CAMLprim value unsn_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 unsn_clone_path(value src, value dst)
{
CAMLparam2(src, dst);
CAMLreturn(Val_false);
}
#endif /* MAC_OS_X_VERSION_10_12 */


#else /* defined(__APPLE__) */


CAMLprim value unsn_clone_path(value src, value dst)
{
CAMLparam2(src, dst);
CAMLreturn(Val_false);
}


#endif /* defined(__APPLE__) */


/* ----------------------------------------------- */
/* Clone a file given input and output fd */
/* It must fully complete or fully fail. */

#if defined(__linux__) || defined(__linux)


#include <sys/ioctl.h>

#if !defined(FICLONE) && defined(_IOW)
#define FICLONE _IOW(0x94, 9, int)
#endif

CAMLprim value unsn_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 unsn_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. */

#if defined(__linux__) || defined(__linux)


#include <unistd.h>
#include <sys/syscall.h>
#include <sys/sendfile.h>

CAMLprim value unsn_copy_file(value in_fd, value out_fd, value offs, value len)
{
CAMLparam4(in_fd, out_fd, offs, len);
off_t off_i = Int64_val(offs);
ssize_t ret;

caml_release_runtime_system();
#ifdef __NR_copy_file_range
/* First, try copy_file_range() */
/* Using off_i and off_o prevents changing in_fd and out_fd file offsets */
off_t off_o = Int64_val(offs);
ret = syscall(__NR_copy_file_range, Int_val(in_fd), &off_i, Int_val(out_fd), &off_o, 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) uerror("copy_file", Nothing);

CAMLreturn(Val_long(ret));
}


#elif defined(__sun) || defined(sun)


#include <sys/sendfile.h>

CAMLprim value unsn_copy_file(value in_fd, value out_fd, value offs, value len)
{
CAMLparam4(in_fd, out_fd, offs, len);
off_t off = Int64_val(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 > Int64_val(offs)) {
ret = off - Int64_val(offs);
} else {
uerror("copy_file", Nothing);
}
}

CAMLreturn(Val_long(ret));
}


#else /* defined(__linux__) || defined(__sun) */


CAMLprim value unsn_copy_file(value in_fd, value out_fd, value offs, value len)
{
CAMLparam4(in_fd, out_fd, offs, len);
unix_error(ENOSYS, "copy_file", Nothing);
CAMLreturn(Val_long(0));
}


#endif /* defined(__linux__) || defined (__sun) */
2 changes: 1 addition & 1 deletion src/dune
Original file line number Diff line number Diff line change
Expand Up @@ -7,7 +7,7 @@
-w -3-6-9-10-26-27-32-34-35-38-39-50-52
-warn-error -3-6-9-10-26-27-32-34-35-39-50-52
-no-strict-sequence)
(c_names bytearray_stubs osxsupport pty hash_compat)
(c_names bytearray_stubs osxsupport pty hash_compat copy_stubs)
(c_library_flags -lutil)
(libraries str unix lwt_lib bigarray))

Expand Down

0 comments on commit aca4da5

Please sign in to comment.