/* -*- mode: c -*- */
/*
    unixfsys.c  -- Unix file system interface.
*/
/*
    Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
    Copyright (c) 1990, Giuseppe Attardi.
    Copyright (c) 2001, Juan Jose Garcia Ripoll.
    Copyright (c) 2010-2012, Jean-Claude Beaudoin.

    MKCL 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 3 of the License, or (at your option) any later version.

    See file '../../Copyright' for full details.
*/

#define _FILE_OFFSET_BITS 64

#include <mkcl/mkcl.h>
#include <string.h>
#include <stdio.h>
#include <limits.h>
#ifdef __unix
# include <unistd.h>
# include <pwd.h>
#elif defined(_MSC_VER)
# include <io.h>
# define F_OK 0
#endif
#include <sys/types.h>
#include <sys/stat.h>
#include <stdlib.h>
#include <mkcl/mkcl-inl.h>
#include <mkcl/internal.h>
#include <dirent.h>

#ifdef MKCL_WINDOWS
# include <windows.h>
# include <direct.h>
# include <ctype.h>
#endif

#include <fcntl.h>
#include <errno.h>


struct OSpath
{
  mkcl_object pathname;
  mkcl_object reverse_directory_list_shadow;
};

static void init_absolute_OSpath(MKCL, struct OSpath * ospath)
{
  mkcl_object p = mkcl_alloc_raw_pathname(env);

  p->pathname.logical   = FALSE;
  p->pathname.complete  = FALSE;
  p->pathname.host      = mk_cl_Cnil;
  p->pathname.device    = mk_cl_Cnil;
  p->pathname.directory = mkcl_list1(env, @':absolute');
  p->pathname.name      = mk_cl_Cnil;
  p->pathname.type      = mk_cl_Cnil;
#if 0
  p->pathname.version   = @':unspecific';
#else
  p->pathname.version   = @':newest';
#endif
  p->pathname.namestring = mk_cl_Cnil;

  ospath->pathname = p;
  ospath->reverse_directory_list_shadow = mkcl_list1(env, p->pathname.directory);
}

static void init_relative_OSpath(MKCL, struct OSpath * ospath)
{
  mkcl_object p = mkcl_alloc_raw_pathname(env);

  p->pathname.logical   = FALSE;
  p->pathname.complete  = FALSE;
  p->pathname.host      = mk_cl_Cnil;
  p->pathname.device    = mk_cl_Cnil;
  p->pathname.directory = mkcl_list1(env, @':relative');
  p->pathname.name      = mk_cl_Cnil;
  p->pathname.type      = mk_cl_Cnil;
#if 0
  p->pathname.version   = @':unspecific';
#else
  p->pathname.version   = @':newest';
#endif
  p->pathname.namestring = mk_cl_Cnil;

  ospath->pathname = p;
  ospath->reverse_directory_list_shadow = mkcl_list1(env, p->pathname.directory);
}

static void init_OSpath_from_pathname(MKCL, struct OSpath * ospath, mkcl_object pathname)
{
  ospath->pathname = pathname;
  ospath->reverse_directory_list_shadow = mkcl_reverse_proper_list(env, pathname);
}


static void copy_OSpath(MKCL, struct OSpath * new, struct OSpath * old)
{
  new->pathname = mkcl_alloc_raw_pathname(env);
  new->pathname->pathname = old->pathname->pathname;

  if (MKCL_CONSP(old->pathname->pathname.directory))
    {
      mkcl_object shadow = mk_cl_Cnil, directory;
      new->pathname->pathname.directory = mkcl_copy_proper_list(env, old->pathname->pathname.directory);

      for (directory = new->pathname->pathname.directory; !mkcl_Null(directory); directory = MKCL_CONS_CDR(directory))
	shadow = mkcl_cons(env, directory, shadow);
      new->reverse_directory_list_shadow = shadow;
    }
  else
    new->reverse_directory_list_shadow = mk_cl_Cnil;
}

static void OSpath_push_dir(MKCL, struct OSpath * path, mkcl_object dir)
{
  mkcl_object last_shadow = path->reverse_directory_list_shadow;

  mkcl_object last = MKCL_CONS_CAR(last_shadow);
  mkcl_object new = mkcl_list1(env, dir);
  
  MKCL_RPLACD(last, new);
  path->reverse_directory_list_shadow = mkcl_cons(env, new, last_shadow);
  path->pathname->pathname.namestring = mk_cl_Cnil; /* clear pathname namestring cache */
}

