From a49c7eed921236ac6d33cca15524465a5ced767d Mon Sep 17 00:00:00 2001
From: Etienne Millon <me@emillon.org>
Date: Tue, 27 Jun 2023 10:06:10 +0200
Subject: [PATCH] fix: sendfile: fall back to portable copy (#8049)

Fixes #8041

Signed-off-by: Etienne Millon <me@emillon.org>
---
 CHANGES.md                                  | 4 ++++
 otherlibs/stdune/src/io.ml                  | 7 ++++++-
 test/blackbox-tests/test-cases/github8041.t | 6 ------
 3 files changed, 10 insertions(+), 7 deletions(-)

diff --git a/CHANGES.md b/CHANGES.md
index 62570c61c90..7ebc14caecb 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -3,6 +3,10 @@
 
 - Fix deadlock on Windows (#8044, @nojb)
 
+- When using `sendfile` to copy files on Linux, fall back to the portable
+  version if it fails at runtime for some reason (NFS, etc).
+  (#8049, fixes #8041, @emillon)
+
 3.8.2 (2023-06-16)
 ------------------
 
diff --git a/otherlibs/stdune/src/io.ml b/otherlibs/stdune/src/io.ml
index 360566a2211..d07a8616b1e 100644
--- a/otherlibs/stdune/src/io.ml
+++ b/otherlibs/stdune/src/io.ml
@@ -176,9 +176,14 @@ 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
+    | `Sendfile -> sendfile_with_fallback
     | `Copyfile -> copyfile
     | `Nothing -> copy_file_portable
 
diff --git a/test/blackbox-tests/test-cases/github8041.t b/test/blackbox-tests/test-cases/github8041.t
index 4db6d0e735b..1276dd4dc12 100644
--- a/test/blackbox-tests/test-cases/github8041.t
+++ b/test/blackbox-tests/test-cases/github8041.t
@@ -15,9 +15,3 @@
 If sendfile fails, we should fallback to the portable implementation.
 
   $ strace -e inject=sendfile:error=EINVAL -o /dev/null dune build @install
-  Error: sendfile(): Invalid argument
-  -> required by _build/default/data.txt
-  -> required by _build/install/default/share/p/data.txt
-  -> required by _build/default/p.install
-  -> required by alias install
-  [1]