diff options
Diffstat (limited to 'win/tclWinFCmd.c')
| -rw-r--r-- | win/tclWinFCmd.c | 1036 |
1 files changed, 660 insertions, 376 deletions
diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c index f2df779..97986c9 100644 --- a/win/tclWinFCmd.c +++ b/win/tclWinFCmd.c @@ -4,12 +4,12 @@ * This file implements the Windows specific portion of file manipulation * subcommands of the "file" command. * - * Copyright (c) 1996-1997 Sun Microsystems, Inc. + * Copyright (c) 1996-1998 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * SCCS: @(#) tclWinFCmd.c 1.20 97/10/10 11:50:14 + * SCCS: @(#) tclWinFCmd.c 1.34 98/02/11 17:39:47 */ #include "tclWinInt.h" @@ -28,19 +28,19 @@ */ static int GetWinFileAttributes _ANSI_ARGS_((Tcl_Interp *interp, - int objIndex, char *fileName, + int objIndex, CONST char *fileName, Tcl_Obj **attributePtrPtr)); static int GetWinFileLongName _ANSI_ARGS_((Tcl_Interp *interp, - int objIndex, char *fileName, + int objIndex, CONST char *fileName, Tcl_Obj **attributePtrPtr)); static int GetWinFileShortName _ANSI_ARGS_((Tcl_Interp *interp, - int objIndex, char *fileName, + int objIndex, CONST char *fileName, Tcl_Obj **attributePtrPtr)); static int SetWinFileAttributes _ANSI_ARGS_((Tcl_Interp *interp, - int objIndex, char *fileName, + int objIndex, CONST char *fileName, Tcl_Obj *attributePtr)); static int CannotSetAttribute _ANSI_ARGS_((Tcl_Interp *interp, - int objIndex, char *fileName, + int objIndex, CONST char *fileName, Tcl_Obj *attributePtr)); /* @@ -60,9 +60,12 @@ static int attributeArray[] = {FILE_ATTRIBUTE_ARCHIVE, FILE_ATTRIBUTE_HIDDEN, 0, FILE_ATTRIBUTE_READONLY, 0, FILE_ATTRIBUTE_SYSTEM}; -char *tclpFileAttrStrings[] = {"-archive", "-hidden", "-longname", "-readonly", - "-shortname", "-system", (char *) NULL}; -CONST TclFileAttrProcs tclpFileAttrProcs[] = { +char *tclpFileAttrStrings[] = { + "-archive", "-hidden", "-longname", "-readonly", + "-shortname", "-system", (char *) NULL +}; + +const TclFileAttrProcs tclpFileAttrProcs[] = { {GetWinFileAttributes, SetWinFileAttributes}, {GetWinFileAttributes, SetWinFileAttributes}, {GetWinFileLongName, CannotSetAttribute}, @@ -74,31 +77,36 @@ CONST TclFileAttrProcs tclpFileAttrProcs[] = { * Prototype for the TraverseWinTree callback function. */ -typedef int (TraversalProc)(char *src, char *dst, DWORD attr, int type, - Tcl_DString *errorPtr); +typedef int (TraversalProc)(Tcl_DString *srcPtr, Tcl_DString *dstPtr, + int type, Tcl_DString *errorPtr); /* * Declarations for local procedures defined in this file: */ -static void AttributesPosixError _ANSI_ARGS_((Tcl_Interp *interp, - int objIndex, char *fileName, int getOrSet)); -static int ConvertFileNameFormat _ANSI_ARGS_((Tcl_Interp *interp, - int objIndex, char *fileName, int longShort, - Tcl_Obj **attributePtrPtr)); -static int TraversalCopy(char *src, char *dst, DWORD attr, - int type, Tcl_DString *errorPtr); -static int TraversalDelete(char *src, char *dst, DWORD attr, - int type, Tcl_DString *errorPtr); +static void StatError(Tcl_Interp *interp, CONST char *fileName); +static int ConvertFileNameFormat(Tcl_Interp *interp, + int objIndex, CONST char *fileName, int longShort, + Tcl_Obj **attributePtrPtr); +static int DoCopyFile(Tcl_DString *srcPtr, Tcl_DString *dstPtr); +static int DoCreateDirectory(Tcl_DString *pathPtr); +static int DoDeleteFile(Tcl_DString *pathPtr); +static int DoRemoveDirectory(Tcl_DString *pathPtr, int recursive, + Tcl_DString *errorPtr); +static int DoRenameFile(const TCHAR *nativeSrc, Tcl_DString *dstPtr); +static int TraversalCopy(Tcl_DString *srcPtr, Tcl_DString *dstPtr, + int type, Tcl_DString *errorPtr); +static int TraversalDelete(Tcl_DString *srcPtr, Tcl_DString *dstPtr, + int type, Tcl_DString *errorPtr); static int TraverseWinTree(TraversalProc *traverseProc, - Tcl_DString *sourcePtr, Tcl_DString *destPtr, + Tcl_DString *sourcePtr, Tcl_DString *dstPtr, Tcl_DString *errorPtr); /* *--------------------------------------------------------------------------- * - * TclpRenameFile -- + * TclpRenameFile, 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 @@ -110,10 +118,11 @@ static int TraverseWinTree(TraversalProc *traverseProc, * fail. * * Results: - * If the directory was successfully created, returns TCL_OK. + * If the file or directory was successfully renamed, returns TCL_OK. * Otherwise the return value is TCL_ERROR and errno is set to * indicate the error. Some possible values for errno are: * + * ENAMETOOLONG: src or dst names are too long. * EACCES: src or dst parent directory can't be read and/or written. * EEXIST: dst is a non-empty directory. * EINVAL: src is a root directory or dst is a subdirectory of src. @@ -138,30 +147,76 @@ static int TraverseWinTree(TraversalProc *traverseProc, int TclpRenameFile( - char *src, /* Pathname of file or dir to be renamed. */ - char *dst) /* New pathname for file or directory. */ + 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 result; + TCHAR *nativeSrc; + Tcl_DString srcString, dstString; + + nativeSrc = Tcl_WinUtfToTChar(src, -1, &srcString); + Tcl_WinUtfToTChar(dst, -1, &dstString); + + if ((TclWinGetPlatformId() == VER_PLATFORM_WIN32s) + && ((Tcl_DStringLength(&srcString) >= MAX_PATH - 1) || + (Tcl_DStringLength(&dstString) >= MAX_PATH - 1))) { + /* + * On Win32s, really long file names cause the MoveFile() call + * to lock up, endlessly throwing an access violation and + * retrying the operation. + */ + + errno = ENAMETOOLONG; + result = TCL_ERROR; + } else { + result = DoRenameFile(nativeSrc, &dstString); + } + Tcl_DStringFree(&srcString); + Tcl_DStringFree(&dstString); + return result; +} + +static int +DoRenameFile( + CONST TCHAR *nativeSrc, /* Pathname of file or dir to be renamed + * (native). */ + Tcl_DString *dstPtr) /* New pathname for file or directory + * (native). */ +{ + const TCHAR *nativeDst; DWORD srcAttr, dstAttr; - + + nativeDst = (TCHAR *) Tcl_DStringValue(dstPtr); + /* * Would throw an exception under NT if one of the arguments is a * char block device. */ try { - if (MoveFile(src, dst) != FALSE) { + if ((*tclWinProcs->moveFileProc)(nativeSrc, nativeDst) != FALSE) { return TCL_OK; } } except (-1) {} TclWinConvertError(GetLastError()); - srcAttr = GetFileAttributes(src); - dstAttr = GetFileAttributes(dst); - if (srcAttr == (DWORD) -1) { + srcAttr = (*tclWinProcs->getFileAttributesProc)(nativeSrc); + dstAttr = (*tclWinProcs->getFileAttributesProc)(nativeDst); + if (srcAttr == 0xffffffff) { + if ((*tclWinProcs->getFullPathNameProc)(nativeSrc, 0, NULL, NULL) >= MAX_PATH) { + errno = ENAMETOOLONG; + return TCL_ERROR; + } srcAttr = 0; } - if (dstAttr == (DWORD) -1) { + if (dstAttr == 0xffffffff) { + if ((*tclWinProcs->getFullPathNameProc)(nativeDst, 0, NULL, NULL) >= MAX_PATH) { + errno = ENAMETOOLONG; + return TCL_ERROR; + } dstAttr = 0; } @@ -169,7 +224,7 @@ TclpRenameFile( errno = EACCES; return TCL_ERROR; } - if ((errno == EACCES) && (TclWinGetPlatformId() == VER_PLATFORM_WIN32s)) { + if ((TclWinGetPlatformId() == VER_PLATFORM_WIN32s) && (errno == EACCES)) { if ((srcAttr != 0) && (dstAttr != 0)) { /* * Win32s reports trying to overwrite an existing file or directory @@ -182,33 +237,44 @@ TclpRenameFile( if (errno == EACCES) { decode: if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) { - char srcPath[MAX_PATH], dstPath[MAX_PATH]; - int srcArgc, dstArgc; + TCHAR *nativeSrcRest, *nativeDstRest; char **srcArgv, **dstArgv; - char *srcRest, *dstRest; - int size; - - size = GetFullPathName(src, sizeof(srcPath), srcPath, &srcRest); - if ((size == 0) || (size > sizeof(srcPath))) { + int size, srcArgc, dstArgc; + WCHAR nativeSrcPath[MAX_PATH]; + WCHAR nativeDstPath[MAX_PATH]; + Tcl_DString srcString, dstString; + CONST char *src, *dst; + + size = (*tclWinProcs->getFullPathNameProc)(nativeSrc, MAX_PATH, + nativeSrcPath, &nativeSrcRest); + if ((size == 0) || (size > MAX_PATH)) { return TCL_ERROR; } - size = GetFullPathName(dst, sizeof(dstPath), dstPath, &dstRest); - if ((size == 0) || (size > sizeof(dstPath))) { + size = (*tclWinProcs->getFullPathNameProc)(nativeDst, MAX_PATH, + nativeDstPath, &nativeDstRest); + if ((size == 0) || (size > MAX_PATH)) { return TCL_ERROR; } - if (srcRest == NULL) { - srcRest = srcPath + strlen(srcPath); - } - if (strnicmp(srcPath, dstPath, srcRest - srcPath) == 0) { + (*tclWinProcs->charLowerProc)((TCHAR *) nativeSrcPath); + (*tclWinProcs->charLowerProc)((TCHAR *) nativeDstPath); + + src = Tcl_WinTCharToUtf((TCHAR *) nativeSrcPath, -1, &srcString); + dst = Tcl_WinTCharToUtf((TCHAR *) nativeDstPath, -1, &dstString); + if (strncmp(src, dst, Tcl_DStringLength(&srcString)) == 0) { /* * Trying to move a directory into itself. */ errno = EINVAL; + Tcl_DStringFree(&srcString); + Tcl_DStringFree(&dstString); return TCL_ERROR; } - Tcl_SplitPath(srcPath, &srcArgc, &srcArgv); - Tcl_SplitPath(dstPath, &dstArgc, &dstArgv); + Tcl_SplitPath(src, &srcArgc, &srcArgv); + Tcl_SplitPath(dst, &dstArgc, &dstArgv); + Tcl_DStringFree(&srcString); + Tcl_DStringFree(&dstString); + if (srcArgc == 1) { /* * They are trying to move a root directory. Whether @@ -216,9 +282,9 @@ TclpRenameFile( * done. */ - errno = EINVAL; + Tcl_SetErrno(EINVAL); } else if ((srcArgc > 0) && (dstArgc > 0) && - (stricmp(srcArgv[0], dstArgv[0]) != 0)) { + (strcmp(srcArgv[0], dstArgv[0]) != 0)) { /* * If src is a directory and dst filesystem != src * filesystem, errno should be EXDEV. It is very @@ -229,7 +295,7 @@ TclpRenameFile( * file between filesystems. */ - errno = EXDEV; + Tcl_SetErrno(EXDEV); } ckfree((char *) srcArgv); @@ -243,7 +309,7 @@ TclpRenameFile( * current filesystem. EACCES is returned for those cases. */ - } else if (errno == EEXIST) { + } else if (Tcl_GetErrno() == EEXIST) { /* * Reports EEXIST any time the target already exists. If it makes * sense, remove the old file and try renaming again. @@ -257,14 +323,14 @@ TclpRenameFile( * fails, it's because it wasn't empty. */ - if (TclpRemoveDirectory(dst, 0, NULL) == TCL_OK) { + if (DoRemoveDirectory(dstPtr, 0, NULL) == TCL_OK) { /* * Now that that empty directory is gone, we can try * renaming again. If that fails, we'll put this empty * directory back, for completeness. */ - if (MoveFile(src, dst) != FALSE) { + if ((*tclWinProcs->moveFileProc)(nativeSrc, nativeDst) != FALSE) { return TCL_OK; } @@ -274,9 +340,9 @@ TclpRenameFile( */ TclWinConvertError(GetLastError()); - CreateDirectory(dst, NULL); - SetFileAttributes(dst, dstAttr); - if (errno == EACCES) { + (*tclWinProcs->createDirectoryProc)(nativeDst, NULL); + (*tclWinProcs->setFileAttributesProc)(nativeDst, dstAttr); + if (Tcl_GetErrno() == EACCES) { /* * Decode the EACCES to a more meaningful error. */ @@ -285,11 +351,11 @@ TclpRenameFile( } } } else { /* (dstAttr & FILE_ATTRIBUTE_DIRECTORY) == 0 */ - errno = ENOTDIR; + Tcl_SetErrno(ENOTDIR); } } else { /* (srcAttr & FILE_ATTRIBUTE_DIRECTORY) == 0 */ if (dstAttr & FILE_ATTRIBUTE_DIRECTORY) { - errno = EISDIR; + Tcl_SetErrno(EISDIR); } else { /* * Overwrite existing file by: @@ -300,17 +366,24 @@ TclpRenameFile( * put temp file back to old name. */ - char tempName[MAX_PATH]; + TCHAR *nativeRest, *nativeTmp, *nativePrefix; int result, size; - char *rest; + WCHAR tempBuf[MAX_PATH]; - size = GetFullPathName(dst, sizeof(tempName), tempName, &rest); - if ((size == 0) || (size > sizeof(tempName)) || (rest == NULL)) { + size = (*tclWinProcs->getFullPathNameProc)(nativeDst, MAX_PATH, + tempBuf, &nativeRest); + if ((size == 0) || (size > MAX_PATH) || (nativeRest == NULL)) { return TCL_ERROR; } - *rest = '\0'; + nativeTmp = (TCHAR *) tempBuf; + ((char *) nativeRest)[0] = '\0'; + ((char *) nativeRest)[1] = '\0'; /* In case it's Unicode. */ + result = TCL_ERROR; - if (GetTempFileName(tempName, "tclr", 0, tempName) != 0) { + nativePrefix = (tclWinProcs->useWide) + ? (TCHAR *) L"tclr" : (TCHAR *) "tclr"; + if ((*tclWinProcs->getTempFileNameProc)(nativeTmp, + nativePrefix, 0, tempBuf) != 0) { /* * Strictly speaking, need the following DeleteFile and * MoveFile to be joined as an atomic operation so no @@ -318,15 +391,17 @@ TclpRenameFile( * same temp file. */ - DeleteFile(tempName); - if (MoveFile(dst, tempName) != FALSE) { - if (MoveFile(src, dst) != FALSE) { - SetFileAttributes(tempName, FILE_ATTRIBUTE_NORMAL); - DeleteFile(tempName); + nativeTmp = (TCHAR *) tempBuf; + (*tclWinProcs->deleteFileProc)(nativeTmp); + if ((*tclWinProcs->moveFileProc)(nativeDst, nativeTmp) != FALSE) { + if ((*tclWinProcs->moveFileProc)(nativeSrc, nativeDst) != FALSE) { + (*tclWinProcs->setFileAttributesProc)(nativeTmp, + FILE_ATTRIBUTE_NORMAL); + (*tclWinProcs->deleteFileProc)(nativeTmp); return TCL_OK; } else { - DeleteFile(dst); - MoveFile(tempName, dst); + (*tclWinProcs->deleteFileProc)(nativeDst); + (*tclWinProcs->moveFileProc)(nativeTmp, nativeDst); } } @@ -336,7 +411,7 @@ TclpRenameFile( */ TclWinConvertError(GetLastError()); - if (errno == EACCES) { + if (Tcl_GetErrno() == EACCES) { /* * Decode the EACCES to a more meaningful error. */ @@ -354,7 +429,7 @@ TclpRenameFile( /* *--------------------------------------------------------------------------- * - * TclpCopyFile -- + * TclpCopyFile, DoCopyFile -- * * Copy a single file (not a directory). If dst already exists and * is not a directory, it is removed. @@ -380,41 +455,63 @@ TclpRenameFile( int TclpCopyFile( - char *src, /* Pathname of file to be copied. */ - char *dst) /* Pathname of file to copy to. */ + CONST char *src, /* Pathname of file to be copied (UTF-8). */ + CONST char *dst) /* Pathname of file to copy to (UTF-8). */ +{ + int result; + Tcl_DString srcString, dstString; + + Tcl_WinUtfToTChar(src, -1, &srcString); + Tcl_WinUtfToTChar(dst, -1, &dstString); + result = DoCopyFile(&srcString, &dstString); + Tcl_DStringFree(&srcString); + Tcl_DStringFree(&dstString); + return result; +} + +static int +DoCopyFile( + Tcl_DString *srcPtr, /* Pathname of file to be copied (native). */ + Tcl_DString *dstPtr) /* Pathname of file to copy to (native). */ { + CONST TCHAR *nativeSrc, *nativeDst; + + nativeSrc = (TCHAR *) Tcl_DStringValue(srcPtr); + nativeDst = (TCHAR *) Tcl_DStringValue(dstPtr); + /* * Would throw an exception under NT if one of the arguments is a char * block device. */ try { - if (CopyFile(src, dst, 0) != FALSE) { + if ((*tclWinProcs->copyFileProc)(nativeSrc, nativeDst, 0) != FALSE) { return TCL_OK; } } except (-1) {} TclWinConvertError(GetLastError()); - if (errno == EBADF) { - errno = EACCES; + if (Tcl_GetErrno() == EBADF) { + Tcl_SetErrno(EACCES); return TCL_ERROR; } - if (errno == EACCES) { + if (Tcl_GetErrno() == EACCES) { DWORD srcAttr, dstAttr; - srcAttr = GetFileAttributes(src); - dstAttr = GetFileAttributes(dst); - if (srcAttr != (DWORD) -1) { - if (dstAttr == (DWORD) -1) { + srcAttr = (*tclWinProcs->getFileAttributesProc)(nativeSrc); + dstAttr = (*tclWinProcs->getFileAttributesProc)(nativeDst); + if (srcAttr != 0xffffffff) { + if (dstAttr == 0xffffffff) { dstAttr = 0; } if ((srcAttr & FILE_ATTRIBUTE_DIRECTORY) || (dstAttr & FILE_ATTRIBUTE_DIRECTORY)) { - errno = EISDIR; + Tcl_SetErrno(EISDIR); } if (dstAttr & FILE_ATTRIBUTE_READONLY) { - SetFileAttributes(dst, dstAttr & ~FILE_ATTRIBUTE_READONLY); - if (CopyFile(src, dst, 0) != FALSE) { + (*tclWinProcs->setFileAttributesProc)(nativeDst, + dstAttr & ~FILE_ATTRIBUTE_READONLY); + if ((*tclWinProcs->copyFileProc)(nativeSrc, nativeDst, 0) != FALSE) { return TCL_OK; } /* @@ -423,7 +520,7 @@ TclpCopyFile( */ TclWinConvertError(GetLastError()); - SetFileAttributes(dst, dstAttr); + (*tclWinProcs->setFileAttributesProc)(nativeDst, dstAttr); } } } @@ -433,7 +530,7 @@ TclpCopyFile( /* *--------------------------------------------------------------------------- * - * TclpDeleteFile -- + * TclpDeleteFile, DoDeleteFile -- * * Removes a single file (not a directory). * @@ -457,59 +554,86 @@ TclpCopyFile( int TclpDeleteFile( - char *path) /* Pathname of file to be removed. */ + CONST char *path) /* Pathname of file to be removed (UTF-8). */ +{ + int result; + Tcl_DString pathString; + + Tcl_WinUtfToTChar(path, -1, &pathString); + result = DoDeleteFile(&pathString); + Tcl_DStringFree(&pathString); + return result; +} + +static int +DoDeleteFile( + Tcl_DString *pathPtr) /* Pathname of file to be removed (native). */ { DWORD attr; + CONST TCHAR *nativePath; - if (DeleteFile(path) != FALSE) { + nativePath = (TCHAR *) Tcl_DStringValue(pathPtr); + + if ((*tclWinProcs->deleteFileProc)(nativePath) != FALSE) { return TCL_OK; } TclWinConvertError(GetLastError()); - if (path[0] == '\0') { - /* - * Win32s thinks that "" is the same as "." and then reports EISDIR - * instead of ENOENT. - */ - errno = ENOENT; - } else if (errno == EACCES) { - attr = GetFileAttributes(path); - if (attr != (DWORD) -1) { + /* + * Win32s thinks that "" is the same as "." and then reports EISDIR + * instead of ENOENT. + */ + + if (tclWinProcs->useWide) { + if (((WCHAR *) nativePath)[0] == '\0') { + Tcl_SetErrno(ENOENT); + return TCL_ERROR; + } + } else { + if (((char *) nativePath)[0] == '\0') { + Tcl_SetErrno(ENOENT); + return TCL_ERROR; + } + } + if (Tcl_GetErrno() == EACCES) { + attr = (*tclWinProcs->getFileAttributesProc)(nativePath); + if (attr != 0xffffffff) { if (attr & FILE_ATTRIBUTE_DIRECTORY) { /* * Windows NT reports removing a directory as EACCES instead * of EISDIR. */ - errno = EISDIR; + Tcl_SetErrno(EISDIR); } else if (attr & FILE_ATTRIBUTE_READONLY) { - SetFileAttributes(path, attr & ~FILE_ATTRIBUTE_READONLY); - if (DeleteFile(path) != FALSE) { + (*tclWinProcs->setFileAttributesProc)(nativePath, + attr & ~FILE_ATTRIBUTE_READONLY); + if ((*tclWinProcs->deleteFileProc)(nativePath) != FALSE) { return TCL_OK; } TclWinConvertError(GetLastError()); - SetFileAttributes(path, attr); + (*tclWinProcs->setFileAttributesProc)(nativePath, attr); } } - } else if (errno == ENOENT) { - attr = GetFileAttributes(path); - if (attr != (DWORD) -1) { + } else if (Tcl_GetErrno() == ENOENT) { + attr = (*tclWinProcs->getFileAttributesProc)(nativePath); + if (attr != 0xffffffff) { if (attr & FILE_ATTRIBUTE_DIRECTORY) { /* * Windows 95 reports removing a directory as ENOENT instead * of EISDIR. */ - errno = EISDIR; + Tcl_SetErrno(EISDIR); } } - } else if (errno == EINVAL) { + } else if (Tcl_GetErrno() == EINVAL) { /* * Windows NT reports removing a char device as EINVAL instead of * EACCES. */ - errno = EACCES; + Tcl_SetErrno(EACCES); } return TCL_ERROR; @@ -542,15 +666,31 @@ TclpDeleteFile( int TclpCreateDirectory( - char *path) /* Pathname of directory to create */ + CONST char *path) /* Pathname of directory to create (UTF-8). */ +{ + int result; + Tcl_DString pathString; + + Tcl_WinUtfToTChar(path, -1, &pathString); + result = DoCreateDirectory(&pathString); + Tcl_DStringFree(&pathString); + return result; +} + +static int +DoCreateDirectory( + Tcl_DString *pathPtr) /* Pathname of directory to create (native). */ { int error; + CONST TCHAR *nativePath; - if (CreateDirectory(path, NULL) == 0) { + nativePath = (TCHAR *) Tcl_DStringValue(pathPtr); + if ((*tclWinProcs->createDirectoryProc)(nativePath, NULL) == 0) { error = GetLastError(); if (TclWinGetPlatformId() == VER_PLATFORM_WIN32s) { if ((error == ERROR_ACCESS_DENIED) - && (GetFileAttributes(path) != (DWORD) -1)) { + && ((*tclWinProcs->getFileAttributesProc)(nativePath) + != 0xffffffff)) { error = ERROR_FILE_EXISTS; } } @@ -588,30 +728,30 @@ TclpCreateDirectory( int TclpCopyDirectory( - char *src, /* Pathname of directory to be copied. */ - char *dst, /* Pathname of target directory. */ - Tcl_DString *errorPtr) /* If non-NULL, initialized DString for - * error reporting. */ + 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 result; - Tcl_DString srcBuffer; - Tcl_DString dstBuffer; - - Tcl_DStringInit(&srcBuffer); - Tcl_DStringInit(&dstBuffer); - Tcl_DStringAppend(&srcBuffer, src, -1); - Tcl_DStringAppend(&dstBuffer, dst, -1); - result = TraverseWinTree(TraversalCopy, &srcBuffer, &dstBuffer, - errorPtr); - Tcl_DStringFree(&srcBuffer); - Tcl_DStringFree(&dstBuffer); + Tcl_DString srcString, dstString; + + Tcl_WinUtfToTChar(src, -1, &srcString); + Tcl_WinUtfToTChar(dst, -1, &dstString); + + result = TraverseWinTree(TraversalCopy, &srcString, &dstString, errorPtr); + + Tcl_DStringFree(&srcString); + Tcl_DStringFree(&dstString); return result; } /* *---------------------------------------------------------------------- * - * TclpRemoveDirectory -- + * TclpRemoveDirectory, DoRemoveDirectory -- * * Removes directory (and its contents, if the recursive flag is set). * @@ -639,52 +779,87 @@ TclpCopyDirectory( int TclpRemoveDirectory( - char *path, /* Pathname of directory to be removed. */ + 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, initialized DString for - * error reporting. */ + Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free + * DString filled with UTF-8 name of file + * causing error. */ { int result; - Tcl_DString buffer; + Tcl_DString pathString; + + Tcl_WinUtfToTChar(path, -1, &pathString); + result = DoRemoveDirectory(&pathString, recursive, errorPtr); + Tcl_DStringFree(&pathString); + + return result; +} + +static int +DoRemoveDirectory( + Tcl_DString *pathPtr, /* Pathname of directory to be removed + * (native). */ + 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. */ +{ + CONST TCHAR *nativePath; DWORD attr; - if (RemoveDirectory(path) != FALSE) { + nativePath = (TCHAR *) Tcl_DStringValue(pathPtr); + + if ((*tclWinProcs->removeDirectoryProc)(nativePath) != FALSE) { return TCL_OK; } TclWinConvertError(GetLastError()); - if (path[0] == '\0') { - /* - * Win32s thinks that "" is the same as "." and then reports EACCES - * instead of ENOENT. - */ - errno = ENOENT; + /* + * Win32s thinks that "" is the same as "." and then reports EACCES + * instead of ENOENT. + */ + + + if (tclWinProcs->useWide) { + if (((WCHAR *) nativePath)[0] == '\0') { + Tcl_SetErrno(ENOENT); + return TCL_ERROR; + } + } else { + if (((char *) nativePath)[0] == '\0') { + Tcl_SetErrno(ENOENT); + return TCL_ERROR; + } } - if (errno == EACCES) { - attr = GetFileAttributes(path); - if (attr != (DWORD) -1) { + if (Tcl_GetErrno() == EACCES) { + attr = (*tclWinProcs->getFileAttributesProc)(nativePath); + if (attr != 0xffffffff) { if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) { /* * Windows 95 reports calling RemoveDirectory on a file as an * EACCES, not an ENOTDIR. */ - errno = ENOTDIR; + Tcl_SetErrno(ENOTDIR); goto end; } if (attr & FILE_ATTRIBUTE_READONLY) { attr &= ~FILE_ATTRIBUTE_READONLY; - if (SetFileAttributes(path, attr) == FALSE) { + if ((*tclWinProcs->setFileAttributesProc)(nativePath, attr) == FALSE) { goto end; } - if (RemoveDirectory(path) != FALSE) { + if ((*tclWinProcs->removeDirectoryProc)(nativePath) != FALSE) { return TCL_OK; } TclWinConvertError(GetLastError()); - SetFileAttributes(path, attr | FILE_ATTRIBUTE_READONLY); + (*tclWinProcs->setFileAttributesProc)(nativePath, + attr | FILE_ATTRIBUTE_READONLY); } /* @@ -694,20 +869,22 @@ TclpRemoveDirectory( */ if (TclWinGetPlatformId() != VER_PLATFORM_WIN32_NT) { + char *path, *find; HANDLE handle; - WIN32_FIND_DATA data; + WIN32_FIND_DATAA data; Tcl_DString buffer; - char *find; int len; + path = (char *) nativePath; + Tcl_DStringInit(&buffer); - find = Tcl_DStringAppend(&buffer, path, -1); - len = Tcl_DStringLength(&buffer); + len = strlen(path); + find = Tcl_DStringAppend(&buffer, path, len); if ((len > 0) && (find[len - 1] != '\\')) { Tcl_DStringAppend(&buffer, "\\", 1); } find = Tcl_DStringAppend(&buffer, "*.*", 3); - handle = FindFirstFile(find, &data); + handle = FindFirstFileA(find, &data); if (handle != INVALID_HANDLE_VALUE) { while (1) { if ((strcmp(data.cFileName, ".") != 0) @@ -716,10 +893,10 @@ TclpRemoveDirectory( * Found something in this directory. */ - errno = EEXIST; + Tcl_SetErrno(EEXIST); break; } - if (FindNextFile(handle, &data) == FALSE) { + if (FindNextFileA(handle, &data) == FALSE) { break; } } @@ -729,30 +906,26 @@ TclpRemoveDirectory( } } } - if (errno == ENOTEMPTY) { + if (Tcl_GetErrno() == ENOTEMPTY) { /* * The caller depends on EEXIST to signify that the directory is * not empty, not ENOTEMPTY. */ - errno = EEXIST; + Tcl_SetErrno(EEXIST); } - if ((recursive != 0) && (errno == EEXIST)) { + if ((recursive != 0) && (Tcl_GetErrno() == EEXIST)) { /* * The directory is nonempty, but the recursive flag has been * specified, so we recursively remove all the files in the directory. */ - Tcl_DStringInit(&buffer); - Tcl_DStringAppend(&buffer, path, -1); - result = TraverseWinTree(TraversalDelete, &buffer, NULL, errorPtr); - Tcl_DStringFree(&buffer); - return result; + return TraverseWinTree(TraversalDelete, pathPtr, NULL, errorPtr); } - + end: if (errorPtr != NULL) { - Tcl_DStringAppend(errorPtr, path, -1); + Tcl_WinTCharToUtf(nativePath, -1, errorPtr); } return TCL_ERROR; } @@ -784,34 +957,28 @@ TraverseWinTree( TraversalProc *traverseProc,/* Function to call for every file and * directory in source hierarchy. */ Tcl_DString *sourcePtr, /* Pathname of source directory to be - * traversed. */ + * traversed (native). */ Tcl_DString *targetPtr, /* Pathname of directory to traverse in - * parallel with source directory. */ - Tcl_DString *errorPtr) /* If non-NULL, an initialized DString for - * error reporting. */ + * parallel with source directory (native). */ + Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free + * DString filled with UTF-8 name of file + * causing error. */ { DWORD sourceAttr; - char *source, *target, *errfile; - int result, sourceLen, targetLen, sourceLenOriginal, targetLenOriginal; + TCHAR *nativeSource, *nativeErrfile; + int result, found, sourceLen, targetLen, oldSourceLen, oldTargetLen; HANDLE handle; - WIN32_FIND_DATA data; + WIN32_FIND_DATAT data; + nativeErrfile = NULL; result = TCL_OK; - source = Tcl_DStringValue(sourcePtr); - sourceLenOriginal = Tcl_DStringLength(sourcePtr); - if (targetPtr != NULL) { - target = Tcl_DStringValue(targetPtr); - targetLenOriginal = Tcl_DStringLength(targetPtr); - } else { - target = NULL; - targetLenOriginal = 0; - } - - errfile = NULL; + oldTargetLen = 0; /* lint. */ - sourceAttr = GetFileAttributes(source); - if (sourceAttr == (DWORD) -1) { - errfile = source; + nativeSource = (TCHAR *) Tcl_DStringValue(sourcePtr); + oldSourceLen = Tcl_DStringLength(sourcePtr); + sourceAttr = (*tclWinProcs->getFileAttributesProc)(nativeSource); + if (sourceAttr == 0xffffffff) { + nativeErrfile = nativeSource; goto end; } if ((sourceAttr & FILE_ATTRIBUTE_DIRECTORY) == 0) { @@ -819,76 +986,112 @@ TraverseWinTree( * Process the regular file */ - return (*traverseProc)(source, target, sourceAttr, DOTREE_F, errorPtr); + return (*traverseProc)(sourcePtr, targetPtr, DOTREE_F, errorPtr); } - /* - * When given the pathname of the form "c:\" (one that already ends - * with a backslash), must make sure not to add another "\" to the end - * otherwise it will try to access a network drive. - */ - - sourceLen = sourceLenOriginal; - if ((sourceLen > 0) && (source[sourceLen - 1] != '\\')) { - Tcl_DStringAppend(sourcePtr, "\\", 1); - sourceLen++; + if (tclWinProcs->useWide) { + Tcl_DStringAppend(sourcePtr, (char *) L"\\*.*", 4 * sizeof(WCHAR) + 1); + Tcl_DStringSetLength(sourcePtr, Tcl_DStringLength(sourcePtr) - 1); + } else { + Tcl_DStringAppend(sourcePtr, "\\*.*", 4); } - source = Tcl_DStringAppend(sourcePtr, "*.*", 3); - handle = FindFirstFile(source, &data); - Tcl_DStringSetLength(sourcePtr, sourceLen); - if (handle == INVALID_HANDLE_VALUE) { + nativeSource = (TCHAR *) Tcl_DStringValue(sourcePtr); + handle = (*tclWinProcs->findFirstFileProc)(nativeSource, &data); + if (handle == INVALID_HANDLE_VALUE) { /* * Can't read directory */ TclWinConvertError(GetLastError()); - errfile = source; + nativeErrfile = nativeSource; goto end; } - result = (*traverseProc)(source, target, sourceAttr, DOTREE_PRED, errorPtr); + nativeSource[oldSourceLen + 1] = '\0'; + Tcl_DStringSetLength(sourcePtr, oldSourceLen); + result = (*traverseProc)(sourcePtr, targetPtr, DOTREE_PRED, errorPtr); if (result != TCL_OK) { FindClose(handle); return result; } + sourceLen = oldSourceLen; + + if (tclWinProcs->useWide) { + sourceLen += sizeof(WCHAR); + Tcl_DStringAppend(sourcePtr, (char *) L"\\", sizeof(WCHAR) + 1); + Tcl_DStringSetLength(sourcePtr, sourceLen); + } else { + sourceLen += 1; + Tcl_DStringAppend(sourcePtr, "\\", 1); + } if (targetPtr != NULL) { - targetLen = targetLenOriginal; - if ((targetLen > 0) && (target[targetLen - 1] != '\\')) { - target = Tcl_DStringAppend(targetPtr, "\\", 1); - targetLen++; + oldTargetLen = Tcl_DStringLength(targetPtr); + + targetLen = oldTargetLen; + if (tclWinProcs->useWide) { + targetLen += sizeof(WCHAR); + Tcl_DStringAppend(targetPtr, (char *) L"\\", sizeof(WCHAR) + 1); + Tcl_DStringSetLength(targetPtr, targetLen); + } else { + targetLen += 1; + Tcl_DStringAppend(targetPtr, "\\", 1); } } - while (1) { - if ((strcmp(data.cFileName, ".") != 0) - && (strcmp(data.cFileName, "..") != 0)) { - /* - * Append name after slash, and recurse on the file. - */ + found = 1; + for ( ; found; found = (*tclWinProcs->findNextFileProc)(handle, &data)) { + TCHAR *nativeName; + int len; + + if (tclWinProcs->useWide) { + WCHAR *wp; - Tcl_DStringAppend(sourcePtr, data.cFileName, -1); - if (targetPtr != NULL) { - Tcl_DStringAppend(targetPtr, data.cFileName, -1); + wp = data.w.cFileName; + if (*wp == '.') { + wp++; + if (*wp == '.') { + wp++; + } + if (*wp == '\0') { + continue; + } } - result = TraverseWinTree(traverseProc, sourcePtr, targetPtr, - errorPtr); - if (result != TCL_OK) { - break; + nativeName = (TCHAR *) data.w.cFileName; + len = TclUniCharLen(data.w.cFileName) * sizeof(WCHAR); + } else { + if ((strcmp(data.a.cFileName, ".") == 0) + || (strcmp(data.a.cFileName, "..") == 0)) { + continue; } + nativeName = (TCHAR *) data.a.cFileName; + len = strlen(data.a.cFileName); + } - /* - * Remove name after slash. - */ + /* + * Append name after slash, and recurse on the file. + */ - Tcl_DStringSetLength(sourcePtr, sourceLen); - if (targetPtr != NULL) { - Tcl_DStringSetLength(targetPtr, targetLen); - } + Tcl_DStringAppend(sourcePtr, (char *) nativeName, len + 1); + Tcl_DStringSetLength(sourcePtr, Tcl_DStringLength(sourcePtr) - 1); + if (targetPtr != NULL) { + Tcl_DStringAppend(targetPtr, (char *) nativeName, len + 1); + Tcl_DStringSetLength(targetPtr, Tcl_DStringLength(targetPtr) - 1); } - if (FindNextFile(handle, &data) == FALSE) { + result = TraverseWinTree(traverseProc, sourcePtr, targetPtr, + errorPtr); + if (result != TCL_OK) { break; } + + /* + * Remove name after slash. + */ + + Tcl_DStringSetLength(sourcePtr, sourceLen); + if (targetPtr != NULL) { + Tcl_DStringSetLength(targetPtr, targetLen); + } } FindClose(handle); @@ -896,27 +1099,26 @@ TraverseWinTree( * Strip off the trailing slash we added */ - Tcl_DStringSetLength(sourcePtr, sourceLenOriginal); - source = Tcl_DStringValue(sourcePtr); + Tcl_DStringSetLength(sourcePtr, oldSourceLen + 1); + Tcl_DStringSetLength(sourcePtr, oldSourceLen); if (targetPtr != NULL) { - Tcl_DStringSetLength(targetPtr, targetLenOriginal); - target = Tcl_DStringValue(targetPtr); + Tcl_DStringSetLength(targetPtr, oldTargetLen + 1); + Tcl_DStringSetLength(targetPtr, oldTargetLen); } - if (result == TCL_OK) { /* * Call traverseProc() on a directory after visiting all the * files in that directory. */ - result = (*traverseProc)(source, target, sourceAttr, - DOTREE_POSTD, errorPtr); + result = (*traverseProc)(sourcePtr, targetPtr, DOTREE_POSTD, + errorPtr); } end: - if (errfile != NULL) { + if (nativeErrfile != NULL) { TclWinConvertError(GetLastError()); if (errorPtr != NULL) { - Tcl_DStringAppend(errorPtr, errfile, -1); + Tcl_WinTCharToUtf(nativeErrfile, -1, errorPtr); } result = TCL_ERROR; } @@ -943,32 +1145,37 @@ TraverseWinTree( static int TraversalCopy( - char *src, /* Source pathname to copy. */ - char *dst, /* Destination pathname of copy. */ - DWORD srcAttr, /* File attributes for src. */ + Tcl_DString *srcPtr, /* Source pathname to copy. */ + Tcl_DString *dstPtr, /* Destination pathname of copy. */ int type, /* Reason for call - see TraverseWinTree() */ - Tcl_DString *errorPtr) /* If non-NULL, initialized DString for - * error return. */ + Tcl_DString *errorPtr) /* If non-NULL, initialized DString filled + * with UTF-8 name of file causing error. */ { + TCHAR *nativeDst, *nativeSrc; + DWORD attr; + switch (type) { - case DOTREE_F: - if (TclpCopyFile(src, dst) == TCL_OK) { + case DOTREE_F: { + if (DoCopyFile(srcPtr, dstPtr) == TCL_OK) { return TCL_OK; } break; - - case DOTREE_PRED: - if (TclpCreateDirectory(dst) == TCL_OK) { - if (SetFileAttributes(dst, srcAttr) != FALSE) { + } + case DOTREE_PRED: { + if (DoCreateDirectory(dstPtr) == TCL_OK) { + nativeSrc = (TCHAR *) Tcl_DStringValue(srcPtr); + nativeDst = (TCHAR *) Tcl_DStringValue(dstPtr); + attr = (*tclWinProcs->getFileAttributesProc)(nativeSrc); + if ((*tclWinProcs->setFileAttributesProc)(nativeDst, attr) != FALSE) { return TCL_OK; } TclWinConvertError(GetLastError()); } break; - - case DOTREE_POSTD: + } + case DOTREE_POSTD: { return TCL_OK; - + } } /* @@ -977,7 +1184,8 @@ TraversalCopy( */ if (errorPtr != NULL) { - Tcl_DStringAppend(errorPtr, dst, -1); + nativeDst = (TCHAR *) Tcl_DStringValue(dstPtr); + Tcl_WinTCharToUtf(nativeDst, -1, errorPtr); } return TCL_ERROR; } @@ -1005,33 +1213,35 @@ TraversalCopy( static int TraversalDelete( - char *src, /* Source pathname. */ - char *ignore, /* Destination pathname (not used). */ - DWORD srcAttr, /* File attributes for src (not used). */ - int type, /* Reason for call - see TraverseWinTree(). */ - Tcl_DString *errorPtr) /* If non-NULL, initialized DString for - * error return. */ + Tcl_DString *srcPtr, /* Source pathname to delete. */ + Tcl_DString *dstPtr, /* Not used. */ + int type, /* Reason for call - see TraverseWinTree() */ + Tcl_DString *errorPtr) /* If non-NULL, initialized DString filled + * with UTF-8 name of file causing error. */ { + TCHAR *nativeSrc; + switch (type) { - case DOTREE_F: - if (TclpDeleteFile(src) == TCL_OK) { + case DOTREE_F: { + if (DoDeleteFile(srcPtr) == TCL_OK) { return TCL_OK; } break; - - case DOTREE_PRED: + } + case DOTREE_PRED: { return TCL_OK; - - case DOTREE_POSTD: - if (TclpRemoveDirectory(src, 0, NULL) == TCL_OK) { + } + case DOTREE_POSTD: { + if (DoRemoveDirectory(srcPtr, 0, NULL) == TCL_OK) { return TCL_OK; } break; - + } } if (errorPtr != NULL) { - Tcl_DStringAppend(errorPtr, src, -1); + nativeSrc = (TCHAR *) Tcl_DStringValue(srcPtr); + Tcl_WinTCharToUtf(nativeSrc, -1, errorPtr); } return TCL_ERROR; } @@ -1039,7 +1249,7 @@ TraversalDelete( /* *---------------------------------------------------------------------- * - * AttributesPosixError -- + * StatError -- * * Sets the object result with the appropriate error. * @@ -1054,18 +1264,15 @@ TraversalDelete( */ static void -AttributesPosixError( +StatError( Tcl_Interp *interp, /* The interp that has the error */ - int objIndex, /* The attribute which caused the problem. */ - char *fileName, /* The name of the file which caused the + CONST char *fileName) /* The name of the file which caused the * error. */ - int getOrSet) /* 0 for get; 1 for set */ { TclWinConvertError(GetLastError()); Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), - "cannot ", getOrSet ? "set" : "get", " attribute \"", - tclpFileAttrStrings[objIndex], "\" for file \"", fileName, - "\": ", Tcl_PosixError(interp), (char *) NULL); + "could not read \"", fileName, "\": ", Tcl_PosixError(interp), + (char *) NULL); } /* @@ -1089,15 +1296,21 @@ AttributesPosixError( static int GetWinFileAttributes( - Tcl_Interp *interp, /* The interp we are using for errors. */ - int objIndex, /* The index of the attribute. */ - char *fileName, /* The name of the file. */ - Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ + Tcl_Interp *interp, /* The interp we are using for errors. */ + int objIndex, /* The index of the attribute. */ + CONST char *fileName, /* The name of the file. */ + Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ { - DWORD result = GetFileAttributes(fileName); + DWORD result; + Tcl_DString ds; + TCHAR *nativeName; + + nativeName = Tcl_WinUtfToTChar(fileName, -1, &ds); + result = (*tclWinProcs->getFileAttributesProc)(nativeName); + Tcl_DStringFree(&ds); - if (result == 0xFFFFFFFF) { - AttributesPosixError(interp, objIndex, fileName, 0); + if (result == 0xffffffff) { + StatError(interp, fileName); return TCL_ERROR; } @@ -1126,87 +1339,129 @@ GetWinFileAttributes( static int ConvertFileNameFormat( - Tcl_Interp *interp, /* The interp we are using for errors. */ - int objIndex, /* The index of the attribute. */ - char *fileName, /* The name of the file. */ - int longShort, /* 0 to short name, 1 to long name. */ - Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ + Tcl_Interp *interp, /* The interp we are using for errors. */ + int objIndex, /* The index of the attribute. */ + CONST char *fileName, /* The name of the file. */ + int longShort, /* 0 to short name, 1 to long name. */ + Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ { - HANDLE findHandle; - WIN32_FIND_DATA findData; - int pathArgc, i; - char **pathArgv, **newPathArgv; - char *currentElement, *resultStr; + int pathc, i; + char **pathv, **newv; + char *resultStr; Tcl_DString resultDString; int result = TCL_OK; - Tcl_SplitPath(fileName, &pathArgc, &pathArgv); - newPathArgv = (char **) ckalloc(pathArgc * sizeof(char *)); - - i = 0; - if ((pathArgv[0][0] == '/') - || ((strlen(pathArgv[0]) == 3) && (pathArgv[0][1] == ':'))) { - newPathArgv[0] = (char *) ckalloc(strlen(pathArgv[0]) + 1); - strcpy(newPathArgv[0], pathArgv[0]); - i = 1; - } - for ( ; i < pathArgc; i++) { - if (strcmp(pathArgv[i], ".") == 0) { - currentElement = ckalloc(2); - strcpy(currentElement, "."); - } else if (strcmp(pathArgv[i], "..") == 0) { - currentElement = ckalloc(3); - strcpy(currentElement, ".."); + Tcl_SplitPath(fileName, &pathc, &pathv); + newv = (char **) ckalloc(pathc * sizeof(char *)); + + for (i = 0; i < pathc; i++) { + if ((pathv[i][0] == '/') + || ((strlen(pathv[i]) == 3) && (pathv[i][1] == ':')) + || (strcmp(pathv[i], ".") == 0) + || (strcmp(pathv[i], "..") == 0)) { + /* + * Handle "/", "//machine/export", "c:/", "." or ".." by just + * copying the string literally. Uppercase the drive letter, + * just because it looks better under Windows to do so. + */ + + simple: + pathv[i][0] = (char) Tcl_UniCharToUpper(UCHAR(pathv[i][0])); + newv[i] = (char *) ckalloc(strlen(pathv[i]) + 1); + lstrcpyA(newv[i], pathv[i]); } else { - int useLong; + char *str; + TCHAR *nativeName; + Tcl_DString ds; + WIN32_FIND_DATAT data; + HANDLE handle; + DWORD attr; Tcl_DStringInit(&resultDString); - resultStr = Tcl_JoinPath(i + 1, pathArgv, &resultDString); - findHandle = FindFirstFile(resultStr, &findData); - if (findHandle == INVALID_HANDLE_VALUE) { - pathArgc = i - 1; - AttributesPosixError(interp, objIndex, fileName, 0); + str = Tcl_JoinPath(i + 1, pathv, &resultDString); + nativeName = Tcl_WinUtfToTChar(str, -1, &ds); + handle = (*tclWinProcs->findFirstFileProc)(nativeName, &data); + if (handle == INVALID_HANDLE_VALUE) { + /* + * FindFirstFile() doesn't like root directories. We + * would only get a root directory here if the caller + * specified "c:" or "c:." and the current directory on the + * drive was the root directory + */ + + attr = (*tclWinProcs->getFileAttributesProc)(nativeName); + if ((attr != 0xFFFFFFFF) && (attr & FILE_ATTRIBUTE_DIRECTORY)) { + Tcl_DStringFree(&ds); + Tcl_DStringFree(&resultDString); + + goto simple; + } + } + Tcl_DStringFree(&ds); + Tcl_DStringFree(&resultDString); + + if (handle == INVALID_HANDLE_VALUE) { + pathc = i - 1; + StatError(interp, fileName); result = TCL_ERROR; - Tcl_DStringFree(&resultDString); goto cleanup; } - if (longShort) { - if (findData.cFileName[0] != '\0') { - useLong = 1; + if (tclWinProcs->useWide) { + nativeName = (TCHAR *) data.w.cAlternateFileName; + if (longShort) { + if (data.w.cFileName[0] != '\0') { + nativeName = (TCHAR *) data.w.cFileName; + } } else { - useLong = 0; + if (data.w.cAlternateFileName[0] == '\0') { + nativeName = (TCHAR *) data.w.cFileName; + } } } else { - if (findData.cAlternateFileName[0] == '\0') { - useLong = 1; + nativeName = (TCHAR *) data.a.cAlternateFileName; + if (longShort) { + if (data.a.cFileName[0] != '\0') { + nativeName = (TCHAR *) data.a.cFileName; + } } else { - useLong = 0; + if (data.a.cAlternateFileName[0] == '\0') { + nativeName = (TCHAR *) data.a.cFileName; + } } } - if (useLong) { - currentElement = ckalloc(strlen(findData.cFileName) + 1); - strcpy(currentElement, findData.cFileName); - } else { - currentElement = ckalloc(strlen(findData.cAlternateFileName) - + 1); - strcpy(currentElement, findData.cAlternateFileName); - } - Tcl_DStringFree(&resultDString); - FindClose(findHandle); + + /* + * Purify reports a extraneous UMR in Tcl_WinTCharToUtf() trying + * to dereference nativeName as a Unicode string. I have proven + * to myself that purify is wrong by running the following + * example when nativeName == data.w.cAlternateFileName and + * noting that purify doesn't complain about the first line, + * but does complain about the second. + * + * fprintf(stderr, "%d\n", data.w.cAlternateFileName[0]); + * fprintf(stderr, "%d\n", ((WCHAR *) nativeName)[0]); + */ + + Tcl_WinTCharToUtf(nativeName, -1, &ds); + newv[i] = ckalloc(Tcl_DStringLength(&ds) + 1); + lstrcpyA(newv[i], Tcl_DStringValue(&ds)); + Tcl_DStringFree(&ds); + FindClose(handle); } - newPathArgv[i] = currentElement; } Tcl_DStringInit(&resultDString); - resultStr = Tcl_JoinPath(pathArgc, newPathArgv, &resultDString); - *attributePtrPtr = Tcl_NewStringObj(resultStr, Tcl_DStringLength(&resultDString)); + resultStr = Tcl_JoinPath(pathc, newv, &resultDString); + *attributePtrPtr = Tcl_NewStringObj(resultStr, + Tcl_DStringLength(&resultDString)); Tcl_DStringFree(&resultDString); cleanup: - for (i = 0; i < pathArgc; i++) { - ckfree(newPathArgv[i]); + for (i = 0; i < pathc; i++) { + ckfree(newv[i]); } - ckfree((char *) newPathArgv); + ckfree((char *) newv); + ckfree((char *) pathv); return result; } @@ -1231,10 +1486,10 @@ cleanup: static int GetWinFileLongName( - Tcl_Interp *interp, /* The interp we are using for errors. */ - int objIndex, /* The index of the attribute. */ - char *fileName, /* The name of the file. */ - Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ + Tcl_Interp *interp, /* The interp we are using for errors. */ + int objIndex, /* The index of the attribute. */ + CONST char *fileName, /* The name of the file. */ + Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ { return ConvertFileNameFormat(interp, objIndex, fileName, 1, attributePtrPtr); } @@ -1260,10 +1515,10 @@ GetWinFileLongName( static int GetWinFileShortName( - Tcl_Interp *interp, /* The interp we are using for errors. */ - int objIndex, /* The index of the attribute. */ - char *fileName, /* The name of the file. */ - Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ + Tcl_Interp *interp, /* The interp we are using for errors. */ + int objIndex, /* The index of the attribute. */ + CONST char *fileName, /* The name of the file. */ + Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ { return ConvertFileNameFormat(interp, objIndex, fileName, 0, attributePtrPtr); } @@ -1287,23 +1542,29 @@ GetWinFileShortName( static int SetWinFileAttributes( - Tcl_Interp *interp, /* The interp we are using for errors. */ - int objIndex, /* The index of the attribute. */ - char *fileName, /* The name of the file. */ - Tcl_Obj *attributePtr) /* The new value of the attribute. */ + Tcl_Interp *interp, /* The interp we are using for errors. */ + int objIndex, /* The index of the attribute. */ + CONST char *fileName, /* The name of the file. */ + Tcl_Obj *attributePtr) /* The new value of the attribute. */ { - DWORD fileAttributes = GetFileAttributes(fileName); + DWORD fileAttributes; int yesNo; int result; + Tcl_DString ds; + TCHAR *nativeName; - if (fileAttributes == 0xFFFFFFFF) { - AttributesPosixError(interp, objIndex, fileName, 1); - return TCL_ERROR; + nativeName = Tcl_WinUtfToTChar(fileName, -1, &ds); + fileAttributes = (*tclWinProcs->getFileAttributesProc)(nativeName); + + if (fileAttributes == 0xffffffff) { + StatError(interp, fileName); + result = TCL_ERROR; + goto end; } result = Tcl_GetBooleanFromObj(interp, attributePtr, &yesNo); if (result != TCL_OK) { - return result; + goto end; } if (yesNo) { @@ -1312,11 +1573,16 @@ SetWinFileAttributes( fileAttributes &= ~(attributeArray[objIndex]); } - if (!SetFileAttributes(fileName, fileAttributes)) { - AttributesPosixError(interp, objIndex, fileName, 1); - return TCL_ERROR; + if (!(*tclWinProcs->setFileAttributesProc)(nativeName, fileAttributes)) { + StatError(interp, fileName); + result = TCL_ERROR; + goto end; } - return TCL_OK; + + end: + Tcl_DStringFree(&ds); + + return result; } /* @@ -1338,14 +1604,14 @@ SetWinFileAttributes( static int CannotSetAttribute( - Tcl_Interp *interp, /* The interp we are using for errors. */ - int objIndex, /* The index of the attribute. */ - char *fileName, /* The name of the file. */ - Tcl_Obj *attributePtr) /* The new value of the attribute. */ + Tcl_Interp *interp, /* The interp we are using for errors. */ + int objIndex, /* The index of the attribute. */ + CONST char *fileName, /* The name of the file. */ + Tcl_Obj *attributePtr) /* The new value of the attribute. */ { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "cannot set attribute \"", tclpFileAttrStrings[objIndex], - "\" for file \"", fileName, "\" : attribute is readonly", + "\" for file \"", fileName, "\": attribute is readonly", (char *) NULL); return TCL_ERROR; } @@ -1371,29 +1637,47 @@ CannotSetAttribute( int TclpListVolumes( - Tcl_Interp *interp) /* Interpreter to which to pass the volume list */ + Tcl_Interp *interp) /* Interpreter for returning volume list. */ { Tcl_Obj *resultPtr, *elemPtr; - char buf[4]; + char buf[40 * 4]; /* There couldn't be more than 30 drives??? */ int i; + char *p; resultPtr = Tcl_GetObjResult(interp); - buf[1] = ':'; - buf[2] = '/'; - buf[3] = '\0'; - /* - * On Win32s: + * On Win32s: * GetLogicalDriveStrings() isn't implemented. * GetLogicalDrives() returns incorrect information. */ - for (i = 0; i < 26; i++) { - buf[0] = (char) ('a' + i); - if (GetVolumeInformation(buf, NULL, 0, NULL, NULL, NULL, NULL, 0) - || (GetLastError() == ERROR_NOT_READY)) { - elemPtr = Tcl_NewStringObj(buf, -1); + if (GetLogicalDriveStringsA(sizeof(buf), buf) == 0) { + /* + * GetVolumeInformation() will detects all drives, but causes + * chattering on empty floppy drives. We only do this if + * GetLogicalDriveStrings() didn't work. It has also been reported + * that on some laptops it takes a while for GetVolumeInformation() + * to return when pinging an empty floppy drive, another reason to + * try to avoid calling it. + */ + + buf[1] = ':'; + buf[2] = '/'; + buf[3] = '\0'; + + for (i = 0; i < 26; i++) { + buf[0] = (char) ('a' + i); + if (GetVolumeInformationA(buf, NULL, 0, NULL, NULL, NULL, NULL, 0) + || (GetLastError() == ERROR_NOT_READY)) { + elemPtr = Tcl_NewStringObj(buf, -1); + Tcl_ListObjAppendElement(NULL, resultPtr, elemPtr); + } + } + } else { + for (p = buf; *p != '\0'; p += 4) { + p[2] = '/'; + elemPtr = Tcl_NewStringObj(p, -1); Tcl_ListObjAppendElement(NULL, resultPtr, elemPtr); } } |