*
 * Copyright (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * 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.15 2005/01/24 21:44:38 dgp Exp $
 * RCS: @(#) $Id: tclIOUtil.c,v 1.81.2.16 2005/04/29 22:40:25 dgp Exp $
 */

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

}

/*
 *---------------------------------------------------------------------------
 *
 * TclGetOpenMode --
 *
 * Description:
 * 	This routine is an obsolete, limited version of
 * 	TclGetOpenModeEx() below.  It exists only to satisfy any
 * 	extensions imprudently using it via Tcl's internal stubs table.
 *
 * Results:
 * 	Same as TclGetOpenModeEx().
 *
 * Side effects:
 * 	Same as TclGetOpenModeEx().
 *
 *---------------------------------------------------------------------------
 */

int
TclGetOpenMode(interp, modeString, seekFlagPtr)
    Tcl_Interp *interp;			/* Interpreter to use for error
					 * reporting - may be NULL. */
    CONST char *modeString;		/* Mode string, e.g. "r+" or
					 * "RDONLY CREAT". */
    int *seekFlagPtr;			/* Set this to 1 if the caller
                                         * should seek to EOF during the
                                         * opening of the file. */
{
    int binary = 0;
    return TclGetOpenModeEx(interp, modeString, seekFlagPtr, &binary);
}

/*
 *---------------------------------------------------------------------------
 *
 * TclGetOpenModeEx --
 *
 * Description:
 *	Computes a POSIX mode mask for opening a file, from a given string,
 *	and also sets a flag to indicate whether the caller should seek to
 *	EOF after opening the file.
 *	and also sets flags to indicate whether the caller should seek to
 *	EOF after opening the file, and whether the caller should
 *	configure the channel for binary data.
 *
 * Results:
 *	On success, returns mode to pass to "open". If an error occurs, the
 *	return value is -1 and if interp is not NULL, sets interp's result
 *	object to an error message.
 *
 * Side effects:
 *	Sets the integer referenced by seekFlagPtr to 1 to tell the caller
 *	to seek to EOF after opening the file.
 *	to seek to EOF after opening the file, or to 0 otherwise.  Sets the
 *	integer referenced by binaryPtr to 1 to tell the caller	to seek to
 *	configure the channel for binary data, or to 0 otherwise.
 *
 * Special note:
 *	This code is based on a prototype implementation contributed
 *	by Mark Diekhans.
 *
 *---------------------------------------------------------------------------
 */

int
TclGetOpenMode(interp, string, seekFlagPtr)
TclGetOpenModeEx(interp, modeString, seekFlagPtr, binaryPtr)
    Tcl_Interp *interp;			/* Interpreter to use for error
					 * reporting - may be NULL. */
    CONST char *string;			/* Mode string, e.g. "r+" or
    CONST char *modeString;		/* Mode string, e.g. "r+" or
					 * "RDONLY CREAT". */
    int *seekFlagPtr;			/* Set this to 1 if the caller
                                         * should seek to EOF during the
                                         * opening of the file. */
    int *binaryPtr;			/* Set this to 1 if the caller
					 * should configure the opened
					 * channel for binary operations */
{
    int mode, modeArgc, c, i, gotRW;
    CONST char **modeArgv, *flag;
#define RW_MODES (O_RDONLY|O_WRONLY|O_RDWR)

    /*
     * Check for the simpler fopen-like access modes (e.g. "r").  They
     * are distinguished from the POSIX access modes by the presence
     * of a lower-case first letter.
     */

    *seekFlagPtr = 0;
    *binaryPtr = 0;
    mode = 0;

    /*
     * Guard against international characters before using byte oriented
     * routines.
     */

    if (!(string[0] & 0x80)
	    && islower(UCHAR(string[0]))) { /* INTL: ISO only. */
	switch (string[0]) {
    if (!(modeString[0] & 0x80)
	    && islower(UCHAR(modeString[0]))) { /* INTL: ISO only. */
	switch (modeString[0]) {
	    case 'r':
		mode = O_RDONLY;
		break;
	    case 'w':
		mode = O_WRONLY|O_CREAT|O_TRUNC;
		break;
	    case 'a':
		mode = O_WRONLY|O_CREAT;
                *seekFlagPtr = 1;
		break;
	    default:
		error:
                *seekFlagPtr = 0;
		*binaryPtr = 0;
                if (interp != (Tcl_Interp *) NULL) {
                    Tcl_AppendResult(interp,
                            "illegal access mode \"", string, "\"",
                            "illegal access mode \"", modeString, "\"",
                            (char *) NULL);
                }
		return -1;
	}
	i=1;
	while (i<3 && modeString[i]) {
	    if (modeString[i] == modeString[i-1]) {
		goto error;
	    }
	    switch (modeString[i++]) {
	if (string[1] == '+') {
	    mode &= ~(O_RDONLY|O_WRONLY);
	    mode |= O_RDWR;
	    if (string[2] != 0) {
		goto error;
		case '+':
		    mode &= ~(O_RDONLY|O_WRONLY);
		    mode |= O_RDWR;
		    break;
		case 'b':
		    *binaryPtr = 1;
		    break;
		default:
		    goto error;
	    }
	}
	} else if (string[1] != 0) {
	if (modeString[i] != 0) {
	    goto error;
	}
        return mode;
    }

    /*
     * The access modes are specified using a list of POSIX modes
     * such as O_CREAT.
     *
     * IMPORTANT NOTE: We rely on Tcl_SplitList working correctly when
     * a NULL interpreter is passed in.
     */

    if (Tcl_SplitList(interp, string, &modeArgc, &modeArgv) != TCL_OK) {
    if (Tcl_SplitList(interp, modeString, &modeArgc, &modeArgv) != TCL_OK) {
        if (interp != (Tcl_Interp *) NULL) {
            Tcl_AddErrorInfo(interp,
                    "\n    while processing open access modes \"");
            Tcl_AddErrorInfo(interp, string);
            Tcl_AddErrorInfo(interp, modeString);
            Tcl_AddErrorInfo(interp, "\"");
        }
        return -1;
    }
    
    gotRW = 0;
    for (i = 0; i < modeArgc; i++) {

                        "\" not supported by this system", (char *) NULL);
            }
            ckfree((char *) modeArgv);
	    return -1;
#endif
	} else if ((c == 'T') && (strcmp(flag, "TRUNC") == 0)) {
	    mode |= O_TRUNC;
	} else if ((c == 'B') && (strcmp(flag, "BINARY") == 0)) {
	    *binaryPtr = 1;
	} else {
            if (interp != (Tcl_Interp *) NULL) {
                Tcl_AppendResult(interp, "invalid access mode \"", flag,
                        "\": must be RDONLY, WRONLY, RDWR, APPEND, CREAT",
                        " EXCL, NOCTTY, NONBLOCK, or TRUNC", (char *) NULL);
			"\": must be RDONLY, WRONLY, RDWR, APPEND, BINARY, "
			"CREAT, EXCL, NOCTTY, NONBLOCK, or TRUNC",
			(char *) NULL);
            }
	    ckfree((char *) modeArgv);
	    return -1;
	}
    }
    ckfree((char *) modeArgv);
    if (!gotRW) {

        return NULL;
    }
    
    fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
    if (fsPtr != NULL) {
	Tcl_FSOpenFileChannelProc *proc = fsPtr->openFileChannelProc;
	if (proc != NULL) {
	    int mode, seekFlag;
	    mode = TclGetOpenMode(interp, modeString, &seekFlag);
	    int mode, seekFlag, binary;
	    mode = TclGetOpenModeEx(interp, modeString, &seekFlag, &binary);
	    if (mode == -1) {
	        return NULL;
	    }
	    retVal = (*proc)(interp, pathPtr, mode, permissions);
	    if (retVal != NULL) {
		if (seekFlag) {
		    if (Tcl_Seek(retVal, (Tcl_WideInt)0, 
				 SEEK_END) < (Tcl_WideInt)0) {
			if (interp != (Tcl_Interp *) NULL) {
			    Tcl_AppendResult(interp,
			      "could not seek to end of file while opening \"",
			      Tcl_GetString(pathPtr), "\": ", 
			      Tcl_PosixError(interp), (char *) 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);
    if (interp != NULL) {

		    if (symbols[i] != NULL) {
			*procPtrs[i] = TclpFindSymbol(interp, *handlePtr, 
						      symbols[i]);
		    }
		}
		/* Copy this across, since both are equal for the native fs */
		*clientDataPtr = (ClientData)*handlePtr;
                Tcl_ResetResult(interp);
		return retVal;
		return TCL_OK;
	    }
	    if (Tcl_GetErrno() != EXDEV) {
	        return retVal;
	    }
	}
	/* 
	 * The filesystem doesn't support 'load', so we fall back on

	
	/* 
	 * Get a temporary filename to use, first to
	 * copy the file into, and then to load. 
	 */
	copyToPtr = TclpTempFileName();
	if (copyToPtr == NULL) {
	    Tcl_AppendResult(interp, "couldn't create temporary file: ",
			     Tcl_PosixError(interp), (char *) NULL);
	    return -1;
	    return TCL_ERROR;
	}
	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
	     * probably created, and then exit.
	     */
	    Tcl_FSDeleteFile(copyToPtr);
	    Tcl_DecrRefCount(copyToPtr);
	    Tcl_AppendResult(interp, "couldn't load from current filesystem",
			     (char *) NULL);
	    return -1;
	    return TCL_ERROR;
	}
	
	if (TclCrossFilesystemCopy(interp, pathPtr, copyToPtr) == TCL_OK) {
	    Tcl_LoadHandle newLoadHandle = NULL;
	    ClientData newClientData = NULL;
	    Tcl_FSUnloadFileProc *newUnloadProcPtr = NULL;
	    FsDivertLoad *tvdlPtr;

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

		Tcl_DecrRefCount(copyToPtr);
	    }

	    copyToPtr = NULL;
	    (*handlePtr) = newLoadHandle;
	    (*clientDataPtr) = (ClientData)tvdlPtr;
	    (*unloadProcPtr) = &FSUnloadTempFile;
	    Tcl_ResetResult(interp);
	    return retVal;
	} else {
	    /* Cross-platform copy failed */
	    Tcl_FSDeleteFile(copyToPtr);
	    Tcl_DecrRefCount(copyToPtr);
	    return TCL_ERROR;
	}
    }
    Tcl_SetErrno(ENOENT);
    return -1;
    return TCL_ERROR;
}
/* 
 * This function used to be in the platform specific directories, but it
 * has now been made to work cross-platform
 */
int
TclpLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr,