summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog22
-rw-r--r--doc/FileSystem.312
-rw-r--r--generic/tcl.decls4
-rw-r--r--generic/tclDecls.h6
-rw-r--r--generic/tclIOUtil.c73
-rw-r--r--unix/tclUnixFile.c26
-rw-r--r--win/tclWinFCmd.c311
-rw-r--r--win/tclWinFile.c721
-rw-r--r--win/tclWinInt.h12
-rw-r--r--win/tclWinPort.h14
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 <vincentdarley@users.sourceforge.net>
+
+ * 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 <msofer@users.sourceforge.net>
* 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 <winioctl.h>
#include <sys/stat.h>
#include <shlobj.h>
#include <lmaccess.h> /* 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
generated by cgit v0.12 at 2024-07-18 17:14:45 (GMT)