diff options
Diffstat (limited to 'win')
| -rw-r--r-- | win/tclWin32Dll.c | 30 | ||||
| -rw-r--r-- | win/tclWinFCmd.c | 292 | ||||
| -rw-r--r-- | win/tclWinFile.c | 220 |
3 files changed, 395 insertions, 147 deletions
diff --git a/win/tclWin32Dll.c b/win/tclWin32Dll.c index ce9bbcb..c1194dd 100644 --- a/win/tclWin32Dll.c +++ b/win/tclWin32Dll.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWin32Dll.c,v 1.10 2001/10/29 15:02:44 vincentdarley Exp $ + * RCS: @(#) $Id: tclWin32Dll.c,v 1.11 2001/11/19 17:45:12 vincentdarley Exp $ */ #include "tclWinInt.h" @@ -78,8 +78,7 @@ static TclWinProcs asciiProcs = { WCHAR *, TCHAR **)) SearchPathA, (BOOL (WINAPI *)(CONST TCHAR *)) SetCurrentDirectoryA, (BOOL (WINAPI *)(CONST TCHAR *, DWORD)) SetFileAttributesA, - (BOOL (WINAPI *)(CONST TCHAR *, GET_FILEEX_INFO_LEVELS, - LPVOID)) GetFileAttributesExA, + NULL, }; static TclWinProcs unicodeProcs = { @@ -117,8 +116,7 @@ static TclWinProcs unicodeProcs = { WCHAR *, TCHAR **)) SearchPathW, (BOOL (WINAPI *)(CONST TCHAR *)) SetCurrentDirectoryW, (BOOL (WINAPI *)(CONST TCHAR *, DWORD)) SetFileAttributesW, - (BOOL (WINAPI *)(CONST TCHAR *, GET_FILEEX_INFO_LEVELS, - LPVOID)) GetFileAttributesExW, + NULL, }; TclWinProcs *tclWinProcs; @@ -390,6 +388,10 @@ TclWinGetPlatform() * tclWinProcs structure to dispatch to either the wide-character * or multi-byte versions of the operating system calls, depending * on whether Unicode is the system encoding. + * + * As well as this, we can also try to load in some additional + * procs which may/may not be present depending on the current + * Windows version (e.g. Win95 will not have the procs below). * * Results: * None. @@ -410,9 +412,27 @@ TclWinSetInterfaces( if (wide) { tclWinProcs = &unicodeProcs; tclWinTCharEncoding = Tcl_GetEncoding(NULL, "unicode"); + if (tclWinProcs->getFileAttributesExProc == NULL) { + HINSTANCE hInstance = LoadLibraryA("kernel32"); + if (hInstance != NULL) { + tclWinProcs->getFileAttributesExProc = + (BOOL (WINAPI *)(CONST TCHAR *, GET_FILEEX_INFO_LEVELS, + LPVOID)) GetProcAddress(hInstance, "GetFileAttributesExW"); + FreeLibrary(hInstance); + } + } } else { tclWinProcs = &asciiProcs; tclWinTCharEncoding = NULL; + if (tclWinProcs->getFileAttributesExProc == NULL) { + HINSTANCE hInstance = LoadLibraryA("kernel32"); + if (hInstance != NULL) { + tclWinProcs->getFileAttributesExProc = + (BOOL (WINAPI *)(CONST TCHAR *, GET_FILEEX_INFO_LEVELS, + LPVOID)) GetProcAddress(hInstance, "GetFileAttributesExA"); + FreeLibrary(hInstance); + } + } } } diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c index 744ab2b..72f1678 100644 --- a/win/tclWinFCmd.c +++ b/win/tclWinFCmd.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWinFCmd.c,v 1.15 2001/10/22 17:10:00 vincentdarley Exp $ + * RCS: @(#) $Id: tclWinFCmd.c,v 1.16 2001/11/19 17:45:12 vincentdarley Exp $ */ #include "tclWinInt.h" @@ -1711,6 +1711,82 @@ TclpObjListVolumes(void) return resultPtr; } +/* + * This function could be thoroughly tested and then substituted in + * below to speed up file normalization on Windows NT/2000/XP + */ +#if 0 + +void WinGetLongPathName(CONST TCHAR* origPath, Tcl_DString *dsPtr); + +#define IsDirSep(a) (a == '/' || a == '\\') + +void WinGetLongPathName(CONST TCHAR* pszOriginal, Tcl_DString *dsPtr) { + TCHAR szResult[_MAX_PATH * 2 + 1]; + + TCHAR* pchResult = szResult; + const TCHAR* pchScan = pszOriginal; + WIN32_FIND_DATA wfd; + + /* Do Drive Letter check... */ + if (pchScan[0] && pchScan[1] == ':') { + /* Copy drive letter and colon, ensuring drive is upper case. */ + char drive = *pchScan++; + *pchResult++ = (drive < 97 ? drive : drive - 32); + *pchResult++ = *pchScan++; + } else if (IsDirSep(pchScan[0]) && IsDirSep(pchScan[1])) { + /* Copy \\ and machine name. */ + *pchResult++ = *pchScan++; + *pchResult++ = *pchScan++; + while (*pchScan && !IsDirSep(*pchScan)) { + *pchResult++ = *pchScan++; + } + /* + * Note that the code below will fail since FindFirstFile + * on a UNC path seems not to work on directory name searches? + */ + } + + if (!IsDirSep(*pchScan)) { + while ((*pchResult++ = *pchScan++) != '\0'); + } else { + /* Now loop through directories and files... */ + while (IsDirSep(*pchScan)) { + char* pchReplace; + const TCHAR* pchEnd; + HANDLE hFind; + + *pchResult++ = *pchScan++; + pchReplace = pchResult; + + pchEnd = pchScan; + while (*pchEnd && !IsDirSep(*pchEnd)) { + *pchResult++ = *pchEnd++; + } + + *pchResult = '\0'; + + /* Now run this through FindFirstFile... */ + hFind = FindFirstFileA(szResult, &wfd); + if (hFind != INVALID_HANDLE_VALUE) { + FindClose(hFind); + strcpy(pchReplace, wfd.cFileName); + pchResult = pchReplace + strlen(pchReplace); + } else { + /* Copy rest of input path & end. */ + strcat(pchResult, pchEnd); + break; + } + pchScan = pchEnd; + } + } + /* Copy it over */ + Tcl_ExternalToUtfDString(NULL, szResult, -1, dsPtr); +} + +#endif + + /* *--------------------------------------------------------------------------- * @@ -1737,73 +1813,179 @@ TclpObjNormalizePath(interp, pathPtr, nextCheckpoint) Tcl_Obj *pathPtr; int nextCheckpoint; { - char *currentPathEndPosition; char *lastValidPathEnd = NULL; - char *path = Tcl_GetString(pathPtr); - - currentPathEndPosition = path + nextCheckpoint; + Tcl_DString ds; + int pathLen; - while (1) { - char cur = *currentPathEndPosition; - if ((cur == '/' || cur == 0) && (path != currentPathEndPosition)) { - /* Reached directory separator, or end of string */ - Tcl_DString ds; - DWORD attr; - char * nativePath; - nativePath = Tcl_WinUtfToTChar(path, currentPathEndPosition - path, - &ds); - attr = (*tclWinProcs->getFileAttributesProc)(nativePath); - Tcl_DStringFree(&ds); - - if (attr == 0xffffffff) { - /* File doesn't exist */ + char *path = Tcl_GetStringFromObj(pathPtr, &pathLen); + + if (TclWinGetPlatformId() == VER_PLATFORM_WIN32_WINDOWS) { + Tcl_DString eDs; + char *nativePath; + int nativeLen; + + nativePath = Tcl_UtfToExternalDString(NULL, path, -1, &ds); + nativeLen = Tcl_DStringLength(&ds); + + /* We're on Windows 95/98 */ + lastValidPathEnd = nativePath + Tcl_DStringLength(&ds); + + while (1) { + DWORD res = GetShortPathNameA(nativePath, nativePath, 1+nativeLen); + if (res != 0) { + /* We found an ok path */ break; } - lastValidPathEnd = currentPathEndPosition; - /* File does exist */ - if (cur == 0) { - break; + /* Undo the null-termination we put in before */ + if (lastValidPathEnd != (nativePath + nativeLen)) { + *lastValidPathEnd = '/'; + } + /* + * The path doesn't exist. Back up the path, one component + * (directory/file) at a time, until one does exist. + */ + while (1) { + char cur; + lastValidPathEnd--; + if (lastValidPathEnd == nativePath) { + /* We didn't accept any of the path */ + Tcl_DStringFree(&ds); + return nextCheckpoint; + } + cur = *(--lastValidPathEnd); + if (cur == '/' || cur == '\\') { + /* Reached directory separator */ + break; + } } + /* Temporarily terminate the string */ + *lastValidPathEnd = '\0'; } - currentPathEndPosition++; - } - nextCheckpoint = currentPathEndPosition - path; - if (lastValidPathEnd != NULL) { - Tcl_Obj *tmpPathPtr; /* - * The leading end of the path description was acceptable to - * us. We therefore convert it to its long form, and return - * that. + * If we get here, we found a valid path, which we've converted to + * short form, and the valid string ends at or before 'lastValidPathEnd' + * and the invalid string starts at 'lastValidPathEnd'. */ - Tcl_Obj* objPtr = NULL; - int endOfString; - int useLength = lastValidPathEnd - path; - if (*lastValidPathEnd == 0) { - tmpPathPtr = Tcl_NewStringObj(path, useLength); - endOfString = 1; - } else { - tmpPathPtr = Tcl_NewStringObj(path, useLength + 1); - endOfString = 0; + + /* Copy over the valid part of the path and find its length */ + path = Tcl_ExternalToUtfDString(NULL, nativePath, -1, &eDs); + if (path[1] == ':') { + if (path[0] >= 'a' && path[0] <= 'z') { + /* Make uppercase */ + path[0] -= 32; + } + } + nextCheckpoint = Tcl_DStringLength(&eDs); + Tcl_SetStringObj(pathPtr, path, Tcl_DStringLength(&eDs)); + Tcl_DStringFree(&eDs); + if (lastValidPathEnd != (nativePath + nativeLen)) { + *lastValidPathEnd = '/'; + /* Now copy over the invalid (i.e. non-existent) part of the path */ + path = Tcl_ExternalToUtfDString(NULL, lastValidPathEnd, -1, &eDs); + Tcl_AppendToObj(pathPtr, path, Tcl_DStringLength(&eDs)); + Tcl_DStringFree(&eDs); } + Tcl_DStringFree(&ds); + } else { + /* We're on WinNT or 2000 or XP */ + char *nativePath; +#if 0 /* - * If this returns an error, we have a strange situation; the - * file exists, but we can't get its long name. We will have - * to assume the name we have is ok. + * We don't use this simpler version, because the speed + * increase does not seem significant at present and the version + * below is thoroughly debugged. */ - Tcl_IncrRefCount(tmpPathPtr); - if (ConvertFileNameFormat(interp, 0, tmpPathPtr, 1, &objPtr) == TCL_OK) { - int len; - (void) Tcl_GetStringFromObj(objPtr,&len); - if (!endOfString) { - /* Be nice and fix the string before we clear it */ - Tcl_AppendToObj(objPtr, lastValidPathEnd, -1); + int nativeLen; + Tcl_DString eDs; + nativePath = Tcl_UtfToExternalDString(NULL, path, -1, &ds); + nativeLen = Tcl_DStringLength(&ds); + WinGetLongPathName(nativePath, &eDs); + /* + * We need to add code here to calculate the new value of + * 'nextCheckpoint' -- i.e. the longest part of the path + * which is an existing file. + */ + Tcl_SetStringObj(pathPtr, Tcl_DStringValue(&eDs), Tcl_DStringLength(&eDs)); + Tcl_DStringFree(&eDs); + Tcl_DStringFree(&ds); +#else + char *currentPathEndPosition; + WIN32_FILE_ATTRIBUTE_DATA data; + nativePath = Tcl_WinUtfToTChar(path, -1, &ds); + + if ((*tclWinProcs->getFileAttributesExProc)(nativePath, + GetFileExInfoStandard, + &data) == TRUE) { + currentPathEndPosition = path + pathLen; + nextCheckpoint = pathLen; + lastValidPathEnd = currentPathEndPosition; + Tcl_DStringFree(&ds); + } else { + Tcl_DStringFree(&ds); + currentPathEndPosition = path + nextCheckpoint; + while (1) { + char cur = *currentPathEndPosition; + if ((cur == '/' || cur == 0) && (path != currentPathEndPosition)) { + /* Reached directory separator, or end of string */ + nativePath = Tcl_WinUtfToTChar(path, currentPathEndPosition - path, + &ds); + if ((*tclWinProcs->getFileAttributesExProc)(nativePath, + GetFileExInfoStandard, &data) != TRUE) { + /* File doesn't exist */ + Tcl_DStringFree(&ds); + break; + } + Tcl_DStringFree(&ds); + + lastValidPathEnd = currentPathEndPosition; + /* File does exist */ + if (cur == 0) { + break; + } + } + currentPathEndPosition++; + } + nextCheckpoint = currentPathEndPosition - path; + } + if (lastValidPathEnd != NULL) { + Tcl_Obj *tmpPathPtr; + /* + * The leading end of the path description was acceptable to + * us. We therefore convert it to its long form, and return + * that. + */ + Tcl_Obj* objPtr = NULL; + int endOfString; + int useLength = lastValidPathEnd - path; + if (*lastValidPathEnd == 0) { + tmpPathPtr = Tcl_NewStringObj(path, useLength); + endOfString = 1; + } else { + tmpPathPtr = Tcl_NewStringObj(path, useLength + 1); + endOfString = 0; } - nextCheckpoint += (len - useLength); - path = Tcl_GetStringFromObj(objPtr,&len); - Tcl_SetStringObj(pathPtr,path, len); - Tcl_DecrRefCount(objPtr); + /* + * If this returns an error, we have a strange situation; the + * file exists, but we can't get its long name. We will have + * to assume the name we have is ok. + */ + Tcl_IncrRefCount(tmpPathPtr); + if (ConvertFileNameFormat(interp, 0, tmpPathPtr, 1, &objPtr) == TCL_OK) { + int len; + (void) Tcl_GetStringFromObj(objPtr,&len); + if (!endOfString) { + /* Be nice and fix the string before we clear it */ + Tcl_AppendToObj(objPtr, lastValidPathEnd, -1); + } + nextCheckpoint += (len - useLength); + path = Tcl_GetStringFromObj(objPtr,&len); + Tcl_SetStringObj(pathPtr,path, len); + Tcl_DecrRefCount(objPtr); + } + Tcl_DecrRefCount(tmpPathPtr); } - Tcl_DecrRefCount(tmpPathPtr); +#endif } return nextCheckpoint; } + diff --git a/win/tclWinFile.c b/win/tclWinFile.c index cc5e9c5..d64c833 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWinFile.c,v 1.18 2001/10/29 15:02:44 vincentdarley Exp $ + * RCS: @(#) $Id: tclWinFile.c,v 1.19 2001/11/19 17:45:13 vincentdarley Exp $ */ #include "tclWinInt.h" @@ -887,100 +887,157 @@ NativeStat(nativePath, statPtr) struct stat *statPtr; /* Filled with results of stat call. */ { Tcl_DString ds; -#ifdef OLD_API - WIN32_FIND_DATAT data; - HANDLE handle; -#else - WIN32_FILE_ATTRIBUTE_DATA data; -#endif DWORD attr; WCHAR nativeFullPath[MAX_PATH]; TCHAR *nativePart; CONST char *fullPath; int dev, mode; + + if (tclWinProcs->getFileAttributesExProc == NULL) { + /* + * We don't have the faster attributes proc, so we're + * probably running on Win95 + */ + WIN32_FIND_DATAT data; + HANDLE handle; + + handle = (*tclWinProcs->findFirstFileProc)(nativePath, &data); + if (handle == INVALID_HANDLE_VALUE) { + /* + * FindFirstFile() doesn't work on root directories, so call + * GetFileAttributes() to see if the specified file exists. + */ -#ifdef OLD_API - handle = (*tclWinProcs->findFirstFileProc)(nativePath, &data); - if (handle == INVALID_HANDLE_VALUE) { - /* - * FindFirstFile() doesn't work on root directories, so call - * GetFileAttributes() to see if the specified file exists. - */ + attr = (*tclWinProcs->getFileAttributesProc)(nativePath); + if (attr == 0xffffffff) { + Tcl_SetErrno(ENOENT); + return -1; + } - attr = (*tclWinProcs->getFileAttributesProc)(nativePath); - if (attr == 0xffffffff) { - Tcl_SetErrno(ENOENT); - return -1; - } + /* + * Make up some fake information for this file. It has the + * correct file attributes and a time of 0. + */ - /* - * Make up some fake information for this file. It has the - * correct file attributes and a time of 0. - */ + memset(&data, 0, sizeof(data)); + data.a.dwFileAttributes = attr; + } else { + FindClose(handle); + } - memset(&data, 0, sizeof(data)); - data.a.dwFileAttributes = attr; - } else { - FindClose(handle); - } -#else - if((*tclWinProcs->getFileAttributesExProc)(nativePath, - GetFileExInfoStandard, - &data) != TRUE) { - Tcl_SetErrno(ENOENT); - return -1; - } -#endif - (*tclWinProcs->getFullPathNameProc)(nativePath, MAX_PATH, nativeFullPath, - &nativePart); + (*tclWinProcs->getFullPathNameProc)(nativePath, MAX_PATH, nativeFullPath, + &nativePart); + + fullPath = Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds); + + dev = -1; + if ((fullPath[0] == '\\') && (fullPath[1] == '\\')) { + CONST char *p; + DWORD dw; + TCHAR *nativeVol; + Tcl_DString volString; + + p = strchr(fullPath + 2, '\\'); + p = strchr(p + 1, '\\'); + if (p == NULL) { + /* + * Add terminating backslash to fullpath or + * GetVolumeInformation() won't work. + */ - fullPath = Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds); + fullPath = Tcl_DStringAppend(&ds, "\\", 1); + p = fullPath + Tcl_DStringLength(&ds); + } else { + p++; + } + nativeVol = Tcl_WinUtfToTChar(fullPath, p - fullPath, &volString); + dw = (DWORD) -1; + (*tclWinProcs->getVolumeInformationProc)(nativeVol, NULL, 0, &dw, + NULL, NULL, NULL, 0); + /* + * GetFullPathName() turns special devices like "NUL" into "\\.\NUL", + * but GetVolumeInformation() returns failure for "\\.\NUL". This + * will cause "NUL" to get a drive number of -1, which makes about + * as much sense as anything since the special devices don't live on + * any drive. + */ + + dev = dw; + Tcl_DStringFree(&volString); + } else if ((fullPath[0] != '\0') && (fullPath[1] == ':')) { + dev = Tcl_UniCharToLower(fullPath[0]) - 'a'; + } + Tcl_DStringFree(&ds); + + attr = data.a.dwFileAttributes; + + statPtr->st_size = data.a.nFileSizeLow; + statPtr->st_atime = ToCTime(data.a.ftLastAccessTime); + statPtr->st_mtime = ToCTime(data.a.ftLastWriteTime); + statPtr->st_ctime = ToCTime(data.a.ftCreationTime); + } else { + WIN32_FILE_ATTRIBUTE_DATA data; + if((*tclWinProcs->getFileAttributesExProc)(nativePath, + GetFileExInfoStandard, + &data) != TRUE) { + Tcl_SetErrno(ENOENT); + return -1; + } - dev = -1; - if ((fullPath[0] == '\\') && (fullPath[1] == '\\')) { - CONST char *p; - DWORD dw; - TCHAR *nativeVol; - Tcl_DString volString; + + (*tclWinProcs->getFullPathNameProc)(nativePath, MAX_PATH, nativeFullPath, + &nativePart); + + fullPath = Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds); + + dev = -1; + if ((fullPath[0] == '\\') && (fullPath[1] == '\\')) { + CONST char *p; + DWORD dw; + TCHAR *nativeVol; + Tcl_DString volString; + + p = strchr(fullPath + 2, '\\'); + p = strchr(p + 1, '\\'); + if (p == NULL) { + /* + * Add terminating backslash to fullpath or + * GetVolumeInformation() won't work. + */ - p = strchr(fullPath + 2, '\\'); - p = strchr(p + 1, '\\'); - if (p == NULL) { + fullPath = Tcl_DStringAppend(&ds, "\\", 1); + p = fullPath + Tcl_DStringLength(&ds); + } else { + p++; + } + nativeVol = Tcl_WinUtfToTChar(fullPath, p - fullPath, &volString); + dw = (DWORD) -1; + (*tclWinProcs->getVolumeInformationProc)(nativeVol, NULL, 0, &dw, + NULL, NULL, NULL, 0); /* - * Add terminating backslash to fullpath or - * GetVolumeInformation() won't work. + * GetFullPathName() turns special devices like "NUL" into "\\.\NUL", + * but GetVolumeInformation() returns failure for "\\.\NUL". This + * will cause "NUL" to get a drive number of -1, which makes about + * as much sense as anything since the special devices don't live on + * any drive. */ - fullPath = Tcl_DStringAppend(&ds, "\\", 1); - p = fullPath + Tcl_DStringLength(&ds); - } else { - p++; + dev = dw; + Tcl_DStringFree(&volString); + } else if ((fullPath[0] != '\0') && (fullPath[1] == ':')) { + dev = Tcl_UniCharToLower(fullPath[0]) - 'a'; } - nativeVol = Tcl_WinUtfToTChar(fullPath, p - fullPath, &volString); - dw = (DWORD) -1; - (*tclWinProcs->getVolumeInformationProc)(nativeVol, NULL, 0, &dw, - NULL, NULL, NULL, 0); - /* - * GetFullPathName() turns special devices like "NUL" into "\\.\NUL", - * but GetVolumeInformation() returns failure for "\\.\NUL". This - * will cause "NUL" to get a drive number of -1, which makes about - * as much sense as anything since the special devices don't live on - * any drive. - */ - - dev = dw; - Tcl_DStringFree(&volString); - } else if ((fullPath[0] != '\0') && (fullPath[1] == ':')) { - dev = Tcl_UniCharToLower(fullPath[0]) - 'a'; + Tcl_DStringFree(&ds); + + attr = data.dwFileAttributes; + + statPtr->st_size = data.nFileSizeLow; + statPtr->st_atime = ToCTime(data.ftLastAccessTime); + statPtr->st_mtime = ToCTime(data.ftLastWriteTime); + statPtr->st_ctime = ToCTime(data.ftCreationTime); } - Tcl_DStringFree(&ds); -#ifdef OLD_API - attr = data.a.dwFileAttributes; -#else - attr = data.dwFileAttributes; -#endif mode = (attr & FILE_ATTRIBUTE_DIRECTORY) ? S_IFDIR | S_IEXEC : S_IFREG; mode |= (attr & FILE_ATTRIBUTE_READONLY) ? S_IREAD : S_IREAD | S_IWRITE; if (NativeIsExec(nativePath)) { @@ -1002,17 +1059,6 @@ NativeStat(nativePath, statPtr) statPtr->st_uid = 0; statPtr->st_gid = 0; statPtr->st_rdev = (dev_t) dev; -#ifdef OLD_API - statPtr->st_size = data.a.nFileSizeLow; - statPtr->st_atime = ToCTime(data.a.ftLastAccessTime); - statPtr->st_mtime = ToCTime(data.a.ftLastWriteTime); - statPtr->st_ctime = ToCTime(data.a.ftCreationTime); -#else - statPtr->st_size = data.nFileSizeLow; - statPtr->st_atime = ToCTime(data.ftLastAccessTime); - statPtr->st_mtime = ToCTime(data.ftLastWriteTime); - statPtr->st_ctime = ToCTime(data.ftCreationTime); -#endif return 0; } |