static mkcl_object OSpath_pop_dir(MKCL, struct OSpath * path)
{
  mkcl_object last_shadow = path->reverse_directory_list_shadow;

  mkcl_object last = MKCL_CONS_CAR(last_shadow);
  mkcl_object dir = MKCL_CONS_CAR(last);

  path->pathname->pathname.namestring = mk_cl_Cnil; /* clear pathname namestring cache */
  if (!(dir == @':absolute' || dir == @':relative'))
    {
      mkcl_object next_to_last_shadow = MKCL_CONS_CDR(last);
      mkcl_object next_to_last = MKCL_CONS_CAR(next_to_last_shadow);

      MKCL_RPLACD(next_to_last, mk_cl_Cnil);
      path->reverse_directory_list_shadow = next_to_last_shadow;
      return dir;
    }
  else
    return mk_cl_Cnil;
}



static int is_slash(int c) { return MKCL_IS_DIR_SEPARATOR(c); }


static int
safe_chdir(MKCL, mkcl_object path)
{
#if 0
  mkcl_object os_path = mkcl_string_to_OSstring(env, path);
#else
  mkcl_dynamic_extent_OSstring(env, os_path, path);
#endif
  int output;

#ifdef MKCL_WINDOWS
  MKCL_LIBC_NO_INTR(env, output = _wchdir(mkcl_OSstring_self(os_path)));
#else
  MKCL_LIBC_NO_INTR(env, output = chdir(mkcl_OSstring_self(os_path)));
#endif
  return output;
}

#ifdef MKCL_WINDOWS
typedef struct __stat64 os_file_stat;
#else
typedef struct stat os_file_stat;
#endif

static int
safe_stat(MKCL, mkcl_object path, os_file_stat *sb)
{
#if 0
  mkcl_object os_path = mkcl_string_to_OSstring(env, path);
#else
  mkcl_dynamic_extent_OSstring(env, os_path, path);
#endif
  int output;

#ifdef MKCL_WINDOWS
  MKCL_LIBC_NO_INTR(env, output = _wstat64(mkcl_OSstring_self(os_path), sb));
#else
  MKCL_LIBC_NO_INTR(env, output = stat(mkcl_OSstring_self(os_path), sb));
#endif
  return output;
}

#ifdef HAVE_LSTAT
static int
safe_lstat(MKCL, mkcl_object path, struct stat *sb)
{
#if 0
  mkcl_object os_path = mkcl_string_to_OSstring(env, path);
#else
  mkcl_dynamic_extent_OSstring(env, os_path, path);
#endif
  int output;

  MKCL_LIBC_NO_INTR(env, output = lstat(mkcl_OSstring_self(os_path), sb));
  return output;
}
#endif

#ifdef __unix
static mkcl_object safe_realpath(MKCL, mkcl_object orig_pathname, mkcl_object path)
{
#if 0
  mkcl_OSstring_raw_type os_raw_path = mkcl_OSstring_self(mkcl_string_to_OSstring(env, path));
#else
  mkcl_dynamic_extent_OSstring(env, os_path, path);
  mkcl_OSstring_raw_type os_raw_path = mkcl_OSstring_self(os_path);
#endif
  char * output;

  MKCL_LIBC_NO_INTR(env, output = realpath(os_raw_path, NULL));
  if (output == NULL)
    {
      /* errno could be: EACCES, EINVAL, EIO, ELOOP, ENAMETOOLONG, ENOENT, ENOTDIR. */
      mkcl_FElibc_file_error(env, orig_pathname, "realpath() failed in safe_realpath()", 0);
      return NULL;
    }
  else
    {
      mkcl_object str = mkcl_cstring_copy_to_OSstring(env, output);

      free(output); /* Yes this bypasses the GC since it was malloced by realpath(). */
      return str;
    }
}

#elif defined(MKCL_WINDOWS)

static mkcl_object safe_realpath(MKCL, mkcl_object orig_pathname, mkcl_object path)
{
#if 0
  mkcl_OSstring_raw_type os_raw_path = mkcl_OSstring_self(mkcl_string_to_OSstring(env, path));
#else
  mkcl_dynamic_extent_OSstring(env, os_path, path);
  mkcl_OSstring_raw_type os_raw_path = mkcl_OSstring_self(os_path);
#endif
  DWORD size = MAX_PATH + 1;
  wchar_t * output;

  MKCL_LIBC_NO_INTR(env, output = malloc(size * sizeof(wchar_t)));
  if (output == NULL)
    {
      mkcl_FEerror(env, "malloc(): Out of memory", 0);
      return NULL;
    }

  MKCL_LIBC_NO_INTR(env, size = GetFullPathNameW(os_raw_path, size, output, NULL));
  if (size > MAX_PATH)
    { /* Not big enough */
      MKCL_LIBC_NO_INTR(env, (output = realloc(output, size * sizeof(wchar_t))));
      if (output == NULL)
	{
	  mkcl_FEerror(env, "realloc(): Out of memory", 0);
	  return NULL;
	}
      MKCL_LIBC_NO_INTR(env, size = GetFullPathNameW(os_raw_path, size, output, NULL));
    }
  if (size == 0)
    { /* Something went wrong. */
      mkcl_FEwin32_file_error(env, orig_pathname, "GetFullPathname() failed in safe_realpath().", 0);
      return NULL;
    }
  else
    {
      mkcl_object str = mkcl_cstring16_copy_to_utf_16(env, output);

      free(output); /* Yes this bypasses the GC since it was malloced by realpath(). */
      
      return str;    
    }
}
#endif


