* Copyright (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 2001-2004 Vincent Darley.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclIOUtil.c,v 1.81.2.37 2008/04/24 04:56:37 dgp Exp $
 */

#include "tclInt.h"
#ifdef __WIN32__
#   include "tclWinInt.h"
#endif
#include "tclFileSystem.h"

Tcl_Stat(
    const char *path,		/* Path of file to stat (in current CP). */
    struct stat *oldStyleBuf)	/* Filled with results of stat call. */
{
    int ret;
    Tcl_StatBuf buf;
    Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1);

#ifndef TCL_WIDE_INT_IS_LONG
    Tcl_WideInt tmp1, tmp2;
#ifdef HAVE_ST_BLOCKS
    Tcl_WideInt tmp3;
#endif
#endif

	(((Tcl_WideUInt)(x)) > ((Tcl_WideUInt)ULONG_MAX))

	/*
	 * Perform the result-buffer overflow check manually.
	 *
	 * Note that ino_t/ino64_t is unsigned...
	 *
	 * Workaround gcc warning of "comparison is always false due to limited range of
	 * data type" by assigning to tmp var of type Tcl_WideInt.

	 */

        tmp1 = (Tcl_WideInt) buf.st_ino;
        tmp2 = (Tcl_WideInt) buf.st_size;
#ifdef HAVE_ST_BLOCKS
        tmp3 = (Tcl_WideInt) buf.st_blocks;
#endif


/* Obsolete */
char *
Tcl_GetCwd(
    Tcl_Interp *interp,
    Tcl_DString *cwdPtr)
{
    Tcl_Obj *cwd;
    cwd = Tcl_FSGetCwd(interp);
    if (cwd == NULL) {
	return NULL;
    } else {

	Tcl_DStringInit(cwdPtr);
	Tcl_DStringAppend(cwdPtr, Tcl_GetString(cwd), -1);
	Tcl_DecrRefCount(cwd);
	return Tcl_DStringValue(cwdPtr);
    }
}

/* Obsolete */
int
Tcl_EvalFile(
    Tcl_Interp *interp,		/* Interpreter in which to process file. */
    const char *fileName)	/* Name of file to process. Tilde-substitution
				 * will be performed on this name. */
{
    int ret;
    Tcl_Obj *pathPtr = Tcl_NewStringObj(fileName,-1);

    Tcl_IncrRefCount(pathPtr);
    ret = Tcl_FSEvalFile(interp, pathPtr);
    Tcl_DecrRefCount(pathPtr);
    return ret;
}

/*

static FilesystemRecord *filesystemList = &nativeFilesystemRecord;
TCL_DECLARE_MUTEX(filesystemMutex)

/*
 * Used to implement Tcl_FSGetCwd in a file-system independent way.
 */

static Tcl_Obj* cwdPathPtr = NULL;
static int cwdPathEpoch = 0;
static ClientData cwdClientData = NULL;
TCL_DECLARE_MUTEX(cwdMutex)

Tcl_ThreadDataKey tclFsDataKey;

/*

 * Now move on to the basic filesystem implementation
 */

static void
FsThrExitProc(
    ClientData cd)
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) cd;
    FilesystemRecord *fsRecPtr = NULL, *tmpFsRecPtr = NULL;

    /*
     * Trash the cwd copy.
     */

    if (tsdPtr->cwdPathPtr != NULL) {

     * Trash the filesystems cache.
     */

    fsRecPtr = tsdPtr->filesystemList;
    while (fsRecPtr != NULL) {
	tmpFsRecPtr = fsRecPtr->nextPtr;
	if (--fsRecPtr->fileRefCount <= 0) {
	    ckfree((char *)fsRecPtr);
	}
	fsRecPtr = tmpFsRecPtr;
    }
    tsdPtr->initialized = 0;
}

int

 *	refCount).
 *
 *----------------------------------------------------------------------
 */

int
TclFSCwdPointerEquals(
    Tcl_Obj** pathPtrPtr)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);

    Tcl_MutexLock(&cwdMutex);
    if (tsdPtr->cwdPathPtr == NULL
	    || tsdPtr->cwdPathEpoch != cwdPathEpoch) {
	if (tsdPtr->cwdPathPtr != NULL) {

	    tsdPtr->cwdClientData = TclNativeDupInternalRep(cwdClientData);
	}
	tsdPtr->cwdPathEpoch = cwdPathEpoch;
    }
    Tcl_MutexUnlock(&cwdMutex);

    if (tsdPtr->initialized == 0) {
	Tcl_CreateThreadExitHandler(FsThrExitProc, (ClientData) tsdPtr);
	tsdPtr->initialized = 1;
    }

    if (pathPtrPtr == NULL) {
	return (tsdPtr->cwdPathPtr == NULL);
    }

     * Trash the current cache.
     */

    fsRecPtr = tsdPtr->filesystemList;
    while (fsRecPtr != NULL) {
	tmpFsRecPtr = fsRecPtr->nextPtr;
	if (--fsRecPtr->fileRefCount <= 0) {
	    ckfree((char *)fsRecPtr);
	}
	fsRecPtr = tmpFsRecPtr;
    }
    tsdPtr->filesystemList = NULL;

    /*
     * Code below operates on shared data. We are already called under mutex

    }

    /*
     * Make sure the above gets released on thread exit.
     */

    if (tsdPtr->initialized == 0) {
	Tcl_CreateThreadExitHandler(FsThrExitProc, (ClientData) tsdPtr);
	tsdPtr->initialized = 1;
    }
}
#endif /* TCL_THREADS */

