sl@0: /* sl@0: * tclWinFile.c -- sl@0: * sl@0: * This file contains temporary wrappers around UNIX file handling sl@0: * functions. These wrappers map the UNIX functions to Win32 HANDLE-style sl@0: * files, which can be manipulated through the Win32 console redirection sl@0: * interfaces. sl@0: * sl@0: * Copyright (c) 1995-1998 Sun Microsystems, Inc. sl@0: * sl@0: * See the file "license.terms" for information on usage and redistribution sl@0: * of this file, and for a DISCLAIMER OF ALL WARRANTIES. sl@0: * sl@0: * RCS: @(#) $Id: tclWinFile.c,v 1.44.2.18 2006/10/17 04:36:45 dgp Exp $ sl@0: */ sl@0: sl@0: //#define _WIN32_WINNT 0x0500 sl@0: sl@0: #include "tclWinInt.h" sl@0: #include sl@0: #include sl@0: #include sl@0: #include /* For TclpGetUserHome(). */ sl@0: sl@0: /* sl@0: * The number of 100-ns intervals between the Windows system epoch (1601-01-01 sl@0: * on the proleptic Gregorian calendar) and the Posix epoch (1970-01-01). sl@0: */ sl@0: sl@0: #define POSIX_EPOCH_AS_FILETIME 116444736000000000 sl@0: sl@0: /* sl@0: * Declarations for 'link' related information. This information sl@0: * should come with VC++ 6.0, but is not in some older SDKs. sl@0: * In any case it is not well documented. sl@0: */ sl@0: #ifndef IO_REPARSE_TAG_RESERVED_ONE sl@0: # define IO_REPARSE_TAG_RESERVED_ONE 0x000000001 sl@0: #endif sl@0: #ifndef IO_REPARSE_TAG_RESERVED_RANGE sl@0: # define IO_REPARSE_TAG_RESERVED_RANGE 0x000000001 sl@0: #endif sl@0: #ifndef IO_REPARSE_TAG_VALID_VALUES sl@0: # define IO_REPARSE_TAG_VALID_VALUES 0x0E000FFFF sl@0: #endif sl@0: #ifndef IO_REPARSE_TAG_HSM sl@0: # define IO_REPARSE_TAG_HSM 0x0C0000004 sl@0: #endif sl@0: #ifndef IO_REPARSE_TAG_NSS sl@0: # define IO_REPARSE_TAG_NSS 0x080000005 sl@0: #endif sl@0: #ifndef IO_REPARSE_TAG_NSSRECOVER sl@0: # define IO_REPARSE_TAG_NSSRECOVER 0x080000006 sl@0: #endif sl@0: #ifndef IO_REPARSE_TAG_SIS sl@0: # define IO_REPARSE_TAG_SIS 0x080000007 sl@0: #endif sl@0: #ifndef IO_REPARSE_TAG_DFS sl@0: # define IO_REPARSE_TAG_DFS 0x080000008 sl@0: #endif sl@0: sl@0: #ifndef IO_REPARSE_TAG_RESERVED_ZERO sl@0: # define IO_REPARSE_TAG_RESERVED_ZERO 0x00000000 sl@0: #endif sl@0: #ifndef FILE_FLAG_OPEN_REPARSE_POINT sl@0: # define FILE_FLAG_OPEN_REPARSE_POINT 0x00200000 sl@0: #endif sl@0: #ifndef IO_REPARSE_TAG_MOUNT_POINT sl@0: # define IO_REPARSE_TAG_MOUNT_POINT 0xA0000003 sl@0: #endif sl@0: #ifndef IsReparseTagValid sl@0: # define IsReparseTagValid(x) (!((x)&~IO_REPARSE_TAG_VALID_VALUES)&&((x)>IO_REPARSE_TAG_RESERVED_RANGE)) sl@0: #endif sl@0: #ifndef IO_REPARSE_TAG_SYMBOLIC_LINK sl@0: # define IO_REPARSE_TAG_SYMBOLIC_LINK IO_REPARSE_TAG_RESERVED_ZERO sl@0: #endif sl@0: #ifndef FILE_SPECIAL_ACCESS sl@0: # define FILE_SPECIAL_ACCESS (FILE_ANY_ACCESS) sl@0: #endif sl@0: #ifndef FSCTL_SET_REPARSE_POINT sl@0: # define FSCTL_SET_REPARSE_POINT CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 41, METHOD_BUFFERED, FILE_SPECIAL_ACCESS) sl@0: # define FSCTL_GET_REPARSE_POINT CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 42, METHOD_BUFFERED, FILE_ANY_ACCESS) sl@0: # define FSCTL_DELETE_REPARSE_POINT CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 43, METHOD_BUFFERED, FILE_SPECIAL_ACCESS) sl@0: #endif sl@0: #ifndef INVALID_FILE_ATTRIBUTES sl@0: #define INVALID_FILE_ATTRIBUTES ((DWORD)-1) sl@0: #endif sl@0: sl@0: /* sl@0: * Maximum reparse buffer info size. The max user defined reparse sl@0: * data is 16KB, plus there's a header. sl@0: */ sl@0: sl@0: #define MAX_REPARSE_SIZE 17000 sl@0: sl@0: /* sl@0: * Undocumented REPARSE_MOUNTPOINT_HEADER_SIZE structure definition. sl@0: * This is found in winnt.h. sl@0: * sl@0: * IMPORTANT: caution when using this structure, since the actual sl@0: * structures used will want to store a full path in the 'PathBuffer' sl@0: * field, but there isn't room (there's only a single WCHAR!). Therefore sl@0: * one must artificially create a larger space of memory and then cast it sl@0: * to this type. We use the 'DUMMY_REPARSE_BUFFER' struct just below to sl@0: * deal with this problem. sl@0: */ sl@0: sl@0: #define REPARSE_MOUNTPOINT_HEADER_SIZE 8 sl@0: #ifndef REPARSE_DATA_BUFFER_HEADER_SIZE sl@0: typedef struct _REPARSE_DATA_BUFFER { sl@0: DWORD ReparseTag; sl@0: WORD ReparseDataLength; sl@0: WORD Reserved; sl@0: union { sl@0: struct { sl@0: WORD SubstituteNameOffset; sl@0: WORD SubstituteNameLength; sl@0: WORD PrintNameOffset; sl@0: WORD PrintNameLength; sl@0: WCHAR PathBuffer[1]; sl@0: } SymbolicLinkReparseBuffer; sl@0: struct { sl@0: WORD SubstituteNameOffset; sl@0: WORD SubstituteNameLength; sl@0: WORD PrintNameOffset; sl@0: WORD PrintNameLength; sl@0: WCHAR PathBuffer[1]; sl@0: } MountPointReparseBuffer; sl@0: struct { sl@0: BYTE DataBuffer[1]; sl@0: } GenericReparseBuffer; sl@0: }; sl@0: } REPARSE_DATA_BUFFER; sl@0: #endif sl@0: sl@0: typedef struct { sl@0: REPARSE_DATA_BUFFER dummy; sl@0: WCHAR dummyBuf[MAX_PATH*3]; sl@0: } DUMMY_REPARSE_BUFFER; sl@0: sl@0: #if defined(_MSC_VER) && ( _MSC_VER <= 1100 ) sl@0: #define HAVE_NO_FINDEX_ENUMS sl@0: #elif !defined(_WIN32_WINNT) || (_WIN32_WINNT < 0x0400) sl@0: #define HAVE_NO_FINDEX_ENUMS sl@0: #endif sl@0: sl@0: #ifdef HAVE_NO_FINDEX_ENUMS sl@0: /* These two aren't in VC++ 5.2 headers */ sl@0: typedef enum _FINDEX_INFO_LEVELS { sl@0: FindExInfoStandard, sl@0: FindExInfoMaxInfoLevel sl@0: } FINDEX_INFO_LEVELS; sl@0: typedef enum _FINDEX_SEARCH_OPS { sl@0: FindExSearchNameMatch, sl@0: FindExSearchLimitToDirectories, sl@0: FindExSearchLimitToDevices, sl@0: FindExSearchMaxSearchOp sl@0: } FINDEX_SEARCH_OPS; sl@0: #endif /* HAVE_NO_FINDEX_ENUMS */ sl@0: sl@0: /* Other typedefs required by this code */ sl@0: sl@0: static time_t ToCTime(FILETIME fileTime); sl@0: static void FromCTime(time_t posixTime, FILETIME *fileTime); sl@0: sl@0: typedef NET_API_STATUS NET_API_FUNCTION NETUSERGETINFOPROC sl@0: (LPWSTR servername, LPWSTR username, DWORD level, LPBYTE *bufptr); sl@0: sl@0: typedef NET_API_STATUS NET_API_FUNCTION NETAPIBUFFERFREEPROC sl@0: (LPVOID Buffer); sl@0: sl@0: typedef NET_API_STATUS NET_API_FUNCTION NETGETDCNAMEPROC sl@0: (LPWSTR servername, LPWSTR domainname, LPBYTE *bufptr); sl@0: sl@0: /* sl@0: * Declarations for local procedures defined in this file: sl@0: */ sl@0: sl@0: static int NativeAccess(CONST TCHAR *path, int mode); sl@0: static int NativeStat(CONST TCHAR *path, Tcl_StatBuf *statPtr, int checkLinks); sl@0: static unsigned short NativeStatMode(DWORD attr, int checkLinks, int isExec); sl@0: static int NativeIsExec(CONST TCHAR *path); sl@0: static int NativeReadReparse(CONST TCHAR* LinkDirectory, sl@0: REPARSE_DATA_BUFFER* buffer); sl@0: static int NativeWriteReparse(CONST TCHAR* LinkDirectory, sl@0: REPARSE_DATA_BUFFER* buffer); sl@0: static int NativeMatchType(int isDrive, DWORD attr, CONST TCHAR* nativeName, sl@0: Tcl_GlobTypeData *types); sl@0: static int WinIsDrive(CONST char *name, int nameLen); sl@0: static int WinIsReserved(CONST char *path); sl@0: static Tcl_Obj* WinReadLink(CONST TCHAR* LinkSource); sl@0: static Tcl_Obj* WinReadLinkDirectory(CONST TCHAR* LinkDirectory); sl@0: static int WinLink(CONST TCHAR* LinkSource, CONST TCHAR* LinkTarget, sl@0: int linkAction); sl@0: static int WinSymLinkDirectory(CONST TCHAR* LinkDirectory, sl@0: CONST TCHAR* LinkTarget); sl@0: sl@0: /* sl@0: *-------------------------------------------------------------------- sl@0: * sl@0: * WinLink sl@0: * sl@0: * Make a link from source to target. sl@0: *-------------------------------------------------------------------- sl@0: */ sl@0: static int sl@0: WinLink(LinkSource, LinkTarget, linkAction) sl@0: CONST TCHAR* LinkSource; sl@0: CONST TCHAR* LinkTarget; sl@0: int linkAction; sl@0: { sl@0: WCHAR tempFileName[MAX_PATH]; sl@0: TCHAR* tempFilePart; sl@0: int attr; sl@0: sl@0: /* Get the full path referenced by the target */ sl@0: if (!(*tclWinProcs->getFullPathNameProc)(LinkTarget, sl@0: MAX_PATH, tempFileName, &tempFilePart)) { sl@0: /* Invalid file */ sl@0: TclWinConvertError(GetLastError()); sl@0: return -1; sl@0: } sl@0: sl@0: /* Make sure source file doesn't exist */ sl@0: attr = (*tclWinProcs->getFileAttributesProc)(LinkSource); sl@0: if (attr != 0xffffffff) { sl@0: Tcl_SetErrno(EEXIST); sl@0: return -1; sl@0: } sl@0: sl@0: /* Get the full path referenced by the directory */ sl@0: if (!(*tclWinProcs->getFullPathNameProc)(LinkSource, sl@0: MAX_PATH, tempFileName, &tempFilePart)) { sl@0: /* Invalid file */ sl@0: TclWinConvertError(GetLastError()); sl@0: return -1; sl@0: } sl@0: /* Check the target */ sl@0: attr = (*tclWinProcs->getFileAttributesProc)(LinkTarget); sl@0: if (attr == 0xffffffff) { sl@0: /* The target doesn't exist */ sl@0: TclWinConvertError(GetLastError()); sl@0: return -1; sl@0: } else if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) { sl@0: /* It is a file */ sl@0: if (tclWinProcs->createHardLinkProc == NULL) { sl@0: Tcl_SetErrno(ENOTDIR); sl@0: return -1; sl@0: } sl@0: if (linkAction & TCL_CREATE_HARD_LINK) { sl@0: if (!(*tclWinProcs->createHardLinkProc)(LinkSource, LinkTarget, NULL)) { sl@0: TclWinConvertError(GetLastError()); sl@0: return -1; sl@0: } sl@0: return 0; sl@0: } else if (linkAction & TCL_CREATE_SYMBOLIC_LINK) { sl@0: /* Can't symlink files */ sl@0: Tcl_SetErrno(ENOTDIR); sl@0: return -1; sl@0: } else { sl@0: Tcl_SetErrno(ENODEV); sl@0: return -1; sl@0: } sl@0: } else { sl@0: if (linkAction & TCL_CREATE_SYMBOLIC_LINK) { sl@0: return WinSymLinkDirectory(LinkSource, LinkTarget); sl@0: } else if (linkAction & TCL_CREATE_HARD_LINK) { sl@0: /* Can't hard link directories */ sl@0: Tcl_SetErrno(EISDIR); sl@0: return -1; sl@0: } else { sl@0: Tcl_SetErrno(ENODEV); sl@0: return -1; sl@0: } sl@0: } sl@0: } sl@0: sl@0: /* sl@0: *-------------------------------------------------------------------- sl@0: * sl@0: * WinReadLink sl@0: * sl@0: * What does 'LinkSource' point to? sl@0: *-------------------------------------------------------------------- sl@0: */ sl@0: static Tcl_Obj* sl@0: WinReadLink(LinkSource) sl@0: CONST TCHAR* LinkSource; sl@0: { sl@0: WCHAR tempFileName[MAX_PATH]; sl@0: TCHAR* tempFilePart; sl@0: int attr; sl@0: sl@0: /* Get the full path referenced by the target */ sl@0: if (!(*tclWinProcs->getFullPathNameProc)(LinkSource, sl@0: MAX_PATH, tempFileName, &tempFilePart)) { sl@0: /* Invalid file */ sl@0: TclWinConvertError(GetLastError()); sl@0: return NULL; sl@0: } sl@0: sl@0: /* Make sure source file does exist */ sl@0: attr = (*tclWinProcs->getFileAttributesProc)(LinkSource); sl@0: if (attr == 0xffffffff) { sl@0: /* The source doesn't exist */ sl@0: TclWinConvertError(GetLastError()); sl@0: return NULL; sl@0: } else if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) { sl@0: /* It is a file - this is not yet supported */ sl@0: Tcl_SetErrno(ENOTDIR); sl@0: return NULL; sl@0: } else { sl@0: return WinReadLinkDirectory(LinkSource); sl@0: } sl@0: } sl@0: sl@0: /* sl@0: *-------------------------------------------------------------------- sl@0: * sl@0: * WinSymLinkDirectory sl@0: * sl@0: * This routine creates a NTFS junction, using the undocumented sl@0: * FSCTL_SET_REPARSE_POINT structure Win2K uses for mount points sl@0: * and junctions. sl@0: * sl@0: * Assumption that LinkTarget is a valid, existing directory. sl@0: * sl@0: * Returns zero on success. sl@0: *-------------------------------------------------------------------- sl@0: */ sl@0: static int sl@0: WinSymLinkDirectory(LinkDirectory, LinkTarget) sl@0: CONST TCHAR* LinkDirectory; sl@0: CONST TCHAR* LinkTarget; sl@0: { sl@0: DUMMY_REPARSE_BUFFER dummy; sl@0: REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER*)&dummy; sl@0: int len; sl@0: WCHAR nativeTarget[MAX_PATH]; sl@0: WCHAR *loop; sl@0: sl@0: /* Make the native target name */ sl@0: memcpy((VOID*)nativeTarget, (VOID*)L"\\??\\", 4*sizeof(WCHAR)); sl@0: memcpy((VOID*)(nativeTarget + 4), (VOID*)LinkTarget, sl@0: sizeof(WCHAR)*(1+wcslen((WCHAR*)LinkTarget))); sl@0: len = wcslen(nativeTarget); sl@0: /* sl@0: * We must have backslashes only. This is VERY IMPORTANT. sl@0: * If we have any forward slashes everything appears to work, sl@0: * but the resulting symlink is useless! sl@0: */ sl@0: for (loop = nativeTarget; *loop != 0; loop++) { sl@0: if (*loop == L'/') *loop = L'\\'; sl@0: } sl@0: if ((nativeTarget[len-1] == L'\\') && (nativeTarget[len-2] != L':')) { sl@0: nativeTarget[len-1] = 0; sl@0: } sl@0: sl@0: /* Build the reparse info */ sl@0: memset(reparseBuffer, 0, sizeof(DUMMY_REPARSE_BUFFER)); sl@0: reparseBuffer->ReparseTag = IO_REPARSE_TAG_MOUNT_POINT; sl@0: reparseBuffer->SymbolicLinkReparseBuffer.SubstituteNameLength = sl@0: wcslen(nativeTarget) * sizeof(WCHAR); sl@0: reparseBuffer->Reserved = 0; sl@0: reparseBuffer->SymbolicLinkReparseBuffer.PrintNameLength = 0; sl@0: reparseBuffer->SymbolicLinkReparseBuffer.PrintNameOffset = sl@0: reparseBuffer->SymbolicLinkReparseBuffer.SubstituteNameLength sl@0: + sizeof(WCHAR); sl@0: memcpy(reparseBuffer->SymbolicLinkReparseBuffer.PathBuffer, nativeTarget, sl@0: sizeof(WCHAR) sl@0: + reparseBuffer->SymbolicLinkReparseBuffer.SubstituteNameLength); sl@0: reparseBuffer->ReparseDataLength = sl@0: reparseBuffer->SymbolicLinkReparseBuffer.SubstituteNameLength + 12; sl@0: sl@0: return NativeWriteReparse(LinkDirectory, reparseBuffer); sl@0: } sl@0: sl@0: /* sl@0: *-------------------------------------------------------------------- sl@0: * sl@0: * TclWinSymLinkCopyDirectory sl@0: * sl@0: * Copy a Windows NTFS junction. This function assumes that sl@0: * LinkOriginal exists and is a valid junction point, and that sl@0: * LinkCopy does not exist. sl@0: * sl@0: * Returns zero on success. sl@0: *-------------------------------------------------------------------- sl@0: */ sl@0: int sl@0: TclWinSymLinkCopyDirectory(LinkOriginal, LinkCopy) sl@0: CONST TCHAR* LinkOriginal; /* Existing junction - reparse point */ sl@0: CONST TCHAR* LinkCopy; /* Will become a duplicate junction */ sl@0: { sl@0: DUMMY_REPARSE_BUFFER dummy; sl@0: REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER*)&dummy; sl@0: sl@0: if (NativeReadReparse(LinkOriginal, reparseBuffer)) { sl@0: return -1; sl@0: } sl@0: return NativeWriteReparse(LinkCopy, reparseBuffer); sl@0: } sl@0: sl@0: /* sl@0: *-------------------------------------------------------------------- sl@0: * sl@0: * TclWinSymLinkDelete sl@0: * sl@0: * Delete a Windows NTFS junction. Once the junction information sl@0: * is deleted, the filesystem object becomes an ordinary directory. sl@0: * Unless 'linkOnly' is given, that directory is also removed. sl@0: * sl@0: * Assumption that LinkOriginal is a valid, existing junction. sl@0: * sl@0: * Returns zero on success. sl@0: *-------------------------------------------------------------------- sl@0: */ sl@0: int sl@0: TclWinSymLinkDelete(LinkOriginal, linkOnly) sl@0: CONST TCHAR* LinkOriginal; sl@0: int linkOnly; sl@0: { sl@0: /* It is a symbolic link -- remove it */ sl@0: DUMMY_REPARSE_BUFFER dummy; sl@0: REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER*)&dummy; sl@0: HANDLE hFile; sl@0: DWORD returnedLength; sl@0: memset(reparseBuffer, 0, sizeof(DUMMY_REPARSE_BUFFER)); sl@0: reparseBuffer->ReparseTag = IO_REPARSE_TAG_MOUNT_POINT; sl@0: hFile = (*tclWinProcs->createFileProc)(LinkOriginal, GENERIC_WRITE, 0, sl@0: NULL, OPEN_EXISTING, sl@0: FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, NULL); sl@0: if (hFile != INVALID_HANDLE_VALUE) { sl@0: if (!DeviceIoControl(hFile, FSCTL_DELETE_REPARSE_POINT, reparseBuffer, sl@0: REPARSE_MOUNTPOINT_HEADER_SIZE, sl@0: NULL, 0, &returnedLength, NULL)) { sl@0: /* Error setting junction */ sl@0: TclWinConvertError(GetLastError()); sl@0: CloseHandle(hFile); sl@0: } else { sl@0: CloseHandle(hFile); sl@0: if (!linkOnly) { sl@0: (*tclWinProcs->removeDirectoryProc)(LinkOriginal); sl@0: } sl@0: return 0; sl@0: } sl@0: } sl@0: return -1; sl@0: } sl@0: sl@0: /* sl@0: *-------------------------------------------------------------------- sl@0: * sl@0: * WinReadLinkDirectory sl@0: * sl@0: * This routine reads a NTFS junction, using the undocumented sl@0: * FSCTL_GET_REPARSE_POINT structure Win2K uses for mount points sl@0: * and junctions. sl@0: * sl@0: * Assumption that LinkDirectory is a valid, existing directory. sl@0: * sl@0: * Returns a Tcl_Obj with refCount of 1 (i.e. owned by the caller), sl@0: * or NULL if anything went wrong. sl@0: * sl@0: * In the future we should enhance this to return a path object sl@0: * rather than a string. sl@0: *-------------------------------------------------------------------- sl@0: */ sl@0: static Tcl_Obj* sl@0: WinReadLinkDirectory(LinkDirectory) sl@0: CONST TCHAR* LinkDirectory; sl@0: { sl@0: int attr; sl@0: DUMMY_REPARSE_BUFFER dummy; sl@0: REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER*)&dummy; sl@0: sl@0: attr = (*tclWinProcs->getFileAttributesProc)(LinkDirectory); sl@0: if (!(attr & FILE_ATTRIBUTE_REPARSE_POINT)) { sl@0: Tcl_SetErrno(EINVAL); sl@0: return NULL; sl@0: } sl@0: if (NativeReadReparse(LinkDirectory, reparseBuffer)) { sl@0: return NULL; sl@0: } sl@0: sl@0: switch (reparseBuffer->ReparseTag) { sl@0: case 0x80000000|IO_REPARSE_TAG_SYMBOLIC_LINK: sl@0: case IO_REPARSE_TAG_SYMBOLIC_LINK: sl@0: case IO_REPARSE_TAG_MOUNT_POINT: { sl@0: Tcl_Obj *retVal; sl@0: Tcl_DString ds; sl@0: CONST char *copy; sl@0: int len; sl@0: int offset = 0; sl@0: sl@0: /* sl@0: * Certain native path representations on Windows have a sl@0: * special prefix to indicate that they are to be treated sl@0: * specially. For example extremely long paths, or symlinks, sl@0: * or volumes mounted inside directories. sl@0: * sl@0: * There is an assumption in this code that 'wide' interfaces sl@0: * are being used (see tclWin32Dll.c), which is true for the sl@0: * only systems which support reparse tags at present. If sl@0: * that changes in the future, this code will have to be sl@0: * generalised. sl@0: */ sl@0: if (reparseBuffer->SymbolicLinkReparseBuffer.PathBuffer[0] sl@0: == L'\\') { sl@0: /* Check whether this is a mounted volume */ sl@0: if (wcsncmp(reparseBuffer->SymbolicLinkReparseBuffer.PathBuffer, sl@0: L"\\??\\Volume{",11) == 0) { sl@0: char drive; sl@0: /* sl@0: * There is some confusion between \??\ and \\?\ which sl@0: * we have to fix here. It doesn't seem very well sl@0: * documented. sl@0: */ sl@0: reparseBuffer->SymbolicLinkReparseBuffer sl@0: .PathBuffer[1] = L'\\'; sl@0: /* sl@0: * Check if a corresponding drive letter exists, and sl@0: * use that if it is found sl@0: */ sl@0: drive = TclWinDriveLetterForVolMountPoint(reparseBuffer sl@0: ->SymbolicLinkReparseBuffer.PathBuffer); sl@0: if (drive != -1) { sl@0: char driveSpec[3] = { sl@0: drive, ':', '\0' sl@0: }; sl@0: retVal = Tcl_NewStringObj(driveSpec,2); sl@0: Tcl_IncrRefCount(retVal); sl@0: return retVal; sl@0: } sl@0: /* sl@0: * This is actually a mounted drive, which doesn't sl@0: * exists as a DOS drive letter. This means the path sl@0: * isn't actually a link, although we partially treat sl@0: * it like one ('file type' will return 'link'), but sl@0: * then the link will actually just be treated like sl@0: * an ordinary directory. I don't believe any sl@0: * serious inconsistency will arise from this, but it sl@0: * is something to be aware of. sl@0: */ sl@0: Tcl_SetErrno(EINVAL); sl@0: return NULL; sl@0: } else if (wcsncmp(reparseBuffer->SymbolicLinkReparseBuffer sl@0: .PathBuffer, L"\\\\?\\",4) == 0) { sl@0: /* Strip off the prefix */ sl@0: offset = 4; sl@0: } else if (wcsncmp(reparseBuffer->SymbolicLinkReparseBuffer sl@0: .PathBuffer, L"\\??\\",4) == 0) { sl@0: /* Strip off the prefix */ sl@0: offset = 4; sl@0: } sl@0: } sl@0: sl@0: Tcl_WinTCharToUtf( sl@0: (CONST char*)reparseBuffer->SymbolicLinkReparseBuffer.PathBuffer, sl@0: (int)reparseBuffer->SymbolicLinkReparseBuffer sl@0: .SubstituteNameLength, &ds); sl@0: sl@0: copy = Tcl_DStringValue(&ds)+offset; sl@0: len = Tcl_DStringLength(&ds)-offset; sl@0: retVal = Tcl_NewStringObj(copy,len); sl@0: Tcl_IncrRefCount(retVal); sl@0: Tcl_DStringFree(&ds); sl@0: return retVal; sl@0: } sl@0: } sl@0: Tcl_SetErrno(EINVAL); sl@0: return NULL; sl@0: } sl@0: sl@0: /* sl@0: *-------------------------------------------------------------------- sl@0: * sl@0: * NativeReadReparse sl@0: * sl@0: * Read the junction/reparse information from a given NTFS directory. sl@0: * sl@0: * Assumption that LinkDirectory is a valid, existing directory. sl@0: * sl@0: * Returns zero on success. sl@0: *-------------------------------------------------------------------- sl@0: */ sl@0: static int sl@0: NativeReadReparse(LinkDirectory, buffer) sl@0: CONST TCHAR* LinkDirectory; /* The junction to read */ sl@0: REPARSE_DATA_BUFFER* buffer; /* Pointer to buffer. Cannot be NULL */ sl@0: { sl@0: HANDLE hFile; sl@0: DWORD returnedLength; sl@0: sl@0: hFile = (*tclWinProcs->createFileProc)(LinkDirectory, GENERIC_READ, 0, sl@0: NULL, OPEN_EXISTING, sl@0: FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, NULL); sl@0: if (hFile == INVALID_HANDLE_VALUE) { sl@0: /* Error creating directory */ sl@0: TclWinConvertError(GetLastError()); sl@0: return -1; sl@0: } sl@0: /* Get the link */ sl@0: if (!DeviceIoControl(hFile, FSCTL_GET_REPARSE_POINT, NULL, sl@0: 0, buffer, sizeof(DUMMY_REPARSE_BUFFER), sl@0: &returnedLength, NULL)) { sl@0: /* Error setting junction */ sl@0: TclWinConvertError(GetLastError()); sl@0: CloseHandle(hFile); sl@0: return -1; sl@0: } sl@0: CloseHandle(hFile); sl@0: sl@0: if (!IsReparseTagValid(buffer->ReparseTag)) { sl@0: Tcl_SetErrno(EINVAL); sl@0: return -1; sl@0: } sl@0: return 0; sl@0: } sl@0: sl@0: /* sl@0: *-------------------------------------------------------------------- sl@0: * sl@0: * NativeWriteReparse sl@0: * sl@0: * Write the reparse information for a given directory. sl@0: * sl@0: * Assumption that LinkDirectory does not exist. sl@0: *-------------------------------------------------------------------- sl@0: */ sl@0: static int sl@0: NativeWriteReparse(LinkDirectory, buffer) sl@0: CONST TCHAR* LinkDirectory; sl@0: REPARSE_DATA_BUFFER* buffer; sl@0: { sl@0: HANDLE hFile; sl@0: DWORD returnedLength; sl@0: sl@0: /* Create the directory - it must not already exist */ sl@0: if ((*tclWinProcs->createDirectoryProc)(LinkDirectory, NULL) == 0) { sl@0: /* Error creating directory */ sl@0: TclWinConvertError(GetLastError()); sl@0: return -1; sl@0: } sl@0: hFile = (*tclWinProcs->createFileProc)(LinkDirectory, GENERIC_WRITE, 0, sl@0: NULL, OPEN_EXISTING, sl@0: FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, NULL); sl@0: if (hFile == INVALID_HANDLE_VALUE) { sl@0: /* Error creating directory */ sl@0: TclWinConvertError(GetLastError()); sl@0: return -1; sl@0: } sl@0: /* Set the link */ sl@0: if (!DeviceIoControl(hFile, FSCTL_SET_REPARSE_POINT, buffer, sl@0: (DWORD) buffer->ReparseDataLength sl@0: + REPARSE_MOUNTPOINT_HEADER_SIZE, sl@0: NULL, 0, &returnedLength, NULL)) { sl@0: /* Error setting junction */ sl@0: TclWinConvertError(GetLastError()); sl@0: CloseHandle(hFile); sl@0: (*tclWinProcs->removeDirectoryProc)(LinkDirectory); sl@0: return -1; sl@0: } sl@0: CloseHandle(hFile); sl@0: /* We succeeded */ sl@0: return 0; sl@0: } sl@0: sl@0: /* sl@0: *--------------------------------------------------------------------------- sl@0: * sl@0: * TclpFindExecutable -- sl@0: * sl@0: * This procedure computes the absolute path name of the current sl@0: * application, given its argv[0] value. sl@0: * sl@0: * Results: sl@0: * A clean UTF string that is the path to the executable. At this sl@0: * point we may not know the system encoding, but we convert the sl@0: * string value to UTF-8 using core Windows functions. The path name sl@0: * contains ASCII string and '/' chars do not conflict with other UTF sl@0: * chars. sl@0: * sl@0: * Side effects: sl@0: * The variable tclNativeExecutableName gets filled in with the file sl@0: * name for the application, if we figured it out. If we couldn't sl@0: * figure it out, tclNativeExecutableName is set to NULL. sl@0: * sl@0: *--------------------------------------------------------------------------- sl@0: */ sl@0: sl@0: char * sl@0: TclpFindExecutable(argv0) sl@0: CONST char *argv0; /* The value of the application's argv[0] sl@0: * (native). */ sl@0: { sl@0: WCHAR wName[MAX_PATH]; sl@0: char name[MAX_PATH * TCL_UTF_MAX]; sl@0: sl@0: if (argv0 == NULL) { sl@0: return NULL; sl@0: } sl@0: if (tclNativeExecutableName != NULL) { sl@0: return tclNativeExecutableName; sl@0: } sl@0: sl@0: /* sl@0: * Under Windows we ignore argv0, and return the path for the file used to sl@0: * create this process. sl@0: */ sl@0: sl@0: if (GetModuleFileNameW(NULL, wName, MAX_PATH) == 0) { sl@0: GetModuleFileNameA(NULL, name, sizeof(name)); sl@0: } else { sl@0: WideCharToMultiByte(CP_UTF8, 0, wName, -1, sl@0: name, sizeof(name), NULL, NULL); sl@0: } sl@0: sl@0: tclNativeExecutableName = ckalloc((unsigned) (strlen(name) + 1)); sl@0: strcpy(tclNativeExecutableName, name); sl@0: sl@0: TclWinNoBackslash(tclNativeExecutableName); sl@0: return tclNativeExecutableName; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * TclpMatchInDirectory -- sl@0: * sl@0: * This routine is used by the globbing code to search a sl@0: * directory for all files which match a given pattern. sl@0: * sl@0: * Results: sl@0: * sl@0: * The return value is a standard Tcl result indicating whether an sl@0: * error occurred in globbing. Errors are left in interp, good sl@0: * results are lappended to resultPtr (which must be a valid object) sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *---------------------------------------------------------------------- */ sl@0: sl@0: int sl@0: TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) sl@0: Tcl_Interp *interp; /* Interpreter to receive errors. */ sl@0: Tcl_Obj *resultPtr; /* List object to lappend results. */ sl@0: Tcl_Obj *pathPtr; /* Contains path to directory to search. */ sl@0: CONST char *pattern; /* Pattern to match against. */ sl@0: Tcl_GlobTypeData *types; /* Object containing list of acceptable types. sl@0: * May be NULL. In particular the directory sl@0: * flag is very important. */ sl@0: { sl@0: CONST TCHAR *native; sl@0: sl@0: if (pattern == NULL || (*pattern == '\0')) { sl@0: Tcl_Obj *norm = Tcl_FSGetNormalizedPath(NULL, pathPtr); sl@0: if (norm != NULL) { sl@0: /* Match a single file directly */ sl@0: int len; sl@0: DWORD attr; sl@0: CONST char *str = Tcl_GetStringFromObj(norm,&len); sl@0: sl@0: native = (CONST TCHAR*) Tcl_FSGetNativePath(pathPtr); sl@0: sl@0: if (tclWinProcs->getFileAttributesExProc == NULL) { sl@0: attr = (*tclWinProcs->getFileAttributesProc)(native); sl@0: if (attr == 0xffffffff) { sl@0: return TCL_OK; sl@0: } sl@0: } else { sl@0: WIN32_FILE_ATTRIBUTE_DATA data; sl@0: if ((*tclWinProcs->getFileAttributesExProc)(native, sl@0: GetFileExInfoStandard, &data) != TRUE) { sl@0: return TCL_OK; sl@0: } sl@0: attr = data.dwFileAttributes; sl@0: } sl@0: if (NativeMatchType(WinIsDrive(str,len), attr, sl@0: native, types)) { sl@0: Tcl_ListObjAppendElement(interp, resultPtr, pathPtr); sl@0: } sl@0: } sl@0: return TCL_OK; sl@0: } else { sl@0: DWORD attr; sl@0: HANDLE handle; sl@0: WIN32_FIND_DATAT data; sl@0: CONST char *dirName; sl@0: int dirLength; sl@0: int matchSpecialDots; sl@0: Tcl_DString ds; /* native encoding of dir */ sl@0: Tcl_DString dsOrig; /* utf-8 encoding of dir */ sl@0: Tcl_DString dirString; /* utf-8 encoding of dir with \'s */ sl@0: Tcl_Obj *fileNamePtr; sl@0: sl@0: /* sl@0: * Convert the path to normalized form since some interfaces only sl@0: * accept backslashes. Also, ensure that the directory ends with a sl@0: * separator character. sl@0: */ sl@0: sl@0: fileNamePtr = Tcl_FSGetTranslatedPath(interp, pathPtr); sl@0: if (fileNamePtr == NULL) { sl@0: return TCL_ERROR; sl@0: } sl@0: Tcl_DStringInit(&dsOrig); sl@0: dirName = Tcl_GetStringFromObj(fileNamePtr, &dirLength); sl@0: Tcl_DStringAppend(&dsOrig, dirName, dirLength); sl@0: sl@0: Tcl_DStringInit(&dirString); sl@0: if (dirLength == 0) { sl@0: Tcl_DStringAppend(&dirString, ".\\", 2); sl@0: } else { sl@0: char *p; sl@0: sl@0: Tcl_DStringAppend(&dirString, dirName, dirLength); sl@0: for (p = Tcl_DStringValue(&dirString); *p != '\0'; p++) { sl@0: if (*p == '/') { sl@0: *p = '\\'; sl@0: } sl@0: } sl@0: p--; sl@0: /* Make sure we have a trailing directory delimiter */ sl@0: if ((*p != '\\') && (*p != ':')) { sl@0: Tcl_DStringAppend(&dirString, "\\", 1); sl@0: Tcl_DStringAppend(&dsOrig, "/", 1); sl@0: dirLength++; sl@0: } sl@0: } sl@0: dirName = Tcl_DStringValue(&dirString); sl@0: Tcl_DecrRefCount(fileNamePtr); sl@0: sl@0: /* sl@0: * First verify that the specified path is actually a directory. sl@0: */ sl@0: sl@0: native = Tcl_WinUtfToTChar(dirName, Tcl_DStringLength(&dirString), sl@0: &ds); sl@0: attr = (*tclWinProcs->getFileAttributesProc)(native); sl@0: Tcl_DStringFree(&ds); sl@0: sl@0: if ((attr == 0xffffffff) || ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0)) { sl@0: Tcl_DStringFree(&dirString); sl@0: return TCL_OK; sl@0: } sl@0: sl@0: /* sl@0: * We need to check all files in the directory, so append a *.* sl@0: * to the path. sl@0: */ sl@0: sl@0: dirName = Tcl_DStringAppend(&dirString, "*.*", 3); sl@0: native = Tcl_WinUtfToTChar(dirName, -1, &ds); sl@0: handle = (*tclWinProcs->findFirstFileProc)(native, &data); sl@0: sl@0: if (handle == INVALID_HANDLE_VALUE) { sl@0: TclWinConvertError(GetLastError()); sl@0: Tcl_DStringFree(&ds); sl@0: Tcl_DStringFree(&dirString); sl@0: Tcl_ResetResult(interp); sl@0: Tcl_AppendResult(interp, "couldn't read directory \"", sl@0: Tcl_DStringValue(&dsOrig), "\": ", sl@0: Tcl_PosixError(interp), (char *) NULL); sl@0: Tcl_DStringFree(&dsOrig); sl@0: return TCL_ERROR; sl@0: } sl@0: Tcl_DStringFree(&ds); sl@0: sl@0: /* sl@0: * Check to see if the pattern should match the special sl@0: * . and .. names, referring to the current directory, sl@0: * or the directory above. We need a special check for sl@0: * this because paths beginning with a dot are not considered sl@0: * hidden on Windows, and so otherwise a relative glob like sl@0: * 'glob -join * *' will actually return './. ../..' etc. sl@0: */ sl@0: sl@0: if ((pattern[0] == '.') sl@0: || ((pattern[0] == '\\') && (pattern[1] == '.'))) { sl@0: matchSpecialDots = 1; sl@0: } else { sl@0: matchSpecialDots = 0; sl@0: } sl@0: sl@0: /* sl@0: * Now iterate over all of the files in the directory, starting sl@0: * with the first one we found. sl@0: */ sl@0: sl@0: do { sl@0: CONST char *utfname; sl@0: int checkDrive = 0; sl@0: int isDrive; sl@0: DWORD attr; sl@0: sl@0: if (tclWinProcs->useWide) { sl@0: native = (CONST TCHAR *) data.w.cFileName; sl@0: attr = data.w.dwFileAttributes; sl@0: } else { sl@0: native = (CONST TCHAR *) data.a.cFileName; sl@0: attr = data.a.dwFileAttributes; sl@0: } sl@0: sl@0: utfname = Tcl_WinTCharToUtf(native, -1, &ds); sl@0: sl@0: if (!matchSpecialDots) { sl@0: /* If it is exactly '.' or '..' then we ignore it */ sl@0: if ((utfname[0] == '.') && (utfname[1] == '\0' sl@0: || (utfname[1] == '.' && utfname[2] == '\0'))) { sl@0: Tcl_DStringFree(&ds); sl@0: continue; sl@0: } sl@0: } else if (utfname[0] == '.' && utfname[1] == '.' sl@0: && utfname[2] == '\0') { sl@0: /* sl@0: * Have to check if this is a drive below, so we can sl@0: * correctly match 'hidden' and not hidden files. sl@0: */ sl@0: checkDrive = 1; sl@0: } sl@0: sl@0: /* sl@0: * Check to see if the file matches the pattern. Note that sl@0: * we are ignoring the case sensitivity flag because Windows sl@0: * doesn't honor case even if the volume is case sensitive. sl@0: * If the volume also doesn't preserve case, then we sl@0: * previously returned the lower case form of the name. This sl@0: * didn't seem quite right since there are sl@0: * non-case-preserving volumes that actually return mixed sl@0: * case. So now we are returning exactly what we get from sl@0: * the system. sl@0: */ sl@0: sl@0: if (Tcl_StringCaseMatch(utfname, pattern, 1)) { sl@0: /* sl@0: * If the file matches, then we need to process the remainder sl@0: * of the path. sl@0: */ sl@0: sl@0: if (checkDrive) { sl@0: CONST char *fullname = Tcl_DStringAppend(&dsOrig, utfname, sl@0: Tcl_DStringLength(&ds)); sl@0: isDrive = WinIsDrive(fullname, Tcl_DStringLength(&dsOrig)); sl@0: Tcl_DStringSetLength(&dsOrig, dirLength); sl@0: } else { sl@0: isDrive = 0; sl@0: } sl@0: if (NativeMatchType(isDrive, attr, native, types)) { sl@0: Tcl_ListObjAppendElement(interp, resultPtr, sl@0: TclNewFSPathObj(pathPtr, utfname, sl@0: Tcl_DStringLength(&ds))); sl@0: } sl@0: } sl@0: sl@0: /* sl@0: * Free ds here to ensure that native is valid above. sl@0: */ sl@0: Tcl_DStringFree(&ds); sl@0: } while ((*tclWinProcs->findNextFileProc)(handle, &data) == TRUE); sl@0: sl@0: FindClose(handle); sl@0: Tcl_DStringFree(&dirString); sl@0: Tcl_DStringFree(&dsOrig); sl@0: return TCL_OK; sl@0: } sl@0: } sl@0: sl@0: /* sl@0: * Does the given path represent a root volume? We need this special sl@0: * case because for NTFS root volumes, the getFileAttributesProc returns sl@0: * a 'hidden' attribute when it should not. sl@0: */ sl@0: static int sl@0: WinIsDrive( sl@0: CONST char *name, /* Name (UTF-8) */ sl@0: int len) /* Length of name */ sl@0: { sl@0: int remove = 0; sl@0: while (len > 4) { sl@0: if ((name[len-1] != '.' || name[len-2] != '.') sl@0: || (name[len-3] != '/' && name[len-3] != '\\')) { sl@0: /* We don't have '/..' at the end */ sl@0: if (remove == 0) { sl@0: break; sl@0: } sl@0: remove--; sl@0: while (len > 0) { sl@0: len--; sl@0: if (name[len] == '/' || name[len] == '\\') { sl@0: break; sl@0: } sl@0: } sl@0: if (len < 4) { sl@0: len++; sl@0: break; sl@0: } sl@0: } else { sl@0: /* We do have '/..' */ sl@0: len -= 3; sl@0: remove++; sl@0: } sl@0: } sl@0: if (len < 4) { sl@0: if (len == 0) { sl@0: /* sl@0: * Not sure if this is possible, but we pass it on sl@0: * anyway sl@0: */ sl@0: } else if (len == 1 && (name[0] == '/' || name[0] == '\\')) { sl@0: /* Path is pointing to the root volume */ sl@0: return 1; sl@0: } else if ((name[1] == ':') sl@0: && (len == 2 || (name[2] == '/' || name[2] == '\\'))) { sl@0: /* Path is of the form 'x:' or 'x:/' or 'x:\' */ sl@0: return 1; sl@0: } sl@0: } sl@0: return 0; sl@0: } sl@0: sl@0: /* sl@0: * Does the given path represent a reserved window path name? If not sl@0: * return 0, if true, return the number of characters of the path that sl@0: * we actually want (not any trailing :). sl@0: */ sl@0: static int WinIsReserved( sl@0: CONST char *path) /* Path in UTF-8 */ sl@0: { sl@0: if ((path[0] == 'c' || path[0] == 'C') sl@0: && (path[1] == 'o' || path[1] == 'O')) { sl@0: if ((path[2] == 'm' || path[2] == 'M') sl@0: && path[3] >= '1' && path[3] <= '4') { sl@0: /* May have match for 'com[1-4]:?', which is a serial port */ sl@0: if (path[4] == '\0') { sl@0: return 4; sl@0: } else if (path [4] == ':' && path[5] == '\0') { sl@0: return 4; sl@0: } sl@0: } else if ((path[2] == 'n' || path[2] == 'N') && path[3] == '\0') { sl@0: /* Have match for 'con' */ sl@0: return 3; sl@0: } sl@0: } else if ((path[0] == 'l' || path[0] == 'L') sl@0: && (path[1] == 'p' || path[1] == 'P') sl@0: && (path[2] == 't' || path[2] == 'T')) { sl@0: if (path[3] >= '1' && path[3] <= '3') { sl@0: /* May have match for 'lpt[1-3]:?' */ sl@0: if (path[4] == '\0') { sl@0: return 4; sl@0: } else if (path [4] == ':' && path[5] == '\0') { sl@0: return 4; sl@0: } sl@0: } sl@0: } else if (stricmp(path, "prn") == 0) { sl@0: /* Have match for 'prn' */ sl@0: return 3; sl@0: } else if (stricmp(path, "nul") == 0) { sl@0: /* Have match for 'nul' */ sl@0: return 3; sl@0: } else if (stricmp(path, "aux") == 0) { sl@0: /* Have match for 'aux' */ sl@0: return 3; sl@0: } sl@0: return 0; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * NativeMatchType -- sl@0: * sl@0: * This function needs a special case for a path which is a root sl@0: * volume, because for NTFS root volumes, the getFileAttributesProc sl@0: * returns a 'hidden' attribute when it should not. sl@0: * sl@0: * We never make any calss to a 'get attributes' routine here, sl@0: * since we have arranged things so that our caller already knows sl@0: * such information. sl@0: * sl@0: * Results: sl@0: * 0 = file doesn't match sl@0: * 1 = file matches sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: static int sl@0: NativeMatchType( sl@0: int isDrive, /* Is this a drive */ sl@0: DWORD attr, /* We already know the attributes sl@0: * for the file */ sl@0: CONST TCHAR* nativeName, /* Native path to check */ sl@0: Tcl_GlobTypeData *types) /* Type description to match against */ sl@0: { sl@0: /* sl@0: * 'attr' represents the attributes of the file, but we only sl@0: * want to retrieve this info if it is absolutely necessary sl@0: * because it is an expensive call. Unfortunately, to deal sl@0: * with hidden files properly, we must always retrieve it. sl@0: */ sl@0: sl@0: if (types == NULL) { sl@0: /* If invisible, don't return the file */ sl@0: if (attr & FILE_ATTRIBUTE_HIDDEN && !isDrive) { sl@0: return 0; sl@0: } sl@0: } else { sl@0: if (attr & FILE_ATTRIBUTE_HIDDEN && !isDrive) { sl@0: /* If invisible */ sl@0: if ((types->perm == 0) || sl@0: !(types->perm & TCL_GLOB_PERM_HIDDEN)) { sl@0: return 0; sl@0: } sl@0: } else { sl@0: /* Visible */ sl@0: if (types->perm & TCL_GLOB_PERM_HIDDEN) { sl@0: return 0; sl@0: } sl@0: } sl@0: sl@0: if (types->perm != 0) { sl@0: if ( sl@0: ((types->perm & TCL_GLOB_PERM_RONLY) && sl@0: !(attr & FILE_ATTRIBUTE_READONLY)) || sl@0: ((types->perm & TCL_GLOB_PERM_R) && sl@0: (0 /* File exists => R_OK on Windows */)) || sl@0: ((types->perm & TCL_GLOB_PERM_W) && sl@0: (attr & FILE_ATTRIBUTE_READONLY)) || sl@0: ((types->perm & TCL_GLOB_PERM_X) && sl@0: (!(attr & FILE_ATTRIBUTE_DIRECTORY) sl@0: && !NativeIsExec(nativeName))) sl@0: ) { sl@0: return 0; sl@0: } sl@0: } sl@0: if ((types->type & TCL_GLOB_TYPE_DIR) sl@0: && (attr & FILE_ATTRIBUTE_DIRECTORY)) { sl@0: /* Quicker test for directory, which is a common case */ sl@0: return 1; sl@0: } else if (types->type != 0) { sl@0: unsigned short st_mode; sl@0: int isExec = NativeIsExec(nativeName); sl@0: sl@0: st_mode = NativeStatMode(attr, 0, isExec); sl@0: sl@0: /* sl@0: * In order bcdpfls as in 'find -t' sl@0: */ sl@0: if ( sl@0: ((types->type & TCL_GLOB_TYPE_BLOCK) && sl@0: S_ISBLK(st_mode)) || sl@0: ((types->type & TCL_GLOB_TYPE_CHAR) && sl@0: S_ISCHR(st_mode)) || sl@0: ((types->type & TCL_GLOB_TYPE_DIR) && sl@0: S_ISDIR(st_mode)) || sl@0: ((types->type & TCL_GLOB_TYPE_PIPE) && sl@0: S_ISFIFO(st_mode)) || sl@0: ((types->type & TCL_GLOB_TYPE_FILE) && sl@0: S_ISREG(st_mode)) sl@0: #ifdef S_ISSOCK sl@0: || ((types->type & TCL_GLOB_TYPE_SOCK) && sl@0: S_ISSOCK(st_mode)) sl@0: #endif sl@0: ) { sl@0: /* Do nothing -- this file is ok */ sl@0: } else { sl@0: #ifdef S_ISLNK sl@0: if (types->type & TCL_GLOB_TYPE_LINK) { sl@0: st_mode = NativeStatMode(attr, 1, isExec); sl@0: if (S_ISLNK(st_mode)) { sl@0: return 1; sl@0: } sl@0: } sl@0: #endif sl@0: return 0; sl@0: } sl@0: } sl@0: } sl@0: return 1; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * TclpGetUserHome -- sl@0: * sl@0: * This function takes the passed in user name and finds the sl@0: * corresponding home directory specified in the password file. sl@0: * sl@0: * Results: sl@0: * The result is a pointer to a string specifying the user's home sl@0: * directory, or NULL if the user's home directory could not be sl@0: * determined. Storage for the result string is allocated in sl@0: * bufferPtr; the caller must call Tcl_DStringFree() when the result sl@0: * is no longer needed. sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: char * sl@0: TclpGetUserHome(name, bufferPtr) sl@0: CONST char *name; /* User name for desired home directory. */ sl@0: Tcl_DString *bufferPtr; /* Uninitialized or free DString filled sl@0: * with name of user's home directory. */ sl@0: { sl@0: char *result; sl@0: HINSTANCE netapiInst; sl@0: sl@0: result = NULL; sl@0: sl@0: Tcl_DStringInit(bufferPtr); sl@0: sl@0: netapiInst = LoadLibraryA("netapi32.dll"); sl@0: if (netapiInst != NULL) { sl@0: NETAPIBUFFERFREEPROC *netApiBufferFreeProc; sl@0: NETGETDCNAMEPROC *netGetDCNameProc; sl@0: NETUSERGETINFOPROC *netUserGetInfoProc; sl@0: sl@0: netApiBufferFreeProc = (NETAPIBUFFERFREEPROC *) sl@0: GetProcAddress(netapiInst, "NetApiBufferFree"); sl@0: netGetDCNameProc = (NETGETDCNAMEPROC *) sl@0: GetProcAddress(netapiInst, "NetGetDCName"); sl@0: netUserGetInfoProc = (NETUSERGETINFOPROC *) sl@0: GetProcAddress(netapiInst, "NetUserGetInfo"); sl@0: if ((netUserGetInfoProc != NULL) && (netGetDCNameProc != NULL) sl@0: && (netApiBufferFreeProc != NULL)) { sl@0: USER_INFO_1 *uiPtr; sl@0: Tcl_DString ds; sl@0: int nameLen, badDomain; sl@0: char *domain; sl@0: WCHAR *wName, *wHomeDir, *wDomain; sl@0: WCHAR buf[MAX_PATH]; sl@0: sl@0: badDomain = 0; sl@0: nameLen = -1; sl@0: wDomain = NULL; sl@0: domain = strchr(name, '@'); sl@0: if (domain != NULL) { sl@0: Tcl_DStringInit(&ds); sl@0: wName = Tcl_UtfToUniCharDString(domain + 1, -1, &ds); sl@0: badDomain = (*netGetDCNameProc)(NULL, wName, sl@0: (LPBYTE *) &wDomain); sl@0: Tcl_DStringFree(&ds); sl@0: nameLen = domain - name; sl@0: } sl@0: if (badDomain == 0) { sl@0: Tcl_DStringInit(&ds); sl@0: wName = Tcl_UtfToUniCharDString(name, nameLen, &ds); sl@0: if ((*netUserGetInfoProc)(wDomain, wName, 1, sl@0: (LPBYTE *) &uiPtr) == 0) { sl@0: wHomeDir = uiPtr->usri1_home_dir; sl@0: if ((wHomeDir != NULL) && (wHomeDir[0] != L'\0')) { sl@0: Tcl_UniCharToUtfDString(wHomeDir, lstrlenW(wHomeDir), sl@0: bufferPtr); sl@0: } else { sl@0: /* sl@0: * User exists but has no home dir. Return sl@0: * "{Windows Drive}:/users/default". sl@0: */ sl@0: sl@0: GetWindowsDirectoryW(buf, MAX_PATH); sl@0: Tcl_UniCharToUtfDString(buf, 2, bufferPtr); sl@0: Tcl_DStringAppend(bufferPtr, "/users/default", -1); sl@0: } sl@0: result = Tcl_DStringValue(bufferPtr); sl@0: (*netApiBufferFreeProc)((void *) uiPtr); sl@0: } sl@0: Tcl_DStringFree(&ds); sl@0: } sl@0: if (wDomain != NULL) { sl@0: (*netApiBufferFreeProc)((void *) wDomain); sl@0: } sl@0: } sl@0: FreeLibrary(netapiInst); sl@0: } sl@0: if (result == NULL) { sl@0: /* sl@0: * Look in the "Password Lists" section of system.ini for the sl@0: * local user. There are also entries in that section that begin sl@0: * with a "*" character that are used by Windows for other sl@0: * purposes; ignore user names beginning with a "*". sl@0: */ sl@0: sl@0: char buf[MAX_PATH]; sl@0: sl@0: if (name[0] != '*') { sl@0: if (GetPrivateProfileStringA("Password Lists", name, "", buf, sl@0: MAX_PATH, "system.ini") > 0) { sl@0: /* sl@0: * User exists, but there is no such thing as a home sl@0: * directory in system.ini. Return "{Windows drive}:/". sl@0: */ sl@0: sl@0: GetWindowsDirectoryA(buf, MAX_PATH); sl@0: Tcl_DStringAppend(bufferPtr, buf, 3); sl@0: result = Tcl_DStringValue(bufferPtr); sl@0: } sl@0: } sl@0: } sl@0: sl@0: return result; sl@0: } sl@0: sl@0: /* sl@0: *--------------------------------------------------------------------------- sl@0: * sl@0: * NativeAccess -- sl@0: * sl@0: * This function replaces the library version of access(), fixing the sl@0: * following bugs: sl@0: * sl@0: * 1. access() returns that all files have execute permission. sl@0: * sl@0: * Results: sl@0: * See access documentation. sl@0: * sl@0: * Side effects: sl@0: * See access documentation. sl@0: * sl@0: *--------------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static int sl@0: NativeAccess( sl@0: CONST TCHAR *nativePath, /* Path of file to access (UTF-8). */ sl@0: int mode) /* Permission setting. */ sl@0: { sl@0: DWORD attr; sl@0: sl@0: attr = (*tclWinProcs->getFileAttributesProc)(nativePath); sl@0: sl@0: if (attr == 0xffffffff) { sl@0: /* sl@0: * File doesn't exist. sl@0: */ sl@0: sl@0: TclWinConvertError(GetLastError()); sl@0: return -1; sl@0: } sl@0: sl@0: if ((mode & W_OK) sl@0: && (tclWinProcs->getFileSecurityProc == NULL) sl@0: && (attr & FILE_ATTRIBUTE_READONLY)) { sl@0: /* sl@0: * We don't have the advanced 'getFileSecurityProc', and sl@0: * our attributes say the file is not writable. If we sl@0: * do have 'getFileSecurityProc', we'll do a more sl@0: * robust XP-related check below. sl@0: */ sl@0: sl@0: Tcl_SetErrno(EACCES); sl@0: return -1; sl@0: } sl@0: sl@0: if (mode & X_OK) { sl@0: if (!(attr & FILE_ATTRIBUTE_DIRECTORY) && !NativeIsExec(nativePath)) { sl@0: /* sl@0: * It's not a directory and doesn't have the correct extension. sl@0: * Therefore it can't be executable sl@0: */ sl@0: sl@0: Tcl_SetErrno(EACCES); sl@0: return -1; sl@0: } sl@0: } sl@0: sl@0: /* sl@0: * It looks as if the permissions are ok, but if we are on NT, 2000 or XP, sl@0: * we have a more complex permissions structure so we try to check that. sl@0: * The code below is remarkably complex for such a simple thing as finding sl@0: * what permissions the OS has set for a file. sl@0: * sl@0: * If we are simply checking for file existence, then we don't need all sl@0: * these complications (which are really quite slow: with this code 'file sl@0: * readable' is 5-6 times slower than 'file exists'). sl@0: */ sl@0: sl@0: if ((mode != F_OK) && (tclWinProcs->getFileSecurityProc != NULL)) { sl@0: SECURITY_DESCRIPTOR *sdPtr = NULL; sl@0: unsigned long size; sl@0: GENERIC_MAPPING genMap; sl@0: HANDLE hToken = NULL; sl@0: DWORD desiredAccess = 0; sl@0: DWORD grantedAccess = 0; sl@0: BOOL accessYesNo = FALSE; sl@0: PRIVILEGE_SET privSet; sl@0: DWORD privSetSize = sizeof(PRIVILEGE_SET); sl@0: int error; sl@0: sl@0: /* sl@0: * First find out how big the buffer needs to be sl@0: */ sl@0: sl@0: size = 0; sl@0: (*tclWinProcs->getFileSecurityProc)(nativePath, sl@0: OWNER_SECURITY_INFORMATION | GROUP_SECURITY_INFORMATION sl@0: | DACL_SECURITY_INFORMATION, 0, 0, &size); sl@0: sl@0: /* sl@0: * Should have failed with ERROR_INSUFFICIENT_BUFFER sl@0: */ sl@0: sl@0: error = GetLastError(); sl@0: if (error != ERROR_INSUFFICIENT_BUFFER) { sl@0: /* sl@0: * Most likely case is ERROR_ACCESS_DENIED, which we will convert sl@0: * to EACCES - just what we want! sl@0: */ sl@0: sl@0: TclWinConvertError((DWORD)error); sl@0: return -1; sl@0: } sl@0: sl@0: /* sl@0: * Now size contains the size of buffer needed sl@0: */ sl@0: sl@0: sdPtr = (SECURITY_DESCRIPTOR *) HeapAlloc(GetProcessHeap(), 0, size); sl@0: sl@0: if (sdPtr == NULL) { sl@0: goto accessError; sl@0: } sl@0: sl@0: /* sl@0: * Call GetFileSecurity() for real sl@0: */ sl@0: sl@0: if (!(*tclWinProcs->getFileSecurityProc)(nativePath, sl@0: OWNER_SECURITY_INFORMATION | GROUP_SECURITY_INFORMATION sl@0: | DACL_SECURITY_INFORMATION, sdPtr, size, &size)) { sl@0: /* sl@0: * Error getting owner SD sl@0: */ sl@0: sl@0: goto accessError; sl@0: } sl@0: sl@0: /* sl@0: * Perform security impersonation of the user and open the sl@0: * resulting thread token. sl@0: */ sl@0: sl@0: if (!(*tclWinProcs->impersonateSelfProc)(SecurityImpersonation)) { sl@0: /* sl@0: * Unable to perform security impersonation. sl@0: */ sl@0: sl@0: goto accessError; sl@0: } sl@0: if (!(*tclWinProcs->openThreadTokenProc)(GetCurrentThread (), sl@0: TOKEN_DUPLICATE | TOKEN_QUERY, FALSE, &hToken)) { sl@0: /* sl@0: * Unable to get current thread's token. sl@0: */ sl@0: sl@0: goto accessError; sl@0: } sl@0: sl@0: (*tclWinProcs->revertToSelfProc)(); sl@0: sl@0: /* sl@0: * Setup desiredAccess according to the access priveleges we are sl@0: * checking. sl@0: */ sl@0: sl@0: if (mode & R_OK) { sl@0: desiredAccess |= FILE_GENERIC_READ; sl@0: } sl@0: if (mode & W_OK) { sl@0: desiredAccess |= FILE_GENERIC_WRITE; sl@0: } sl@0: if (mode & X_OK) { sl@0: desiredAccess |= FILE_GENERIC_EXECUTE; sl@0: } sl@0: sl@0: memset (&genMap, 0x0, sizeof (GENERIC_MAPPING)); sl@0: genMap.GenericRead = FILE_GENERIC_READ; sl@0: genMap.GenericWrite = FILE_GENERIC_WRITE; sl@0: genMap.GenericExecute = FILE_GENERIC_EXECUTE; sl@0: genMap.GenericAll = FILE_ALL_ACCESS; sl@0: sl@0: /* sl@0: * Perform access check using the token. sl@0: */ sl@0: sl@0: if (!(*tclWinProcs->accessCheckProc)(sdPtr, hToken, desiredAccess, sl@0: &genMap, &privSet, &privSetSize, &grantedAccess, sl@0: &accessYesNo)) { sl@0: /* sl@0: * Unable to perform access check. sl@0: */ sl@0: sl@0: accessError: sl@0: TclWinConvertError(GetLastError()); sl@0: if (sdPtr != NULL) { sl@0: HeapFree(GetProcessHeap(), 0, sdPtr); sl@0: } sl@0: if (hToken != NULL) { sl@0: CloseHandle(hToken); sl@0: } sl@0: return -1; sl@0: } sl@0: sl@0: /* sl@0: * Clean up. sl@0: */ sl@0: sl@0: HeapFree(GetProcessHeap (), 0, sdPtr); sl@0: CloseHandle(hToken); sl@0: if (!accessYesNo) { sl@0: Tcl_SetErrno(EACCES); sl@0: return -1; sl@0: } sl@0: /* sl@0: * For directories the above checks are ok. For files, though, sl@0: * we must still check the 'attr' value. sl@0: */ sl@0: if ((mode & W_OK) sl@0: && !(attr & FILE_ATTRIBUTE_DIRECTORY) sl@0: && (attr & FILE_ATTRIBUTE_READONLY)) { sl@0: Tcl_SetErrno(EACCES); sl@0: return -1; sl@0: } sl@0: } sl@0: return 0; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * NativeIsExec -- sl@0: * sl@0: * Determines if a path is executable. On windows this is sl@0: * simply defined by whether the path ends in any of ".exe", sl@0: * ".com", or ".bat" sl@0: * sl@0: * Results: sl@0: * 1 = executable, 0 = not. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: static int sl@0: NativeIsExec(nativePath) sl@0: CONST TCHAR *nativePath; sl@0: { sl@0: if (tclWinProcs->useWide) { sl@0: CONST WCHAR *path; sl@0: int len; sl@0: sl@0: path = (CONST WCHAR*)nativePath; sl@0: len = wcslen(path); sl@0: sl@0: if (len < 5) { sl@0: return 0; sl@0: } sl@0: sl@0: if (path[len-4] != L'.') { sl@0: return 0; sl@0: } sl@0: sl@0: /* sl@0: * Use wide-char case-insensitive comparison sl@0: */ sl@0: if ((_wcsicmp(path+len-3,L"exe") == 0) sl@0: || (_wcsicmp(path+len-3,L"com") == 0) sl@0: || (_wcsicmp(path+len-3,L"bat") == 0)) { sl@0: return 1; sl@0: } sl@0: } else { sl@0: CONST char *p; sl@0: sl@0: /* We are only looking for pure ascii */ sl@0: sl@0: p = strrchr((CONST char*)nativePath, '.'); sl@0: if (p != NULL) { sl@0: p++; sl@0: /* sl@0: * Note: in the old code, stat considered '.pif' files as sl@0: * executable, whereas access did not. sl@0: */ sl@0: if ((stricmp(p, "exe") == 0) sl@0: || (stricmp(p, "com") == 0) sl@0: || (stricmp(p, "bat") == 0)) { sl@0: /* sl@0: * File that ends with .exe, .com, or .bat is executable. sl@0: */ sl@0: sl@0: return 1; sl@0: } sl@0: } sl@0: } sl@0: return 0; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * TclpObjChdir -- sl@0: * sl@0: * This function replaces the library version of chdir(). sl@0: * sl@0: * Results: sl@0: * See chdir() documentation. sl@0: * sl@0: * Side effects: sl@0: * See chdir() documentation. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: int sl@0: TclpObjChdir(pathPtr) sl@0: Tcl_Obj *pathPtr; /* Path to new working directory. */ sl@0: { sl@0: int result; sl@0: CONST TCHAR *nativePath; sl@0: #ifdef __CYGWIN__ sl@0: extern int cygwin_conv_to_posix_path sl@0: _ANSI_ARGS_((CONST char *, char *)); sl@0: char posixPath[MAX_PATH+1]; sl@0: CONST char *path; sl@0: Tcl_DString ds; sl@0: #endif /* __CYGWIN__ */ sl@0: sl@0: nativePath = (CONST TCHAR *) Tcl_FSGetNativePath(pathPtr); sl@0: #ifdef __CYGWIN__ sl@0: /* Cygwin chdir only groks POSIX path. */ sl@0: path = Tcl_WinTCharToUtf(nativePath, -1, &ds); sl@0: cygwin_conv_to_posix_path(path, posixPath); sl@0: result = (chdir(posixPath) == 0 ? 1 : 0); sl@0: Tcl_DStringFree(&ds); sl@0: #else /* __CYGWIN__ */ sl@0: result = (*tclWinProcs->setCurrentDirectoryProc)(nativePath); sl@0: #endif /* __CYGWIN__ */ sl@0: sl@0: if (result == 0) { sl@0: TclWinConvertError(GetLastError()); sl@0: return -1; sl@0: } sl@0: return 0; sl@0: } sl@0: sl@0: #ifdef __CYGWIN__ sl@0: /* sl@0: *--------------------------------------------------------------------------- sl@0: * sl@0: * TclpReadlink -- sl@0: * sl@0: * This function replaces the library version of readlink(). sl@0: * sl@0: * Results: sl@0: * The result is a pointer to a string specifying the contents sl@0: * of the symbolic link given by 'path', or NULL if the symbolic sl@0: * link could not be read. Storage for the result string is sl@0: * allocated in bufferPtr; the caller must call Tcl_DStringFree() sl@0: * when the result is no longer needed. sl@0: * sl@0: * Side effects: sl@0: * See readlink() documentation. sl@0: * sl@0: *--------------------------------------------------------------------------- sl@0: */ sl@0: sl@0: char * sl@0: TclpReadlink(path, linkPtr) sl@0: CONST char *path; /* Path of file to readlink (UTF-8). */ sl@0: Tcl_DString *linkPtr; /* Uninitialized or free DString filled sl@0: * with contents of link (UTF-8). */ sl@0: { sl@0: char link[MAXPATHLEN]; sl@0: int length; sl@0: char *native; sl@0: Tcl_DString ds; sl@0: sl@0: native = Tcl_UtfToExternalDString(NULL, path, -1, &ds); sl@0: length = readlink(native, link, sizeof(link)); /* INTL: Native. */ sl@0: Tcl_DStringFree(&ds); sl@0: sl@0: if (length < 0) { sl@0: return NULL; sl@0: } sl@0: sl@0: Tcl_ExternalToUtfDString(NULL, link, length, linkPtr); sl@0: return Tcl_DStringValue(linkPtr); sl@0: } sl@0: #endif /* __CYGWIN__ */ sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * TclpGetCwd -- sl@0: * sl@0: * This function replaces the library version of getcwd(). sl@0: * sl@0: * Results: sl@0: * The result is a pointer to a string specifying the current sl@0: * directory, or NULL if the current directory could not be sl@0: * determined. If NULL is returned, an error message is left in the sl@0: * interp's result. Storage for the result string is allocated in sl@0: * bufferPtr; the caller must call Tcl_DStringFree() when the result sl@0: * is no longer needed. sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: CONST char * sl@0: TclpGetCwd(interp, bufferPtr) sl@0: Tcl_Interp *interp; /* If non-NULL, used for error reporting. */ sl@0: Tcl_DString *bufferPtr; /* Uninitialized or free DString filled sl@0: * with name of current directory. */ sl@0: { sl@0: WCHAR buffer[MAX_PATH]; sl@0: char *p; sl@0: sl@0: if ((*tclWinProcs->getCurrentDirectoryProc)(MAX_PATH, buffer) == 0) { sl@0: TclWinConvertError(GetLastError()); sl@0: if (interp != NULL) { sl@0: Tcl_AppendResult(interp, sl@0: "error getting working directory name: ", sl@0: Tcl_PosixError(interp), (char *) NULL); sl@0: } sl@0: return NULL; sl@0: } sl@0: sl@0: /* sl@0: * Watch for the weird Windows c:\\UNC syntax. sl@0: */ sl@0: sl@0: if (tclWinProcs->useWide) { sl@0: WCHAR *native; sl@0: sl@0: native = (WCHAR *) buffer; sl@0: if ((native[0] != '\0') && (native[1] == ':') sl@0: && (native[2] == '\\') && (native[3] == '\\')) { sl@0: native += 2; sl@0: } sl@0: Tcl_WinTCharToUtf((TCHAR *) native, -1, bufferPtr); sl@0: } else { sl@0: char *native; sl@0: sl@0: native = (char *) buffer; sl@0: if ((native[0] != '\0') && (native[1] == ':') sl@0: && (native[2] == '\\') && (native[3] == '\\')) { sl@0: native += 2; sl@0: } sl@0: Tcl_WinTCharToUtf((TCHAR *) native, -1, bufferPtr); sl@0: } sl@0: sl@0: /* sl@0: * Convert to forward slashes for easier use in scripts. sl@0: */ sl@0: sl@0: for (p = Tcl_DStringValue(bufferPtr); *p != '\0'; p++) { sl@0: if (*p == '\\') { sl@0: *p = '/'; sl@0: } sl@0: } sl@0: return Tcl_DStringValue(bufferPtr); sl@0: } sl@0: sl@0: int sl@0: TclpObjStat(pathPtr, statPtr) sl@0: Tcl_Obj *pathPtr; /* Path of file to stat */ sl@0: Tcl_StatBuf *statPtr; /* Filled with results of stat call. */ sl@0: { sl@0: #ifdef OLD_API sl@0: Tcl_Obj *transPtr; sl@0: /* sl@0: * Eliminate file names containing wildcard characters, or subsequent sl@0: * call to FindFirstFile() will expand them, matching some other file. sl@0: */ sl@0: sl@0: transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr); sl@0: if (transPtr == NULL || (strpbrk(Tcl_GetString(transPtr), "?*") != NULL)) { sl@0: if (transPtr != NULL) { sl@0: Tcl_DecrRefCount(transPtr); sl@0: } sl@0: Tcl_SetErrno(ENOENT); sl@0: return -1; sl@0: } sl@0: Tcl_DecrRefCount(transPtr); sl@0: #endif sl@0: sl@0: /* sl@0: * Ensure correct file sizes by forcing the OS to write any sl@0: * pending data to disk. This is done only for channels which are sl@0: * dirty, i.e. have been written to since the last flush here. sl@0: */ sl@0: sl@0: TclWinFlushDirtyChannels (); sl@0: sl@0: return NativeStat((CONST TCHAR*) Tcl_FSGetNativePath(pathPtr), statPtr, 0); sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * NativeStat -- sl@0: * sl@0: * This function replaces the library version of stat(), fixing sl@0: * the following bugs: sl@0: * sl@0: * 1. stat("c:") returns an error. sl@0: * 2. Borland stat() return time in GMT instead of localtime. sl@0: * 3. stat("\\server\mount") would return error. sl@0: * 4. Accepts slashes or backslashes. sl@0: * 5. st_dev and st_rdev were wrong for UNC paths. sl@0: * sl@0: * Results: sl@0: * See stat documentation. sl@0: * sl@0: * Side effects: sl@0: * See stat documentation. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static int sl@0: NativeStat(nativePath, statPtr, checkLinks) sl@0: CONST TCHAR *nativePath; /* Path of file to stat */ sl@0: Tcl_StatBuf *statPtr; /* Filled with results of stat call. */ sl@0: int checkLinks; /* If non-zero, behave like 'lstat' */ sl@0: { sl@0: Tcl_DString ds; sl@0: DWORD attr; sl@0: WCHAR nativeFullPath[MAX_PATH]; sl@0: TCHAR *nativePart; sl@0: CONST char *fullPath; sl@0: int dev; sl@0: unsigned short mode; sl@0: sl@0: if (tclWinProcs->getFileAttributesExProc == NULL) { sl@0: /* sl@0: * We don't have the faster attributes proc, so we're sl@0: * probably running on Win95 sl@0: */ sl@0: WIN32_FIND_DATAT data; sl@0: HANDLE handle; sl@0: sl@0: handle = (*tclWinProcs->findFirstFileProc)(nativePath, &data); sl@0: if (handle == INVALID_HANDLE_VALUE) { sl@0: /* sl@0: * FindFirstFile() doesn't work on root directories, so call sl@0: * GetFileAttributes() to see if the specified file exists. sl@0: */ sl@0: sl@0: attr = (*tclWinProcs->getFileAttributesProc)(nativePath); sl@0: if (attr == INVALID_FILE_ATTRIBUTES) { sl@0: Tcl_SetErrno(ENOENT); sl@0: return -1; sl@0: } sl@0: sl@0: /* sl@0: * Make up some fake information for this file. It has the sl@0: * correct file attributes and a time of 0. sl@0: */ sl@0: sl@0: memset(&data, 0, sizeof(data)); sl@0: data.a.dwFileAttributes = attr; sl@0: } else { sl@0: FindClose(handle); sl@0: } sl@0: sl@0: sl@0: (*tclWinProcs->getFullPathNameProc)(nativePath, MAX_PATH, nativeFullPath, sl@0: &nativePart); sl@0: sl@0: fullPath = Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds); sl@0: sl@0: dev = -1; sl@0: if ((fullPath[0] == '\\') && (fullPath[1] == '\\')) { sl@0: CONST char *p; sl@0: DWORD dw; sl@0: CONST TCHAR *nativeVol; sl@0: Tcl_DString volString; sl@0: sl@0: p = strchr(fullPath + 2, '\\'); sl@0: p = strchr(p + 1, '\\'); sl@0: if (p == NULL) { sl@0: /* sl@0: * Add terminating backslash to fullpath or sl@0: * GetVolumeInformation() won't work. sl@0: */ sl@0: sl@0: fullPath = Tcl_DStringAppend(&ds, "\\", 1); sl@0: p = fullPath + Tcl_DStringLength(&ds); sl@0: } else { sl@0: p++; sl@0: } sl@0: nativeVol = Tcl_WinUtfToTChar(fullPath, p - fullPath, &volString); sl@0: dw = (DWORD) -1; sl@0: (*tclWinProcs->getVolumeInformationProc)(nativeVol, NULL, 0, &dw, sl@0: NULL, NULL, NULL, 0); sl@0: /* sl@0: * GetFullPathName() turns special devices like "NUL" into sl@0: * "\\.\NUL", but GetVolumeInformation() returns failure for sl@0: * "\\.\NUL". This will cause "NUL" to get a drive number of sl@0: * -1, which makes about as much sense as anything since the sl@0: * special devices don't live on any drive. sl@0: */ sl@0: sl@0: dev = dw; sl@0: Tcl_DStringFree(&volString); sl@0: } else if ((fullPath[0] != '\0') && (fullPath[1] == ':')) { sl@0: dev = Tcl_UniCharToLower(fullPath[0]) - 'a'; sl@0: } sl@0: Tcl_DStringFree(&ds); sl@0: sl@0: attr = data.a.dwFileAttributes; sl@0: sl@0: statPtr->st_size = ((Tcl_WideInt)data.a.nFileSizeLow) | sl@0: (((Tcl_WideInt)data.a.nFileSizeHigh) << 32); sl@0: statPtr->st_atime = ToCTime(data.a.ftLastAccessTime); sl@0: statPtr->st_mtime = ToCTime(data.a.ftLastWriteTime); sl@0: statPtr->st_ctime = ToCTime(data.a.ftCreationTime); sl@0: } else { sl@0: WIN32_FILE_ATTRIBUTE_DATA data; sl@0: if((*tclWinProcs->getFileAttributesExProc)(nativePath, sl@0: GetFileExInfoStandard, sl@0: &data) != TRUE) { sl@0: Tcl_SetErrno(ENOENT); sl@0: return -1; sl@0: } sl@0: sl@0: sl@0: (*tclWinProcs->getFullPathNameProc)(nativePath, MAX_PATH, sl@0: nativeFullPath, &nativePart); sl@0: sl@0: fullPath = Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds); sl@0: sl@0: dev = -1; sl@0: if ((fullPath[0] == '\\') && (fullPath[1] == '\\')) { sl@0: CONST char *p; sl@0: DWORD dw; sl@0: CONST TCHAR *nativeVol; sl@0: Tcl_DString volString; sl@0: sl@0: p = strchr(fullPath + 2, '\\'); sl@0: p = strchr(p + 1, '\\'); sl@0: if (p == NULL) { sl@0: /* sl@0: * Add terminating backslash to fullpath or sl@0: * GetVolumeInformation() won't work. sl@0: */ sl@0: sl@0: fullPath = Tcl_DStringAppend(&ds, "\\", 1); sl@0: p = fullPath + Tcl_DStringLength(&ds); sl@0: } else { sl@0: p++; sl@0: } sl@0: nativeVol = Tcl_WinUtfToTChar(fullPath, p - fullPath, &volString); sl@0: dw = (DWORD) -1; sl@0: (*tclWinProcs->getVolumeInformationProc)(nativeVol, NULL, 0, &dw, sl@0: NULL, NULL, NULL, 0); sl@0: /* sl@0: * GetFullPathName() turns special devices like "NUL" into sl@0: * "\\.\NUL", but GetVolumeInformation() returns failure for sl@0: * "\\.\NUL". This will cause "NUL" to get a drive number of sl@0: * -1, which makes about as much sense as anything since the sl@0: * special devices don't live on any drive. sl@0: */ sl@0: sl@0: dev = dw; sl@0: Tcl_DStringFree(&volString); sl@0: } else if ((fullPath[0] != '\0') && (fullPath[1] == ':')) { sl@0: dev = Tcl_UniCharToLower(fullPath[0]) - 'a'; sl@0: } sl@0: Tcl_DStringFree(&ds); sl@0: sl@0: attr = data.dwFileAttributes; sl@0: sl@0: statPtr->st_size = ((Tcl_WideInt)data.nFileSizeLow) | sl@0: (((Tcl_WideInt)data.nFileSizeHigh) << 32); sl@0: statPtr->st_atime = ToCTime(data.ftLastAccessTime); sl@0: statPtr->st_mtime = ToCTime(data.ftLastWriteTime); sl@0: statPtr->st_ctime = ToCTime(data.ftCreationTime); sl@0: } sl@0: sl@0: mode = NativeStatMode(attr, checkLinks, NativeIsExec(nativePath)); sl@0: sl@0: statPtr->st_dev = (dev_t) dev; sl@0: statPtr->st_ino = 0; sl@0: statPtr->st_mode = mode; sl@0: statPtr->st_nlink = 1; sl@0: statPtr->st_uid = 0; sl@0: statPtr->st_gid = 0; sl@0: statPtr->st_rdev = (dev_t) dev; sl@0: return 0; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * NativeStatMode -- sl@0: * sl@0: * Calculate just the 'st_mode' field of a 'stat' structure. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: static unsigned short sl@0: NativeStatMode(DWORD attr, int checkLinks, int isExec) sl@0: { sl@0: int mode; sl@0: if (checkLinks && (attr & FILE_ATTRIBUTE_REPARSE_POINT)) { sl@0: /* It is a link */ sl@0: mode = S_IFLNK; sl@0: } else { sl@0: mode = (attr & FILE_ATTRIBUTE_DIRECTORY) ? S_IFDIR | S_IEXEC : S_IFREG; sl@0: } sl@0: mode |= (attr & FILE_ATTRIBUTE_READONLY) ? S_IREAD : S_IREAD | S_IWRITE; sl@0: if (isExec) { sl@0: mode |= S_IEXEC; sl@0: } sl@0: sl@0: /* sl@0: * Propagate the S_IREAD, S_IWRITE, S_IEXEC bits to the group and sl@0: * other positions. sl@0: */ sl@0: sl@0: mode |= (mode & 0x0700) >> 3; sl@0: mode |= (mode & 0x0700) >> 6; sl@0: return (unsigned short)mode; sl@0: } sl@0: sl@0: /* sl@0: *------------------------------------------------------------------------ sl@0: * sl@0: * ToCTime -- sl@0: * sl@0: * Converts a Windows FILETIME to a time_t in UTC. sl@0: * sl@0: * Results: sl@0: * Returns the count of seconds from the Posix epoch. sl@0: * sl@0: *------------------------------------------------------------------------ sl@0: */ sl@0: sl@0: static time_t sl@0: ToCTime( sl@0: FILETIME fileTime) /* UTC time */ sl@0: { sl@0: LARGE_INTEGER convertedTime; sl@0: sl@0: convertedTime.LowPart = fileTime.dwLowDateTime; sl@0: convertedTime.HighPart = (LONG) fileTime.dwHighDateTime; sl@0: sl@0: return (time_t) ((convertedTime.QuadPart sl@0: - (Tcl_WideInt) POSIX_EPOCH_AS_FILETIME) / (Tcl_WideInt) 10000000); sl@0: } sl@0: sl@0: /* sl@0: *------------------------------------------------------------------------ sl@0: * sl@0: * FromCTime -- sl@0: * sl@0: * Converts a time_t to a Windows FILETIME sl@0: * sl@0: * Results: sl@0: * Returns the count of 100-ns ticks seconds from the Windows epoch. sl@0: * sl@0: *------------------------------------------------------------------------ sl@0: */ sl@0: sl@0: static void sl@0: FromCTime( sl@0: time_t posixTime, sl@0: FILETIME* fileTime) /* UTC Time */ sl@0: { sl@0: LARGE_INTEGER convertedTime; sl@0: convertedTime.QuadPart = ((LONGLONG) posixTime) * 10000000 sl@0: + POSIX_EPOCH_AS_FILETIME; sl@0: fileTime->dwLowDateTime = convertedTime.LowPart; sl@0: fileTime->dwHighDateTime = convertedTime.HighPart; sl@0: } sl@0: sl@0: #if 0 sl@0: /* sl@0: *------------------------------------------------------------------------- sl@0: * sl@0: * TclWinResolveShortcut -- sl@0: * sl@0: * Resolve a potential Windows shortcut to get the actual file or sl@0: * directory in question. sl@0: * sl@0: * Results: sl@0: * Returns 1 if the shortcut could be resolved, or 0 if there was sl@0: * an error or if the filename was not a shortcut. sl@0: * If bufferPtr did hold the name of a shortcut, it is modified to sl@0: * hold the resolved target of the shortcut instead. sl@0: * sl@0: * Side effects: sl@0: * Loads and unloads OLE package to determine if filename refers to sl@0: * a shortcut. sl@0: * sl@0: *------------------------------------------------------------------------- sl@0: */ sl@0: sl@0: int sl@0: TclWinResolveShortcut(bufferPtr) sl@0: Tcl_DString *bufferPtr; /* Holds name of file to resolve. On sl@0: * return, holds resolved file name. */ sl@0: { sl@0: HRESULT hres; sl@0: IShellLink *psl; sl@0: IPersistFile *ppf; sl@0: WIN32_FIND_DATA wfd; sl@0: WCHAR wpath[MAX_PATH]; sl@0: char *path, *ext; sl@0: char realFileName[MAX_PATH]; sl@0: sl@0: /* sl@0: * Windows system calls do not automatically resolve sl@0: * shortcuts like UNIX automatically will with symbolic links. sl@0: */ sl@0: sl@0: path = Tcl_DStringValue(bufferPtr); sl@0: ext = strrchr(path, '.'); sl@0: if ((ext == NULL) || (stricmp(ext, ".lnk") != 0)) { sl@0: return 0; sl@0: } sl@0: sl@0: CoInitialize(NULL); sl@0: path = Tcl_DStringValue(bufferPtr); sl@0: realFileName[0] = '\0'; sl@0: hres = CoCreateInstance(&CLSID_ShellLink, NULL, CLSCTX_INPROC_SERVER, sl@0: &IID_IShellLink, &psl); sl@0: if (SUCCEEDED(hres)) { sl@0: hres = psl->lpVtbl->QueryInterface(psl, &IID_IPersistFile, &ppf); sl@0: if (SUCCEEDED(hres)) { sl@0: MultiByteToWideChar(CP_ACP, 0, path, -1, wpath, sizeof(wpath)); sl@0: hres = ppf->lpVtbl->Load(ppf, wpath, STGM_READ); sl@0: if (SUCCEEDED(hres)) { sl@0: hres = psl->lpVtbl->Resolve(psl, NULL, sl@0: SLR_ANY_MATCH | SLR_NO_UI); sl@0: if (SUCCEEDED(hres)) { sl@0: hres = psl->lpVtbl->GetPath(psl, realFileName, MAX_PATH, sl@0: &wfd, 0); sl@0: } sl@0: } sl@0: ppf->lpVtbl->Release(ppf); sl@0: } sl@0: psl->lpVtbl->Release(psl); sl@0: } sl@0: CoUninitialize(); sl@0: sl@0: if (realFileName[0] != '\0') { sl@0: Tcl_DStringSetLength(bufferPtr, 0); sl@0: Tcl_DStringAppend(bufferPtr, realFileName, -1); sl@0: return 1; sl@0: } sl@0: return 0; sl@0: } sl@0: #endif sl@0: sl@0: Tcl_Obj* sl@0: TclpObjGetCwd(interp) sl@0: Tcl_Interp *interp; sl@0: { sl@0: Tcl_DString ds; sl@0: if (TclpGetCwd(interp, &ds) != NULL) { sl@0: Tcl_Obj *cwdPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); sl@0: Tcl_IncrRefCount(cwdPtr); sl@0: Tcl_DStringFree(&ds); sl@0: return cwdPtr; sl@0: } else { sl@0: return NULL; sl@0: } sl@0: } sl@0: sl@0: int sl@0: TclpObjAccess(pathPtr, mode) sl@0: Tcl_Obj *pathPtr; sl@0: int mode; sl@0: { sl@0: return NativeAccess((CONST TCHAR*) Tcl_FSGetNativePath(pathPtr), mode); sl@0: } sl@0: sl@0: int sl@0: TclpObjLstat(pathPtr, statPtr) sl@0: Tcl_Obj *pathPtr; sl@0: Tcl_StatBuf *statPtr; sl@0: { sl@0: /* sl@0: * Ensure correct file sizes by forcing the OS to write any sl@0: * pending data to disk. This is done only for channels which are sl@0: * dirty, i.e. have been written to since the last flush here. sl@0: */ sl@0: sl@0: TclWinFlushDirtyChannels (); sl@0: sl@0: return NativeStat((CONST TCHAR*) Tcl_FSGetNativePath(pathPtr), statPtr, 1); sl@0: } sl@0: sl@0: #ifdef S_IFLNK sl@0: sl@0: Tcl_Obj* sl@0: TclpObjLink(pathPtr, toPtr, linkAction) sl@0: Tcl_Obj *pathPtr; sl@0: Tcl_Obj *toPtr; sl@0: int linkAction; sl@0: { sl@0: if (toPtr != NULL) { sl@0: int res; sl@0: TCHAR* LinkTarget = (TCHAR*)Tcl_FSGetNativePath(toPtr); sl@0: TCHAR* LinkSource = (TCHAR*)Tcl_FSGetNativePath(pathPtr); sl@0: if (LinkSource == NULL || LinkTarget == NULL) { sl@0: return NULL; sl@0: } sl@0: res = WinLink(LinkSource, LinkTarget, linkAction); sl@0: if (res == 0) { sl@0: return toPtr; sl@0: } else { sl@0: return NULL; sl@0: } sl@0: } else { sl@0: TCHAR* LinkSource = (TCHAR*)Tcl_FSGetNativePath(pathPtr); sl@0: if (LinkSource == NULL) { sl@0: return NULL; sl@0: } sl@0: return WinReadLink(LinkSource); sl@0: } sl@0: } sl@0: sl@0: #endif sl@0: sl@0: sl@0: /* sl@0: *--------------------------------------------------------------------------- sl@0: * sl@0: * TclpFilesystemPathType -- sl@0: * sl@0: * This function is part of the native filesystem support, and sl@0: * returns the path type of the given path. Returns NTFS or FAT sl@0: * or whatever is returned by the 'volume information' proc. sl@0: * sl@0: * Results: sl@0: * NULL at present. sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *--------------------------------------------------------------------------- sl@0: */ sl@0: Tcl_Obj* sl@0: TclpFilesystemPathType(pathObjPtr) sl@0: Tcl_Obj* pathObjPtr; sl@0: { sl@0: #define VOL_BUF_SIZE 32 sl@0: int found; sl@0: WCHAR volType[VOL_BUF_SIZE]; sl@0: char* firstSeparator; sl@0: CONST char *path; sl@0: sl@0: Tcl_Obj *normPath = Tcl_FSGetNormalizedPath(NULL, pathObjPtr); sl@0: if (normPath == NULL) return NULL; sl@0: path = Tcl_GetString(normPath); sl@0: if (path == NULL) return NULL; sl@0: sl@0: firstSeparator = strchr(path, '/'); sl@0: if (firstSeparator == NULL) { sl@0: found = tclWinProcs->getVolumeInformationProc( sl@0: Tcl_FSGetNativePath(pathObjPtr), NULL, 0, NULL, NULL, sl@0: NULL, (WCHAR *)volType, VOL_BUF_SIZE); sl@0: } else { sl@0: Tcl_Obj *driveName = Tcl_NewStringObj(path, firstSeparator - path+1); sl@0: Tcl_IncrRefCount(driveName); sl@0: found = tclWinProcs->getVolumeInformationProc( sl@0: Tcl_FSGetNativePath(driveName), NULL, 0, NULL, NULL, sl@0: NULL, (WCHAR *)volType, VOL_BUF_SIZE); sl@0: Tcl_DecrRefCount(driveName); sl@0: } sl@0: sl@0: if (found == 0) { sl@0: return NULL; sl@0: } else { sl@0: Tcl_DString ds; sl@0: Tcl_Obj *objPtr; sl@0: sl@0: Tcl_WinTCharToUtf((CONST char *)volType, -1, &ds); sl@0: objPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds),Tcl_DStringLength(&ds)); sl@0: Tcl_DStringFree(&ds); sl@0: return objPtr; sl@0: } sl@0: #undef VOL_BUF_SIZE sl@0: } sl@0: sl@0: sl@0: /* sl@0: *--------------------------------------------------------------------------- sl@0: * sl@0: * TclpObjNormalizePath -- sl@0: * sl@0: * This function scans through a path specification and replaces it, sl@0: * in place, with a normalized version. This means using the sl@0: * 'longname', and expanding any symbolic links contained within the sl@0: * path. sl@0: * sl@0: * Results: sl@0: * The new 'nextCheckpoint' value, giving as far as we could sl@0: * understand in the path. sl@0: * sl@0: * Side effects: sl@0: * The pathPtr string, which must contain a valid path, is sl@0: * possibly modified in place. sl@0: * sl@0: *--------------------------------------------------------------------------- sl@0: */ sl@0: sl@0: int sl@0: TclpObjNormalizePath(interp, pathPtr, nextCheckpoint) sl@0: Tcl_Interp *interp; sl@0: Tcl_Obj *pathPtr; sl@0: int nextCheckpoint; sl@0: { sl@0: char *lastValidPathEnd = NULL; sl@0: /* This will hold the normalized string */ sl@0: Tcl_DString dsNorm; sl@0: char *path; sl@0: char *currentPathEndPosition; sl@0: sl@0: Tcl_DStringInit(&dsNorm); sl@0: path = Tcl_GetString(pathPtr); sl@0: sl@0: if (TclWinGetPlatformId() == VER_PLATFORM_WIN32_WINDOWS) { sl@0: /* sl@0: * We're on Win95, 98 or ME. There are two assumptions sl@0: * in this block of code. First that the native (NULL) sl@0: * encoding is basically ascii, and second that symbolic sl@0: * links are not possible. Both of these assumptions sl@0: * appear to be true of these operating systems. sl@0: */ sl@0: int isDrive = 1; sl@0: Tcl_DString ds; sl@0: sl@0: currentPathEndPosition = path + nextCheckpoint; sl@0: if (*currentPathEndPosition == '/') { sl@0: currentPathEndPosition++; sl@0: } sl@0: while (1) { sl@0: char cur = *currentPathEndPosition; sl@0: if ((cur == '/' || cur == 0) && (path != currentPathEndPosition)) { sl@0: /* Reached directory separator, or end of string */ sl@0: CONST char *nativePath = Tcl_UtfToExternalDString(NULL, path, sl@0: currentPathEndPosition - path, &ds); sl@0: sl@0: /* sl@0: * Now we convert the tail of the current path to its sl@0: * 'long form', and append it to 'dsNorm' which holds sl@0: * the current normalized path, if the file exists. sl@0: */ sl@0: if (isDrive) { sl@0: if (GetFileAttributesA(nativePath) == INVALID_FILE_ATTRIBUTES) { sl@0: /* File doesn't exist */ sl@0: if (isDrive) { sl@0: int len = WinIsReserved(path); sl@0: if (len > 0) { sl@0: /* Actually it does exist - COM1, etc */ sl@0: int i; sl@0: for (i=0;i= 'a') { sl@0: ((char*)nativePath)[i] -= ('a' - 'A'); sl@0: } sl@0: } sl@0: Tcl_DStringAppend(&dsNorm, nativePath, len); sl@0: lastValidPathEnd = currentPathEndPosition; sl@0: } sl@0: } sl@0: Tcl_DStringFree(&ds); sl@0: break; sl@0: } sl@0: if (nativePath[0] >= 'a') { sl@0: ((char*)nativePath)[0] -= ('a' - 'A'); sl@0: } sl@0: Tcl_DStringAppend(&dsNorm,nativePath,Tcl_DStringLength(&ds)); sl@0: } else { sl@0: WIN32_FIND_DATA fData; sl@0: HANDLE handle; sl@0: sl@0: handle = FindFirstFileA(nativePath, &fData); sl@0: if (handle == INVALID_HANDLE_VALUE) { sl@0: if (GetFileAttributesA(nativePath) sl@0: == INVALID_FILE_ATTRIBUTES) { sl@0: /* File doesn't exist */ sl@0: Tcl_DStringFree(&ds); sl@0: break; sl@0: } sl@0: /* This is usually the '/' in 'c:/' at end of string */ sl@0: Tcl_DStringAppend(&dsNorm,"/", 1); sl@0: } else { sl@0: char *nativeName; sl@0: if (fData.cFileName[0] != '\0') { sl@0: nativeName = fData.cFileName; sl@0: } else { sl@0: nativeName = fData.cAlternateFileName; sl@0: } sl@0: FindClose(handle); sl@0: Tcl_DStringAppend(&dsNorm,"/", 1); sl@0: Tcl_DStringAppend(&dsNorm,nativeName,-1); sl@0: } sl@0: } sl@0: Tcl_DStringFree(&ds); sl@0: lastValidPathEnd = currentPathEndPosition; sl@0: if (cur == 0) { sl@0: break; sl@0: } sl@0: /* sl@0: * If we get here, we've got past one directory sl@0: * delimiter, so we know it is no longer a drive sl@0: */ sl@0: isDrive = 0; sl@0: } sl@0: currentPathEndPosition++; sl@0: } sl@0: } else { sl@0: /* We're on WinNT or 2000 or XP */ sl@0: Tcl_Obj *temp = NULL; sl@0: int isDrive = 1; sl@0: Tcl_DString ds; sl@0: sl@0: currentPathEndPosition = path + nextCheckpoint; sl@0: if (*currentPathEndPosition == '/') { sl@0: currentPathEndPosition++; sl@0: } sl@0: while (1) { sl@0: char cur = *currentPathEndPosition; sl@0: if ((cur == '/' || cur == 0) && (path != currentPathEndPosition)) { sl@0: /* Reached directory separator, or end of string */ sl@0: WIN32_FILE_ATTRIBUTE_DATA data; sl@0: CONST char *nativePath = Tcl_WinUtfToTChar(path, sl@0: currentPathEndPosition - path, &ds); sl@0: if ((*tclWinProcs->getFileAttributesExProc)(nativePath, sl@0: GetFileExInfoStandard, &data) != TRUE) { sl@0: /* File doesn't exist */ sl@0: if (isDrive) { sl@0: int len = WinIsReserved(path); sl@0: if (len > 0) { sl@0: /* Actually it does exist - COM1, etc */ sl@0: int i; sl@0: for (i=0;i= L'a') { sl@0: wc -= (L'a' - L'A'); sl@0: ((WCHAR*)nativePath)[i] = wc; sl@0: } sl@0: } sl@0: Tcl_DStringAppend(&dsNorm, nativePath, sl@0: sizeof(WCHAR)*len); sl@0: lastValidPathEnd = currentPathEndPosition; sl@0: } sl@0: } sl@0: Tcl_DStringFree(&ds); sl@0: break; sl@0: } sl@0: sl@0: /* sl@0: * File 'nativePath' does exist if we get here. We sl@0: * now want to check if it is a symlink and otherwise sl@0: * continue with the rest of the path. sl@0: */ sl@0: sl@0: /* sl@0: * Check for symlinks, except at last component sl@0: * of path (we don't follow final symlinks). Also sl@0: * a drive (C:/) for example, may sometimes have sl@0: * the reparse flag set for some reason I don't sl@0: * understand. We therefore don't perform this sl@0: * check for drives. sl@0: */ sl@0: if (cur != 0 && !isDrive && (data.dwFileAttributes sl@0: & FILE_ATTRIBUTE_REPARSE_POINT)) { sl@0: Tcl_Obj *to = WinReadLinkDirectory(nativePath); sl@0: if (to != NULL) { sl@0: /* Read the reparse point ok */ sl@0: /* Tcl_GetStringFromObj(to, &pathLen); */ sl@0: nextCheckpoint = 0; /* pathLen */ sl@0: Tcl_AppendToObj(to, currentPathEndPosition, -1); sl@0: /* Convert link to forward slashes */ sl@0: for (path = Tcl_GetString(to); *path != 0; path++) { sl@0: if (*path == '\\') *path = '/'; sl@0: } sl@0: path = Tcl_GetString(to); sl@0: currentPathEndPosition = path + nextCheckpoint; sl@0: if (temp != NULL) { sl@0: Tcl_DecrRefCount(temp); sl@0: } sl@0: temp = to; sl@0: /* Reset variables so we can restart normalization */ sl@0: isDrive = 1; sl@0: Tcl_DStringFree(&dsNorm); sl@0: Tcl_DStringInit(&dsNorm); sl@0: Tcl_DStringFree(&ds); sl@0: continue; sl@0: } sl@0: } sl@0: /* sl@0: * Now we convert the tail of the current path to its sl@0: * 'long form', and append it to 'dsNorm' which holds sl@0: * the current normalized path sl@0: */ sl@0: if (isDrive) { sl@0: WCHAR drive = ((WCHAR*)nativePath)[0]; sl@0: if (drive >= L'a') { sl@0: drive -= (L'a' - L'A'); sl@0: ((WCHAR*)nativePath)[0] = drive; sl@0: } sl@0: Tcl_DStringAppend(&dsNorm,nativePath,Tcl_DStringLength(&ds)); sl@0: } else { sl@0: char *checkDots = NULL; sl@0: sl@0: if (lastValidPathEnd[1] == '.') { sl@0: checkDots = lastValidPathEnd + 1; sl@0: while (checkDots < currentPathEndPosition) { sl@0: if (*checkDots != '.') { sl@0: checkDots = NULL; sl@0: break; sl@0: } sl@0: checkDots++; sl@0: } sl@0: } sl@0: if (checkDots != NULL) { sl@0: int dotLen = currentPathEndPosition - lastValidPathEnd; sl@0: /* sl@0: * Path is just dots. We shouldn't really sl@0: * ever see a path like that. However, to be sl@0: * nice we at least don't mangle the path -- sl@0: * we just add the dots as a path segment and sl@0: * continue sl@0: */ sl@0: Tcl_DStringAppend(&dsNorm, sl@0: (TCHAR*)((WCHAR*)(nativePath sl@0: + Tcl_DStringLength(&ds)) sl@0: - dotLen), sl@0: (int)(dotLen * sizeof(WCHAR))); sl@0: } else { sl@0: /* Normal path */ sl@0: WIN32_FIND_DATAW fData; sl@0: HANDLE handle; sl@0: sl@0: handle = FindFirstFileW((WCHAR*)nativePath, &fData); sl@0: if (handle == INVALID_HANDLE_VALUE) { sl@0: /* This is usually the '/' in 'c:/' at end of string */ sl@0: Tcl_DStringAppend(&dsNorm,(CONST char*)L"/", sl@0: sizeof(WCHAR)); sl@0: } else { sl@0: WCHAR *nativeName; sl@0: if (fData.cFileName[0] != '\0') { sl@0: nativeName = fData.cFileName; sl@0: } else { sl@0: nativeName = fData.cAlternateFileName; sl@0: } sl@0: FindClose(handle); sl@0: Tcl_DStringAppend(&dsNorm,(CONST char*)L"/", sl@0: sizeof(WCHAR)); sl@0: Tcl_DStringAppend(&dsNorm,(TCHAR*)nativeName, sl@0: (int) (wcslen(nativeName)*sizeof(WCHAR))); sl@0: } sl@0: } sl@0: } sl@0: Tcl_DStringFree(&ds); sl@0: lastValidPathEnd = currentPathEndPosition; sl@0: if (cur == 0) { sl@0: break; sl@0: } sl@0: /* sl@0: * If we get here, we've got past one directory sl@0: * delimiter, so we know it is no longer a drive sl@0: */ sl@0: isDrive = 0; sl@0: } sl@0: currentPathEndPosition++; sl@0: } sl@0: } sl@0: /* Common code path for all Windows platforms */ sl@0: nextCheckpoint = currentPathEndPosition - path; sl@0: if (lastValidPathEnd != NULL) { sl@0: /* sl@0: * Concatenate the normalized string in dsNorm with the sl@0: * tail of the path which we didn't recognise. The sl@0: * string in dsNorm is in the native encoding, so we sl@0: * have to convert it to Utf. sl@0: */ sl@0: Tcl_DString dsTemp; sl@0: Tcl_WinTCharToUtf(Tcl_DStringValue(&dsNorm), sl@0: Tcl_DStringLength(&dsNorm), &dsTemp); sl@0: nextCheckpoint = Tcl_DStringLength(&dsTemp); sl@0: if (*lastValidPathEnd != 0) { sl@0: /* Not the end of the string */ sl@0: int len; sl@0: char *path; sl@0: Tcl_Obj *tmpPathPtr; sl@0: tmpPathPtr = Tcl_NewStringObj(Tcl_DStringValue(&dsTemp), sl@0: nextCheckpoint); sl@0: Tcl_AppendToObj(tmpPathPtr, lastValidPathEnd, -1); sl@0: path = Tcl_GetStringFromObj(tmpPathPtr, &len); sl@0: Tcl_SetStringObj(pathPtr, path, len); sl@0: Tcl_DecrRefCount(tmpPathPtr); sl@0: } else { sl@0: /* End of string was reached above */ sl@0: Tcl_SetStringObj(pathPtr, Tcl_DStringValue(&dsTemp), sl@0: nextCheckpoint); sl@0: } sl@0: Tcl_DStringFree(&dsTemp); sl@0: } sl@0: Tcl_DStringFree(&dsNorm); sl@0: return nextCheckpoint; sl@0: } sl@0: sl@0: /* sl@0: *--------------------------------------------------------------------------- sl@0: * sl@0: * TclpUtime -- sl@0: * sl@0: * Set the modification date for a file. sl@0: * sl@0: * Results: sl@0: * 0 on success, -1 on error. sl@0: * sl@0: * Side effects: sl@0: * Sets errno to a representation of any Windows problem that's observed sl@0: * in the process. sl@0: * sl@0: *--------------------------------------------------------------------------- sl@0: */ sl@0: sl@0: int sl@0: TclpUtime( sl@0: Tcl_Obj *pathPtr, /* File to modify */ sl@0: struct utimbuf *tval) /* New modification date structure */ sl@0: { sl@0: int res = 0; sl@0: HANDLE fileHandle; sl@0: CONST TCHAR *native; sl@0: DWORD attr = 0; sl@0: DWORD flags = FILE_ATTRIBUTE_NORMAL; sl@0: FILETIME lastAccessTime, lastModTime; sl@0: sl@0: FromCTime(tval->actime, &lastAccessTime); sl@0: FromCTime(tval->modtime, &lastModTime); sl@0: sl@0: native = (CONST TCHAR *)Tcl_FSGetNativePath(pathPtr); sl@0: sl@0: attr = (*tclWinProcs->getFileAttributesProc)(native); sl@0: sl@0: if (attr != INVALID_FILE_ATTRIBUTES && attr & FILE_ATTRIBUTE_DIRECTORY) { sl@0: flags = FILE_FLAG_BACKUP_SEMANTICS; sl@0: } sl@0: sl@0: /* sl@0: * We use the native APIs (not 'utime') because there are some daylight sl@0: * savings complications that utime gets wrong. sl@0: */ sl@0: sl@0: fileHandle = (tclWinProcs->createFileProc) ( sl@0: native, FILE_WRITE_ATTRIBUTES, 0, NULL, sl@0: OPEN_EXISTING, flags, NULL); sl@0: sl@0: if (fileHandle == INVALID_HANDLE_VALUE || sl@0: !SetFileTime(fileHandle, NULL, &lastAccessTime, &lastModTime)) { sl@0: TclWinConvertError(GetLastError()); sl@0: res = -1; sl@0: } sl@0: if (fileHandle != INVALID_HANDLE_VALUE) { sl@0: CloseHandle(fileHandle); sl@0: } sl@0: return res; sl@0: }