[3.9] backport #8234 (sendfile fallback) (#8270)

* test: repro for #8210 (EACCESS if sendfile fails)

What's happening here is:

- input and output files are open
- sendfile is attempted and fails
- both files are closed
- input file is opened again
- output file is opened again (but already exists)

This throws an error if the output file is not writable.

Signed-off-by: Etienne Millon <me@emillon.org>

* refactor: use Exn.protect instead of protectx (#8235)

This adds a layer of rebinding that obscures what is going on.

Signed-off-by: Etienne Millon <me@emillon.org>

* fix(sendfile): unlink dst before fallback (#8234)

Fixes #8210

If the `sendfile` branch failed, it leaves an empty target file, so
retrying will fail. Instead we reuse the fd directly.

Signed-off-by: Etienne Millon <me@emillon.org>

---------

Signed-off-by: Etienne Millon <me@emillon.org>

CHANGES.md

@@ -5,6 +5,9 @@
   unremovable files would make dune crash when the shared cache is enabled.
   (#8243, fixes #8228, @emillon)
 
+- Fix permission errors when `sendfile` is not available (#8234, fixes #8120,
+  @emillon)
+
 3.9.1 (2023-07-06)
 ------------------
 

otherlibs/stdune/src/io.ml

@@ -101,7 +101,7 @@ module Copyfile = struct
     | Linux -> `Sendfile
     | Windows | Other -> `Nothing
 
-  let sendfile =
+  let sendfile_with_fallback =
     let setup_copy ?(chmod = Fun.id) ~src ~dst () =
       match Unix.openfile src [ O_RDONLY ] 0 with
       | exception Unix.Unix_error (Unix.ENOENT, _, _) -> Error `Src_missing
@@ -145,10 +145,15 @@ module Copyfile = struct
       | Error `Src_missing ->
         let message = Printf.sprintf "%s: No such file or directory" src in
         raise (Sys_error message)
-      | Ok (fd_src, fd_dst, src_size) ->
-        Exn.protectx (fd_src, fd_dst, src_size)
-          ~f:(fun (src, dst, src_size) -> sendfile ~src ~dst src_size)
-          ~finally:(fun (src, dst, _) ->
+      | 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)
 
@@ -176,11 +181,6 @@ module Copyfile = struct
     Exn.protectx (setup_copy ?chmod ~src ~dst ()) ~finally:close_both
       ~f:(fun (ic, oc) -> copy_channels ic oc)
 
-  let sendfile_with_fallback ?chmod ~src ~dst () =
-    try sendfile ?chmod ~src ~dst ()
-    with Unix.Unix_error (EINVAL, "sendfile", _) ->
-      copy_file_portable ?chmod ~src ~dst ()
-
   let copy_file_best =
     match available with
     | `Sendfile -> sendfile_with_fallback

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

@@ -1,12 +1,14 @@
   $ cat > dune-project << EOF
-  > (lang dune 1.0)
+  > (lang dune 2.4)
   > (package
   >  (name p))
   > EOF
 
   $ cat > dune << EOF
+  > (rule (copy data.txt data2.txt))
+  > 
   > (install
-  >  (files data.txt)
+  >  (files data.txt data2.txt)
   >  (section share))
   > EOF
 
@@ -15,3 +17,6 @@
 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.