#ifdef MKCL_WINDOWS
/*
 * Finds current directory by using _getdcwd() with an adjustable
 * string which grows until it can host the whole path.
 */
static mkcl_object
current_dir_on_drive(MKCL, int drive)
{
  mkcl_object output;
  const wchar_t *ok;
  mkcl_index size = 128;

  do {
    output = mkcl_alloc_OSstring(env, size);
    MKCL_LIBC_NO_INTR(env, ok = _wgetdcwd(drive, mkcl_OSstring_self(output), size));
    size += 256;
  } while (ok == NULL && errno == ERANGE);
  if (ok == NULL)
    mkcl_FElibc_error(env, "current_dir_on_drive() failed on _getdcwd()", 0);
  size = wcslen(mkcl_OSstring_self(output));
  mkcl_OSstring_set_fillp(output, size);
#ifdef _MSC_VER
#error left as an exercise to the reader!
  {
    unsigned char *c;
    for (c = output->base_string.self; *c; c++)
      if (*c == '\\')
	*c = '/';
  }
#endif

  if (mkcl_OSstring_last(env, output) != '/')
    mkcl_OSstring_push_extend(env, output, '/');
  return mkcl_OSstring_to_string(env, output);
}
#endif /* defined(MKCL_WINDOWS) */

/*
 * Finds current directory by using getcwd() with an adjustable
 * string which grows until it can host the whole path.
 */
static mkcl_object
current_dir(MKCL)
{
  mkcl_object output;
#ifdef MKCL_WINDOWS
  const wchar_t *ok;
  mkcl_index size = 256;

  do {
    output = mkcl_alloc_OSstring(env, size);
    MKCL_LIBC_NO_INTR(env, ok = _wgetcwd(mkcl_OSstring_self(output), size));
    size += 256;
  } while (ok == NULL && errno == ERANGE);
  if (ok == NULL)
    mkcl_FElibc_error(env, "current_dir() failed on _wgetcwd()", 0);
  size = wcslen(mkcl_OSstring_self(output));
  mkcl_OSstring_set_fillp(output, size);
# ifdef _MSC_VER
#  error left as an exercise to the reader!
  {
    unsigned char *c;
    for (c = output->base_string.self; *c; c++)
      if (*c == '\\')
	*c = '/';
  }
# endif
#else /* def MKCL_WINDOWS */
  const char *ok;
  mkcl_index size = 256;

  do {
    output = mkcl_alloc_OSstring(env, size);
    MKCL_LIBC_NO_INTR(env, ok = getcwd(mkcl_OSstring_self(output), size));
    size += 256;
  } while (ok == NULL && errno == ERANGE);
  if (ok == NULL)
    mkcl_FElibc_error(env, "current_dir() failed on getcwd()", 0);
  size = strlen(mkcl_OSstring_self(output)); /* Unix only! */
  mkcl_OSstring_set_fillp(output, size);
#endif

  if (mkcl_OSstring_last(env, output) != '/')
    mkcl_OSstring_push_extend(env, output, '/');
  return mkcl_OSstring_to_string(env, output);
}

/*
 * Using a certain path, query the type of the filesystem element it points to.
 */

static mkcl_object
file_kind(MKCL, mkcl_object os_filename, bool follow_links)
{
  mkcl_OSstring_raw_type raw_os_filename = mkcl_OSstring_self(os_filename);
  mkcl_object output;
#ifdef MKCL_WINDOWS
  DWORD dw;
  MKCL_LIBC_NO_INTR(env, dw = GetFileAttributesW( raw_os_filename ));
  if (dw == INVALID_FILE_ATTRIBUTES)
    /* mkcl_FEwin32_file_error(env, os_filename, "GetFileAttributes() failed in file_kind()", 0); */
    output = mk_cl_Cnil; /* We prefer to have the caller handle the error just above us. */
  else if ( dw & FILE_ATTRIBUTE_DIRECTORY )
    output = @':directory';
#ifdef FILE_ATTRIBUTE_REPARSE_POINT
  else if ( dw & FILE_ATTRIBUTE_REPARSE_POINT )
    output = @':link';
#endif
  else if ( dw & FILE_ATTRIBUTE_DEVICE )
    output = @':device';
  else
    output = @':file';
#else /* !defined(MKCL_WINDOWS) */
  struct stat buf;
  int rc;

# ifdef HAVE_LSTAT
  MKCL_LIBC_NO_INTR(env, rc = (follow_links ? stat : lstat)(mkcl_OSstring_self(os_filename), &buf));
# else
  MKCL_LIBC_NO_INTR(env, rc = stat(mkcl_OSstring_self(os_filename), &buf));
# endif

  if (rc)
    /* Here errno could be EACCES, EBADF, EFAULT, ELOOP,
       ENAMETOOLONG, ENOENT, ENOMEM, ENOTDIR, EOVERFLOW. */
    /* ANSI requires us to raise a file-error on most of these. JCB */
    /* mkcl_FElibc_file_error(env, os_filename, "stat() failed in file_kind()", 0); */
    output = mk_cl_Cnil; /* We prefer to have the caller handle the error just above us. */
  else if (S_ISDIR(buf.st_mode))
    output = @':directory';
  else if (S_ISREG(buf.st_mode))
    output = @':file';
# ifdef HAVE_LSTAT
  else if (S_ISLNK(buf.st_mode))
    output = @':link';
# endif
  else if (S_ISCHR(buf.st_mode))
    output = @':device';
  else if (S_ISBLK(buf.st_mode))
    output = @':device';
  else
    output = @':special';
#endif /* !defined(MKCL_WINDOWS) */
  return output;
}

#if 0
mkcl_object
mk_si_file_kind(MKCL, mkcl_object filename, mkcl_object follow_links) {
  filename = mk_si_coerce_to_filename(env, filename);
#if 0
  mkcl_object os_filename = mkcl_string_to_OSstring(env, filename);
#else
  mkcl_dynamic_extent_OSstring(env, os_filename, filename);
#endif
  mkcl_object kind = file_kind(env, os_filename, !mkcl_Null(follow_links));
  @(return kind);
}
#else

@(defun si::file-kind (filespec &key follow_symlinks signal_error)
@
  mkcl_object filename = mk_si_coerce_to_filename(env, filespec);
  mkcl_dynamic_extent_OSstring(env, os_filename, filename);
  mkcl_object kind = file_kind(env, os_filename, !mkcl_Null(follow_symlinks));

  if (mkcl_Null(kind) && !mkcl_Null(signal_error))
    {
#ifdef MKCL_WINDOWS
      mkcl_FEwin32_file_error(env, os_filename, "GetFileAttributes() failed in file_kind()", 0);
#else
      mkcl_FElibc_file_error(env, os_filename, "stat() failed in file_kind()", 0);
#endif
    }
  @(return kind);
@)
#endif



/*
 * Search the actual name of the directory of a pathname,
 * going through links if they exist. Default is
 * current directory
 */
mkcl_object
mk_cl_truename(MKCL, mkcl_object orig_pathname)
{
  mkcl_call_stack_check(env);
  mkcl_object pathname = orig_pathname;
  mkcl_object filename = mk_si_coerce_to_filename(env, pathname);
  if (mkcl_string_length(env, filename))
    {
      mkcl_object true_os_path = safe_realpath(env, filename, filename);

      if (@':directory' == file_kind(env, true_os_path, FALSE))
	if (!MKCL_IS_DIR_SEPARATOR(mkcl_OSstring_last(env, true_os_path)))
	  mkcl_OSstring_push_extend(env, true_os_path, MKCL_DIR_SEPARATOR);
      @(return mk_cl_pathname(env, mkcl_OSstring_to_string(env, true_os_path)));
    }
  else
    { /* This is a ridiculously nonsensical extension of the specification 
	 but it is implemented by a large number CL environments
	 (like ccl, clisp, cmulisp, lispworks and allegro)
	 and seems to be expected (even demanded) by a large number of users.
	 So, we are forced to join the crowd! JCB */
      @(return mk_cl_parse_namestring(env, 3, current_dir(env), mk_cl_Cnil, mk_cl_Cnil));
    }
}

