Use accelerated copy functions with rsync

On filesystems that support block-level copy-on-write links (so-called
reflinks), the accelerated copy functions can be used by the rsync
algorithm to copy the unchanged data from the original file without
actually copying it.  If reflinks are not supported then an in-kernel
copy is attempted instead. Worst case, if this is not supported then
data will be copied as usual.

For large files with only few changes, this means the following (when
filesystem support exists):

 - syncing will be much faster; copying possibly gigabytes of
   data around can become almost free;

 - storage is only required for changed blocks; filesystem snapshots
   will record only changed blocks, as expected.

This is like rsync's --inplace but completely safe.

src/copy.ml

@@ -841,6 +841,14 @@ let transferFileContents
                   fspathTo pathTo fileKind srcFileSize outfd id in
               let eof =
                 Transfer.Rsync.rsyncDecompress blockSize ifd fd showProgress ti
+                  ~copyFn:(fun in_offs len ~fallback ->
+                    (* Flush the buffered output channel just in case since
+                       we manipulate the channel's underlying fd directly. *)
+                    flush fd;
+                    copyFileRange
+                      (Unix.descr_of_in_channel ifd)
+                      (Unix.descr_of_out_channel fd)
+                      in_offs len fallback (fun _ -> ()))
               in
               if eof then close_all infd outfd))
       else

src/transfer.ml

@@ -466,7 +466,7 @@ struct
 
   (* For each transfer instruction, either output a string or copy one or
      several blocks from the old file. *)
-  let rsyncDecompress blockSize infd outfd showProgress (data, pos, len) =
+  let rsyncDecompress blockSize infd outfd ?copyFn showProgress (data, pos, len) =
     let decomprBuf = Bytes.create decomprBufSize in
     let progress = ref 0 in
     let rec copy length =
@@ -478,10 +478,23 @@ struct
         let _ = reallyRead infd decomprBuf 0 length in
         reallyWrite outfd decomprBuf 0 length
     in
+    let copyBlocks' offs length =
+      LargeFile.seek_in infd offs;
+      copy length
+    in
     let copyBlocks n k =
-      LargeFile.seek_in infd (Int64.mul n (Int64.of_int blockSize));
+      let offs = Int64.mul n (Int64.of_int blockSize) in
       let length = k * blockSize in
-      copy length;
+      begin match copyFn with
+      | None -> copyBlocks' offs length
+      | Some f ->
+          let fallback copied =
+            let offs = Int64.add offs (Uutil.Filesize.toInt64 copied)
+            and length = length - (Uutil.Filesize.toInt copied) in
+            copyBlocks' offs length
+          in
+          f (Uutil.Filesize.ofInt64 offs) (Uutil.Filesize.ofInt length) ~fallback;
+      end;
       progress := !progress + length
     in
     let maxPos = pos + len in

src/transfer.mli

@@ -94,6 +94,13 @@ module Rsync :
            int                   (* block size *)
         -> in_channel            (* old file descriptor *)
         -> out_channel           (* output file descriptor *)
+        -> ?copyFn:              (* function for optimized copying *)
+           (   Uutil.Filesize.t  (* input file offset *)
+            -> Uutil.Filesize.t  (* data length *)
+            -> fallback:         (* default function for copying *)
+               (Uutil.Filesize.t (* bytes copied before fallback *)
+                -> unit)
+            -> unit)
         -> (int -> unit)         (* progress report *)
         -> transfer_instruction  (* transfer instruction received *)
         -> bool