view src/realpath.c @ 4885:6772ce4d982b

Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums lisp/ChangeLog addition: 2010-01-24 Aidan Kehoe <kehoea@parhasard.net> Correct the semantics of #'member*, #'eql, #'assoc* in the presence of bignums; change the integerp byte code to fixnump semantics. * bytecomp.el (fixnump, integerp, byte-compile-integerp): Change the integerp byte code to fixnump; add a byte-compile method to integerp using fixnump and numberp and avoiding a funcall most of the time, since in the non-core contexts where integerp is used, it's mostly distinguishing between fixnums and things that are not numbers at all. * byte-optimize.el (side-effect-free-fns, byte-after-unbind-ops) (byte-compile-side-effect-and-error-free-ops): Replace the integerp bytecode with fixnump; add fixnump to the side-effect-free-fns. Add the other extended number type predicates to the list in passing. * obsolete.el (floatp-safe): Mark this as obsolete. * cl.el (eql): Go into more detail in the docstring here. Don't bother checking whether both arguments are numbers; one is enough, #'equal will fail correctly if they have distinct types. (subst): Replace a call to #'integerp (deciding whether to use #'memq or not) with one to #'fixnump. Delete most-positive-fixnum, most-negative-fixnum from this file; they're now always in C, so they can't be modified from Lisp. * cl-seq.el (member*, assoc*, rassoc*): Correct these functions in the presence of bignums. * cl-macs.el (cl-make-type-test): The type test for a fixnum is now fixnump. Ditch floatp-safe, use floatp instead. (eql): Correct this compiler macro in the presence of bignums. (assoc*): Correct this compiler macro in the presence of bignums. * simple.el (undo): Change #'integerp to #'fixnump here, since we use #'delq with the same value as ELT a few lines down. src/ChangeLog addition: 2010-01-24 Aidan Kehoe <kehoea@parhasard.net> Fix problems with #'eql, extended number types, and the hash table implementation; change the Bintegerp bytecode to fixnump semantics even on bignum builds, since #'integerp can have a fast implementation in terms of #'fixnump for most of its extant uses, but not vice-versa. * lisp.h: Always #include number.h; we want the macros provided in it, even if the various number types are not available. * number.h (NON_FIXNUM_NUMBER_P): New macro, giving 1 when its argument is of non-immediate number type. Equivalent to FLOATP if WITH_NUMBER_TYPES is not defined. * elhash.c (lisp_object_eql_equal, lisp_object_eql_hash): Use NON_FIXNUM_NUMBER_P in these functions, instead of FLOATP, giving more correct behaviour in the presence of the extended number types. * bytecode.c (Bfixnump, execute_optimized_program): Rename Bintegerp to Bfixnump; change its semantics to reflect the new name on builds with bignum support. * data.c (Ffixnump, Fintegerp, syms_of_data, vars_of_data): Always make #'fixnump available, even on non-BIGNUM builds; always implement #'integerp in this file, even on BIGNUM builds. Move most-positive-fixnum, most-negative-fixnum here from number.c, so they are Lisp constants even on builds without number types, and attempts to change or bind them error. Use the NUMBERP and INTEGERP macros even on builds without extended number types. * data.c (fixnum_char_or_marker_to_int): Rename this function from integer_char_or_marker_to_int, to better reflect the arguments it accepts. * number.c (Fevenp, Foddp, syms_of_number): Never provide #'integerp in this file. Remove #'oddp, #'evenp; their implementations are overridden by those in cl.el. * number.c (vars_of_number): most-positive-fixnum, most-negative-fixnum are no longer here. man/ChangeLog addition: 2010-01-23 Aidan Kehoe <kehoea@parhasard.net> Generally: be careful to say fixnum, not integer, when talking about fixed-precision integral types. I'm sure I've missed instances, both here and in the docstrings, but this is a decent start. * lispref/text.texi (Columns): Document where only fixnums, not integers generally, are accepted. (Registers): Remove some ancient char-int confoundance here. * lispref/strings.texi (Creating Strings, Creating Strings): Be more exact in describing where fixnums but not integers in general are accepted. (Creating Strings): Use a more contemporary example to illustrate how concat deals with lists including integers about #xFF. Delete some obsolete documentation on same. (Char Table Types): Document that only fixnums are accepted as values in syntax tables. * lispref/searching.texi (String Search, Search and Replace): Be exact in describing where fixnums but not integers in general are accepted. * lispref/range-tables.texi (Range Tables): Be exact in describing them; only fixnums are accepted to describe ranges. * lispref/os.texi (Killing XEmacs, User Identification) (Time of Day, Time Conversion): Be more exact about using fixnum where only fixed-precision integers are accepted. * lispref/objects.texi (Integer Type): Be more exact (and up-to-date) about the possible values for integers. Cross-reference to documentation of the bignum extension. (Equality Predicates): (Range Table Type): (Array Type): Use fixnum, not integer, to describe a fixed-precision integer. (Syntax Table Type): Correct some English syntax here. * lispref/numbers.texi (Numbers): Change the phrasing here to use fixnum to mean the fixed-precision integers normal in emacs. Document that our terminology deviates from that of Common Lisp, and that we're working on it. (Compatibility Issues): Reiterate the Common Lisp versus Emacs Lisp compatibility issues. (Comparison of Numbers, Arithmetic Operations): * lispref/commands.texi (Command Loop Info, Working With Events): * lispref/buffers.texi (Modification Time): Be more exact in describing where fixnums but not integers in general are accepted.
author Aidan Kehoe <kehoea@parhasard.net>
date Sun, 24 Jan 2010 15:21:27 +0000
parents b3ea9c582280
children 19a72041c5ed
line wrap: on
line source

