summaryrefslogtreecommitdiffstats
path: root/win/tclWinFCmd.c
diff options
context:
space:
mode:
Diffstat (limited to 'win/tclWinFCmd.c')
-rw-r--r--win/tclWinFCmd.c1230
1 files changed, 666 insertions, 564 deletions
diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c
index 32e1656..a1338a7 100644
--- a/win/tclWinFCmd.c
+++ b/win/tclWinFCmd.c
@@ -1,13 +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.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include "tclWinInt.h"
@@ -17,29 +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_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.
@@ -74,18 +70,17 @@ CONST TclFileAttrProcs tclpFileAttrProcs[] = {
#ifdef HAVE_NO_SEH
/*
- * Unlike Borland and Microsoft, we don't register exception handlers
- * by pushing registration records onto the runtime stack. Instead, we
- * register them by creating an EXCEPTION_REGISTRATION within the activation
- * record.
+ * Unlike Borland and Microsoft, we don't register exception handlers by
+ * pushing registration records onto the runtime stack. Instead, we register
+ * them by creating an EXCEPTION_REGISTRATION within the activation record.
*/
typedef struct EXCEPTION_REGISTRATION {
- struct EXCEPTION_REGISTRATION* link;
- EXCEPTION_DISPOSITION (*handler)( struct _EXCEPTION_RECORD*, void*,
- struct _CONTEXT*, void* );
- void* ebp;
- void* esp;
+ struct EXCEPTION_REGISTRATION *link;
+ EXCEPTION_DISPOSITION (*handler)(
+ struct _EXCEPTION_RECORD *, void *, struct _CONTEXT *, void *);
+ void *ebp;
+ void *esp;
int status;
} EXCEPTION_REGISTRATION;
@@ -95,191 +90,195 @@ typedef struct EXCEPTION_REGISTRATION {
* 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 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). */
+ * (native). */
CONST TCHAR *nativeDst) /* New pathname for file or directory
* (native). */
-{
-#ifdef HAVE_NO_SEH
+{
+#if defined(HAVE_NO_SEH) && !defined(_WIN64)
EXCEPTION_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' ||
- nativeDst == NULL || nativeDst[0] == '\0') {
+ nativeDst == NULL || nativeDst[0] == '\0') {
Tcl_SetErrno(ENOENT);
return TCL_ERROR;
}
/*
- * 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.
*/
#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.
+ * 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__ (
/*
- * Pick up params before messing with the stack */
+ * Pick up params before messing with the stack.
+ */
"movl %[nativeDst], %%ebx" "\n\t"
- "movl %[nativeSrc], %%ecx" "\n\t"
+ "movl %[nativeSrc], %%ecx" "\n\t"
/*
- * Construct an EXCEPTION_REGISTRATION to protect the
- * call to MoveFile
+ * Construct an EXCEPTION_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 EXCEPTION_REGISTRATION on the chain */
-
- "movl %%edx, %%fs:0" "\n\t"
-
- /* Call MoveFile( nativeSrc, nativeDst ) */
-
+
+ "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 EXCEPTION_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 EXCEPTION_REGISTRATION
- * and put the status return from MoveFile into it.
+
+ /*
+ * Come here on normal exit. Recover the EXCEPTION_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 EXCEPTION_REGISTRATION
+ * Come here on an exception. Recover the EXCEPTION_REGISTRATION
*/
-
+
"1:" "\t"
- "movl %%fs:0, %%edx" "\n\t"
- "movl 0x8(%%edx), %%edx" "\n\t"
-
- /*
- * Come here however we exited. Restore context from the
+ "movl %%fs:0, %%edx" "\n\t"
+ "movl 0x8(%%edx), %%edx" "\n\t"
+
+ /*
+ * Come here however we exited. Restore context from the
* EXCEPTION_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"
-
+
+ "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" (tclWinProcs->moveFileProc)
- :
+ :
+ [registration] "m" (registration),
+ [nativeDst] "m" (nativeDst),
+ [nativeSrc] "m" (nativeSrc),
+ [moveFile] "r" (tclWinProcs->moveFileProc)
+ :
"%eax", "%ebx", "%ecx", "%edx", "memory"
- );
+ );
if (registration.status != FALSE) {
retval = TCL_OK;
}
@@ -295,22 +294,25 @@ DoRenameFile(
#endif
#endif
- if (retval != -1)
- return retval;
+ if (retval != -1) {
+ return retval;
+ }
TclWinConvertError(GetLastError());
srcAttr = (*tclWinProcs->getFileAttributesProc)(nativeSrc);
dstAttr = (*tclWinProcs->getFileAttributesProc)(nativeDst);
if (srcAttr == 0xffffffff) {
- if ((*tclWinProcs->getFullPathNameProc)(nativeSrc, 0, NULL, NULL) >= MAX_PATH) {
+ if ((*tclWinProcs->getFullPathNameProc)(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 ((*tclWinProcs->getFullPathNameProc)(nativeDst, 0, NULL,
+ NULL) >= MAX_PATH) {
errno = ENAMETOOLONG;
return TCL_ERROR;
}
@@ -322,7 +324,7 @@ DoRenameFile(
return TCL_ERROR;
}
if (errno == EACCES) {
- decode:
+ decode:
if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) {
TCHAR *nativeSrcRest, *nativeDstRest;
CONST char **srcArgv, **dstArgv;
@@ -332,12 +334,12 @@ DoRenameFile(
Tcl_DString srcString, dstString;
CONST char *src, *dst;
- size = (*tclWinProcs->getFullPathNameProc)(nativeSrc, MAX_PATH,
+ size = (*tclWinProcs->getFullPathNameProc)(nativeSrc, MAX_PATH,
nativeSrcPath, &nativeSrcRest);
if ((size == 0) || (size > MAX_PATH)) {
return TCL_ERROR;
}
- size = (*tclWinProcs->getFullPathNameProc)(nativeDst, MAX_PATH,
+ size = (*tclWinProcs->getFullPathNameProc)(nativeDst, MAX_PATH,
nativeDstPath, &nativeDstRest);
if ((size == 0) || (size > MAX_PATH)) {
return TCL_ERROR;
@@ -347,7 +349,17 @@ DoRenameFile(
src = Tcl_WinTCharToUtf((TCHAR *) nativeSrcPath, -1, &srcString);
dst = Tcl_WinTCharToUtf((TCHAR *) nativeDstPath, -1, &dstString);
- if (strncmp(src, dst, (size_t) Tcl_DStringLength(&srcString)) == 0) {
+
+ /*
+ * Check whether the destination path is actually inside the
+ * 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)
+ && (dst[Tcl_DStringLength(&srcString)] == '\\'
+ || dst[Tcl_DStringLength(&srcString)] == '/'
+ || dst[Tcl_DStringLength(&srcString)] == '\0')) {
/*
* Trying to move a directory into itself.
*/
@@ -364,22 +376,20 @@ 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);
@@ -391,39 +401,40 @@ DoRenameFile(
/*
* 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 ((*tclWinProcs->moveFileProc)(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());
@@ -446,18 +457,18 @@ 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,
+
+ size = (*tclWinProcs->getFullPathNameProc)(nativeDst, MAX_PATH,
tempBuf, &nativeRest);
if ((size == 0) || (size > MAX_PATH) || (nativeRest == NULL)) {
return TCL_ERROR;
@@ -467,9 +478,9 @@ DoRenameFile(
((char *) nativeRest)[1] = '\0'; /* In case it's Unicode. */
result = TCL_ERROR;
- nativePrefix = (tclWinProcs->useWide)
+ nativePrefix = (tclWinProcs->useWide)
? (TCHAR *) L"tclr" : (TCHAR *) "tclr";
- if ((*tclWinProcs->getTempFileNameProc)(nativeTmp,
+ if ((*tclWinProcs->getTempFileNameProc)(nativeTmp,
nativePrefix, 0, tempBuf) != 0) {
/*
* Strictly speaking, need the following DeleteFile and
@@ -477,12 +488,14 @@ DoRenameFile(
* 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,
+ if ((*tclWinProcs->moveFileProc)(nativeDst,
+ nativeTmp) != FALSE) {
+ if ((*tclWinProcs->moveFileProc)(nativeSrc,
+ nativeDst) != FALSE) {
+ (*tclWinProcs->setFileAttributesProc)(nativeTmp,
FILE_ATTRIBUTE_NORMAL);
(*tclWinProcs->deleteFileProc)(nativeTmp);
return TCL_OK;
@@ -490,11 +503,11 @@ DoRenameFile(
(*tclWinProcs->deleteFileProc)(nativeDst);
(*tclWinProcs->moveFileProc)(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());
@@ -518,19 +531,19 @@ DoRenameFile(
*
* 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)
*
@@ -540,48 +553,46 @@ DoRenameFile(
*---------------------------------------------------------------------------
*/
-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). */
{
-#ifdef HAVE_NO_SEH
+#if defined(HAVE_NO_SEH) && !defined(_WIN64)
EXCEPTION_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' ||
- nativeDst == NULL || nativeDst[0] == '\0') {
+ nativeDst == NULL || nativeDst[0] == '\0') {
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.
*/
#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.
+ * 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__ (
@@ -590,71 +601,77 @@ DoCopyFile(
* Pick up parameters before messing with the stack
*/
- "movl %[nativeDst], %%ebx" "\n\t"
- "movl %[nativeSrc], %%ecx" "\n\t"
+ "movl %[nativeDst], %%ebx" "\n\t"
+ "movl %[nativeSrc], %%ecx" "\n\t"
+
+ /*
+ * Construct an EXCEPTION_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 EXCEPTION_REGISTRATION on the chain.
+ */
+
+ "movl %%edx, %%fs:0" "\n\t"
+
/*
- * Construct an EXCEPTION_REGISTRATION to protect the
- * call to CopyFile
+ * Call CopyFile(nativeSrc, nativeDst, 0)
*/
- "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 EXCEPTION_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 $0" "\n\t"
"pushl %%ebx" "\n\t"
"pushl %%ecx" "\n\t"
"call *%%eax" "\n\t"
-
- /*
- * Come here on normal exit. Recover the EXCEPTION_REGISTRATION
- * and put the status return from CopyFile into it.
+
+ /*
+ * Come here on normal exit. Recover the EXCEPTION_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 EXCEPTION_REGISTRATION
+ * Come here on an exception. Recover the EXCEPTION_REGISTRATION
*/
-
+
"1:" "\t"
- "movl %%fs:0, %%edx" "\n\t"
- "movl 0x8(%%edx), %%edx" "\n\t"
-
- /*
- * Come here however we exited. Restore context from the
+ "movl %%fs:0, %%edx" "\n\t"
+ "movl 0x8(%%edx), %%edx" "\n\t"
+
+ /*
+ * Come here however we exited. Restore context from the
* EXCEPTION_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"
-
+
+ "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" (tclWinProcs->copyFileProc)
- :
+ :
+ [registration] "m" (registration),
+ [nativeDst] "m" (nativeDst),
+ [nativeSrc] "m" (nativeSrc),
+ [copyFile] "r" (tclWinProcs->copyFileProc)
+ :
"%eax", "%ebx", "%ecx", "%edx", "memory"
- );
+ );
if (registration.status != FALSE) {
retval = TCL_OK;
}
@@ -670,8 +687,9 @@ DoCopyFile(
#endif
#endif
- if (retval != -1)
- return retval;
+ if (retval != -1) {
+ return retval;
+ }
TclWinConvertError(GetLastError());
if (Tcl_GetErrno() == EBADF) {
@@ -691,21 +709,23 @@ 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,
+ (*tclWinProcs->setFileAttributesProc)(nativeDst,
dstAttr & ~((DWORD)FILE_ATTRIBUTE_READONLY));
- if ((*tclWinProcs->copyFileProc)(nativeSrc, nativeDst, 0) != FALSE) {
+ if ((*tclWinProcs->copyFileProc)(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());
@@ -721,29 +741,29 @@ DoCopyFile(
*
* 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));
}
@@ -755,8 +775,8 @@ TclpDeleteFile(
DWORD attr;
/*
- * 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') {
@@ -770,27 +790,30 @@ TclpDeleteFile(
TclWinConvertError(GetLastError());
if (Tcl_GetErrno() == EACCES) {
- attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
+ attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
if (attr != 0xffffffff) {
if (attr & FILE_ATTRIBUTE_DIRECTORY) {
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;
+ 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,
+ int res = (*tclWinProcs->setFileAttributesProc)(nativePath,
attr & ~((DWORD)FILE_ATTRIBUTE_READONLY));
+
if ((res != 0) && ((*tclWinProcs->deleteFileProc)(nativePath)
!= FALSE)) {
return TCL_OK;
@@ -802,12 +825,12 @@ TclpDeleteFile(
}
}
} else if (Tcl_GetErrno() == ENOENT) {
- attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
+ attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
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);
@@ -830,29 +853,29 @@ 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));
}
@@ -866,7 +889,7 @@ DoCreateDirectory(
error = GetLastError();
TclWinConvertError(error);
return TCL_ERROR;
- }
+ }
return TCL_OK;
}
@@ -875,32 +898,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;
@@ -908,14 +929,12 @@ TclpObjCopyDirectory(srcPathPtr, destPathPtr, errorPtr)
int ret;
normSrcPtr = Tcl_FSGetNormalizedPath(NULL,srcPathPtr);
- if (normSrcPtr == NULL) {
- return TCL_ERROR;
- }
- Tcl_WinUtfToTChar(Tcl_GetString(normSrcPtr), -1, &srcString);
normDestPtr = Tcl_FSGetNormalizedPath(NULL,destPathPtr);
- if (normDestPtr == NULL) {
+ 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);
@@ -924,9 +943,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);
@@ -940,47 +959,49 @@ 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) {
@@ -990,14 +1011,14 @@ TclpObjRemoveDirectory(pathPtr, recursive, errorPtr)
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 (normPtr != NULL
- && !strcmp(Tcl_DStringValue(&ds), Tcl_GetString(normPtr))) {
+ if (normPtr != NULL &&
+ !strcmp(Tcl_DStringValue(&ds), TclGetString(normPtr))) {
*errorPtr = pathPtr;
} else {
*errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
@@ -1006,6 +1027,7 @@ TclpObjRemoveDirectory(pathPtr, recursive, errorPtr)
}
Tcl_DStringFree(&ds);
}
+
return ret;
}
@@ -1013,16 +1035,17 @@ static int
DoRemoveJustDirectory(
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') {
@@ -1030,48 +1053,68 @@ DoRemoveJustDirectory(
goto end;
}
- if ((*tclWinProcs->removeDirectoryProc)(nativePath) != FALSE) {
- return TCL_OK;
+ attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
+
+ if (attr & FILE_ATTRIBUTE_REPARSE_POINT) {
+ /*
+ * It is a symbolic link - remove it.
+ */
+ if (TclWinSymLinkDelete(nativePath, 0) == 0) {
+ return TCL_OK;
+ }
+ } else {
+ /*
+ * Ordinary directory.
+ */
+
+ if ((*tclWinProcs->removeDirectoryProc)(nativePath) != FALSE) {
+ return TCL_OK;
+ }
}
+
TclWinConvertError(GetLastError());
if (Tcl_GetErrno() == EACCES) {
- DWORD attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
+ attr = (*tclWinProcs->getFileAttributesProc)(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 ((*tclWinProcs->setFileAttributesProc)(nativePath,
+ attr) == FALSE) {
goto end;
}
if ((*tclWinProcs->removeDirectoryProc)(nativePath) != FALSE) {
return TCL_OK;
}
TclWinConvertError(GetLastError());
- (*tclWinProcs->setFileAttributesProc)(nativePath,
+ (*tclWinProcs->setFileAttributesProc)(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.
+ /*
+ * 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) {
@@ -1112,24 +1155,25 @@ DoRemoveJustDirectory(
}
}
}
+
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) {
Tcl_WinTCharToUtf(nativePath, -1, errorPtr);
}
@@ -1141,21 +1185,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(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;
@@ -1167,24 +1212,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. */
@@ -1193,13 +1238,13 @@ 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;
@@ -1208,15 +1253,25 @@ TraverseWinTree(
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);
if (sourceAttr == 0xffffffff) {
nativeErrfile = nativeSource;
goto end;
}
+
+ if (sourceAttr & FILE_ATTRIBUTE_REPARSE_POINT) {
+ /*
+ * Process the symbolic link
+ */
+
+ return (*traverseProc)(nativeSource, nativeTarget, DOTREE_LINK,
+ errorPtr);
+ }
+
if ((sourceAttr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
/*
* Process the regular file
@@ -1231,11 +1286,12 @@ TraverseWinTree(
} else {
Tcl_DStringAppend(sourcePtr, "\\*.*", 4);
}
+
nativeSource = (TCHAR *) Tcl_DStringValue(sourcePtr);
handle = (*tclWinProcs->findFirstFileProc)(nativeSource, &data);
- if (handle == INVALID_HANDLE_VALUE) {
- /*
- * Can't read directory
+ if (handle == INVALID_HANDLE_VALUE) {
+ /*
+ * Can't read directory.
*/
TclWinConvertError(GetLastError());
@@ -1245,7 +1301,8 @@ TraverseWinTree(
nativeSource[oldSourceLen + 1] = '\0';
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;
@@ -1276,7 +1333,7 @@ TraverseWinTree(
}
found = 1;
- for ( ; found; found = (*tclWinProcs->findNextFileProc)(handle, &data)) {
+ for (; found; found = (*tclWinProcs->findNextFileProc)(handle, &data)) {
TCHAR *nativeName;
int len;
@@ -1296,7 +1353,7 @@ TraverseWinTree(
nativeName = (TCHAR *) data.w.cFileName;
len = wcslen(data.w.cFileName) * sizeof(WCHAR);
} else {
- if ((strcmp(data.a.cFileName, ".") == 0)
+ if ((strcmp(data.a.cFileName, ".") == 0)
|| (strcmp(data.a.cFileName, "..") == 0)) {
continue;
}
@@ -1304,8 +1361,8 @@ TraverseWinTree(
len = strlen(data.a.cFileName);
}
- /*
- * 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);
@@ -1314,7 +1371,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;
@@ -1332,7 +1389,7 @@ TraverseWinTree(
FindClose(handle);
/*
- * Strip off the trailing slash we added
+ * Strip off the trailing slash we added.
*/
Tcl_DStringSetLength(sourcePtr, oldSourceLen + 1);
@@ -1347,11 +1404,12 @@ TraverseWinTree(
* files in that directory.
*/
- result = (*traverseProc)(Tcl_DStringValue(sourcePtr),
- (targetPtr == NULL ? NULL : Tcl_DStringValue(targetPtr)),
- DOTREE_POSTD, errorPtr);
+ result = (*traverseProc)(Tcl_DStringValue(sourcePtr),
+ (targetPtr == NULL ? NULL : Tcl_DStringValue(targetPtr)),
+ DOTREE_POSTD, errorPtr);
}
- end:
+
+ end:
if (nativeErrfile != NULL) {
TclWinConvertError(GetLastError());
if (errorPtr != NULL) {
@@ -1368,19 +1426,19 @@ 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. */
@@ -1389,30 +1447,34 @@ TraversalCopy(
* 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_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_F:
+ if (DoCopyFile(nativeSrc, nativeDst) == TCL_OK) {
+ return TCL_OK;
}
- case DOTREE_POSTD: {
+ break;
+ case DOTREE_LINK:
+ if (TclWinSymLinkCopyDirectory(nativeSrc, nativeDst) == TCL_OK) {
return TCL_OK;
}
+ break;
+ 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_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) {
@@ -1426,24 +1488,24 @@ 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(
+TraversalDelete(
CONST TCHAR *nativeSrc, /* Source pathname to delete. */
CONST TCHAR *dstPtr, /* Not used. */
int type, /* Reason for call - see TraverseWinTree() */
@@ -1451,21 +1513,23 @@ TraversalDelete(
* with UTF-8 name of file causing error. */
{
switch (type) {
- case DOTREE_F: {
- if (TclpDeleteFile(nativeSrc) == 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) {
@@ -1482,11 +1546,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.
*
*----------------------------------------------------------------------
*/
@@ -1494,14 +1558,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_AppendStringsToObj(Tcl_GetObjResult(interp),
- "could not read \"", Tcl_GetString(fileName),
- "\": ", Tcl_PosixError(interp),
- (char *) NULL);
+ Tcl_AppendResult(interp, "could not read \"", TclGetString(fileName),
+ "\": ", Tcl_PosixError(interp), (char *) NULL);
}
/*
@@ -1509,16 +1571,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.
*
*----------------------------------------------------------------------
*/
@@ -1527,13 +1589,13 @@ 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;
int attr;
-
+
nativeName = Tcl_FSGetNativePath(fileName);
result = (*tclWinProcs->getFileAttributesProc)(nativeName);
@@ -1544,31 +1606,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);
+
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] == ':')
- && (len == 2 || (str[2] == '/' || str[2] == '\\'))) {
- /* Path is of the form 'x:' or 'x:/' or 'x:\' */
+ } else if ((str[1] == ':')
+ && (len == 2 || (str[2] == '/' || str[2] == '\\'))) {
+ /*
+ * Path is of the form 'x:' or 'x:/' or 'x:\'
+ */
+
attr = 0;
}
}
}
+
*attributePtrPtr = Tcl_NewBooleanObj(attr);
return TCL_OK;
}
@@ -1578,21 +1648,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.
*
*----------------------------------------------------------------------
*/
@@ -1601,48 +1670,55 @@ 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. */
{
int pathc, i;
Tcl_Obj *splitPath;
- int result = TCL_OK;
splitPath = Tcl_FSSplitPath(fileName, &pathc);
if (splitPath == NULL || pathc == 0) {
if (interp != NULL) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "could not read \"", Tcl_GetString(fileName),
- "\": no such file or directory",
- (char *) NULL);
+ Tcl_AppendResult(interp, "could not read \"",
+ Tcl_GetString(fileName), "\": no such file or directory",
+ (char *) NULL);
}
- result = TCL_ERROR;
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.
+ */
+
+ 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)) {
+ 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;
@@ -1657,10 +1733,12 @@ ConvertFileNameFormat(
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);
@@ -1668,14 +1746,14 @@ ConvertFileNameFormat(
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
+ * 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)) {
+ if ((attr!=0xFFFFFFFF) && (attr & FILE_ATTRIBUTE_DIRECTORY)) {
Tcl_DStringFree(&ds);
goto simple;
}
@@ -1686,7 +1764,6 @@ ConvertFileNameFormat(
if (interp != NULL) {
StatError(interp, fileName);
}
- result = TCL_ERROR;
goto cleanup;
}
if (tclWinProcs->useWide) {
@@ -1694,7 +1771,7 @@ ConvertFileNameFormat(
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;
@@ -1705,7 +1782,7 @@ ConvertFileNameFormat(
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;
@@ -1714,12 +1791,12 @@ ConvertFileNameFormat(
}
/*
- * 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]);
@@ -1727,14 +1804,18 @@ ConvertFileNameFormat(
Tcl_DStringInit(&dsTemp);
Tcl_WinTCharToUtf(nativeName, -1, &dsTemp);
- /* Deal with issues of tildes being absolute */
+
+ /*
+ * 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));
+ Tcl_AppendToObj(tempPath, Tcl_DStringValue(&dsTemp),
+ Tcl_DStringLength(&dsTemp));
} else {
- tempPath = Tcl_NewStringObj(Tcl_DStringValue(&dsTemp),
- Tcl_DStringLength(&dsTemp));
+ tempPath = Tcl_NewStringObj(Tcl_DStringValue(&dsTemp),
+ Tcl_DStringLength(&dsTemp));
}
Tcl_ListObjReplace(NULL, splitPath, i, 1, 1, &tempPath);
Tcl_DStringFree(&ds);
@@ -1745,12 +1826,27 @@ ConvertFileNameFormat(
*attributePtrPtr = Tcl_FSJoinPath(splitPath, -1);
-cleanup:
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.
+ */
+
+ Tcl_IncrRefCount(*attributePtrPtr);
Tcl_DecrRefCount(splitPath);
+ --(*attributePtrPtr)->refCount;
}
-
- return result;
+ return TCL_OK;
+
+ cleanup:
+ if (splitPath != NULL) {
+ Tcl_DecrRefCount(splitPath);
+ }
+
+ return TCL_ERROR;
}
/*
@@ -1758,16 +1854,15 @@ cleanup:
*
* 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.
*
*----------------------------------------------------------------------
*/
@@ -1776,10 +1871,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);
}
/*
@@ -1787,16 +1883,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.
*
*----------------------------------------------------------------------
*/
@@ -1805,10 +1900,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);
}
/*
@@ -1816,14 +1912,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.
*
*----------------------------------------------------------------------
*/
@@ -1832,7 +1928,7 @@ 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;
@@ -1872,14 +1968,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.
*
*----------------------------------------------------------------------
*/
@@ -1888,13 +1983,12 @@ 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_AppendStringsToObj(Tcl_GetObjResult(interp),
- "cannot set attribute \"", tclpFileAttrStrings[objIndex],
- "\" for file \"", Tcl_GetString(fileName),
- "\": attribute is readonly",
+ Tcl_AppendResult(interp, "cannot set attribute \"",
+ tclpFileAttrStrings[objIndex], "\" for file \"",
+ Tcl_GetString(fileName), "\": attribute is readonly",
(char *) NULL);
return TCL_ERROR;
}
@@ -1935,11 +2029,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] = ':';
@@ -1948,7 +2042,7 @@ TclpObjListVolumes(void)
for (i = 0; i < 26; i++) {
buf[0] = (char) ('a' + i);
- if (GetVolumeInformationA(buf, NULL, 0, NULL, NULL, NULL, NULL, 0)
+ if (GetVolumeInformationA(buf, NULL, 0, NULL, NULL, NULL, NULL, 0)
|| (GetLastError() == ERROR_NOT_READY)) {
elemPtr = Tcl_NewStringObj(buf, -1);
Tcl_ListObjAppendElement(NULL, resultPtr, elemPtr);
@@ -1961,7 +2055,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:
+ */