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