mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-20 11:40:18 +02:00
Add bindings for `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'.
This commit is contained in:
Ludovic Courtès
parent
e8a57fb052
commit
fbac7c6113
5 changed files with 201 additions and 7 deletions
20
configure.ac
20
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"])
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -98,6 +98,18 @@
|
|||
|
||||
#define NAMLEN(dirent) strlen ((dirent)->d_name)
|
||||
|
||||
#ifdef HAVE_SYS_SENDFILE_H
|
||||
# include <sys/sendfile.h>
|
||||
#endif
|
||||
|
||||
/* Glibc's `sendfile' function. */
|
||||
#define sendfile_or_sendfile64 \
|
||||
CHOOSE_LARGEFILE (sendfile, sendfile64)
|
||||
|
||||
#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 +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 */
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue