Change `sendfile' to loop until everything has been sent.

* libguile/filesys.c (scm_sendfile)[HAVE_SYS_SENDFILE_H &&
  HAVE_SENDFILE]: Compare RESULT with C_COUNT.  Loop until C_COUNT bytes
  have been sent.
* doc/ref/posix.texi (File System): Update the description.  Explain the
  new semantics.
* test-suite/tests/filesys.test ("sendfile"): Rewrite using
  `pass-if-equal'.  Check the return value for all the tests.
  ["file with offset past the end", "file with offset near the end"]:
  New tests.

3 files changed, 114 insertions, 74 deletions

diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index 45f320f45..b3a6a048f 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -806,9 +806,10 @@ The return value is unspecified.
 @deffn {Scheme Procedure} sendfile out in count [offset]
 @deffnx {C Function} scm_sendfile (out, in, count, offset)
 Send @var{count} bytes from @var{in} to @var{out}, both of which
-are either open file ports or file descriptors.  When
+must be either open file ports or file descriptors.  When
 @var{offset} is omitted, start reading from @var{in}'s current
-position; otherwise, start reading at @var{offset}.
+position; otherwise, start reading at @var{offset}.  Return
+the number of bytes actually sent.
 
 When @var{in} is a port, it is often preferable to specify @var{offset},
 because @var{in}'s offset as a port may be different from the offset of
@@ -824,6 +825,12 @@ In some cases, the @code{sendfile} libc function may return
 @code{EINVAL} or @code{ENOSYS}.  In that case, Guile's @code{sendfile}
 procedure automatically falls back to doing a series of @code{read} and
 @code{write} calls.
+
+In other cases, the libc function may send fewer bytes than
+@var{count}---for instance because @var{out} is a slow or limited
+device, such as a pipe.  When that happens, Guile's @code{sendfile}
+automatically retries until exactly @var{count} bytes were sent or an
+error occurs.
 @end deffn
 
 @findex rename
