diff options
Diffstat (limited to 'win/tclWinFile.c')
| -rw-r--r-- | win/tclWinFile.c | 231 |
1 files changed, 160 insertions, 71 deletions
diff --git a/win/tclWinFile.c b/win/tclWinFile.c index 8213e6d..895747a 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.44 2003/02/10 12:50:32 vincentdarley Exp $ + * RCS: @(#) $Id: tclWinFile.c,v 1.45 2003/04/11 16:00:13 vincentdarley Exp $ */ //#define _WIN32_WINNT 0x0500 @@ -128,6 +128,18 @@ typedef struct { WCHAR dummyBuf[MAX_PATH*3]; } DUMMY_REPARSE_BUFFER; +/* These two aren't in VC++ 5.2 headers */ +typedef enum _FINDEX_INFO_LEVELS { + FindExInfoStandard, + FindExInfoMaxInfoLevel +} FINDEX_INFO_LEVELS; +typedef enum _FINDEX_SEARCH_OPS { + FindExSearchNameMatch, + FindExSearchLimitToDirectories, + FindExSearchLimitToDevices, + FindExSearchMaxSearchOp +} FINDEX_SEARCH_OPS; + /* Other typedefs required by this code */ static time_t ToCTime(FILETIME fileTime); @@ -141,6 +153,8 @@ typedef NET_API_STATUS NET_API_FUNCTION NETAPIBUFFERFREEPROC typedef NET_API_STATUS NET_API_FUNCTION NETGETDCNAMEPROC (LPWSTR servername, LPWSTR domainname, LPBYTE *bufptr); +extern Tcl_FSDupInternalRepProc NativeDupInternalRep; + /* * Declarations for local procedures defined in this file: */ @@ -162,7 +176,6 @@ static int WinLink(CONST TCHAR* LinkSource, CONST TCHAR* LinkTarget, int linkAction); static int WinSymLinkDirectory(CONST TCHAR* LinkDirectory, CONST TCHAR* LinkTarget); - /* *-------------------------------------------------------------------- @@ -249,8 +262,7 @@ WinLink(LinkSource, LinkTarget, linkAction) * * WinReadLink * - * What does 'LinkSource' point to? We need the original 'pathPtr' - * just so we can construct a path object in the correct filesystem. + * What does 'LinkSource' point to? *-------------------------------------------------------------------- */ static Tcl_Obj* @@ -429,7 +441,11 @@ TclWinSymLinkDelete(LinkOriginal, linkOnly) * * Assumption that LinkDirectory is a valid, existing directory. * - * Returns a Tcl_Obj with refCount of 1 (i.e. owned by the caller). + * Returns a Tcl_Obj with refCount of 1 (i.e. owned by the caller), + * or NULL if anything went wrong. + * + * In the future we should enhance this to return a path object + * rather than a string. *-------------------------------------------------------------------- */ static Tcl_Obj* @@ -457,28 +473,77 @@ WinReadLinkDirectory(LinkDirectory) Tcl_DString ds; CONST char *copy; int len; + int offset = 0; - Tcl_WinTCharToUtf( - (CONST char*)reparseBuffer->SymbolicLinkReparseBuffer.PathBuffer, - (int)reparseBuffer->SymbolicLinkReparseBuffer.SubstituteNameLength, - &ds); - - copy = Tcl_DStringValue(&ds); - len = Tcl_DStringLength(&ds); /* - * Certain native path representations on Windows have this special - * prefix to indicate that they are to be treated specially. For - * example extremely long paths, or symlinks + * Certain native path representations on Windows have a + * special prefix to indicate that they are to be treated + * specially. For example extremely long paths, or symlinks, + * or volumes mounted inside directories. + * + * There is an assumption in this code that 'wide' interfaces + * are being used (see tclWin32Dll.c), which is true for the + * only systems which support reparse tags at present. If + * that changes in the future, this code will have to be + * generalised. */ - if (*copy == '\\') { - if (0 == strncmp(copy,"\\??\\",4)) { - copy += 4; - len -= 4; - } else if (0 == strncmp(copy,"\\\\?\\",4)) { - copy += 4; - len -= 4; + if (reparseBuffer->SymbolicLinkReparseBuffer.PathBuffer[0] + == L'\\') { + /* Check whether this is a mounted volume */ + if (wcsncmp(reparseBuffer->SymbolicLinkReparseBuffer.PathBuffer, + L"\\??\\Volume{",11) == 0) { + char drive; + /* + * There is some confusion between \??\ and \\?\ which + * we have to fix here. It doesn't seem very well + * documented. + */ + reparseBuffer->SymbolicLinkReparseBuffer + .PathBuffer[1] = L'\\'; + /* + * Check if a corresponding drive letter exists, and + * use that if it is found + */ + drive = TclWinDriveLetterForVolMountPoint(reparseBuffer + ->SymbolicLinkReparseBuffer.PathBuffer); + if (drive != -1) { + char driveSpec[3] = { + drive, ':', '\0' + }; + retVal = Tcl_NewStringObj(driveSpec,2); + Tcl_IncrRefCount(retVal); + return retVal; + } + /* + * This is actually a mounted drive, which doesn't + * exists as a DOS drive letter. This means the path + * isn't actually a link, although we partially treat + * it like one ('file type' will return 'link'), but + * then the link will actually just be treated like + * an ordinary directory. I don't believe any + * serious inconsistency will arise from this, but it + * is something to be aware of. + */ + Tcl_SetErrno(EINVAL); + return NULL; + } else if (wcsncmp(reparseBuffer->SymbolicLinkReparseBuffer + .PathBuffer, L"\\\\?\\",4) == 0) { + /* Strip off the prefix */ + offset = 4; + } else if (wcsncmp(reparseBuffer->SymbolicLinkReparseBuffer + .PathBuffer, L"\\??\\",4) == 0) { + /* Strip off the prefix */ + offset = 4; } } + + Tcl_WinTCharToUtf( + (CONST char*)reparseBuffer->SymbolicLinkReparseBuffer.PathBuffer, + (int)reparseBuffer->SymbolicLinkReparseBuffer + .SubstituteNameLength, &ds); + + copy = Tcl_DStringValue(&ds)+offset; + len = Tcl_DStringLength(&ds)-offset; retVal = Tcl_NewStringObj(copy,len); Tcl_IncrRefCount(retVal); Tcl_DStringFree(&ds); @@ -702,77 +767,97 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) DWORD attr; HANDLE handle; WIN32_FIND_DATAT data; - CONST char *dirName; + CONST char *dirName; /* utf-8 dir name, later + * with pattern appended */ int dirLength; int matchSpecialDots; - Tcl_DString ds; /* native encoding of dir */ + Tcl_DString ds; /* native encoding of dir, also used + * temporarily for other things. */ Tcl_DString dsOrig; /* utf-8 encoding of dir */ - Tcl_DString dirString; /* utf-8 encoding of dir with \'s */ Tcl_Obj *fileNamePtr; + char lastChar; /* - * Convert the path to normalized form since some interfaces only - * accept backslashes. Also, ensure that the directory ends with a - * separator character. + * Get the normalized path representation + * (the main thing is we dont want any '~' sequences). */ - fileNamePtr = Tcl_FSGetTranslatedPath(interp, pathPtr); + fileNamePtr = Tcl_FSGetNormalizedPath(interp, pathPtr); if (fileNamePtr == NULL) { return TCL_ERROR; } - Tcl_DStringInit(&dsOrig); - dirName = Tcl_GetStringFromObj(fileNamePtr, &dirLength); - Tcl_DStringAppend(&dsOrig, dirName, dirLength); - - Tcl_DStringInit(&dirString); - if (dirLength == 0) { - Tcl_DStringAppend(&dirString, ".\\", 2); - } else { - char *p; - - Tcl_DStringAppend(&dirString, dirName, dirLength); - for (p = Tcl_DStringValue(&dirString); *p != '\0'; p++) { - if (*p == '/') { - *p = '\\'; - } - } - p--; - /* Make sure we have a trailing directory delimiter */ - if ((*p != '\\') && (*p != ':')) { - Tcl_DStringAppend(&dirString, "\\", 1); - Tcl_DStringAppend(&dsOrig, "/", 1); - dirLength++; - } - } - dirName = Tcl_DStringValue(&dirString); /* - * First verify that the specified path is actually a directory. + * Verify that the specified path exists and + * is actually a directory. */ - - native = Tcl_WinUtfToTChar(dirName, Tcl_DStringLength(&dirString), - &ds); + native = Tcl_FSGetNativePath(pathPtr); + if (native == NULL) { + return TCL_OK; + } attr = (*tclWinProcs->getFileAttributesProc)(native); - Tcl_DStringFree(&ds); if ((attr == 0xffffffff) || ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0)) { - Tcl_DStringFree(&dirString); return TCL_OK; } + /* + * Build up the directory name for searching, including + * a trailing directory separator. + */ + + Tcl_DStringInit(&dsOrig); + dirName = Tcl_GetStringFromObj(fileNamePtr, &dirLength); + Tcl_DStringAppend(&dsOrig, dirName, dirLength); + + lastChar = dirName[dirLength -1]; + if ((lastChar != '\\') && (lastChar != '/') && (lastChar != ':')) { + Tcl_DStringAppend(&dsOrig, "/", 1); + dirLength++; + } + dirName = Tcl_DStringValue(&dsOrig); + /* - * We need to check all files in the directory, so append a *.* - * to the path. + * We need to check all files in the directory, so we append + * '*.*' to the path, unless the pattern we've been given is + * rather simple, when we can use that instead. */ - dirName = Tcl_DStringAppend(&dirString, "*.*", 3); + if (strpbrk(pattern, "[]\\") == NULL) { + /* + * The pattern is a simple one containing just '*' and/or '?'. + * This means we can get the OS to help us, by passing + * it the pattern. + */ + dirName = Tcl_DStringAppend(&dsOrig, pattern, -1); + } else { + dirName = Tcl_DStringAppend(&dsOrig, "*.*", 3); + } native = Tcl_WinUtfToTChar(dirName, -1, &ds); - handle = (*tclWinProcs->findFirstFileProc)(native, &data); + if (tclWinProcs->findFirstFileExProc == NULL + || (types == NULL) + || (types->type != TCL_GLOB_TYPE_DIR)) { + handle = (*tclWinProcs->findFirstFileProc)(native, &data); + } else { + /* We can be more efficient, for pure directory requests */ + handle = (*tclWinProcs->findFirstFileExProc)(native, + FindExInfoStandard, &data, + FindExSearchLimitToDirectories, NULL, 0); + } Tcl_DStringFree(&ds); if (handle == INVALID_HANDLE_VALUE) { - Tcl_DStringFree(&dirString); - TclWinConvertError(GetLastError()); + DWORD err = GetLastError(); + if (err == ERROR_FILE_NOT_FOUND) { + /* + * We used our 'pattern' above, and matched nothing + * This means we just return TCL_OK, indicating + * no results found. + */ + Tcl_DStringFree(&dsOrig); + return TCL_OK; + } + TclWinConvertError(err); Tcl_ResetResult(interp); Tcl_AppendResult(interp, "couldn't read directory \"", Tcl_DStringValue(&dsOrig), "\": ", @@ -781,6 +866,12 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) return TCL_ERROR; } + /* + * We may use this later, so we must restore it to its + * length including the directory delimiter + */ + Tcl_DStringSetLength(&dsOrig, dirLength); + /* * Check to see if the pattern should match the special * . and .. names, referring to the current directory, @@ -874,7 +965,6 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) } while ((*tclWinProcs->findNextFileProc)(handle, &data) == TRUE); FindClose(handle); - Tcl_DStringFree(&dirString); Tcl_DStringFree(&dsOrig); return TCL_OK; } @@ -942,10 +1032,9 @@ WinIsDrive( * volume, because for NTFS root volumes, the getFileAttributesProc * returns a 'hidden' attribute when it should not. * - * We only ever make one call to a 'get attributes' routine here, - * so that this function is as fast as possible. Unfortunately, - * it still means we have to make the call for every single file - * we return from 'glob', which is not ideal. + * We never make any calss to a 'get attributes' routine here, + * since we have arranged things so that our caller already knows + * such information. * * Results: * 0 = file doesn't match |