static FilesystemRecord *
FsGetFirstFilesystem(void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
    FilesystemRecord *fsRecPtr;

#ifndef TCL_THREADS
    tsdPtr->filesystemEpoch = theFilesystemEpoch;
    fsRecPtr = filesystemList;
#else
    Tcl_MutexLock(&filesystemMutex);
    if (tsdPtr->filesystemList == NULL
	    || (tsdPtr->filesystemEpoch != theFilesystemEpoch)) {

     * Remove all filesystems, freeing any allocated memory that is no longer
     * needed
     */

    fsRecPtr = filesystemList;
    while (fsRecPtr != NULL) {
	FilesystemRecord *tmpFsRecPtr = fsRecPtr->nextPtr;

	if (fsRecPtr->fileRefCount <= 0) {
	    /*
	     * The native filesystem is static, so we don't free it.
	     */

	    if (fsRecPtr->fsPtr != &tclNativeFilesystem) {
		ckfree((char *)fsRecPtr);
	    }
	}
	fsRecPtr = tmpFsRecPtr;
    }
    filesystemList = NULL;

    /*

	     * (which would of course lead to memory exceptions).
	     */

	    theFilesystemEpoch++;

	    fsRecPtr->fileRefCount--;
	    if (fsRecPtr->fileRefCount <= 0) {
		ckfree((char *)fsRecPtr);
	    }

	    retVal = TCL_OK;
	} else {
	    fsRecPtr = fsRecPtr->nextPtr;
	}
    }

				 * May be NULL. In particular the directory
				 * flag is very important. */
{
    const Tcl_Filesystem *fsPtr;
    Tcl_Obj *cwd, *tmpResultPtr, **elemsPtr;
    int resLength, i, ret = -1;

    if (types != NULL && types->type & TCL_GLOB_TYPE_MOUNT) {
	/*
	 * We don't currently allow querying of mounts by external code (a
	 * valuable future step), so since we're the only function that
	 * actually knows about mounts, this means we're being called
	 * recursively by ourself. Return no matches.
	 */

     * special case, in which if we have a native filesystem handler, we call
     * it first. This is because the root of Tcl's filesystem is always a
     * native filesystem (i.e. '/' on unix is native).
     */

    firstFsRecPtr = FsGetFirstFilesystem();





    fsRecPtr = firstFsRecPtr;




    while (fsRecPtr != NULL) {
	if (fsRecPtr->fsPtr == &tclNativeFilesystem) {
	    Tcl_FSNormalizePathProc *proc = fsRecPtr->fsPtr->normalizePathProc;
	    if (proc != NULL) {
		startAt = (*proc)(interp, pathPtr, startAt);
	    }
	    break;
	}
	fsRecPtr = fsRecPtr->nextPtr;
    }

    fsRecPtr = firstFsRecPtr;
    while (fsRecPtr != NULL) {
	/*
	 * Skip the native system next time through.
	 */

	if (fsRecPtr->fsPtr != &tclNativeFilesystem) {


	    Tcl_FSNormalizePathProc *proc = fsRecPtr->fsPtr->normalizePathProc;
	    if (proc != NULL) {

		startAt = (*proc)(interp, pathPtr, startAt);
	    }

	    /*
	     * We could add an efficiency check like this:
	     *		if (retVal == length-of(pathPtr)) {break;}
	     * but there's not much benefit.
	     */
	}
	fsRecPtr = fsRecPtr->nextPtr;
    }

    return startAt;
}

/*
 *---------------------------------------------------------------------------

    if (Tcl_FSStat(pathPtr, &statBuf) == -1) {
	Tcl_SetErrno(errno);
	Tcl_AppendResult(interp, "couldn't read file \"",
		Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), NULL);
	return result;
    }
    chan = Tcl_FSOpenFileChannel(interp, pathPtr, "r", 0644);
    if (chan == (Tcl_Channel) NULL) {
	Tcl_ResetResult(interp);
	Tcl_AppendResult(interp, "couldn't read file \"",
		Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), NULL);
	return result;
    }

    /*

    }

    iPtr = (Interp *) interp;
    oldScriptFile = iPtr->scriptFile;
    iPtr->scriptFile = pathPtr;
    Tcl_IncrRefCount(iPtr->scriptFile);


    /* TIP #280 Force the evaluator to open a frame for a sourced

     * file. */
    iPtr->evalFlags |= TCL_EVAL_FILE;
    result = Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_DIRECT);

    /*
     * Now we have to be careful; the script may have changed the
     * iPtr->scriptFile value, so we must reset it without assuming it still
     * points to 'pathPtr'.

 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetErrno(void)
{





    return errno;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetErrno --

 *----------------------------------------------------------------------
 */

void
Tcl_SetErrno(
    int err)			/* The new value. */
{





    errno = err;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_PosixError --

 */

int
Tcl_FSStat(
    Tcl_Obj *pathPtr,		/* Path of file to stat (in current CP). */
    Tcl_StatBuf *buf)		/* Filled with results of stat call. */
{
    const Tcl_Filesystem *fsPtr;

    fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
    if (fsPtr != NULL) {
	Tcl_FSStatProc *proc = fsPtr->statProc;
	if (proc != NULL) {
	    return (*proc)(pathPtr, buf);
	}
    }
    Tcl_SetErrno(ENOENT);
    return -1;
}

/*
 *----------------------------------------------------------------------

int
Tcl_FSLstat(
    Tcl_Obj *pathPtr,		/* Path of file to stat (in current CP). */
    Tcl_StatBuf *buf)		/* Filled with results of stat call. */
{
    const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);

    if (fsPtr != NULL) {
	Tcl_FSLstatProc *proc = fsPtr->lstatProc;
	if (proc != NULL) {
	    return (*proc)(pathPtr, buf);
	} else {
	    Tcl_FSStatProc *sproc = fsPtr->statProc;
	    if (sproc != NULL) {
		return (*sproc)(pathPtr, buf);
	    }


	}
    }
    Tcl_SetErrno(ENOENT);
    return -1;
}

