summaryrefslogtreecommitdiffstats
path: root/win
diff options
context:
space:
mode:
Diffstat (limited to 'win')
-rw-r--r--win/tclWinChan.c26
-rw-r--r--win/tclWinFCmd.c287
-rw-r--r--win/tclWinFile.c244
-rw-r--r--win/tclWinLoad.c7
-rw-r--r--win/tclWinPort.h3
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.