* 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.55 2010/04/02 23:48:14 dgp Exp $
 */

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

static void		FsAddMountsToGlobResult(Tcl_Obj *resultPtr,
			    Tcl_Obj *pathPtr, const char *pattern,
			    Tcl_GlobTypeData *types);
static void		FsUpdateCwd(Tcl_Obj *cwdObj, ClientData clientData);
#ifdef TCL_THREADS
static void		FsRecacheFilesystemList(void);
#endif
static void*		DivertFindSymbol(Tcl_Interp* interp,
					 Tcl_LoadHandle loadHandle,
					 const char* symbol);
static void		DivertUnloadFile(Tcl_LoadHandle loadHandle);

/*
 * These form part of the native filesystem support. They are needed here
 * because we have a few native filesystem functions (which are the same for
 * win/unix) in this file. There is no need to place them in tclInt.h, because
 * they are not (and should not be) used anywhere else.
 */

				 * file which will be passed back to
				 * (*unloadProcPtr)() to unload the file. */
    Tcl_FSUnloadFileProc **unloadProcPtr)
				/* Filled with address of Tcl_FSUnloadFileProc
				 * function which should be used for this
				 * file. */
{
    const char *symbols[3];
    void *procPtrs[2];

    int res;

    /*
     * Initialize the arrays.
     */

    symbols[0] = sym1;
    symbols[1] = sym2;
    symbols[2] = NULL;


    /*
     * Perform the load.
     */

    res = Tcl_LoadFile(interp, pathPtr, symbols, 0, procPtrs, handlePtr);
    if (res == TCL_OK) {
	*proc1Ptr = (Tcl_PackageInitProc*) procPtrs[0];
	*proc2Ptr = (Tcl_PackageInitProc*) procPtrs[1];
    } else {
	*proc1Ptr = *proc2Ptr = NULL;
    }












    return res;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_LoadFile --
 *
 *	Dynamically loads a binary code file into memory and returns the
 *	addresses of a number of given functions within that file, if they are
 *	defined. The appropriate function for the filesystem to which pathPtr
 *	belongs will be called.
 *
 *	Note that the native filesystem doesn't actually assume 'pathPtr' is a
 *	path. Rather it assumes pathPtr is either a path or just the name
 *	(tail) of a file which can be found somewhere in the environment's
 *	loadable path. This behaviour is not very compatible with virtual
 *	filesystems (and has other problems documented in the load man-page),
 *	so it is advised that full paths are always used.
 *






 * Results:
 *	A standard Tcl completion code. If an error occurs, an error message
 *	is left in the interp's result.
 *
 * Side effects:
 *	New code suddenly appears in memory. This may later be unloaded by
 *	calling TclFS_UnloadFile.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_LoadFile(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Obj *pathPtr,		/* Name of the file containing the desired
				 * code. */


    const char *const symbols[],	/* Names of functions to look up in the file's
				 * symbol table. */

    int flags,			/* Flags (unused) */
    void *procVPtrs,		/* Where to return the addresses corresponding
				 * to symbols[]. */
    Tcl_LoadHandle *handlePtr)	/* Filled with token for shared library
				 * information which can be used in
				 * TclpFindSymbol. */







{
    void** procPtrs = (void**) procVPtrs;
    const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
    const Tcl_Filesystem *copyFsPtr;
    Tcl_FSUnloadFileProc* unloadProcPtr;
    Tcl_Obj *copyToPtr;
    Tcl_LoadHandle newLoadHandle = NULL;
    Tcl_LoadHandle divertedLoadHandle = NULL;
    Tcl_FSUnloadFileProc *newUnloadProcPtr = NULL;
    FsDivertLoad *tvdlPtr;
    int retVal;
    int i;

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

    if (fsPtr->loadFileProc != NULL) {
	int retVal = fsPtr->loadFileProc(interp, pathPtr, handlePtr,
		&unloadProcPtr);

	if (retVal == TCL_OK) {
	    if (*handlePtr == NULL) {
		return TCL_ERROR;
	    }






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

	if (!buffer) {
	    Tcl_Close(interp, data);
	    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) {

	    goto resolveSymbols;
	}
    }

  mustCopyToTempAnyway:
    Tcl_ResetResult(interp);
#endif

    /*
     * Get a temporary filename to use, first to copy the file into, and then
     * to load.
     */

    copyToPtr = TclpTempFileNameForLibrary(interp, pathPtr);





    Tcl_IncrRefCount(copyToPtr);

    copyFsPtr = Tcl_FSGetFileSystemForPath(copyToPtr);
    if ((copyFsPtr == NULL) || (copyFsPtr == fsPtr)) {
	/*
	 * We already know we can't use Tcl_FSLoadFile from this filesystem,
	 * and we must avoid a possible infinite loop. Try to delete the file

    /*
     * We need to reset the result now, because the cross-filesystem copy may
     * have stored the number of bytes in the result.
     */

    Tcl_ResetResult(interp);

    retVal = Tcl_LoadFile(interp, copyToPtr, symbols, 0, procPtrs,
			 &newLoadHandle);
    if (retVal != TCL_OK) {
	/*
	 * The file didn't load successfully.
	 */

	Tcl_FSDeleteFile(copyToPtr);
	Tcl_DecrRefCount(copyToPtr);

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


	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;

    
    divertedLoadHandle = (Tcl_LoadHandle)
	ckalloc(sizeof (struct Tcl_LoadHandle_));
    divertedLoadHandle->clientData = (ClientData) tvdlPtr;
    divertedLoadHandle->findSymbolProcPtr = DivertFindSymbol;
    divertedLoadHandle->unloadFileProcPtr = DivertUnloadFile;
    *handlePtr = divertedLoadHandle;

    Tcl_ResetResult(interp);
    return retVal;

  resolveSymbols:

    /* 
     * At this point, *handlePtr is already set up to the handle for the
     * loaded library. We now try to resolve the symbols.
     */
    if (symbols != NULL) {
	for (i=0 ; symbols[i] != NULL; i++) {
	    procPtrs[i] = Tcl_FindSymbol(interp, *handlePtr, symbols[i]);
	    if (procPtrs[i] == NULL) {
		/* 
		 * At least one symbol in the list was not found.
		 * Unload the file, and report the problem back to the 
		 * caller. (Tcl_FindSymbol should already have left an
		 * appropriate error message.)
		 */	
		(*handlePtr)->unloadFileProcPtr(*handlePtr);
		*handlePtr = NULL;
		return TCL_ERROR;
	    }
	}
    }
    return TCL_OK;
}

/*
 *-----------------------------------------------------------------------------
 *
 * DivertFindSymbol --
 *	
 *	Find a symbol in a shared library loaded by copy-from-VFS.
 *
 *-----------------------------------------------------------------------------
 */

static void*
DivertFindSymbol(Tcl_Interp* interp, 	    /* Tcl interpreter */
		 Tcl_LoadHandle loadHandle, /* Handle to the diverted module */
		 const char* symbol)	    /* Symbol to resolve */
{
    FsDivertLoad* tvdlPtr = (FsDivertLoad*) (loadHandle->clientData);
    Tcl_LoadHandle originalHandle = tvdlPtr->loadHandle;
    return originalHandle->findSymbolProcPtr(interp, originalHandle, symbol);
}

/*
 *-----------------------------------------------------------------------------
 *
 * DivertUnloadFile --
 *
 *	Unloads a file that has been loaded by copying from VFS to the
 *	native filesystem.
 *
 * Parameters:
 *	loadHandle -- Handle of the file to unload
 *
 *-----------------------------------------------------------------------------
 */

static void
DivertUnloadFile(Tcl_LoadHandle loadHandle)
{
    FsDivertLoad* tvdlPtr = (FsDivertLoad*) (loadHandle->clientData);
    Tcl_LoadHandle originalHandle = tvdlPtr->loadHandle;

    /*
     * This test should never trigger, since we give the client data in the
     * function above.
     */

    if (tvdlPtr == NULL) {
	return;
    }

    /*
     * Call the real 'unloadfile' proc we actually used. It is very important
     * that we call this first, so that the shared library is actually
     * unloaded by the OS. Otherwise, the following 'delete' may well fail
     * because the shared library is still in use.
     */

    originalHandle->unloadFileProcPtr(originalHandle);

    /* What filesystem contains the temp copy of the library? */

    if (tvdlPtr->divertedFilesystem == NULL) {
	/*
	 * 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)
		!= TCL_OK) {
	    /*
	     * The above may have failed because the filesystem, or something
	     * it depends upon (e.g. encodings) have been taken down because
	     * Tcl is exiting.
	     *
	     * We may need to work out how to delete this file more robustly
	     * (or give the filesystem the information it needs to delete the
	     * file more robustly).
	     *
	     * In particular, one problem might be that the filesystem cannot
	     * extract the information it needs from the above path object
	     * because Tcl's entire filesystem apparatus (the code in this
	     * file) has been finalized, and it refuses to pass the internal
	     * representation to the filesystem.
	     */
	}

	/*
	 * And free up the allocations. This will also of course remove a
	 * 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((void*)tvdlPtr);
    ckfree((void*)loadHandle);
}

/*
 * This function used to be in the platform specific directories, but it has
 * now been made to work cross-platform.
 */

int

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

    *clientDataPtr = handle;

    *proc1Ptr = Tcl_FindSymbol(interp, handle, sym1);
    *proc2Ptr = Tcl_FindSymbol(interp, handle, sym2);
    return TCL_OK;
}

/*
 *-----------------------------------------------------------------------------
 *
 * Tcl_FindSymbol --
 *
 *	Find a symbol in a loaded library
 *
 * Results:
 *	Returns a pointer to the symbol if found. If not found, returns
 *	NULL and leaves an error message in the interpreter result.
 *
 * This function was once filesystem-specific, but has been made portable
 * by having TclpDlopen return a structure that includes procedure pointers.
 *
 *-----------------------------------------------------------------------------
 */

void*
Tcl_FindSymbol(Tcl_Interp* interp,	  /* Tcl interpreter */
	       Tcl_LoadHandle loadHandle, /* Handle to the loaded library */
	       const char* symbol)        /* Name of the symbol to resolve */
{
    return (*(loadHandle->findSymbolProcPtr))(interp, loadHandle, symbol);
}

/*
 *-----------------------------------------------------------------------------
 *
 * Tcl_FSUnloadFile --
 *
 *	Unloads a library given its handle. Checks first that the library
 *	supports unloading.
 *
 *-----------------------------------------------------------------------------
 */

int
Tcl_FSUnloadFile(Tcl_Interp* interp, /* Tcl interpreter */
		 Tcl_LoadHandle handle) /* Handle of the file to unload */
{
    if (handle->unloadFileProcPtr == NULL) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp,
			     Tcl_NewStringObj("cannot unload: filesystem "
					      "does not support unloading",
					      -1));
	}
	return TCL_ERROR;
    } else {
	TclpUnloadFile(handle);
    return TCL_OK;
    }
}

/*
 *-----------------------------------------------------------------------------
 *
 * TclpUnloadFile --
 *
 *	Unloads a library given its handle
 *
 * This function was once filesystem-specific, but has been made portable
 * by having TclpDlopen return a structure that includes procedure pointers.
 *
 *-----------------------------------------------------------------------------
 */

void
TclpUnloadFile(Tcl_LoadHandle handle)
{
    if (handle->unloadFileProcPtr != NULL) {
	(*(handle->unloadFileProcPtr))(handle);
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * TclFSUnloadTempFile --
 *