/*

 */

int
Tcl_FSAccess(
    Tcl_Obj *pathPtr,		/* Path of file to access (in current CP). */
    int mode)			/* Permission setting. */
{
    const Tcl_Filesystem *fsPtr;

    fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
    if (fsPtr != NULL) {
	Tcl_FSAccessProc *proc = fsPtr->accessProc;
	if (proc != NULL) {
	    return (*proc)(pathPtr, mode);
	}
    }

    Tcl_SetErrno(ENOENT);
    return -1;
}

/*
 *----------------------------------------------------------------------
 *

				 * as "rw". */
    int permissions)		/* If the open involves creating a file, with
				 * what modes to create it? */
{
    const Tcl_Filesystem *fsPtr;
    Tcl_Channel retVal = NULL;


    /*
     * We need this just to ensure we return the correct error messages under
     * some circumstances.
     */

    if (Tcl_FSGetNormalizedPath(interp, pathPtr) == NULL) {
	return NULL;
    }

    fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
    if (fsPtr != NULL) {
	Tcl_FSOpenFileChannelProc *proc = fsPtr->openFileChannelProc;
	if (proc != NULL) {
	    int mode, seekFlag, binary;

	    /*
	     * Parse the mode, picking up whether we want to seek to start
	     * with and/or set the channel automatically into binary mode.
	     */

	    mode = TclGetOpenModeEx(interp, modeString, &seekFlag, &binary);
	    if (mode == -1) {
		return NULL;
	    }

	    /*
	     * Do the actual open() call.
	     */

	    retVal = (*proc)(interp, pathPtr, mode, permissions);

	    if (retVal == NULL) {
		return NULL;
	    }

	    /*
	     * Apply appropriate flags parsed out above.
	     */

	    if (seekFlag && Tcl_Seek(retVal, (Tcl_WideInt)0,
		    SEEK_END) < (Tcl_WideInt)0) {
		if (interp != NULL) {
		    Tcl_AppendResult(interp, "could not seek to end "
			    "of file while opening \"", Tcl_GetString(pathPtr),
			    "\": ", Tcl_PosixError(interp), NULL);
		}
		Tcl_Close(NULL, retVal);
		return NULL;
	    }
	    if (binary) {
		Tcl_SetChannelOption(interp, retVal, "-translation", "binary");
	    }
	    return retVal;
	}
    }

    /*
     * File doesn't belong to any filesystem that can open it.
     */

    Tcl_SetErrno(ENOENT);

int
Tcl_FSUtime(
    Tcl_Obj *pathPtr,		/* File to change access/modification times */
    struct utimbuf *tval)	/* Structure containing access/modification
				 * times to use. Should not be modified. */
{
    const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);

    if (fsPtr != NULL) {
	Tcl_FSUtimeProc *proc = fsPtr->utimeProc;
	if (proc != NULL) {
	    return (*proc)(pathPtr, tval);
	}
    }

    return -1;
}

/*
 *----------------------------------------------------------------------
 *
 * NativeFileAttrStrings --

const char **
Tcl_FSFileAttrStrings(
    Tcl_Obj *pathPtr,
    Tcl_Obj **objPtrRef)
{
    const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);

    if (fsPtr != NULL) {
	Tcl_FSFileAttrStringsProc *proc = fsPtr->fileAttrStringsProc;
	if (proc != NULL) {
	    return (*proc)(pathPtr, objPtrRef);
	}
    }
    Tcl_SetErrno(ENOENT);
    return NULL;
}

/*
 *----------------------------------------------------------------------

    Tcl_Interp *interp,		/* The interpreter for error reporting. */
    int index,			/* index of the attribute command. */
    Tcl_Obj *pathPtr,		/* filename we are operating on. */
    Tcl_Obj **objPtrRef)	/* for output. */
{
    const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);

    if (fsPtr != NULL) {
	Tcl_FSFileAttrsGetProc *proc = fsPtr->fileAttrsGetProc;
	if (proc != NULL) {
	    return (*proc)(interp, index, pathPtr, objPtrRef);
	}
    }
    Tcl_SetErrno(ENOENT);
    return -1;
}

/*
 *----------------------------------------------------------------------

    Tcl_Interp *interp,		/* The interpreter for error reporting. */
    int index,			/* index of the attribute command. */
    Tcl_Obj *pathPtr,		/* filename we are operating on. */
    Tcl_Obj *objPtr)		/* Input value. */
{
    const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);

    if (fsPtr != NULL) {
	Tcl_FSFileAttrsSetProc *proc = fsPtr->fileAttrsSetProc;
	if (proc != NULL) {
	    return (*proc)(interp, index, pathPtr, objPtr);
	}
    }
    Tcl_SetErrno(ENOENT);
    return -1;
}

