/* -*- 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>
#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

#ifdef __unix

static int
safe_stat(MKCL, mkcl_object path, os_file_stat *sb)
{
  mkcl_dynamic_extent_OSstring(env, os_path, path);
  int output;

  MKCL_LIBC_NO_INTR(env, output = stat(mkcl_OSstring_self(os_path), sb));
  return output;
}

#endif /* def __unix */

#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), /* FIXME, This will not work across filesystems. JCB */

	       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));
  }
}

#ifdef MKCL_WINDOWS
static mkcl_object mkcl_FILETIME_to_universal_time(MKCL, FILETIME file_time)
{
  ULARGE_INTEGER large_file_time;
  static ULARGE_INTEGER large_jan1st1900_ft = { 0, 0 };
  const static SYSTEMTIME jan1st1900_st = { 1900, 1, 1, 1, 0, 0, 0, 0};
  static FILETIME jan1st1900_ft = { 0, 0 };

  large_file_time.LowPart = file_time.dwLowDateTime;
  large_file_time.HighPart = file_time.dwHighDateTime;

  if (large_jan1st1900_ft.QuadPart == 0)
    {
      BOOL ok;
      MKCL_LIBC_NO_INTR(env, ok = SystemTimeToFileTime(&jan1st1900_st, &jan1st1900_ft));
      if (!ok)
	mkcl_FEwin32_error(env, "SystemTimetoFileTime failed to convert 1900/01/01 00:00:00 properly", 0);
      large_jan1st1900_ft.LowPart = jan1st1900_ft.dwLowDateTime;
      large_jan1st1900_ft.HighPart = jan1st1900_ft.dwHighDateTime;
    }
  
  /* FILETIME count is in 100 nanoseconds, so we divide it by 10000000 to get seconds. */
  __time64_t universal_time = (large_file_time.QuadPart - large_jan1st1900_ft.QuadPart) / (10 * 1000 * 1000);
  return mkcl_make_int64_t(env, universal_time);
}
#endif /* def MKCL_WINDOWS */

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);

#ifdef __unix

  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);

#elif defined(MKCL_WINDOWS)
  FILETIME ftWrite;
  HANDLE file_handle;
  BOOL ok;
  mkcl_dynamic_extent_OSstring(env, os_filename, filename);
  
  /* FILE_FLAG_BACKUP_SEMANTICS is required to obtain a handle on directories (see MicroSoft documentation on CreateFile).
     Hope it does not have extra unexpected consequences for regular files... */
  MKCL_LIBC_NO_INTR(env, file_handle = CreateFileW(mkcl_OSstring_self(os_filename),
						   GENERIC_READ, FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE,
						   NULL, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, NULL));
  if (file_handle == INVALID_HANDLE_VALUE)
    mkcl_FEwin32_file_error(env, file, "file-write-date failed to find file", 0);
  
  MKCL_LIBC_NO_INTR(env, ok = GetFileTime(file_handle, NULL, NULL, &ftWrite));
  CloseHandle(file_handle);
  if (!ok)
    mkcl_FEwin32_file_error(env, file, "file-write-date failed to retreive file write date", 0);
  
  time = mkcl_FILETIME_to_universal_time(env, ftWrite);
#else
#error mk_cl_file_write_date() not implemented on this platform.
#endif /* elif defined(MKCL_WINDOWS) */