/* Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2004, 2006,
- * 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
+ * 2009, 2010, 2011, 2012, 2013, 2014 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
#include "libguile/smob.h"
#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"
#include "libguile/validate.h"
#include "libguile/filesys.h"
+#include "libguile/load.h" /* for scm_i_mirror_backslashes */
\f
#ifdef HAVE_IO_H
# endif
#endif
-#ifdef HAVE_UNISTD_H
#include <unistd.h>
-#endif
#ifdef LIBC_H_WITH_UNISTD_H
#include <libc.h>
#endif
-#ifdef HAVE_SYS_SELECT_H
#include <sys/select.h>
-#endif
#ifdef HAVE_STRING_H
#include <string.h>
#define NAMLEN(dirent) strlen ((dirent)->d_name)
-/* Some more definitions for the native Windows port. */
-#ifdef __MINGW32__
-# define fsync(fd) _commit (fd)
-#endif /* __MINGW32__ */
+#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>
\f
eno = errno; scm_dynwind_end (); errno = eno; \
} while (0)
+
+#define MAX(A, B) ((A) > (B) ? (A) : (B))
+#define MIN(A, B) ((A) < (B) ? (A) : (B))
+
\f
#ifdef HAVE_POSIX
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)
{
- 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;
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))
{
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)
}
#undef FUNC_NAME
-#ifdef HAVE_LSTAT
SCM_DEFINE (scm_lstat, "lstat", 1, 0, 0,
(SCM str),
"Similar to @code{stat}, but does not follow symbolic links, i.e.,\n"
return scm_stat2scm (&stat_temp);
}
#undef FUNC_NAME
-#endif /* HAVE_LSTAT */
\f
#ifdef HAVE_POSIX
/* {Modifying Directories}
*/
-#ifdef HAVE_LINK
SCM_DEFINE (scm_link, "link", 2, 0, 0,
(SCM oldpath, SCM newpath),
"Creates a new name @var{newpath} in the file system for the\n"
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
-#endif /* HAVE_LINK */
\f
/* {Navigating Directories}
\f
-#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;
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;
- if (scm_is_simple_vector (list_or_vec))
+ if (scm_is_vector (list_or_vec))
{
int i = SCM_SIMPLE_VECTOR_LENGTH (list_or_vec);
/* 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;
*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;
- if (scm_is_simple_vector (list_or_vec))
+ if (scm_is_vector (list_or_vec))
{
int i = SCM_SIMPLE_VECTOR_LENGTH (list_or_vec);
"This procedure has a variety of uses: waiting for the ability\n"
"to provide input, accept output, or the existence of\n"
"exceptional conditions on a collection of ports or file\n"
- "descriptors, or waiting for a timeout to occur.\n"
- "It also returns if interrupted by a signal.\n\n"
+ "descriptors, or waiting for a timeout to occur.\n\n"
+
+ "When an error occurs, of if it is interrupted by a signal, this\n"
+ "procedure throws a @code{system-error} exception\n"
+ "(@pxref{Conventions, @code{system-error}}). In case of an\n"
+ "interruption, the associated error number is @var{EINTR}.\n\n"
+
"@var{reads}, @var{writes} and @var{excepts} can be lists or\n"
"vectors, with each member a port or a file descriptor.\n"
"The value returned is a list of three corresponding\n"
{
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;
SCM write_ports_ready = SCM_EOL;
int max_fd;
- if (scm_is_simple_vector (reads))
+ if (scm_is_vector (reads))
{
read_count = SCM_SIMPLE_VECTOR_LENGTH (reads);
}
read_count = scm_ilength (reads);
SCM_ASSERT (read_count >= 0, reads, SCM_ARG1, FUNC_NAME);
}
- if (scm_is_simple_vector (writes))
+ if (scm_is_vector (writes))
{
write_count = SCM_SIMPLE_VECTOR_LENGTH (writes);
}
write_count = scm_ilength (writes);
SCM_ASSERT (write_count >= 0, writes, SCM_ARG2, FUNC_NAME);
}
- if (scm_is_simple_vector (excepts))
+ if (scm_is_vector (excepts))
{
except_count = SCM_SIMPLE_VECTOR_LENGTH (excepts);
}
}
{
- 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;
}
retrieve_select_type (&except_set, SCM_EOL, excepts));
}
#undef FUNC_NAME
-#endif /* HAVE_SELECT */
\f
if (SCM_OPFPORTP (object))
{
- scm_flush (object);
+ scm_flush_unlocked (object);
fdes = SCM_FPORT_FDES (object);
}
else
#undef FUNC_NAME
#endif /* HAVE_SYMLINK */
-#ifdef HAVE_READLINK
SCM_DEFINE (scm_readlink, "readlink", 1, 0, 0,
(SCM path),
"Return the value of the symbolic link named by @var{path} (a\n"
return result;
}
#undef FUNC_NAME
-#endif /* HAVE_READLINK */
SCM_DEFINE (scm_copy_file, "copy-file", 2, 0, 0,
(SCM oldfile, SCM newfile),
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;
}
#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 "
+ "must be 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}. Return "
+ "the number of bytes actually sent.")
+#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); \
+ }
+
+ ssize_t result SCM_UNUSED;
+ size_t c_count, total = 0;
+ scm_t_off c_offset;
+ 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);
+
+#if defined HAVE_SYS_SENDFILE_H && defined HAVE_SENDFILE
+ /* The Linux-style sendfile(2), which is different from the BSD-style. */
+
+ {
+ off_t *offset_ptr;
+
+ offset_ptr = SCM_UNBNDP (offset) ? NULL : &c_offset;
+
+ /* On Linux, when OUT_FD is a file, everything is transferred at once and
+ RESULT == C_COUNT. However, when OUT_FD is a pipe or other "slow"
+ device, fewer bytes may be transferred, hence the loop. RESULT == 0
+ means EOF on IN_FD, so leave the loop in that case. */
+ do
+ {
+ result = sendfile_or_sendfile64 (out_fd, in_fd, offset_ptr,
+ c_count - total);
+ if (result > 0)
+ /* At this point, either OFFSET_PTR is non-NULL and it has been
+ updated to the current offset in IN_FD, or it is NULL and IN_FD's
+ offset has been updated. */
+ total += result;
+ else if (result < 0 && (errno == EINTR || errno == EAGAIN))
+ /* Keep going. */
+ result = 1;
+ }
+ while (total < c_count && result > 0);
+ }
+
+ /* 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 left;
+ int reached_eof = 0;
+
+ if (!SCM_UNBNDP (offset))
+ {
+ if (SCM_PORTP (in))
+ scm_seek (in, scm_from_off_t (c_offset), scm_from_int (SEEK_SET));
+ else
+ {
+ if (lseek_or_lseek64 (in_fd, c_offset, SEEK_SET) < 0)
+ SCM_SYSERROR;
+ }
+ }
+
+ for (total = 0, left = c_count; total < c_count && !reached_eof; )
+ {
+ size_t asked, obtained, written;
+
+ asked = MIN (sizeof buf, left);
+ obtained = full_read (in_fd, buf, asked);
+ if (obtained < asked)
+ {
+ if (errno == 0)
+ reached_eof = 1;
+ else
+ SCM_SYSERROR;
+ }
+
+ left -= obtained;
+
+ written = full_write (out_fd, buf, obtained);
+ if (written < obtained)
+ SCM_SYSERROR;
+
+ total += written;
+ }
+
+ }
+
+ return scm_from_size_t (total);
+
+#undef VALIDATE_FD_OR_PORT
+}
+#undef FUNC_NAME
+
#endif /* HAVE_POSIX */
\f
errno = save_errno;
SCM_SYSERROR;
}
+ /* On Windows, convert backslashes in current directory to forward
+ slashes. */
+ scm_i_mirror_backslashes (wd);
result = scm_from_locale_stringn (wd, strlen (wd));
free (wd);
return result;
#undef FUNC_NAME
#endif /* HAVE_GETCWD */
-#ifdef HAVE_MKDIR
SCM_DEFINE (scm_mkdir, "mkdir", 1, 1, 0,
(SCM path, SCM mode),
"Create a new directory named by @var{path}. If @var{mode} is omitted\n"
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
-#endif /* HAVE_MKDIR */
-#ifdef HAVE_RMDIR
SCM_DEFINE (scm_rmdir, "rmdir", 1, 0, 0,
(SCM path),
"Remove the existing directory named by @var{path}. The directory must\n"
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
-#endif
-
-#ifdef HAVE_RENAME
-#define my_rename rename
-#else
-static int
-my_rename (const char *oldname, const char *newname)
-{
- int rv;
-
- SCM_SYSCALL (rv = link (oldname, newname));
- if (rv == 0)
- {
- SCM_SYSCALL (rv = unlink (oldname));
- if (rv != 0)
- /* unlink failed. remove new name */
- SCM_SYSCALL (unlink (newname));
- }
- return rv;
-}
-#endif
SCM_DEFINE (scm_rename, "rename-file", 2, 0, 0,
(SCM oldname, SCM newname),
STRING2_SYSCALL (oldname, c_oldname,
newname, c_newname,
- rv = my_rename (c_oldname, c_newname));
+ rv = rename (c_oldname, c_newname));
if (rv != 0)
SCM_SYSERROR;
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
-#ifndef HAVE_MKSTEMP
-extern int mkstemp (char *);
-#endif
-
SCM_DEFINE (scm_mkstemp, "mkstemp!", 1, 0, 0,
(SCM tmpl),
"Create a new unique file in the file system and return a new\n"
SCM_MISC_ERROR ("Directory ~S is not open.", scm_list_1 (port));
#if HAVE_READDIR_R
- /* As noted in the glibc manual, on various systems (such as Solaris) the
- d_name[] field is only 1 char and you're expected to size the dirent
- buffer for readdir_r based on NAME_MAX. The SCM_MAX expressions below
- effectively give either sizeof(d_name) or NAME_MAX+1, whichever is
- bigger.
+ /* As noted in the glibc manual, on various systems (such as Solaris)
+ the d_name[] field is only 1 char and you're expected to size the
+ dirent buffer for readdir_r based on NAME_MAX. The MAX expressions
+ below effectively give either sizeof(d_name) or NAME_MAX+1,
+ whichever is bigger.
On solaris 10 there's no NAME_MAX constant, it's necessary to use
pathconf(). We prefer NAME_MAX though, since it should be a constant
struct dirent_or_dirent64 de; /* just for sizeof */
DIR *ds = (DIR *) SCM_SMOB_DATA_1 (port);
#ifdef NAME_MAX
- char buf [SCM_MAX (sizeof (de),
- sizeof (de) - sizeof (de.d_name) + NAME_MAX + 1)];
+ char buf [MAX (sizeof (de),
+ sizeof (de) - sizeof (de.d_name) + NAME_MAX + 1)];
#else
char *buf;
long name_max = fpathconf (dirfd (ds), _PC_NAME_MAX);
if (name_max == -1)
SCM_SYSERROR;
- buf = alloca (SCM_MAX (sizeof (de),
- sizeof (de) - sizeof (de.d_name) + name_max + 1));
+ buf = alloca (MAX (sizeof (de),
+ sizeof (de) - sizeof (de.d_name) + name_max + 1));
#endif
errno = 0;
static int
scm_dir_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
{
- scm_puts ("#<", port);
+ scm_puts_unlocked ("#<", port);
if (!SCM_DIR_OPEN_P (exp))
- scm_puts ("closed: ", port);
- scm_puts ("directory stream ", port);
+ scm_puts_unlocked ("closed: ", port);
+ scm_puts_unlocked ("directory stream ", port);
scm_uintprint (SCM_SMOB_DATA_1 (exp), 16, port);
- scm_putc ('>', port);
+ scm_putc_unlocked ('>', port);
return 1;
}
HCoop / bpt / guile.git / blobdiff