/*
 *----------------------------------------------------------------------

	/*
	 * We've never been called before, try to find a cwd. Call each of the
	 * "Tcl_GetCwd" function in succession. A non-NULL return value
	 * indicates the particular function has succeeded.
	 */

	fsRecPtr = FsGetFirstFilesystem();
	while ((retVal == NULL) && (fsRecPtr != NULL)) {
	    Tcl_FSGetCwdProc *proc = fsRecPtr->fsPtr->getCwdProc;
	    if (proc != NULL) {
		if (fsRecPtr->fsPtr->version != TCL_FILESYSTEM_VERSION_1) {
		    ClientData retCd;
		    TclFSGetCwdProc2 *proc2 = (TclFSGetCwdProc2*)proc;










		    retCd = (*proc2)(NULL);
		    if (retCd != NULL) {
			Tcl_Obj *norm;

			/* Looks like a new current directory */
			retVal = (*fsRecPtr->fsPtr->internalToNormalizedProc)(
				retCd);
			Tcl_IncrRefCount(retVal);
			norm = TclFSNormalizeAbsolutePath(interp,retVal,NULL);
			if (norm != NULL) {
			    /*
			     * We found a cwd, which is now in our global
			     * storage. We must make a copy. Norm already has
			     * a refCount of 1.
			     *
			     * Threading issue: note that multiple threads at
			     * system startup could in principle call this
			     * function simultaneously. They will therefore
			     * each set the cwdPathPtr independently. That
			     * behaviour is a bit peculiar, but should be
			     * fine. Once we have a cwd, we'll always be in
			     * the 'else' branch below which is simpler.
			     */

			    FsUpdateCwd(norm, retCd);
			    Tcl_DecrRefCount(norm);
			} else {
			    (*fsRecPtr->fsPtr->freeInternalRepProc)(retCd);
			}
			Tcl_DecrRefCount(retVal);
			retVal = NULL;
			goto cdDidNotChange;
		    } else if (interp != NULL) {
			Tcl_AppendResult(interp,
				"error getting working directory name: ",
				Tcl_PosixError(interp), NULL);
		    }
		} else {
		    retVal = (*proc)(interp);
		}
	    }
	    fsRecPtr = fsRecPtr->nextPtr;
	}

	/*
	 * Now the 'cwd' may NOT be normalized, at least on some platforms.
	 * For the sake of efficiency, we want a completely normalized cwd at
	 * all times.
	 *
	 * Finally, if retVal is NULL, we do not have a cwd, which could be
	 * problematic.
	 */

	if (retVal != NULL) {
	    Tcl_Obj *norm = TclFSNormalizeAbsolutePath(interp, retVal, NULL);

	    if (norm != NULL) {
		/*
		 * We found a cwd, which is now in our global storage. We must
		 * make a copy. Norm already has a refCount of 1.
		 *
		 * Threading issue: note that multiple threads at system
		 * startup could in principle call this function
		 * simultaneously. They will therefore each set the cwdPathPtr
		 * independently. That behaviour is a bit peculiar, but should
		 * be fine. Once we have a cwd, we'll always be in the 'else'
		 * branch below which is simpler.
		 */

		ClientData cd = (ClientData) Tcl_FSGetNativePath(norm);

		FsUpdateCwd(norm, TclNativeDupInternalRep(cd));
		Tcl_DecrRefCount(norm);
	    }
	    Tcl_DecrRefCount(retVal);
	}
    } else {
	/*
	 * We already have a cwd cached, but we want to give the filesystem it
	 * is in a chance to check whether that cwd has changed, or is perhaps
	 * no longer accessible. This allows an error to be thrown if, say,
	 * the permissions on that directory have changed.
	 */

	const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(tsdPtr->cwdPathPtr);




	/*
	 * If the filesystem couldn't be found, or if no cwd function exists
	 * for this filesystem, then we simply assume the cached cwd is ok.
	 * If we do call a cwd, we must watch for errors (if the cwd returns
	 * NULL). This ensures that, say, on Unix if the permissions of the
	 * cwd change, 'pwd' does actually throw the correct error in Tcl.
	 * (This is tested for in the test suite on unix).
	 */




	if (fsPtr != NULL) {

	    Tcl_FSGetCwdProc *proc = fsPtr->getCwdProc;
	    ClientData retCd = NULL;


	    if (proc != NULL) {
		Tcl_Obj *retVal;
		if (fsPtr->version != TCL_FILESYSTEM_VERSION_1) {
		    TclFSGetCwdProc2 *proc2 = (TclFSGetCwdProc2*)proc;

		    retCd = (*proc2)(tsdPtr->cwdClientData);
		    if (retCd == NULL && interp != NULL) {
			Tcl_AppendResult(interp,
				"error getting working directory name: ",
				Tcl_PosixError(interp), NULL);
		    }

		    if (retCd == tsdPtr->cwdClientData) {
			goto cdDidNotChange;
		    }

		    /*
		     * Looks like a new current directory.
		     */

		    retVal = (*fsPtr->internalToNormalizedProc)(retCd);
		    Tcl_IncrRefCount(retVal);

		} else {
		    retVal = (*proc)(interp);




		}
		if (retVal != NULL) {








		    Tcl_Obj *norm = TclFSNormalizeAbsolutePath(interp,
			    retVal, NULL);

		    /*
		     * Check whether cwd has changed from the value previously
		     * stored in cwdPathPtr. Really 'norm' shouldn't be NULL,
		     * but we are careful.
		     */

		    if (norm == NULL) {
			/* Do nothing */
			if (retCd != NULL) {
			    (*fsPtr->freeInternalRepProc)(retCd);
			}
		    } else if (norm == tsdPtr->cwdPathPtr) {
			goto cdEqual;
		    } else {
			/*
			 * Note that both 'norm' and 'tsdPtr->cwdPathPtr' are
			 * normalized paths. Therefore we can be more
			 * efficient than calling 'Tcl_FSEqualPaths', and in
			 * addition avoid a nasty infinite loop bug when
			 * trying to normalize tsdPtr->cwdPathPtr.
			 */

			int len1, len2;
			char *str1, *str2;

			str1 = Tcl_GetStringFromObj(tsdPtr->cwdPathPtr, &len1);
			str2 = Tcl_GetStringFromObj(norm, &len2);
			if ((len1 == len2) && (strcmp(str1, str2) == 0)) {
			    /*
			     * If the paths were equal, we can be more
			     * efficient and retain the old path object which
			     * will probably already be shared. In this case
			     * we can simply free the normalized path we just
			     * calculated.
			     */

			cdEqual:
			    Tcl_DecrRefCount(norm);
			    if (retCd != NULL) {
				(*fsPtr->freeInternalRepProc)(retCd);
			    }
			} else {
			    FsUpdateCwd(norm, retCd);
			    Tcl_DecrRefCount(norm);
			}
		    }
		    Tcl_DecrRefCount(retVal);
		} else {
		    /*
		     * The 'cwd' function returned an error; reset the cwd.
		     */

		    FsUpdateCwd(NULL, NULL);
		}
	    }
	}
    }

  cdDidNotChange:
    if (tsdPtr->cwdPathPtr != NULL) {
	Tcl_IncrRefCount(tsdPtr->cwdPathPtr);
    }

    if (Tcl_FSGetNormalizedPath(NULL, pathPtr) == NULL) {
	Tcl_SetErrno(ENOENT);
	return retVal;
    }

    fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
    if (fsPtr != NULL) {
	Tcl_FSChdirProc *proc = fsPtr->chdirProc;
	if (proc != NULL) {
	    /*
	     * If this fails, an appropriate errno will have been stored using
	     * 'Tcl_SetErrno()'.
	     */

	    retVal = (*proc)(pathPtr);
	} else {
	    /*
	     * Fallback on stat-based implementation.
	     */

	    Tcl_StatBuf buf;

    /*
     * The cwd changed, or an error was thrown. If an error was thrown, we can
     * just continue (and that will report the error to the user). If there
     * was no error we must assume that the cwd was actually changed to the
     * normalized value we calculated above, and we must therefore cache that
     * information.
     */

    /*
     * If the filesystem in question has a getCwdProc, then the correct logic
     * which performs the part below is already part of the Tcl_FSGetCwd()
     * call, so no need to replicate it again. This will have a side effect
     * though. The private authoritative representation of the current working
     * directory stored in cwdPathPtr in static memory will be out-of-sync
     * with the real OS-maintained value. The first call to Tcl_FSGetCwd will
     * however recalculate the private copy to match the OS-value so

	    ClientData cd;
	    ClientData oldcd = tsdPtr->cwdClientData;

	    /*
	     * Assumption we are using a filesystem version 2.
	     */

	    TclFSGetCwdProc2 *proc2 = (TclFSGetCwdProc2*)fsPtr->getCwdProc;

	    cd = (*proc2)(oldcd);
	    if (cd != oldcd) {
		FsUpdateCwd(normDirName, cd);
	    }
	} else {
	    FsUpdateCwd(normDirName, NULL);
	}
    }

     * throw away the loadHandle and only use the clientData. It just so
     * happens, for the native filesystem only, that these two are identical.
     *
     * This also means that the signatures Tcl_FSUnloadFileProc and
     * Tcl_FSLoadFileProc are both misleading.
     */

    *handlePtr = (Tcl_LoadHandle) clientData;
    return res;
}

