[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.7-322-ge0886e0

[Ludovic Courtès]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=e0886e0780fc1f3ce1c80d0692c11adf3b68f682

The branch, stable-2.0 has been updated
       via  e0886e0780fc1f3ce1c80d0692c11adf3b68f682 (commit)
      from  254d313a21f06739930032062678ff5360d248fd (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit e0886e0780fc1f3ce1c80d0692c11adf3b68f682
Author: Ludovic Courtès <address@hidden>
Date:   Sun Apr 7 23:43:21 2013 +0200

    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.

-----------------------------------------------------------------------

Summary of changes:
 doc/ref/posix.texi            |   11 +++-
 libguile/filesys.c            |   47 +++++++++++----
 test-suite/tests/filesys.test |  130 ++++++++++++++++++++++------------------
 3 files changed, 114 insertions(+), 74 deletions(-)

diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index 45f320f..b3a6a04 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
address@hidden 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 d318ae7..d2e565b 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 21b8937..7998bc7 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))


hooks/post-receive
-- 
GNU Guile