int
mkcl_backup_open(MKCL, mkcl_object filename, int option, int mode)
{
  int fd;
  int error;
  static const mkcl_base_string_object(back_ext_str_obj, ".BAK");
#if 0
  mkcl_object os_back_ext = mkcl_string_to_OSstring(env, (mkcl_object) &back_ext_str_obj);
  mkcl_object os_filename = mkcl_string_to_OSstring(env, filename);
#else
  mkcl_dynamic_extent_OSstring(env, os_back_ext, (mkcl_object) &back_ext_str_obj);
  mkcl_dynamic_extent_OSstring(env, os_filename, filename);
#endif
  mkcl_object backupfilename = mkcl_alloc_OSstring(env, mkcl_length(env, filename) + mkcl_OSstring_size(os_back_ext));

  mkcl_OSstring_nconc(env, backupfilename, os_filename);
  mkcl_OSstring_nconc(env, backupfilename, os_back_ext);

#ifdef MKCL_WINDOWS
  /* MS-Windows rename doesn't remove an existing file */
  MKCL_LIBC_NO_INTR(env, error = (_waccess(mkcl_OSstring_self(backupfilename), F_OK) == 0
				  && _wunlink(mkcl_OSstring_self(backupfilename))));
  if (error) {
    mkcl_object f = mkcl_OSstring_to_string(env, backupfilename);
    mkcl_FElibc_file_error(env, f, "Cannot remove the file ~S", 1, f);
  }
#endif
#ifdef MKCL_WINDOWS
  MKCL_LIBC_NO_INTR(env, error = _wrename(mkcl_OSstring_self(os_filename), mkcl_OSstring_self(backupfilename)));
#else
  MKCL_LIBC_NO_INTR(env, error = rename(mkcl_OSstring_self(os_filename), mkcl_OSstring_self(backupfilename)));
#endif
  if (error) {
    mkcl_object f = filename;
    mkcl_FElibc_file_error(env, f, "Cannot rename the file ~S to ~S.",
			   2, f, mkcl_OSstring_to_string(env, backupfilename));
  }
#ifdef MKCL_WINDOWS
  MKCL_LIBC_NO_INTR(env, fd = _wopen(mkcl_OSstring_self(os_filename), option, mode));
#else
  MKCL_LIBC_NO_INTR(env, fd = open(mkcl_OSstring_self(os_filename), option, mode));
#endif
  /* error value of fd must be handled by caller. */
  /* mkcl_dealloc(env, backupfilename); */
  return fd;
}

mkcl_object
mkcl_file_len(MKCL, int f)
{
  os_file_stat filestatus;
  int not_ok;

#ifdef MKCL_WINDOWS
  MKCL_LIBC_NO_INTR(env, not_ok = _fstat64(f, &filestatus));
#else
  MKCL_LIBC_NO_INTR(env, not_ok = fstat(f, &filestatus));
#endif
  if (not_ok)
    mkcl_FElibc_error(env, "fstat() failed in mkcl_file_len().", 0);

#if 0
  return mkcl_make_integer(env, filestatus.st_size);
#else
  return mkcl_make_int64_t(env, filestatus.st_size);
#endif
}


mkcl_object mk_cl_rename_file(MKCL, mkcl_object old_filespec, mkcl_object new_name)
{
  mkcl_call_stack_check(env);
  /* 1) Get the old filename, and complain if it has wild components,
   *    or if it does not exist. Notice that the filename to be renamed
   *    is not the truename, because we might be renaming a symbolic link.
   */
  mkcl_object old_filename = mk_si_coerce_to_filename(env, old_filespec = mk_cl_pathname(env, old_filespec));
  mkcl_object old_truename = mk_cl_truename(env, old_filespec);
  mkcl_object new_filename;
  mkcl_interrupt_status old_intr;
  
  /* 2) Create the new file name. */
  new_name = mkcl_merge_pathnames(env, mk_cl_pathname(env, new_name), old_filespec, @':newest');
  new_filename = mk_si_coerce_to_filename(env, new_name);

#if 0
  mkcl_object new_os_filename = mkcl_string_to_OSstring(env, new_filename);
  mkcl_object old_os_filename = mkcl_string_to_OSstring(env, old_filename);
#else
  mkcl_dynamic_extent_OSstring(env, new_os_filename, new_filename);
  mkcl_dynamic_extent_OSstring(env, old_os_filename, old_filename);
#endif
  
  mkcl_get_interrupt_status(env, &old_intr);
  mkcl_disable_interrupts(env);
  {
#ifdef MKCL_WINDOWS
    int error_mode = SetErrorMode(0);

    if (MoveFileW(mkcl_OSstring_self(old_os_filename),
		  mkcl_OSstring_self(new_os_filename)))
      {
	SetErrorMode(error_mode);
	goto SUCCESS;
      }
    switch (GetLastError())
      {
      case ERROR_ALREADY_EXISTS:
      case ERROR_FILE_EXISTS:
	break;
      default:
	goto FAILURE_CLOBBER;
      };
    if (MoveFileExW(mkcl_OSstring_self(old_os_filename),
		    mkcl_OSstring_self(new_os_filename),
		    MOVEFILE_REPLACE_EXISTING))
      {
	SetErrorMode(error_mode);
	goto SUCCESS;
      }
    /* hack for win95/novell */
    _wchmod(mkcl_OSstring_self(old_os_filename), 0777); /* FIXME: Return value? JCB */
    _wchmod(mkcl_OSstring_self(new_os_filename), 0777); /* FIXME: Return value? JCB */
    SetFileAttributesW(mkcl_OSstring_self(new_os_filename), FILE_ATTRIBUTE_NORMAL); /* FIXME: Return value? JCB */
    SetFileAttributesW(mkcl_OSstring_self(new_os_filename), FILE_ATTRIBUTE_TEMPORARY); /* FIXME: Return value? JCB */
    if (MoveFileW(mkcl_OSstring_self(old_os_filename),
		  mkcl_OSstring_self(new_os_filename)))
      {
	SetErrorMode(error_mode);
	goto SUCCESS;
      }
    /* fallback on old behavior */
    (void)DeleteFileW(mkcl_OSstring_self(new_os_filename)); /* FIXME: Return value? JCB */
    if (MoveFileW(mkcl_OSstring_self(old_os_filename),
		  mkcl_OSstring_self(new_os_filename)))
      {
	SetErrorMode(error_mode);
	goto SUCCESS;
      }
    /* fall through */
#else /* def MKCL_WINDOWS */
    if (rename(mkcl_OSstring_self(old_os_filename),
	       mkcl_OSstring_self(new_os_filename)) == 0) {
      goto SUCCESS;
    }
    /* fall through */
#endif /* def MKCL_WINDOWS */
  }
 FAILURE_CLOBBER:
  mkcl_set_interrupt_status(env, &old_intr);
#ifdef MKCL_WINDOWS
  mkcl_FEwin32_file_error(env, old_filespec, "Cannot rename the file ~S to ~S.", 2, old_filespec, new_name);
#else
  mkcl_FElibc_file_error(env, old_filespec, "Cannot rename the file ~S to ~S.", 2, old_filespec, new_name);
#endif
  
 SUCCESS:
  mkcl_set_interrupt_status(env, &old_intr);
  @(return new_name old_truename mk_cl_truename(env, new_name));
}

