diff options
Diffstat (limited to 'win/tclWinFCmd.c')
| -rw-r--r-- | win/tclWinFCmd.c | 1629 |
1 files changed, 784 insertions, 845 deletions
diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c index 1821f8f..52ea8c6 100644 --- a/win/tclWinFCmd.c +++ b/win/tclWinFCmd.c @@ -1,15 +1,13 @@ /* * tclWinFCmd.c * - * This file implements the Windows specific portion of file manipulation - * subcommands of the "file" command. + * This file implements the Windows specific portion of file manipulation + * subcommands of the "file" command. * * 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. - * - * RCS: @(#) $Id: tclWinFCmd.c,v 1.43 2004/10/06 16:37:18 dgp Exp $ + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclWinInt.h" @@ -19,30 +17,25 @@ * TraverseWinTree() calls the traverseProc() */ -#define DOTREE_PRED 1 /* pre-order directory */ -#define DOTREE_POSTD 2 /* post-order directory */ -#define DOTREE_F 3 /* regular file */ -#define DOTREE_LINK 4 /* symbolic link */ +#define DOTREE_PRED 1 /* pre-order directory */ +#define DOTREE_POSTD 2 /* post-order directory */ +#define DOTREE_F 3 /* regular file */ +#define DOTREE_LINK 4 /* symbolic link */ /* * Callbacks for file attributes code. */ -static int GetWinFileAttributes _ANSI_ARGS_((Tcl_Interp *interp, - int objIndex, Tcl_Obj *fileName, - Tcl_Obj **attributePtrPtr)); -static int GetWinFileLongName _ANSI_ARGS_((Tcl_Interp *interp, - int objIndex, Tcl_Obj *fileName, - Tcl_Obj **attributePtrPtr)); -static int GetWinFileShortName _ANSI_ARGS_((Tcl_Interp *interp, - int objIndex, Tcl_Obj *fileName, - Tcl_Obj **attributePtrPtr)); -static int SetWinFileAttributes _ANSI_ARGS_((Tcl_Interp *interp, - int objIndex, Tcl_Obj *fileName, - Tcl_Obj *attributePtr)); -static int CannotSetAttribute _ANSI_ARGS_((Tcl_Interp *interp, - int objIndex, Tcl_Obj *fileName, - Tcl_Obj *attributePtr)); +static int GetWinFileAttributes(Tcl_Interp *interp, int objIndex, + Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); +static int GetWinFileLongName(Tcl_Interp *interp, int objIndex, + Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); +static int GetWinFileShortName(Tcl_Interp *interp, int objIndex, + Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); +static int SetWinFileAttributes(Tcl_Interp *interp, int objIndex, + Tcl_Obj *fileName, Tcl_Obj *attributePtr); +static int CannotSetAttribute(Tcl_Interp *interp, int objIndex, + Tcl_Obj *fileName, Tcl_Obj *attributePtr); /* * Constants and variables necessary for file attributes subcommand. @@ -57,16 +50,16 @@ enum { WIN_SYSTEM_ATTRIBUTE }; -static int attributeArray[] = {FILE_ATTRIBUTE_ARCHIVE, FILE_ATTRIBUTE_HIDDEN, +static const int attributeArray[] = {FILE_ATTRIBUTE_ARCHIVE, FILE_ATTRIBUTE_HIDDEN, 0, FILE_ATTRIBUTE_READONLY, 0, FILE_ATTRIBUTE_SYSTEM}; -CONST char *tclpFileAttrStrings[] = { +const char *const tclpFileAttrStrings[] = { "-archive", "-hidden", "-longname", "-readonly", "-shortname", "-system", (char *) NULL }; -CONST TclFileAttrProcs tclpFileAttrProcs[] = { +const TclFileAttrProcs tclpFileAttrProcs[] = { {GetWinFileAttributes, SetWinFileAttributes}, {GetWinFileAttributes, SetWinFileAttributes}, {GetWinFileLongName, CannotSetAttribute}, @@ -74,131 +67,104 @@ CONST TclFileAttrProcs tclpFileAttrProcs[] = { {GetWinFileShortName, CannotSetAttribute}, {GetWinFileAttributes, SetWinFileAttributes}}; -#if defined(HAVE_NO_SEH) && defined(TCL_MEM_DEBUG) -static void *INITIAL_ESP, - *INITIAL_EBP, - *INITIAL_HANDLER, - *RESTORED_ESP, - *RESTORED_EBP, - *RESTORED_HANDLER; -#endif /* HAVE_NO_SEH && TCL_MEM_DEBUG */ - -#ifdef HAVE_NO_SEH -static -__attribute__ ((cdecl)) -EXCEPTION_DISPOSITION -_except_dorenamefile_handler( - struct _EXCEPTION_RECORD *ExceptionRecord, - void *EstablisherFrame, - struct _CONTEXT *ContextRecord, - void *DispatcherContext); - -static -__attribute__ ((cdecl)) -EXCEPTION_DISPOSITION -_except_docopyfile_handler( - struct _EXCEPTION_RECORD *ExceptionRecord, - void *EstablisherFrame, - struct _CONTEXT *ContextRecord, - void *DispatcherContext); - -#endif /* HAVE_NO_SEH */ - /* * Prototype for the TraverseWinTree callback function. */ -typedef int (TraversalProc)(CONST TCHAR *srcPtr, CONST TCHAR *dstPtr, +typedef int (TraversalProc)(const TCHAR *srcPtr, const TCHAR *dstPtr, int type, Tcl_DString *errorPtr); /* - * Declarations for local procedures defined in this file: + * Declarations for local functions defined in this file: */ static void StatError(Tcl_Interp *interp, Tcl_Obj *fileName); -static int ConvertFileNameFormat(Tcl_Interp *interp, +static int ConvertFileNameFormat(Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, int longShort, Tcl_Obj **attributePtrPtr); -static int DoCopyFile(CONST TCHAR *srcPtr, CONST TCHAR *dstPtr); -static int DoCreateDirectory(CONST TCHAR *pathPtr); -static int DoRemoveJustDirectory(CONST TCHAR *nativeSrc, +static int DoCopyFile(const TCHAR *srcPtr, const TCHAR *dstPtr); +static int DoCreateDirectory(const TCHAR *pathPtr); +static int DoRemoveJustDirectory(const TCHAR *nativeSrc, int ignoreError, Tcl_DString *errorPtr); -static int DoRemoveDirectory(Tcl_DString *pathPtr, int recursive, +static int DoRemoveDirectory(Tcl_DString *pathPtr, int recursive, Tcl_DString *errorPtr); -static int DoRenameFile(CONST TCHAR *nativeSrc, CONST TCHAR *dstPtr); -static int TraversalCopy(CONST TCHAR *srcPtr, CONST TCHAR *dstPtr, - int type, Tcl_DString *errorPtr); -static int TraversalDelete(CONST TCHAR *srcPtr, CONST TCHAR *dstPtr, +static int DoRenameFile(const TCHAR *nativeSrc, + const TCHAR *dstPtr); +static int TraversalCopy(const TCHAR *srcPtr, const TCHAR *dstPtr, int type, Tcl_DString *errorPtr); +static int TraversalDelete(const TCHAR *srcPtr, + const TCHAR *dstPtr, int type, + Tcl_DString *errorPtr); static int TraverseWinTree(TraversalProc *traverseProc, - Tcl_DString *sourcePtr, Tcl_DString *dstPtr, + Tcl_DString *sourcePtr, Tcl_DString *dstPtr, Tcl_DString *errorPtr); - /* *--------------------------------------------------------------------------- * * 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 - * and returns success. Otherwise if dst already exists, it will be - * deleted and replaced by src subject to the following conditions: + * 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 and + * returns success. Otherwise if dst already exists, it will be deleted + * and replaced by src subject to the following conditions: * If src is a directory, dst may be an empty directory. * If src is a file, dst may be a file. - * In any other situation where dst already exists, the rename will - * fail. + * In any other situation where dst already exists, the rename will fail. * * Results: * 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: + * 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. + * 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. * EISDIR: dst is a directory, but src is not. - * ENOENT: src doesn't exist. src or dst is "". - * ENOTDIR: src is a directory, but dst is not. + * ENOENT: src doesn't exist. src or dst is "". + * ENOTDIR: src is a directory, but dst is not. * EXDEV: src and dst are on different filesystems. * - * EACCES: exists an open file already referring to src or dst. - * EACCES: src or dst specify the current working directory (NT). - * EACCES: src specifies a char device (nul:, com1:, etc.) + * EACCES: exists an open file already referring to src or dst. + * EACCES: src or dst specify the current working directory (NT). + * EACCES: src specifies a char device (nul:, com1:, etc.) * EEXIST: dst specifies a char device (nul:, com1:, etc.) (NT) * EACCES: dst specifies a char device (nul:, com1:, etc.) (95) - * + * * Side effects: - * The implementation supports cross-filesystem renames of files, - * but the caller should be prepared to emulate cross-filesystem - * renames of directories if errno is EXDEV. + * The implementation supports cross-filesystem renames of files, but the + * caller should be prepared to emulate cross-filesystem renames of + * directories if errno is EXDEV. * *--------------------------------------------------------------------------- */ -int -TclpObjRenameFile(srcPathPtr, destPathPtr) - Tcl_Obj *srcPathPtr; - Tcl_Obj *destPathPtr; +int +TclpObjRenameFile( + Tcl_Obj *srcPathPtr, + Tcl_Obj *destPathPtr) { - return DoRenameFile(Tcl_FSGetNativePath(srcPathPtr), - Tcl_FSGetNativePath(destPathPtr)); + return DoRenameFile(Tcl_FSGetNativePath(srcPathPtr), + Tcl_FSGetNativePath(destPathPtr)); } static int DoRenameFile( - CONST TCHAR *nativeSrc, /* Pathname of file or dir to be renamed - * (native). */ - CONST TCHAR *nativeDst) /* New pathname for file or directory + const TCHAR *nativeSrc, /* Pathname of file or dir to be renamed + * (native). */ + const TCHAR *nativeDst) /* New pathname for file or directory * (native). */ -{ +{ +#if defined(HAVE_NO_SEH) && !defined(_WIN64) + TCLEXCEPTION_REGISTRATION registration; +#endif DWORD srcAttr, dstAttr; int retval = -1; /* - * The MoveFile API acts differently under Win95/98 and NT - * WRT NULL and "". Avoid passing these values. + * The MoveFile API acts differently under Win95/98 and NT WRT NULL and + * "". Avoid passing these values. */ if (nativeSrc == NULL || nativeSrc[0] == '\0' || @@ -208,93 +174,126 @@ DoRenameFile( } /* - * The MoveFile API would throw an exception under NT - * if one of the arguments is a char block device. + * The MoveFile API would throw an exception under NT if one of the + * arguments is a char block device. */ -#ifdef HAVE_NO_SEH -# ifdef TCL_MEM_DEBUG - __asm__ __volatile__ ( - "movl %%esp, %0" "\n\t" - "movl %%ebp, %1" "\n\t" - "movl %%fs:0, %2" "\n\t" - : "=m"(INITIAL_ESP), - "=m"(INITIAL_EBP), - "=r"(INITIAL_HANDLER) ); -# endif /* TCL_MEM_DEBUG */ +#if defined(HAVE_NO_SEH) && !defined(_WIN64) + /* + * Don't have SEH available, do things the hard way. Note that this needs + * to be one block of asm, to avoid stack imbalance; also, it is illegal + * for one asm block to contain a jump to another. + */ __asm__ __volatile__ ( - "pushl %%ebp" "\n\t" - "pushl %0" "\n\t" - "pushl %%fs:0" "\n\t" - "movl %%esp, %%fs:0" - : - : "r" (_except_dorenamefile_handler) - ); + /* + * Pick up params before messing with the stack. + */ + + "movl %[nativeDst], %%ebx" "\n\t" + "movl %[nativeSrc], %%ecx" "\n\t" + + /* + * Construct an TCLEXCEPTION_REGISTRATION to protect the call to + * MoveFile. + */ + + "leal %[registration], %%edx" "\n\t" + "movl %%fs:0, %%eax" "\n\t" + "movl %%eax, 0x0(%%edx)" "\n\t" /* link */ + "leal 1f, %%eax" "\n\t" + "movl %%eax, 0x4(%%edx)" "\n\t" /* handler */ + "movl %%ebp, 0x8(%%edx)" "\n\t" /* ebp */ + "movl %%esp, 0xc(%%edx)" "\n\t" /* esp */ + "movl $0, 0x10(%%edx)" "\n\t" /* status */ + + /* + * Link the TCLEXCEPTION_REGISTRATION on the chain. + */ + + "movl %%edx, %%fs:0" "\n\t" + + /* + * Call MoveFile(nativeSrc, nativeDst) + */ + + "pushl %%ebx" "\n\t" + "pushl %%ecx" "\n\t" + "movl %[moveFile], %%eax" "\n\t" + "call *%%eax" "\n\t" + + /* + * Come here on normal exit. Recover the TCLEXCEPTION_REGISTRATION and + * put the status return from MoveFile into it. + */ + + "movl %%fs:0, %%edx" "\n\t" + "movl %%eax, 0x10(%%edx)" "\n\t" + "jmp 2f" "\n" + + /* + * Come here on an exception. Recover the TCLEXCEPTION_REGISTRATION + */ + + "1:" "\t" + "movl %%fs:0, %%edx" "\n\t" + "movl 0x8(%%edx), %%edx" "\n\t" + + /* + * Come here however we exited. Restore context from the + * TCLEXCEPTION_REGISTRATION in case the stack is unbalanced. + */ + + "2:" "\t" + "movl 0xc(%%edx), %%esp" "\n\t" + "movl 0x8(%%edx), %%ebp" "\n\t" + "movl 0x0(%%edx), %%eax" "\n\t" + "movl %%eax, %%fs:0" "\n\t" + + : + /* No outputs */ + : + [registration] "m" (registration), + [nativeDst] "m" (nativeDst), + [nativeSrc] "m" (nativeSrc), + [moveFile] "r" (MoveFile) + : + "%eax", "%ebx", "%ecx", "%edx", "memory" + ); + if (registration.status != FALSE) { + retval = TCL_OK; + } #else +#ifndef HAVE_NO_SEH __try { -#endif /* HAVE_NO_SEH */ - if ((*tclWinProcs->moveFileProc)(nativeSrc, nativeDst) != FALSE) { +#endif + if ((*MoveFile)(nativeSrc, nativeDst) != FALSE) { retval = TCL_OK; } -#ifdef HAVE_NO_SEH - __asm__ __volatile__ ( - "jmp dorenamefile_pop" "\n" - "dorenamefile_reentry:" "\n\t" - "movl %%fs:0, %%eax" "\n\t" - "movl 0x8(%%eax), %%esp" "\n\t" - "movl 0x8(%%esp), %%ebp" "\n" - "dorenamefile_pop:" "\n\t" - "movl (%%esp), %%eax" "\n\t" - "movl %%eax, %%fs:0" "\n\t" - "add $12, %%esp" "\n\t" - : - : - : "%eax"); - -# ifdef TCL_MEM_DEBUG - __asm__ __volatile__ ( - "movl %%esp, %0" "\n\t" - "movl %%ebp, %1" "\n\t" - "movl %%fs:0, %2" "\n\t" - : "=m"(RESTORED_ESP), - "=m"(RESTORED_EBP), - "=r"(RESTORED_HANDLER) ); - - if (INITIAL_ESP != RESTORED_ESP) { - Tcl_Panic("ESP restored incorrectly"); - } - if (INITIAL_EBP != RESTORED_EBP) { - Tcl_Panic("EBP restored incorrectly"); - } - if (INITIAL_HANDLER != RESTORED_HANDLER) { - Tcl_Panic("HANDLER restored incorrectly"); - } -# endif /* TCL_MEM_DEBUG */ -#else +#ifndef HAVE_NO_SEH } __except (EXCEPTION_EXECUTE_HANDLER) {} -#endif /* HAVE_NO_SEH */ +#endif +#endif - /* - * Avoid using control flow statements in the SEH guarded block! - */ if (retval != -1) { - return retval; + return retval; } TclWinConvertError(GetLastError()); - srcAttr = (*tclWinProcs->getFileAttributesProc)(nativeSrc); - dstAttr = (*tclWinProcs->getFileAttributesProc)(nativeDst); + srcAttr = GetFileAttributes(nativeSrc); + dstAttr = GetFileAttributes(nativeDst); if (srcAttr == 0xffffffff) { - if ((*tclWinProcs->getFullPathNameProc)(nativeSrc, 0, NULL, NULL) >= MAX_PATH) { + if (GetFullPathName(nativeSrc, 0, NULL, + NULL) >= MAX_PATH) { errno = ENAMETOOLONG; return TCL_ERROR; } srcAttr = 0; } if (dstAttr == 0xffffffff) { - if ((*tclWinProcs->getFullPathNameProc)(nativeDst, 0, NULL, NULL) >= MAX_PATH) { + if (GetFullPathName(nativeDst, 0, NULL, + NULL) >= MAX_PATH) { errno = ENAMETOOLONG; return TCL_ERROR; } @@ -306,37 +305,39 @@ DoRenameFile( return TCL_ERROR; } if (errno == EACCES) { - decode: + decode: if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) { TCHAR *nativeSrcRest, *nativeDstRest; - CONST char **srcArgv, **dstArgv; + const char **srcArgv, **dstArgv; int size, srcArgc, dstArgc; - WCHAR nativeSrcPath[MAX_PATH]; - WCHAR nativeDstPath[MAX_PATH]; + TCHAR nativeSrcPath[MAX_PATH]; + TCHAR nativeDstPath[MAX_PATH]; Tcl_DString srcString, dstString; - CONST char *src, *dst; + const char *src, *dst; - size = (*tclWinProcs->getFullPathNameProc)(nativeSrc, MAX_PATH, + size = GetFullPathName(nativeSrc, MAX_PATH, nativeSrcPath, &nativeSrcRest); if ((size == 0) || (size > MAX_PATH)) { return TCL_ERROR; } - size = (*tclWinProcs->getFullPathNameProc)(nativeDst, MAX_PATH, + size = GetFullPathName(nativeDst, MAX_PATH, nativeDstPath, &nativeDstRest); if ((size == 0) || (size > MAX_PATH)) { return TCL_ERROR; } - (*tclWinProcs->charLowerProc)((TCHAR *) nativeSrcPath); - (*tclWinProcs->charLowerProc)((TCHAR *) nativeDstPath); + CharLower(nativeSrcPath); + CharLower(nativeDstPath); + + src = Tcl_WinTCharToUtf(nativeSrcPath, -1, &srcString); + dst = Tcl_WinTCharToUtf(nativeDstPath, -1, &dstString); - src = Tcl_WinTCharToUtf((TCHAR *) nativeSrcPath, -1, &srcString); - dst = Tcl_WinTCharToUtf((TCHAR *) nativeDstPath, -1, &dstString); /* * Check whether the destination path is actually inside the - * source path. This is true if the prefix matches, and the next + * source path. This is true if the prefix matches, and the next * character is either end-of-string or a directory separator */ - if ((strncmp(src, dst, (size_t) Tcl_DStringLength(&srcString))==0) + + if ((strncmp(src, dst, (size_t) Tcl_DStringLength(&srcString))==0) && (dst[Tcl_DStringLength(&srcString)] == '\\' || dst[Tcl_DStringLength(&srcString)] == '/' || dst[Tcl_DStringLength(&srcString)] == '\0')) { @@ -356,71 +357,70 @@ DoRenameFile( if (srcArgc == 1) { /* - * They are trying to move a root directory. Whether - * or not it is across filesystems, this cannot be - * done. + * They are trying to move a root directory. Whether or not it + * is across filesystems, this cannot be done. */ Tcl_SetErrno(EINVAL); } else if ((srcArgc > 0) && (dstArgc > 0) && (strcmp(srcArgv[0], dstArgv[0]) != 0)) { /* - * If src is a directory and dst filesystem != src - * filesystem, errno should be EXDEV. It is very - * important to get this behavior, so that the caller - * can respond to a cross filesystem rename by - * simulating it with copy and delete. The MoveFile - * system call already handles the case of moving a - * file between filesystems. + * If src is a directory and dst filesystem != src filesystem, + * errno should be EXDEV. It is very important to get this + * behavior, so that the caller can respond to a cross + * filesystem rename by simulating it with copy and delete. + * The MoveFile system call already handles the case of moving + * a file between filesystems. */ Tcl_SetErrno(EXDEV); } - ckfree((char *) srcArgv); - ckfree((char *) dstArgv); + ckfree(srcArgv); + ckfree(dstArgv); } /* * Other types of access failure is that dst is a read-only - * filesystem, that an open file referred to src or dest, or that - * src or dest specified the current working directory on the - * current filesystem. EACCES is returned for those cases. + * filesystem, that an open file referred to src or dest, or that src + * or dest specified the current working directory on the current + * filesystem. EACCES is returned for those cases. */ } else if (Tcl_GetErrno() == EEXIST) { /* - * Reports EEXIST any time the target already exists. If it makes + * Reports EEXIST any time the target already exists. If it makes * sense, remove the old file and try renaming again. */ if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) { if (dstAttr & FILE_ATTRIBUTE_DIRECTORY) { /* - * Overwrite empty dst directory with src directory. The - * following call will remove an empty directory. If it - * fails, it's because it wasn't empty. + * Overwrite empty dst directory with src directory. The + * following call will remove an empty directory. If it fails, + * it's because it wasn't empty. */ if (DoRemoveJustDirectory(nativeDst, 0, NULL) == TCL_OK) { /* * Now that that empty directory is gone, we can try - * renaming again. If that fails, we'll put this empty + * renaming again. If that fails, we'll put this empty * directory back, for completeness. */ - if ((*tclWinProcs->moveFileProc)(nativeSrc, nativeDst) != FALSE) { + if (MoveFile(nativeSrc, + nativeDst) != FALSE) { return TCL_OK; } /* - * Some new error has occurred. Don't know what it - * could be, but report this one. + * Some new error has occurred. Don't know what it could + * be, but report this one. */ TclWinConvertError(GetLastError()); - (*tclWinProcs->createDirectoryProc)(nativeDst, NULL); - (*tclWinProcs->setFileAttributesProc)(nativeDst, dstAttr); + CreateDirectory(nativeDst, NULL); + SetFileAttributes(nativeDst, dstAttr); if (Tcl_GetErrno() == EACCES) { /* * Decode the EACCES to a more meaningful error. @@ -438,55 +438,52 @@ DoRenameFile( } else { /* * Overwrite existing file by: - * + * * 1. Rename existing file to temp name. * 2. Rename old file to new name. - * 3. If success, delete temp file. If failure, - * put temp file back to old name. + * 3. If success, delete temp file. If failure, put temp file + * back to old name. */ TCHAR *nativeRest, *nativeTmp, *nativePrefix; int result, size; - WCHAR tempBuf[MAX_PATH]; - - size = (*tclWinProcs->getFullPathNameProc)(nativeDst, MAX_PATH, + TCHAR tempBuf[MAX_PATH]; + + size = GetFullPathName(nativeDst, MAX_PATH, tempBuf, &nativeRest); if ((size == 0) || (size > MAX_PATH) || (nativeRest == NULL)) { return TCL_ERROR; } nativeTmp = (TCHAR *) tempBuf; - ((char *) nativeRest)[0] = '\0'; - ((char *) nativeRest)[1] = '\0'; /* In case it's Unicode. */ + nativeRest[0] = L'\0'; result = TCL_ERROR; - nativePrefix = (tclWinProcs->useWide) - ? (TCHAR *) L"tclr" : (TCHAR *) "tclr"; - if ((*tclWinProcs->getTempFileNameProc)(nativeTmp, - nativePrefix, 0, tempBuf) != 0) { + nativePrefix = (TCHAR *) L"tclr"; + if (GetTempFileName(nativeTmp, nativePrefix, + 0, tempBuf) != 0) { /* * Strictly speaking, need the following DeleteFile and * MoveFile to be joined as an atomic operation so no * other app comes along in the meantime and creates the * same temp file. */ - - 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); + + nativeTmp = tempBuf; + DeleteFile(nativeTmp); + if (MoveFile(nativeDst, nativeTmp) != FALSE) { + if (MoveFile(nativeSrc, nativeDst) != FALSE) { + SetFileAttributes(nativeTmp, FILE_ATTRIBUTE_NORMAL); + DeleteFile(nativeTmp); return TCL_OK; } else { - (*tclWinProcs->deleteFileProc)(nativeDst); - (*tclWinProcs->moveFileProc)(nativeTmp, nativeDst); + DeleteFile(nativeDst); + MoveFile(nativeTmp, nativeDst); } - } + } /* - * Can't backup dst file or move src file. Return that - * error. Could happen if an open file refers to dst. + * Can't backup dst file or move src file. Return that + * error. Could happen if an open file refers to dst. */ TclWinConvertError(GetLastError()); @@ -506,54 +503,23 @@ DoRenameFile( } /* - *---------------------------------------------------------------------- - * - * _except_dorenamefile_handler -- - * - * SEH exception handler for DoRenameFile. - * - * Results: - * See DoRenameFile. - * - * Side effects: - * See DoRenameFile. - * - *---------------------------------------------------------------------- - */ -#ifdef HAVE_NO_SEH -static -__attribute__ ((cdecl)) -EXCEPTION_DISPOSITION -_except_dorenamefile_handler( - struct _EXCEPTION_RECORD *ExceptionRecord, - void *EstablisherFrame, - struct _CONTEXT *ContextRecord, - void *DispatcherContext) -{ - __asm__ __volatile__ ( - "jmp dorenamefile_reentry"); - return 0; /* Function does not return */ -} -#endif /* HAVE_NO_SEH */ - -/* *--------------------------------------------------------------------------- * * TclpObjCopyFile, DoCopyFile -- * - * Copy a single file (not a directory). If dst already exists and - * is not a directory, it is removed. + * Copy a single file (not a directory). If dst already exists and is not + * a directory, it is removed. * * Results: - * If the file was successfully copied, returns TCL_OK. Otherwise - * the return value is TCL_ERROR and errno is set to indicate the - * error. Some possible values for errno are: + * If the file was successfully copied, returns TCL_OK. Otherwise the + * return value is TCL_ERROR and errno is set to indicate the error. + * Some possible values for errno are: * - * EACCES: src or dst parent directory can't be read and/or written. + * EACCES: src or dst parent directory can't be read and/or written. * EISDIR: src or dst is a directory. - * ENOENT: src doesn't exist. src or dst is "". + * ENOENT: src doesn't exist. src or dst is "". * - * EACCES: exists an open file already referring to dst (95). + * EACCES: exists an open file already referring to dst (95). * EACCES: src specifies a char device (nul:, com1:, etc.) (NT) * ENOENT: src specifies a char device (nul:, com1:, etc.) (95) * @@ -563,25 +529,28 @@ _except_dorenamefile_handler( *--------------------------------------------------------------------------- */ -int -TclpObjCopyFile(srcPathPtr, destPathPtr) - Tcl_Obj *srcPathPtr; - Tcl_Obj *destPathPtr; +int +TclpObjCopyFile( + Tcl_Obj *srcPathPtr, + Tcl_Obj *destPathPtr) { return DoCopyFile(Tcl_FSGetNativePath(srcPathPtr), - Tcl_FSGetNativePath(destPathPtr)); + Tcl_FSGetNativePath(destPathPtr)); } static int DoCopyFile( - CONST TCHAR *nativeSrc, /* Pathname of file to be copied (native). */ - CONST TCHAR *nativeDst) /* Pathname of file to copy to (native). */ + const TCHAR *nativeSrc, /* Pathname of file to be copied (native). */ + const TCHAR *nativeDst) /* Pathname of file to copy to (native). */ { +#if defined(HAVE_NO_SEH) && !defined(_WIN64) + TCLEXCEPTION_REGISTRATION registration; +#endif int retval = -1; /* - * The CopyFile API acts differently under Win95/98 and NT - * WRT NULL and "". Avoid passing these values. + * The CopyFile API acts differently under Win95/98 and NT WRT NULL and + * "". Avoid passing these values. */ if (nativeSrc == NULL || nativeSrc[0] == '\0' || @@ -589,80 +558,113 @@ DoCopyFile( Tcl_SetErrno(ENOENT); return TCL_ERROR; } - + /* - * The CopyFile API would throw an exception under NT if one - * of the arguments is a char block device. + * The CopyFile API would throw an exception under NT if one of the + * arguments is a char block device. */ -#ifdef HAVE_NO_SEH -# ifdef TCL_MEM_DEBUG - __asm__ __volatile__ ( - "movl %%esp, %0" "\n\t" - "movl %%ebp, %1" "\n\t" - "movl %%fs:0, %2" "\n\t" - : "=m"(INITIAL_ESP), - "=m"(INITIAL_EBP), - "=r"(INITIAL_HANDLER) ); -# endif /* TCL_MEM_DEBUG */ +#if defined(HAVE_NO_SEH) && !defined(_WIN64) + /* + * Don't have SEH available, do things the hard way. Note that this needs + * to be one block of asm, to avoid stack imbalance; also, it is illegal + * for one asm block to contain a jump to another. + */ __asm__ __volatile__ ( - "pushl %%ebp" "\n\t" - "pushl %0" "\n\t" - "pushl %%fs:0" "\n\t" - "movl %%esp, %%fs:0" - : - : "r" (_except_docopyfile_handler) - ); + + /* + * Pick up parameters before messing with the stack + */ + + "movl %[nativeDst], %%ebx" "\n\t" + "movl %[nativeSrc], %%ecx" "\n\t" + + /* + * Construct an TCLEXCEPTION_REGISTRATION to protect the call to + * CopyFile. + */ + + "leal %[registration], %%edx" "\n\t" + "movl %%fs:0, %%eax" "\n\t" + "movl %%eax, 0x0(%%edx)" "\n\t" /* link */ + "leal 1f, %%eax" "\n\t" + "movl %%eax, 0x4(%%edx)" "\n\t" /* handler */ + "movl %%ebp, 0x8(%%edx)" "\n\t" /* ebp */ + "movl %%esp, 0xc(%%edx)" "\n\t" /* esp */ + "movl $0, 0x10(%%edx)" "\n\t" /* status */ + + /* + * Link the TCLEXCEPTION_REGISTRATION on the chain. + */ + + "movl %%edx, %%fs:0" "\n\t" + + /* + * Call CopyFile(nativeSrc, nativeDst, 0) + */ + + "movl %[copyFile], %%eax" "\n\t" + "pushl $0" "\n\t" + "pushl %%ebx" "\n\t" + "pushl %%ecx" "\n\t" + "call *%%eax" "\n\t" + + /* + * Come here on normal exit. Recover the TCLEXCEPTION_REGISTRATION and + * put the status return from CopyFile into it. + */ + + "movl %%fs:0, %%edx" "\n\t" + "movl %%eax, 0x10(%%edx)" "\n\t" + "jmp 2f" "\n" + + /* + * Come here on an exception. Recover the TCLEXCEPTION_REGISTRATION + */ + + "1:" "\t" + "movl %%fs:0, %%edx" "\n\t" + "movl 0x8(%%edx), %%edx" "\n\t" + + /* + * Come here however we exited. Restore context from the + * TCLEXCEPTION_REGISTRATION in case the stack is unbalanced. + */ + + "2:" "\t" + "movl 0xc(%%edx), %%esp" "\n\t" + "movl 0x8(%%edx), %%ebp" "\n\t" + "movl 0x0(%%edx), %%eax" "\n\t" + "movl %%eax, %%fs:0" "\n\t" + + : + /* No outputs */ + : + [registration] "m" (registration), + [nativeDst] "m" (nativeDst), + [nativeSrc] "m" (nativeSrc), + [copyFile] "r" (CopyFile) + : + "%eax", "%ebx", "%ecx", "%edx", "memory" + ); + if (registration.status != FALSE) { + retval = TCL_OK; + } #else +#ifndef HAVE_NO_SEH __try { -#endif /* HAVE_NO_SEH */ - if ((*tclWinProcs->copyFileProc)(nativeSrc, nativeDst, 0) != FALSE) { +#endif + if (CopyFile(nativeSrc, nativeDst, 0) != FALSE) { retval = TCL_OK; } -#ifdef HAVE_NO_SEH - __asm__ __volatile__ ( - "jmp docopyfile_pop" "\n" - "docopyfile_reentry:" "\n\t" - "movl %%fs:0, %%eax" "\n\t" - "movl 0x8(%%eax), %%esp" "\n\t" - "movl 0x8(%%esp), %%ebp" "\n" - "docopyfile_pop:" "\n\t" - "movl (%%esp), %%eax" "\n\t" - "movl %%eax, %%fs:0" "\n\t" - "add $12, %%esp" "\n\t" - : - : - : "%eax"); - -# ifdef TCL_MEM_DEBUG - __asm__ __volatile__ ( - "movl %%esp, %0" "\n\t" - "movl %%ebp, %1" "\n\t" - "movl %%fs:0, %2" "\n\t" - : "=m"(RESTORED_ESP), - "=m"(RESTORED_EBP), - "=r"(RESTORED_HANDLER) ); - - if (INITIAL_ESP != RESTORED_ESP) { - Tcl_Panic("ESP restored incorrectly"); - } - if (INITIAL_EBP != RESTORED_EBP) { - Tcl_Panic("EBP restored incorrectly"); - } - if (INITIAL_HANDLER != RESTORED_HANDLER) { - Tcl_Panic("HANDLER restored incorrectly"); - } -# endif /* TCL_MEM_DEBUG */ -#else +#ifndef HAVE_NO_SEH } __except (EXCEPTION_EXECUTE_HANDLER) {} -#endif /* HAVE_NO_SEH */ +#endif +#endif - /* - * Avoid using control flow statements in the SEH guarded block! - */ if (retval != -1) { - return retval; + return retval; } TclWinConvertError(GetLastError()); @@ -673,8 +675,8 @@ DoCopyFile( if (Tcl_GetErrno() == EACCES) { DWORD srcAttr, dstAttr; - srcAttr = (*tclWinProcs->getFileAttributesProc)(nativeSrc); - dstAttr = (*tclWinProcs->getFileAttributesProc)(nativeDst); + srcAttr = GetFileAttributes(nativeSrc); + dstAttr = GetFileAttributes(nativeDst); if (srcAttr != 0xffffffff) { if (dstAttr == 0xffffffff) { dstAttr = 0; @@ -683,25 +685,27 @@ DoCopyFile( (dstAttr & FILE_ATTRIBUTE_DIRECTORY)) { if (srcAttr & FILE_ATTRIBUTE_REPARSE_POINT) { /* Source is a symbolic link -- copy it */ - if (TclWinSymLinkCopyDirectory(nativeSrc, nativeDst) == 0) { - return TCL_OK; + if (TclWinSymLinkCopyDirectory(nativeSrc, nativeDst)==0) { + return TCL_OK; } } Tcl_SetErrno(EISDIR); } if (dstAttr & FILE_ATTRIBUTE_READONLY) { - (*tclWinProcs->setFileAttributesProc)(nativeDst, + SetFileAttributes(nativeDst, dstAttr & ~((DWORD)FILE_ATTRIBUTE_READONLY)); - if ((*tclWinProcs->copyFileProc)(nativeSrc, nativeDst, 0) != FALSE) { + if (CopyFile(nativeSrc, nativeDst, + 0) != FALSE) { return TCL_OK; } + /* - * Still can't copy onto dst. Return that error, and - * restore attributes of dst. + * Still can't copy onto dst. Return that error, and restore + * attributes of dst. */ TclWinConvertError(GetLastError()); - (*tclWinProcs->setFileAttributesProc)(nativeDst, dstAttr); + SetFileAttributes(nativeDst, dstAttr); } } } @@ -709,128 +713,101 @@ DoCopyFile( } /* - *---------------------------------------------------------------------- - * - * _except_docopyfile_handler -- - * - * SEH exception handler for DoCopyFile. - * - * Results: - * See DoCopyFile. - * - * Side effects: - * See DoCopyFile. - * - *---------------------------------------------------------------------- - */ -#ifdef HAVE_NO_SEH -static -__attribute__ ((cdecl)) -EXCEPTION_DISPOSITION -_except_docopyfile_handler( - struct _EXCEPTION_RECORD *ExceptionRecord, - void *EstablisherFrame, - struct _CONTEXT *ContextRecord, - void *DispatcherContext) -{ - __asm__ __volatile__ ( - "jmp docopyfile_reentry"); - return 0; /* Function does not return */ -} -#endif /* HAVE_NO_SEH */ - -/* *--------------------------------------------------------------------------- * * TclpObjDeleteFile, TclpDeleteFile -- * - * Removes a single file (not a directory). + * Removes a single file (not a directory). * * Results: - * If the file was successfully deleted, returns TCL_OK. Otherwise - * the return value is TCL_ERROR and errno is set to indicate the - * error. Some possible values for errno are: + * If the file was successfully deleted, returns TCL_OK. Otherwise the + * return value is TCL_ERROR and errno is set to indicate the error. + * Some possible values for errno are: * - * EACCES: a parent directory can't be read and/or written. + * EACCES: a parent directory can't be read and/or written. * EISDIR: path is a directory. * ENOENT: path doesn't exist or is "". * - * EACCES: exists an open file already referring to path. + * EACCES: exists an open file already referring to path. * EACCES: path is a char device (nul:, com1:, etc.) * * Side effects: - * The file is deleted, even if it is read-only. + * The file is deleted, even if it is read-only. * *--------------------------------------------------------------------------- */ -int -TclpObjDeleteFile(pathPtr) - Tcl_Obj *pathPtr; +int +TclpObjDeleteFile( + Tcl_Obj *pathPtr) { return TclpDeleteFile(Tcl_FSGetNativePath(pathPtr)); } int TclpDeleteFile( - CONST TCHAR *nativePath) /* Pathname of file to be removed (native). */ + const void *nativePath) /* Pathname of file to be removed (native). */ { DWORD attr; + const TCHAR *path = nativePath; /* - * The DeleteFile API acts differently under Win95/98 and NT - * WRT NULL and "". Avoid passing these values. + * The DeleteFile API acts differently under Win95/98 and NT WRT NULL and + * "". Avoid passing these values. */ - if (nativePath == NULL || nativePath[0] == '\0') { + if (path == NULL || path[0] == '\0') { Tcl_SetErrno(ENOENT); return TCL_ERROR; } - if ((*tclWinProcs->deleteFileProc)(nativePath) != FALSE) { + if (DeleteFile(path) != FALSE) { return TCL_OK; } TclWinConvertError(GetLastError()); if (Tcl_GetErrno() == EACCES) { - attr = (*tclWinProcs->getFileAttributesProc)(nativePath); + attr = GetFileAttributes(path); if (attr != 0xffffffff) { if (attr & FILE_ATTRIBUTE_DIRECTORY) { if (attr & FILE_ATTRIBUTE_REPARSE_POINT) { - /* It is a symbolic link -- remove it */ - if (TclWinSymLinkDelete(nativePath, 0) == 0) { - return TCL_OK; + /* + * It is a symbolic link - remove it. + */ + if (TclWinSymLinkDelete(path, 0) == 0) { + return TCL_OK; } } - - /* + + /* * If we fall through here, it is a directory. - * + * * Windows NT reports removing a directory as EACCES instead * of EISDIR. */ Tcl_SetErrno(EISDIR); } else if (attr & FILE_ATTRIBUTE_READONLY) { - int res = (*tclWinProcs->setFileAttributesProc)(nativePath, - attr & ~((DWORD)FILE_ATTRIBUTE_READONLY)); - if ((res != 0) && ((*tclWinProcs->deleteFileProc)(nativePath) - != FALSE)) { + int res = SetFileAttributes(path, + attr & ~((DWORD) FILE_ATTRIBUTE_READONLY)); + + if ((res != 0) && + (DeleteFile(path) != FALSE)) { return TCL_OK; } TclWinConvertError(GetLastError()); if (res != 0) { - (*tclWinProcs->setFileAttributesProc)(nativePath, attr); + SetFileAttributes(path, attr); } } } } else if (Tcl_GetErrno() == ENOENT) { - attr = (*tclWinProcs->getFileAttributesProc)(nativePath); + attr = GetFileAttributes(path); if (attr != 0xffffffff) { if (attr & FILE_ATTRIBUTE_DIRECTORY) { - /* - * Windows 95 reports removing a directory as ENOENT instead - * of EISDIR. + /* + * Windows 95 reports removing a directory as ENOENT instead + * of EISDIR. */ Tcl_SetErrno(EISDIR); @@ -853,43 +830,43 @@ TclpDeleteFile( * * TclpObjCreateDirectory -- * - * Creates the specified directory. All parent directories of the - * specified directory must already exist. The directory is - * automatically created with permissions so that user can access - * the new directory and create new files or subdirectories in it. + * Creates the specified directory. All parent directories of the + * specified directory must already exist. The directory is automatically + * created with permissions so that user can access the new directory and + * create new files or subdirectories in it. * * Results: - * If the directory was successfully created, returns TCL_OK. - * Otherwise the return value is TCL_ERROR and errno is set to - * indicate the error. Some possible values for errno are: + * If the directory was successfully created, returns TCL_OK. Otherwise + * the return value is TCL_ERROR and errno is set to indicate the error. + * Some possible values for errno are: * - * EACCES: a parent directory can't be read and/or written. + * EACCES: a parent directory can't be read and/or written. * EEXIST: path already exists. * ENOENT: a parent directory doesn't exist. * * Side effects: - * A directory is created. + * A directory is created. * *--------------------------------------------------------------------------- */ -int -TclpObjCreateDirectory(pathPtr) - Tcl_Obj *pathPtr; +int +TclpObjCreateDirectory( + Tcl_Obj *pathPtr) { return DoCreateDirectory(Tcl_FSGetNativePath(pathPtr)); } static int DoCreateDirectory( - CONST TCHAR *nativePath) /* Pathname of directory to create (native). */ + const TCHAR *nativePath) /* Pathname of directory to create (native). */ { - DWORD error; - if ((*tclWinProcs->createDirectoryProc)(nativePath, NULL) == 0) { - error = GetLastError(); + if (CreateDirectory(nativePath, NULL) == 0) { + DWORD error = GetLastError(); + TclWinConvertError(error); return TCL_ERROR; - } + } return TCL_OK; } @@ -898,32 +875,30 @@ DoCreateDirectory( * * TclpObjCopyDirectory -- * - * Recursively copies a directory. The target directory dst must - * not already exist. Note that this function does not merge two - * directory hierarchies, even if the target directory is an an - * empty directory. + * Recursively copies a directory. The target directory dst must not + * already exist. Note that this function does not merge two directory + * hierarchies, even if the target directory is an an empty directory. * * Results: - * If the directory was successfully copied, returns TCL_OK. - * Otherwise the return value is TCL_ERROR, errno is set to indicate - * the error, and the pathname of the file that caused the error - * is stored in errorPtr. See TclpCreateDirectory and TclpCopyFile - * for a description of possible values for errno. + * If the directory was successfully copied, returns TCL_OK. Otherwise + * the return value is TCL_ERROR, errno is set to indicate the error, and + * the pathname of the file that caused the error is stored in errorPtr. + * See TclpCreateDirectory and TclpCopyFile for a description of possible + * values for errno. * * Side effects: - * An exact copy of the directory hierarchy src will be created - * with the name dst. If an error occurs, the error will - * be returned immediately, and remaining files will not be - * processed. + * An exact copy of the directory hierarchy src will be created with the + * name dst. If an error occurs, the error will be returned immediately, + * and remaining files will not be processed. * *--------------------------------------------------------------------------- */ -int -TclpObjCopyDirectory(srcPathPtr, destPathPtr, errorPtr) - Tcl_Obj *srcPathPtr; - Tcl_Obj *destPathPtr; - Tcl_Obj **errorPtr; +int +TclpObjCopyDirectory( + Tcl_Obj *srcPathPtr, + Tcl_Obj *destPathPtr, + Tcl_Obj **errorPtr) { Tcl_DString ds; Tcl_DString srcString, dstString; @@ -931,8 +906,12 @@ TclpObjCopyDirectory(srcPathPtr, destPathPtr, errorPtr) int ret; normSrcPtr = Tcl_FSGetNormalizedPath(NULL,srcPathPtr); - Tcl_WinUtfToTChar(Tcl_GetString(normSrcPtr), -1, &srcString); normDestPtr = Tcl_FSGetNormalizedPath(NULL,destPathPtr); + if ((normSrcPtr == NULL) || (normDestPtr == NULL)) { + return TCL_ERROR; + } + + Tcl_WinUtfToTChar(Tcl_GetString(normSrcPtr), -1, &srcString); Tcl_WinUtfToTChar(Tcl_GetString(normDestPtr), -1, &dstString); ret = TraverseWinTree(TraversalCopy, &srcString, &dstString, &ds); @@ -941,9 +920,9 @@ TclpObjCopyDirectory(srcPathPtr, destPathPtr, errorPtr) Tcl_DStringFree(&dstString); if (ret != TCL_OK) { - if (!strcmp(Tcl_DStringValue(&ds), Tcl_GetString(normSrcPtr))) { + if (!strcmp(Tcl_DStringValue(&ds), TclGetString(normSrcPtr))) { *errorPtr = srcPathPtr; - } else if (!strcmp(Tcl_DStringValue(&ds), Tcl_GetString(normDestPtr))) { + } else if (!strcmp(Tcl_DStringValue(&ds), TclGetString(normDestPtr))) { *errorPtr = destPathPtr; } else { *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); @@ -957,87 +936,92 @@ TclpObjCopyDirectory(srcPathPtr, destPathPtr, errorPtr) /* *---------------------------------------------------------------------- * - * TclpObjRemoveDirectory, DoRemoveDirectory -- + * TclpObjRemoveDirectory, DoRemoveDirectory -- * * Removes directory (and its contents, if the recursive flag is set). * * Results: - * If the directory was successfully removed, returns TCL_OK. - * Otherwise the return value is TCL_ERROR, errno is set to indicate - * the error, and the pathname of the file that caused the error - * is stored in errorPtr. Some possible values for errno are: + * If the directory was successfully removed, returns TCL_OK. Otherwise + * the return value is TCL_ERROR, errno is set to indicate the error, and + * the pathname of the file that caused the error is stored in errorPtr. + * Some possible values for errno are: * - * EACCES: path directory can't be read and/or written. + * EACCES: path directory can't be read and/or written. * EEXIST: path is a non-empty directory. * EINVAL: path is root directory or current directory. * ENOENT: path doesn't exist or is "". - * ENOTDIR: path is not a directory. + * ENOTDIR: path is not a directory. * * EACCES: path is a char device (nul:, com1:, etc.) (95) * EINVAL: path is a char device (nul:, com1:, etc.) (NT) * * Side effects: - * Directory removed. If an error occurs, the error will be returned + * Directory removed. If an error occurs, the error will be returned * immediately, and remaining files will not be deleted. * *---------------------------------------------------------------------- */ -int -TclpObjRemoveDirectory(pathPtr, recursive, errorPtr) - Tcl_Obj *pathPtr; - int recursive; - Tcl_Obj **errorPtr; +int +TclpObjRemoveDirectory( + Tcl_Obj *pathPtr, + int recursive, + Tcl_Obj **errorPtr) { Tcl_DString ds; Tcl_Obj *normPtr = NULL; 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 which may be used extensively, so we can't optimize + * this case easily. */ + Tcl_DString native; normPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr); + if (normPtr == NULL) { + return TCL_ERROR; + } Tcl_WinUtfToTChar(Tcl_GetString(normPtr), -1, &native); ret = DoRemoveDirectory(&native, recursive, &ds); Tcl_DStringFree(&native); } else { - ret = DoRemoveJustDirectory(Tcl_FSGetNativePath(pathPtr), - 0, &ds); + ret = DoRemoveJustDirectory(Tcl_FSGetNativePath(pathPtr), 0, &ds); } + if (ret != TCL_OK) { - int len = Tcl_DStringLength(&ds); - if (len > 0) { + if (Tcl_DStringLength(&ds) > 0) { if (normPtr != NULL && !strcmp(Tcl_DStringValue(&ds), TclGetString(normPtr))) { *errorPtr = pathPtr; } else { - *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); + *errorPtr = TclDStringToObj(&ds); } Tcl_IncrRefCount(*errorPtr); } Tcl_DStringFree(&ds); } + return ret; } static int DoRemoveJustDirectory( - CONST TCHAR *nativePath, /* Pathname of directory to be removed + const TCHAR *nativePath, /* Pathname of directory to be removed * (native). */ - int ignoreError, /* If non-zero, don't initialize the - * errorPtr under some circumstances - * on return. */ - Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free - * DString filled with UTF-8 name of file - * causing error. */ + int ignoreError, /* If non-zero, don't initialize the errorPtr + * under some circumstances on return. */ + Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free DString + * filled with UTF-8 name of file causing + * error. */ { DWORD attr; + /* - * The RemoveDirectory API acts differently under Win95/98 and NT - * WRT NULL and "". Avoid passing these values. + * The RemoveDirectory API acts differently under Win95/98 and NT WRT NULL + * and "". Avoid passing these values. */ if (nativePath == NULL || nativePath[0] == '\0') { @@ -1045,120 +1029,91 @@ DoRemoveJustDirectory( goto end; } - attr = (*tclWinProcs->getFileAttributesProc)(nativePath); + attr = GetFileAttributes(nativePath); if (attr & FILE_ATTRIBUTE_REPARSE_POINT) { - /* It is a symbolic link -- remove it */ + /* + * It is a symbolic link - remove it. + */ if (TclWinSymLinkDelete(nativePath, 0) == 0) { return TCL_OK; } } else { - /* Ordinary directory */ - if ((*tclWinProcs->removeDirectoryProc)(nativePath) != FALSE) { + /* + * Ordinary directory. + */ + + if (RemoveDirectory(nativePath) != FALSE) { return TCL_OK; } } - + TclWinConvertError(GetLastError()); if (Tcl_GetErrno() == EACCES) { - attr = (*tclWinProcs->getFileAttributesProc)(nativePath); + attr = GetFileAttributes(nativePath); if (attr != 0xffffffff) { if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) { - /* - * Windows 95 reports calling RemoveDirectory on a file as an + /* + * Windows 95 reports calling RemoveDirectory on a file as an * EACCES, not an ENOTDIR. */ - + Tcl_SetErrno(ENOTDIR); goto end; } if (attr & FILE_ATTRIBUTE_REPARSE_POINT) { - /* It is a symbolic link -- remove it */ + /* + * It is a symbolic link - remove it. + */ + if (TclWinSymLinkDelete(nativePath, 1) != 0) { goto end; } } - + if (attr & FILE_ATTRIBUTE_READONLY) { attr &= ~FILE_ATTRIBUTE_READONLY; - if ((*tclWinProcs->setFileAttributesProc)(nativePath, attr) == FALSE) { + if (SetFileAttributes(nativePath, + attr) == FALSE) { goto end; } - if ((*tclWinProcs->removeDirectoryProc)(nativePath) != FALSE) { + if (RemoveDirectory(nativePath) != FALSE) { return TCL_OK; } TclWinConvertError(GetLastError()); - (*tclWinProcs->setFileAttributesProc)(nativePath, + SetFileAttributes(nativePath, attr | FILE_ATTRIBUTE_READONLY); } - - /* - * Windows 95 and Win32s report removing a non-empty directory - * as EACCES, not EEXIST. If the directory is not empty, - * change errno so caller knows what's going on. - - */ - - if (TclWinGetPlatformId() != VER_PLATFORM_WIN32_NT) { - CONST char *path, *find; - HANDLE handle; - WIN32_FIND_DATAA data; - Tcl_DString buffer; - int len; - - path = (CONST char *) nativePath; - - Tcl_DStringInit(&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 = FindFirstFileA(find, &data); - if (handle != INVALID_HANDLE_VALUE) { - while (1) { - if ((strcmp(data.cFileName, ".") != 0) - && (strcmp(data.cFileName, "..") != 0)) { - /* - * Found something in this directory. - */ - - Tcl_SetErrno(EEXIST); - break; - } - if (FindNextFileA(handle, &data) == FALSE) { - break; - } - } - FindClose(handle); - } - Tcl_DStringFree(&buffer); - } } } + if (Tcl_GetErrno() == ENOTEMPTY) { - /* - * The caller depends on EEXIST to signify that the directory is - * not empty, not ENOTEMPTY. + /* + * The caller depends on EEXIST to signify that the directory is not + * empty, not ENOTEMPTY. */ Tcl_SetErrno(EEXIST); } + if ((ignoreError != 0) && (Tcl_GetErrno() == EEXIST)) { - /* - * If we're being recursive, this error may actually - * be ok, so we don't want to initialise the errorPtr - * yet. + /* + * If we're being recursive, this error may actually be ok, so we + * don't want to initialise the errorPtr yet. */ return TCL_ERROR; } - end: + end: if (errorPtr != NULL) { + char *p; Tcl_WinTCharToUtf(nativePath, -1, errorPtr); + p = Tcl_DStringValue(errorPtr); + for (; *p; ++p) { + if (*p == '\\') *p = '/'; + } } return TCL_ERROR; @@ -1168,21 +1123,22 @@ 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. */ + 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 res = DoRemoveJustDirectory(Tcl_DStringValue(pathPtr), recursive, - errorPtr); - + int res = DoRemoveJustDirectory((const TCHAR *)Tcl_DStringValue(pathPtr), recursive, + errorPtr); + if ((res == TCL_ERROR) && (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. */ + return TraverseWinTree(TraversalDelete, pathPtr, NULL, errorPtr); } else { return res; @@ -1194,24 +1150,24 @@ DoRemoveDirectory( * * TraverseWinTree -- * - * Traverse directory tree specified by sourcePtr, calling the function - * traverseProc for each file and directory encountered. If destPtr - * is non-null, each of name in the sourcePtr directory is appended to - * the directory specified by destPtr and passed as the second argument - * to traverseProc() . + * Traverse directory tree specified by sourcePtr, calling the function + * traverseProc for each file and directory encountered. If destPtr is + * non-null, each of name in the sourcePtr directory is appended to the + * directory specified by destPtr and passed as the second argument to + * traverseProc(). * * Results: - * Standard Tcl result. + * Standard Tcl result. * * Side effects: - * None caused by TraverseWinTree, however the user specified - * traverseProc() may change state. If an error occurs, the error will - * be returned immediately, and remaining files will not be processed. + * None caused by TraverseWinTree, however the user specified + * traverseProc() may change state. If an error occurs, the error will be + * returned immediately, and remaining files will not be processed. * *--------------------------------------------------------------------------- */ -static int +static int TraverseWinTree( TraversalProc *traverseProc,/* Function to call for every file and * directory in source hierarchy. */ @@ -1220,59 +1176,56 @@ TraverseWinTree( Tcl_DString *targetPtr, /* Pathname of directory to traverse in * parallel with source directory (native), * may be NULL. */ - Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free - * DString filled with UTF-8 name of file - * causing error. */ + Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free DString + * filled with UTF-8 name of file causing + * error. */ { DWORD sourceAttr; TCHAR *nativeSource, *nativeTarget, *nativeErrfile; - int result, found, sourceLen, targetLen, oldSourceLen, oldTargetLen; + int result, found, sourceLen, targetLen = 0, oldSourceLen, oldTargetLen; HANDLE handle; - WIN32_FIND_DATAT data; + WIN32_FIND_DATA data; nativeErrfile = NULL; result = TCL_OK; oldTargetLen = 0; /* lint. */ nativeSource = (TCHAR *) Tcl_DStringValue(sourcePtr); - nativeTarget = (TCHAR *) (targetPtr == NULL - ? NULL : Tcl_DStringValue(targetPtr)); - + nativeTarget = (TCHAR *) + (targetPtr == NULL ? NULL : Tcl_DStringValue(targetPtr)); + oldSourceLen = Tcl_DStringLength(sourcePtr); - sourceAttr = (*tclWinProcs->getFileAttributesProc)(nativeSource); + sourceAttr = GetFileAttributes(nativeSource); if (sourceAttr == 0xffffffff) { nativeErrfile = nativeSource; goto end; } - + if (sourceAttr & FILE_ATTRIBUTE_REPARSE_POINT) { /* * Process the symbolic link */ - return (*traverseProc)(nativeSource, nativeTarget, - DOTREE_LINK, errorPtr); + return traverseProc(nativeSource, nativeTarget, DOTREE_LINK, + errorPtr); } - + if ((sourceAttr & FILE_ATTRIBUTE_DIRECTORY) == 0) { /* * Process the regular file */ - return (*traverseProc)(nativeSource, nativeTarget, DOTREE_F, errorPtr); + return traverseProc(nativeSource, nativeTarget, DOTREE_F, errorPtr); } - if (tclWinProcs->useWide) { - Tcl_DStringAppend(sourcePtr, (char *) L"\\*.*", 4 * sizeof(WCHAR) + 1); - Tcl_DStringSetLength(sourcePtr, Tcl_DStringLength(sourcePtr) - 1); - } else { - Tcl_DStringAppend(sourcePtr, "\\*.*", 4); - } + Tcl_DStringAppend(sourcePtr, (char *) TEXT("\\*.*"), 4 * sizeof(TCHAR) + 1); + Tcl_DStringSetLength(sourcePtr, Tcl_DStringLength(sourcePtr) - 1); + nativeSource = (TCHAR *) Tcl_DStringValue(sourcePtr); - handle = (*tclWinProcs->findFirstFileProc)(nativeSource, &data); + handle = FindFirstFile(nativeSource, &data); if (handle == INVALID_HANDLE_VALUE) { - /* - * Can't read directory + /* + * Can't read directory. */ TclWinConvertError(GetLastError()); @@ -1280,69 +1233,47 @@ TraverseWinTree( goto end; } - nativeSource[oldSourceLen + 1] = '\0'; + Tcl_DStringSetLength(sourcePtr, oldSourceLen + 1); Tcl_DStringSetLength(sourcePtr, oldSourceLen); - result = (*traverseProc)(nativeSource, nativeTarget, DOTREE_PRED, errorPtr); + result = traverseProc(nativeSource, nativeTarget, 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); - } + sourceLen = oldSourceLen + sizeof(TCHAR); + Tcl_DStringAppend(sourcePtr, (char *) TEXT("\\"), sizeof(TCHAR) + 1); + Tcl_DStringSetLength(sourcePtr, sourceLen); if (targetPtr != NULL) { 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); - } + targetLen += sizeof(TCHAR); + Tcl_DStringAppend(targetPtr, (char *) TEXT("\\"), sizeof(TCHAR) + 1); + Tcl_DStringSetLength(targetPtr, targetLen); } found = 1; - for ( ; found; found = (*tclWinProcs->findNextFileProc)(handle, &data)) { + for (; found; found = FindNextFile(handle, &data)) { TCHAR *nativeName; int len; - if (tclWinProcs->useWide) { - WCHAR *wp; - - wp = data.w.cFileName; + TCHAR *wp = data.cFileName; + if (*wp == '.') { + wp++; if (*wp == '.') { wp++; - if (*wp == '.') { - wp++; - } - if (*wp == '\0') { - continue; - } } - nativeName = (TCHAR *) data.w.cFileName; - len = Tcl_UniCharLen(data.w.cFileName) * sizeof(WCHAR); - } else { - if ((strcmp(data.a.cFileName, ".") == 0) - || (strcmp(data.a.cFileName, "..") == 0)) { + if (*wp == '\0') { continue; } - nativeName = (TCHAR *) data.a.cFileName; - len = strlen(data.a.cFileName); } + nativeName = (TCHAR *) data.cFileName; + len = _tcslen(data.cFileName) * sizeof(TCHAR); - /* - * Append name after slash, and recurse on the file. + /* + * Append name after slash, and recurse on the file. */ Tcl_DStringAppend(sourcePtr, (char *) nativeName, len + 1); @@ -1351,7 +1282,7 @@ TraverseWinTree( Tcl_DStringAppend(targetPtr, (char *) nativeName, len + 1); Tcl_DStringSetLength(targetPtr, Tcl_DStringLength(targetPtr) - 1); } - result = TraverseWinTree(traverseProc, sourcePtr, targetPtr, + result = TraverseWinTree(traverseProc, sourcePtr, targetPtr, errorPtr); if (result != TCL_OK) { break; @@ -1369,7 +1300,7 @@ TraverseWinTree( FindClose(handle); /* - * Strip off the trailing slash we added + * Strip off the trailing slash we added. */ Tcl_DStringSetLength(sourcePtr, oldSourceLen + 1); @@ -1384,11 +1315,12 @@ TraverseWinTree( * files in that directory. */ - result = (*traverseProc)(Tcl_DStringValue(sourcePtr), - (targetPtr == NULL ? NULL : Tcl_DStringValue(targetPtr)), - DOTREE_POSTD, errorPtr); + result = traverseProc((const TCHAR *)Tcl_DStringValue(sourcePtr), + (const TCHAR *)(targetPtr == NULL ? NULL : Tcl_DStringValue(targetPtr)), + DOTREE_POSTD, errorPtr); } - end: + + end: if (nativeErrfile != NULL) { TclWinConvertError(GetLastError()); if (errorPtr != NULL) { @@ -1396,7 +1328,7 @@ TraverseWinTree( } result = TCL_ERROR; } - + return result; } @@ -1405,58 +1337,55 @@ TraverseWinTree( * * TraversalCopy * - * Called from TraverseUnixTree in order to execute a recursive - * copy of a directory. + * Called from TraverseUnixTree in order to execute a recursive copy of a + * directory. * * Results: - * Standard Tcl result. + * Standard Tcl result. * * Side effects: - * Depending on the value of type, src may be copied to dst. - * + * Depending on the value of type, src may be copied to dst. + * *---------------------------------------------------------------------- */ -static int +static int TraversalCopy( - CONST TCHAR *nativeSrc, /* Source pathname to copy. */ - CONST TCHAR *nativeDst, /* Destination pathname of copy. */ + const TCHAR *nativeSrc, /* Source pathname to copy. */ + const TCHAR *nativeDst, /* Destination pathname of copy. */ int type, /* Reason for call - see TraverseWinTree() */ Tcl_DString *errorPtr) /* If non-NULL, initialized DString filled * with UTF-8 name of file causing error. */ { switch (type) { - case DOTREE_F: { - if (DoCopyFile(nativeSrc, nativeDst) == TCL_OK) { - return TCL_OK; - } - break; + case DOTREE_F: + if (DoCopyFile(nativeSrc, nativeDst) == TCL_OK) { + return TCL_OK; } - case DOTREE_LINK: { - if (TclWinSymLinkCopyDirectory(nativeSrc, nativeDst) == TCL_OK) { - return TCL_OK; - } - break; + break; + case DOTREE_LINK: + if (TclWinSymLinkCopyDirectory(nativeSrc, nativeDst) == TCL_OK) { + return TCL_OK; } - case DOTREE_PRED: { - if (DoCreateDirectory(nativeDst) == TCL_OK) { - DWORD attr = (*tclWinProcs->getFileAttributesProc)(nativeSrc); - if ((*tclWinProcs->setFileAttributesProc)(nativeDst, attr) - != FALSE) { - return TCL_OK; - } - TclWinConvertError(GetLastError()); + break; + case DOTREE_PRED: + if (DoCreateDirectory(nativeDst) == TCL_OK) { + DWORD attr = GetFileAttributes(nativeSrc); + + if (SetFileAttributes(nativeDst, + attr) != FALSE) { + return TCL_OK; } - break; - } - case DOTREE_POSTD: { - return TCL_OK; + TclWinConvertError(GetLastError()); } + break; + case DOTREE_POSTD: + return TCL_OK; } /* - * There shouldn't be a problem with src, because we already - * checked it to get here. + * There shouldn't be a problem with src, because we already checked it to + * get here. */ if (errorPtr != NULL) { @@ -1470,52 +1399,48 @@ TraversalCopy( * * TraversalDelete -- * - * Called by procedure TraverseWinTree for every file and - * directory that it encounters in a directory hierarchy. This - * procedure unlinks files, and removes directories after all the - * containing files have been processed. + * Called by function TraverseWinTree for every file and directory that + * it encounters in a directory hierarchy. This function unlinks files, + * and removes directories after all the containing files have been + * processed. * * Results: - * Standard Tcl result. + * Standard Tcl result. * * Side effects: - * Files or directory specified by src will be deleted. If an - * error occurs, the windows error is converted to a Posix error - * and errno is set accordingly. + * Files or directory specified by src will be deleted. If an error + * occurs, the windows error is converted to a Posix error and errno is + * set accordingly. * *---------------------------------------------------------------------- */ static int -TraversalDelete( - CONST TCHAR *nativeSrc, /* Source pathname to delete. */ - CONST TCHAR *dstPtr, /* Not used. */ +TraversalDelete( + const TCHAR *nativeSrc, /* Source pathname to delete. */ + const TCHAR *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. */ { switch (type) { - case DOTREE_F: { - if (TclpDeleteFile(nativeSrc) == TCL_OK) { - return TCL_OK; - } - break; - } - case DOTREE_LINK: { - if (DoRemoveJustDirectory(nativeSrc, 0, NULL) == TCL_OK) { - return TCL_OK; - } - break; + case DOTREE_F: + if (TclpDeleteFile(nativeSrc) == TCL_OK) { + return TCL_OK; } - case DOTREE_PRED: { + break; + case DOTREE_LINK: + if (DoRemoveJustDirectory(nativeSrc, 0, NULL) == TCL_OK) { return TCL_OK; } - case DOTREE_POSTD: { - if (DoRemoveJustDirectory(nativeSrc, 0, NULL) == TCL_OK) { - return TCL_OK; - } - break; + break; + case DOTREE_PRED: + return TCL_OK; + case DOTREE_POSTD: + if (DoRemoveJustDirectory(nativeSrc, 0, NULL) == TCL_OK) { + return TCL_OK; } + break; } if (errorPtr != NULL) { @@ -1532,11 +1457,11 @@ TraversalDelete( * Sets the object result with the appropriate error. * * Results: - * None. + * None. * * Side effects: - * The interp's object result is set with an error message - * based on the objIndex, fileName and errno. + * The interp's object result is set with an error message based on the + * objIndex, fileName and errno. * *---------------------------------------------------------------------- */ @@ -1544,12 +1469,12 @@ TraversalDelete( static void StatError( Tcl_Interp *interp, /* The interp that has the error */ - Tcl_Obj *fileName) /* The name of the file which caused the + Tcl_Obj *fileName) /* The name of the file which caused the * error. */ { TclWinConvertError(GetLastError()); - Tcl_AppendResult(interp, "could not read \"", Tcl_GetString(fileName), - "\": ", Tcl_PosixError(interp), (char *) NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("could not read \"%s\": %s", + TclGetString(fileName), Tcl_PosixError(interp))); } /* @@ -1557,16 +1482,16 @@ StatError( * * GetWinFileAttributes -- * - * Returns a Tcl_Obj containing the value of a file attribute. - * This routine gets the -hidden, -readonly or -system attribute. + * Returns a Tcl_Obj containing the value of a file attribute. This + * routine gets the -hidden, -readonly or -system attribute. * * Results: - * Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object - * will have ref count 0. If the return value is not TCL_OK, - * attributePtrPtr is not touched. + * Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object will + * have ref count 0. If the return value is not TCL_OK, attributePtrPtr + * is not touched. * * Side effects: - * A new object is allocated if the file is valid. + * A new object is allocated if the file is valid. * *---------------------------------------------------------------------- */ @@ -1575,15 +1500,15 @@ static int GetWinFileAttributes( Tcl_Interp *interp, /* The interp we are using for errors. */ int objIndex, /* The index of the attribute. */ - Tcl_Obj *fileName, /* The name of the file. */ + Tcl_Obj *fileName, /* The name of the file. */ Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ { DWORD result; - CONST TCHAR *nativeName; + const TCHAR *nativeName; int attr; - + nativeName = Tcl_FSGetNativePath(fileName); - result = (*tclWinProcs->getFileAttributesProc)(nativeName); + result = GetFileAttributes(nativeName); if (result == 0xffffffff) { StatError(interp, fileName); @@ -1592,31 +1517,39 @@ GetWinFileAttributes( attr = (int)(result & attributeArray[objIndex]); if ((objIndex == WIN_HIDDEN_ATTRIBUTE) && (attr != 0)) { - /* - * It is hidden. However there is a bug on some Windows - * OSes in which root volumes (drives) formatted as NTFS - * are declared hidden when they are not (and cannot be). - * + /* + * It is hidden. However there is a bug on some Windows OSes in which + * root volumes (drives) formatted as NTFS are declared hidden when + * they are not (and cannot be). + * * We test for, and fix that case, here. */ + int len; - char *str = Tcl_GetStringFromObj(fileName,&len); + const char *str = Tcl_GetStringFromObj(fileName,&len); + if (len < 4) { if (len == 0) { - /* - * Not sure if this is possible, but we pass it on - * anyway + /* + * Not sure if this is possible, but we pass it on anyway. */ } else if (len == 1 && (str[0] == '/' || str[0] == '\\')) { - /* Path is pointing to the root volume */ + /* + * Path is pointing to the root volume. + */ + attr = 0; - } else if ((str[1] == ':') + } else if ((str[1] == ':') && (len == 2 || (str[2] == '/' || str[2] == '\\'))) { - /* Path is of the form 'x:' or 'x:/' or 'x:\' */ + /* + * Path is of the form 'x:' or 'x:/' or 'x:\' + */ + attr = 0; } } } + *attributePtrPtr = Tcl_NewBooleanObj(attr); return TCL_OK; } @@ -1626,21 +1559,20 @@ GetWinFileAttributes( * * ConvertFileNameFormat -- * - * Returns a Tcl_Obj containing either the long or short version of the + * Returns a Tcl_Obj containing either the long or short version of the * file name. * * Results: - * Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object - * will have ref count 0. If the return value is not TCL_OK, - * attributePtrPtr is not touched. - * - * Warning: if you pass this function a drive name like 'c:' it - * will actually return the current working directory on that - * drive. To avoid this, make sure the drive name ends in a - * slash, like this 'c:/'. + * Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object will + * have ref count 0. If the return value is not TCL_OK, attributePtrPtr + * is not touched. + * + * Warning: if you pass this function a drive name like 'c:' it will + * actually return the current working directory on that drive. To avoid + * this, make sure the drive name ends in a slash, like this 'c:/'. * * Side effects: - * A new object is allocated if the file is valid. + * A new object is allocated if the file is valid. * *---------------------------------------------------------------------- */ @@ -1649,7 +1581,7 @@ static int ConvertFileNameFormat( Tcl_Interp *interp, /* The interp we are using for errors. */ int objIndex, /* The index of the attribute. */ - Tcl_Obj *fileName, /* The name of the file. */ + Tcl_Obj *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. */ { @@ -1657,75 +1589,84 @@ ConvertFileNameFormat( Tcl_Obj *splitPath; splitPath = Tcl_FSSplitPath(fileName, &pathc); - + if (splitPath == NULL || pathc == 0) { if (interp != NULL) { - Tcl_AppendResult(interp, "could not read \"", - Tcl_GetString(fileName), "\": no such file or directory", - (char *) NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "could not read \"%s\": no such file or directory", + Tcl_GetString(fileName))); + errno = ENOENT; + Tcl_PosixError(interp); } goto cleanup; } - + /* - * We will decrement this again at the end. It is safer to - * do this in case any of the calls below retain a reference - * to splitPath. + * We will decrement this again at the end. It is safer to do this in + * case any of the calls below retain a reference to splitPath. */ + Tcl_IncrRefCount(splitPath); for (i = 0; i < pathc; i++) { Tcl_Obj *elt; char *pathv; int pathLen; + Tcl_ListObjIndex(NULL, splitPath, i, &elt); - + pathv = Tcl_GetStringFromObj(elt, &pathLen); if ((pathv[0] == '/') || ((pathLen == 3) && (pathv[1] == ':')) || (strcmp(pathv, ".") == 0) || (strcmp(pathv, "..") == 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. + * copying the string literally. Uppercase the drive letter, just + * because it looks better under Windows to do so. + */ + + simple: + /* + * Here we are modifying the string representation in place. + * + * I believe this is legal, since this won't affect any file + * representation this thing may have. */ - simple: - /* Here we are modifying the string representation in place */ - /* I believe this is legal, since this won't affect any - * file representation this thing may have. */ pathv[0] = (char) Tcl_UniCharToUpper(UCHAR(pathv[0])); } else { Tcl_Obj *tempPath; Tcl_DString ds; Tcl_DString dsTemp; - TCHAR *nativeName; - char *tempString; + const TCHAR *nativeName; + const char *tempString; int tempLen; - WIN32_FIND_DATAT data; + WIN32_FIND_DATA data; HANDLE handle; DWORD attr; tempPath = Tcl_FSJoinPath(splitPath, i+1); Tcl_IncrRefCount(tempPath); - /* - * We'd like to call Tcl_FSGetNativePath(tempPath) - * but that is likely to lead to infinite loops + + /* + * We'd like to call Tcl_FSGetNativePath(tempPath) but that is + * likely to lead to infinite loops. */ + Tcl_DStringInit(&ds); tempString = Tcl_GetStringFromObj(tempPath,&tempLen); nativeName = Tcl_WinUtfToTChar(tempString, tempLen, &ds); Tcl_DecrRefCount(tempPath); - handle = (*tclWinProcs->findFirstFileProc)(nativeName, &data); + handle = FindFirstFile(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 + * 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)) { + attr = GetFileAttributes(nativeName); + if ((attr!=0xFFFFFFFF) && (attr & FILE_ATTRIBUTE_DIRECTORY)) { Tcl_DStringFree(&ds); goto simple; } @@ -1738,37 +1679,24 @@ ConvertFileNameFormat( } goto cleanup; } - if (tclWinProcs->useWide) { - nativeName = (TCHAR *) data.w.cAlternateFileName; - if (longShort) { - if (data.w.cFileName[0] != '\0') { - nativeName = (TCHAR *) data.w.cFileName; - } - } else { - if (data.w.cAlternateFileName[0] == '\0') { - nativeName = (TCHAR *) data.w.cFileName; - } + nativeName = data.cAlternateFileName; + if (longShort) { + if (data.cFileName[0] != '\0') { + nativeName = data.cFileName; } } else { - nativeName = (TCHAR *) data.a.cAlternateFileName; - if (longShort) { - if (data.a.cFileName[0] != '\0') { - nativeName = (TCHAR *) data.a.cFileName; - } - } else { - if (data.a.cAlternateFileName[0] == '\0') { - nativeName = (TCHAR *) data.a.cFileName; - } + if (data.cAlternateFileName[0] == '\0') { + nativeName = (TCHAR *) data.cFileName; } } /* - * 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. + * 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]); @@ -1776,32 +1704,36 @@ ConvertFileNameFormat( Tcl_DStringInit(&dsTemp); Tcl_WinTCharToUtf(nativeName, -1, &dsTemp); - /* Deal with issues of tildes being absolute */ + Tcl_DStringFree(&ds); + + /* + * 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)); + TclNewLiteralStringObj(tempPath, "./"); + Tcl_AppendToObj(tempPath, Tcl_DStringValue(&dsTemp), + Tcl_DStringLength(&dsTemp)); + Tcl_DStringFree(&dsTemp); } else { - tempPath = Tcl_NewStringObj(Tcl_DStringValue(&dsTemp), - Tcl_DStringLength(&dsTemp)); + tempPath = TclDStringToObj(&dsTemp); } Tcl_ListObjReplace(NULL, splitPath, i, 1, 1, &tempPath); - Tcl_DStringFree(&ds); - Tcl_DStringFree(&dsTemp); FindClose(handle); } } *attributePtrPtr = Tcl_FSJoinPath(splitPath, -1); - + if (splitPath != NULL) { - /* - * Unfortunately, the object we will return may have its only - * refCount as part of the list splitPath. This means if - * we free splitPath, the object will disappear. So, we - * have to be very careful here. Unfortunately this means - * we must manipulate the object's refCount directly. + /* + * Unfortunately, the object we will return may have its only refCount + * as part of the list splitPath. This means if we free splitPath, the + * object will disappear. So, we have to be very careful here. + * Unfortunately this means we must manipulate the object's refCount + * directly. */ + Tcl_IncrRefCount(*attributePtrPtr); Tcl_DecrRefCount(splitPath); --(*attributePtrPtr)->refCount; @@ -1812,7 +1744,7 @@ ConvertFileNameFormat( if (splitPath != NULL) { Tcl_DecrRefCount(splitPath); } - + return TCL_ERROR; } @@ -1821,16 +1753,15 @@ ConvertFileNameFormat( * * GetWinFileLongName -- * - * Returns a Tcl_Obj containing the long version of the file - * name. + * Returns a Tcl_Obj containing the long version of the file name. * * Results: - * Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object - * will have ref count 0. If the return value is not TCL_OK, - * attributePtrPtr is not touched. + * Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object will + * have ref count 0. If the return value is not TCL_OK, attributePtrPtr + * is not touched. * * Side effects: - * A new object is allocated if the file is valid. + * A new object is allocated if the file is valid. * *---------------------------------------------------------------------- */ @@ -1839,10 +1770,11 @@ static int GetWinFileLongName( Tcl_Interp *interp, /* The interp we are using for errors. */ int objIndex, /* The index of the attribute. */ - Tcl_Obj *fileName, /* The name of the file. */ + Tcl_Obj *fileName, /* The name of the file. */ Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ { - return ConvertFileNameFormat(interp, objIndex, fileName, 1, attributePtrPtr); + return ConvertFileNameFormat(interp, objIndex, fileName, 1, + attributePtrPtr); } /* @@ -1850,16 +1782,15 @@ GetWinFileLongName( * * GetWinFileShortName -- * - * Returns a Tcl_Obj containing the short version of the file - * name. + * Returns a Tcl_Obj containing the short version of the file name. * * Results: - * Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object - * will have ref count 0. If the return value is not TCL_OK, - * attributePtrPtr is not touched. + * Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object will + * have ref count 0. If the return value is not TCL_OK, attributePtrPtr + * is not touched. * * Side effects: - * A new object is allocated if the file is valid. + * A new object is allocated if the file is valid. * *---------------------------------------------------------------------- */ @@ -1868,10 +1799,11 @@ static int GetWinFileShortName( Tcl_Interp *interp, /* The interp we are using for errors. */ int objIndex, /* The index of the attribute. */ - Tcl_Obj *fileName, /* The name of the file. */ + Tcl_Obj *fileName, /* The name of the file. */ Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ { - return ConvertFileNameFormat(interp, objIndex, fileName, 0, attributePtrPtr); + return ConvertFileNameFormat(interp, objIndex, fileName, 0, + attributePtrPtr); } /* @@ -1879,14 +1811,14 @@ GetWinFileShortName( * * SetWinFileAttributes -- * - * Set the file attributes to the value given by attributePtr. - * This routine sets the -hidden, -readonly, or -system attributes. + * Set the file attributes to the value given by attributePtr. This + * routine sets the -hidden, -readonly, or -system attributes. * * Results: - * Standard TCL error. + * Standard TCL error. * * Side effects: - * The file's attribute is set. + * The file's attribute is set. * *---------------------------------------------------------------------- */ @@ -1895,16 +1827,15 @@ static int SetWinFileAttributes( Tcl_Interp *interp, /* The interp we are using for errors. */ int objIndex, /* The index of the attribute. */ - Tcl_Obj *fileName, /* The name of the file. */ + Tcl_Obj *fileName, /* The name of the file. */ Tcl_Obj *attributePtr) /* The new value of the attribute. */ { - DWORD fileAttributes; - int yesNo; - int result; - CONST TCHAR *nativeName; + DWORD fileAttributes, old; + int yesNo, result; + const TCHAR *nativeName; nativeName = Tcl_FSGetNativePath(fileName); - fileAttributes = (*tclWinProcs->getFileAttributesProc)(nativeName); + fileAttributes = old = GetFileAttributes(nativeName); if (fileAttributes == 0xffffffff) { StatError(interp, fileName); @@ -1922,7 +1853,8 @@ SetWinFileAttributes( fileAttributes &= ~(attributeArray[objIndex]); } - if (!(*tclWinProcs->setFileAttributesProc)(nativeName, fileAttributes)) { + if ((fileAttributes != old) + && !SetFileAttributes(nativeName, fileAttributes)) { StatError(interp, fileName); return TCL_ERROR; } @@ -1935,14 +1867,13 @@ SetWinFileAttributes( * * SetWinFileLongName -- * - * The attribute in question is a readonly attribute and cannot - * be set. + * The attribute in question is a readonly attribute and cannot be set. * * Results: - * TCL_ERROR + * TCL_ERROR * * Side effects: - * The object result is set to a pertinent error message. + * The object result is set to a pertinent error message. * *---------------------------------------------------------------------- */ @@ -1951,16 +1882,16 @@ static int CannotSetAttribute( Tcl_Interp *interp, /* The interp we are using for errors. */ int objIndex, /* The index of the attribute. */ - Tcl_Obj *fileName, /* The name of the file. */ + Tcl_Obj *fileName, /* The name of the file. */ Tcl_Obj *attributePtr) /* The new value of the attribute. */ { - Tcl_AppendResult(interp, "cannot set attribute \"", - tclpFileAttrStrings[objIndex], "\" for file \"", - Tcl_GetString(fileName), "\": attribute is readonly", - (char *) NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "cannot set attribute \"%s\" for file \"%s\": attribute is readonly", + tclpFileAttrStrings[objIndex], Tcl_GetString(fileName))); + errno = EINVAL; + Tcl_PosixError(interp); return TCL_ERROR; } - /* *--------------------------------------------------------------------------- @@ -1978,7 +1909,7 @@ CannotSetAttribute( *--------------------------------------------------------------------------- */ -Tcl_Obj* +Tcl_Obj * TclpObjListVolumes(void) { Tcl_Obj *resultPtr, *elemPtr; @@ -1997,11 +1928,11 @@ TclpObjListVolumes(void) 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. + * 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] = ':'; @@ -2023,7 +1954,15 @@ TclpObjListVolumes(void) Tcl_ListObjAppendElement(NULL, resultPtr, elemPtr); } } - + Tcl_IncrRefCount(resultPtr); return resultPtr; } + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ |