vfs fixes

1 files changed, 28 insertions, 12 deletions

diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index 31dca87..04c5fa8 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.38 2002/07/19 12:31:10 dkf Exp $
+ * RCS: @(#) $Id: tclWinFile.c,v 1.39 2002/07/20 01:01:41 vincentdarley Exp $
  */
 
 //#define _WIN32_WINNT  0x0500
@@ -452,19 +452,35 @@ WinReadLinkDirectory(LinkDirectory)
 	case 0x80000000|IO_REPARSE_TAG_SYMBOLIC_LINK: 
 	case IO_REPARSE_TAG_SYMBOLIC_LINK: 
 	case IO_REPARSE_TAG_MOUNT_POINT: {
-	    int len;
-	    ClientData clientData;
 	    Tcl_Obj *retVal;
+	    Tcl_DString ds;
+	    CONST char *copy;
+	    int len;
 	    
-	    len = reparseBuffer->SymbolicLinkReparseBuffer.SubstituteNameLength
-		+ sizeof(WCHAR);
-	    clientData = (ClientData)ckalloc(len);
-	    memcpy((VOID*)clientData,
-		   (VOID*)reparseBuffer->SymbolicLinkReparseBuffer.PathBuffer,
-		   len);
-	    
-	    retVal = Tcl_FSNewNativePath(&tclNativeFilesystem, clientData);
+	    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 
+	     */
+	    if (*copy == '\\') {
+		if (0 == strncmp(copy,"\\??\\",4)) {
+		    copy += 4;
+		    len -= 4;
+		} else if (0 == strncmp(copy,"\\\\?\\",4)) {
+		    copy += 4;
+		    len -= 4;
+		}
+	    }
+	    retVal = Tcl_NewStringObj(copy,len);
 	    Tcl_IncrRefCount(retVal);
+	    Tcl_DStringFree(&ds);
 	    return retVal;
 	}
     }
@@ -1362,7 +1378,7 @@ TclpReadlink(path, linkPtr)
     Tcl_DStringFree(&ds);
     
     if (length < 0) {
-       return NULL;
+	return NULL;
     }
 
     Tcl_ExternalToUtfDString(NULL, link, length, linkPtr);