static int
TraversalDelete(
Tcl_DString *srcPtr, /* Source pathname to delete. */
Tcl_DString *dstPtr, /* Not used. */
int type, /* Reason for call - see TraverseWinTree() */
Tcl_DString *errorPtr) /* If non-NULL, initialized DString filled
* with UTF-8 name of file causing error. */
{
TCHAR *nativeSrc;
switch (type) {
case DOTREE_F: {
if (DoDeleteFile(srcPtr) == TCL_OK) {
return TCL_OK;
}
break;
}
case DOTREE_PRED: {
return TCL_OK;
}
case DOTREE_POSTD: {
if (DoRemoveDirectory(srcPtr, 0, NULL) == TCL_OK) {
return TCL_OK;
}
break;
}
}
if (errorPtr != NULL) {
nativeSrc = (TCHAR *) Tcl_DStringValue(srcPtr);
Tcl_WinTCharToUtf(nativeSrc, -1, errorPtr);
}
return TCL_ERROR;
}
Tcl_Obj *Tcl_NewWStringObj(const wchar_t *str)
{
Tcl_DString ds;
Tcl_WinTCharToUtf(str, -1, &ds);
Tcl_Obj *result = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
Tcl_DStringFree(&ds);
return result;
};
Tcl_Obj *Tcl_NewGuidObj(const GUID& Guid)
{
wchar_t guidstr[37];
FSF.sprintf(guidstr,L"%08x-%04x-%04x-%02x%02x-%02x%02x%02x%02x%02x%02x",Guid.Data1,Guid.Data2,Guid.Data3,Guid.Data4[0],Guid.Data4[1],Guid.Data4[2],Guid.Data4[3],Guid.Data4[4],Guid.Data4[5],Guid.Data4[6],Guid.Data4[7]);
Tcl_DString ds;
Tcl_WinTCharToUtf(guidstr, -1, &ds);
Tcl_Obj *result = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
Tcl_DStringFree(&ds);
return result;
};
static const char *gai_strerror(int code) {
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (tsdPtr->initialized) {
Tcl_DStringFree(&tsdPtr->errorMsg);
} else {
tsdPtr->initialized = 1;
}
Tcl_WinTCharToUtf(gai_strerrorW(code), -1, &tsdPtr->errorMsg);
return Tcl_DStringValue(&tsdPtr->errorMsg);
}
static int
TestgetwindowinfoObjCmd(
ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
{
long hwnd;
Tcl_Obj *dictObj = NULL, *classObj = NULL, *textObj = NULL;
Tcl_Obj *childrenObj = NULL;
TCHAR buf[512];
int cch, cchBuf = 256;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "hwnd");
return TCL_ERROR;
}
if (Tcl_GetLongFromObj(interp, objv[1], &hwnd) != TCL_OK)
return TCL_ERROR;
cch = GetClassName(INT2PTR(hwnd), buf, cchBuf);
if (cch == 0) {
Tcl_SetObjResult(interp, Tcl_NewStringObj("failed to get class name: ", -1));
AppendSystemError(interp, GetLastError());
return TCL_ERROR;
} else {
Tcl_DString ds;
Tcl_WinTCharToUtf(buf, -1, &ds);
classObj = Tcl_NewStringObj(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds));
Tcl_DStringFree(&ds);
}
dictObj = Tcl_NewDictObj();
Tcl_DictObjPut(interp, dictObj, Tcl_NewStringObj("class", 5), classObj);
Tcl_DictObjPut(interp, dictObj, Tcl_NewStringObj("id", 2),
Tcl_NewLongObj(GetWindowLongA(INT2PTR(hwnd), GWL_ID)));
cch = GetWindowText(INT2PTR(hwnd), (LPTSTR)buf, cchBuf);
textObj = Tcl_NewUnicodeObj((LPCWSTR)buf, cch);
Tcl_DictObjPut(interp, dictObj, Tcl_NewStringObj("text", 4), textObj);
Tcl_DictObjPut(interp, dictObj, Tcl_NewStringObj("parent", 6),
Tcl_NewLongObj(PTR2INT(GetParent((INT2PTR(hwnd))))));
childrenObj = Tcl_NewListObj(0, NULL);
EnumChildWindows(INT2PTR(hwnd), EnumChildrenProc, (LPARAM)childrenObj);
Tcl_DictObjPut(interp, dictObj, Tcl_NewStringObj("children", -1), childrenObj);
Tcl_SetObjResult(interp, dictObj);
return TCL_OK;
}
static int
TraversalCopy(
Tcl_DString *srcPtr, /* Source pathname to copy. */
Tcl_DString *dstPtr, /* Destination pathname of copy. */
int type, /* Reason for call - see TraverseWinTree() */
Tcl_DString *errorPtr) /* If non-NULL, initialized DString filled
* with UTF-8 name of file causing error. */
{
TCHAR *nativeDst, *nativeSrc;
DWORD attr;
switch (type) {
case DOTREE_F: {
if (DoCopyFile(srcPtr, dstPtr) == TCL_OK) {
return TCL_OK;
}
break;
}
case DOTREE_PRED: {
if (DoCreateDirectory(dstPtr) == TCL_OK) {
nativeSrc = (TCHAR *) Tcl_DStringValue(srcPtr);
nativeDst = (TCHAR *) Tcl_DStringValue(dstPtr);
attr = (*tclWinProcs->getFileAttributesProc)(nativeSrc);
if ((*tclWinProcs->setFileAttributesProc)(nativeDst, attr) != FALSE) {
return TCL_OK;
}
TclWinConvertError(GetLastError());
}
break;
}
case DOTREE_POSTD: {
return TCL_OK;
}
}
/*
* There shouldn't be a problem with src, because we already
* checked it to get here.
*/
if (errorPtr != NULL) {
nativeDst = (TCHAR *) Tcl_DStringValue(dstPtr);
Tcl_WinTCharToUtf(nativeDst, -1, errorPtr);
}
return TCL_ERROR;
}
static void UpdateWinCharsTypeString(Tcl_Obj *objP)
{
int nbytes;
char *utf8;
WinChars *rep;
Tcl_DString ds;
rep = WinCharsGet(objP);
if (rep->nchars == 0) {
objP->bytes = ckalloc(1);
objP->bytes[0] = '\0';
objP->length = 0;
return;
}
#if 0
/* Disabled because XP does not support WC_ERR_INVALID_CHARS and
* will silently discard those characters
*/
/* Note rep->nchars does not include terminating \0 so return values
* will not include it either
*/
nbytes = WideCharToMultiByte(
CP_UTF8, /* CodePag */
WC_ERR_INVALID_CHARS, /* dwFlags */
rep->chars, /* lpWideCharStr */
rep->nchars, /* cchWideChar */
NULL, /* lpMultiByteStr */
NULL, /* cbMultiByte */
NULL, /* lpDefaultChar */
NULL /* lpUsedDefaultChar */
);
if (nbytes != 0) {
utf8 = ckalloc(nbytes+1); /* One extra for terminating \0 */
nbytes = WideCharToMultiByte(
CP_UTF8, /* CodePag */
WC_ERR_INVALID_CHARS, /* dwFlags */
rep->chars, /* lpWideCharStr */
rep->nchars, /* cchWideChar */
utf8, /* lpMultiByteStr */
nbytes, /* cbMultiByte */
NULL, /* lpDefaultChar */
NULL /* lpUsedDefaultChar */
);
if (nbytes != 0) {
utf8[nbytes] = '\0';
objP->bytes = utf8;
objP->length = nbytes;
return;
}
ckfree(utf8);
}
/*
* Failures are possible because of invalid characters like embedded
* nulls which are not illegal in Tcl, so do it the (slower) Tcl way then.
*/
#endif // #if 0
Tcl_WinTCharToUtf(rep->chars, rep->nchars * sizeof(WCHAR), &ds);
nbytes = Tcl_DStringLength(&ds);
utf8 = ckalloc(nbytes+1);
memmove(utf8, Tcl_DStringValue(&ds), nbytes);
Tcl_DStringFree(&ds);
utf8[nbytes] = '\0';
objP->bytes = utf8;
objP->length = nbytes;
}
void
TclpSetVariables(
Tcl_Interp *interp) /* Interp to initialize. */
{
const char *ptr;
char buffer[TCL_INTEGER_SPACE * 2];
SYSTEM_INFO sysInfo, *sysInfoPtr = &sysInfo;
OemId *oemId;
OSVERSIONINFOA osInfo;
Tcl_DString ds;
WCHAR szUserName[UNLEN+1];
DWORD cchUserNameLen = UNLEN;
Tcl_SetVar2Ex(interp, "tclDefaultLibrary", NULL,
TclGetProcessGlobalValue(&defaultLibraryDir), TCL_GLOBAL_ONLY);
osInfo.dwOSVersionInfoSize = sizeof(OSVERSIONINFOA);
GetVersionExA(&osInfo);
oemId = (OemId *) sysInfoPtr;
GetSystemInfo(&sysInfo);
/*
* Define the tcl_platform array.
*/
Tcl_SetVar2(interp, "tcl_platform", "platform", "windows",
TCL_GLOBAL_ONLY);
if (osInfo.dwPlatformId < NUMPLATFORMS) {
Tcl_SetVar2(interp, "tcl_platform", "os",
platforms[osInfo.dwPlatformId], TCL_GLOBAL_ONLY);
}
wsprintfA(buffer, "%d.%d", osInfo.dwMajorVersion, osInfo.dwMinorVersion);
Tcl_SetVar2(interp, "tcl_platform", "osVersion", buffer, TCL_GLOBAL_ONLY);
if (oemId->wProcessorArchitecture < NUMPROCESSORS) {
Tcl_SetVar2(interp, "tcl_platform", "machine",
processors[oemId->wProcessorArchitecture],
TCL_GLOBAL_ONLY);
}
#ifdef _DEBUG
/*
* The existence of the "debug" element of the tcl_platform array
* indicates that this particular Tcl shell has been compiled with debug
* information. Using "info exists tcl_platform(debug)" a Tcl script can
* direct the interpreter to load debug versions of DLLs with the load
* command.
*/
Tcl_SetVar2(interp, "tcl_platform", "debug", "1",
TCL_GLOBAL_ONLY);
#endif
/*
* Set up the HOME environment variable from the HOMEDRIVE & HOMEPATH
* environment variables, if necessary.
*/
Tcl_DStringInit(&ds);
ptr = Tcl_GetVar2(interp, "env", "HOME", TCL_GLOBAL_ONLY);
if (ptr == NULL) {
ptr = Tcl_GetVar2(interp, "env", "HOMEDRIVE", TCL_GLOBAL_ONLY);
if (ptr != NULL) {
Tcl_DStringAppend(&ds, ptr, -1);
}
ptr = Tcl_GetVar2(interp, "env", "HOMEPATH", TCL_GLOBAL_ONLY);
if (ptr != NULL) {
Tcl_DStringAppend(&ds, ptr, -1);
}
if (Tcl_DStringLength(&ds) > 0) {
Tcl_SetVar2(interp, "env", "HOME", Tcl_DStringValue(&ds),
TCL_GLOBAL_ONLY);
} else {
Tcl_SetVar2(interp, "env", "HOME", "c:\\", TCL_GLOBAL_ONLY);
}
}
/*
* Initialize the user name from the environment first, since this is much
* faster than asking the system.
* Note: cchUserNameLen is number of characters including nul terminator.
*/
Tcl_DStringInit(&ds);
if (TclGetEnv("USERNAME", &ds) == NULL) {
if (tclWinProcs->getUserName((LPTSTR)szUserName, &cchUserNameLen) != 0) {
int cbUserNameLen = cchUserNameLen - 1;
if (tclWinProcs->useWide) cbUserNameLen *= sizeof(WCHAR);
Tcl_WinTCharToUtf((LPTSTR)szUserName, cbUserNameLen, &ds);
}
}
Tcl_SetVar2(interp, "tcl_platform", "user", Tcl_DStringValue(&ds),
TCL_GLOBAL_ONLY);
Tcl_DStringFree(&ds);
/*
* Define what the platform PATH separator is. [TIP #315]
*/
Tcl_SetVar2(interp, "tcl_platform","pathSeparator", ";", TCL_GLOBAL_ONLY);
}
static int
TraverseWinTree(
TraversalProc *traverseProc,/* Function to call for every file and
* directory in source hierarchy. */
Tcl_DString *sourcePtr, /* Pathname of source directory to be
* traversed (native). */
Tcl_DString *targetPtr, /* Pathname of directory to traverse in
* parallel with source directory (native). */
Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free
* DString filled with UTF-8 name of file
* causing error. */
{
DWORD sourceAttr;
TCHAR *nativeSource, *nativeErrfile;
int result, found, sourceLen, targetLen, oldSourceLen, oldTargetLen;
HANDLE handle;
WIN32_FIND_DATAT data;
nativeErrfile = NULL;
result = TCL_OK;
oldTargetLen = 0; /* lint. */
nativeSource = (TCHAR *) Tcl_DStringValue(sourcePtr);
oldSourceLen = Tcl_DStringLength(sourcePtr);
sourceAttr = (*tclWinProcs->getFileAttributesProc)(nativeSource);
if (sourceAttr == 0xffffffff) {
nativeErrfile = nativeSource;
goto end;
}
if ((sourceAttr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
/*
* Process the regular file
*/
return (*traverseProc)(sourcePtr, targetPtr, 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);
}
nativeSource = (TCHAR *) Tcl_DStringValue(sourcePtr);
handle = (*tclWinProcs->findFirstFileProc)(nativeSource, &data);
if (handle == INVALID_HANDLE_VALUE) {
/*
* Can't read directory
*/
TclWinConvertError(GetLastError());
nativeErrfile = nativeSource;
goto end;
}
nativeSource[oldSourceLen + 1] = '\0';
Tcl_DStringSetLength(sourcePtr, oldSourceLen);
result = (*traverseProc)(sourcePtr, targetPtr, DOTREE_PRED, errorPtr);
if (result != TCL_OK) {
FindClose(handle);
return result;
}
sourceLen = oldSourceLen;
if (tclWinProcs->useWide) {
sourceLen += sizeof(WCHAR);
Tcl_DStringAppend(sourcePtr, (char *) L"\\", sizeof(WCHAR) + 1);
Tcl_DStringSetLength(sourcePtr, sourceLen);
} else {
sourceLen += 1;
Tcl_DStringAppend(sourcePtr, "\\", 1);
}
if (targetPtr != NULL) {
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);
}
}
found = 1;
for ( ; found; found = (*tclWinProcs->findNextFileProc)(handle, &data)) {
TCHAR *nativeName;
int len;
if (tclWinProcs->useWide) {
WCHAR *wp;
wp = data.w.cFileName;
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)) {
continue;
}
nativeName = (TCHAR *) data.a.cFileName;
len = strlen(data.a.cFileName);
}
/*
* Append name after slash, and recurse on the file.
*/
Tcl_DStringAppend(sourcePtr, (char *) nativeName, len + 1);
Tcl_DStringSetLength(sourcePtr, Tcl_DStringLength(sourcePtr) - 1);
if (targetPtr != NULL) {
Tcl_DStringAppend(targetPtr, (char *) nativeName, len + 1);
Tcl_DStringSetLength(targetPtr, Tcl_DStringLength(targetPtr) - 1);
}
result = TraverseWinTree(traverseProc, sourcePtr, targetPtr,
errorPtr);
if (result != TCL_OK) {
break;
}
/*
* Remove name after slash.
*/
Tcl_DStringSetLength(sourcePtr, sourceLen);
if (targetPtr != NULL) {
Tcl_DStringSetLength(targetPtr, targetLen);
}
}
FindClose(handle);
/*
* Strip off the trailing slash we added
*/
Tcl_DStringSetLength(sourcePtr, oldSourceLen + 1);
Tcl_DStringSetLength(sourcePtr, oldSourceLen);
if (targetPtr != NULL) {
Tcl_DStringSetLength(targetPtr, oldTargetLen + 1);
Tcl_DStringSetLength(targetPtr, oldTargetLen);
}
if (result == TCL_OK) {
/*
* Call traverseProc() on a directory after visiting all the
* files in that directory.
*/
result = (*traverseProc)(sourcePtr, targetPtr, DOTREE_POSTD,
errorPtr);
}
end:
if (nativeErrfile != NULL) {
TclWinConvertError(GetLastError());
if (errorPtr != NULL) {
Tcl_WinTCharToUtf(nativeErrfile, -1, errorPtr);
}
result = TCL_ERROR;
}
return result;
}
static int
DoRemoveDirectory(
Tcl_DString *pathPtr, /* Pathname of directory to be removed
* (native). */
int recursive, /* If non-zero, removes directories that
* are nonempty. Otherwise, will only remove
* empty directories. */
Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free
* DString filled with UTF-8 name of file
* causing error. */
{
CONST TCHAR *nativePath;
DWORD attr;
nativePath = (TCHAR *) Tcl_DStringValue(pathPtr);
if ((*tclWinProcs->removeDirectoryProc)(nativePath) != FALSE) {
return TCL_OK;
}
TclWinConvertError(GetLastError());
/*
* Win32s thinks that "" is the same as "." and then reports EACCES
* instead of ENOENT.
*/
if (tclWinProcs->useWide) {
if (((WCHAR *) nativePath)[0] == '\0') {
Tcl_SetErrno(ENOENT);
return TCL_ERROR;
}
} else {
if (((char *) nativePath)[0] == '\0') {
Tcl_SetErrno(ENOENT);
return TCL_ERROR;
}
}
if (Tcl_GetErrno() == EACCES) {
attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
if (attr != 0xffffffff) {
if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
/*
* Windows 95 reports calling RemoveDirectory on a file as an
* EACCES, not an ENOTDIR.
*/
Tcl_SetErrno(ENOTDIR);
goto end;
}
if (attr & FILE_ATTRIBUTE_READONLY) {
attr &= ~FILE_ATTRIBUTE_READONLY;
if ((*tclWinProcs->setFileAttributesProc)(nativePath, attr) == FALSE) {
goto end;
}
if ((*tclWinProcs->removeDirectoryProc)(nativePath) != FALSE) {
return TCL_OK;
}
TclWinConvertError(GetLastError());
(*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.
*/
if (TclWinGetPlatformId() != VER_PLATFORM_WIN32_NT) {
char *path, *find;
HANDLE handle;
WIN32_FIND_DATAA data;
Tcl_DString buffer;
int len;
path = (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.
*/
Tcl_SetErrno(EEXIST);
}
if ((recursive != 0) && (Tcl_GetErrno() == EEXIST)) {
/*
* The directory is nonempty, but the recursive flag has been
* specified, so we recursively remove all the files in the directory.
*/
return TraverseWinTree(TraversalDelete, pathPtr, NULL, errorPtr);
}
end:
if (errorPtr != NULL) {
Tcl_WinTCharToUtf(nativePath, -1, errorPtr);
}
return TCL_ERROR;
}
static int
DoRenameFile(
CONST TCHAR *nativeSrc, /* Pathname of file or dir to be renamed
* (native). */
Tcl_DString *dstPtr) /* New pathname for file or directory
* (native). */
{
const TCHAR *nativeDst;
DWORD srcAttr, dstAttr;
nativeDst = (TCHAR *) Tcl_DStringValue(dstPtr);
/*
* Would throw an exception under NT if one of the arguments is a
* char block device.
*/
__try {
if ((*tclWinProcs->moveFileProc)(nativeSrc, nativeDst) != FALSE) {
return TCL_OK;
}
} __except (-1) {}
TclWinConvertError(GetLastError());
srcAttr = (*tclWinProcs->getFileAttributesProc)(nativeSrc);
dstAttr = (*tclWinProcs->getFileAttributesProc)(nativeDst);
if (srcAttr == 0xffffffff) {
if ((*tclWinProcs->getFullPathNameProc)(nativeSrc, 0, NULL, NULL) >= MAX_PATH) {
errno = ENAMETOOLONG;
return TCL_ERROR;
}
srcAttr = 0;
}
if (dstAttr == 0xffffffff) {
if ((*tclWinProcs->getFullPathNameProc)(nativeDst, 0, NULL, NULL) >= MAX_PATH) {
errno = ENAMETOOLONG;
return TCL_ERROR;
}
dstAttr = 0;
}
if (errno == EBADF) {
errno = EACCES;
return TCL_ERROR;
}
if ((TclWinGetPlatformId() == VER_PLATFORM_WIN32s) && (errno == EACCES)) {
if ((srcAttr != 0) && (dstAttr != 0)) {
/*
* Win32s reports trying to overwrite an existing file or directory
* as EACCES.
*/
errno = EEXIST;
}
}
if (errno == EACCES) {
decode:
if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) {
TCHAR *nativeSrcRest, *nativeDstRest;
char **srcArgv, **dstArgv;
int size, srcArgc, dstArgc;
WCHAR nativeSrcPath[MAX_PATH];
WCHAR nativeDstPath[MAX_PATH];
Tcl_DString srcString, dstString;
CONST char *src, *dst;
size = (*tclWinProcs->getFullPathNameProc)(nativeSrc, MAX_PATH,
nativeSrcPath, &nativeSrcRest);
if ((size == 0) || (size > MAX_PATH)) {
return TCL_ERROR;
}
size = (*tclWinProcs->getFullPathNameProc)(nativeDst, MAX_PATH,
nativeDstPath, &nativeDstRest);
if ((size == 0) || (size > MAX_PATH)) {
return TCL_ERROR;
}
(*tclWinProcs->charLowerProc)((TCHAR *) nativeSrcPath);
(*tclWinProcs->charLowerProc)((TCHAR *) nativeDstPath);
src = Tcl_WinTCharToUtf((TCHAR *) nativeSrcPath, -1, &srcString);
dst = Tcl_WinTCharToUtf((TCHAR *) nativeDstPath, -1, &dstString);
if (strncmp(src, dst, Tcl_DStringLength(&srcString)) == 0) {
/*
* Trying to move a directory into itself.
*/
errno = EINVAL;
Tcl_DStringFree(&srcString);
Tcl_DStringFree(&dstString);
return TCL_ERROR;
}
Tcl_SplitPath(src, &srcArgc, &srcArgv);
Tcl_SplitPath(dst, &dstArgc, &dstArgv);
Tcl_DStringFree(&srcString);
Tcl_DStringFree(&dstString);
if (srcArgc == 1) {
/*
* They are trying to move a root directory. Whether
* 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.
*/
Tcl_SetErrno(EXDEV);
}
ckfree((char *) srcArgv);
ckfree((char *) 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.
*/
} else if (Tcl_GetErrno() == EEXIST) {
/*
* Reports EEXIST any time the target already exists. If it makes
* sense, remove the old file and try renaming again.
*/
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.
*/
if (DoRemoveDirectory(dstPtr, 0, NULL) == TCL_OK) {
/*
* Now that that empty directory is gone, we can try
* renaming again. If that fails, we'll put this empty
* directory back, for completeness.
*/
if ((*tclWinProcs->moveFileProc)(nativeSrc, nativeDst) != FALSE) {
return TCL_OK;
}
/*
* 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);
if (Tcl_GetErrno() == EACCES) {
/*
* Decode the EACCES to a more meaningful error.
*/
goto decode;
}
}
} else { /* (dstAttr & FILE_ATTRIBUTE_DIRECTORY) == 0 */
Tcl_SetErrno(ENOTDIR);
}
} else { /* (srcAttr & FILE_ATTRIBUTE_DIRECTORY) == 0 */
if (dstAttr & FILE_ATTRIBUTE_DIRECTORY) {
Tcl_SetErrno(EISDIR);
} 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.
*/
TCHAR *nativeRest, *nativeTmp, *nativePrefix;
int result, size;
WCHAR tempBuf[MAX_PATH];
size = (*tclWinProcs->getFullPathNameProc)(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. */
result = TCL_ERROR;
nativePrefix = (tclWinProcs->useWide)
? (TCHAR *) L"tclr" : (TCHAR *) "tclr";
if ((*tclWinProcs->getTempFileNameProc)(nativeTmp,
nativePrefix, 0, tempBuf) != 0) {
/*
* Strictly speaking, need the following DeleteFile and
* MoveFile to be joined as an atomic operation so no
* 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);
return TCL_OK;
} else {
(*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.
*/
TclWinConvertError(GetLastError());
if (Tcl_GetErrno() == EACCES) {
/*
* Decode the EACCES to a more meaningful error.
*/
goto decode;
}
}
return result;
}
}
}
return TCL_ERROR;
}
static int
ConvertFileNameFormat(
Tcl_Interp *interp, /* The interp we are using for errors. */
int objIndex, /* The index of the attribute. */
CONST char *fileName, /* The name of the file. */
int longShort, /* 0 to short name, 1 to long name. */
Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */
{
int pathc, i;
char **pathv, **newv;
char *resultStr;
Tcl_DString resultDString;
int result = TCL_OK;
Tcl_SplitPath(fileName, &pathc, &pathv);
newv = (char **) ckalloc(pathc * sizeof(char *));
if (pathc == 0) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"could not read \"", fileName,
"\": no such file or directory",
(char *) NULL);
result = TCL_ERROR;
goto cleanup;
}
for (i = 0; i < pathc; i++) {
if ((pathv[i][0] == '/')
|| ((strlen(pathv[i]) == 3) && (pathv[i][1] == ':'))
|| (strcmp(pathv[i], ".") == 0)
|| (strcmp(pathv[i], "..") == 0)) {
/*
* Handle "/", "//machine/export", "c:/", "." or ".." by just
* copying the string literally. Uppercase the drive letter,
* just because it looks better under Windows to do so.
*/
simple:
pathv[i][0] = (char) Tcl_UniCharToUpper(UCHAR(pathv[i][0]));
newv[i] = (char *) ckalloc(strlen(pathv[i]) + 1);
lstrcpyA(newv[i], pathv[i]);
} else {
char *str;
TCHAR *nativeName;
Tcl_DString ds;
WIN32_FIND_DATAT data;
HANDLE handle;
DWORD attr;
Tcl_DStringInit(&resultDString);
str = Tcl_JoinPath(i + 1, pathv, &resultDString);
nativeName = Tcl_WinUtfToTChar(str, -1, &ds);
handle = (*tclWinProcs->findFirstFileProc)(nativeName, &data);
if (handle == INVALID_HANDLE_VALUE) {
/*
* FindFirstFile() doesn't like root directories. We
* would only get a root directory here if the caller
* specified "c:" or "c:." and the current directory on the
* drive was the root directory
*/
attr = (*tclWinProcs->getFileAttributesProc)(nativeName);
if ((attr != 0xFFFFFFFF) && (attr & FILE_ATTRIBUTE_DIRECTORY)) {
Tcl_DStringFree(&ds);
Tcl_DStringFree(&resultDString);
goto simple;
}
}
Tcl_DStringFree(&ds);
Tcl_DStringFree(&resultDString);
if (handle == INVALID_HANDLE_VALUE) {
pathc = i - 1;
StatError(interp, fileName);
result = TCL_ERROR;
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;
}
}
} 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;
}
}
}
/*
* Purify reports a extraneous UMR in Tcl_WinTCharToUtf() trying
* to dereference nativeName as a Unicode string. I have proven
* to myself that purify is wrong by running the following
* example when nativeName == data.w.cAlternateFileName and
* noting that purify doesn't complain about the first line,
* but does complain about the second.
*
* fprintf(stderr, "%d\n", data.w.cAlternateFileName[0]);
* fprintf(stderr, "%d\n", ((WCHAR *) nativeName)[0]);
*/
Tcl_WinTCharToUtf(nativeName, -1, &ds);
newv[i] = ckalloc(Tcl_DStringLength(&ds) + 1);
lstrcpyA(newv[i], Tcl_DStringValue(&ds));
Tcl_DStringFree(&ds);
FindClose(handle);
}
}
Tcl_DStringInit(&resultDString);
resultStr = Tcl_JoinPath(pathc, newv, &resultDString);
*attributePtrPtr = Tcl_NewStringObj(resultStr,
Tcl_DStringLength(&resultDString));
Tcl_DStringFree(&resultDString);
cleanup:
for (i = 0; i < pathc; i++) {
ckfree(newv[i]);
}
ckfree((char *) newv);
ckfree((char *) pathv);
return result;
}