/*
 *----------------------------------------------------------------------
 *
 * TclLoadFile --

				 * (*unloadProcPtr)() to unload the file. */
    Tcl_FSUnloadFileProc **unloadProcPtr)
				/* Filled with address of Tcl_FSUnloadFileProc
				 * function which should be used for this
				 * file. */
{
    const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
    Tcl_FSLoadFileProc *proc;
    Tcl_Filesystem *copyFsPtr;
    Tcl_Obj *copyToPtr;
    Tcl_LoadHandle newLoadHandle = NULL;
    ClientData newClientData = NULL;
    Tcl_FSUnloadFileProc *newUnloadProcPtr = NULL;
    FsDivertLoad *tvdlPtr;
    int retVal;

    if (fsPtr == NULL) {
	Tcl_SetErrno(ENOENT);
	return TCL_ERROR;
    }

    proc = fsPtr->loadFileProc;

    if (proc != NULL) {
	int retVal = (*proc)(interp, pathPtr, handlePtr, unloadProcPtr);
	if (retVal == TCL_OK) {
	    if (*handlePtr == NULL) {
		return TCL_ERROR;
	    }

	    /*
	     * Copy this across, since both are equal for the native fs.
	     */

	    *clientDataPtr = (ClientData)*handlePtr;
	    Tcl_ResetResult(interp);
	    goto resolveSymbols;
	}
	if (Tcl_GetErrno() != EXDEV) {
	    return retVal;
	}
    }

	    goto mustCopyToTempAnyway;
	}
	ret = Tcl_Read(data, buffer, size);
	Tcl_Close(interp, data);
	ret = TclpLoadMemory(interp, buffer, size, ret, handlePtr,
		unloadProcPtr);
	if (ret == TCL_OK && *handlePtr != NULL) {
	    *clientDataPtr = (ClientData) *handlePtr;
	    goto resolveSymbols;
	}
    }

  mustCopyToTempAnyway:
    Tcl_ResetResult(interp);
#endif

	/*
	 * We tell our caller about the real shared library which was loaded.
	 * Note that this does mean that the package list maintained by 'load'
	 * will store the original (vfs) path alongside the temporary load
	 * handle and unload proc ptr.
	 */

	(*handlePtr) = newLoadHandle;
	(*clientDataPtr) = newClientData;
	(*unloadProcPtr) = newUnloadProcPtr;
	Tcl_ResetResult(interp);
	return TCL_OK;
    }

    /*
     * When we unload this file, we need to divert the unloading so we can
     * unload and cleanup the temporary file correctly.

	tvdlPtr->divertedFile = NULL;
	tvdlPtr->divertedFilesystem = NULL;
	Tcl_DecrRefCount(copyToPtr);
    }

    copyToPtr = NULL;
    (*handlePtr) = newLoadHandle;
    (*clientDataPtr) = (ClientData) tvdlPtr;
    (*unloadProcPtr) = &FSUnloadTempFile;

    Tcl_ResetResult(interp);
    return retVal;

  resolveSymbols:
    {
	int i;

 */

