-/* Copyright (C) 1996,1997,1998,1999,2000,2001, 2002, 2004 Free Software Foundation, Inc.
+/* Copyright (C) 1996,1997,1998,1999,2000,2001, 2002, 2004, 2006, 2009, 2010 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 as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
*
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
* Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with this library; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
*/
\f
/* See stime.c for comments on why _POSIX_C_SOURCE is not always defined. */
-#define _GNU_SOURCE /* ask glibc for everything */
+#define _LARGEFILE64_SOURCE /* ask for stat64 etc */
#ifdef __hpux
#define _POSIX_C_SOURCE 199506L /* for readdir_r */
#endif
-#if HAVE_CONFIG_H
+#ifdef HAVE_CONFIG_H
# include <config.h>
#endif
+#include <alloca.h>
+
+#include <stdlib.h>
#include <stdio.h>
#include <errno.h>
#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/lang.h"
#include "libguile/dynwind.h"
#include "libguile/validate.h"
#if defined (__MINGW32__) || defined (_MSC_VER) || defined (__BORLANDC__)
# include "win32-dirent.h"
# define NAMLEN(dirent) strlen((dirent)->d_name)
+/* The following bits are per AC_HEADER_DIRENT doco in the autoconf manual */
#elif HAVE_DIRENT_H
# include <dirent.h>
# define NAMLEN(dirent) strlen((dirent)->d_name)
# endif
#endif
-/* Ultrix has S_IFSOCK, but no S_ISSOCK. Ipe! */
-#if defined (S_IFSOCK) && ! defined (S_ISSOCK)
-#define S_ISSOCK(mode) (((mode) & S_IFMT) == S_IFSOCK)
-#endif
-
-/* The MinGW gcc does not define the S_ISSOCK macro. Any other native Windows
- compiler like BorlandC or MSVC has none of these macros defined. */
-#ifdef __MINGW32__
-
-# ifdef _S_IFIFO
-# undef _S_IFIFO
-# endif
-# ifdef _S_IFCHR
-# undef _S_IFCHR
-# endif
-# ifdef _S_IFBLK
-# undef _S_IFBLK
-# endif
-# ifdef _S_IFDIR
-# undef _S_IFDIR
-# endif
-# ifdef _S_IFREG
-# undef _S_IFREG
-# endif
-# ifdef _S_IFSOCK
-# undef _S_IFSOCK
-# endif
-
-# define _S_IFIFO 0x1000 /* FIFO */
-# define _S_IFCHR 0x2000 /* Character */
-# define _S_IFBLK 0x3000 /* Block */
-# define _S_IFDIR 0x4000 /* Directory */
-# define _S_IFREG 0x8000 /* Regular */
-# define _S_IFSOCK 0xC000 /* Socket */
-
-# ifdef S_ISBLK
-# undef S_ISBLK
-# endif
-# ifdef S_ISFIFO
-# undef S_ISFIFO
-# endif
-# ifdef S_ISCHR
-# undef S_ISCHR
-# endif
-# ifdef S_ISDIR
-# undef S_ISDIR
-# endif
-# ifdef S_ISREG
-# undef S_ISREG
-# endif
-# ifdef S_ISSOCK
-# undef S_ISSOCK
-# endif
-
-# define S_ISBLK(mode) (((mode) & _S_IFMT) == _S_IFBLK)
-# define S_ISFIFO(mode) (((mode) & _S_IFMT) == _S_IFIFO)
-# define S_ISCHR(mode) (((mode) & _S_IFMT) == _S_IFCHR)
-# define S_ISDIR(mode) (((mode) & _S_IFMT) == _S_IFDIR)
-# define S_ISREG(mode) (((mode) & _S_IFMT) == _S_IFREG)
-# define S_ISSOCK(mode) (((mode) & _S_IFMT) == _S_IFSOCK)
-
-#endif /* __MINGW32__ */
-
/* Some more definitions for the native Windows port. */
#ifdef __MINGW32__
# define mkdir(path, mode) mkdir (path)
# define fsync(fd) _commit (fd)
# define fchmod(fd, mode) (-1)
#endif /* __MINGW32__ */
+
+/* dirfd() returns the file descriptor underlying a "DIR*" directory stream.
+ Found on MacOS X for instance. The following definition is for Solaris
+ 10, it's probably not right elsewhere, but that's ok, it shouldn't be
+ used elsewhere. Crib note: If we need more then gnulib has a dirfd.m4
+ figuring out how to get the fd (dirfd function, dirfd macro, dd_fd field,
+ or d_fd field). */
+#ifndef dirfd
+#define dirfd(dirstream) ((dirstream)->dd_fd)
+#endif
+
\f
/* Two helper macros for an often used pattern */
do { \
int eno; \
char *cstr1, *cstr2; \
- scm_frame_begin (0); \
+ scm_dynwind_begin (0); \
cstr1 = scm_to_locale_string (str1); \
- scm_frame_free (cstr1); \
+ scm_dynwind_free (cstr1); \
cstr2 = scm_to_locale_string (str2); \
- scm_frame_free (cstr2); \
+ scm_dynwind_free (cstr2); \
SCM_SYSCALL (code); \
- eno = errno; scm_frame_end (); errno = eno; \
+ eno = errno; scm_dynwind_end (); errno = eno; \
} while (0)
\f
iflags = SCM_NUM2INT (2, flags);
imode = SCM_NUM2INT_DEF (3, mode, 0666);
- STRING_SYSCALL (path, c_path, fd = open (c_path, iflags, imode));
+ STRING_SYSCALL (path, c_path, fd = open_or_open64 (c_path, iflags, imode));
if (fd == -1)
SCM_SYSERROR;
return scm_from_int (fd);
SCM_SYMBOL (scm_sym_regular, "regular");
SCM_SYMBOL (scm_sym_directory, "directory");
-#ifdef HAVE_S_ISLNK
+#ifdef S_ISLNK
SCM_SYMBOL (scm_sym_symlink, "symlink");
#endif
SCM_SYMBOL (scm_sym_block_special, "block-special");
SCM_SYMBOL (scm_sym_unknown, "unknown");
static SCM
-scm_stat2scm (struct stat *stat_temp)
+scm_stat2scm (struct stat_or_stat64 *stat_temp)
{
- SCM ans = scm_c_make_vector (15, SCM_UNSPECIFIED);
+ SCM ans = scm_c_make_vector (18, SCM_UNSPECIFIED);
SCM_SIMPLE_VECTOR_SET(ans, 0, scm_from_ulong (stat_temp->st_dev));
- SCM_SIMPLE_VECTOR_SET(ans, 1, scm_from_ulong (stat_temp->st_ino));
+ SCM_SIMPLE_VECTOR_SET(ans, 1, scm_from_ino_t_or_ino64_t (stat_temp->st_ino));
SCM_SIMPLE_VECTOR_SET(ans, 2, scm_from_ulong (stat_temp->st_mode));
SCM_SIMPLE_VECTOR_SET(ans, 3, scm_from_ulong (stat_temp->st_nlink));
SCM_SIMPLE_VECTOR_SET(ans, 4, scm_from_ulong (stat_temp->st_uid));
#else
SCM_SIMPLE_VECTOR_SET(ans, 6, SCM_BOOL_F);
#endif
- SCM_SIMPLE_VECTOR_SET(ans, 7, scm_from_ulong (stat_temp->st_size));
+ SCM_SIMPLE_VECTOR_SET(ans, 7, scm_from_off_t_or_off64_t (stat_temp->st_size));
SCM_SIMPLE_VECTOR_SET(ans, 8, scm_from_ulong (stat_temp->st_atime));
SCM_SIMPLE_VECTOR_SET(ans, 9, scm_from_ulong (stat_temp->st_mtime));
SCM_SIMPLE_VECTOR_SET(ans, 10, scm_from_ulong (stat_temp->st_ctime));
SCM_SIMPLE_VECTOR_SET(ans, 11, scm_from_ulong (4096L));
#endif
#ifdef HAVE_STRUCT_STAT_ST_BLOCKS
- SCM_SIMPLE_VECTOR_SET(ans, 12, scm_from_ulong (stat_temp->st_blocks));
+ SCM_SIMPLE_VECTOR_SET(ans, 12, scm_from_blkcnt_t_or_blkcnt64_t (stat_temp->st_blocks));
#else
SCM_SIMPLE_VECTOR_SET(ans, 12, SCM_BOOL_F);
#endif
SCM_SIMPLE_VECTOR_SET(ans, 13, scm_sym_regular);
else if (S_ISDIR (mode))
SCM_SIMPLE_VECTOR_SET(ans, 13, scm_sym_directory);
-#ifdef HAVE_S_ISLNK
+#ifdef S_ISLNK
+ /* systems without symlinks probably don't have S_ISLNK */
else if (S_ISLNK (mode))
SCM_SIMPLE_VECTOR_SET(ans, 13, scm_sym_symlink);
#endif
*/
}
+#ifdef HAVE_STRUCT_STAT_ST_ATIM
+ SCM_SIMPLE_VECTOR_SET(ans, 15, scm_from_long (stat_temp->st_atim.tv_nsec));
+#else
+ SCM_SIMPLE_VECTOR_SET(ans, 15, SCM_I_MAKINUM (0));
+#endif
+#ifdef HAVE_STRUCT_STAT_ST_MTIM
+ SCM_SIMPLE_VECTOR_SET(ans, 16, scm_from_long (stat_temp->st_mtim.tv_nsec));
+#else
+ SCM_SIMPLE_VECTOR_SET(ans, 16, SCM_I_MAKINUM (0));
+#endif
+#ifdef HAVE_STRUCT_STAT_ST_CTIM
+ SCM_SIMPLE_VECTOR_SET(ans, 17, scm_from_ulong (stat_temp->st_ctim.tv_sec));
+#else
+ SCM_SIMPLE_VECTOR_SET(ans, 17, SCM_I_MAKINUM (0));
+#endif
return ans;
}
}
#endif /* __MINGW32__ */
-SCM_DEFINE (scm_stat, "stat", 1, 0, 0,
- (SCM object),
+SCM_DEFINE (scm_stat, "stat", 1, 1, 0,
+ (SCM object, SCM exception_on_error),
"Return an object containing various information about the file\n"
"determined by @var{obj}. @var{obj} can be a string containing\n"
"a file name or a port or integer file descriptor which is open\n"
"on a file (in which case @code{fstat} is used as the underlying\n"
"system call).\n"
"\n"
- "The object returned by @code{stat} can be passed as a single\n"
- "parameter to the following procedures, all of which return\n"
- "integers:\n"
+ "If the optional @var{exception_on_error} argument is true, which\n"
+ "is the default, an exception will be raised if the underlying\n"
+ "system call returns an error, for example if the file is not\n"
+ "found or is not readable. Otherwise, an error will cause\n"
+ "@code{stat} to return @code{#f}."
+ "\n"
+ "The object returned by a successful call to @code{stat} can be\n"
+ "passed as a single parameter to the following procedures, all of\n"
+ "which return integers:\n"
"\n"
"@table @code\n"
"@item stat:dev\n"
{
int rv;
int fdes;
- struct stat stat_temp;
+ struct stat_or_stat64 stat_temp;
if (scm_is_integer (object))
{
#ifdef __MINGW32__
SCM_SYSCALL (rv = fstat_Win32 (scm_to_int (object), &stat_temp));
#else
- SCM_SYSCALL (rv = fstat (scm_to_int (object), &stat_temp));
+ SCM_SYSCALL (rv = fstat_or_fstat64 (scm_to_int (object), &stat_temp));
#endif
}
else if (scm_is_string (object))
while (p > file && (*p == '/' || *p == '\\'))
*p-- = '\0';
#endif
- SCM_SYSCALL (rv = stat (file, &stat_temp));
+ SCM_SYSCALL (rv = stat_or_stat64 (file, &stat_temp));
free (file);
}
else
#ifdef __MINGW32__
SCM_SYSCALL (rv = fstat_Win32 (fdes, &stat_temp));
#else
- SCM_SYSCALL (rv = fstat (fdes, &stat_temp));
+ SCM_SYSCALL (rv = fstat_or_fstat64 (fdes, &stat_temp));
#endif
}
if (rv == -1)
{
- int en = errno;
-
- SCM_SYSERROR_MSG ("~A: ~S",
- scm_list_2 (scm_strerror (scm_from_int (en)),
- object),
- en);
+ if (SCM_UNBNDP (exception_on_error) || scm_is_true (exception_on_error))
+ {
+ int en = errno;
+ SCM_SYSERROR_MSG ("~A: ~S",
+ scm_list_2 (scm_strerror (scm_from_int (en)),
+ object),
+ en);
+ }
+ else
+ return SCM_BOOL_F;
}
return scm_stat2scm (&stat_temp);
}
STRING_SYSCALL (dirname, c_dirname, ds = opendir (c_dirname));
if (ds == NULL)
SCM_SYSERROR;
- SCM_RETURN_NEWSMOB (scm_tc16_dir | SCM_DIR_FLAG_OPEN, ds);
+ SCM_RETURN_NEWSMOB (scm_tc16_dir | (SCM_DIR_FLAG_OPEN<<16), ds);
}
#undef FUNC_NAME
/* FIXME: The glibc manual has a portability note that readdir_r may not
null-terminate its return string. The circumstances outlined for this
- are not clear, nor is it clear what should be done about it. Lets worry
- about this if/when someone can figure it out. */
+ are not clear, nor is it clear what should be done about it. Lets use
+ NAMLEN and worry about what else should be done if/when someone can
+ figure it out. */
SCM_DEFINE (scm_readdir, "readdir", 1, 0, 0,
(SCM port),
"end of file object is returned.")
#define FUNC_NAME s_scm_readdir
{
- struct dirent *rdent;
+ struct dirent_or_dirent64 *rdent;
SCM_VALIDATE_DIR (1, port);
if (!SCM_DIR_OPEN_P (port))
SCM_MISC_ERROR ("Directory ~S is not open.", scm_list_1 (port));
- errno = 0;
- {
#if HAVE_READDIR_R
- /* On Solaris 2.7, struct dirent only contains "char d_name[1]" and one is
- expected to provide a buffer of "sizeof(struct dirent) + NAME_MAX"
- bytes. The glibc 2.3.2 manual notes this sort of thing too, and
- advises "offsetof(struct dirent,d_name) + NAME_MAX + 1". Either should
- suffice, we give both to be certain. */
- union {
- struct dirent ent;
- char pad1 [sizeof(struct dirent) + NAME_MAX];
- char pad2 [offsetof (struct dirent, d_name) + NAME_MAX + 1];
- } u;
- SCM_SYSCALL (readdir_r ((DIR *) SCM_CELL_WORD_1 (port), &u.ent, &rdent));
+ /* 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.
+
+ 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
+ and will therefore save a system call. We also prefer it since dirfd()
+ is not available everywhere.
+
+ An alternative to dirfd() would be to open() the directory and then use
+ fdopendir(), if the latter is available. That'd let us hold the fd
+ somewhere in the smob, or just the dirent size calculated once. */
+ {
+ struct dirent_or_dirent64 de; /* just for sizeof */
+ DIR *ds = (DIR *) SCM_SMOB_DATA_1 (port);
+ size_t namlen;
+#ifdef NAME_MAX
+ char buf [SCM_MAX (sizeof (de),
+ sizeof (de) - sizeof (de.d_name) + NAME_MAX + 1)];
#else
- SCM_SYSCALL (rdent = readdir ((DIR *) SCM_CELL_WORD_1 (port)));
+ 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));
#endif
+
+ errno = 0;
+ SCM_SYSCALL (readdir_r_or_readdir64_r (ds, (struct dirent_or_dirent64 *) buf, &rdent));
if (errno != 0)
SCM_SYSERROR;
+ if (! rdent)
+ return SCM_EOF_VAL;
+
+ namlen = NAMLEN (rdent);
return (rdent ? scm_from_locale_stringn (rdent->d_name, NAMLEN (rdent))
: SCM_EOF_VAL);
}
+#else
+ {
+ SCM ret;
+ scm_dynwind_begin (0);
+ scm_i_dynwind_pthread_mutex_lock (&scm_i_misc_mutex);
+
+ errno = 0;
+ SCM_SYSCALL (rdent = readdir_or_readdir64 ((DIR *) SCM_SMOB_DATA_1 (port)));
+ if (errno != 0)
+ SCM_SYSERROR;
+
+ ret = (rdent ? scm_from_locale_stringn (rdent->d_name, NAMLEN (rdent))
+ : SCM_EOF_VAL);
+
+ scm_dynwind_end ();
+ return ret;
+ }
+#endif
}
#undef FUNC_NAME
if (!SCM_DIR_OPEN_P (port))
SCM_MISC_ERROR ("Directory ~S is not open.", scm_list_1 (port));
- rewinddir ((DIR *) SCM_CELL_WORD_1 (port));
+ rewinddir ((DIR *) SCM_SMOB_DATA_1 (port));
return SCM_UNSPECIFIED;
}
{
int sts;
- SCM_SYSCALL (sts = closedir ((DIR *) SCM_CELL_WORD_1 (port)));
+ SCM_SYSCALL (sts = closedir ((DIR *) SCM_SMOB_DATA_1 (port)));
if (sts != 0)
SCM_SYSERROR;
- SCM_SET_CELL_WORD_0 (port, scm_tc16_dir);
+ SCM_SET_SMOB_DATA_0 (port, scm_tc16_dir);
}
return SCM_UNSPECIFIED;
if (!SCM_DIR_OPEN_P (exp))
scm_puts ("closed: ", port);
scm_puts ("directory stream ", port);
- scm_uintprint (SCM_CELL_WORD_1 (exp), 16, port);
+ scm_uintprint (SCM_SMOB_DATA_1 (exp), 16, port);
scm_putc ('>', port);
return 1;
}
scm_dir_free (SCM p)
{
if (SCM_DIR_OPEN_P (p))
- closedir ((DIR *) SCM_CELL_WORD_1 (p));
+ closedir ((DIR *) SCM_SMOB_DATA_1 (p));
return 0;
}
}
{
- int rv = scm_internal_select (max_fd + 1,
- &read_set, &write_set, &except_set,
- time_ptr);
+ int rv = scm_std_select (max_fd + 1,
+ &read_set, &write_set, &except_set,
+ time_ptr);
if (rv < 0)
SCM_SYSERROR;
}
SCM result;
char *c_path;
- scm_frame_begin (0);
+ scm_dynwind_begin (0);
c_path = scm_to_locale_string (path);
- scm_frame_free (c_path);
+ scm_dynwind_free (c_path);
buf = scm_malloc (size);
}
result = scm_take_locale_stringn (buf, rv);
- scm_frame_end ();
+ scm_dynwind_end ();
return result;
}
#undef FUNC_NAME
#define FUNC_NAME s_scm_lstat
{
int rv;
- struct stat stat_temp;
+ struct stat_or_stat64 stat_temp;
- STRING_SYSCALL (str, c_str, rv = lstat (c_str, &stat_temp));
+ STRING_SYSCALL (str, c_str, rv = lstat_or_lstat64 (c_str, &stat_temp));
if (rv != 0)
{
int en = errno;
int oldfd, newfd;
int n, rv;
char buf[BUFSIZ];
- struct stat oldstat;
+ struct stat_or_stat64 oldstat;
- scm_frame_begin (0);
+ scm_dynwind_begin (0);
c_oldfile = scm_to_locale_string (oldfile);
- scm_frame_free (c_oldfile);
+ scm_dynwind_free (c_oldfile);
c_newfile = scm_to_locale_string (newfile);
- scm_frame_free (c_newfile);
+ scm_dynwind_free (c_newfile);
- oldfd = open (c_oldfile, O_RDONLY);
+ oldfd = open_or_open64 (c_oldfile, O_RDONLY);
if (oldfd == -1)
SCM_SYSERROR;
#ifdef __MINGW32__
SCM_SYSCALL (rv = fstat_Win32 (oldfd, &oldstat));
#else
- SCM_SYSCALL (rv = fstat (oldfd, &oldstat));
+ SCM_SYSCALL (rv = fstat_or_fstat64 (oldfd, &oldstat));
#endif
if (rv == -1)
goto err_close_oldfd;
/* use POSIX flags instead of 07777?. */
- newfd = open (c_newfile, O_WRONLY | O_CREAT | O_TRUNC,
- oldstat.st_mode & 07777);
+ newfd = open_or_open64 (c_newfile, O_WRONLY | O_CREAT | O_TRUNC,
+ oldstat.st_mode & 07777);
if (newfd == -1)
{
err_close_oldfd:
if (close (newfd) == -1)
SCM_SYSERROR;
- scm_frame_end ();
+ scm_dynwind_end ();
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
"component, @code{.} is returned.")
#define FUNC_NAME s_scm_dirname
{
- const char *s;
long int i;
unsigned long int len;
SCM_VALIDATE_STRING (1, filename);
- s = scm_i_string_chars (filename);
len = scm_i_string_length (filename);
i = len - 1;
#ifdef __MINGW32__
- while (i >= 0 && (s[i] == '/' || s[i] == '\\')) --i;
- while (i >= 0 && (s[i] != '/' && s[i] != '\\')) --i;
- while (i >= 0 && (s[i] == '/' || s[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;
+ while (i >= 0 && (scm_i_string_ref (filename, i) == '/'
+ || scm_i_string_ref (filename, i) == '\\'))
+ --i;
#else
- while (i >= 0 && s[i] == '/') --i;
- while (i >= 0 && s[i] != '/') --i;
- while (i >= 0 && s[i] == '/') --i;
+ while (i >= 0 && scm_i_string_ref (filename, i) == '/')
+ --i;
+ while (i >= 0 && scm_i_string_ref (filename, i) != '/')
+ --i;
+ while (i >= 0 && scm_i_string_ref (filename, i) == '/')
+ --i;
#endif /* ndef __MINGW32__ */
if (i < 0)
{
#ifdef __MINGW32__
- if (len > 0 && (s[0] == '/' || s[0] == '\\'))
+ if (len > 0 && (scm_i_string_ref (filename, 0) == '/'
+ || scm_i_string_ref (filename, 0) == '\\'))
#else
- if (len > 0 && s[0] == '/')
+ if (len > 0 && scm_i_string_ref (filename, 0) == '/')
#endif /* ndef __MINGW32__ */
return scm_c_substring (filename, 0, 1);
else
"@var{basename}, it is removed also.")
#define FUNC_NAME s_scm_basename
{
- const char *f, *s = 0;
int i, j, len, end;
SCM_VALIDATE_STRING (1, filename);
- f = scm_i_string_chars (filename);
len = scm_i_string_length (filename);
if (SCM_UNBNDP (suffix))
else
{
SCM_VALIDATE_STRING (2, suffix);
- s = scm_i_string_chars (suffix);
j = scm_i_string_length (suffix) - 1;
}
i = len - 1;
#ifdef __MINGW32__
- while (i >= 0 && (f[i] == '/' || f[i] == '\\')) --i;
+ while (i >= 0 && (scm_i_string_ref (filename, i) == '/'
+ || scm_i_string_ref (filename, i) == '\\'))
+ --i;
#else
- while (i >= 0 && f[i] == '/') --i;
+ while (i >= 0 && scm_i_string_ref (filename, i) == '/')
+ --i;
#endif /* ndef __MINGW32__ */
end = i;
- while (i >= 0 && j >= 0 && f[i] == s[j]) --i, --j;
+ while (i >= 0 && j >= 0
+ && (scm_i_string_ref (filename, i)
+ == scm_i_string_ref (suffix, j)))
+ {
+ --i;
+ --j;
+ }
if (j == -1)
end = i;
#ifdef __MINGW32__
- while (i >= 0 && f[i] != '/' && f[i] != '\\') --i;
+ while (i >= 0 && (scm_i_string_ref (filename, i) != '/'
+ && scm_i_string_ref (filename, i) != '\\'))
+ --i;
#else
- while (i >= 0 && f[i] != '/') --i;
+ while (i >= 0 && scm_i_string_ref (filename, i) != '/')
+ --i;
#endif /* ndef __MINGW32__ */
if (i == end)
{
#ifdef __MINGW32__
- if (len > 0 && (f[0] == '/' || f[0] == '\\'))
+ if (len > 0 && (scm_i_string_ref (filename, 0) == '/'
+ || scm_i_string_ref (filename, 0) == '\\'))
#else
- if (len > 0 && f[0] == '/')
+ if (len > 0 && scm_i_string_ref (filename, 0) == '/')
#endif /* ndef __MINGW32__ */
- return scm_c_substring (filename, 0, 1);
+ return scm_c_substring (filename, 0, 1);
else
return scm_dot_string;
}
}
#undef FUNC_NAME
+SCM_DEFINE (scm_canonicalize_path, "canonicalize-path", 1, 0, 0,
+ (SCM path),
+ "Return the canonical path of @var{path}. A canonical path has\n"
+ "no @code{.} or @code{..} components, nor any repeated path\n"
+ "separators (@code{/}) nor symlinks.\n\n"
+ "Raises an error if any component of @var{path} does not exist.")
+#define FUNC_NAME s_scm_canonicalize_path
+{
+ char *str, *canon;
+
+ SCM_VALIDATE_STRING (1, path);
+
+ str = scm_to_locale_string (path);
+ canon = canonicalize_file_name (str);
+ free (str);
+
+ if (canon)
+ return scm_take_locale_string (canon);
+ else
+ SCM_SYSERROR;
+}
+#undef FUNC_NAME
+
+SCM
+scm_i_relativize_path (SCM path, SCM in_path)
+{
+ char *str, *canon;
+ SCM scanon;
+
+ str = scm_to_locale_string (path);
+ canon = canonicalize_file_name (str);
+ free (str);
+
+ if (!canon)
+ return SCM_BOOL_F;
+
+ scanon = scm_take_locale_string (canon);
+
+ for (; scm_is_pair (in_path); in_path = scm_cdr (in_path))
+ if (scm_is_true (scm_string_prefix_p (scm_car (in_path),
+ scanon,
+ SCM_UNDEFINED, SCM_UNDEFINED,
+ SCM_UNDEFINED, SCM_UNDEFINED)))
+ {
+ size_t len = scm_c_string_length (scm_car (in_path));
+
+ /* The path either has a trailing delimiter or doesn't. scanon will be
+ delimited by single delimiters. In the case in which the path does
+ not have a trailing delimiter, add one to the length to strip off the
+ delimiter within scanon. */
+ if (!len
+#ifdef __MINGW32__
+ || (scm_i_string_ref (scm_car (in_path), len - 1) != '/'
+ && scm_i_string_ref (scm_car (in_path), len - 1) != '\\')
+#else
+ || scm_i_string_ref (scm_car (in_path), len - 1) != '/'
+#endif
+ )
+ len++;
+
+ if (scm_c_string_length (scanon) > len)
+ return scm_substring (scanon, scm_from_size_t (len), SCM_UNDEFINED);
+ else
+ return SCM_BOOL_F;
+ }
+
+ return SCM_BOOL_F;
+}
\f
scm_set_smob_free (scm_tc16_dir, scm_dir_free);
scm_set_smob_print (scm_tc16_dir, scm_dir_print);
- scm_dot_string = scm_permanent_object (scm_from_locale_string ("."));
+ scm_dot_string = scm_from_locale_string (".");
#ifdef O_RDONLY
- scm_c_define ("O_RDONLY", scm_from_long (O_RDONLY));
+ scm_c_define ("O_RDONLY", scm_from_int (O_RDONLY));
#endif
#ifdef O_WRONLY
- scm_c_define ("O_WRONLY", scm_from_long (O_WRONLY));
+ scm_c_define ("O_WRONLY", scm_from_int (O_WRONLY));
#endif
#ifdef O_RDWR
- scm_c_define ("O_RDWR", scm_from_long (O_RDWR));
+ scm_c_define ("O_RDWR", scm_from_int (O_RDWR));
#endif
#ifdef O_CREAT
- scm_c_define ("O_CREAT", scm_from_long (O_CREAT));
+ scm_c_define ("O_CREAT", scm_from_int (O_CREAT));
#endif
#ifdef O_EXCL
- scm_c_define ("O_EXCL", scm_from_long (O_EXCL));
+ scm_c_define ("O_EXCL", scm_from_int (O_EXCL));
#endif
#ifdef O_NOCTTY
- scm_c_define ("O_NOCTTY", scm_from_long (O_NOCTTY));
+ scm_c_define ("O_NOCTTY", scm_from_int (O_NOCTTY));
#endif
#ifdef O_TRUNC
- scm_c_define ("O_TRUNC", scm_from_long (O_TRUNC));
+ scm_c_define ("O_TRUNC", scm_from_int (O_TRUNC));
#endif
#ifdef O_APPEND
- scm_c_define ("O_APPEND", scm_from_long (O_APPEND));
+ scm_c_define ("O_APPEND", scm_from_int (O_APPEND));
#endif
#ifdef O_NONBLOCK
- scm_c_define ("O_NONBLOCK", scm_from_long (O_NONBLOCK));
+ scm_c_define ("O_NONBLOCK", scm_from_int (O_NONBLOCK));
#endif
#ifdef O_NDELAY
- scm_c_define ("O_NDELAY", scm_from_long (O_NDELAY));
+ scm_c_define ("O_NDELAY", scm_from_int (O_NDELAY));
#endif
#ifdef O_SYNC
- scm_c_define ("O_SYNC", scm_from_long (O_SYNC));
+ scm_c_define ("O_SYNC", scm_from_int (O_SYNC));
+#endif
+#ifdef O_LARGEFILE
+ scm_c_define ("O_LARGEFILE", scm_from_int (O_LARGEFILE));
#endif
#ifdef F_DUPFD
- scm_c_define ("F_DUPFD", scm_from_long (F_DUPFD));
+ scm_c_define ("F_DUPFD", scm_from_int (F_DUPFD));
#endif
#ifdef F_GETFD
- scm_c_define ("F_GETFD", scm_from_long (F_GETFD));
+ scm_c_define ("F_GETFD", scm_from_int (F_GETFD));
#endif
#ifdef F_SETFD
- scm_c_define ("F_SETFD", scm_from_long (F_SETFD));
+ scm_c_define ("F_SETFD", scm_from_int (F_SETFD));
#endif
#ifdef F_GETFL
- scm_c_define ("F_GETFL", scm_from_long (F_GETFL));
+ scm_c_define ("F_GETFL", scm_from_int (F_GETFL));
#endif
#ifdef F_SETFL
- scm_c_define ("F_SETFL", scm_from_long (F_SETFL));
+ scm_c_define ("F_SETFL", scm_from_int (F_SETFL));
#endif
#ifdef F_GETOWN
- scm_c_define ("F_GETOWN", scm_from_long (F_GETOWN));
+ scm_c_define ("F_GETOWN", scm_from_int (F_GETOWN));
#endif
#ifdef F_SETOWN
- scm_c_define ("F_SETOWN", scm_from_long (F_SETOWN));
+ scm_c_define ("F_SETOWN", scm_from_int (F_SETOWN));
#endif
#ifdef FD_CLOEXEC
- scm_c_define ("FD_CLOEXEC", scm_from_long (FD_CLOEXEC));
+ scm_c_define ("FD_CLOEXEC", scm_from_int (FD_CLOEXEC));
#endif
#include "libguile/filesys.x"
HCoop / bpt / guile.git / blobdiff