From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Nala Ginrut Newsgroups: gmane.lisp.guile.devel Subject: Re: [PATCH] Bindings for =?UTF-8?Q?=E2=80=98sendfile=E2=80=99?= Date: Thu, 21 Mar 2013 11:45:31 +0800 Organization: HFG Message-ID: <1363837531.2854.53.camel@Renee-desktop.suse> References: <87ip4liufs.fsf@gnu.org> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset="UTF-8" Content-Transfer-Encoding: 8bit X-Trace: ger.gmane.org 1363837556 4089 80.91.229.3 (21 Mar 2013 03:45:56 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Thu, 21 Mar 2013 03:45:56 +0000 (UTC) Cc: guile-devel@gnu.org To: Ludovic =?ISO-8859-1?Q?Court=E8s?= Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Thu Mar 21 04:46: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 1UIWSG-0004Gd-QN for guile-devel@m.gmane.org; Thu, 21 Mar 2013 04:46:17 +0100 Original-Received: from localhost ([::1]:46935 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1UIWRt-0007fA-G8 for guile-devel@m.gmane.org; Wed, 20 Mar 2013 23:45:53 -0400 Original-Received: from eggs.gnu.org ([208.118.235.92]:47554) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1UIWRj-0007eu-3g for guile-devel@gnu.org; Wed, 20 Mar 2013 23:45:45 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1UIWRg-0001Ni-ME for guile-devel@gnu.org; Wed, 20 Mar 2013 23:45:43 -0400 Original-Received: from mail-da0-x22e.google.com ([2607:f8b0:400e:c00::22e]:59426) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1UIWRd-0001N9-3d; Wed, 20 Mar 2013 23:45:37 -0400 Original-Received: by mail-da0-f46.google.com with SMTP id y19so1384409dan.19 for ; Wed, 20 Mar 2013 20:45:36 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20120113; h=x-received:message-id:subject:from:to:cc:date:in-reply-to :references:organization:content-type:x-mailer:mime-version :content-transfer-encoding; bh=cm9FI7Rty6mBRB/xVb2EGSKqkfAXCRVxIwuhh+fi2tU=; b=yZ0I5tNOChwqZ0LD2mkpisKzf+WfYLTK/i7PWoU5iDTP3lpasta2EeXR/BPl+BnKro JxSacK6g5AiawR2sG5RAUBhU/usJsBYcYxU5h7hMhMXrwsX7RgqOmfsPD5vpNB78fVQU +pVBaXhhqQxiaRveQqkylsTIpM21Rj0asYUi3VQfO89QbPjwtTJuAIA3AI8SYwfjpZVU rmsHYloteVMpQmyBwq7vpDB7GlCec0k39XqnhXbnpIvmJW1rZxOn9/8RMW69EIEL7Zj5 fizKD/4AX9EL8RLl7QdgmXURL1e9ZqYZcKa27Tk1qlZejG5nm52RHS8PnFcZLnRobMva j/Hg== X-Received: by 10.66.217.133 with SMTP id oy5mr8366476pac.20.1363837535971; Wed, 20 Mar 2013 20:45:35 -0700 (PDT) Original-Received: from [147.2.147.112] ([61.14.130.226]) by mx.google.com with ESMTPS id ef3sm4681619pad.20.2013.03.20.20.45.33 (version=SSLv3 cipher=RC4-SHA bits=128/128); Wed, 20 Mar 2013 20:45:34 -0700 (PDT) In-Reply-To: <87ip4liufs.fsf@gnu.org> X-Mailer: Evolution 3.4.4 X-detected-operating-system: by eggs.gnu.org: Error: Malformed IPv6 address (bad octet value). X-Received-From: 2607:f8b0:400e:c00::22e 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:15941 Archived-At: 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?= > 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))