mkcl_object
mk_cl_delete_file(MKCL, mkcl_object file)
{
  mkcl_call_stack_check(env);
  mkcl_object filename = mk_si_coerce_to_filename(env, file);
#if 0
  mkcl_object os_filename = mkcl_string_to_OSstring(env, filename);
#else
  mkcl_dynamic_extent_OSstring(env, os_filename, filename);
#endif
  int ok;

#ifdef MKCL_WINDOWS
  MKCL_LIBC_NO_INTR(env, ok = _wunlink(mkcl_OSstring_self(os_filename)));
#else
  MKCL_LIBC_NO_INTR(env, ok = unlink(mkcl_OSstring_self(os_filename)));
#endif

  if (ok == -1)
    mkcl_FElibc_file_error(env, file, "Cannot delete file.", 0);
  @(return mk_cl_Ct);
}


bool mkcl_probe_file(MKCL, mkcl_object os_filename, bool follow_links)
{
  mkcl_OSstring_raw_type raw_os_filename = mkcl_OSstring_self(os_filename);
  mkcl_object output;
#ifdef MKCL_WINDOWS
  DWORD dw;
  MKCL_LIBC_NO_INTR(env, dw = GetFileAttributesW( raw_os_filename ));
  if (dw == INVALID_FILE_ATTRIBUTES)
    {
      DWORD last_error = GetLastError();
      switch (last_error)
	{
	default:
	  mkcl_FEwin32_file_error(env, os_filename, "GetFileAttributes() failed in mkcl_probe_file()", 0);
	case ERROR_FILE_NOT_FOUND:
	case ERROR_PATH_NOT_FOUND:
	  return FALSE;
	}
    }
#if 0
# ifdef FILE_ATTRIBUTE_REPARSE_POINT
  else if ( dw & FILE_ATTRIBUTE_REPARSE_POINT )
    return TRUE;
# endif
#endif
  else if ( dw & FILE_ATTRIBUTE_DIRECTORY )
    return TRUE;
  else if ( dw & FILE_ATTRIBUTE_DEVICE )
    return FALSE;
  else
    return TRUE;
#else /* !defined(MKCL_WINDOWS) */
  struct stat buf;
  int rc;

# ifdef HAVE_LSTAT
  MKCL_LIBC_NO_INTR(env, rc = (follow_links ? stat : lstat)(mkcl_OSstring_self(os_filename), &buf));
# else
  MKCL_LIBC_NO_INTR(env, rc = stat(mkcl_OSstring_self(os_filename), &buf));
# endif

  if (rc)
    {
      int this_errno = errno;

      output = mk_cl_Cnil;
      switch (this_errno)
	{
	default: /* should be one of: EACCES, EBADF, EFAULT, ELOOP, ENAMETOOLONG, ENOMEM, EOVERFLOW. */
	  mkcl_FElibc_file_error(env, os_filename, "stat() failed in mkcl_probe_file()", 0);
	case ENOENT:
	case ENOTDIR:
	  return FALSE;
	}
    }
  else if (S_ISDIR(buf.st_mode))
    return TRUE;
  else if (S_ISREG(buf.st_mode))
    return TRUE;
# ifdef HAVE_LSTAT
  else if (S_ISLNK(buf.st_mode))
    return TRUE;
# endif
  else if (S_ISCHR(buf.st_mode))
    return FALSE;
  else if (S_ISBLK(buf.st_mode))
    return FALSE;
  else
    return FALSE;
#endif /* !defined(MKCL_WINDOWS) */
}

