fix 5 small filesystem bugs, and some typos

4 files changed, 359 insertions, 77 deletions

diff --git a/win/makefile.vc b/win/makefile.vc
index 771ebe8..f42d67b 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -12,7 +12,7 @@
 # Copyright (c) 2001-2002 David Gravereaux.
 #
 #------------------------------------------------------------------------------
-# RCS: @(#) $Id: makefile.vc,v 1.104 2003/04/05 01:25:11 dkf Exp $
+# RCS: @(#) $Id: makefile.vc,v 1.105 2003/04/11 16:00:07 vincentdarley Exp $
 #------------------------------------------------------------------------------
 
 !if "$(MSVCDIR)" == ""
@@ -264,6 +264,7 @@ TCLOBJS = \
 	$(TMP_DIR)\tclPanic.obj \
 	$(TMP_DIR)\tclParse.obj \
 	$(TMP_DIR)\tclParseExpr.obj \
+	$(TMP_DIR)\tclPathObj.obj \
 	$(TMP_DIR)\tclPipe.obj \
 	$(TMP_DIR)\tclPkg.obj \
 	$(TMP_DIR)\tclPosixStr.obj \
diff --git a/win/tclWin32Dll.c b/win/tclWin32Dll.c
index 5b939f9..ded9c6f 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.24 2003/02/04 17:06:52 vincentdarley Exp $
+ * RCS: @(#) $Id: tclWin32Dll.c,v 1.25 2003/04/11 16:00:08 vincentdarley Exp $
  */
 
 #include "tclWinInt.h"
@@ -88,7 +88,7 @@ static TclWinProcs asciiProcs = {
     (BOOL (WINAPI *)(CONST TCHAR *)) SetCurrentDirectoryA,
     (BOOL (WINAPI *)(CONST TCHAR *, DWORD)) SetFileAttributesA,
     /* 
-     * These two function pointers will only be set when
+     * The three NULL function pointers will only be set when
      * Tcl_FindExecutable is called.  If you don't ever call that
      * function, the application will crash whenever WinTcl tries to call
      * functions through these null pointers.  That is not a bug in Tcl
@@ -97,6 +97,8 @@ static TclWinProcs asciiProcs = {
     NULL,
     NULL,
     (int (__cdecl*)(CONST TCHAR *, struct _utimbuf *)) _utime,
+    NULL,
+    NULL,
 };
 
 static TclWinProcs unicodeProcs = {
@@ -135,7 +137,7 @@ static TclWinProcs unicodeProcs = {
     (BOOL (WINAPI *)(CONST TCHAR *)) SetCurrentDirectoryW,
     (BOOL (WINAPI *)(CONST TCHAR *, DWORD)) SetFileAttributesW,
     /* 
-     * These two function pointers will only be set when
+     * The three NULL function pointers will only be set when
      * Tcl_FindExecutable is called.  If you don't ever call that
      * function, the application will crash whenever WinTcl tries to call
      * functions through these null pointers.  That is not a bug in Tcl
@@ -144,6 +146,8 @@ static TclWinProcs unicodeProcs = {
     NULL,
     NULL,
     (int (__cdecl*)(CONST TCHAR *, struct _utimbuf *)) _wutime,
+    NULL,
+    NULL,
 };
 
 TclWinProcs *tclWinProcs;
@@ -156,6 +160,28 @@ static Tcl_Encoding tclWinTCharEncoding;
 BOOL APIENTRY		DllMain(HINSTANCE hInst, DWORD reason, 
 				LPVOID reserved);
 
+/*
+ * The following structure and linked list is to allow us to map between
+ * volume mount points and drive letters on the fly (no Win API exists
+ * for this).
+ */
+typedef struct MountPointMap {
+    CONST WCHAR* volumeName;       /* Native wide string volume name */
+    char driveLetter;              /* Drive letter corresponding to
+                                    * the volume name. */
+    struct MountPointMap* nextPtr; /* Pointer to next structure in list,
+                                    * or NULL */
+} MountPointMap;
+
+/* 
+ * This is the head of the linked list, which is protected by the
+ * mutex which follows, for thread-enabled builds.
+ */
+MountPointMap *driveLetterLookup = NULL;
+TCL_DECLARE_MUTEX(mountPointMap)
+
+/* We will need this below */
+extern Tcl_FSDupInternalRepProc NativeDupInternalRep;
 
 #ifdef __WIN32__
 #ifndef STATIC_BUILD
@@ -531,6 +557,14 @@ TclWinSetInterfaces(
 		  (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR*, 
 		  LPSECURITY_ATTRIBUTES)) GetProcAddress(hInstance, 
 		  "CreateHardLinkW");
+	        tclWinProcs->findFirstFileExProc = 
+		  (HANDLE (WINAPI *)(CONST TCHAR*, UINT,
+		  LPVOID, UINT, LPVOID, DWORD)) GetProcAddress(hInstance, 
+		  "FindFirstFileExW");
+	        tclWinProcs->getVolumeNameForVMPProc = 
+		  (BOOL (WINAPI *)(CONST TCHAR*, TCHAR*, 
+		  DWORD)) GetProcAddress(hInstance, 
+		  "GetVolumeNameForVolumeMountPointW");
 		FreeLibrary(hInstance);
 	    }
 	}