int
TclpLoadFile(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Obj *pathPtr,		/* Name of the file containing the desired
				 * code (UTF-8). */
    const char *sym1, CONST char *sym2,
				/* Names of two functions to look up in the
				 * file's symbol table. */
    Tcl_PackageInitProc **proc1Ptr, Tcl_PackageInitProc **proc2Ptr,
				/* Where to return the addresses corresponding
				 * to sym1 and sym2. */
    ClientData *clientDataPtr,	/* Filled with token for dynamically loaded
				 * file which will be passed back to

	return res;
    }

    if (handle == NULL) {
	return TCL_ERROR;
    }

    *clientDataPtr = (ClientData) handle;

    *proc1Ptr = TclpFindSymbol(interp, handle, sym1);
    *proc2Ptr = TclpFindSymbol(interp, handle, sym2);
    return TCL_OK;
}

/*

	 * It was the native filesystem, and we have a special function
	 * available just for this purpose, which we know works even at this
	 * late stage.
	 */

	TclpDeleteFile(tvdlPtr->divertedFileNativeRep);
	NativeFreeInternalRep(tvdlPtr->divertedFileNativeRep);

    } else {
	/*
	 * Remove the temporary file we created. Note, we may crash here
	 * because encodings have been taken down already.
	 */

	if (tvdlPtr->divertedFilesystem->deleteFileProc(tvdlPtr->divertedFile)

	 * refCount from the Tcl_Filesystem to which this file belongs, which
	 * could then free up the filesystem if we are exiting.
	 */

	Tcl_DecrRefCount(tvdlPtr->divertedFile);
    }

    ckfree((char*)tvdlPtr);
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSLink --
 *

Tcl_FSLink(
    Tcl_Obj *pathPtr,		/* Path of file to readlink or link */
    Tcl_Obj *toPtr,		/* NULL or path to be linked to */
    int linkAction)		/* Action to perform */
{
    const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);

    if (fsPtr != NULL) {
	Tcl_FSLinkProc *proc = fsPtr->linkProc;

	if (proc != NULL) {
	    return (*proc)(pathPtr, toPtr, linkAction);
	}
    }

    /*
     * If S_IFLNK isn't defined it means that the machine doesn't support
     * symbolic links, so the file can't possibly be a symbolic link. Generate
     * an EINVAL error, which is what happens on machines that do support
     * symbolic links when you invoke readlink on a file that isn't a symbolic
     * link.
     */

#ifndef S_IFLNK
    errno = EINVAL;
#else
    Tcl_SetErrno(ENOENT);
#endif /* S_IFLNK */
    return NULL;
}

/*

 *
 * Side effects:
 *	None
 *
 *---------------------------------------------------------------------------
 */

Tcl_Obj*
Tcl_FSListVolumes(void)
{
    FilesystemRecord *fsRecPtr;
    Tcl_Obj *resultPtr = Tcl_NewObj();

    /*
     * Call each of the "listVolumes" function in succession. A non-NULL
     * return value indicates the particular function has succeeded. We call
     * all the functions registered, since we want a list of all drives from
     * all filesystems.
     */

    fsRecPtr = FsGetFirstFilesystem();
    while (fsRecPtr != NULL) {
	Tcl_FSListVolumesProc *proc = fsRecPtr->fsPtr->listVolumesProc;
	if (proc != NULL) {
	    Tcl_Obj *thisFsVolumes = (*proc)();

	    if (thisFsVolumes != NULL) {
		Tcl_ListObjAppendList(NULL, resultPtr, thisFsVolumes);
		Tcl_DecrRefCount(thisFsVolumes);
	    }
	}
	fsRecPtr = fsRecPtr->nextPtr;
    }

     * specific type information 'mountsOnly'. A non-NULL return value
     * indicates the particular function has succeeded. We call all the
     * functions registered, since we want a list from each filesystems.
     */

    fsRecPtr = FsGetFirstFilesystem();
    while (fsRecPtr != NULL) {
	if (fsRecPtr->fsPtr != &tclNativeFilesystem) {
	    Tcl_FSMatchInDirectoryProc *proc =
		    fsRecPtr->fsPtr->matchInDirectoryProc;
	    if (proc != NULL) {
		if (resultPtr == NULL) {
		    resultPtr = Tcl_NewObj();
		}

		(*proc)(NULL, resultPtr, pathPtr, pattern, &mountsOnly);
	    }
	}
	fsRecPtr = fsRecPtr->nextPtr;
    }

    return resultPtr;
}


    /*
     * We assume separators are single characters.
     */

    if (fsPtr->filesystemSeparatorProc != NULL) {
	Tcl_Obj *sep = (*fsPtr->filesystemSeparatorProc)(pathPtr);

	if (sep != NULL) {
	    Tcl_IncrRefCount(sep);
	    separator = Tcl_GetString(sep)[0];
	    Tcl_DecrRefCount(sep);
	}
    }

    /*
     * Add the remaining path elements to the list.
     */

    for (;;) {
	char *elementStart = p;
	int length;

	while ((*p != '\0') && (*p != separator)) {
	    p++;
	}
	length = p - elementStart;
	if (length > 0) {
	    Tcl_Obj *nextElt;

	    if (elementStart[0] == '~') {
		TclNewLiteralStringObj(nextElt, "./");
		Tcl_AppendToObj(nextElt, elementStart, length);
	    } else {
		nextElt = Tcl_NewStringObj(elementStart, length);
	    }
	    Tcl_ListObjAppendElement(NULL, result, nextElt);

	if (fsRecPtr->fsPtr == fromFilesystem) {
	    *fsRecPtrPtr = fsRecPtr;
	    break;
	}
	fsRecPtr = fsRecPtr->nextPtr;
    }

    if ((fsRecPtr != NULL)
	    && (fromFilesystem->internalToNormalizedProc != NULL)) {
	return (*fromFilesystem->internalToNormalizedProc)(clientData);
    } else {
	return NULL;
    }

}