mkcl_object
mk_cl_probe_file(MKCL, mkcl_object filespec)
{
  mkcl_call_stack_check(env);
  /* INV: Both SI:FILE-KIND and TRUENAME complain if "file" has wildcards */
#if 0
  @(return (mkcl_Null(mk_si_file_kind(env, filespec, mk_cl_Ct)) ? mk_cl_Cnil : mk_cl_truename(env, filespec)));
#else
  mkcl_object filename = mk_si_coerce_to_filename(env, filespec);
  mkcl_dynamic_extent_OSstring(env, os_filename, filename);

  @(return (mkcl_probe_file(env, os_filename, TRUE /* follow symlinks */) ? mk_cl_truename(env, filespec) : mk_cl_Cnil));
#endif
}

mkcl_object
mk_mkcl_stream_filename(MKCL, mkcl_object x)
{
  mkcl_call_stack_check(env);
 L:
  switch (mkcl_type_of(x)) {
  case mkcl_t_stream:
    switch ((enum mkcl_smmode)x->stream.mode) {
    case mkcl_smm_input:
    case mkcl_smm_output:
    case mkcl_smm_io:
      x = MKCL_IO_STREAM_FILENAME(x);
      break;
    case mkcl_smm_input_file:
    case mkcl_smm_output_file:
    case mkcl_smm_io_file:
    case mkcl_smm_probe:
      x = MKCL_IO_FILE_FILENAME(x);
      break;
    case mkcl_smm_synonym:
      x = MKCL_SYNONYM_STREAM_STREAM(env, x);
      goto L;
    default:
      ;/* Fall through to error message */
    }
  default:
    mkcl_FEwrong_type_argument(env, @'file-stream', x);
  }
  @(return x);
}

mkcl_object
mk_mkcl_probe_file_p(MKCL, mkcl_object filename)
{
  mkcl_call_stack_check(env);
  switch (mkcl_type_of(filename))
    {
    case mkcl_t_base_string: break;
    case mkcl_t_string: break;
    case mkcl_t_pathname:
      {
	mkcl_object path = filename;
	mkcl_object namestring;

	if (path->pathname.logical)
	  path = mk_cl_translate_logical_pathname(env, 1, path);
	namestring = mkcl_namestring(env, path, TRUE);
	if (namestring == mk_cl_Cnil)
	  mkcl_FEerror(env, "Pathname ~A does not have a physical namestring", 1, filename);
	else
	  filename = namestring;
      }
      break;
    case mkcl_t_stream: filename = mk_mkcl_stream_filename(env, filename); break;
    default:
      mkcl_FEwrong_type_argument(env,
				 mk_cl_list(env, 4, @'or', @'file-stream', @'string', @'pathname'),
				 filename);
    }
  {
    mkcl_dynamic_extent_OSstring(env, os_filename, filename);

    @(return (mkcl_probe_file(env, os_filename, TRUE /* follow symlinks */) ? mk_cl_Ct : mk_cl_Cnil));
  }
}

mkcl_object
mk_cl_file_write_date(MKCL, mkcl_object file)
{
  mkcl_call_stack_check(env);
  mkcl_object time, filename = mk_si_coerce_to_filename(env, file);
  os_file_stat filestatus;

  if (safe_stat(env, filename, &filestatus) < 0)
    mk_cl_error(env, 3, @'file-error', @':pathname', file);
  else
    time = MKCL_UTC_time_to_universal_time(env, filestatus.st_mtime);
  @(return time);
}