diff --git a/libguile/filesys.c b/libguile/filesys.c
index d318ae793..d2e565bf8 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -1111,9 +1111,10 @@ SCM_DEFINE (scm_copy_file, "copy-file", 2, 0, 0,
 SCM_DEFINE (scm_sendfile, "sendfile", 3, 1, 0,
 	    (SCM out, SCM in, SCM count, SCM offset),
 	    "Send @var{count} bytes from @var{in} to @var{out}, both of which "
-	    "are either open file ports or file descriptors.  When "
+	    "must be either open file ports or file descriptors.  When "
 	    "@var{offset} is omitted, start reading from @var{in}'s current "
-	    "position; otherwise, start reading at @var{offset}.")
+	    "position; otherwise, start reading at @var{offset}.  Return "
+	    "the number of bytes actually sent.")
 #define FUNC_NAME s_scm_sendfile
 {
 #define VALIDATE_FD_OR_PORT(cvar, svar, pos)	\
@@ -1126,9 +1127,9 @@ SCM_DEFINE (scm_sendfile, "sendfile", 3, 1, 0,
       cvar = SCM_FPORT_FDES (svar);		\
     }
 
-  size_t c_count;
+  ssize_t result SCM_UNUSED;
+  size_t c_count, total = 0;
   scm_t_off c_offset;
-  ssize_t result;
   int in_fd, out_fd;
 
   VALIDATE_FD_OR_PORT (out_fd, out, 1);
@@ -1139,9 +1140,30 @@ SCM_DEFINE (scm_sendfile, "sendfile", 3, 1, 0,
 #if defined HAVE_SYS_SENDFILE_H && defined HAVE_SENDFILE
   /* The Linux-style sendfile(2), which is different from the BSD-style.  */
 
-  result = sendfile_or_sendfile64 (out_fd, in_fd,
-				   SCM_UNBNDP (offset) ? NULL : &c_offset,
-				   c_count);
+  {
+    off_t *offset_ptr;
+
+    offset_ptr = SCM_UNBNDP (offset) ? NULL : &c_offset;
+
+    /* On Linux, when OUT_FD is a file, everything is transferred at once and
+       RESULT == C_COUNT.  However, when OUT_FD is a pipe or other "slow"
+       device, fewer bytes may be transferred, hence the loop.  RESULT == 0
+       means EOF on IN_FD, so leave the loop in that case.  */
+    do
+      {
+	result = sendfile_or_sendfile64 (out_fd, in_fd, offset_ptr,
+					 c_count - total);
+	if (result > 0)
+	  /* At this point, either OFFSET_PTR is non-NULL and it has been
+	     updated to the current offset in IN_FD, or it is NULL and IN_FD's
+	     offset has been updated.  */
+	  total += result;
+	else if (result < 0 && (errno == EINTR || errno == EAGAIN))
+	  /* Keep going.  */
+	  result = 0;
+      }
+    while (total < c_count && result > 0);
+  }
 
   /* Quoting the Linux man page: "In Linux kernels before 2.6.33, out_fd
      must refer to a socket.  Since Linux 2.6.33 it can be any file."
@@ -1152,12 +1174,12 @@ SCM_DEFINE (scm_sendfile, "sendfile", 3, 1, 0,
 #endif
   {
     char buf[8192];
-    size_t result, left;
+    size_t left;
 
     if (!SCM_UNBNDP (offset))
       {
 	if (SCM_PORTP (in))
-	  scm_seek (in, offset, scm_from_int (SEEK_SET));
+	  scm_seek (in, scm_from_off_t (c_offset), scm_from_int (SEEK_SET));
 	else
 	  {
 	    if (lseek_or_lseek64 (in_fd, c_offset, SEEK_SET) < 0)
@@ -1165,7 +1187,7 @@ SCM_DEFINE (scm_sendfile, "sendfile", 3, 1, 0,
 	  }
       }
 
-    for (result = 0, left = c_count; result < c_count; )
+    for (total = 0, left = c_count; total < c_count; )
       {
 	size_t asked, obtained;
 
@@ -1180,13 +1202,12 @@ SCM_DEFINE (scm_sendfile, "sendfile", 3, 1, 0,
 	if (obtained < asked)
 	  SCM_SYSERROR;
 
-	result += obtained;
+	total += obtained;
       }
 
-    return scm_from_size_t (result);
   }
 
-  return scm_from_ssize_t (result);
+  return scm_from_size_t (total);
 
 #undef VALIDATE_FD_OR_PORT
 }
diff --git a/test-suite/tests/filesys.test b/test-suite/tests/filesys.test
index 21b893796..7998bc710 100644
--- a/test-suite/tests/filesys.test
+++ b/test-suite/tests/filesys.test
@@ -130,70 +130,82 @@
 
 (with-test-prefix "sendfile"
 
-  (pass-if "file"
-    (let ((file (search-path %load-path "ice-9/boot-9.scm")))
+  (let* ((file (search-path %load-path "ice-9/boot-9.scm"))
+         (len  (stat:size (stat file)))
+         (ref  (call-with-input-file file get-bytevector-all)))
+
+    (pass-if-equal "file" (cons len ref)
+      (cons (call-with-input-file file
+              (lambda (input)
+                (call-with-output-file (test-file)
+                  (lambda (output)
+                    (sendfile output input len 0)))))
+            (call-with-input-file (test-file) get-bytevector-all)))
+
+    (pass-if-equal "file with offset"
+        (cons (- len 777) (call-with-input-file file
+                            (lambda (input)
+                              (seek input 777 SEEK_SET)
+                              (get-bytevector-all input))))
+      (cons (call-with-input-file file
+              (lambda (input)
+                (call-with-output-file (test-file)
+                  (lambda (output)
+                    (sendfile output input (- len 777) 777)))))
+            (call-with-input-file (test-file) get-bytevector-all)))
+
+    (pass-if-equal "file with offset past the end" (- len 777)
       (call-with-input-file file
         (lambda (input)
-          (let ((len (stat:size (stat input))))
-            (call-with-output-file (test-file)
-              (lambda (output)
-                (sendfile output input len 0))))))
-      (let ((ref (call-with-input-file file get-bytevector-all))
-            (out (call-with-input-file (test-file) get-bytevector-all)))
-        (bytevector=? ref out))))
-
-  (pass-if "file with offset"
-    (let ((file (search-path %load-path "ice-9/boot-9.scm")))
+          (call-with-output-file (test-file)
+            (lambda (output)
+              (sendfile output input len 777))))))
+
+    (pass-if-equal "file with offset near the end" 77
       (call-with-input-file file
         (lambda (input)
-          (let ((len (stat:size (stat input))))
-            (call-with-output-file (test-file)
-              (lambda (output)
-                (sendfile output input (- len 777) 777))))))
-      (let ((ref (call-with-input-file file
-                   (lambda (input)
-                     (seek input 777 SEEK_SET)
-                     (get-bytevector-all input))))
-            (out (call-with-input-file (test-file) get-bytevector-all)))
-        (bytevector=? ref out))))
-
-  (pass-if "pipe"
-    (if (provided? 'threads)
-        (let* ((file   (search-path %load-path "ice-9/boot-9.scm"))
-               (in+out (pipe))
-               (child  (call-with-new-thread
-                        (lambda ()
-                          (call-with-input-file file
-                            (lambda (input)
-                              (let ((len (stat:size (stat input))))
-                                (sendfile (cdr in+out) (fileno input) len 0)
-                                (close-port (cdr in+out)))))))))
-          (let ((ref (call-with-input-file file get-bytevector-all))
-                (out (get-bytevector-all (car in+out))))
-            (close-port (car in+out))
-            (bytevector=? ref out)))
-        (throw 'unresolved)))
-
-  (pass-if "pipe with offset"
-    (if (provided? 'threads)
-        (let* ((file   (search-path %load-path "ice-9/boot-9.scm"))
-               (in+out (pipe))
-               (child  (call-with-new-thread
-                        (lambda ()
-                          (call-with-input-file file
+          (call-with-output-file (test-file)
+            (lambda (output)
+              (sendfile output input len (- len 77)))))))
+
+    (pass-if-equal "pipe" (cons len ref)
+      (if (provided? 'threads)
+          (let* ((in+out (pipe))
+                 (child  (call-with-new-thread
+                          (lambda ()
+                            (call-with-input-file file
+                              (lambda (input)
+                                (let ((result (sendfile (cdr in+out)
+                                                        (fileno input)
+                                                        len 0)))
+                                  (close-port (cdr in+out))
+                                  result)))))))
+            (let ((out (get-bytevector-all (car in+out))))
+              (close-port (car in+out))
+              (cons (join-thread child) out)))
+          (throw 'unresolved)))
+
+    (pass-if-equal "pipe with offset"
+        (cons (- len 777) (call-with-input-file file
                             (lambda (input)
-                              (let ((len (stat:size (stat input))))
-                                (sendfile (cdr in+out) (fileno input)
-                                          (- len 777) 777)
-                                (close-port (cdr in+out)))))))))
-          (let ((ref (call-with-input-file file
-                       (lambda (input)
-                         (seek input 777 SEEK_SET)
-                         (get-bytevector-all input))))
-                (out (get-bytevector-all (car in+out))))
-            (close-port (car in+out))
-            (bytevector=? ref out)))
-        (throw 'unresolved))))
+                              (seek input 777 SEEK_SET)
+                              (get-bytevector-all input))))
+      (if (provided? 'threads)
+          (let* ((in+out (pipe))
+                 (child  (call-with-new-thread
+                          (lambda ()
+                            (call-with-input-file file
+                              (lambda (input)
+                                (let ((result (sendfile (cdr in+out)
+                                                        (fileno input)
+                                                        (- len 777)
+                                                        777)))
+                                  (close-port (cdr in+out))
+                                  result)))))))
+            (let ((out (get-bytevector-all (car in+out))))
+              (close-port (car in+out))
+              (cons (join-thread child) out)))
+          (throw 'unresolved)))))
 
 (delete-file (test-file))
 (delete-file (test-symlink))