* RCS: @(#) $Id$
*/
+//#define _WIN32_WINNT 0x0500
+
#include "tclWinInt.h"
+#include <winioctl.h>
#include <sys/stat.h>
-
#include <shlobj.h>
#include <lmaccess.h> /* For TclpGetUserHome(). */
+/*
+ * Declarations for 'link' related information. This information
+ * should come with VC++ 6.0, but is not in some older SDKs.
+ * In any case it is not 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
+#ifndef FILE_SPECIAL_ACCESS
+# define FILE_SPECIAL_ACCESS (FILE_ANY_ACCESS)
+#endif
+#ifndef FSCTL_SET_REPARSE_POINT
+# 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)
+#endif
+
+/*
+ * Maximum reparse buffer info size. The max user defined reparse
+ * data is 16KB, plus there's a header.
+ */
+
+#define MAX_REPARSE_SIZE 17000
+
+/*
+ * Undocumented REPARSE_MOUNTPOINT_HEADER_SIZE structure definition.
+ * This is found in winnt.h.
+ *
+ * IMPORTANT: caution when using this structure, since the actual
+ * structures used will want to store a full path in the 'PathBuffer'
+ * field, but there isn't room (there's only a single WCHAR!). Therefore
+ * one must artificially create a larger space of memory and then cast it
+ * to this type. We use the 'DUMMY_REPARSE_BUFFER' struct just below to
+ * deal with this problem.
+ */
+
+#define REPARSE_MOUNTPOINT_HEADER_SIZE 8
+#ifndef REPARSE_DATA_BUFFER_HEADER_SIZE
+typedef struct _REPARSE_DATA_BUFFER {
+ DWORD ReparseTag;
+ WORD ReparseDataLength;
+ WORD Reserved;
+ union {
+ struct {
+ WORD SubstituteNameOffset;
+ WORD SubstituteNameLength;
+ WORD PrintNameOffset;
+ WORD PrintNameLength;
+ WCHAR PathBuffer[1];
+ } SymbolicLinkReparseBuffer;
+ struct {
+ WORD SubstituteNameOffset;
+ WORD SubstituteNameLength;
+ WORD PrintNameOffset;
+ WORD PrintNameLength;
+ WCHAR PathBuffer[1];
+ } MountPointReparseBuffer;
+ struct {
+ BYTE DataBuffer[1];
+ } GenericReparseBuffer;
+ };
+} REPARSE_DATA_BUFFER;
+#endif
+
+typedef struct {
+ REPARSE_DATA_BUFFER dummy;
+ WCHAR dummyBuf[MAX_PATH*3];
+} DUMMY_REPARSE_BUFFER;
+
+/* Other typedefs required by this code */
+
static time_t ToCTime(FILETIME fileTime);
typedef NET_API_STATUS NET_API_FUNCTION NETUSERGETINFOPROC
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, int checkLinks);
+static int NativeIsExec(CONST TCHAR *path);
+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);
+static int WinLink(CONST TCHAR* LinkSource, CONST TCHAR* LinkTarget,
+ int linkAction);
+static int WinSymLinkDirectory(CONST TCHAR* LinkDirectory,
+ CONST TCHAR* LinkTarget);
+
+\f
+/*
+ *--------------------------------------------------------------------
+ *
+ * WinLink
+ *
+ * Make a link from source to target.
+ *--------------------------------------------------------------------
+ */
+static int
+WinLink(LinkSource, LinkTarget, linkAction)
+ CONST TCHAR* LinkSource;
+ CONST TCHAR* LinkTarget;
+ int linkAction;
+{
+ WCHAR tempFileName[MAX_PATH];
+ TCHAR* tempFilePart;
+ int attr;
+
+ /* Get the full path referenced by the target */
+ if (!(*tclWinProcs->getFullPathNameProc)(LinkTarget,
+ MAX_PATH, tempFileName, &tempFilePart)) {
+ /* Invalid file */
+ TclWinConvertError(GetLastError());
+ return -1;
+ }
+
+ /* Make sure source file doesn't exist */
+ attr = (*tclWinProcs->getFileAttributesProc)(LinkSource);
+ if (attr != 0xffffffff) {
+ Tcl_SetErrno(EEXIST);
+ return -1;
+ }
+
+ /* Get the full path referenced by the directory */
+ if (!(*tclWinProcs->getFullPathNameProc)(LinkSource,
+ MAX_PATH, tempFileName, &tempFilePart)) {
+ /* Invalid file */
+ TclWinConvertError(GetLastError());
+ return -1;
+ }
+ /* Check the target */
+ attr = (*tclWinProcs->getFileAttributesProc)(LinkTarget);
+ if (attr == 0xffffffff) {
+ /* The target doesn't exist */
+ TclWinConvertError(GetLastError());
+ return -1;
+ } else if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
+ /* It is a file */
+ if (tclWinProcs->createHardLinkProc == NULL) {
+ Tcl_SetErrno(ENOTDIR);
+ return -1;
+ }
+ if (linkAction & TCL_CREATE_HARD_LINK) {
+ if (!(*tclWinProcs->createHardLinkProc)(LinkSource, LinkTarget, NULL)) {
+ TclWinConvertError(GetLastError());
+ return -1;
+ }
+ return 0;
+ } else if (linkAction & TCL_CREATE_SYMBOLIC_LINK) {
+ /* Can't symlink files */
+ Tcl_SetErrno(ENOTDIR);
+ return -1;
+ } else {
+ Tcl_SetErrno(ENODEV);
+ return -1;
+ }
+ } else {
+ if (linkAction & TCL_CREATE_SYMBOLIC_LINK) {
+ return WinSymLinkDirectory(LinkSource, LinkTarget);
+ } else if (linkAction & TCL_CREATE_HARD_LINK) {
+ /* Can't hard link directories */
+ Tcl_SetErrno(EISDIR);
+ return -1;
+ } else {
+ Tcl_SetErrno(ENODEV);
+ return -1;
+ }
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------------
+ *
+ * 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);
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------------
+ *
+ * WinSymLinkDirectory
+ *
+ * This routine creates a NTFS junction, using the undocumented
+ * FSCTL_SET_REPARSE_POINT structure Win2K uses for mount points
+ * and junctions.
+ *
+ * Assumption that LinkTarget is a valid, existing directory.
+ *
+ * Returns zero on success.
+ *--------------------------------------------------------------------
+ */
+static int
+WinSymLinkDirectory(LinkDirectory, LinkTarget)
+ CONST TCHAR* LinkDirectory;
+ CONST TCHAR* LinkTarget;
+{
+ DUMMY_REPARSE_BUFFER dummy;
+ REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER*)&dummy;
+ int len;
+ WCHAR nativeTarget[MAX_PATH];
+ WCHAR *loop;
+
+ /* Make the native target name */
+ memcpy((VOID*)nativeTarget, (VOID*)L"\\??\\", 4*sizeof(WCHAR));
+ memcpy((VOID*)(nativeTarget + 4), (VOID*)LinkTarget,
+ sizeof(WCHAR)*(1+wcslen((WCHAR*)LinkTarget)));
+ len = wcslen(nativeTarget);
+ /*
+ * We must have backslashes only. This is VERY IMPORTANT.
+ * If we have any forward slashes everything appears to work,
+ * but the resulting symlink is useless!
+ */
+ for (loop = nativeTarget; *loop != 0; loop++) {
+ if (*loop == L'/') *loop = L'\\';
+ }
+ if ((nativeTarget[len-1] == L'\\') && (nativeTarget[len-2] != L':')) {
+ nativeTarget[len-1] = 0;
+ }
+
+ /* Build the reparse info */
+ memset(reparseBuffer, 0, sizeof(DUMMY_REPARSE_BUFFER));
+ reparseBuffer->ReparseTag = IO_REPARSE_TAG_MOUNT_POINT;
+ reparseBuffer->SymbolicLinkReparseBuffer.SubstituteNameLength =
+ wcslen(nativeTarget) * sizeof(WCHAR);
+ reparseBuffer->Reserved = 0;
+ reparseBuffer->SymbolicLinkReparseBuffer.PrintNameLength = 0;
+ reparseBuffer->SymbolicLinkReparseBuffer.PrintNameOffset =
+ reparseBuffer->SymbolicLinkReparseBuffer.SubstituteNameLength
+ + sizeof(WCHAR);
+ memcpy(reparseBuffer->SymbolicLinkReparseBuffer.PathBuffer, nativeTarget,
+ sizeof(WCHAR)
+ + reparseBuffer->SymbolicLinkReparseBuffer.SubstituteNameLength);
+ reparseBuffer->ReparseDataLength =
+ reparseBuffer->SymbolicLinkReparseBuffer.SubstituteNameLength + 12;
+
+ return NativeWriteReparse(LinkDirectory, reparseBuffer);
+}
+\f
+/*
+ *--------------------------------------------------------------------
+ *
+ * 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 */
+{
+ DUMMY_REPARSE_BUFFER dummy;
+ REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER*)&dummy;
+
+ if (NativeReadReparse(LinkOriginal, reparseBuffer)) {
+ return -1;
+ }
+ return NativeWriteReparse(LinkCopy, reparseBuffer);
+}
+\f
+/*
+ *--------------------------------------------------------------------
+ *
+ * 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 */
+ DUMMY_REPARSE_BUFFER dummy;
+ REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER*)&dummy;
+ HANDLE hFile;
+ int returnedLength;
+ memset(reparseBuffer, 0, sizeof(DUMMY_REPARSE_BUFFER));
+ reparseBuffer->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, reparseBuffer,
+ 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;
+}
+\f
+/*
+ *--------------------------------------------------------------------
+ *
+ * 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;
+ DUMMY_REPARSE_BUFFER dummy;
+ REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER*)&dummy;
+
+ 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: {
+ Tcl_Obj *retVal;
+ Tcl_DString ds;
+ CONST char *copy;
+ int len;
+
+ Tcl_WinTCharToUtf(
+ (CONST char*)reparseBuffer->SymbolicLinkReparseBuffer.PathBuffer,
+ (int)reparseBuffer->SymbolicLinkReparseBuffer.SubstituteNameLength,
+ &ds);
+
+ copy = Tcl_DStringValue(&ds);
+ len = Tcl_DStringLength(&ds);
+ /*
+ * Certain native path representations on Windows have this special
+ * prefix to indicate that they are to be treated specially. For
+ * example extremely long paths, or symlinks
+ */
+ if (*copy == '\\') {
+ if (0 == strncmp(copy,"\\??\\",4)) {
+ copy += 4;
+ len -= 4;
+ } else if (0 == strncmp(copy,"\\\\?\\",4)) {
+ copy += 4;
+ len -= 4;
+ }
+ }
+ retVal = Tcl_NewStringObj(copy,len);
+ Tcl_IncrRefCount(retVal);
+ Tcl_DStringFree(&ds);
+ return retVal;
+ }
+ }
+ Tcl_SetErrno(EINVAL);
+ return NULL;
+}
+\f
+/*
+ *--------------------------------------------------------------------
+ *
+ * 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(DUMMY_REPARSE_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;
+}
+\f
+/*
+ *--------------------------------------------------------------------
+ *
+ * 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;
+}
\f
/*
*---------------------------------------------------------------------------
*/
(*tclWinProcs->getModuleFileNameProc)(NULL, wName, MAX_PATH);
- Tcl_WinTCharToUtf((TCHAR *) wName, -1, &ds);
+ Tcl_WinTCharToUtf((CONST TCHAR *) wName, -1, &ds);
tclNativeExecutableName = ckalloc((unsigned) (Tcl_DStringLength(&ds) + 1));
strcpy(tclNativeExecutableName, Tcl_DStringValue(&ds));
/*
*----------------------------------------------------------------------
*
- * TclpMatchFilesTypes --
+ * TclpMatchInDirectory --
*
* This routine is used by the globbing code to search a
* directory for all files which match a given pattern.
*
* Results:
- * If the tail argument is NULL, then the matching files are
- * added to the the interp's result. Otherwise, TclDoGlob is called
- * recursively for each matching subdirectory. The return value
- * is a standard Tcl result indicating whether an error occurred
- * in globbing.
+ *
+ * The return value is a standard Tcl result indicating whether an
+ * error occurred in globbing. Errors are left in interp, good
+ * results are lappended to resultPtr (which must be a valid object)
*
* Side effects:
* None.
*---------------------------------------------------------------------- */
int
-TclpMatchFilesTypes(
- Tcl_Interp *interp, /* Interpreter to receive results. */
- char *separators, /* Directory separators to pass to TclDoGlob. */
- Tcl_DString *dirPtr, /* Contains path to directory to search. */
- char *pattern, /* Pattern to match against. */
- char *tail, /* Pointer to end of pattern. Tail must
- * point to a location in pattern and must
- * not be static.*/
- GlobTypeData *types) /* Object containing list of acceptable types.
- * May be NULL. */
+TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
+ Tcl_Interp *interp; /* Interpreter to receive errors. */
+ Tcl_Obj *resultPtr; /* List object to lappend results. */
+ Tcl_Obj *pathPtr; /* Contains path to directory to search. */
+ CONST char *pattern; /* Pattern to match against. */
+ Tcl_GlobTypeData *types; /* Object containing list of acceptable types.
+ * May be NULL. In particular the directory
+ * flag is very important. */
{
- char drivePat[] = "?:\\";
- const char *message;
- char *dir, *newPattern, *root;
- int matchDotFiles;
- int dirLength, result = TCL_OK;
- Tcl_DString dirString, patternString;
- DWORD attr, volFlags;
- HANDLE handle;
- WIN32_FIND_DATAT data;
- BOOL found;
- Tcl_DString ds;
- TCHAR *nativeName;
- Tcl_Obj *resultPtr;
+ CONST TCHAR *nativeName;
+
+ if (pattern == NULL || (*pattern == '\0')) {
+ Tcl_Obj *norm = Tcl_FSGetNormalizedPath(NULL, pathPtr);
+ if (norm != NULL) {
+ int len;
+ char *str = Tcl_GetStringFromObj(norm,&len);
+ /* Match a file directly */
+ nativeName = (CONST TCHAR*) Tcl_FSGetNativePath(pathPtr);
+ if (NativeMatchType(str, len, nativeName, types)) {
+ Tcl_ListObjAppendElement(interp, resultPtr, pathPtr);
+ }
+ }
+ return TCL_OK;
+ } else {
+ char drivePat[] = "?:\\";
+ const char *message;
+ CONST char *dir;
+ char *root;
+ int dirLength;
+ Tcl_DString dirString;
+ DWORD attr, volFlags;
+ HANDLE handle;
+ WIN32_FIND_DATAT data;
+ BOOL found;
+ Tcl_DString ds;
+ Tcl_DString dsOrig;
+ Tcl_Obj *fileNamePtr;
+ int matchSpecialDots;
+
+ /*
+ * Convert the path to normalized form since some interfaces only
+ * accept backslashes. Also, ensure that the directory ends with a
+ * separator character.
+ */
- /*
- * Convert the path to normalized form since some interfaces only
- * accept backslashes. Also, ensure that the directory ends with a
- * separator character.
- */
+ fileNamePtr = Tcl_FSGetTranslatedPath(interp, pathPtr);
+ if (fileNamePtr == NULL) {
+ return TCL_ERROR;
+ }
+ Tcl_DStringInit(&dsOrig);
+ Tcl_DStringAppend(&dsOrig, Tcl_GetString(fileNamePtr), -1);
- dirLength = Tcl_DStringLength(dirPtr);
- Tcl_DStringInit(&dirString);
- if (dirLength == 0) {
- Tcl_DStringAppend(&dirString, ".\\", 2);
- } else {
- char *p;
+ dirLength = Tcl_DStringLength(&dsOrig);
+ Tcl_DStringInit(&dirString);
+ if (dirLength == 0) {
+ Tcl_DStringAppend(&dirString, ".\\", 2);
+ } else {
+ char *p;
- Tcl_DStringAppend(&dirString, Tcl_DStringValue(dirPtr),
- Tcl_DStringLength(dirPtr));
- for (p = Tcl_DStringValue(&dirString); *p != '\0'; p++) {
- if (*p == '/') {
- *p = '\\';
+ Tcl_DStringAppend(&dirString, Tcl_DStringValue(&dsOrig),
+ Tcl_DStringLength(&dsOrig));
+ 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++;
}
}
- p--;
- if ((*p != '\\') && (*p != ':')) {
- Tcl_DStringAppend(&dirString, "\\", 1);
- }
- }
- dir = Tcl_DStringValue(&dirString);
+ dir = Tcl_DStringValue(&dirString);
- /*
- * First verify that the specified path is actually a directory.
- */
+ /*
+ * First verify that the specified path is actually a directory.
+ */
- nativeName = Tcl_WinUtfToTChar(dir, Tcl_DStringLength(&dirString), &ds);
- attr = (*tclWinProcs->getFileAttributesProc)(nativeName);
- Tcl_DStringFree(&ds);
+ nativeName = Tcl_WinUtfToTChar(dir, Tcl_DStringLength(&dirString), &ds);
+ attr = (*tclWinProcs->getFileAttributesProc)(nativeName);
+ Tcl_DStringFree(&ds);
- if ((attr == 0xffffffff) || ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0)) {
- Tcl_DStringFree(&dirString);
- return TCL_OK;
- }
+ if ((attr == 0xffffffff) || ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0)) {
+ Tcl_DStringFree(&dirString);
+ return TCL_OK;
+ }
- /*
- * Next check the volume information for the directory to see whether
- * comparisons should be case sensitive or not. If the root is null, then
- * we use the root of the current directory. If the root is just a drive
- * specifier, we use the root directory of the given drive.
- */
+ /*
+ * Next check the volume information for the directory to see
+ * whether comparisons should be case sensitive or not. If the
+ * root is null, then we use the root of the current directory.
+ * If the root is just a drive specifier, we use the root
+ * directory of the given drive.
+ */
- switch (Tcl_GetPathType(dir)) {
- case TCL_PATH_RELATIVE:
- found = GetVolumeInformationA(NULL, NULL, 0, NULL, NULL,
- &volFlags, NULL, 0);
- break;
- case TCL_PATH_VOLUME_RELATIVE:
- if (dir[0] == '\\') {
- root = NULL;
- } else {
- root = drivePat;
- *root = dir[0];
- }
- found = GetVolumeInformationA(root, NULL, 0, NULL, NULL,
- &volFlags, NULL, 0);
- break;
- case TCL_PATH_ABSOLUTE:
- if (dir[1] == ':') {
- root = drivePat;
- *root = dir[0];
+ switch (Tcl_GetPathType(dir)) {
+ case TCL_PATH_RELATIVE:
+ found = GetVolumeInformationA(NULL, NULL, 0, NULL, NULL,
+ &volFlags, NULL, 0);
+ break;
+ case TCL_PATH_VOLUME_RELATIVE:
+ if (dir[0] == '\\') {
+ root = NULL;
+ } else {
+ root = drivePat;
+ *root = dir[0];
+ }
found = GetVolumeInformationA(root, NULL, 0, NULL, NULL,
&volFlags, NULL, 0);
- } else if (dir[1] == '\\') {
- char *p;
-
- p = strchr(dir + 2, '\\');
- p = strchr(p + 1, '\\');
- p++;
- nativeName = Tcl_WinUtfToTChar(dir, p - dir, &ds);
- found = (*tclWinProcs->getVolumeInformationProc)(nativeName,
- NULL, 0, NULL, NULL, &volFlags, NULL, 0);
- Tcl_DStringFree(&ds);
- }
- break;
- }
-
- if (found == 0) {
- message = "couldn't read volume information for \"";
- goto error;
- }
-
- /*
- * In Windows, although some volumes may support case sensitivity, Windows
- * doesn't honor case. So in globbing we need to ignore the case
- * of file names.
- */
+ break;
+ case TCL_PATH_ABSOLUTE:
+ if (dir[1] == ':') {
+ root = drivePat;
+ *root = dir[0];
+ found = GetVolumeInformationA(root, NULL, 0, NULL, NULL,
+ &volFlags, NULL, 0);
+ } else if (dir[1] == '\\') {
+ char *p;
+
+ p = strchr(dir + 2, '\\');
+ p = strchr(p + 1, '\\');
+ p++;
+ nativeName = Tcl_WinUtfToTChar(dir, p - dir, &ds);
+ found = (*tclWinProcs->getVolumeInformationProc)(nativeName,
+ NULL, 0, NULL, NULL, &volFlags, NULL, 0);
+ Tcl_DStringFree(&ds);
+ }
+ break;
+ }
- Tcl_DStringInit(&patternString);
- newPattern = Tcl_DStringAppend(&patternString, pattern, tail - pattern);
- Tcl_UtfToLower(newPattern);
+ if (found == 0) {
+ message = "couldn't read volume information for \"";
+ goto error;
+ }
- /*
- * We need to check all files in the directory, so append a *.*
- * to the path.
- */
+ /*
+ * Check to see if the pattern should match the special
+ * . and .. names, referring to the current directory,
+ * or the directory above. We need a special check for
+ * this because paths beginning with a dot are not considered
+ * hidden on Windows, and so otherwise a relative glob like
+ * 'glob -join * *' will actually return './. ../..' etc.
+ */
- dir = Tcl_DStringAppend(&dirString, "*.*", 3);
- nativeName = Tcl_WinUtfToTChar(dir, -1, &ds);
- handle = (*tclWinProcs->findFirstFileProc)(nativeName, &data);
- Tcl_DStringFree(&ds);
+ if ((pattern[0] == '.')
+ || ((pattern[0] == '\\') && (pattern[1] == '.'))) {
+ matchSpecialDots = 1;
+ } else {
+ matchSpecialDots = 0;
+ }
- if (handle == INVALID_HANDLE_VALUE) {
- message = "couldn't read directory \"";
- goto error;
- }
+ /*
+ * We need to check all files in the directory, so append a *.*
+ * to the path.
+ */
- /*
- * Clean up the tail pointer. Leave the tail pointing to the
- * first character after the path separator or NULL.
- */
+ dir = Tcl_DStringAppend(&dirString, "*.*", 3);
+ nativeName = Tcl_WinUtfToTChar(dir, -1, &ds);
+ handle = (*tclWinProcs->findFirstFileProc)(nativeName, &data);
+ Tcl_DStringFree(&ds);
- if (*tail == '\\') {
- tail++;
- }
- if (*tail == '\0') {
- tail = NULL;
- } else {
- tail++;
- }
+ if (handle == INVALID_HANDLE_VALUE) {
+ message = "couldn't read directory \"";
+ goto error;
+ }
- /*
- * Check to see if the pattern needs to compare with dot files.
- */
+ /*
+ * Now iterate over all of the files in the directory.
+ */
- if ((newPattern[0] == '.')
- || ((pattern[0] == '\\') && (pattern[1] == '.'))) {
- matchDotFiles = 1;
- } else {
- matchDotFiles = 0;
- }
+ for (found = 1; found != 0;
+ found = (*tclWinProcs->findNextFileProc)(handle, &data)) {
+ CONST TCHAR *nativeMatchResult;
+ CONST char *name, *fname;
+
+ if (tclWinProcs->useWide) {
+ nativeName = (CONST TCHAR *) data.w.cFileName;
+ } else {
+ nativeName = (CONST TCHAR *) data.a.cFileName;
+ }
+ name = Tcl_WinTCharToUtf(nativeName, -1, &ds);
+
+ if (!matchSpecialDots) {
+ /* If it is exactly '.' or '..' then we ignore it */
+ if (name[0] == '.') {
+ if (name[1] == '\0'
+ || (name[1] == '.' && name[2] == '\0')) {
+ continue;
+ }
+ }
+ }
+
+ /*
+ * Check to see if the file matches the pattern. Note that
+ * we are ignoring the case sensitivity flag because Windows
+ * doesn't honor case even if the volume is case sensitive.
+ * If the volume also doesn't preserve case, then we
+ * previously returned the lower case form of the name. This
+ * didn't seem quite right since there are
+ * non-case-preserving volumes that actually return mixed
+ * case. So now we are returning exactly what we get from
+ * the system.
+ */
- /*
- * Now iterate over all of the files in the directory.
- */
+ nativeMatchResult = NULL;
- resultPtr = Tcl_GetObjResult(interp);
- for (found = 1; found != 0;
- found = (*tclWinProcs->findNextFileProc)(handle, &data)) {
- TCHAR *nativeMatchResult;
- char *name, *fname;
+ if (Tcl_StringCaseMatch(name, pattern, 1) != 0) {
+ nativeMatchResult = nativeName;
+ }
+ Tcl_DStringFree(&ds);
- if (tclWinProcs->useWide) {
- nativeName = (TCHAR *) data.w.cFileName;
- } else {
- nativeName = (TCHAR *) data.a.cFileName;
- }
- name = Tcl_WinTCharToUtf(nativeName, -1, &ds);
+ if (nativeMatchResult == NULL) {
+ continue;
+ }
- /*
- * Check to see if the file matches the pattern. We need to convert
- * the file name to lower case for comparison purposes. Note that we
- * are ignoring the case sensitivity flag because Windows doesn't honor
- * case even if the volume is case sensitive. If the volume also
- * doesn't preserve case, then we previously returned the lower case
- * form of the name. This didn't seem quite right since there are
- * non-case-preserving volumes that actually return mixed case. So now
- * we are returning exactly what we get from the system.
- */
+ /*
+ * If the file matches, then we need to process the remainder
+ * of the path.
+ */
- Tcl_UtfToLower(name);
- nativeMatchResult = NULL;
+ name = Tcl_WinTCharToUtf(nativeMatchResult, -1, &ds);
+ Tcl_DStringAppend(&dsOrig, name, -1);
+ Tcl_DStringFree(&ds);
- if ((matchDotFiles == 0) && (name[0] == '.')) {
+ fname = Tcl_DStringValue(&dsOrig);
+ nativeName = Tcl_WinUtfToTChar(fname, Tcl_DStringLength(&dsOrig),
+ &ds);
+
+ if (NativeMatchType(fname, Tcl_DStringLength(&dsOrig),
+ nativeName, types)) {
+ Tcl_ListObjAppendElement(interp, resultPtr,
+ Tcl_NewStringObj(fname, Tcl_DStringLength(&dsOrig)));
+ }
/*
- * Ignore hidden files.
+ * Free ds here to ensure that nativeName is valid above.
*/
- } else if (Tcl_StringMatch(name, newPattern) != 0) {
- nativeMatchResult = nativeName;
- }
- Tcl_DStringFree(&ds);
- if (nativeMatchResult == NULL) {
- continue;
- }
+ Tcl_DStringFree(&ds);
- /*
- * If the file matches, then we need to process the remainder of the
- * path. If there are more characters to process, then ensure matching
- * files are directories and call TclDoGlob. Otherwise, just add the
- * file to the result.
- */
+ Tcl_DStringSetLength(&dsOrig, dirLength);
+ }
- name = Tcl_WinTCharToUtf(nativeMatchResult, -1, &ds);
- Tcl_DStringAppend(dirPtr, name, -1);
- Tcl_DStringFree(&ds);
+ FindClose(handle);
+ Tcl_DStringFree(&dirString);
+ Tcl_DStringFree(&dsOrig);
- fname = Tcl_DStringValue(dirPtr);
- nativeName = Tcl_WinUtfToTChar(fname, Tcl_DStringLength(dirPtr), &ds);
- attr = (*tclWinProcs->getFileAttributesProc)(nativeName);
- Tcl_DStringFree(&ds);
+ return TCL_OK;
+
+ error:
+ Tcl_DStringFree(&dirString);
+ TclWinConvertError(GetLastError());
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, message, Tcl_DStringValue(&dsOrig), "\": ",
+ Tcl_PosixError(interp), (char *) NULL);
+ Tcl_DStringFree(&dsOrig);
+ return TCL_ERROR;
+ }
- if (tail == NULL) {
- int typeOk = 1;
- if (types != NULL) {
- if (types->perm != 0) {
- if (
- ((types->perm & TCL_GLOB_PERM_RONLY) &&
- !(attr & FILE_ATTRIBUTE_READONLY)) ||
- ((types->perm & TCL_GLOB_PERM_HIDDEN) &&
- !(attr & FILE_ATTRIBUTE_HIDDEN)) ||
- ((types->perm & TCL_GLOB_PERM_R) &&
- (TclpAccess(fname, R_OK) != 0)) ||
- ((types->perm & TCL_GLOB_PERM_W) &&
- (TclpAccess(fname, W_OK) != 0)) ||
- ((types->perm & TCL_GLOB_PERM_X) &&
- (TclpAccess(fname, X_OK) != 0))
- ) {
- typeOk = 0;
- }
+}
+\f
+/*
+ * Does the given path represent a root volume? We need this special
+ * case because for NTFS root volumes, the getFileAttributesProc returns
+ * a 'hidden' attribute when it should not.
+ */
+static int
+WinIsDrive(
+ CONST char *name, /* Name (UTF-8) */
+ int len) /* Length of name */
+{
+ int remove = 0;
+ while (len > 4) {
+ if ((name[len-1] != '.' || name[len-2] != '.')
+ || (name[len-3] != '/' && name[len-3] != '\\')) {
+ /* We don't have '/..' at the end */
+ if (remove == 0) {
+ break;
+ }
+ remove--;
+ while (len > 0) {
+ len--;
+ if (name[len] == '/' || name[len] == '\\') {
+ break;
}
- if (typeOk && types->type != 0) {
- struct stat buf;
- /*
- * We must match at least one flag to be listed
- */
- typeOk = 0;
- if (TclpLstat(fname, &buf) >= 0) {
- /*
- * In order bcdpfls as in 'find -t'
- */
- if (
- ((types->type & TCL_GLOB_TYPE_BLOCK) &&
- S_ISBLK(buf.st_mode)) ||
- ((types->type & TCL_GLOB_TYPE_CHAR) &&
- S_ISCHR(buf.st_mode)) ||
- ((types->type & TCL_GLOB_TYPE_DIR) &&
- S_ISDIR(buf.st_mode)) ||
- ((types->type & TCL_GLOB_TYPE_PIPE) &&
- S_ISFIFO(buf.st_mode)) ||
- ((types->type & TCL_GLOB_TYPE_FILE) &&
- S_ISREG(buf.st_mode))
-#ifdef S_ISLNK
- || ((types->type & TCL_GLOB_TYPE_LINK) &&
- S_ISLNK(buf.st_mode))
-#endif
+ }
+ if (len < 4) {
+ len++;
+ break;
+ }
+ } else {
+ /* We do have '/..' */
+ len -= 3;
+ remove++;
+ }
+ }
+ if (len < 4) {
+ if (len == 0) {
+ /*
+ * Not sure if this is possible, but we pass it on
+ * anyway
+ */
+ } else if (len == 1 && (name[0] == '/' || name[0] == '\\')) {
+ /* Path is pointing to the root volume */
+ return 1;
+ } else if ((name[1] == ':')
+ && (len == 2 || (name[2] == '/' || name[2] == '\\'))) {
+ /* Path is of the form 'x:' or 'x:/' or 'x:\' */
+ return 1;
+ }
+ }
+ return 0;
+}
+
+\f
+/*
+ * This function needs a special case for a path which is a root
+ * volume, because for NTFS root volumes, the getFileAttributesProc
+ * returns a 'hidden' attribute when it should not.
+ */
+static int
+NativeMatchType(
+ CONST char *name, /* Name */
+ int nameLen, /* Length of name */
+ CONST TCHAR* nativeName, /* Native path to check */
+ Tcl_GlobTypeData *types) /* Type description to match against */
+{
+ /*
+ * 'attr' represents the attributes of the file, but we only
+ * want to retrieve this info if it is absolutely necessary
+ * because it is an expensive call. Unfortunately, to deal
+ * with hidden files properly, we must always retrieve it.
+ * There are more modern Win32 APIs available which we should
+ * look into.
+ */
+
+ DWORD attr = (*tclWinProcs->getFileAttributesProc)(nativeName);
+ if (attr == 0xffffffff) {
+ /* File doesn't exist */
+ return 0;
+ }
+
+ if (types == NULL) {
+ /* If invisible, don't return the file */
+ if (attr & FILE_ATTRIBUTE_HIDDEN && !WinIsDrive(name, nameLen)) {
+ return 0;
+ }
+ } else {
+ if (attr & FILE_ATTRIBUTE_HIDDEN && !WinIsDrive(name, nameLen)) {
+ /* If invisible */
+ if ((types->perm == 0) ||
+ !(types->perm & TCL_GLOB_PERM_HIDDEN)) {
+ return 0;
+ }
+ } else {
+ /* Visible */
+ if (types->perm & TCL_GLOB_PERM_HIDDEN) {
+ return 0;
+ }
+ }
+
+ if (types->perm != 0) {
+ if (
+ ((types->perm & TCL_GLOB_PERM_RONLY) &&
+ !(attr & FILE_ATTRIBUTE_READONLY)) ||
+ ((types->perm & TCL_GLOB_PERM_R) &&
+ (NativeAccess(nativeName, R_OK) != 0)) ||
+ ((types->perm & TCL_GLOB_PERM_W) &&
+ (NativeAccess(nativeName, W_OK) != 0)) ||
+ ((types->perm & TCL_GLOB_PERM_X) &&
+ (NativeAccess(nativeName, X_OK) != 0))
+ ) {
+ return 0;
+ }
+ }
+ if (types->type != 0) {
+ Tcl_StatBuf buf;
+
+ if (NativeStat(nativeName, &buf, 0) != 0) {
+ /*
+ * Posix error occurred, either the file
+ * has disappeared, or there is some other
+ * strange error. In any case we don't
+ * return this file.
+ */
+ return 0;
+ }
+ /*
+ * In order bcdpfls as in 'find -t'
+ */
+ if (
+ ((types->type & TCL_GLOB_TYPE_BLOCK) &&
+ S_ISBLK(buf.st_mode)) ||
+ ((types->type & TCL_GLOB_TYPE_CHAR) &&
+ S_ISCHR(buf.st_mode)) ||
+ ((types->type & TCL_GLOB_TYPE_DIR) &&
+ S_ISDIR(buf.st_mode)) ||
+ ((types->type & TCL_GLOB_TYPE_PIPE) &&
+ S_ISFIFO(buf.st_mode)) ||
+ ((types->type & TCL_GLOB_TYPE_FILE) &&
+ S_ISREG(buf.st_mode))
#ifdef S_ISSOCK
- || ((types->type & TCL_GLOB_TYPE_SOCK) &&
- S_ISSOCK(buf.st_mode))
+ || ((types->type & TCL_GLOB_TYPE_SOCK) &&
+ S_ISSOCK(buf.st_mode))
#endif
- ) {
- typeOk = 1;
+ ) {
+ /* Do nothing -- this file is ok */
+ } else {
+#ifdef S_ISLNK
+ if (types->type & TCL_GLOB_TYPE_LINK) {
+ if (NativeStat(nativeName, &buf, 1) == 0) {
+ if (S_ISLNK(buf.st_mode)) {
+ return 1;
}
- } else {
- /* Posix error occurred */
}
- }
- }
- if (typeOk) {
- Tcl_ListObjAppendElement(interp, resultPtr,
- Tcl_NewStringObj(fname, Tcl_DStringLength(dirPtr)));
- }
- } else if (attr & FILE_ATTRIBUTE_DIRECTORY) {
- Tcl_DStringAppend(dirPtr, "/", 1);
- result = TclDoGlob(interp, separators, dirPtr, tail, types);
- if (result != TCL_OK) {
- break;
+ }
+#endif
+ return 0;
}
- }
- Tcl_DStringSetLength(dirPtr, dirLength);
- }
-
- FindClose(handle);
- Tcl_DStringFree(&dirString);
- Tcl_DStringFree(&patternString);
-
- return result;
-
- error:
- Tcl_DStringFree(&dirString);
- TclWinConvertError(GetLastError());
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, message, Tcl_DStringValue(dirPtr), "\": ",
- Tcl_PosixError(interp), (char *) NULL);
- return TCL_ERROR;
-}
-\f
-/*
- * TclpMatchFiles --
- *
- * This function is now obsolete. Call the above function
- * 'TclpMatchFilesTypes' instead.
- */
-int
-TclpMatchFiles(
- Tcl_Interp *interp, /* Interpreter to receive results. */
- char *separators, /* Directory separators to pass to TclDoGlob. */
- Tcl_DString *dirPtr, /* Contains path to directory to search. */
- char *pattern, /* Pattern to match against. */
- char *tail) /* Pointer to end of pattern. Tail must
- * point to a location in pattern and must
- * not be static.*/
-{
- return TclpMatchFilesTypes(interp,separators,dirPtr,pattern,tail,NULL);
+ }
+ }
+ return 1;
}
\f
/*
if (badDomain == 0) {
Tcl_DStringInit(&ds);
wName = Tcl_UtfToUniCharDString(name, nameLen, &ds);
- if ((*netUserGetInfoProc)(wDomain, wName, 1,
+ if ((*netUserGetInfoProc)(wDomain, wName, 1,
(LPBYTE *) &uiPtr) == 0) {
wHomeDir = uiPtr->usri1_home_dir;
if ((wHomeDir != NULL) && (wHomeDir[0] != L'\0')) {
return result;
}
+
\f
/*
*---------------------------------------------------------------------------
*
- * TclpAccess --
+ * NativeAccess --
*
* This function replaces the library version of access(), fixing the
* following bugs:
*---------------------------------------------------------------------------
*/
-int
-TclpAccess(
- CONST char *path, /* Path of file to access (UTF-8). */
+static int
+NativeAccess(
+ CONST TCHAR *nativePath, /* Path of file to access (UTF-8). */
int mode) /* Permission setting. */
{
- Tcl_DString ds;
- TCHAR *nativePath;
DWORD attr;
- nativePath = Tcl_WinUtfToTChar(path, -1, &ds);
attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
- Tcl_DStringFree(&ds);
if (attr == 0xffffffff) {
/*
}
if (mode & X_OK) {
- CONST char *p;
-
if (attr & FILE_ATTRIBUTE_DIRECTORY) {
/*
* Directories are always executable.
return 0;
}
- p = strrchr(path, '.');
- if (p != NULL) {
- p++;
- if ((stricmp(p, "exe") == 0)
- || (stricmp(p, "com") == 0)
- || (stricmp(p, "bat") == 0)) {
- /*
- * File that ends with .exe, .com, or .bat is executable.
- */
-
- return 0;
- }
+ if (NativeIsExec(nativePath)) {
+ return 0;
}
Tcl_SetErrno(EACCES);
return -1;
return 0;
}
\f
+static int
+NativeIsExec(nativePath)
+ CONST TCHAR *nativePath;
+{
+ CONST char *p, *path;
+ Tcl_DString ds;
+
+ /*
+ * This is really not efficient. We should be able to examine
+ * the native path directly without converting to UTF.
+ */
+ Tcl_DStringInit(&ds);
+ path = Tcl_WinTCharToUtf(nativePath, -1, &ds);
+
+ p = strrchr(path, '.');
+ if (p != NULL) {
+ p++;
+ /*
+ * Note: in the old code, stat considered '.pif' files as
+ * executable, whereas access did not.
+ */
+ if ((stricmp(p, "exe") == 0)
+ || (stricmp(p, "com") == 0)
+ || (stricmp(p, "bat") == 0)) {
+ /*
+ * File that ends with .exe, .com, or .bat is executable.
+ */
+
+ Tcl_DStringFree(&ds);
+ return 1;
+ }
+ }
+ Tcl_DStringFree(&ds);
+ return 0;
+}
+\f
/*
*----------------------------------------------------------------------
*
- * TclpChdir --
+ * TclpObjChdir --
*
* This function replaces the library version of chdir().
*
*----------------------------------------------------------------------
*/
-int
-TclpChdir(path)
- CONST char *path; /* Path to new working directory (UTF-8). */
+int
+TclpObjChdir(pathPtr)
+ Tcl_Obj *pathPtr; /* Path to new working directory. */
{
int result;
- Tcl_DString ds;
- TCHAR *nativePath;
+ CONST TCHAR *nativePath;
- nativePath = Tcl_WinUtfToTChar(path, -1, &ds);
+ nativePath = (CONST TCHAR *) Tcl_FSGetNativePath(pathPtr);
result = (*tclWinProcs->setCurrentDirectoryProc)(nativePath);
- Tcl_DStringFree(&ds);
if (result == 0) {
TclWinConvertError(GetLastError());
Tcl_DStringFree(&ds);
if (length < 0) {
- return NULL;
+ return NULL;
}
Tcl_ExternalToUtfDString(NULL, link, length, linkPtr);
*----------------------------------------------------------------------
*/
-char *
+CONST char *
TclpGetCwd(interp, bufferPtr)
Tcl_Interp *interp; /* If non-NULL, used for error reporting. */
Tcl_DString *bufferPtr; /* Uninitialized or free DString filled
}
/*
- * Watch for the wierd Windows c:\\UNC syntax.
+ * Watch for the weird Windows c:\\UNC syntax.
*/
if (tclWinProcs->useWide) {
return Tcl_DStringValue(bufferPtr);
}
\f
+int
+TclpObjStat(pathPtr, statPtr)
+ Tcl_Obj *pathPtr; /* Path of file to stat */
+ Tcl_StatBuf *statPtr; /* Filled with results of stat call. */
+{
+#ifdef OLD_API
+ Tcl_Obj *transPtr;
+ /*
+ * Eliminate file names containing wildcard characters, or subsequent
+ * call to FindFirstFile() will expand them, matching some other file.
+ */
+
+ transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
+ if (transPtr == NULL || (strpbrk(Tcl_GetString(transPtr), "?*") != NULL)) {
+ Tcl_SetErrno(ENOENT);
+ return -1;
+ }
+#endif
+
+ /*
+ * 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, 0);
+}
+\f
/*
*----------------------------------------------------------------------
*
- * TclpStat --
+ * NativeStat --
*
* This function replaces the library version of stat(), fixing
* the following bugs:
*----------------------------------------------------------------------
*/
-int
-TclpStat(path, statPtr)
- CONST char *path; /* Path of file to stat (UTF-8). */
- struct stat *statPtr; /* Filled with results of stat call. */
+static int
+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;
- TCHAR *nativePath;
- WIN32_FIND_DATAT data;
- HANDLE handle;
DWORD attr;
WCHAR nativeFullPath[MAX_PATH];
TCHAR *nativePart;
- char *p, *fullPath;
+ CONST char *fullPath;
int dev, mode;
+
+ if (tclWinProcs->getFileAttributesExProc == NULL) {
+ /*
+ * We don't have the faster attributes proc, so we're
+ * probably running on Win95
+ */
+ WIN32_FIND_DATAT data;
+ HANDLE handle;
+
+ handle = (*tclWinProcs->findFirstFileProc)(nativePath, &data);
+ if (handle == INVALID_HANDLE_VALUE) {
+ /*
+ * FindFirstFile() doesn't work on root directories, so call
+ * GetFileAttributes() to see if the specified file exists.
+ */
- /*
- * Eliminate file names containing wildcard characters, or subsequent
- * call to FindFirstFile() will expand them, matching some other file.
- */
+ attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
+ if (attr == 0xffffffff) {
+ Tcl_SetErrno(ENOENT);
+ return -1;
+ }
- if (strpbrk(path, "?*") != NULL) {
- Tcl_SetErrno(ENOENT);
- return -1;
- }
+ /*
+ * Make up some fake information for this file. It has the
+ * correct file attributes and a time of 0.
+ */
- nativePath = Tcl_WinUtfToTChar(path, -1, &ds);
- handle = (*tclWinProcs->findFirstFileProc)(nativePath, &data);
- if (handle == INVALID_HANDLE_VALUE) {
- /*
- * FindFirstFile() doesn't work on root directories, so call
- * GetFileAttributes() to see if the specified file exists.
- */
+ memset(&data, 0, sizeof(data));
+ data.a.dwFileAttributes = attr;
+ } else {
+ FindClose(handle);
+ }
- attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
- if (attr == 0xffffffff) {
- Tcl_DStringFree(&ds);
+
+ (*tclWinProcs->getFullPathNameProc)(nativePath, MAX_PATH, nativeFullPath,
+ &nativePart);
+
+ fullPath = Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds);
+
+ dev = -1;
+ if ((fullPath[0] == '\\') && (fullPath[1] == '\\')) {
+ CONST char *p;
+ DWORD dw;
+ CONST TCHAR *nativeVol;
+ Tcl_DString volString;
+
+ p = strchr(fullPath + 2, '\\');
+ p = strchr(p + 1, '\\');
+ if (p == NULL) {
+ /*
+ * Add terminating backslash to fullpath or
+ * GetVolumeInformation() won't work.
+ */
+
+ fullPath = Tcl_DStringAppend(&ds, "\\", 1);
+ p = fullPath + Tcl_DStringLength(&ds);
+ } else {
+ p++;
+ }
+ nativeVol = Tcl_WinUtfToTChar(fullPath, p - fullPath, &volString);
+ dw = (DWORD) -1;
+ (*tclWinProcs->getVolumeInformationProc)(nativeVol, NULL, 0, &dw,
+ NULL, NULL, NULL, 0);
+ /*
+ * GetFullPathName() turns special devices like "NUL" into
+ * "\\.\NUL", but GetVolumeInformation() returns failure for
+ * "\\.\NUL". This will cause "NUL" to get a drive number of
+ * -1, which makes about as much sense as anything since the
+ * special devices don't live on any drive.
+ */
+
+ dev = dw;
+ Tcl_DStringFree(&volString);
+ } else if ((fullPath[0] != '\0') && (fullPath[1] == ':')) {
+ dev = Tcl_UniCharToLower(fullPath[0]) - 'a';
+ }
+ Tcl_DStringFree(&ds);
+
+ attr = data.a.dwFileAttributes;
+
+ statPtr->st_size = ((Tcl_WideInt)data.a.nFileSizeLow) |
+ (((Tcl_WideInt)data.a.nFileSizeHigh) << 32);
+ statPtr->st_atime = ToCTime(data.a.ftLastAccessTime);
+ statPtr->st_mtime = ToCTime(data.a.ftLastWriteTime);
+ statPtr->st_ctime = ToCTime(data.a.ftCreationTime);
+ } else {
+ WIN32_FILE_ATTRIBUTE_DATA data;
+ if((*tclWinProcs->getFileAttributesExProc)(nativePath,
+ GetFileExInfoStandard,
+ &data) != TRUE) {
Tcl_SetErrno(ENOENT);
return -1;
}
- /*
- * Make up some fake information for this file. It has the
- * correct file attributes and a time of 0.
- */
+
+ (*tclWinProcs->getFullPathNameProc)(nativePath, MAX_PATH,
+ nativeFullPath, &nativePart);
- memset(&data, 0, sizeof(data));
- data.a.dwFileAttributes = attr;
- } else {
- FindClose(handle);
- }
+ fullPath = Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds);
- (*tclWinProcs->getFullPathNameProc)(nativePath, MAX_PATH, nativeFullPath,
- &nativePart);
+ dev = -1;
+ if ((fullPath[0] == '\\') && (fullPath[1] == '\\')) {
+ CONST char *p;
+ DWORD dw;
+ CONST TCHAR *nativeVol;
+ Tcl_DString volString;
- Tcl_DStringFree(&ds);
- fullPath = Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds);
-
- dev = -1;
- if ((fullPath[0] == '\\') && (fullPath[1] == '\\')) {
- char *p;
- DWORD dw;
- TCHAR *nativeVol;
- Tcl_DString volString;
-
- p = strchr(fullPath + 2, '\\');
- p = strchr(p + 1, '\\');
- if (p == NULL) {
+ p = strchr(fullPath + 2, '\\');
+ p = strchr(p + 1, '\\');
+ if (p == NULL) {
+ /*
+ * Add terminating backslash to fullpath or
+ * GetVolumeInformation() won't work.
+ */
+
+ fullPath = Tcl_DStringAppend(&ds, "\\", 1);
+ p = fullPath + Tcl_DStringLength(&ds);
+ } else {
+ p++;
+ }
+ nativeVol = Tcl_WinUtfToTChar(fullPath, p - fullPath, &volString);
+ dw = (DWORD) -1;
+ (*tclWinProcs->getVolumeInformationProc)(nativeVol, NULL, 0, &dw,
+ NULL, NULL, NULL, 0);
/*
- * Add terminating backslash to fullpath or
- * GetVolumeInformation() won't work.
+ * GetFullPathName() turns special devices like "NUL" into
+ * "\\.\NUL", but GetVolumeInformation() returns failure for
+ * "\\.\NUL". This will cause "NUL" to get a drive number of
+ * -1, which makes about as much sense as anything since the
+ * special devices don't live on any drive.
*/
- fullPath = Tcl_DStringAppend(&ds, "\\", 1);
- p = fullPath + Tcl_DStringLength(&ds);
- } else {
- p++;
+ dev = dw;
+ Tcl_DStringFree(&volString);
+ } else if ((fullPath[0] != '\0') && (fullPath[1] == ':')) {
+ dev = Tcl_UniCharToLower(fullPath[0]) - 'a';
}
- nativeVol = Tcl_WinUtfToTChar(fullPath, p - fullPath, &volString);
- dw = (DWORD) -1;
- (*tclWinProcs->getVolumeInformationProc)(nativeVol, NULL, 0, &dw,
- NULL, NULL, NULL, 0);
- /*
- * GetFullPathName() turns special devices like "NUL" into "\\.\NUL",
- * but GetVolumeInformation() returns failure for "\\.\NUL". This
- * will cause "NUL" to get a drive number of -1, which makes about
- * as much sense as anything since the special devices don't live on
- * any drive.
- */
-
- dev = dw;
- Tcl_DStringFree(&volString);
- } else if ((fullPath[0] != '\0') && (fullPath[1] == ':')) {
- dev = Tcl_UniCharToLower(fullPath[0]) - 'a';
+ Tcl_DStringFree(&ds);
+
+ attr = data.dwFileAttributes;
+
+ statPtr->st_size = ((Tcl_WideInt)data.nFileSizeLow) |
+ (((Tcl_WideInt)data.nFileSizeHigh) << 32);
+ statPtr->st_atime = ToCTime(data.ftLastAccessTime);
+ statPtr->st_mtime = ToCTime(data.ftLastWriteTime);
+ statPtr->st_ctime = ToCTime(data.ftCreationTime);
}
- Tcl_DStringFree(&ds);
- attr = data.a.dwFileAttributes;
- 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;
- p = strrchr(path, '.');
- if (p != NULL) {
- if ((lstrcmpiA(p, ".exe") == 0)
- || (lstrcmpiA(p, ".com") == 0)
- || (lstrcmpiA(p, ".bat") == 0)
- || (lstrcmpiA(p, ".pif") == 0)) {
- mode |= S_IEXEC;
- }
+ if (NativeIsExec(nativePath)) {
+ mode |= S_IEXEC;
}
-
+
/*
* Propagate the S_IREAD, S_IWRITE, S_IEXEC bits to the group and
* other positions.
statPtr->st_uid = 0;
statPtr->st_gid = 0;
statPtr->st_rdev = (dev_t) dev;
- statPtr->st_size = data.a.nFileSizeLow;
- statPtr->st_atime = ToCTime(data.a.ftLastAccessTime);
- statPtr->st_mtime = ToCTime(data.a.ftLastWriteTime);
- statPtr->st_ctime = ToCTime(data.a.ftCreationTime);
return 0;
}
return 0;
}
#endif
+\f
+Tcl_Obj*
+TclpObjGetCwd(interp)
+ Tcl_Interp *interp;
+{
+ Tcl_DString ds;
+ if (TclpGetCwd(interp, &ds) != NULL) {
+ Tcl_Obj *cwdPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
+ Tcl_IncrRefCount(cwdPtr);
+ Tcl_DStringFree(&ds);
+ return cwdPtr;
+ } else {
+ return NULL;
+ }
+}
+
+int
+TclpObjAccess(pathPtr, mode)
+ Tcl_Obj *pathPtr;
+ int mode;
+{
+ return NativeAccess((CONST TCHAR*) Tcl_FSGetNativePath(pathPtr), mode);
+}
+
+int
+TclpObjLstat(pathPtr, statPtr)
+ Tcl_Obj *pathPtr;
+ Tcl_StatBuf *statPtr;
+{
+ /*
+ * 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
+
+Tcl_Obj*
+TclpObjLink(pathPtr, toPtr, linkAction)
+ Tcl_Obj *pathPtr;
+ Tcl_Obj *toPtr;
+ int linkAction;
+{
+ if (toPtr != NULL) {
+ int res;
+ TCHAR* LinkTarget = (TCHAR*)Tcl_FSGetNativePath(toPtr);
+ TCHAR* LinkSource = (TCHAR*)Tcl_FSGetNativePath(pathPtr);
+ if (LinkSource == NULL || LinkTarget == NULL) {
+ return NULL;
+ }
+ res = WinLink(LinkSource, LinkTarget, linkAction);
+ if (res == 0) {
+ return toPtr;
+ } else {
+ return NULL;
+ }
+ } else {
+ TCHAR* LinkSource = (TCHAR*)Tcl_FSGetNativePath(pathPtr);
+ if (LinkSource == NULL) {
+ return NULL;
+ }
+ return WinReadLink(LinkSource);
+ }
+}
+
+#endif
+
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpFilesystemPathType --
+ *
+ * This function is part of the native filesystem support, and
+ * returns the path type of the given path. Returns NTFS or FAT
+ * or whatever is returned by the 'volume information' proc.
+ *
+ * Results:
+ * NULL at present.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+Tcl_Obj*
+TclpFilesystemPathType(pathObjPtr)
+ Tcl_Obj* pathObjPtr;
+{
+#define VOL_BUF_SIZE 32
+ int found;
+ char volType[VOL_BUF_SIZE];
+ char* firstSeparator;
+ CONST char *path;
+
+ Tcl_Obj *normPath = Tcl_FSGetNormalizedPath(NULL, pathObjPtr);
+ if (normPath == NULL) return NULL;
+ path = Tcl_GetString(normPath);
+ if (path == NULL) return NULL;
+
+ firstSeparator = strchr(path, '/');
+ if (firstSeparator == NULL) {
+ found = tclWinProcs->getVolumeInformationProc(
+ Tcl_FSGetNativePath(pathObjPtr), NULL, 0, NULL, NULL,
+ NULL, (WCHAR *)volType, VOL_BUF_SIZE);
+ } else {
+ Tcl_Obj *driveName = Tcl_NewStringObj(path, firstSeparator - path+1);
+ Tcl_IncrRefCount(driveName);
+ found = tclWinProcs->getVolumeInformationProc(
+ Tcl_FSGetNativePath(driveName), NULL, 0, NULL, NULL,
+ NULL, (WCHAR *)volType, VOL_BUF_SIZE);
+ Tcl_DecrRefCount(driveName);
+ }
+
+ if (found == 0) {
+ return NULL;
+ } else {
+ Tcl_DString ds;
+ Tcl_Obj *objPtr;
+
+ Tcl_WinTCharToUtf(volType, -1, &ds);
+ objPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds),Tcl_DStringLength(&ds));
+ Tcl_DStringFree(&ds);
+ return objPtr;
+ }
+#undef VOL_BUF_SIZE
+}
+
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpObjNormalizePath --
+ *
+ * This function scans through a path specification and replaces it,
+ * in place, with a normalized version. This means using the
+ * 'longname', and expanding any symbolic links contained within the
+ * path.
+ *
+ * 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;
+ /* This will hold the normalized string */
+ Tcl_DString dsNorm;
+ char *path;
+ char *currentPathEndPosition;
+
+ Tcl_DStringInit(&dsNorm);
+ path = Tcl_GetString(pathPtr);
+ if (TclWinGetPlatformId() == VER_PLATFORM_WIN32_WINDOWS) {
+ /*
+ * We're on Win95, 98 or ME. There are two assumptions
+ * in this block of code. First that the native (NULL)
+ * encoding is basically ascii, and second that symbolic
+ * links are not possible. Both of these assumptions
+ * appear to be true of these operating systems.
+ */
+ Tcl_Obj *temp = NULL;
+ int isDrive = 1;
+ Tcl_DString ds;
+
+ currentPathEndPosition = path + nextCheckpoint;
+ while (1) {
+ char cur = *currentPathEndPosition;
+ if ((cur == '/' || cur == 0) && (path != currentPathEndPosition)) {
+ /* Reached directory separator, or end of string */
+ CONST char *nativePath = Tcl_UtfToExternalDString(NULL, path,
+ currentPathEndPosition - path, &ds);
+
+ /*
+ * Now we convert the tail of the current path to its
+ * 'long form', and append it to 'dsNorm' which holds
+ * the current normalized path, if the file exists.
+ */
+ if (isDrive) {
+ if (GetFileAttributesA(nativePath)
+ == 0xffffffff) {
+ /* File doesn't exist */
+ Tcl_DStringFree(&ds);
+ break;
+ }
+ if (nativePath[0] >= 'a') {
+ ((char*)nativePath)[0] -= ('a' - 'A');
+ }
+ Tcl_DStringAppend(&dsNorm,nativePath,Tcl_DStringLength(&ds));
+ } else {
+ WIN32_FIND_DATA fData;
+ HANDLE handle;
+
+ handle = FindFirstFileA(nativePath, &fData);
+ if (handle == INVALID_HANDLE_VALUE) {
+ if (GetFileAttributesA(nativePath)
+ == 0xffffffff) {
+ /* File doesn't exist */
+ Tcl_DStringFree(&ds);
+ break;
+ }
+ /* This is usually the '/' in 'c:/' at end of string */
+ Tcl_DStringAppend(&dsNorm,"/", 1);
+ } else {
+ char *nativeName;
+ if (fData.cFileName[0] != '\0') {
+ nativeName = fData.cFileName;
+ } else {
+ nativeName = fData.cAlternateFileName;
+ }
+ FindClose(handle);
+ Tcl_DStringAppend(&dsNorm,"/", 1);
+ Tcl_DStringAppend(&dsNorm,nativeName,-1);
+ }
+ }
+ Tcl_DStringFree(&ds);
+ lastValidPathEnd = currentPathEndPosition;
+ if (cur == 0) {
+ break;
+ }
+ /*
+ * If we get here, we've got past one directory
+ * delimiter, so we know it is no longer a drive
+ */
+ isDrive = 0;
+ }
+ currentPathEndPosition++;
+ }
+ } else {
+ /* We're on WinNT or 2000 or XP */
+ Tcl_Obj *temp = NULL;
+ int isDrive = 1;
+ Tcl_DString ds;
+
+ currentPathEndPosition = path + nextCheckpoint;
+ while (1) {
+ char cur = *currentPathEndPosition;
+ if ((cur == '/' || cur == 0) && (path != currentPathEndPosition)) {
+ /* Reached directory separator, or end of string */
+ WIN32_FILE_ATTRIBUTE_DATA data;
+ CONST char *nativePath = Tcl_WinUtfToTChar(path,
+ currentPathEndPosition - path, &ds);
+ if ((*tclWinProcs->getFileAttributesExProc)(nativePath,
+ GetFileExInfoStandard, &data) != TRUE) {
+ /* File doesn't exist */
+ Tcl_DStringFree(&ds);
+ break;
+ }
+ /*
+ * File 'nativePath' does exist if we get here. We
+ * now want to check if it is a symlink and otherwise
+ * continue with the rest of the path.
+ */
+
+ /*
+ * Check for symlinks, except at last component
+ * of path (we don't follow final symlinks). Also
+ * a drive (C:/) for example, may sometimes have
+ * the reparse flag set for some reason I don't
+ * understand. We therefore don't perform this
+ * check for drives.
+ */
+ if (cur != 0 && !isDrive && (data.dwFileAttributes
+ & FILE_ATTRIBUTE_REPARSE_POINT)) {
+ Tcl_Obj *to = WinReadLinkDirectory(nativePath);
+ if (to != NULL) {
+ /* Read the reparse point ok */
+ /* Tcl_GetStringFromObj(to, &pathLen); */
+ nextCheckpoint = 0; /* pathLen */
+ Tcl_AppendToObj(to, currentPathEndPosition, -1);
+ /* Convert link to forward slashes */
+ for (path = Tcl_GetString(to); *path != 0; path++) {
+ if (*path == '\\') *path = '/';
+ }
+ path = Tcl_GetString(to);
+ currentPathEndPosition = path + nextCheckpoint;
+ if (temp != NULL) {
+ Tcl_DecrRefCount(temp);
+ }
+ temp = to;
+ /* Reset variables so we can restart normalization */
+ isDrive = 1;
+ Tcl_DStringFree(&dsNorm);
+ Tcl_DStringInit(&dsNorm);
+ Tcl_DStringFree(&ds);
+ continue;
+ }
+ }
+ /*
+ * Now we convert the tail of the current path to its
+ * 'long form', and append it to 'dsNorm' which holds
+ * the current normalized path
+ */
+ if (isDrive) {
+ WCHAR drive = ((WCHAR*)nativePath)[0];
+ if (drive >= L'a') {
+ drive -= (L'a' - L'A');
+ ((WCHAR*)nativePath)[0] = drive;
+ }
+ Tcl_DStringAppend(&dsNorm,nativePath,Tcl_DStringLength(&ds));
+ } else {
+ WIN32_FIND_DATAW fData;
+ HANDLE handle;
+
+ handle = FindFirstFileW((WCHAR*)nativePath, &fData);
+ if (handle == INVALID_HANDLE_VALUE) {
+ /* This is usually the '/' in 'c:/' at end of string */
+ Tcl_DStringAppend(&dsNorm,(CONST char*)L"/",
+ sizeof(WCHAR));
+ } else {
+ WCHAR *nativeName;
+ if (fData.cFileName[0] != '\0') {
+ nativeName = fData.cFileName;
+ } else {
+ nativeName = fData.cAlternateFileName;
+ }
+ FindClose(handle);
+ Tcl_DStringAppend(&dsNorm,(CONST char*)L"/",
+ sizeof(WCHAR));
+ Tcl_DStringAppend(&dsNorm,(TCHAR*)nativeName,
+ wcslen(nativeName)*sizeof(WCHAR));
+ }
+ }
+ Tcl_DStringFree(&ds);
+ lastValidPathEnd = currentPathEndPosition;
+ if (cur == 0) {
+ break;
+ }
+ /*
+ * If we get here, we've got past one directory
+ * delimiter, so we know it is no longer a drive
+ */
+ isDrive = 0;
+ }
+ currentPathEndPosition++;
+ }
+ }
+ /* Common code path for all Windows platforms */
+ nextCheckpoint = currentPathEndPosition - path;
+ if (lastValidPathEnd != NULL) {
+ /*
+ * Concatenate the normalized string in dsNorm with the
+ * tail of the path which we didn't recognise. The
+ * string in dsNorm is in the native encoding, so we
+ * have to convert it to Utf.
+ */
+ Tcl_DString dsTemp;
+ Tcl_WinTCharToUtf(Tcl_DStringValue(&dsNorm),
+ Tcl_DStringLength(&dsNorm), &dsTemp);
+ nextCheckpoint = Tcl_DStringLength(&dsTemp);
+ if (*lastValidPathEnd != 0) {
+ /* Not the end of the string */
+ int len;
+ char *path;
+ Tcl_Obj *tmpPathPtr;
+ tmpPathPtr = Tcl_NewStringObj(Tcl_DStringValue(&dsTemp),
+ nextCheckpoint);
+ Tcl_AppendToObj(tmpPathPtr, lastValidPathEnd, -1);
+ path = Tcl_GetStringFromObj(tmpPathPtr, &len);
+ Tcl_SetStringObj(pathPtr, path, len);
+ Tcl_DecrRefCount(tmpPathPtr);
+ } else {
+ /* End of string was reached above */
+ Tcl_SetStringObj(pathPtr, Tcl_DStringValue(&dsTemp),
+ nextCheckpoint);
+ }
+ Tcl_DStringFree(&dsTemp);
+ }
+ Tcl_DStringFree(&dsNorm);
+ return nextCheckpoint;
+}
OSDN Git Service
