From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: ludo@gnu.org (Ludovic =?utf-8?Q?Court=C3=A8s?=) Newsgroups: gmane.lisp.guile.devel Subject: [PATCH] Bindings for =?utf-8?B?4oCYc2VuZGZpbGXigJk=?= Date: Wed, 20 Mar 2013 23:21:27 +0100 Message-ID: <87ip4liufs.fsf@gnu.org> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1363818112 1898 80.91.229.3 (20 Mar 2013 22:21:52 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Wed, 20 Mar 2013 22:21:52 +0000 (UTC) To: guile-devel@gnu.org Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Wed Mar 20 23:22:18 2013 Return-path: Envelope-to: guile-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1UIROk-0001w9-0T for guile-devel@m.gmane.org; Wed, 20 Mar 2013 23:22:18 +0100 Original-Received: from localhost ([::1]:54919 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1UIROM-00033W-PV for guile-devel@m.gmane.org; Wed, 20 Mar 2013 18:21:54 -0400 Original-Received: from eggs.gnu.org ([208.118.235.92]:34363) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1UIROI-00033N-Rk for guile-devel@gnu.org; Wed, 20 Mar 2013 18:21:52 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1UIROG-0001OP-7g for guile-devel@gnu.org; Wed, 20 Mar 2013 18:21:50 -0400 Original-Received: from plane.gmane.org ([80.91.229.3]:52568) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1UIROF-0001OI-OI for guile-devel@gnu.org; Wed, 20 Mar 2013 18:21:48 -0400 Original-Received: from list by plane.gmane.org with local (Exim 4.69) (envelope-from ) id 1UIROa-0001rS-37 for guile-devel@gnu.org; Wed, 20 Mar 2013 23:22:08 +0100 Original-Received: from reverse-83.fdn.fr ([80.67.176.83]) by main.gmane.org with esmtp (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Wed, 20 Mar 2013 23:22:08 +0100 Original-Received: from ludo by reverse-83.fdn.fr with local (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Wed, 20 Mar 2013 23:22:08 +0100 X-Injected-Via-Gmane: http://gmane.org/ Original-Lines: 338 Original-X-Complaints-To: usenet@ger.gmane.org X-Gmane-NNTP-Posting-Host: reverse-83.fdn.fr X-URL: http://www.fdn.fr/~lcourtes/ X-Revolutionary-Date: 30 =?utf-8?Q?Vent=C3=B4se?= an 221 de la =?utf-8?Q?R?= =?utf-8?Q?=C3=A9volution?= X-PGP-Key-ID: 0xEA52ECF4 X-PGP-Key: http://www.fdn.fr/~lcourtes/ludovic.asc X-PGP-Fingerprint: 83C4 F8E5 10A3 3B4C 5BEA D15D 77DD 95E2 EA52 ECF4 X-OS: x86_64-unknown-linux-gnu User-Agent: Gnus/5.130005 (Ma Gnus v0.5) Emacs/24.2 (gnu/linux) Cancel-Lock: sha1:Yn7yTmgceTIsr3qaM51zse2SySQ= X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-Received-From: 80.91.229.3 X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Developers list for Guile, the GNU extensibility library" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Original-Sender: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.lisp.guile.devel:15937 Archived-At: --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: 8bit Hi, I plan to commit the patch below, which adds bindings for ‘sendfile’. Comments? Ludo’. --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=0001-Add-bindings-for-Linux-s-sendfile.patch Content-Description: the patch >From a10f5d5d69d63495cab5432d858b1af52a2bacbf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 20 Mar 2013 23:04:11 +0100 Subject: [PATCH] Add bindings for Linux's `sendfile'. * configure.ac: Check for 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 # 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 # 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 +#endif + +#include +#include + + /* 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)) -- 1.7.10.4 --=-=-=--