From 9b6316eabcd3438ca01d1bf7269702af24c3ec5f Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Tue, 19 Feb 2013 11:41:44 +0100 Subject: better handling of windows file name conventions * libguile/filesys.c (scm_system_file_name_convention): New function. Exported to Scheme only. * module/ice-9/boot-9.scm (file-name-separator?, absolute-file-name?): New predicates. (file-name-separator-string): New global variable. (in-vicinity): Use the new procedures. (load-user-init, try-module-autoload): Use file-name-separator-string. (load-in-vicinity): Update canonical->suffix. Consistently use the term "file name" throughout. * module/ice-9/psyntax.scm (include): Use global `absolute-file-name?'. * module/ice-9/psyntax-pp.scm: Regenerate. --- libguile/filesys.c | 20 +++++++++++++++++++- 1 file changed, 19 insertions(+), 1 deletion(-) (limited to 'libguile/filesys.c') diff --git a/libguile/filesys.c b/libguile/filesys.c index 9c39307b6..94d824e85 100644 --- a/libguile/filesys.c +++ b/libguile/filesys.c @@ -1,5 +1,5 @@ /* Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2004, 2006, - * 2009, 2010, 2011, 2012 Free Software Foundation, Inc. + * 2009, 2010, 2011, 2012, 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 @@ -1434,6 +1434,24 @@ SCM_DEFINE (scm_mkstemp, "mkstemp!", 1, 0, 0, SCM scm_dot_string; +#ifdef __MINGW32__ +SCM_SYMBOL (sym_file_name_convention, "windows"); +#else +SCM_SYMBOL (sym_file_name_convention, "posix"); +#endif + +SCM_INTERNAL SCM scm_system_file_name_convention (void); + +SCM_DEFINE (scm_system_file_name_convention, + "system-file-name-convention", 0, 0, 0, (void), + "Return either @code{posix} or @code{windows}, depending on\n" + "what kind of system this Guile is running on.") +#define FUNC_NAME s_scm_system_file_name_convention +{ + return sym_file_name_convention; +} +#undef FUNC_NAME + SCM_DEFINE (scm_dirname, "dirname", 1, 0, 0, (SCM filename), "Return the directory name component of the file name\n" -- cgit v1.2.3 From 5a4a4454c5302ed511eafde5a7759ebf00fbee17 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Tue, 19 Feb 2013 22:36:22 +0100 Subject: copy-file and load-objcode use O_BINARY * libguile/filesys.c (scm_copy_file): * libguile/objcodes.c (scm_load_objcode): Use O_BINARY. Thanks to Eli Zaretskii for the patch. --- libguile/filesys.c | 2 +- libguile/objcodes.c | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) (limited to 'libguile/filesys.c') diff --git a/libguile/filesys.c b/libguile/filesys.c index 94d824e85..2c4168eea 100644 --- a/libguile/filesys.c +++ b/libguile/filesys.c @@ -1095,7 +1095,7 @@ SCM_DEFINE (scm_copy_file, "copy-file", 2, 0, 0, c_newfile = scm_to_locale_string (newfile); scm_dynwind_free (c_newfile); - oldfd = open_or_open64 (c_oldfile, O_RDONLY); + oldfd = open_or_open64 (c_oldfile, O_RDONLY | O_BINARY); if (oldfd == -1) SCM_SYSERROR; diff --git a/libguile/objcodes.c b/libguile/objcodes.c index 004dd6118..a8515a7a2 100644 --- a/libguile/objcodes.c +++ b/libguile/objcodes.c @@ -1,4 +1,4 @@ -/* Copyright (C) 2001, 2009, 2010, 2011 Free Software Foundation, Inc. +/* Copyright (C) 2001, 2009, 2010, 2011, 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 @@ -363,7 +363,7 @@ SCM_DEFINE (scm_load_objcode, "load-objcode", 1, 0, 0, SCM_VALIDATE_STRING (1, file); c_file = scm_to_locale_string (file); - fd = open (c_file, O_RDONLY | O_CLOEXEC); + fd = open (c_file, O_RDONLY | O_BINARY | O_CLOEXEC); free (c_file); if (fd < 0) SCM_SYSERROR; -- cgit v1.2.3 From c21939bc247e2e36a5d698c60ba4a03cd3bbaf38 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Sun, 24 Feb 2013 14:07:13 +0100 Subject: simplify scm_stat on mingw * libguile/filesys.c (scm_stat): Don't munge the filename on MinGW; gnulib does that for us. --- libguile/filesys.c | 6 ------ 1 file changed, 6 deletions(-) (limited to 'libguile/filesys.c') diff --git a/libguile/filesys.c b/libguile/filesys.c index 2c4168eea..422a44cac 100644 --- a/libguile/filesys.c +++ b/libguile/filesys.c @@ -541,12 +541,6 @@ SCM_DEFINE (scm_stat, "stat", 1, 1, 0, else if (scm_is_string (object)) { char *file = scm_to_locale_string (object); -#ifdef __MINGW32__ - char *p; - p = file + strlen (file) - 1; - while (p > file && (*p == '/' || *p == '\\')) - *p-- = '\0'; -#endif SCM_SYSCALL (rv = stat_or_stat64 (file, &stat_temp)); free (file); } -- cgit v1.2.3 From 7a17979ea4ae769c60ca4ca291cca877701c08e1 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Sun, 24 Feb 2013 14:15:06 +0100 Subject: cleanup to filesys.c's handling of file name separators * libguile/filesys.c (is_file_name_separator): New helper, as in load.c. (scm_dirname, scm_basename, scm_i_relativize_path): Use is_file_name_separator. --- libguile/filesys.c | 71 +++++++++++++++++------------------------------------- 1 file changed, 22 insertions(+), 49 deletions(-) (limited to 'libguile/filesys.c') diff --git a/libguile/filesys.c b/libguile/filesys.c index 422a44cac..f7c83e00f 100644 --- a/libguile/filesys.c +++ b/libguile/filesys.c @@ -460,6 +460,18 @@ static int fstat_Win32 (int fdes, struct stat *buf) } #endif /* __MINGW32__ */ +static int +is_file_name_separator (SCM c) +{ + if (c == SCM_MAKE_CHAR ('/')) + return 1; +#ifdef __MINGW32__ + if (c == SCM_MAKE_CHAR ('\\')) + return 1; +#endif + return 0; +} + SCM_DEFINE (scm_stat, "stat", 1, 1, 0, (SCM object, SCM exception_on_error), "Return an object containing various information about the file\n" @@ -1461,32 +1473,17 @@ SCM_DEFINE (scm_dirname, "dirname", 1, 0, 0, len = scm_i_string_length (filename); i = len - 1; -#ifdef __MINGW32__ - while (i >= 0 && (scm_i_string_ref (filename, i) == '/' - || scm_i_string_ref (filename, i) == '\\')) - --i; - while (i >= 0 && (scm_i_string_ref (filename, i) != '/' - && scm_i_string_ref (filename, i) != '\\')) - --i; - while (i >= 0 && (scm_i_string_ref (filename, i) == '/' - || scm_i_string_ref (filename, i) == '\\')) - --i; -#else - while (i >= 0 && scm_i_string_ref (filename, i) == '/') + + while (i >= 0 && is_file_name_separator (scm_c_string_ref (filename, i))) --i; - while (i >= 0 && scm_i_string_ref (filename, i) != '/') + while (i >= 0 && !is_file_name_separator (scm_c_string_ref (filename, i))) --i; - while (i >= 0 && scm_i_string_ref (filename, i) == '/') + while (i >= 0 && is_file_name_separator (scm_c_string_ref (filename, i))) --i; -#endif /* ndef __MINGW32__ */ + if (i < 0) { -#ifdef __MINGW32__ - if (len > 0 && (scm_i_string_ref (filename, 0) == '/' - || scm_i_string_ref (filename, 0) == '\\')) -#else - if (len > 0 && scm_i_string_ref (filename, 0) == '/') -#endif /* ndef __MINGW32__ */ + if (len > 0 && is_file_name_separator (scm_c_string_ref (filename, 0))) return scm_c_substring (filename, 0, 1); else return scm_dot_string; @@ -1517,14 +1514,8 @@ SCM_DEFINE (scm_basename, "basename", 1, 1, 0, j = scm_i_string_length (suffix) - 1; } i = len - 1; -#ifdef __MINGW32__ - while (i >= 0 && (scm_i_string_ref (filename, i) == '/' - || scm_i_string_ref (filename, i) == '\\')) + while (i >= 0 && is_file_name_separator (scm_c_string_ref (filename, i))) --i; -#else - while (i >= 0 && scm_i_string_ref (filename, i) == '/') - --i; -#endif /* ndef __MINGW32__ */ end = i; while (i >= 0 && j >= 0 && (scm_i_string_ref (filename, i) @@ -1535,22 +1526,11 @@ SCM_DEFINE (scm_basename, "basename", 1, 1, 0, } if (j == -1) end = i; -#ifdef __MINGW32__ - while (i >= 0 && (scm_i_string_ref (filename, i) != '/' - && scm_i_string_ref (filename, i) != '\\')) + while (i >= 0 && !is_file_name_separator (scm_c_string_ref (filename, i))) --i; -#else - while (i >= 0 && scm_i_string_ref (filename, i) != '/') - --i; -#endif /* ndef __MINGW32__ */ if (i == end) { -#ifdef __MINGW32__ - if (len > 0 && (scm_i_string_ref (filename, 0) == '/' - || scm_i_string_ref (filename, 0) == '\\')) -#else - if (len > 0 && scm_i_string_ref (filename, 0) == '/') -#endif /* ndef __MINGW32__ */ + if (len > 0 && is_file_name_separator (scm_c_string_ref (filename, 0))) return scm_c_substring (filename, 0, 1); else return scm_dot_string; @@ -1617,14 +1597,7 @@ scm_i_relativize_path (SCM path, SCM in_path) will be delimited by single delimiters. When DIR does not have a trailing delimiter, add one to the length to strip off the delimiter within SCANON. */ - if ( -#ifdef __MINGW32__ - (scm_i_string_ref (dir, len - 1) != '/' - && scm_i_string_ref (dir, len - 1) != '\\') -#else - scm_i_string_ref (dir, len - 1) != '/' -#endif - ) + if (!is_file_name_separator (scm_c_string_ref (dir, len - 1))) len++; if (scm_c_string_length (scanon) > len) -- cgit v1.2.3 From 69b6da07c386446d16a11cc41cb64b486199413c Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 4 Mar 2013 08:56:47 +0100 Subject: Use `scm_is_eq' in filesys.c. * libguile/filesys.c (is_file_name_separator): Use `scm_is_eq' instead of `=='. Fixes . --- libguile/filesys.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'libguile/filesys.c') diff --git a/libguile/filesys.c b/libguile/filesys.c index f7c83e00f..cd4be792f 100644 --- a/libguile/filesys.c +++ b/libguile/filesys.c @@ -463,10 +463,10 @@ static int fstat_Win32 (int fdes, struct stat *buf) static int is_file_name_separator (SCM c) { - if (c == SCM_MAKE_CHAR ('/')) + if (scm_is_eq (c, SCM_MAKE_CHAR ('/'))) return 1; #ifdef __MINGW32__ - if (c == SCM_MAKE_CHAR ('\\')) + if (scm_is_eq (c, SCM_MAKE_CHAR ('\\'))) return 1; #endif return 0; -- cgit v1.2.3 From ba59471eeeeb6738f87e1c9c4050ce4698a7c9d8 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Sat, 9 Mar 2013 22:30:26 +0100 Subject: simplify filesys.c via gnulib's select and fstat modules * libguile/filesys.c: Instead of using scm_std_select, just use select, relying on gnulib to provide it to us. Likewise, rely on fstat. --- libguile/filesys.c | 63 +++++++++--------------------------------------------- 1 file changed, 10 insertions(+), 53 deletions(-) (limited to 'libguile/filesys.c') diff --git a/libguile/filesys.c b/libguile/filesys.c index cd4be792f..282ff31b2 100644 --- a/libguile/filesys.c +++ b/libguile/filesys.c @@ -45,7 +45,6 @@ #include "libguile/feature.h" #include "libguile/fports.h" #include "libguile/private-gc.h" /* for SCM_MAX */ -#include "libguile/iselect.h" #include "libguile/strings.h" #include "libguile/vectors.h" #include "libguile/dynwind.h" @@ -81,9 +80,7 @@ #include #endif -#ifdef HAVE_SYS_SELECT_H #include -#endif #ifdef HAVE_STRING_H #include @@ -435,31 +432,6 @@ scm_stat2scm (struct stat_or_stat64 *stat_temp) return ans; } -#ifdef __MINGW32__ -/* - * Try getting the appropiate stat buffer for a given file descriptor - * under Windows. It differentiates between file, pipe and socket - * descriptors. - */ -static int fstat_Win32 (int fdes, struct stat *buf) -{ - int error, optlen = sizeof (int); - - memset (buf, 0, sizeof (struct stat)); - - /* Is this a socket ? */ - if (getsockopt (fdes, SOL_SOCKET, SO_ERROR, (void *) &error, &optlen) >= 0) - { - buf->st_mode = _S_IREAD | _S_IWRITE | _S_IEXEC; - buf->st_nlink = 1; - buf->st_atime = buf->st_ctime = buf->st_mtime = time (NULL); - return 0; - } - /* Maybe a regular file or pipe ? */ - return fstat (fdes, buf); -} -#endif /* __MINGW32__ */ - static int is_file_name_separator (SCM c) { @@ -544,11 +516,7 @@ SCM_DEFINE (scm_stat, "stat", 1, 1, 0, if (scm_is_integer (object)) { -#ifdef __MINGW32__ - SCM_SYSCALL (rv = fstat_Win32 (scm_to_int (object), &stat_temp)); -#else SCM_SYSCALL (rv = fstat_or_fstat64 (scm_to_int (object), &stat_temp)); -#endif } else if (scm_is_string (object)) { @@ -561,11 +529,7 @@ SCM_DEFINE (scm_stat, "stat", 1, 1, 0, object = SCM_COERCE_OUTPORT (object); SCM_VALIDATE_OPFPORT (1, object); fdes = SCM_FPORT_FDES (object); -#ifdef __MINGW32__ - SCM_SYSCALL (rv = fstat_Win32 (fdes, &stat_temp)); -#else SCM_SYSCALL (rv = fstat_or_fstat64 (fdes, &stat_temp)); -#endif } if (rv == -1) @@ -659,15 +623,13 @@ SCM_DEFINE (scm_chdir, "chdir", 1, 0, 0, -#ifdef HAVE_SELECT - /* check that element is a port or file descriptor. if it's a port and its buffer is ready for use, add it to the ports_ready list. otherwise add its file descriptor to *set. the type of list can be determined from pos: SCM_ARG1 for reads, SCM_ARG2 for writes, SCM_ARG3 for excepts. */ static int -set_element (SELECT_TYPE *set, SCM *ports_ready, SCM element, int pos) +set_element (fd_set *set, SCM *ports_ready, SCM element, int pos) { int fd; @@ -713,7 +675,7 @@ set_element (SELECT_TYPE *set, SCM *ports_ready, SCM element, int pos) determined from pos: SCM_ARG1 for reads, SCM_ARG2 for writes, SCM_ARG3 for excepts. */ static int -fill_select_type (SELECT_TYPE *set, SCM *ports_ready, SCM list_or_vec, int pos) +fill_select_type (fd_set *set, SCM *ports_ready, SCM list_or_vec, int pos) { int max_fd = 0; @@ -748,7 +710,7 @@ fill_select_type (SELECT_TYPE *set, SCM *ports_ready, SCM list_or_vec, int pos) /* if element (a file descriptor or port) appears in *set, cons it to list. return list. */ static SCM -get_element (SELECT_TYPE *set, SCM element, SCM list) +get_element (fd_set *set, SCM element, SCM list) { int fd; @@ -774,7 +736,7 @@ get_element (SELECT_TYPE *set, SCM element, SCM list) *set and appending them to ports_ready. result is converted to a vector if list_or_vec is a vector. */ static SCM -retrieve_select_type (SELECT_TYPE *set, SCM ports_ready, SCM list_or_vec) +retrieve_select_type (fd_set *set, SCM ports_ready, SCM list_or_vec) { SCM answer_list = ports_ready; @@ -835,9 +797,9 @@ SCM_DEFINE (scm_select, "select", 3, 2, 0, { struct timeval timeout; struct timeval * time_ptr; - SELECT_TYPE read_set; - SELECT_TYPE write_set; - SELECT_TYPE except_set; + fd_set read_set; + fd_set write_set; + fd_set except_set; int read_count; int write_count; int except_count; @@ -928,9 +890,9 @@ SCM_DEFINE (scm_select, "select", 3, 2, 0, } { - int rv = scm_std_select (max_fd + 1, - &read_set, &write_set, &except_set, - time_ptr); + int rv = select (max_fd + 1, + &read_set, &write_set, &except_set, + time_ptr); if (rv < 0) SCM_SYSERROR; } @@ -939,7 +901,6 @@ SCM_DEFINE (scm_select, "select", 3, 2, 0, retrieve_select_type (&except_set, SCM_EOL, excepts)); } #undef FUNC_NAME -#endif /* HAVE_SELECT */ @@ -1105,11 +1066,7 @@ SCM_DEFINE (scm_copy_file, "copy-file", 2, 0, 0, if (oldfd == -1) SCM_SYSERROR; -#ifdef __MINGW32__ - SCM_SYSCALL (rv = fstat_Win32 (oldfd, &oldstat)); -#else SCM_SYSCALL (rv = fstat_or_fstat64 (oldfd, &oldstat)); -#endif if (rv == -1) goto err_close_oldfd; -- cgit v1.2.3 From fbac7c6113056bc6ee85996b10bdc08325c742a5 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 20 Mar 2013 23:04:11 +0100 Subject: Add bindings for `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 | 91 +++++++++++++++++++++++++++++++++++++++++++ libguile/filesys.h | 4 +- test-suite/tests/filesys.test | 70 ++++++++++++++++++++++++++++++++- 5 files changed, 201 insertions(+), 7 deletions(-) (limited to 'libguile/filesys.c') diff --git a/configure.ac b/configure.ac index 42de73307..bcfc1a65e 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 ded3787df..bc8732932 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 282ff31b2..6804db9fb 100644 --- a/libguile/filesys.c +++ b/libguile/filesys.c @@ -98,6 +98,18 @@ #define NAMLEN(dirent) strlen ((dirent)->d_name) +#ifdef HAVE_SYS_SENDFILE_H +# include +#endif + +/* Glibc's `sendfile' function. */ +#define sendfile_or_sendfile64 \ + CHOOSE_LARGEFILE (sendfile, sendfile64) + +#include +#include + + /* Some more definitions for the native Windows port. */ #ifdef __MINGW32__ # define fsync(fd) _commit (fd) @@ -1096,6 +1108,85 @@ 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; + scm_t_off 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_or_sendfile64 (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) when such an error occurs. */ + if (result < 0 && errno != EINVAL && errno != ENOSYS) + SCM_SYSERROR; + else if (result < 0) +#endif + { + char buf[8192]; + size_t result, 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_size_t (result); + } + + 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 967ce7450..776b263cc 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 a6bfb6eb5..c80c2956c 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)) -- cgit v1.2.3 From f28885f4957882c4d96bdfee11d26cd265539aac Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 25 Mar 2013 13:28:42 +0100 Subject: sendfile: Check return value of `lseek'. * libguile/filesys.c (scm_sendfile): Check return value of `lseek_or_lseek64', and use `SCM_SYSERROR' upon error. --- libguile/filesys.c | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) (limited to 'libguile/filesys.c') diff --git a/libguile/filesys.c b/libguile/filesys.c index 6804db9fb..334e2cd07 100644 --- a/libguile/filesys.c +++ b/libguile/filesys.c @@ -1157,7 +1157,10 @@ SCM_DEFINE (scm_sendfile, "sendfile", 3, 1, 0, if (SCM_PORTP (in)) scm_seek (in, offset, scm_from_int (SEEK_SET)); else - lseek_or_lseek64 (in_fd, c_offset, SEEK_SET); + { + if (lseek_or_lseek64 (in_fd, c_offset, SEEK_SET) < 0) + SCM_SYSERROR; + } } for (result = 0, left = c_count; result < c_count; ) -- cgit v1.2.3 From 11ed42771dec06626457eae58f2f334df1397f72 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 25 Mar 2013 13:51:57 +0100 Subject: sendfile: Make sure we have a Linux-style `sendfile'. * libguile/filesys.c (scm_sendfile): Change conditional to HAVE_SYS_SENDFILE_H && HAVE_SENDFILE. --- libguile/filesys.c | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'libguile/filesys.c') diff --git a/libguile/filesys.c b/libguile/filesys.c index 334e2cd07..d318ae793 100644 --- a/libguile/filesys.c +++ b/libguile/filesys.c @@ -1136,7 +1136,9 @@ SCM_DEFINE (scm_sendfile, "sendfile", 3, 1, 0, c_count = scm_to_size_t (count); c_offset = SCM_UNBNDP (offset) ? 0 : scm_to_off_t (offset); -#ifdef HAVE_SENDFILE +#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); -- cgit v1.2.3