Re: [PATCH] Bindings for ‘sendfile’

[Nala Ginrut]

On Wed, 2013-03-20 at 23:21 +0100, Ludovic Courtès wrote:
> Hi,
> 
> I plan to commit the patch below, which adds bindings for ‘sendfile’.
> 
> Comments?
> 

As a server-develop fan, I definitely love it.
Besides, can we add more linux-specific features and add them into a
place like (ice-9 linux)?

> Ludo’.
> 
> differences between files attachment
> (0001-Add-bindings-for-Linux-s-sendfile.patch), "the patch"
> From a10f5d5d69d63495cab5432d858b1af52a2bacbf Mon Sep 17 00:00:00 2001
> From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <address@hidden>
> Date: Wed, 20 Mar 2013 23:04:11 +0100
> Subject: [PATCH] Add bindings for Linux's `sendfile'.
> 
> * configure.ac: Check for <sys/sendfile.h> and `sendfile'.
> * libguile/filesys.c (scm_sendfile): New function.
> * libguile/filesys.h (scm_sendfile): New declaration.
> * test-suite/tests/filesys.test ("sendfile"): New test prefix.
> * doc/ref/posix.texi (File System): Document `sendfile'.
> ---
>  configure.ac                  |   20 ++++++++--
>  doc/ref/posix.texi            |   23 +++++++++++
>  libguile/filesys.c            |   85 
> +++++++++++++++++++++++++++++++++++++++++
>  libguile/filesys.h            |    4 +-
>  test-suite/tests/filesys.test |   70 ++++++++++++++++++++++++++++++++-
>  5 files changed, 195 insertions(+), 7 deletions(-)
> 
> diff --git a/configure.ac b/configure.ac
> index 42de733..bcfc1a6 100644
> --- a/configure.ac
> +++ b/configure.ac
> @@ -647,12 +647,13 @@ AC_SUBST([SCM_I_GSC_HAVE_STRUCT_DIRENT64])
>  #     this file instead of <fenv.h>
>  #   process.h - mingw specific
>  #   sched.h - missing on MinGW
> +#   sys/sendfile.h - non-POSIX, found in glibc
>  #
>  AC_CHECK_HEADERS([complex.h fenv.h io.h libc.h limits.h memory.h process.h 
> string.h \
>  sys/dir.h sys/ioctl.h sys/select.h \
>  sys/time.h sys/timeb.h sys/times.h sys/stdtypes.h sys/types.h \
>  sys/utime.h time.h unistd.h utime.h pwd.h grp.h sys/utsname.h \
> -direct.h machine/fpu.h sched.h])
> +direct.h machine/fpu.h sched.h sys/sendfile.h])
>  
>  # "complex double" is new in C99, and "complex" is only a keyword if
>  # <complex.h> is included
> @@ -744,10 +745,21 @@ AC_CHECK_HEADERS([assert.h crt_externs.h])
>  #   _NSGetEnviron - Darwin specific
>  #   strcoll_l, newlocale - GNU extensions (glibc), also available on Darwin
>  #   fork - unavailable on Windows
> -#   utimensat: posix.1-2008
> -#   sched_getaffinity, sched_setaffinity: GNU extensions (glibc)
> +#   utimensat - posix.1-2008
> +#   sched_getaffinity, sched_setaffinity - GNU extensions (glibc)
> +#   sendfile - non-POSIX, found in glibc
>  #
> -AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid fesetround 
> ftime ftruncate fchown fchmod getcwd geteuid getsid gettimeofday gmtime_r 
> ioctl lstat mkdir mknod nice pipe _pipe readdir_r readdir64_r readlink rename 
> rmdir select setegid seteuid setlocale setpgid setsid sigaction siginterrupt 
> stat64 strftime strptime symlink sync sysconf tcgetpgrp tcsetpgrp times uname 
> waitpid strdup system usleep atexit on_exit chown link fcntl ttyname getpwent 
> getgrent kill getppid getpgrp fork setitimer getitimer strchr strcmp index 
> bcopy memcpy rindex truncate unsetenv isblank _NSGetEnviron strcoll strcoll_l 
> newlocale utimensat sched_getaffinity sched_setaffinity])
> +AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid              
> \
> +  fesetround ftime ftruncate fchown fchmod getcwd geteuid getsid     \
> +  gettimeofday gmtime_r ioctl lstat mkdir mknod nice pipe _pipe              
> \
> +  readdir_r readdir64_r readlink rename rmdir select setegid seteuid \
> +  setlocale setpgid setsid sigaction siginterrupt stat64 strftime    \
> +  strptime symlink sync sysconf tcgetpgrp tcsetpgrp times uname waitpid      
> \
> +  strdup system usleep atexit on_exit chown link fcntl ttyname getpwent      
> \
> +  getgrent kill getppid getpgrp fork setitimer getitimer strchr strcmp       
> \
> +  index bcopy memcpy rindex truncate unsetenv isblank _NSGetEnviron  \
> +  strcoll strcoll_l newlocale utimensat sched_getaffinity            \
> +  sched_setaffinity sendfile])
>  
>  AM_CONDITIONAL([HAVE_FORK], [test "x$ac_cv_func_fork" = "xyes"])
>  
> diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
> index d659cf3..ca02093 100644
> --- a/doc/ref/posix.texi
> +++ b/doc/ref/posix.texi
> @@ -803,6 +803,29 @@ Copy the file specified by @var{oldfile} to 
> @var{newfile}.
>  The return value is unspecified.
>  @end deffn
>  
> address@hidden {Scheme Procedure} sendfile out in count [offset]
> address@hidden {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
> address@hidden is omitted, start reading from @var{in}'s current
> +position; otherwise, start reading at @var{offset}.
> +
> +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
> +its underlying file descriptor.
> +
> +On systems that support it, such as GNU/Linux, this procedure uses the
> address@hidden libc function, which usually corresponds to a system
> +call.  This is faster than doing a series of @code{read} and
> address@hidden system calls.  A typical application is to send a file over
> +a socket.
> +
> +In some cases, the @code{sendfile} libc function may return
> address@hidden or @code{ENOSYS}.  In that case, Guile's @code{sendfile}
> +procedure automatically falls back to doing a series of @code{read} and
> address@hidden calls.
> address@hidden deffn
> +
>  @findex rename
>  @deffn {Scheme Procedure} rename-file oldname newname
>  @deffnx {C Function} scm_rename (oldname, newname)
> diff --git a/libguile/filesys.c b/libguile/filesys.c
> index 282ff31..097b03a 100644
> --- a/libguile/filesys.c
> +++ b/libguile/filesys.c
> @@ -98,6 +98,14 @@
>  
>  #define NAMLEN(dirent)  strlen ((dirent)->d_name)
>  
> +#ifdef HAVE_SYS_SENDFILE_H
> +# include <sys/sendfile.h>
> +#endif
> +
> +#include <full-read.h>
> +#include <full-write.h>
> +
> +
>  /* Some more definitions for the native Windows port. */
>  #ifdef __MINGW32__
>  # define fsync(fd) _commit (fd)
> @@ -1096,6 +1104,83 @@ SCM_DEFINE (scm_copy_file, "copy-file", 2, 0, 0,
>  }
>  #undef FUNC_NAME
>  
> +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 "
> +         "@var{offset} is omitted, start reading from @var{in}'s current "
> +         "position; otherwise, start reading at @var{offset}.")
> +#define FUNC_NAME s_scm_sendfile
> +{
> +#define VALIDATE_FD_OR_PORT(cvar, svar, pos) \
> +  if (scm_is_integer (svar))                 \
> +    cvar = scm_to_int (svar);                        \
> +  else                                               \
> +    {                                                \
> +      SCM_VALIDATE_OPFPORT (pos, svar);              \
> +      scm_flush (svar);                              \
> +      cvar = SCM_FPORT_FDES (svar);          \
> +    }
> +
> +  size_t c_count;
> +  off_t c_offset;
> +  ssize_t result;
> +  int in_fd, out_fd;
> +
> +  VALIDATE_FD_OR_PORT (out_fd, out, 1);
> +  VALIDATE_FD_OR_PORT (in_fd, in, 2);
> +  c_count = scm_to_size_t (count);
> +  c_offset = SCM_UNBNDP (offset) ? 0 : scm_to_off_t (offset);
> +
> +#ifdef HAVE_SENDFILE
> +  result = sendfile (out_fd, in_fd,
> +                  SCM_UNBNDP (offset) ? NULL : &c_offset,
> +                  c_count);
> +
> +  /* 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."
> +     Fall back to read(2) and write(2) such an error happens.  */
> +  if (result < 0 && errno != EINVAL && errno != ENOSYS)
> +    SCM_SYSERROR;
> +  else if (result < 0)
> +#endif
> +  {
> +    char buf[8192];
> +    size_t left;
> +
> +    if (!SCM_UNBNDP (offset))
> +      {
> +     if (SCM_PORTP (in))
> +       scm_seek (in, offset, scm_from_int (SEEK_SET));
> +     else
> +       lseek_or_lseek64 (in_fd, c_offset, SEEK_SET);
> +      }
> +
> +    for (result = 0, left = c_count; result < c_count; )
> +      {
> +     size_t asked, obtained;
> +
> +     asked = SCM_MIN (sizeof buf, left);
> +     obtained = full_read (in_fd, buf, asked);
> +     if (obtained < asked)
> +       SCM_SYSERROR;
> +
> +     left -= obtained;
> +
> +     obtained = full_write (out_fd, buf, asked);
> +     if (obtained < asked)
> +       SCM_SYSERROR;
> +
> +     result += obtained;
> +      }
> +  }
> +
> +  return scm_from_ssize_t (result);
> +
> +#undef VALIDATE_FD_OR_PORT
> +}
> +#undef FUNC_NAME
> +
>  #endif /* HAVE_POSIX */
>  
>  
> diff --git a/libguile/filesys.h b/libguile/filesys.h
> index 967ce74..776b263 100644
> --- a/libguile/filesys.h
> +++ b/libguile/filesys.h
> @@ -3,7 +3,8 @@
>  #ifndef SCM_FILESYS_H
>  #define SCM_FILESYS_H
>  
> -/* Copyright (C) 1995,1997,1998,1999,2000,2001, 2006, 2008, 2009, 2010 Free 
> Software Foundation, Inc.
> +/* Copyright (C) 1995, 1997, 1998, 1999, 2000, 2001, 2006, 2008, 2009,
> + *   2010, 2013 Free Software Foundation, Inc.
>   *
>   * This library is free software; you can redistribute it and/or
>   * modify it under the terms of the GNU Lesser General Public License
> @@ -66,6 +67,7 @@ SCM_API SCM scm_copy_file (SCM oldfile, SCM newfile);
>  SCM_API SCM scm_dirname (SCM filename);
>  SCM_API SCM scm_basename (SCM filename, SCM suffix);
>  SCM_API SCM scm_canonicalize_path (SCM path);
> +SCM_API SCM scm_sendfile (SCM out, SCM in, SCM count, SCM offset);
>  SCM_INTERNAL SCM scm_i_relativize_path (SCM path, SCM in_path);
>  
>  SCM_INTERNAL void scm_init_filesys (void);
> diff --git a/test-suite/tests/filesys.test b/test-suite/tests/filesys.test
> index a6bfb6e..c80c295 100644
> --- a/test-suite/tests/filesys.test
> +++ b/test-suite/tests/filesys.test
> @@ -1,6 +1,6 @@
>  ;;;; filesys.test --- test file system functions -*- scheme -*-
>  ;;;; 
> -;;;; Copyright (C) 2004, 2006 Free Software Foundation, Inc.
> +;;;; Copyright (C) 2004, 2006, 2013 Free Software Foundation, Inc.
>  ;;;; 
>  ;;;; This library is free software; you can redistribute it and/or
>  ;;;; modify it under the terms of the GNU Lesser General Public
> @@ -18,7 +18,10 @@
>  
>  (define-module (test-suite test-filesys)
>    #:use-module (test-suite lib)
> -  #:use-module (test-suite guile-test))
> +  #:use-module (test-suite guile-test)
> +  #:use-module (ice-9 match)
> +  #:use-module (rnrs io ports)
> +  #:use-module (rnrs bytevectors))
>  
>  (define (test-file)
>    (data-file-name "filesys-test.tmp"))
> @@ -125,5 +128,68 @@
>       (close-port port)
>       (eqv? 5 (stat:size st))))))
>  
> +(with-test-prefix "sendfile"
> +
> +  (pass-if "file"
> +    (let ((file (search-path %load-path "ice-9/boot-9.scm")))
> +      (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-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"
> +    (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))))
> +
> +  (pass-if "pipe with offset"
> +    (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 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)))))
> +
>  (delete-file (test-file))
>  (delete-file (test-symlink))