diff options
Diffstat (limited to 'win')
| -rw-r--r-- | win/tclWinChan.c | 26 | ||||
| -rw-r--r-- | win/tclWinFCmd.c | 287 | ||||
| -rw-r--r-- | win/tclWinFile.c | 244 | ||||
| -rw-r--r-- | win/tclWinLoad.c | 7 | ||||
| -rw-r--r-- | win/tclWinPort.h | 3 |
5 files changed, 227 insertions, 340 deletions
diff --git a/win/tclWinChan.c b/win/tclWinChan.c index be6ffe0..51d418a 100644 --- a/win/tclWinChan.c +++ b/win/tclWinChan.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWinChan.c,v 1.13 2000/10/06 23:46:06 davidg Exp $ + * RCS: @(#) $Id: tclWinChan.c,v 1.14 2001/08/30 08:53:15 vincentdarley Exp $ */ #include "tclWinInt.h" @@ -653,10 +653,10 @@ FileGetHandleProc(instanceData, direction, handlePtr) */ Tcl_Channel -TclpOpenFileChannel(interp, fileName, modeString, permissions) +TclpOpenFileChannel(interp, pathPtr, modeString, permissions) Tcl_Interp *interp; /* Interpreter for error reporting; * can be NULL. */ - char *fileName; /* Name of file to open. */ + Tcl_Obj *pathPtr; /* Name of file to open. */ char *modeString; /* A list of POSIX open modes or * a string such as "rw". */ int permissions; /* If the open involves creating a @@ -667,7 +667,6 @@ TclpOpenFileChannel(interp, fileName, modeString, permissions) int seekFlag, mode, channelPermissions; DWORD accessMode, createMode, shareMode, flags, consoleParams, type; TCHAR *nativeName; - Tcl_DString ds, buffer; DCB dcb; HANDLE handle; char channelName[16 + TCL_INTEGER_SPACE]; @@ -679,12 +678,11 @@ TclpOpenFileChannel(interp, fileName, modeString, permissions) return NULL; } - if (Tcl_TranslateFileName(interp, fileName, &ds) == NULL) { + nativeName = (TCHAR*) Tcl_FSGetNativePath(pathPtr); + if (nativeName == NULL) { return NULL; } - nativeName = Tcl_WinUtfToTChar(Tcl_DStringValue(&ds), - Tcl_DStringLength(&ds), &buffer); - + switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) { case O_RDONLY: accessMode = GENERIC_READ; @@ -766,10 +764,10 @@ TclpOpenFileChannel(interp, fileName, modeString, permissions) } TclWinConvertError(err); if (interp != (Tcl_Interp *) NULL) { - Tcl_AppendResult(interp, "couldn't open \"", fileName, "\": ", + Tcl_AppendResult(interp, "couldn't open \"", + Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), (char *) NULL); } - Tcl_DStringFree(&buffer); return NULL; } @@ -828,14 +826,12 @@ TclpOpenFileChannel(interp, fileName, modeString, permissions) */ channel = NULL; - Tcl_AppendResult(interp, "couldn't open \"", fileName, "\": ", - "bad file type", (char *) NULL); + Tcl_AppendResult(interp, "couldn't open \"", + Tcl_GetString(pathPtr), "\": ", + "bad file type", (char *) NULL); break; } - Tcl_DStringFree(&buffer); - Tcl_DStringFree(&ds); - if (channel != NULL) { if (seekFlag) { if (Tcl_Seek(channel, 0, SEEK_END) < 0) { diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c index c21fb9e..a04fc45 100644 --- a/win/tclWinFCmd.c +++ b/win/tclWinFCmd.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWinFCmd.c,v 1.10 2001/08/23 17:37:08 vincentdarley Exp $ + * RCS: @(#) $Id: tclWinFCmd.c,v 1.11 2001/08/30 08:53:15 vincentdarley Exp $ */ #include "tclWinInt.h" @@ -91,8 +91,8 @@ static int ConvertFileNameFormat(Tcl_Interp *interp, static int DoCopyFile(CONST TCHAR *srcPtr, CONST TCHAR *dstPtr); static int DoCreateDirectory(CONST TCHAR *pathPtr); static int DoDeleteFile(CONST TCHAR *pathPtr); -static int DoRemoveJustDirectory(CONST TCHAR *nativeSrc, int recursive, - Tcl_DString *errorPtr); +static int DoRemoveJustDirectory(CONST TCHAR *nativeSrc, + int recursive, Tcl_DString *errorPtr); static int DoRemoveDirectory(Tcl_DString *pathPtr, int recursive, Tcl_DString *errorPtr); static int DoRenameFile(CONST TCHAR *nativeSrc, CONST TCHAR *dstPtr); @@ -105,85 +105,10 @@ static int TraverseWinTree(TraversalProc *traverseProc, Tcl_DString *errorPtr); -int -TclpObjCreateDirectory(pathPtr) - Tcl_Obj *pathPtr; -{ - return DoCreateDirectory(Tcl_FSGetNativePath(pathPtr)); -} - -int -TclpObjDeleteFile(pathPtr) - Tcl_Obj *pathPtr; -{ - return DoDeleteFile(Tcl_FSGetNativePath(pathPtr)); -} - -int -TclpObjCopyDirectory(srcPathPtr, destPathPtr, errorPtr) - Tcl_Obj *srcPathPtr; - Tcl_Obj *destPathPtr; - Tcl_Obj **errorPtr; -{ - Tcl_DString ds; - int ret; - ret = TclpCopyDirectory(Tcl_FSGetTranslatedStringPath(NULL,srcPathPtr), - Tcl_FSGetTranslatedStringPath(NULL,destPathPtr), &ds); - if (ret != TCL_OK) { - *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); - Tcl_DStringFree(&ds); - Tcl_IncrRefCount(*errorPtr); - } - return ret; -} - -int -TclpObjCopyFile(srcPathPtr, destPathPtr) - Tcl_Obj *srcPathPtr; - Tcl_Obj *destPathPtr; -{ - return DoCopyFile(Tcl_FSGetNativePath(srcPathPtr), - Tcl_FSGetNativePath(destPathPtr)); -} - -int -TclpObjRemoveDirectory(pathPtr, recursive, errorPtr) - Tcl_Obj *pathPtr; - int recursive; - Tcl_Obj **errorPtr; -{ - Tcl_DString ds; - int ret; - if (recursive) { - /* - * In the recursive case, the string rep is used to construct a Tcl_DString - * which may be used extensively, so we can't optimize this case easily. - */ - ret = TclpRemoveDirectory(Tcl_FSGetTranslatedStringPath(NULL, pathPtr), - recursive, &ds); - } else { - ret = DoRemoveJustDirectory(Tcl_FSGetNativePath(pathPtr), recursive, &ds); - } - if (ret != TCL_OK) { - *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); - Tcl_DStringFree(&ds); - Tcl_IncrRefCount(*errorPtr); - } - return ret; -} - -int -TclpObjRenameFile(srcPathPtr, destPathPtr) - Tcl_Obj *srcPathPtr; - Tcl_Obj *destPathPtr; -{ - return DoRenameFile(Tcl_FSGetNativePath(srcPathPtr), Tcl_FSGetNativePath(destPathPtr)); -} - /* *--------------------------------------------------------------------------- * - * TclpRenameFile, DoRenameFile -- + * TclpObjRenameFile, DoRenameFile -- * * Changes the name of an existing file or directory, from src to dst. * If src and dst refer to the same file or directory, does nothing @@ -222,25 +147,13 @@ TclpObjRenameFile(srcPathPtr, destPathPtr) *--------------------------------------------------------------------------- */ -int -TclpRenameFile( - CONST char *src, /* Pathname of file or dir to be renamed - * (UTF-8). */ - CONST char *dst) /* New pathname of file or directory - * (UTF-8). */ +int +TclpObjRenameFile(srcPathPtr, destPathPtr) + Tcl_Obj *srcPathPtr; + Tcl_Obj *destPathPtr; { - int result; - TCHAR *nativeSrc; - TCHAR *nativeDest; - Tcl_DString srcString, dstString; - - nativeSrc = Tcl_WinUtfToTChar(src, -1, &srcString); - nativeDest = Tcl_WinUtfToTChar(dst, -1, &dstString); - - result = DoRenameFile(nativeSrc, nativeDest); - Tcl_DStringFree(&srcString); - Tcl_DStringFree(&dstString); - return result; + return DoRenameFile(Tcl_FSGetNativePath(srcPathPtr), + Tcl_FSGetNativePath(destPathPtr)); } static int @@ -481,7 +394,7 @@ DoRenameFile( /* *--------------------------------------------------------------------------- * - * TclpCopyFile, DoCopyFile -- + * TclpObjCopyFile, DoCopyFile -- * * Copy a single file (not a directory). If dst already exists and * is not a directory, it is removed. @@ -506,20 +419,12 @@ DoRenameFile( */ int -TclpCopyFile( - CONST char *src, /* Pathname of file to be copied (UTF-8). */ - CONST char *dst) /* Pathname of file to copy to (UTF-8). */ +TclpObjCopyFile(srcPathPtr, destPathPtr) + Tcl_Obj *srcPathPtr; + Tcl_Obj *destPathPtr; { - int result; - Tcl_DString srcString, dstString; - - Tcl_WinUtfToTChar(src, -1, &srcString); - Tcl_WinUtfToTChar(dst, -1, &dstString); - result = DoCopyFile(Tcl_DStringValue(&srcString), - Tcl_DStringValue(&dstString)); - Tcl_DStringFree(&srcString); - Tcl_DStringFree(&dstString); - return result; + return DoCopyFile(Tcl_FSGetNativePath(srcPathPtr), + Tcl_FSGetNativePath(destPathPtr)); } static int @@ -532,6 +437,16 @@ DoCopyFile( * block device. */ + /* + * If 'nativeDst' is NULL, the following code can lock the process + * up, at least under Windows2000. Therefore we have to bail at + * that point. + */ + if (nativeDst == NULL) { + Tcl_SetErrno(ENOENT); + return TCL_ERROR; + } + __try { if ((*tclWinProcs->copyFileProc)(nativeSrc, nativeDst, 0) != FALSE) { return TCL_OK; @@ -578,7 +493,7 @@ DoCopyFile( /* *--------------------------------------------------------------------------- * - * TclpDeleteFile, DoDeleteFile -- + * TclpObjDeleteFile, DoDeleteFile -- * * Removes a single file (not a directory). * @@ -600,17 +515,11 @@ DoCopyFile( *--------------------------------------------------------------------------- */ -int -TclpDeleteFile( - CONST char *path) /* Pathname of file to be removed (UTF-8). */ +int +TclpObjDeleteFile(pathPtr) + Tcl_Obj *pathPtr; { - int result; - Tcl_DString pathString; - - Tcl_WinUtfToTChar(path, -1, &pathString); - result = DoDeleteFile(Tcl_DStringValue(&pathString)); - Tcl_DStringFree(&pathString); - return result; + return DoDeleteFile(Tcl_FSGetNativePath(pathPtr)); } static int @@ -629,6 +538,11 @@ DoDeleteFile( * instead of ENOENT. */ + if (nativePath == NULL) { + Tcl_SetErrno(ENOENT); + return TCL_ERROR; + } + if (tclWinProcs->useWide) { if (((WCHAR *) nativePath)[0] == '\0') { Tcl_SetErrno(ENOENT); @@ -687,7 +601,7 @@ DoDeleteFile( /* *--------------------------------------------------------------------------- * - * TclpCreateDirectory -- + * TclpObjCreateDirectory -- * * Creates the specified directory. All parent directories of the * specified directory must already exist. The directory is @@ -709,17 +623,11 @@ DoDeleteFile( *--------------------------------------------------------------------------- */ -int -TclpCreateDirectory( - CONST char *path) /* Pathname of directory to create (UTF-8). */ +int +TclpObjCreateDirectory(pathPtr) + Tcl_Obj *pathPtr; { - int result; - Tcl_DString pathString; - - Tcl_WinUtfToTChar(path, -1, &pathString); - result = DoCreateDirectory(Tcl_DStringValue(&pathString)); - Tcl_DStringFree(&pathString); - return result; + return DoCreateDirectory(Tcl_FSGetNativePath(pathPtr)); } static int @@ -738,7 +646,7 @@ DoCreateDirectory( /* *--------------------------------------------------------------------------- * - * TclpCopyDirectory -- + * TclpObjCopyDirectory -- * * Recursively copies a directory. The target directory dst must * not already exist. Note that this function does not merge two @@ -761,32 +669,38 @@ DoCreateDirectory( *--------------------------------------------------------------------------- */ -int -TclpCopyDirectory( - CONST char *src, /* Pathname of directory to be copied - * (UTF-8). */ - CONST char *dst, /* Pathname of target directory (UTF-8). */ - Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free - * DString filled with UTF-8 name of file - * causing error. */ +int +TclpObjCopyDirectory(srcPathPtr, destPathPtr, errorPtr) + Tcl_Obj *srcPathPtr; + Tcl_Obj *destPathPtr; + Tcl_Obj **errorPtr; { - int result; + Tcl_DString ds; Tcl_DString srcString, dstString; + int ret; - Tcl_WinUtfToTChar(src, -1, &srcString); - Tcl_WinUtfToTChar(dst, -1, &dstString); + Tcl_WinUtfToTChar(Tcl_FSGetTranslatedStringPath(NULL,srcPathPtr), + -1, &srcString); + Tcl_WinUtfToTChar(Tcl_FSGetTranslatedStringPath(NULL,destPathPtr), + -1, &dstString); - result = TraverseWinTree(TraversalCopy, &srcString, &dstString, errorPtr); + ret = TraverseWinTree(TraversalCopy, &srcString, &dstString, &ds); Tcl_DStringFree(&srcString); Tcl_DStringFree(&dstString); - return result; + + if (ret != TCL_OK) { + *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); + Tcl_DStringFree(&ds); + Tcl_IncrRefCount(*errorPtr); + } + return ret; } /* *---------------------------------------------------------------------- * - * TclpRemoveDirectory, DoRemoveDirectory -- + * TclpObjRemoveDirectory, DoRemoveDirectory -- * * Removes directory (and its contents, if the recursive flag is set). * @@ -812,25 +726,38 @@ TclpCopyDirectory( *---------------------------------------------------------------------- */ -int -TclpRemoveDirectory( - CONST char *path, /* Pathname of directory to be removed - * (UTF-8). */ - int recursive, /* If non-zero, removes directories that - * are nonempty. Otherwise, will only remove - * empty directories. */ - Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free - * DString filled with UTF-8 name of file - * causing error. */ +int +TclpObjRemoveDirectory(pathPtr, recursive, errorPtr) + Tcl_Obj *pathPtr; + int recursive; + Tcl_Obj **errorPtr; { - int result; - Tcl_DString pathString; - - Tcl_WinUtfToTChar(path, -1, &pathString); - result = DoRemoveDirectory(&pathString, recursive, errorPtr); - Tcl_DStringFree(&pathString); - - return result; + Tcl_DString ds; + int ret; + if (recursive) { + /* + * In the recursive case, the string rep is used to construct a + * Tcl_DString which may be used extensively, so we can't + * optimize this case easily. + */ + Tcl_DString native; + Tcl_WinUtfToTChar(Tcl_FSGetTranslatedStringPath(NULL, pathPtr), + -1, &native); + ret = DoRemoveDirectory(&native, recursive, &ds); + Tcl_DStringFree(&native); + } else { + ret = DoRemoveJustDirectory(Tcl_FSGetNativePath(pathPtr), + recursive, &ds); + } + if (ret != TCL_OK) { + int len = Tcl_DStringLength(&ds); + if (len > 0) { + *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); + Tcl_IncrRefCount(*errorPtr); + } + Tcl_DStringFree(&ds); + } + return ret; } static int @@ -856,7 +783,11 @@ DoRemoveJustDirectory( * instead of ENOENT. */ - + if (nativePath == NULL) { + Tcl_SetErrno(ENOENT); + goto end; + } + if (tclWinProcs->useWide) { if (((WCHAR *) nativePath)[0] == '\0') { Tcl_SetErrno(ENOENT); @@ -974,7 +905,8 @@ DoRemoveDirectory( * DString filled with UTF-8 name of file * causing error. */ { - int res = DoRemoveJustDirectory(Tcl_DStringValue(pathPtr), recursive, errorPtr); + int res = DoRemoveJustDirectory(Tcl_DStringValue(pathPtr), recursive, + errorPtr); if ((res == TCL_ERROR) && (recursive != 0) && (Tcl_GetErrno() == EEXIST)) { /* @@ -1410,10 +1342,12 @@ ConvertFileNameFormat( splitPath = Tcl_FSSplitPath(fileName, &pathc); if (splitPath == NULL || pathc == 0) { - Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), + if (interp != NULL) { + Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "could not read \"", Tcl_GetString(fileName), "\": no such file or directory", (char *) NULL); + } result = TCL_ERROR; goto cleanup; } @@ -1480,7 +1414,9 @@ ConvertFileNameFormat( if (handle == INVALID_HANDLE_VALUE) { Tcl_DStringFree(&ds); - StatError(interp, fileName); + if (interp != NULL) { + StatError(interp, fileName); + } result = TCL_ERROR; goto cleanup; } @@ -1522,8 +1458,15 @@ ConvertFileNameFormat( Tcl_DStringInit(&dsTemp); Tcl_WinTCharToUtf(nativeName, -1, &dsTemp); - tempPath = Tcl_NewStringObj(Tcl_DStringValue(&dsTemp), - Tcl_DStringLength(&dsTemp)); + /* Deal with issues of tildes being absolute */ + if (Tcl_DStringValue(&dsTemp)[0] == '~') { + tempPath = Tcl_NewStringObj("./",2); + Tcl_AppendToObj(tempPath, Tcl_DStringValue(&dsTemp), + Tcl_DStringLength(&dsTemp)); + } else { + tempPath = Tcl_NewStringObj(Tcl_DStringValue(&dsTemp), + Tcl_DStringLength(&dsTemp)); + } Tcl_ListObjReplace(NULL, splitPath, i, 1, 1, &tempPath); Tcl_DStringFree(&ds); Tcl_DStringFree(&dsTemp); diff --git a/win/tclWinFile.c b/win/tclWinFile.c index d74fb78..c62b9ac 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWinFile.c,v 1.12 2001/08/23 17:37:08 vincentdarley Exp $ + * RCS: @(#) $Id: tclWinFile.c,v 1.13 2001/08/30 08:53:15 vincentdarley Exp $ */ #include "tclWinInt.h" @@ -30,6 +30,10 @@ typedef NET_API_STATUS NET_API_FUNCTION NETAPIBUFFERFREEPROC typedef NET_API_STATUS NET_API_FUNCTION NETGETDCNAMEPROC (LPWSTR servername, LPWSTR domainname, LPBYTE *bufptr); +static int NativeAccess(TCHAR *path, int mode); +static int NativeStat(TCHAR *path, struct stat *statPtr); +static int NativeIsExec(TCHAR *path); + /* *--------------------------------------------------------------------------- @@ -266,8 +270,9 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) found = (*tclWinProcs->findNextFileProc)(handle, &data)) { TCHAR *nativeMatchResult; char *name, *fname; + int typeOk = 1; - + if (tclWinProcs->useWide) { nativeName = (TCHAR *) data.w.cFileName; } else { @@ -316,7 +321,7 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) fname = Tcl_DStringValue(&dsOrig); nativeName = Tcl_WinUtfToTChar(fname, Tcl_DStringLength(&dsOrig), &ds); - + /* * 'attr' represents the attributes of the file, but we only * want to retrieve this info if it is absolutely necessary @@ -347,16 +352,17 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) typeOk = 0; } } + if (typeOk == 1 && types->perm != 0) { if ( ((types->perm & TCL_GLOB_PERM_RONLY) && !(attr & FILE_ATTRIBUTE_READONLY)) || ((types->perm & TCL_GLOB_PERM_R) && - (TclpAccess(fname, R_OK) != 0)) || + (NativeAccess(nativeName, R_OK) != 0)) || ((types->perm & TCL_GLOB_PERM_W) && - (TclpAccess(fname, W_OK) != 0)) || + (NativeAccess(nativeName, W_OK) != 0)) || ((types->perm & TCL_GLOB_PERM_X) && - (TclpAccess(fname, X_OK) != 0)) + (NativeAccess(nativeName, X_OK) != 0)) ) { typeOk = 0; } @@ -364,7 +370,7 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) if (typeOk && types->type != 0) { if (types->perm == 0) { /* We haven't yet done a stat on the file */ - if (TclpStat(fname, &buf) != 0) { + if (NativeStat(nativeName, &buf) != 0) { /* Posix error occurred */ typeOk = 0; } @@ -394,7 +400,11 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) typeOk = 0; #ifdef S_ISLNK if (types->type & TCL_GLOB_TYPE_LINK) { - if (TclpLstat(fname, &buf) == 0) { + /* + * We should use 'lstat' but it is the + * same as 'stat' on windows. + */ + if (NativeStat(nativeName, &buf) == 0) { if (S_ISLNK(buf.st_mode)) { typeOk = 1; } @@ -563,7 +573,7 @@ TclpGetUserHome(name, bufferPtr) /* *--------------------------------------------------------------------------- * - * TclpAccess -- + * NativeAccess -- * * This function replaces the library version of access(), fixing the * following bugs: @@ -579,18 +589,14 @@ TclpGetUserHome(name, bufferPtr) *--------------------------------------------------------------------------- */ -int -TclpAccess( - CONST char *path, /* Path of file to access (UTF-8). */ +static int +NativeAccess( + TCHAR *nativePath, /* Path of file to access (UTF-8). */ int mode) /* Permission setting. */ { - Tcl_DString ds; - TCHAR *nativePath; DWORD attr; - nativePath = Tcl_WinUtfToTChar(path, -1, &ds); attr = (*tclWinProcs->getFileAttributesProc)(nativePath); - Tcl_DStringFree(&ds); if (attr == 0xffffffff) { /* @@ -611,8 +617,6 @@ TclpAccess( } if (mode & X_OK) { - CONST char *p; - if (attr & FILE_ATTRIBUTE_DIRECTORY) { /* * Directories are always executable. @@ -620,18 +624,8 @@ TclpAccess( return 0; } - p = strrchr(path, '.'); - if (p != NULL) { - p++; - if ((stricmp(p, "exe") == 0) - || (stricmp(p, "com") == 0) - || (stricmp(p, "bat") == 0)) { - /* - * File that ends with .exe, .com, or .bat is executable. - */ - - return 0; - } + if (NativeIsExec(nativePath)) { + return 0; } Tcl_SetErrno(EACCES); return -1; @@ -640,10 +634,47 @@ TclpAccess( return 0; } +static int +NativeIsExec(nativePath) + TCHAR *nativePath; +{ + CONST char *p; + char *path; + Tcl_DString ds; + + /* + * This is really not efficient. We should be able to examine + * the native path directly without converting to UTF. + */ + Tcl_DStringInit(&ds); + path = Tcl_WinTCharToUtf(nativePath, -1, &ds); + + p = strrchr(path, '.'); + if (p != NULL) { + p++; + /* + * Note: in the old code, stat considered '.pif' files as + * executable, whereas access did not. + */ + if ((stricmp(p, "exe") == 0) + || (stricmp(p, "com") == 0) + || (stricmp(p, "bat") == 0)) { + /* + * File that ends with .exe, .com, or .bat is executable. + */ + + Tcl_DStringFree(&ds); + return 1; + } + } + Tcl_DStringFree(&ds); + return 0; +} + /* *---------------------------------------------------------------------- * - * TclpChdir -- + * TclpObjChdir -- * * This function replaces the library version of chdir(). * @@ -656,17 +687,15 @@ TclpAccess( *---------------------------------------------------------------------- */ -int -TclpChdir(path) - CONST char *path; /* Path to new working directory (UTF-8). */ +int +TclpObjChdir(pathPtr) + Tcl_Obj *pathPtr; /* Path to new working directory. */ { int result; - Tcl_DString ds; TCHAR *nativePath; - nativePath = Tcl_WinUtfToTChar(path, -1, &ds); + nativePath = (TCHAR *) Tcl_FSGetNativePath(pathPtr); result = (*tclWinProcs->setCurrentDirectoryProc)(nativePath); - Tcl_DStringFree(&ds); if (result == 0) { TclWinConvertError(GetLastError()); @@ -796,10 +825,30 @@ TclpGetCwd(interp, bufferPtr) return Tcl_DStringValue(bufferPtr); } +int +TclpObjStat(pathPtr, statPtr) + Tcl_Obj *pathPtr; /* Path of file to stat */ + struct stat *statPtr; /* Filled with results of stat call. */ +{ + Tcl_Obj *transPtr; + /* + * Eliminate file names containing wildcard characters, or subsequent + * call to FindFirstFile() will expand them, matching some other file. + */ + + transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr); + if (transPtr == NULL || (strpbrk(Tcl_GetString(transPtr), "?*") != NULL)) { + Tcl_SetErrno(ENOENT); + return -1; + } + + return NativeStat((TCHAR*) Tcl_FSGetNativePath(pathPtr), statPtr); +} + /* *---------------------------------------------------------------------- * - * TclpObjStat -- + * NativeStat -- * * This function replaces the library version of stat(), fixing * the following bugs: @@ -819,34 +868,20 @@ TclpGetCwd(interp, bufferPtr) *---------------------------------------------------------------------- */ -int -TclpObjStat(pathPtr, statPtr) - Tcl_Obj *pathPtr; /* Path of file to stat */ +static int +NativeStat(nativePath, statPtr) + TCHAR *nativePath; /* Path of file to stat */ struct stat *statPtr; /* Filled with results of stat call. */ { Tcl_DString ds; - TCHAR *nativePath; WIN32_FIND_DATAT data; HANDLE handle; DWORD attr; WCHAR nativeFullPath[MAX_PATH]; TCHAR *nativePart; - char *p, *fullPath; + char *fullPath; int dev, mode; - Tcl_Obj *transPtr; - - /* - * Eliminate file names containing wildcard characters, or subsequent - * call to FindFirstFile() will expand them, matching some other file. - */ - transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr); - if (transPtr == NULL || (strpbrk(Tcl_GetString(transPtr), "?*") != NULL)) { - Tcl_SetErrno(ENOENT); - return -1; - } - - nativePath = (TCHAR *) Tcl_FSGetNativePath(pathPtr); handle = (*tclWinProcs->findFirstFileProc)(nativePath, &data); if (handle == INVALID_HANDLE_VALUE) { /* @@ -918,14 +953,8 @@ TclpObjStat(pathPtr, statPtr) attr = data.a.dwFileAttributes; mode = (attr & FILE_ATTRIBUTE_DIRECTORY) ? S_IFDIR | S_IEXEC : S_IFREG; mode |= (attr & FILE_ATTRIBUTE_READONLY) ? S_IREAD : S_IREAD | S_IWRITE; - p = strrchr(Tcl_GetString(transPtr), '.'); - if (p != NULL) { - if ((lstrcmpiA(p, ".exe") == 0) - || (lstrcmpiA(p, ".com") == 0) - || (lstrcmpiA(p, ".bat") == 0) - || (lstrcmpiA(p, ".pif") == 0)) { - mode |= S_IEXEC; - } + if (NativeIsExec(nativePath)) { + mode |= S_IEXEC; } /* @@ -1096,85 +1125,18 @@ TclpObjGetCwd(interp) } int -TclpObjChdir(pathPtr) - Tcl_Obj *pathPtr; -{ - int result; - TCHAR *nativePath; - - nativePath = (TCHAR *) Tcl_FSGetNativePath(pathPtr); - result = (*tclWinProcs->setCurrentDirectoryProc)(nativePath); - - if (result == 0) { - TclWinConvertError(GetLastError()); - return -1; - } - return 0; -} - -int TclpObjAccess(pathPtr, mode) Tcl_Obj *pathPtr; int mode; { - TCHAR *nativePath; - DWORD attr; - - nativePath = (TCHAR *) Tcl_FSGetNativePath(pathPtr); - attr = (*tclWinProcs->getFileAttributesProc)(nativePath); - - if (attr == 0xffffffff) { - /* - * File doesn't exist. - */ - - TclWinConvertError(GetLastError()); - return -1; - } - - if ((mode & W_OK) && (attr & FILE_ATTRIBUTE_READONLY)) { - /* - * File is not writable. - */ - - Tcl_SetErrno(EACCES); - return -1; - } - - if (mode & X_OK) { - CONST char *p; - - if (attr & FILE_ATTRIBUTE_DIRECTORY) { - /* - * Directories are always executable. - */ - - return 0; - } - p = strrchr(Tcl_FSGetTranslatedStringPath(NULL, pathPtr), '.'); - if (p != NULL) { - p++; - if ((stricmp(p, "exe") == 0) - || (stricmp(p, "com") == 0) - || (stricmp(p, "bat") == 0)) { - /* - * File that ends with .exe, .com, or .bat is executable. - */ - - return 0; - } - } - Tcl_SetErrno(EACCES); - return -1; - } - - return 0; + return NativeAccess((TCHAR*) Tcl_FSGetNativePath(pathPtr), mode); } int TclpObjLstat(pathPtr, buf) Tcl_Obj *pathPtr; - struct stat *buf; { + struct stat *buf; +{ return TclpObjStat(pathPtr,buf); } @@ -1201,17 +1163,3 @@ TclpObjLink(pathPtr, toPtr) } #endif - -/* Obsolete, only called from test suite */ -int -TclpStat(path, statPtr) - CONST char *path; /* Path of file to stat (UTF-8). */ - struct stat *statPtr; /* Filled with results of stat call. */ -{ - int retVal; - Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1); - Tcl_IncrRefCount(pathPtr); - retVal = TclpObjStat(pathPtr, statPtr); - Tcl_DecrRefCount(pathPtr); - return retVal; -} diff --git a/win/tclWinLoad.c b/win/tclWinLoad.c index 8afbefe..c0923d5 100644 --- a/win/tclWinLoad.c +++ b/win/tclWinLoad.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWinLoad.c,v 1.6 2000/09/06 22:37:24 hobbs Exp $ + * RCS: @(#) $Id: tclWinLoad.c,v 1.7 2001/08/30 08:53:15 vincentdarley Exp $ */ #include "tclWinInt.h" @@ -36,9 +36,9 @@ */ int -TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr) +TclpLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr) Tcl_Interp *interp; /* Used for error reporting. */ - char *fileName; /* Name of the file containing the desired + Tcl_Obj *pathPtr; /* Name of the file containing the desired * code. */ char *sym1, *sym2; /* Names of two procedures to look up in * the file's symbol table. */ @@ -53,6 +53,7 @@ TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr) TCHAR *nativeName; Tcl_DString ds; + char *fileName = Tcl_GetString(pathPtr); nativeName = Tcl_WinUtfToTChar(fileName, -1, &ds); handle = (*tclWinProcs->loadLibraryProc)(nativeName); Tcl_DStringFree(&ds); diff --git a/win/tclWinPort.h b/win/tclWinPort.h index aa85de4..e7b5533 100644 --- a/win/tclWinPort.h +++ b/win/tclWinPort.h @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWinPort.h,v 1.18 2001/08/02 20:15:40 mdejong Exp $ + * RCS: @(#) $Id: tclWinPort.h,v 1.19 2001/08/30 08:53:15 vincentdarley Exp $ */ #ifndef _TCLWINPORT @@ -420,7 +420,6 @@ typedef float *TCHAR; */ #define TclpExit exit -#define TclpLstat TclpStat /* * Declarations for Windows-only functions. |