/*
 * realpath.c -- canonicalize pathname by removing symlinks
 * Copyright (C) 1993 Rick Sladkey <jrs@world.std.com>
 * Copyright (C) 2001, 2002, 2004 Ben Wing.
 *

This file is part of XEmacs.

XEmacs is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by the
Free Software Foundation; either version 2, or (at your option) any
later version.

XEmacs 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 General Public License
for more details.

You should have received a copy of the GNU General Public License
along with XEmacs; see the file COPYING.  If not, write to
the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.  */

/* Synched up with: Not in FSF. */

/* This file has been Mule-ized, June 2001 by Ben Wing.

   Everything in this file now works in terms of internal, not external,
   data.  This is the only way to be safe, and it makes the code cleaner. */

#include <config.h>
#include "lisp.h"

#include "profile.h"

#include "sysfile.h"
#include "sysdir.h"

#define MAX_READLINKS 32

#ifdef WIN32_ANY
#include "syswindows.h"
#ifndef ELOOP
#define ELOOP 10062 /* = WSAELOOP in winsock.h */
#endif
#endif

Lisp_Object QSin_qxe_realpath;

/* Length of start of absolute filename. */
static int 
abs_start (const Ibyte *name)
{
#ifdef WIN32_ANY
  if (isalpha (*name) && IS_DEVICE_SEP (name[1])
      && IS_DIRECTORY_SEP (name[2]))
    return 3;
  else if (IS_DIRECTORY_SEP (*name))
    return IS_DIRECTORY_SEP (name[1]) ? 2 : 1;
  else 
    return 0;
#else /* not WIN32_ANY */
  return IS_DIRECTORY_SEP (*name) ? 1 : 0;
#endif
}

/* Find real name of a file by resolving symbolic links and/or shortcuts
   under Windows (.LNK links), if such support is enabled.

   If no link found, and LINKS_ONLY is false, look up the correct case in
   the file system of the last component.

   Under Windows, UNC servers and shares are lower-cased.  Directories must
   be given without trailing '/'. One day, this could read Win2K's reparse
   points.

   Returns length of characters copied info BUF.
   DOES NOT ZERO TERMINATE!!!!!
*/

#ifdef REALPATH_CORRECTS_CASE /* Darwin */
#include <sys/param.h>
#include <stdlib.h>
#endif

static int
readlink_or_correct_case (const Ibyte *name, Ibyte *buf, Bytecount size,
#ifndef WIN32_ANY
			  Boolint UNUSED (links_only)
#else
			  Boolint links_only
#endif
			  )
{
#ifndef WIN32_ANY
#ifdef REALPATH_CORRECTS_CASE
  /* Darwin's realpath corrects file name case, so we want to use that
     here, as well as our own, non-case-correcting, implementation
     further down in this file.

     It might be reasonable to incorporate case correction in our own
     realpath implementation, which would help things with
     case-insensitive file systems on Linux; one way to do this would
     be to make sure that init_initial_directory and
     get_initial_directory always give the correct case.  */
  int n = qxe_readlink (name, buf, (size_t) size);
  Extbyte realpath_buf[PATH_MAX], *tmp;
  DECLARE_EISTRING (realpathing);

  if (n >= 0 || errno != EINVAL)
    return n;

  eicpy_rawz (realpathing, name);
  eito_external (realpathing, Qfile_name);
  tmp = realpath (eiextdata (realpathing), realpath_buf);

  if (!tmp)
    return -1;

  if (0 == memcmp (eiextdata (realpathing), realpath_buf,
                   eiextlen (realpathing)))
    {
      /* No case change needed; tell the caller that. */
      errno = EINVAL;
      return -1;
    }

  eireset (realpathing);
  eicpy_ext (realpathing, realpath_buf, Qfile_name);
  if (eilen (realpathing) > size)
    {
      errno = ERANGE;
      return -1;
    }

  memcpy (buf, eidata (realpathing), eilen (realpathing));
  return eilen (realpathing);
#else /* !REALPATH_CORRECTS_CASE */
  return qxe_readlink (name, buf, (size_t) size);
#endif /* REALPATH_CORRECTS_CASE */
#else /* defined (WIN32_ANY) */
# ifdef CYGWIN
  int n = qxe_readlink (name, buf, (size_t) size);
  if (n >= 0 || errno != EINVAL)
    return n;

  /* The file may exist, but isn't a symlink. Try to find the
     right name. */
  LOCAL_FILE_FORMAT_TO_INTERNAL_MSWIN (name, name);
# else
  if (mswindows_shortcuts_are_symlinks)
    {
      Ibyte *tmp = mswindows_read_link (name);

      if (tmp != NULL)
	{
	  /* Fucking fixed buffers. */
	  Bytecount len = qxestrlen (tmp);
	  if (len > size)
	    {
	      errno = ENAMETOOLONG;
	      return -1;
	    }
	  memcpy (buf, tmp, len);
	  xfree (tmp, Ibyte *);
	  return len;
	}
    }
# endif

  if (links_only)
    {
      errno = EINVAL;
      return -1;
    }

  {
    int len = 0;
    int err = 0;
    const Ibyte *lastname;
    int count = 0;
    const Ibyte *nn;
    DECLARE_EISTRING (result);
  
    assert (*name);
  
    /* Sort of check we have a valid filename. */
    if (qxestrpbrk (name, "*?|<>\""))
      {
	errno = ENOENT;
	return -1;
      }
    else if (qxestrlen (name) >= PATH_MAX_INTERNAL)
      {
	errno = ENAMETOOLONG;
	return -1;
      }
  
    /* Find start of filename */
    lastname = name + qxestrlen (name);
    while (lastname > name && !IS_DIRECTORY_SEP (lastname[-1]))
      --lastname;

    /* Count slashes in unc path */
    if (abs_start (name) == 2)
      for (nn = name; *nn; nn++)
	if (IS_DIRECTORY_SEP (*nn))
	  count++;

    if (count >= 2 && count < 4)
      {
	eicpy_rawz (result, lastname);
	eilwr (result);
      }
    else
      {
	WIN32_FIND_DATAW find_data;
	Extbyte *nameext;
	HANDLE dir_handle;

	C_STRING_TO_TSTR (name, nameext);
	dir_handle = qxeFindFirstFile (nameext, &find_data);
	if (dir_handle == INVALID_HANDLE_VALUE)
	  {
	    errno = ENOENT;
	    return -1;
	  }
	eicpy_ext (result, (Extbyte *) find_data.cFileName, Qmswindows_tstr);
	FindClose (dir_handle);
      }

    if ((len = eilen (result)) <= size)
      {
	DECLARE_EISTRING (eilastname);

	eicpy_rawz (eilastname, lastname);
	if (eicmp_ei (eilastname, result) == 0)
          /* Signal that the name is already OK. */
          err = EINVAL;
	else
	  memcpy (buf, eidata (result), len);
      }
    else
      err = ENAMETOOLONG;

    errno = err;
    return err ? -1 : len;
  }
#endif /* WIN32_ANY */
}

/* Mule Note: This function works with and returns
   internally-formatted strings.

   if LINKS_ONLY is true, don't do case canonicalization under
   Windows. */

