build: Don't include <config.h> in native programs when cross-compiling.
[bpt/guile.git] / libguile / filesys.c
index 422a44c..09f6cf9 100644 (file)
@@ -1,5 +1,5 @@
 /* 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
@@ -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"
 # 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
@@ -435,30 +436,17 @@ 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)
+static int
+is_file_name_separator (SCM c)
 {
-  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);
+  if (scm_is_eq (c, SCM_MAKE_CHAR ('/')))
+    return 1;
+#ifdef __MINGW32__
+  if (scm_is_eq (c, SCM_MAKE_CHAR ('\\')))
+    return 1;
+#endif
+  return 0;
 }
-#endif /* __MINGW32__ */
 
 SCM_DEFINE (scm_stat, "stat", 1, 1, 0, 
             (SCM object, SCM exception_on_error),
@@ -532,11 +520,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))
     {
@@ -549,11 +533,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)
@@ -573,7 +553,6 @@ SCM_DEFINE (scm_stat, "stat", 1, 1, 0,
 }
 #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"
@@ -596,7 +575,6 @@ SCM_DEFINE (scm_lstat, "lstat", 1, 0, 0,
   return scm_stat2scm (&stat_temp);
 }
 #undef FUNC_NAME
-#endif /* HAVE_LSTAT */
 
 \f
 #ifdef HAVE_POSIX
@@ -604,7 +582,6 @@ SCM_DEFINE (scm_lstat, "lstat", 1, 0, 0,
 /* {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"
@@ -623,7 +600,6 @@ SCM_DEFINE (scm_link, "link", 2, 0, 0,
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
-#endif /* HAVE_LINK */
 
 \f
 /* {Navigating Directories}
@@ -647,15 +623,13 @@ SCM_DEFINE (scm_chdir, "chdir", 1, 0, 0,
 
 \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;
 
@@ -701,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;
 
@@ -736,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;
 
@@ -762,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;
 
@@ -823,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;
@@ -916,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;
   }
@@ -927,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 */
 
 \f
 
@@ -1029,7 +1002,6 @@ SCM_DEFINE (scm_symlink, "symlink", 2, 0, 0,
 #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"
@@ -1068,7 +1040,6 @@ SCM_DEFINE (scm_readlink, "readlink", 1, 0, 0,
   return result;
 }
 #undef FUNC_NAME
-#endif /* HAVE_READLINK */
 
 SCM_DEFINE (scm_copy_file, "copy-file", 2, 0, 0,
             (SCM oldfile, SCM newfile),
@@ -1093,11 +1064,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;
 
@@ -1127,6 +1094,117 @@ 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 "
+           "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 = SCM_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
@@ -1164,7 +1242,6 @@ SCM_DEFINE (scm_getcwd, "getcwd", 0, 0, 0,
 #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"
@@ -1191,9 +1268,7 @@ SCM_DEFINE (scm_mkdir, "mkdir", 1, 1, 0,
   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"
@@ -1208,27 +1283,6 @@ SCM_DEFINE (scm_rmdir, "rmdir", 1, 0, 0,
   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),
@@ -1240,7 +1294,7 @@ SCM_DEFINE (scm_rename, "rename-file", 2, 0, 0,
 
   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;
@@ -1375,10 +1429,6 @@ SCM_DEFINE (scm_umask, "umask", 0, 1, 0,
 }
 #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"
@@ -1461,32 +1511,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 +1552,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) ==  '\\'))
-    --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;
-#endif /* ndef __MINGW32__ */
   end = i;
   while (i >= 0 && j >= 0 
         && (scm_i_string_ref (filename, i)
@@ -1535,22 +1564,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) != '\\'))
-    --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;
-#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 +1635,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)