From 85fa4c1014f2115447bba5458e877fe974f04f1b Mon Sep 17 00:00:00 2001 From: vincentdarley Date: Wed, 12 Jun 2002 09:28:58 +0000 Subject: fs clarification and windows fixes --- ChangeLog | 22 ++ doc/FileSystem.3 | 12 +- generic/tcl.decls | 4 +- generic/tclDecls.h | 6 +- generic/tclIOUtil.c | 73 ++++-- unix/tclUnixFile.c | 26 +- win/tclWinFCmd.c | 311 ++-------------------- win/tclWinFile.c | 721 ++++++++++++++++++++++++++++++++++++++++++++++++++-- win/tclWinInt.h | 12 +- win/tclWinPort.h | 14 +- 10 files changed, 853 insertions(+), 348 deletions(-) diff --git a/ChangeLog b/ChangeLog index e73429c..0d84901 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,25 @@ +2002-06-12 Vince Darley + + * generic/tclIOUtil.c: + * generic/tcl.decls: + * generic/tclDecls.h: made code for Tcl_FSNewNativePath + agree with man pages. + + * doc/FileSystem.3: clarified the circumstances under which + certain functions are called in the presence of symlinks. + + * win/tclWinFile.c: + * win/tclWinPort.h: + * win/tclWinInt.h: + * win/tclWinFCmd.c: Fix for Windows to allow 'file lstat', + 'file type', 'glob -type l', 'file copy', 'file delete', + 'file normalize', and all VFS code to work correctly in the + presence of symlinks (previously Tcl's behaviour was not very + well defined). This also fixes possible serious problems in + all versions of WinTcl where 'file delete' on a NTFS symlink + could delete the original, not the symlink. + Note: symlinks cannot yet be created in pure Tcl. + 2002-06-11 Miguel Sofer * generic/tclBasic.c: diff --git a/doc/FileSystem.3 b/doc/FileSystem.3 index 01a3585..a9ec3e8 100644 --- a/doc/FileSystem.3 +++ b/doc/FileSystem.3 @@ -4,7 +4,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: FileSystem.3,v 1.23 2002/05/07 18:03:04 vincentdarley Exp $ +'\" RCS: @(#) $Id: FileSystem.3,v 1.24 2002/06/12 09:28:58 vincentdarley Exp $ '\" .so man.macros .TH Filesystem 3 8.4 Tcl "Tcl Library Procedures" @@ -1168,7 +1168,10 @@ typedef int Tcl_FSDeleteFileProc( .PP The return value is a standard Tcl result indicating whether an error occurred in the process. If successful, the file specified by -\fIpathPtr\fR should have been removed from the filesystem. +\fIpathPtr\fR should have been removed from the filesystem. Note that, +if the filesystem supports symbolic links, Tcl will always call this +function and not Tcl_FSRemoveDirectoryProc when needed to delete them +(even if they are symbolic links to directories). .SH "FILESYSTEM EFFICIENCY" .PP .SH LSTATPROC @@ -1207,7 +1210,10 @@ occurred in the copying process. Note that, \fIdestPathPtr\fR is the name of the file which should become the copy of \fIsrcPathPtr\fR. It is never the name of a directory into which \fIsrcPathPtr\fR could be copied (i.e. the function is much simpler than the Tcl level 'file -copy' subcommand). +copy' subcommand). Note that, +if the filesystem supports symbolic links, Tcl will always call this +function and not Tcl_FSCopyDirectoryProc when needed to copy them +(even if they are symbolic links to directories). .SH RENAMEFILEPROC .PP Function to process a \fBTcl_FSRenameFile()\fR call. If not implemented, diff --git a/generic/tcl.decls b/generic/tcl.decls index b384108..7f10c97 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -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: tcl.decls,v 1.87 2002/05/24 21:19:05 dkf Exp $ +# RCS: @(#) $Id: tcl.decls,v 1.88 2002/06/12 09:28:58 vincentdarley Exp $ library tcl @@ -1649,7 +1649,7 @@ declare 467 generic { int Tcl_FSEvalFile(Tcl_Interp *interp, Tcl_Obj *fileName) } declare 468 generic { - Tcl_Obj* Tcl_FSNewNativePath(Tcl_Obj* fromFilesystem, + Tcl_Obj* Tcl_FSNewNativePath(Tcl_Filesystem* fromFilesystem, ClientData clientData) } declare 469 generic { diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 95e47ec..8062d1e 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.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: tclDecls.h,v 1.87 2002/05/24 21:19:05 dkf Exp $ + * RCS: @(#) $Id: tclDecls.h,v 1.88 2002/06/12 09:28:58 vincentdarley Exp $ */ #ifndef _TCLDECLS @@ -1483,7 +1483,7 @@ EXTERN int Tcl_FSEvalFile _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * fileName)); /* 468 */ EXTERN Tcl_Obj* Tcl_FSNewNativePath _ANSI_ARGS_(( - Tcl_Obj* fromFilesystem, + Tcl_Filesystem* fromFilesystem, ClientData clientData)); /* 469 */ EXTERN CONST char* Tcl_FSGetNativePath _ANSI_ARGS_((Tcl_Obj* pathObjPtr)); @@ -2083,7 +2083,7 @@ typedef struct TclStubs { ClientData (*tcl_FSGetInternalRep) _ANSI_ARGS_((Tcl_Obj* pathObjPtr, Tcl_Filesystem * fsPtr)); /* 465 */ Tcl_Obj* (*tcl_FSGetTranslatedPath) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj* pathPtr)); /* 466 */ int (*tcl_FSEvalFile) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * fileName)); /* 467 */ - Tcl_Obj* (*tcl_FSNewNativePath) _ANSI_ARGS_((Tcl_Obj* fromFilesystem, ClientData clientData)); /* 468 */ + Tcl_Obj* (*tcl_FSNewNativePath) _ANSI_ARGS_((Tcl_Filesystem* fromFilesystem, ClientData clientData)); /* 468 */ CONST char* (*tcl_FSGetNativePath) _ANSI_ARGS_((Tcl_Obj* pathObjPtr)); /* 469 */ Tcl_Obj* (*tcl_FSFileSystemInfo) _ANSI_ARGS_((Tcl_Obj* pathObjPtr)); /* 470 */ Tcl_Obj* (*tcl_FSPathSeparator) _ANSI_ARGS_((Tcl_Obj* pathObjPtr)); /* 471 */ diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index f5ee327..0858a58 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -17,7 +17,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclIOUtil.c,v 1.47 2002/06/10 17:41:52 vincentdarley Exp $ + * RCS: @(#) $Id: tclIOUtil.c,v 1.48 2002/06/12 09:28:58 vincentdarley Exp $ */ #include "tclInt.h" @@ -26,7 +26,7 @@ #include "tclMacInt.h" #endif #ifdef __WIN32__ -/* For 'file link' */ +/* for tclWinProcs->useWide */ #include "tclWinInt.h" #endif @@ -318,6 +318,9 @@ typedef struct FilesystemRecord { * to Tcl, or NULL if no more. */ } FilesystemRecord; +static FilesystemRecord* GetFilesystemRecord + _ANSI_ARGS_((Tcl_Filesystem *fromFilesystem, int *epoch)); + /* * Declare the native filesystem support. These functions should * be considered private to Tcl, and should really not be called @@ -370,7 +373,7 @@ Tcl_FSLinkProc TclpObjLink; Tcl_FSListVolumesProc TclpObjListVolumes; /* Define the native filesystem dispatch table */ -static Tcl_Filesystem nativeFilesystem = { +Tcl_Filesystem nativeFilesystem = { "native", sizeof(Tcl_Filesystem), TCL_FILESYSTEM_VERSION_1, @@ -3900,20 +3903,22 @@ SetFsPathFromAny(interp, objPtr) Tcl_Obj * Tcl_FSNewNativePath(fromFilesystem, clientData) - Tcl_Obj* fromFilesystem; + Tcl_Filesystem* fromFilesystem; ClientData clientData; { Tcl_Obj *objPtr; - FsPath *fsPathPtr, *fsFromPtr; + FsPath *fsPathPtr; + FilesystemRecord *fsFromPtr; Tcl_FSInternalToNormalizedProc *proc; + int epoch; - if (Tcl_FSConvertToPathType(NULL, fromFilesystem) != TCL_OK) { - return NULL; + fsFromPtr = GetFilesystemRecord(fromFilesystem, &epoch); + + if (fsFromPtr == NULL) { + return NULL; } - fsFromPtr = (FsPath*) fromFilesystem->internalRep.otherValuePtr; - - proc = fsFromPtr->fsRecPtr->fsPtr->internalToNormalizedProc; + proc = fsFromPtr->fsPtr->internalToNormalizedProc; if (proc == NULL) { return NULL; @@ -3946,10 +3951,10 @@ Tcl_FSNewNativePath(fromFilesystem, clientData) fsPathPtr->normPathPtr = objPtr; fsPathPtr->cwdPtr = NULL; fsPathPtr->nativePathPtr = clientData; - fsPathPtr->fsRecPtr = fsFromPtr->fsRecPtr; + fsPathPtr->fsRecPtr = fsFromPtr; /* We must increase the refCount for this filesystem. */ fsPathPtr->fsRecPtr->fileRefCount++; - fsPathPtr->filesystemEpoch = fsFromPtr->filesystemEpoch; + fsPathPtr->filesystemEpoch = epoch; objPtr->internalRep.otherValuePtr = (VOID *) fsPathPtr; objPtr->typePtr = &tclFsPathType; @@ -4385,14 +4390,20 @@ NativeCreateNativeRep(pathObjPtr) str = Tcl_GetStringFromObj(normPtr,&len); #ifdef __WIN32__ Tcl_WinUtfToTChar(str, len, &ds); - nativePathPtr = ckalloc((unsigned)(2+Tcl_DStringLength(&ds))); - memcpy((VOID*)nativePathPtr, (VOID*)Tcl_DStringValue(&ds), - (size_t) (2+Tcl_DStringLength(&ds))); + if (tclWinProcs->useWide) { + nativePathPtr = ckalloc((unsigned)(sizeof(WCHAR)+Tcl_DStringLength(&ds))); + memcpy((VOID*)nativePathPtr, (VOID*)Tcl_DStringValue(&ds), + (size_t) (sizeof(WCHAR)+Tcl_DStringLength(&ds))); + } else { + nativePathPtr = ckalloc((unsigned)(sizeof(char)+Tcl_DStringLength(&ds))); + memcpy((VOID*)nativePathPtr, (VOID*)Tcl_DStringValue(&ds), + (size_t) (sizeof(char)+Tcl_DStringLength(&ds))); + } #else Tcl_UtfToExternalDString(NULL, str, len, &ds); - nativePathPtr = ckalloc((unsigned)(1+Tcl_DStringLength(&ds))); + nativePathPtr = ckalloc((unsigned)(sizeof(char)+Tcl_DStringLength(&ds))); memcpy((VOID*)nativePathPtr, (VOID*)Tcl_DStringValue(&ds), - (size_t) (1+Tcl_DStringLength(&ds))); + (size_t) (sizeof(char)+Tcl_DStringLength(&ds))); #endif Tcl_DStringFree(&ds); @@ -4439,9 +4450,14 @@ TclpNativeToNormalized(clientData) * prefix to indicate that they are to be treated specially. For * example extremely long paths, or symlinks */ - if (0 == strncmp(copy,"\\??\\",4)) { - copy += 4; - len -= 4; + if (*copy == '\\') { + if (0 == strncmp(copy,"\\??\\",4)) { + copy += 4; + len -= 4; + } else if (0 == strncmp(copy,"\\\\?\\",4)) { + copy += 4; + len -= 4; + } } #endif @@ -4776,6 +4792,23 @@ Tcl_FSGetFileSystemForPath(pathObjPtr) return retVal; } +/* Simple helper function */ +static FilesystemRecord* +GetFilesystemRecord(fromFilesystem, epoch) + Tcl_Filesystem *fromFilesystem; + int *epoch; +{ + FilesystemRecord *fsRecPtr = FsGetIterator(); + while (fsRecPtr != NULL) { + if (fsRecPtr->fsPtr == fromFilesystem) { + *epoch = theFilesystemEpoch; + break; + } + } + FsReleaseIterator(); + return fsRecPtr; +} + /* *--------------------------------------------------------------------------- * diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c index 5eca8e7..2fd7b11 100644 --- a/unix/tclUnixFile.c +++ b/unix/tclUnixFile.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: tclUnixFile.c,v 1.20 2002/05/02 20:15:20 vincentdarley Exp $ + * RCS: @(#) $Id: tclUnixFile.c,v 1.21 2002/06/12 09:28:58 vincentdarley Exp $ */ #include "tclInt.h" @@ -728,11 +728,21 @@ TclpObjLink(pathPtr, toPtr) Tcl_Obj *pathPtr; Tcl_Obj *toPtr; { - Tcl_Obj* linkPtr = NULL; - if (toPtr != NULL) { - return NULL; + CONST char *src = Tcl_FSGetNativePath(pathPtr); + CONST char *target Tcl_FSGetNativePath(toPtr); + + if (src == NULL || target == NULL) { + return NULL; + } + if (symlink(src, target) != 0) { + return NULL; + } else { + return toPtr; + } } else { + Tcl_Obj* linkPtr = NULL; + char link[MAXPATHLEN]; int length; char *native; @@ -753,10 +763,12 @@ TclpObjLink(pathPtr, toPtr) strncpy(native, link, (unsigned)length); native[length] = '\0'; - linkPtr = Tcl_FSNewNativePath(pathPtr, native); - Tcl_IncrRefCount(linkPtr); + linkPtr = Tcl_FSNewNativePath(&nativeFilesystem, native); + if (linkPtr != NULL) { + Tcl_IncrRefCount(linkPtr); + } + return linkPtr; } - return linkPtr; } #endif diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c index 098a409..35c241f 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.29 2002/04/22 22:51:19 hobbs Exp $ + * RCS: @(#) $Id: tclWinFCmd.c,v 1.30 2002/06/12 09:28:58 vincentdarley Exp $ */ #include "tclWinInt.h" @@ -90,7 +90,7 @@ typedef int (TraversalProc)(CONST TCHAR *srcPtr, CONST TCHAR *dstPtr, */ static void StatError(Tcl_Interp *interp, Tcl_Obj *fileName); -static int ConvertFileNameFormat(Tcl_Interp *interp, +int ConvertFileNameFormat(Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, int longShort, Tcl_Obj **attributePtrPtr); static int DoCopyFile(CONST TCHAR *srcPtr, CONST TCHAR *dstPtr); @@ -566,6 +566,12 @@ DoCopyFile( } if ((srcAttr & FILE_ATTRIBUTE_DIRECTORY) || (dstAttr & FILE_ATTRIBUTE_DIRECTORY)) { + if (srcAttr & FILE_ATTRIBUTE_REPARSE_POINT) { + /* Source is a symbolic link -- copy it */ + if (TclWinSymLinkCopyDirectory(nativeSrc, nativeDst) == 0) { + return TCL_OK; + } + } Tcl_SetErrno(EISDIR); } if (dstAttr & FILE_ATTRIBUTE_READONLY) { @@ -659,7 +665,16 @@ DoDeleteFile( attr = (*tclWinProcs->getFileAttributesProc)(nativePath); if (attr != 0xffffffff) { if (attr & FILE_ATTRIBUTE_DIRECTORY) { - /* + if (attr & FILE_ATTRIBUTE_REPARSE_POINT) { + /* It is a symbolic link -- remove it */ + if (TclWinSymLinkDelete(nativePath, 0) == 0) { + return TCL_OK; + } + } + + /* + * If we fall through here, it is a directory. + * * Windows NT reports removing a directory as EACCES instead * of EISDIR. */ @@ -903,6 +918,13 @@ DoRemoveJustDirectory( goto end; } + if (attr & FILE_ATTRIBUTE_REPARSE_POINT) { + /* It is a symbolic link -- remove it */ + if (TclWinSymLinkDelete(nativePath, 1) != 0) { + goto end; + } + } + if (attr & FILE_ATTRIBUTE_READONLY) { attr &= ~FILE_ATTRIBUTE_READONLY; if ((*tclWinProcs->setFileAttributesProc)(nativePath, attr) == FALSE) { @@ -1444,7 +1466,7 @@ GetWinFileAttributes( *---------------------------------------------------------------------- */ -static int +int ConvertFileNameFormat( Tcl_Interp *interp, /* The interp we are using for errors. */ int objIndex, /* The index of the attribute. */ @@ -1812,284 +1834,3 @@ TclpObjListVolumes(void) Tcl_IncrRefCount(resultPtr); 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 - - -/* - *--------------------------------------------------------------------------- - * - * TclpObjNormalizePath -- - * - * This function scans through a path specification and replaces - * it, in place, with a normalized version. On windows this - * means using the 'longname'. - * - * Results: - * The new 'nextCheckpoint' value, giving as far as we could - * understand in the path. - * - * Side effects: - * The pathPtr string, which must contain a valid path, is - * possibly modified in place. - * - *--------------------------------------------------------------------------- - */ - -int -TclpObjNormalizePath(interp, pathPtr, nextCheckpoint) - Tcl_Interp *interp; - Tcl_Obj *pathPtr; - int nextCheckpoint; -{ - char *lastValidPathEnd = NULL; - Tcl_DString ds; - int pathLen; - - char *path = Tcl_GetStringFromObj(pathPtr, &pathLen); - - if (TclWinGetPlatformId() == VER_PLATFORM_WIN32_WINDOWS) { - Tcl_DString eDs; - char *nativePath; - int nativeLen; - - Tcl_UtfToExternalDString(NULL, path, -1, &ds); - nativePath = Tcl_DStringValue(&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; - } - /* 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'; - } - /* - * 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'. - */ - - /* Copy over the valid part of the path and find its length */ - Tcl_ExternalToUtfDString(NULL, nativePath, -1, &eDs); - path = Tcl_DStringValue(&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)) { - CONST char *tmp; - *lastValidPathEnd = '/'; - /* Now copy over the invalid (i.e. non-existent) part of the path */ - tmp = Tcl_ExternalToUtfDString(NULL, lastValidPathEnd, -1, &eDs); - Tcl_AppendToObj(pathPtr, tmp, Tcl_DStringLength(&eDs)); - Tcl_DStringFree(&eDs); - } - Tcl_DStringFree(&ds); - } else { - /* We're on WinNT or 2000 or XP */ - CONST char *nativePath; -#if 0 - /* - * We don't use this simpler version, because the speed - * increase does not seem significant at present and the version - * below is thoroughly debugged. - */ - 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; - } - /* - * 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); - } -#endif - } - return nextCheckpoint; -} diff --git a/win/tclWinFile.c b/win/tclWinFile.c index 58bf2d0..a7c375a 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -11,14 +11,93 @@ * 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.28 2002/05/02 20:15:20 vincentdarley Exp $ + * RCS: @(#) $Id: tclWinFile.c,v 1.29 2002/06/12 09:28:59 vincentdarley Exp $ */ +#define _WIN32_WINNT 0x0500 + #include "tclWinInt.h" +#include #include #include #include /* For TclpGetUserHome(). */ +extern int ConvertFileNameFormat(Tcl_Interp *interp, + int objIndex, Tcl_Obj *fileName, int longShort, + Tcl_Obj **attributePtrPtr); + +/* + * Declarations for 'link' related information (which may or may + * not be in the windows headers, and some of which is not very + * well documented). + */ +#ifndef IO_REPARSE_TAG_RESERVED_ONE +#define IO_REPARSE_TAG_RESERVED_ONE 0x000000001 +#endif +#ifndef IO_REPARSE_TAG_RESERVED_RANGE +#define IO_REPARSE_TAG_RESERVED_RANGE 0x000000001 +#endif +#ifndef IO_REPARSE_TAG_VALID_VALUES +#define IO_REPARSE_TAG_VALID_VALUES 0x0E000FFFF +#endif +#ifndef IO_REPARSE_TAG_HSM +#define IO_REPARSE_TAG_HSM 0x0C0000004 +#endif +#ifndef IO_REPARSE_TAG_NSS +#define IO_REPARSE_TAG_NSS 0x080000005 +#endif +#ifndef IO_REPARSE_TAG_NSSRECOVER +#define IO_REPARSE_TAG_NSSRECOVER 0x080000006 +#endif +#ifndef IO_REPARSE_TAG_SIS +#define IO_REPARSE_TAG_SIS 0x080000007 +#endif +#ifndef IO_REPARSE_TAG_DFS +#define IO_REPARSE_TAG_DFS 0x080000008 +#endif + +#ifndef IO_REPARSE_TAG_RESERVED_ZERO +#define IO_REPARSE_TAG_RESERVED_ZERO 0x00000000 +#endif +#ifndef FILE_FLAG_OPEN_REPARSE_POINT +#define FILE_FLAG_OPEN_REPARSE_POINT 0x00200000 +#endif +#ifndef IO_REPARSE_TAG_MOUNT_POINT +#define IO_REPARSE_TAG_MOUNT_POINT 0xA0000003 +#endif +#ifndef IsReparseTagValid +#define IsReparseTagValid(x) (!((x)&~IO_REPARSE_TAG_VALID_VALUES)&&((x)>IO_REPARSE_TAG_RESERVED_RANGE)) +#endif +#ifndef IO_REPARSE_TAG_SYMBOLIC_LINK +#define IO_REPARSE_TAG_SYMBOLIC_LINK IO_REPARSE_TAG_RESERVED_ZERO +#endif +#define FILE_SPECIAL_ACCESS (FILE_ANY_ACCESS) +#define FSCTL_SET_REPARSE_POINT CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 41, METHOD_BUFFERED, FILE_SPECIAL_ACCESS) +#define FSCTL_GET_REPARSE_POINT CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 42, METHOD_BUFFERED, FILE_ANY_ACCESS) +#define FSCTL_DELETE_REPARSE_POINT CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 43, METHOD_BUFFERED, FILE_SPECIAL_ACCESS) + +/* + * Maximum reparse buffer info size. The max user defined reparse + * data is 16KB, plus there's a header. + */ + +#define MAX_REPARSE_SIZE 17000 + +/* Undocumented FSCTL_SET_REPARSE_POINT structure definition */ + +#define REPARSE_MOUNTPOINT_HEADER_SIZE 8 +typedef struct { + DWORD ReparseTag; + DWORD ReparseDataLength; + WORD Dummy; + WORD ReparseTargetLength; + WORD ReparseTargetMaximumLength; + WORD Dummy1; + WCHAR ReparseTarget[MAX_PATH*3]; +} REPARSE_DATA_BUFFER; + +/* Other typedefs required by this code */ + static time_t ToCTime(FILETIME fileTime); typedef NET_API_STATUS NET_API_FUNCTION NETUSERGETINFOPROC @@ -30,13 +109,281 @@ typedef NET_API_STATUS NET_API_FUNCTION NETAPIBUFFERFREEPROC typedef NET_API_STATUS NET_API_FUNCTION NETGETDCNAMEPROC (LPWSTR servername, LPWSTR domainname, LPBYTE *bufptr); +/* + * Declarations for local procedures defined in this file: + */ + static int NativeAccess(CONST TCHAR *path, int mode); -static int NativeStat(CONST TCHAR *path, Tcl_StatBuf *statPtr); +static int NativeStat(CONST TCHAR *path, Tcl_StatBuf *statPtr, int checkLinks); static int NativeIsExec(CONST TCHAR *path); -static int WinIsDrive(CONST char *name, int nameLen); +static int NativeReadReparse(CONST TCHAR* LinkDirectory, + REPARSE_DATA_BUFFER* buffer); +static int NativeWriteReparse(CONST TCHAR* LinkDirectory, + REPARSE_DATA_BUFFER* buffer); static int NativeMatchType(CONST char *name, int nameLen, CONST TCHAR* nativeName, Tcl_GlobTypeData *types); +static int WinIsDrive(CONST char *name, int nameLen); +static Tcl_Obj* WinReadLink(CONST TCHAR* LinkSource); +static Tcl_Obj* WinReadLinkDirectory(CONST TCHAR* LinkDirectory); +extern Tcl_Filesystem nativeFilesystem; + + +/* + *-------------------------------------------------------------------- + * + * WinReadLink + * + * What does 'LinkSource' point to? We need the original 'pathPtr' + * just so we can construct a path object in the correct filesystem. + *-------------------------------------------------------------------- + */ +static Tcl_Obj* +WinReadLink(LinkSource) + CONST TCHAR* LinkSource; +{ + WCHAR tempFileName[MAX_PATH]; + TCHAR* tempFilePart; + int attr; + + /* Get the full path referenced by the target */ + if (!(*tclWinProcs->getFullPathNameProc)(LinkSource, + MAX_PATH, tempFileName, &tempFilePart)) { + /* Invalid file */ + TclWinConvertError(GetLastError()); + return NULL; + } + /* Make sure source file does exist */ + attr = (*tclWinProcs->getFileAttributesProc)(LinkSource); + if (attr == 0xffffffff) { + /* The source doesn't exist */ + TclWinConvertError(GetLastError()); + return NULL; + } else if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) { + /* It is a file - this is not yet supported */ + Tcl_SetErrno(ENOTDIR); + return NULL; + } else { + return WinReadLinkDirectory(LinkSource); + } +} + +/* + *-------------------------------------------------------------------- + * + * TclWinSymLinkCopyDirectory + * + * Copy a Windows NTFS junction. This function assumes that + * LinkOriginal exists and is a valid junction point, and that + * LinkCopy does not exist. + * + * Returns zero on success. + *-------------------------------------------------------------------- + */ +int +TclWinSymLinkCopyDirectory(LinkOriginal, LinkCopy) + CONST TCHAR* LinkOriginal; /* Existing junction - reparse point */ + CONST TCHAR* LinkCopy; /* Will become a duplicate junction */ +{ + + REPARSE_DATA_BUFFER reparseBuffer; + if (NativeReadReparse(LinkOriginal, &reparseBuffer)) { + return -1; + } + return NativeWriteReparse(LinkCopy, &reparseBuffer); +} + +/* + *-------------------------------------------------------------------- + * + * TclWinSymLinkDelete + * + * Delete a Windows NTFS junction. Once the junction information + * is deleted, the filesystem object becomes an ordinary directory. + * Unless 'linkOnly' is given, that directory is also removed. + * + * Assumption that LinkOriginal is a valid, existing junction. + * + * Returns zero on success. + *-------------------------------------------------------------------- + */ +int +TclWinSymLinkDelete(LinkOriginal, linkOnly) + CONST TCHAR* LinkOriginal; + int linkOnly; +{ + /* It is a symbolic link -- remove it */ + HANDLE hFile; + REPARSE_DATA_BUFFER buffer; + int returnedLength; + memset(&buffer, 0, sizeof( buffer )); + buffer.ReparseTag = IO_REPARSE_TAG_MOUNT_POINT; + hFile = (*tclWinProcs->createFileProc)(LinkOriginal, GENERIC_WRITE, 0, + NULL, OPEN_EXISTING, + FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, NULL); + if (hFile != INVALID_HANDLE_VALUE) { + if (!DeviceIoControl(hFile, FSCTL_DELETE_REPARSE_POINT, &buffer, + REPARSE_MOUNTPOINT_HEADER_SIZE, + NULL, 0, &returnedLength, NULL)) { + /* Error setting junction */ + TclWinConvertError(GetLastError()); + CloseHandle(hFile); + } else { + CloseHandle(hFile); + if (!linkOnly) { + (*tclWinProcs->removeDirectoryProc)(LinkOriginal); + } + return 0; + } + } + return -1; +} + +/* + *-------------------------------------------------------------------- + * + * WinReadLinkDirectory + * + * This routine reads a NTFS junction, using the undocumented + * FSCTL_GET_REPARSE_POINT structure Win2K uses for mount points + * and junctions. + * + * Assumption that LinkDirectory is a valid, existing directory. + * + * Returns a Tcl_Obj with refCount of 1 (i.e. owned by the caller). + *-------------------------------------------------------------------- + */ +static Tcl_Obj* +WinReadLinkDirectory(LinkDirectory) + CONST TCHAR* LinkDirectory; +{ + int attr; + REPARSE_DATA_BUFFER reparseBuffer; + + attr = (*tclWinProcs->getFileAttributesProc)(LinkDirectory); + if (!(attr & FILE_ATTRIBUTE_REPARSE_POINT)) { + Tcl_SetErrno(EINVAL); + return NULL; + } + if (NativeReadReparse(LinkDirectory, &reparseBuffer)) { + return NULL; + } + + switch (reparseBuffer.ReparseTag) { + 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; + + len = reparseBuffer.ReparseTargetLength + sizeof(WCHAR); + clientData = (ClientData)ckalloc(len); + memcpy((VOID*)clientData, (VOID*)reparseBuffer.ReparseTarget, + len); + + retVal = Tcl_FSNewNativePath(&nativeFilesystem, clientData); + Tcl_IncrRefCount(retVal); + return retVal; + } + } + Tcl_SetErrno(EINVAL); + return NULL; +} + +/* + *-------------------------------------------------------------------- + * + * NativeReadReparse + * + * Read the junction/reparse information from a given NTFS directory. + * + * Assumption that LinkDirectory is a valid, existing directory. + * + * Returns zero on success. + *-------------------------------------------------------------------- + */ +static int +NativeReadReparse(LinkDirectory, buffer) + CONST TCHAR* LinkDirectory; /* The junction to read */ + REPARSE_DATA_BUFFER* buffer; /* Pointer to buffer. Cannot be NULL */ +{ + HANDLE hFile; + int returnedLength; + + hFile = (*tclWinProcs->createFileProc)(LinkDirectory, GENERIC_READ, 0, + NULL, OPEN_EXISTING, + FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, NULL); + if (hFile == INVALID_HANDLE_VALUE) { + /* Error creating directory */ + TclWinConvertError(GetLastError()); + return -1; + } + /* Get the link */ + if (!DeviceIoControl(hFile, FSCTL_GET_REPARSE_POINT, NULL, + 0, buffer, + sizeof(REPARSE_DATA_BUFFER), &returnedLength, NULL)) { + /* Error setting junction */ + TclWinConvertError(GetLastError()); + CloseHandle(hFile); + return -1; + } + CloseHandle(hFile); + + if (!IsReparseTagValid(buffer->ReparseTag)) { + Tcl_SetErrno(EINVAL); + return -1; + } + return 0; +} + +/* + *-------------------------------------------------------------------- + * + * NativeWriteReparse + * + * Write the reparse information for a given directory. + * + * Assumption that LinkDirectory does not exist. + *-------------------------------------------------------------------- + */ +static int +NativeWriteReparse(LinkDirectory, buffer) + CONST TCHAR* LinkDirectory; + REPARSE_DATA_BUFFER* buffer; +{ + HANDLE hFile; + int returnedLength; + + /* Create the directory - it must not already exist */ + if ((*tclWinProcs->createDirectoryProc)(LinkDirectory, NULL) == 0) { + /* Error creating directory */ + TclWinConvertError(GetLastError()); + return -1; + } + hFile = (*tclWinProcs->createFileProc)(LinkDirectory, GENERIC_WRITE, 0, + NULL, OPEN_EXISTING, + FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, NULL); + if (hFile == INVALID_HANDLE_VALUE) { + /* Error creating directory */ + TclWinConvertError(GetLastError()); + return -1; + } + /* Set the link */ + if (!DeviceIoControl(hFile, FSCTL_SET_REPARSE_POINT, buffer, + buffer->ReparseDataLength + + REPARSE_MOUNTPOINT_HEADER_SIZE, + NULL, 0, &returnedLength, NULL)) { + /* Error setting junction */ + TclWinConvertError(GetLastError()); + CloseHandle(hFile); + (*tclWinProcs->removeDirectoryProc)(LinkDirectory); + return -1; + } + CloseHandle(hFile); + /* We succeeded */ + return 0; +} /* *--------------------------------------------------------------------------- @@ -492,7 +839,7 @@ NativeMatchType( if (types->type != 0) { Tcl_StatBuf buf; - if (NativeStat(nativeName, &buf) != 0) { + if (NativeStat(nativeName, &buf, 0) != 0) { /* * Posix error occurred, either the file * has disappeared, or there is some other @@ -524,11 +871,7 @@ NativeMatchType( } else { #ifdef S_ISLNK if (types->type & TCL_GLOB_TYPE_LINK) { - /* - * We should use 'lstat' but it is the - * same as 'stat' on windows. - */ - if (NativeStat(nativeName, &buf) == 0) { + if (NativeStat(nativeName, &buf, 1) == 0) { if (S_ISLNK(buf.st_mode)) { return 1; } @@ -949,7 +1292,7 @@ TclpObjStat(pathPtr, statPtr) TclWinFlushDirtyChannels (); - return NativeStat((CONST TCHAR*) Tcl_FSGetNativePath(pathPtr), statPtr); + return NativeStat((CONST TCHAR*) Tcl_FSGetNativePath(pathPtr), statPtr, 0); } /* @@ -976,9 +1319,10 @@ TclpObjStat(pathPtr, statPtr) */ static int -NativeStat(nativePath, statPtr) +NativeStat(nativePath, statPtr, checkLinks) CONST TCHAR *nativePath; /* Path of file to stat */ Tcl_StatBuf *statPtr; /* Filled with results of stat call. */ + int checkLinks; /* If non-zero, behave like 'lstat' */ { Tcl_DString ds; DWORD attr; @@ -1134,12 +1478,17 @@ NativeStat(nativePath, statPtr) statPtr->st_ctime = ToCTime(data.ftCreationTime); } - mode = (attr & FILE_ATTRIBUTE_DIRECTORY) ? S_IFDIR | S_IEXEC : S_IFREG; + if (checkLinks && (attr & FILE_ATTRIBUTE_REPARSE_POINT)) { + /* It is a link */ + mode = S_IFLNK; + } else { + 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)) { mode |= S_IEXEC; } - + /* * Propagate the S_IREAD, S_IWRITE, S_IEXEC bits to the group and * other positions. @@ -1312,11 +1661,19 @@ TclpObjAccess(pathPtr, mode) } int -TclpObjLstat(pathPtr, buf) +TclpObjLstat(pathPtr, statPtr) Tcl_Obj *pathPtr; - Tcl_StatBuf *buf; + Tcl_StatBuf *statPtr; { - return TclpObjStat(pathPtr,buf); + /* + * Ensure correct file sizes by forcing the OS to write any + * pending data to disk. This is done only for channels which are + * dirty, i.e. have been written to since the last flush here. + */ + + TclWinFlushDirtyChannels (); + + return NativeStat((CONST TCHAR*) Tcl_FSGetNativePath(pathPtr), statPtr, 1); } #ifdef S_IFLNK @@ -1326,20 +1683,15 @@ TclpObjLink(pathPtr, toPtr) Tcl_Obj *pathPtr; Tcl_Obj *toPtr; { - Tcl_Obj* link = NULL; - if (toPtr != NULL) { return NULL; } else { - Tcl_DString ds; - if (TclpReadlink(Tcl_FSGetTranslatedStringPath(NULL, pathPtr), &ds) - != NULL) { - link = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); - Tcl_IncrRefCount(link); - Tcl_DStringFree(&ds); + TCHAR* LinkSource = (TCHAR*)Tcl_FSGetNativePath(pathPtr); + if (LinkSource == NULL) { + return NULL; } + return WinReadLink(LinkSource); } - return link; } #endif @@ -1404,3 +1756,322 @@ TclpFilesystemPathType(pathObjPtr) } #undef VOL_BUF_SIZE } + + +/* + * 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 + + +/* + *--------------------------------------------------------------------------- + * + * TclpObjNormalizePath -- + * + * This function scans through a path specification and replaces + * it, in place, with a normalized version. On windows this + * means using the 'longname'. + * + * Results: + * The new 'nextCheckpoint' value, giving as far as we could + * understand in the path. + * + * Side effects: + * The pathPtr string, which must contain a valid path, is + * possibly modified in place. + * + *--------------------------------------------------------------------------- + */ + +int +TclpObjNormalizePath(interp, pathPtr, nextCheckpoint) + Tcl_Interp *interp; + Tcl_Obj *pathPtr; + int nextCheckpoint; +{ + char *lastValidPathEnd = NULL; + Tcl_DString ds; + int pathLen; + + char *path = Tcl_GetStringFromObj(pathPtr, &pathLen); + + if (TclWinGetPlatformId() == VER_PLATFORM_WIN32_WINDOWS) { + Tcl_DString eDs; + char *nativePath; + int nativeLen; + + Tcl_UtfToExternalDString(NULL, path, -1, &ds); + nativePath = Tcl_DStringValue(&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; + } + /* 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'; + } + /* + * 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'. + */ + + /* Copy over the valid part of the path and find its length */ + Tcl_ExternalToUtfDString(NULL, nativePath, -1, &eDs); + path = Tcl_DStringValue(&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)) { + CONST char *tmp; + *lastValidPathEnd = '/'; + /* Now copy over the invalid (i.e. non-existent) part of the path */ + tmp = Tcl_ExternalToUtfDString(NULL, lastValidPathEnd, -1, &eDs); + Tcl_AppendToObj(pathPtr, tmp, Tcl_DStringLength(&eDs)); + Tcl_DStringFree(&eDs); + } + Tcl_DStringFree(&ds); + } else { + /* We're on WinNT or 2000 or XP */ + CONST char *nativePath; +#if 0 + /* + * We don't use this simpler version, because the speed + * increase does not seem significant at present and the version + * below is thoroughly debugged. + */ + 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; + Tcl_Obj *temp = NULL; + WIN32_FILE_ATTRIBUTE_DATA data; + nativePath = Tcl_WinUtfToTChar(path, -1, &ds); + + /* + * We currently don't use this because we have to check + * each path component for reparse points. + */ + if (0 && (*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; + } + + /* File does exist if we get here */ + + /* + * Check for symlinks, except at last component + * of path (we don't follow final symlinks) + */ + if (cur != 0 && (data.dwFileAttributes + & FILE_ATTRIBUTE_REPARSE_POINT)) { + Tcl_Obj *to = WinReadLinkDirectory(nativePath); + if (to != NULL) { + /* Read the reparse point ok */ + Tcl_GetStringFromObj(to, &pathLen); + nextCheckpoint = pathLen; + Tcl_AppendToObj(to, currentPathEndPosition, -1); + path = Tcl_GetString(to); + currentPathEndPosition = path + nextCheckpoint; + if (temp != NULL) { + Tcl_DecrRefCount(temp); + } + temp = to; + } + } + + Tcl_DStringFree(&ds); + lastValidPathEnd = currentPathEndPosition; + if (0) { + WIN32_FIND_DATAT fdata; + CONST TCHAR *nativeName; + (*tclWinProcs->findFirstFileProc)(nativePath, &fdata); + nativeName = (TCHAR *) fdata.w.cAlternateFileName; + if (fdata.w.cFileName[0] != '\0') { + nativeName = (TCHAR *) fdata.w.cFileName; + } + } + 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; + } + /* + * 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); + } +#endif + } + return nextCheckpoint; +} diff --git a/win/tclWinInt.h b/win/tclWinInt.h index f0e8e42..1508e56 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.14 2002/04/23 17:03:35 hobbs Exp $ + * RCS: @(#) $Id: tclWinInt.h,v 1.15 2002/06/12 09:28:59 vincentdarley Exp $ */ #ifndef _TCLWININT @@ -91,7 +91,6 @@ typedef struct TclWinProcs { BOOL (WINAPI *setFileAttributesProc)(CONST TCHAR *, DWORD); BOOL (WINAPI *getFileAttributesExProc)(CONST TCHAR *, GET_FILEEX_INFO_LEVELS, LPVOID); - } TclWinProcs; EXTERN TclWinProcs *tclWinProcs; @@ -102,6 +101,10 @@ EXTERN TclWinProcs *tclWinProcs; */ EXTERN void TclWinInit(HINSTANCE hInst); +EXTERN int TclWinSymLinkCopyDirectory(CONST TCHAR* LinkOriginal, + CONST TCHAR* LinkCopy); +EXTERN int TclWinSymLinkDelete(CONST TCHAR* LinkOriginal, + int linkOnly); #if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC) EXTERN void TclWinFreeAllocCache(void); EXTERN void TclFreeAllocCache(void *); @@ -110,6 +113,11 @@ EXTERN void *TclpGetAllocCache(void); EXTERN void TclpSetAllocCache(void *); #endif /* TCL_THREADS */ +/* Needed by tclWinFile.c and tclWinFCmd.c */ +#ifndef FILE_ATTRIBUTE_REPARSE_POINT +#define FILE_ATTRIBUTE_REPARSE_POINT 0x00000400 +#endif + #include "tclIntPlatDecls.h" # undef TCL_STORAGE_CLASS diff --git a/win/tclWinPort.h b/win/tclWinPort.h index 72f993f..951d2e7 100644 --- a/win/tclWinPort.h +++ b/win/tclWinPort.h @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWinPort.h,v 1.30 2002/05/28 09:12:25 dkf Exp $ + * RCS: @(#) $Id: tclWinPort.h,v 1.31 2002/06/12 09:28:59 vincentdarley Exp $ */ #ifndef _TCLWINPORT @@ -283,6 +283,10 @@ * defined. */ +#ifndef S_IFLNK +#define S_IFLNK 0120000 /* Symbolic Link */ +#endif + #ifndef S_ISREG # ifdef S_IFREG # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG) @@ -318,6 +322,14 @@ # define S_ISFIFO(m) 0 # endif #endif /* !S_ISFIFO */ +#ifndef S_ISLNK +# ifdef S_IFLNK +# define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK) +# else +# define S_ISLNK(m) 0 +# endif +#endif /* !S_ISLNK */ + /* * Define MAXPATHLEN in terms of MAXPATH if available -- cgit v0.12