backport ocaml#8288

- test: add a repro for ocaml#8284 (ocaml#8292)
- fix(sendfile): Flush the out_channel used in the fallback path (ocaml#8288)

Signed-off-by: Alan Hu <alanh@ccs.neu.edu>
Signed-off-by: Etienne Millon <me@emillon.org>

CHANGES.md

@@ -1,3 +1,8 @@
+3.9.3 (unreleased)
+------------------
+
+- Fix flushing when using `sendfile` fallback (#8288, @alan-j-hu)
+
 3.9.2 (2023-07-25)
 ------------------
 

otherlibs/stdune/src/io.ml

@@ -145,17 +145,23 @@ module Copyfile = struct
       | Error `Src_missing ->
         let message = Printf.sprintf "%s: No such file or directory" src in
         raise (Sys_error message)
-      | Ok (src, dst, src_size) ->
-        Exn.protect
-          ~f:(fun () ->
-            try sendfile ~src ~dst src_size
-            with Unix.Unix_error (EINVAL, "sendfile", _) ->
-              let ic = Unix.in_channel_of_descr src in
-              let oc = Unix.out_channel_of_descr dst in
-              copy_channels ic oc)
-          ~finally:(fun () ->
-            Unix.close src;
-            Unix.close dst)
+      | Ok (src, dst, src_size) -> (
+        let close_fds () =
+          Unix.close src;
+          Unix.close dst
+        in
+        match sendfile ~src ~dst src_size with
+        | exception Unix.Unix_error (EINVAL, "sendfile", _) ->
+          let ic = Unix.in_channel_of_descr src in
+          let oc = Unix.out_channel_of_descr dst in
+          Exn.protect
+            ~f:(fun () -> copy_channels ic oc)
+            ~finally:(fun () ->
+              (* we make sure to close the fd's with the channel api to make
+                 sure everything has been flushed *)
+              close_both (ic, oc))
+        | () -> close_fds ()
+        | exception _ -> close_fds ())
 
   let copyfile ?chmod ~src ~dst () =
     let src_stats =

test/blackbox-tests/test-cases/dune

@@ -136,4 +136,4 @@
  (applies_to github8041)
  (enabled_if
   (= %{system} linux))
- (deps %{bin:strace}))
+ (deps %{bin:strace} %{bin:head}))

test/blackbox-tests/test-cases/github8041.t

@@ -8,15 +8,26 @@
   > (rule (copy data.txt data2.txt))
   > 
   > (install
-  >  (files data.txt data2.txt)
+  >  (files data.txt data2.txt data3.txt)
   >  (section share))
   > EOF
 
   $ echo contents > data.txt
+  $ head -c 100000 /dev/zero > data3.txt
 
 If sendfile fails, we should fallback to the portable implementation.
 
   $ strace -e inject=sendfile:error=EINVAL -o /dev/null dune build @install
 
 #8210: data2.txt is copied from readonly-file data.txt (#3092), so it needs to
 be adequately unlinked before starting the fallback.
+
+#8284: the buffer needs to be flushed, or there will be incomplete data in
+larger files.
+
+  $ if cmp -s data3.txt _build/default/data3.txt ; then
+  >   echo "File copied correctly"
+  > else
+  >   echo "File copied incorrectly"
+  > fi
+  File copied correctly