/*
 *----------------------------------------------------------------------
 *
 * TclGetPathType --
 *

    Tcl_Obj **driveNameRef)	/* If the path is absolute, and this is
				 * non-NULL, then set to the name of the
				 * drive, network-volume which contains the
				 * path, already with a refCount for the
				 * caller. */
{
    int pathLen;
    char *path;
    Tcl_PathType type;

    path = Tcl_GetStringFromObj(pathPtr, &pathLen);

    type = TclFSNonnativePathType(path, pathLen, filesystemPtrPtr,
	    driveNameLengthPtr, driveNameRef);

    if (type != TCL_PATH_ABSOLUTE) {
	type = TclpGetNativePathType(pathPtr, driveNameLengthPtr,
		driveNameRef);
	if ((type == TCL_PATH_ABSOLUTE) && (filesystemPtrPtr != NULL)) {

     * Call each of the "listVolumes" function in succession, checking whether
     * the given path is an absolute path on any of the volumes returned (this
     * is done by checking whether the path's prefix matches).
     */

    fsRecPtr = FsGetFirstFilesystem();
    while (fsRecPtr != NULL) {
	Tcl_FSListVolumesProc *proc = fsRecPtr->fsPtr->listVolumesProc;

	/*
	 * We want to skip the native filesystem in this loop because
	 * otherwise we won't necessarily pass all the Tcl testsuite -- this
	 * is because some of the tests artificially change the current
	 * platform (between win, unix) but the list of volumes we get by
	 * calling (*proc) will reflect the current (real) platform only and
	 * this may cause some tests to fail. In particular, on unix '/' will

	 * match the beginning of certain absolute Windows paths starting '//'
	 * and those tests will go wrong.
	 *
	 * Besides these test-suite issues, there is one other reason to skip
	 * the native filesystem --- since the tclFilename.c code has nice
	 * fast 'absolute path' checkers, we don't want to waste time
	 * repeating that effort here, and this function is actually called
	 * quite often, so if we can save the overhead of the native
	 * filesystem returning us a list of volumes all the time, it is
	 * better.
	 */

	if ((fsRecPtr->fsPtr != &tclNativeFilesystem) && (proc != NULL)) {

	    int numVolumes;
	    Tcl_Obj *thisFsVolumes = (*proc)();

	    if (thisFsVolumes != NULL) {
		if (Tcl_ListObjLength(NULL, thisFsVolumes, &numVolumes)
			!= TCL_OK) {
		    /*
		     * This is VERY bad; the Tcl_FSListVolumesProc didn't
		     * return a valid list. Set numVolumes to -1 so that we
		     * skip the while loop below and just return with the
		     * current value of 'type'.
		     *
		     * It would be better if we could signal an error here
		     * (but Tcl_Panic seems a bit excessive).
		     */

		    numVolumes = -1;
		}

		    }
		}
		Tcl_DecrRefCount(thisFsVolumes);
		if (type == TCL_PATH_ABSOLUTE) {
		    /*
		     * We don't need to examine any more filesystems.
		     */

		    break;
		}
	    }
	}
	fsRecPtr = fsRecPtr->nextPtr;
    }
    return type;

 *	A file may be renamed.
 *
 *---------------------------------------------------------------------------
 */

int
Tcl_FSRenameFile(
    Tcl_Obj* srcPathPtr,	/* Pathname of file or dir to be renamed
				 * (UTF-8). */
    Tcl_Obj *destPathPtr)	/* New pathname of file or directory
				 * (UTF-8). */
{
    int retVal = -1;
    const Tcl_Filesystem *fsPtr, *fsPtr2;

    fsPtr = Tcl_FSGetFileSystemForPath(srcPathPtr);
    fsPtr2 = Tcl_FSGetFileSystemForPath(destPathPtr);

    if ((fsPtr == fsPtr2) && (fsPtr != NULL)) {
	Tcl_FSRenameFileProc *proc = fsPtr->renameFileProc;
	if (proc != NULL) {
	    retVal = (*proc)(srcPathPtr, destPathPtr);
	}
    }
    if (retVal == -1) {
	Tcl_SetErrno(EXDEV);
    }
    return retVal;
}


int
Tcl_FSCopyFile(
    Tcl_Obj *srcPathPtr,	/* Pathname of file to be copied (UTF-8). */
    Tcl_Obj *destPathPtr)	/* Pathname of file to copy to (UTF-8). */
{
    int retVal = -1;
    const Tcl_Filesystem *fsPtr, *fsPtr2;

    fsPtr = Tcl_FSGetFileSystemForPath(srcPathPtr);
    fsPtr2 = Tcl_FSGetFileSystemForPath(destPathPtr);

    if (fsPtr == fsPtr2 && fsPtr != NULL) {
	Tcl_FSCopyFileProc *proc = fsPtr->copyFileProc;
	if (proc != NULL) {
	    retVal = (*proc)(srcPathPtr, destPathPtr);
	}
    }
    if (retVal == -1) {
	Tcl_SetErrno(EXDEV);
    }
    return retVal;
}


 *	Standard Tcl error code.
 *
 * Side effects:
 *	A file may be created.
 *
 *---------------------------------------------------------------------------
 */

int
TclCrossFilesystemCopy(
    Tcl_Interp *interp,		/* For error messages */
    Tcl_Obj *source,		/* Pathname of file to be copied (UTF-8). */
    Tcl_Obj *target)		/* Pathname of file to copy to (UTF-8). */
{
    int result = TCL_ERROR;

 */

int
Tcl_FSDeleteFile(
    Tcl_Obj *pathPtr)		/* Pathname of file to be removed (UTF-8). */
{
    const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);

    if (fsPtr != NULL) {
	Tcl_FSDeleteFileProc *proc = fsPtr->deleteFileProc;
	if (proc != NULL) {
	    return (*proc)(pathPtr);
	}
    }
    Tcl_SetErrno(ENOENT);
    return -1;
}

/*
 *---------------------------------------------------------------------------

 */

int
Tcl_FSCreateDirectory(
    Tcl_Obj *pathPtr)		/* Pathname of directory to create (UTF-8). */
{
    const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);

    if (fsPtr != NULL) {
	Tcl_FSCreateDirectoryProc *proc = fsPtr->createDirectoryProc;
	if (proc != NULL) {
	    return (*proc)(pathPtr);
	}
    }
    Tcl_SetErrno(ENOENT);
    return -1;
}

/*
 *---------------------------------------------------------------------------

 *	A directory may be copied.
 *
 *---------------------------------------------------------------------------
 */

int
Tcl_FSCopyDirectory(
    Tcl_Obj* srcPathPtr,	/* Pathname of directory to be copied
				 * (UTF-8). */
    Tcl_Obj *destPathPtr,	/* Pathname of target directory (UTF-8). */
    Tcl_Obj **errorPtr)		/* If non-NULL, then will be set to a new
				 * object containing name of file causing
				 * error, with refCount 1. */
{
    int retVal = -1;
    const Tcl_Filesystem *fsPtr, *fsPtr2;

    fsPtr = Tcl_FSGetFileSystemForPath(srcPathPtr);
    fsPtr2 = Tcl_FSGetFileSystemForPath(destPathPtr);

    if (fsPtr == fsPtr2 && fsPtr != NULL) {
	Tcl_FSCopyDirectoryProc *proc = fsPtr->copyDirectoryProc;
	if (proc != NULL) {
	    retVal = (*proc)(srcPathPtr, destPathPtr, errorPtr);
	}
    }
    if (retVal == -1) {
	Tcl_SetErrno(EXDEV);
    }
    return retVal;
}


				 * nonempty. Otherwise, will only remove empty
				 * directories. */
    Tcl_Obj **errorPtr)		/* If non-NULL, then will be set to a new
				 * object containing name of file causing
				 * error, with refCount 1. */
{
    const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);

    if (fsPtr != NULL && fsPtr->removeDirectoryProc != NULL) {
	Tcl_FSRemoveDirectoryProc *proc = fsPtr->removeDirectoryProc;
	if (recursive) {
	    /*
	     * We check whether the cwd lies inside this directory and move it
	     * if it does.
	     */

	    Tcl_Obj *cwdPtr = Tcl_FSGetCwd(NULL);

			Tcl_FSChdir(dirPtr);
			Tcl_DecrRefCount(dirPtr);
		    }
		}
		Tcl_DecrRefCount(cwdPtr);
	    }
	}
	return (*proc)(pathPtr, recursive, errorPtr);
    }
    Tcl_SetErrno(ENOENT);
    return -1;
}