@@ -547,6 +581,14 @@ TclWinSetInterfaces(
 		  (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR*, 
 		  LPSECURITY_ATTRIBUTES)) GetProcAddress(hInstance, 
 		  "CreateHardLinkA");
+		tclWinProcs->findFirstFileExProc = 
+		  (HANDLE (WINAPI *)(CONST TCHAR*, UINT,
+		  LPVOID, UINT, LPVOID, DWORD)) GetProcAddress(hInstance, 
+		  "FindFirstFileExA");
+		tclWinProcs->getVolumeNameForVMPProc = 
+		  (BOOL (WINAPI *)(CONST TCHAR*, TCHAR*, 
+		  DWORD)) GetProcAddress(hInstance, 
+		  "GetVolumeNameForVolumeMountPointA");
 		FreeLibrary(hInstance);
 	    }
 	}
@@ -562,6 +604,11 @@ TclWinSetInterfaces(
  *	The tclWinProcs-> look up table is still ok to use after
  *	this call, provided no encoding conversion is required.
  *
+ *      We also clean up any memory allocated in our mount point
+ *      map which is used to follow certain kinds of symlinks.
+ *      That code should never be used once encodings are taken
+ *      down.
+ *      
  * Results:
  *	None.
  *
@@ -573,10 +620,21 @@ TclWinSetInterfaces(
 void
 TclWinResetInterfaceEncodings()
 {
+    MountPointMap *dlIter, *dlIter2;
     if (tclWinTCharEncoding != NULL) {
 	Tcl_FreeEncoding(tclWinTCharEncoding);
 	tclWinTCharEncoding = NULL;
     }
+    /* Clean up the mount point map */
+    Tcl_MutexLock(&mountPointMap);
+    dlIter = driveLetterLookup; 
+    while (dlIter != NULL) {
+	dlIter2 = dlIter->nextPtr;
+	ckfree((char*)dlIter->volumeName);
+	ckfree((char*)dlIter);
+	dlIter = dlIter2;
+    }
+    Tcl_MutexUnlock(&mountPointMap);
 }
 
 /*
@@ -603,6 +661,135 @@ TclWinResetInterfaces()
 }
 
 /*
+ *--------------------------------------------------------------------
+ *
+ * TclWinDriveLetterForVolMountPoint
+ *
+ * Unfortunately, Windows provides no easy way at all to get hold
+ * of the drive letter for a volume mount point, but we need that
+ * information to understand paths correctly.  So, we have to 
+ * build an associated array to find these correctly, and allow
+ * quick and easy lookup from volume mount points to drive letters.
+ * 
+ * We assume here that we are running on a system for which the wide
+ * character interfaces are used, which is valid for Win 2000 and WinXP
+ * which are the only systems on which this function will ever be called.
+ * 
+ * Result: the drive letter, or -1 if no drive letter corresponds to
+ * the given mount point.
+ * 
+ *--------------------------------------------------------------------
+ */
+char 
+TclWinDriveLetterForVolMountPoint(CONST WCHAR *mountPoint)
+{
+    MountPointMap *dlIter, *dlPtr2;
+    WCHAR Target[55];         /* Target of mount at mount point */
+    WCHAR drive[4] = { L'A', L':', L'\\', L'\0' };
+    
+    /* 
+     * Detect the volume mounted there.  Unfortunately, there is no
+     * simple way to map a unique volume name to a DOS drive letter.  
+     * So, we have to build an associative array.
+     */
+    
+    Tcl_MutexLock(&mountPointMap);
+    dlIter = driveLetterLookup; 
+    while (dlIter != NULL) {
+	if (wcscmp(dlIter->volumeName, mountPoint) == 0) {
+	    /* 
+	     * We need to check whether this information is
+	     * still valid, since either the user or various
+	     * programs could have adjusted the mount points on
+	     * the fly.
+	     */
+	    drive[0] = L'A' + (dlIter->driveLetter - 'A');
+	    /* Try to read the volume mount point and see where it points */
+	    if ((*tclWinProcs->getVolumeNameForVMPProc)((TCHAR*)drive, 
+					       (TCHAR*)Target, 55) != 0) {
+		if (wcscmp((WCHAR*)dlIter->volumeName, Target) == 0) {
+		    /* Nothing has changed */
+		    Tcl_MutexUnlock(&mountPointMap);
+		    return dlIter->driveLetter;
+		}
+	    }
+	    /* 
+	     * If we reach here, unfortunately, this mount point is
+	     * no longer valid at all
+	     */
+	    if (driveLetterLookup == dlIter) {
+		dlPtr2 = dlIter;
+		driveLetterLookup = dlIter->nextPtr;
+	    } else {
+		for (dlPtr2 = driveLetterLookup; 
+		     dlPtr2 != NULL; dlPtr2 = dlPtr2->nextPtr) {
+		    if (dlPtr2->nextPtr == dlIter) {
+			dlPtr2->nextPtr = dlIter->nextPtr;
+			dlPtr2 = dlIter;
+			break;
+		    }
+		}
+	    }
+	    /* Now dlPtr2 points to the structure to free */
+	    ckfree((char*)dlPtr2->volumeName);
+	    ckfree((char*)dlPtr2);
+	    /* 
+	     * Restart the loop --- we could try to be clever
+	     * and continue half way through, but the logic is a 
+	     * bit messy, so it's cleanest just to restart
+	     */
+	    dlIter = driveLetterLookup;
+	    continue;
+	}
+	dlIter = dlIter->nextPtr;
+    }
+   
+    /* We couldn't find it, so we must iterate over the letters */
+    
+    for (drive[0] = L'A'; drive[0] <= L'Z'; drive[0]++) {
+	/* Try to read the volume mount point and see where it points */
+	if ((*tclWinProcs->getVolumeNameForVMPProc)((TCHAR*)drive, 
+					   (TCHAR*)Target, 55) != 0) {
+	    int alreadyStored = 0;
+	    for (dlIter = driveLetterLookup; dlIter != NULL; 
+		 dlIter = dlIter->nextPtr) {
+		if (wcscmp((WCHAR*)dlIter->volumeName, Target) == 0) {
+		    alreadyStored = 1;
+		    break;
+		}
+	    }
+	    if (!alreadyStored) {
+		dlPtr2 = (MountPointMap*) ckalloc(sizeof(MountPointMap));
+		dlPtr2->volumeName = NativeDupInternalRep(Target);
+		dlPtr2->driveLetter = 'A' + (drive[0] - L'A');
+		dlPtr2->nextPtr = driveLetterLookup;
+		driveLetterLookup  = dlPtr2;
+	    }
+	}
+    }
+    /* Try again */
+    for (dlIter = driveLetterLookup; dlIter != NULL; 
+					dlIter = dlIter->nextPtr) {
+	if (wcscmp(dlIter->volumeName, mountPoint) == 0) {
+	    Tcl_MutexUnlock(&mountPointMap);
+	    return dlIter->driveLetter;
+	}
+    }
+    /* 
+     * The volume doesn't appear to correspond to a drive letter -- we
+     * remember that fact and store '-1' so we don't have to look it
+     * up each time.
+     */
+    dlPtr2 = (MountPointMap*) ckalloc(sizeof(MountPointMap));
+    dlPtr2->volumeName = NativeDupInternalRep((ClientData)mountPoint);
+    dlPtr2->driveLetter = -1;
+    dlPtr2->nextPtr = driveLetterLookup;
+    driveLetterLookup  = dlPtr2;
+    Tcl_MutexUnlock(&mountPointMap);
+    return -1;
+}
+
+/*
  *---------------------------------------------------------------------------
  *
  * Tcl_WinUtfToTChar, Tcl_WinTCharToUtf --
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
diff --git a/win/tclWinInt.h b/win/tclWinInt.h
index 0e0f11d..c2fe5ae 100644
--- a/win/tclWinInt.h
+++ b/win/tclWinInt.h
@@ -8,7 +8,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclWinInt.h,v 1.20 2003/02/04 17:06:53 vincentdarley Exp $
+ * RCS: @(#) $Id: tclWinInt.h,v 1.21 2003/04/11 16:00:17 vincentdarley Exp $
  */
 
 #ifndef _TCLWININT
@@ -102,7 +102,11 @@ typedef struct TclWinProcs {
 				      LPSECURITY_ATTRIBUTES);
     
     INT (__cdecl *utimeProc)(CONST TCHAR*, struct _utimbuf *);
-    
+    /* These two are also NULL at start; see comment above */
+    HANDLE (WINAPI *findFirstFileExProc)(CONST TCHAR*, UINT,
+					 LPVOID, UINT,
+					 LPVOID, DWORD);
+    BOOL (WINAPI *getVolumeNameForVMPProc)(CONST TCHAR*, TCHAR*, DWORD);
 } TclWinProcs;
 
 EXTERN TclWinProcs *tclWinProcs;
@@ -119,6 +123,7 @@ EXTERN int              TclWinSymLinkCopyDirectory(CONST TCHAR* LinkOriginal,
 						   CONST TCHAR* LinkCopy);
 EXTERN int              TclWinSymLinkDelete(CONST TCHAR* LinkOriginal, 
 					    int linkOnly);
+EXTERN char TclWinDriveLetterForVolMountPoint(CONST WCHAR *mountPoint);
 #if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
 EXTERN void		TclWinFreeAllocCache(void);
 EXTERN void		TclFreeAllocCache(void *);