mkcl_object
mk_cl_file_author(MKCL, mkcl_object file)
{
  mkcl_call_stack_check(env);
#ifdef __unix
  mkcl_object filename = mk_si_coerce_to_filename(env, file);
  mkcl_object output = mk_cl_Cnil;
  struct stat filestatus;

  if (safe_stat(env, filename, &filestatus) < 0)
    mkcl_FElibc_file_error(env, file, "mk_cl_file_author: Cannot get file status.", 0);

  {
    struct passwd pwd;
    struct passwd *result;
    const size_t bufsize = sysconf(_SC_GETPW_R_SIZE_MAX);
    char buf[bufsize]; /* a VLA. */
    int status;

    MKCL_LIBC_NO_INTR(env, (status = getpwuid_r(filestatus.st_uid, &pwd, buf, bufsize, &result)));
    if (result == NULL)
      {
	errno = status;
	mkcl_FElibc_file_error(env, file,
			       "mk_cl_file_author: Cannot get information for UID (~D).",
			       1, mkcl_make_unsigned_integer(env, filestatus.st_uid));
      }
    else
      output = mkcl_cstring_to_string(env, result->pw_name);
  }

  /* Beware that this is the file owner not its author. */
  @(return output);
#else /* def __unix */
  /* If we want to duplicate the unix behavior on MS-Windows
     we could call GetFileSecurity() then do GetSecurityDescriptorOnwer()
     and finally LookupAccountSid to get the name of the file owner.
   */
  @(return mk_cl_Cnil);
#endif /* def __unix */
}

mkcl_object
mkcl_homedir_pathname(MKCL, mkcl_object user)
{
  mkcl_object namestring;
  mkcl_OSstring_raw_type raw_os_home;
  mkcl_OSstring_raw_type raw_os_drive;

  if (!mkcl_Null(user))
    {
#if 0
      mkcl_object os_user = mkcl_string_to_OSstring(env, user);
#else
      mkcl_dynamic_extent_OSstring(env, os_user, user);
#endif
      mkcl_OSstring_raw_type raw_os_user = mkcl_OSstring_self(os_user);
      mkcl_index os_user_size = mkcl_OSstring_size(os_user);

      if (os_user_size > 0 && *raw_os_user == '~') {
	raw_os_user++;
	os_user_size--;
      }
      if (os_user_size == 0)
	return mkcl_homedir_pathname(env, mk_cl_Cnil);
      else
	{
#ifdef __unix
	  struct passwd pwd;
	  struct passwd *result;
	  const size_t bufsize = sysconf(_SC_GETPW_R_SIZE_MAX);
	
	  {
	    char buf[bufsize]; /* a VLA. */
	    int status;

	    MKCL_LIBC_NO_INTR(env, status = getpwnam_r(raw_os_user, &pwd, buf, bufsize, &result));
	    if (result == NULL)
	      {
		if (status)
		  {
		    errno = status;
		    mkcl_FElibc_error(env, "In mkcl_homedir_pathname(), failed on getpwnam_r()", 1, user);
		  }
		else
		  return mk_cl_Cnil;
	      }
	  }
	  namestring = mkcl_cstring_to_string(env, result->pw_dir);
#else /* def __unix */
	  return mk_cl_Cnil;
#endif /* def __unix */
	}
    }
  else
    {
      static const mkcl_base_string_object(home_string_obj, "HOME");

      namestring = mkcl_getenv(env, (mkcl_object)&home_string_obj);

      if (mkcl_Null(namestring))
	{
#ifdef MKCL_WINDOWS
	  static const mkcl_base_string_object(homepath_string_obj, "HOMEPATH");
	  static const mkcl_base_string_object(homedrive_string_obj, "HOMEDRIVE");
	  mkcl_object homepath = mkcl_getenv(env, (mkcl_object)&homepath_string_obj);
	  mkcl_object homedrive = mkcl_getenv(env, (mkcl_object)&homedrive_string_obj);
	  
	  if (mkcl_Null(homepath) || mkcl_Null(homedrive))
	    namestring = mkcl_make_simple_base_string(env, "C:/");
	  else
	    {
	      namestring = mkcl_concatenate_2_strings(env, homedrive, homepath);
	      namestring = mkcl_coerce_to_adjustable_string(env, namestring);
	    }
	  
#else
	  namestring = mkcl_make_simple_base_string(env, "/");
#endif /* def MKCL_WINDOWS */
	}
    }

  if (mkcl_character_index_raw(env, namestring, 0) == '~')
    mkcl_FEerror(env, "Not a valid home pathname ~S", 1, namestring);

  {
    mkcl_character ch = mkcl_string_last(env, namestring);
    if (!MKCL_IS_DIR_SEPARATOR(ch))
      mkcl_string_push_extend(env, namestring, MKCL_DIR_SEPARATOR);
  }
  return mk_cl_parse_namestring(env, 3, namestring, mk_cl_Cnil, mk_cl_Cnil);
}

@(defun user_homedir_pathname (&optional host)
@
  /* Ignore optional host argument. */
  @(return mkcl_homedir_pathname(env, mk_cl_Cnil));
@)

#ifdef __unix
#define not_eq_ch(c1, c2) ((c1) != (c2))
#elif defined(MKCL_WINDOWS)
static inline bool not_eq_ch(wchar_t c1, wchar_t c2)
{