/*
 *---------------------------------------------------------------------------

 *	The object may be converted to a path type.
 *
 *---------------------------------------------------------------------------
 */

Tcl_Filesystem *
Tcl_FSGetFileSystemForPath(
    Tcl_Obj* pathPtr)
{
    FilesystemRecord *fsRecPtr;
    Tcl_Filesystem* retVal = NULL;

    if (pathPtr == NULL) {
	Tcl_Panic("Tcl_FSGetFileSystemForPath called with NULL object");
	return NULL;
    }

    /*

     * Check if the filesystem has changed in some way since this object's
     * internal representation was calculated. Before doing that, assure we
     * have the most up-to-date copy of the master filesystem. This is
     * accomplished by the FsGetFirstFilesystem() call.
     */

    fsRecPtr = FsGetFirstFilesystem();

    if (TclFSEnsureEpochOk(pathPtr, &retVal) != TCL_OK) {
	return NULL;



    }

    /*
     * Call each of the "pathInFilesystem" functions in succession. A
     * non-return value of -1 indicates the particular function has succeeded.
     */


    while ((retVal == NULL) && (fsRecPtr != NULL)) {
	Tcl_FSPathInFilesystemProc *proc =
		fsRecPtr->fsPtr->pathInFilesystemProc;


	if (proc != NULL) {
	    ClientData clientData = NULL;
	    if ((*proc)(pathPtr, &clientData) != -1) {
		/*
		 * We assume the type of pathPtr hasn't been changed by the
		 * above call to the pathInFilesystemProc.
		 */

		TclFSSetPathDetails(pathPtr, fsRecPtr, clientData);
		retVal = fsRecPtr->fsPtr;
	    }
	}
	fsRecPtr = fsRecPtr->nextPtr;
    }

    return retVal;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSGetNativePath --
 *

 */

Tcl_Obj *
Tcl_FSFileSystemInfo(
    Tcl_Obj *pathPtr)
{
    Tcl_Obj *resPtr;
    Tcl_FSFilesystemPathTypeProc *proc;
    const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);

    if (fsPtr == NULL) {
	return NULL;
    }

    resPtr = Tcl_NewListObj(0, NULL);
    Tcl_ListObjAppendElement(NULL,resPtr,Tcl_NewStringObj(fsPtr->typeName,-1));


    proc = fsPtr->filesystemPathTypeProc;
    if (proc != NULL) {
	Tcl_Obj *typePtr = (*proc)(pathPtr);

	if (typePtr != NULL) {
	    Tcl_ListObjAppendElement(NULL, resPtr, typePtr);
	}
    }

    return resPtr;
}