unofficial mirror of guile-devel@gnu.org 
 help / color / mirror / Atom feed
* [PATCH] Bindings for ‘sendfile’
@ 2013-03-20 22:21 Ludovic Courtès
  2013-03-21  0:17 ` Noah Lavine
                   ` (2 more replies)
  0 siblings, 3 replies; 30+ messages in thread
From: Ludovic Courtès @ 2013-03-20 22:21 UTC (permalink / raw)
  To: guile-devel

[-- Attachment #1: Type: text/plain, Size: 101 bytes --]

Hi,

I plan to commit the patch below, which adds bindings for ‘sendfile’.

Comments?

Ludo’.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: the patch --]
[-- Type: text/x-patch, Size: 12286 bytes --]

From a10f5d5d69d63495cab5432d858b1af52a2bacbf Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
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
 
+@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
+@var{offset} 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
+@code{sendfile} libc function, which usually corresponds to a system
+call.  This is faster than doing a series of @code{read} and
+@code{write} system calls.  A typical application is to send a file over
+a socket.
+
+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.
+@end 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 */
 
 \f
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))
-- 
1.7.10.4


^ permalink raw reply related	[flat|nested] 30+ messages in thread

end of thread, other threads:[~2013-04-18  6:58 UTC | newest]

Thread overview: 30+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2013-03-20 22:21 [PATCH] Bindings for ‘sendfile’ Ludovic Courtès
2013-03-21  0:17 ` Noah Lavine
2013-03-21  9:15   ` Ludovic Courtès
2013-03-21 10:04     ` Andrew Gaylard
2013-03-21 15:39     ` Noah Lavine
2013-03-21  3:45 ` Nala Ginrut
2013-03-21  4:50 ` Mark H Weaver
2013-03-21  5:24   ` Mark H Weaver
2013-03-21  9:40   ` Ludovic Courtès
2013-03-21  9:49     ` Andy Wingo
2013-03-21 10:10       ` Ludovic Courtès
2013-03-22 19:22     ` Mark H Weaver
2013-03-22 21:27       ` Ludovic Courtès
2013-03-24  5:04         ` Mark H Weaver
2013-03-25 12:55           ` Ludovic Courtès
2013-04-07 19:53     ` Ludovic Courtès
2013-04-09  8:33       ` Thien-Thi Nguyen
2013-04-09 15:02         ` Ludovic Courtès
2013-04-09 20:34           ` Thien-Thi Nguyen
2013-04-10 11:26             ` Mark H Weaver
2013-04-14 10:48               ` Thien-Thi Nguyen
2013-04-16 16:31                 ` Ludovic Courtès
2013-04-16 20:14                   ` Thien-Thi Nguyen
2013-04-17 12:52                     ` Ludovic Courtès
2013-04-17 15:18                       ` Thien-Thi Nguyen
2013-04-17 16:27                         ` Ludovic Courtès
2013-04-18  6:58                           ` Thien-Thi Nguyen
2013-04-10 20:56             ` Ludovic Courtès
2013-04-14 10:52               ` Thien-Thi Nguyen
2013-04-07 21:51   ` Ludovic Courtès

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).