Ibyte *
qxe_realpath (const Ibyte *path, Ibyte *resolved_path, Boolint links_only)
{
  Ibyte copy_path[PATH_MAX_INTERNAL];
  Ibyte *new_path = resolved_path;
  Ibyte *max_path;
  Ibyte *retval = NULL;
#if defined (HAVE_READLINK) || defined (WIN32_ANY)
  int readlinks = 0;
  Ibyte link_path[PATH_MAX_INTERNAL];
  int n;
  int abslen = abs_start (path);
#endif

  PROFILE_DECLARE ();

  PROFILE_RECORD_ENTERING_SECTION (QSin_qxe_realpath);

 restart:

  /* Make a copy of the source path since we may need to modify it. */
  qxestrcpy (copy_path, path);
  path = copy_path;
  max_path = copy_path + PATH_MAX_INTERNAL - 2;

  if (0)
    ;
#ifdef WIN32_ANY
  /* Check for c:/... or //server/... */
  else if (abslen == 3 || abslen == 2)
    {
      /* Make sure drive letter is lowercased. */
      if (abslen == 3)
	{
	  *new_path = tolower (*path);
	  new_path++;
	  path++;
	  abslen--;
	}
      /* Coerce directory chars. */
      while (abslen-- > 0)
	{
	  if (IS_DIRECTORY_SEP (*path))
	    *new_path++ = DIRECTORY_SEP;
	  else
	    *new_path++ = *path;
	  path++;
	}
    }
#endif
#ifdef WIN32_NATIVE
  /* No drive letter, but a beginning slash? Prepend drive letter. */
  else if (abslen == 1)
    {
      get_initial_directory (new_path, PATH_MAX_INTERNAL - 1);
      new_path += 3;
      path++;
    }
  /* Just a path name, prepend the current directory */
  else
    {
      get_initial_directory (new_path, PATH_MAX_INTERNAL - 1);
      new_path += qxestrlen (new_path);
      if (!IS_DIRECTORY_SEP (new_path[-1]))
	*new_path++ = DIRECTORY_SEP;
    }
#else
  /* If it's a relative pathname use get_initial_directory for starters. */
  else if (abslen == 0)
    {
      get_initial_directory (new_path, PATH_MAX_INTERNAL - 1);
      new_path += qxestrlen (new_path);
      if (!IS_DIRECTORY_SEP (new_path[-1]))
	*new_path++ = DIRECTORY_SEP;
    }
  else
    {
      /* Copy first directory sep. May have two on cygwin. */
      qxestrncpy (new_path, path, abslen);
      new_path += abslen;
      path += abslen;
    }
#endif
  /* Expand each slash-separated pathname component. */
  while (*path != '\0')
    {
      /* Ignore stray "/". */
      if (IS_DIRECTORY_SEP (*path))
	{
	  path++;
	  continue;
	}

      if (*path == '.')
	{
	  /* Ignore ".". */
	  if (path[1] == '\0' || IS_DIRECTORY_SEP (path[1]))
	    {
	      path++;
	      continue;
	    }

	  /* Handle ".." */
	  if (path[1] == '.' &&
	      (path[2] == '\0' || IS_DIRECTORY_SEP (path[2])))
	    {
	      path += 2;

	      /* Ignore ".." at root. */
	      if (new_path == resolved_path + abs_start (resolved_path))
		continue;

	      /* Handle ".." by backing up. */
	      --new_path;
	      while (!IS_DIRECTORY_SEP (new_path[-1]))
		--new_path;
	      continue;
	    }
	}

      /* Safely copy the next pathname component. */
      while (*path != '\0' && !IS_DIRECTORY_SEP (*path))
	{
	  if (path > max_path)
	    {
	      errno = ENAMETOOLONG;
	      goto done;
	    }
	  *new_path++ = *path++;
	}

#if defined (HAVE_READLINK) || defined (WIN32_ANY)
      /* See if latest pathname component is a symlink or needs case
	 correction. */
      *new_path = '\0';
      n = readlink_or_correct_case (resolved_path, link_path,
				    PATH_MAX_INTERNAL - 1, links_only);

      if (n < 0)
	{
	  /* EINVAL means the file exists but isn't a symlink or doesn't
	     need case correction. */
#ifdef WIN32_ANY
	  if (errno != EINVAL && errno != ENOENT)
#else
	  if (errno != EINVAL) 
#endif
	    goto done;
	}
      else
	{
	  /* Protect against infinite loops. */
	  if (readlinks++ > MAX_READLINKS)
	    {
	      errno = ELOOP;
	      goto done;
	    }

	  /* Note: readlink doesn't add the null byte. */
	  link_path[n] = '\0';
	  
	  abslen = abs_start (link_path);
	  if (abslen > 0)
	    {
	      /* Start over for an absolute symlink. */
	      new_path = resolved_path;
	      qxestrcat (link_path, path);
	      path = link_path;
	      goto restart;
	    }

	  /* Otherwise back up over this component. */
	  for (--new_path; !IS_DIRECTORY_SEP (*new_path); --new_path)
	    assert (new_path > resolved_path);

	  /* Safe sex check. */
	  if (qxestrlen (path) + n >= PATH_MAX_INTERNAL)
	    {
	      errno = ENAMETOOLONG;
	      goto done;
	    }

	  /* Insert symlink contents into path. */
	  qxestrcat (link_path, path);
	  qxestrcpy (copy_path, link_path);
	  path = copy_path;
	}
#endif /* HAVE_READLINK || WIN32_ANY */
      *new_path++ = DIRECTORY_SEP;
    }

  /* Delete trailing slash but don't whomp a lone slash. */
  if (new_path != resolved_path + abs_start (resolved_path) &&
      IS_DIRECTORY_SEP (new_path[-1]))
    new_path--;

  /* Make sure it's null terminated. */
  *new_path = '\0';

  retval = resolved_path;
done:
  PROFILE_RECORD_EXITING_SECTION (QSin_qxe_realpath);
  return retval;
}

void
vars_of_realpath (void)
{
  QSin_qxe_realpath =
    build_msg_string ("(in qxe_realpath)");
  staticpro (&QSin_qxe_realpath);
}