/* * tclWinFile.c -- * * This file contains temporary wrappers around UNIX file handling * functions. These wrappers map the UNIX functions to Win32 HANDLE-style * files, which can be manipulated through the Win32 console redirection * interfaces. * * Copyright (c) 1995-1998 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclWinFile.c,v 1.10 2001/07/17 19:40:37 mdejong Exp $ */ #include "tclWinInt.h" #include #include #include /* For TclpGetUserHome(). */ static time_t ToCTime(FILETIME fileTime); typedef NET_API_STATUS NET_API_FUNCTION NETUSERGETINFOPROC (LPWSTR servername, LPWSTR username, DWORD level, LPBYTE *bufptr); typedef NET_API_STATUS NET_API_FUNCTION NETAPIBUFFERFREEPROC (LPVOID Buffer); typedef NET_API_STATUS NET_API_FUNCTION NETGETDCNAMEPROC (LPWSTR servername, LPWSTR domainname, LPBYTE *bufptr); /* *--------------------------------------------------------------------------- * * TclpFindExecutable -- * * This procedure computes the absolute path name of the current * application, given its argv[0] value. * * Results: * A dirty UTF string that is the path to the executable. At this * point we may not know the system encoding. Convert the native * string value to UTF using the default encoding. The assumption * is that we will still be able to parse the path given the path * name contains ASCII string and '/' chars do not conflict with * other UTF chars. * * Side effects: * The variable tclNativeExecutableName gets filled in with the file * name for the application, if we figured it out. If we couldn't * figure it out, tclNativeExecutableName is set to NULL. * *--------------------------------------------------------------------------- */ char * TclpFindExecutable(argv0) CONST char *argv0; /* The value of the application's argv[0] * (native). */ { Tcl_DString ds; WCHAR wName[MAX_PATH]; if (argv0 == NULL) { return NULL; } if (tclNativeExecutableName != NULL) { return tclNativeExecutableName; } /* * Under Windows we ignore argv0, and return the path for the file used to * create this process. */ (*tclWinProcs->getModuleFileNameProc)(NULL, wName, MAX_PATH); Tcl_WinTCharToUtf((TCHAR *) wName, -1, &ds); tclNativeExecutableName = ckalloc((unsigned) (Tcl_DStringLength(&ds) + 1)); strcpy(tclNativeExecutableName, Tcl_DStringValue(&ds)); Tcl_DStringFree(&ds); TclWinNoBackslash(tclNativeExecutableName); return tclNativeExecutableName; } /* *---------------------------------------------------------------------- * * TclpMatchFilesTypes -- * * 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. * * 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. */ { 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; /* * Convert the path to normalized form since some interfaces only * accept backslashes. Also, ensure that the directory ends with a * separator character. */ dirLength = Tcl_DStringLength(dirPtr); 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 = '\\'; } } p--; if ((*p != '\\') && (*p != ':')) { Tcl_DStringAppend(&dirString, "\\", 1); } } dir = Tcl_DStringValue(&dirString); /* * 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); 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. */ 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]; 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. */ Tcl_DStringInit(&patternString); newPattern = Tcl_DStringAppend(&patternString, pattern, tail - pattern); Tcl_UtfToLower(newPattern); /* * We need to check all files in the directory, so append a *.* * to the path. */ dir = Tcl_DStringAppend(&dirString, "*.*", 3); nativeName = Tcl_WinUtfToTChar(dir, -1, &ds); handle = (*tclWinProcs->findFirstFileProc)(nativeName, &data); Tcl_DStringFree(&ds); if (handle == INVALID_HANDLE_VALUE) { message = "couldn't read directory \""; goto error; } /* * Clean up the tail pointer. Leave the tail pointing to the * first character after the path separator or NULL. */ if (*tail == '\\') { tail++; } if (*tail == '\0') { tail = NULL; } else { tail++; } /* * Check to see if the pattern needs to compare with dot files. */ if ((newPattern[0] == '.') || ((pattern[0] == '\\') && (pattern[1] == '.'))) { matchDotFiles = 1; } else { matchDotFiles = 0; } /* * Now iterate over all of the files in the directory. */ resultPtr = Tcl_GetObjResult(interp); for (found = 1; found != 0; found = (*tclWinProcs->findNextFileProc)(handle, &data)) { TCHAR *nativeMatchResult; char *name, *fname; if (tclWinProcs->useWide) { nativeName = (TCHAR *) data.w.cFileName; } else { nativeName = (TCHAR *) data.a.cFileName; } name = Tcl_WinTCharToUtf(nativeName, -1, &ds); /* * 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. */ Tcl_UtfToLower(name); nativeMatchResult = NULL; if ((matchDotFiles == 0) && (name[0] == '.')) { /* * Ignore hidden files. */ } else if (Tcl_StringMatch(name, newPattern) != 0) { nativeMatchResult = nativeName; } Tcl_DStringFree(&ds); if (nativeMatchResult == NULL) { continue; } /* * 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. */ name = Tcl_WinTCharToUtf(nativeMatchResult, -1, &ds); Tcl_DStringAppend(dirPtr, name, -1); Tcl_DStringFree(&ds); fname = Tcl_DStringValue(dirPtr); nativeName = Tcl_WinUtfToTChar(fname, Tcl_DStringLength(dirPtr), &ds); /* * '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. */ attr = 0; if (tail == NULL) { int typeOk = 1; if (types != NULL) { if (types->perm != 0) { attr = (*tclWinProcs->getFileAttributesProc)(nativeName); 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; } } 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 #ifdef S_ISSOCK || ((types->type & TCL_GLOB_TYPE_SOCK) && S_ISSOCK(buf.st_mode)) #endif ) { typeOk = 1; } } else { /* Posix error occurred */ } } } if (typeOk) { Tcl_ListObjAppendElement(interp, resultPtr, Tcl_NewStringObj(fname, Tcl_DStringLength(dirPtr))); } } else { attr = (*tclWinProcs->getFileAttributesProc)(nativeName); if (attr & FILE_ATTRIBUTE_DIRECTORY) { Tcl_DStringAppend(dirPtr, "/", 1); result = TclDoGlob(interp, separators, dirPtr, tail, types); if (result != TCL_OK) { break; } } } /* * Free ds here to ensure that nativeName is valid above. */ Tcl_DStringFree(&ds); 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; } /* * 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); } /* *---------------------------------------------------------------------- * * TclpGetUserHome -- * * This function takes the passed in user name and finds the * corresponding home directory specified in the password file. * * Results: * The result is a pointer to a string specifying the user's home * directory, or NULL if the user's home directory could not be * determined. Storage for the result string is allocated in * bufferPtr; the caller must call Tcl_DStringFree() when the result * is no longer needed. * * Side effects: * None. * *---------------------------------------------------------------------- */ char * TclpGetUserHome(name, bufferPtr) CONST char *name; /* User name for desired home directory. */ Tcl_DString *bufferPtr; /* Uninitialized or free DString filled * with name of user's home directory. */ { char *result; HINSTANCE netapiInst; result = NULL; Tcl_DStringInit(bufferPtr); netapiInst = LoadLibraryA("netapi32.dll"); if (netapiInst != NULL) { NETAPIBUFFERFREEPROC *netApiBufferFreeProc; NETGETDCNAMEPROC *netGetDCNameProc; NETUSERGETINFOPROC *netUserGetInfoProc; netApiBufferFreeProc = (NETAPIBUFFERFREEPROC *) GetProcAddress(netapiInst, "NetApiBufferFree"); netGetDCNameProc = (NETGETDCNAMEPROC *) GetProcAddress(netapiInst, "NetGetDCName"); netUserGetInfoProc = (NETUSERGETINFOPROC *) GetProcAddress(netapiInst, "NetUserGetInfo"); if ((netUserGetInfoProc != NULL) && (netGetDCNameProc != NULL) && (netApiBufferFreeProc != NULL)) { USER_INFO_1 *uiPtr; Tcl_DString ds; int nameLen, badDomain; char *domain; WCHAR *wName, *wHomeDir, *wDomain; WCHAR buf[MAX_PATH]; badDomain = 0; nameLen = -1; wDomain = NULL; domain = strchr(name, '@'); if (domain != NULL) { Tcl_DStringInit(&ds); wName = Tcl_UtfToUniCharDString(domain + 1, -1, &ds); badDomain = (*netGetDCNameProc)(NULL, wName, (LPBYTE *) &wDomain); Tcl_DStringFree(&ds); nameLen = domain - name; } if (badDomain == 0) { Tcl_DStringInit(&ds); wName = Tcl_UtfToUniCharDString(name, nameLen, &ds); if ((*netUserGetInfoProc)(wDomain, wName, 1, (LPBYTE *) &uiPtr) == 0) { wHomeDir = uiPtr->usri1_home_dir; if ((wHomeDir != NULL) && (wHomeDir[0] != L'\0')) { Tcl_UniCharToUtfDString(wHomeDir, lstrlenW(wHomeDir), bufferPtr); } else { /* * User exists but has no home dir. Return * "{Windows Drive}:/users/default". */ GetWindowsDirectoryW(buf, MAX_PATH); Tcl_UniCharToUtfDString(buf, 2, bufferPtr); Tcl_DStringAppend(bufferPtr, "/users/default", -1); } result = Tcl_DStringValue(bufferPtr); (*netApiBufferFreeProc)((void *) uiPtr); } Tcl_DStringFree(&ds); } if (wDomain != NULL) { (*netApiBufferFreeProc)((void *) wDomain); } } FreeLibrary(netapiInst); } if (result == NULL) { /* * Look in the "Password Lists" section of system.ini for the * local user. There are also entries in that section that begin * with a "*" character that are used by Windows for other * purposes; ignore user names beginning with a "*". */ char buf[MAX_PATH]; if (name[0] != '*') { if (GetPrivateProfileStringA("Password Lists", name, "", buf, MAX_PATH, "system.ini") > 0) { /* * User exists, but there is no such thing as a home * directory in system.ini. Return "{Windows drive}:/". */ GetWindowsDirectoryA(buf, MAX_PATH); Tcl_DStringAppend(bufferPtr, buf, 3); result = Tcl_DStringValue(bufferPtr); } } } return result; } /* *--------------------------------------------------------------------------- * * TclpAccess -- * * This function replaces the library version of access(), fixing the * following bugs: * * 1. access() returns that all files have execute permission. * * Results: * See access documentation. * * Side effects: * See access documentation. * *--------------------------------------------------------------------------- */ int TclpAccess( CONST char *path, /* 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) { /* * File doesn't exist. */ TclWinConvertError(GetLastError()); return -1; } if ((mode & W_OK) && (attr & FILE_ATTRIBUTE_READONLY)) { /* * File is not writable. */ Tcl_SetErrno(EACCES); return -1; } 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; } } Tcl_SetErrno(EACCES); return -1; } return 0; } /* *---------------------------------------------------------------------- * * TclpChdir -- * * This function replaces the library version of chdir(). * * Results: * See chdir() documentation. * * Side effects: * See chdir() documentation. * *---------------------------------------------------------------------- */ int TclpChdir(path) CONST char *path; /* Path to new working directory (UTF-8). */ { int result; Tcl_DString ds; TCHAR *nativePath; nativePath = Tcl_WinUtfToTChar(path, -1, &ds); result = (*tclWinProcs->setCurrentDirectoryProc)(nativePath); Tcl_DStringFree(&ds); if (result == 0) { TclWinConvertError(GetLastError()); return -1; } return 0; } #ifdef __CYGWIN__ /* *--------------------------------------------------------------------------- * * TclpReadlink -- * * This function replaces the library version of readlink(). * * Results: * The result is a pointer to a string specifying the contents * of the symbolic link given by 'path', or NULL if the symbolic * link could not be read. Storage for the result string is * allocated in bufferPtr; the caller must call Tcl_DStringFree() * when the result is no longer needed. * * Side effects: * See readlink() documentation. * *--------------------------------------------------------------------------- */ char * TclpReadlink(path, linkPtr) CONST char *path; /* Path of file to readlink (UTF-8). */ Tcl_DString *linkPtr; /* Uninitialized or free DString filled * with contents of link (UTF-8). */ { char link[MAXPATHLEN]; int length; char *native; Tcl_DString ds; native = Tcl_UtfToExternalDString(NULL, path, -1, &ds); length = readlink(native, link, sizeof(link)); /* INTL: Native. */ Tcl_DStringFree(&ds); if (length < 0) { return NULL; } Tcl_ExternalToUtfDString(NULL, link, length, linkPtr); return Tcl_DStringValue(linkPtr); } #endif /* __CYGWIN__ */ /* *---------------------------------------------------------------------- * * TclpGetCwd -- * * This function replaces the library version of getcwd(). * * Results: * The result is a pointer to a string specifying the current * directory, or NULL if the current directory could not be * determined. If NULL is returned, an error message is left in the * interp's result. Storage for the result string is allocated in * bufferPtr; the caller must call Tcl_DStringFree() when the result * is no longer needed. * * Side effects: * None. * *---------------------------------------------------------------------- */ char * TclpGetCwd(interp, bufferPtr) Tcl_Interp *interp; /* If non-NULL, used for error reporting. */ Tcl_DString *bufferPtr; /* Uninitialized or free DString filled * with name of current directory. */ { WCHAR buffer[MAX_PATH]; char *p; if ((*tclWinProcs->getCurrentDirectoryProc)(MAX_PATH, buffer) == 0) { TclWinConvertError(GetLastError()); if (interp != NULL) { Tcl_AppendResult(interp, "error getting working directory name: ", Tcl_PosixError(interp), (char *) NULL); } return NULL; } /* * Watch for the wierd Windows c:\\UNC syntax. */ if (tclWinProcs->useWide) { WCHAR *native; native = (WCHAR *) buffer; if ((native[0] != '\0') && (native[1] == ':') && (native[2] == '\\') && (native[3] == '\\')) { native += 2; } Tcl_WinTCharToUtf((TCHAR *) native, -1, bufferPtr); } else { char *native; native = (char *) buffer; if ((native[0] != '\0') && (native[1] == ':') && (native[2] == '\\') && (native[3] == '\\')) { native += 2; } Tcl_WinTCharToUtf((TCHAR *) native, -1, bufferPtr); } /* * Convert to forward slashes for easier use in scripts. */ for (p = Tcl_DStringValue(bufferPtr); *p != '\0'; p++) { if (*p == '\\') { *p = '/'; } } return Tcl_DStringValue(bufferPtr); } /* *---------------------------------------------------------------------- * * TclpStat -- * * This function replaces the library version of stat(), fixing * the following bugs: * * 1. stat("c:") returns an error. * 2. Borland stat() return time in GMT instead of localtime. * 3. stat("\\server\mount") would return error. * 4. Accepts slashes or backslashes. * 5. st_dev and st_rdev were wrong for UNC paths. * * Results: * See stat documentation. * * Side effects: * See stat documentation. * *---------------------------------------------------------------------- */ int TclpStat(path, statPtr) CONST char *path; /* Path of file to stat (UTF-8). */ struct stat *statPtr; /* Filled with results of stat call. */ { Tcl_DString ds; TCHAR *nativePath; WIN32_FIND_DATAT data; HANDLE handle; DWORD attr; WCHAR nativeFullPath[MAX_PATH]; TCHAR *nativePart; char *p, *fullPath; int dev, mode; /* * Eliminate file names containing wildcard characters, or subsequent * call to FindFirstFile() will expand them, matching some other file. */ if (strpbrk(path, "?*") != NULL) { Tcl_SetErrno(ENOENT); return -1; } 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. */ attr = (*tclWinProcs->getFileAttributesProc)(nativePath); if (attr == 0xffffffff) { Tcl_DStringFree(&ds); Tcl_SetErrno(ENOENT); return -1; } /* * Make up some fake information for this file. It has the * correct file attributes and a time of 0. */ memset(&data, 0, sizeof(data)); data.a.dwFileAttributes = attr; } else { FindClose(handle); } (*tclWinProcs->getFullPathNameProc)(nativePath, MAX_PATH, nativeFullPath, &nativePart); 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) { /* * 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; 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; } } /* * Propagate the S_IREAD, S_IWRITE, S_IEXEC bits to the group and * other positions. */ mode |= (mode & 0x0700) >> 3; mode |= (mode & 0x0700) >> 6; statPtr->st_dev = (dev_t) dev; statPtr->st_ino = 0; statPtr->st_mode = (unsigned short) mode; statPtr->st_nlink = 1; 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; } static time_t ToCTime( FILETIME fileTime) /* UTC Time to convert to local time_t. */ { FILETIME localFileTime; SYSTEMTIME systemTime; struct tm tm; if (FileTimeToLocalFileTime(&fileTime, &localFileTime) == 0) { return 0; } if (FileTimeToSystemTime(&localFileTime, &systemTime) == 0) { return 0; } tm.tm_sec = systemTime.wSecond; tm.tm_min = systemTime.wMinute; tm.tm_hour = systemTime.wHour; tm.tm_mday = systemTime.wDay; tm.tm_mon = systemTime.wMonth - 1; tm.tm_year = systemTime.wYear - 1900; tm.tm_wday = 0; tm.tm_yday = 0; tm.tm_isdst = -1; return mktime(&tm); } #if 0 /* * Borland's stat doesn't take into account localtime. */ if ((result == 0) && (buf->st_mtime != 0)) { TIME_ZONE_INFORMATION tz; int time, bias; time = GetTimeZoneInformation(&tz); bias = tz.Bias; if (time == TIME_ZONE_ID_DAYLIGHT) { bias += tz.DaylightBias; } bias *= 60; buf->st_atime -= bias; buf->st_ctime -= bias; buf->st_mtime -= bias; } #endif #if 0 /* *------------------------------------------------------------------------- * * TclWinResolveShortcut -- * * Resolve a potential Windows shortcut to get the actual file or * directory in question. * * Results: * Returns 1 if the shortcut could be resolved, or 0 if there was * an error or if the filename was not a shortcut. * If bufferPtr did hold the name of a shortcut, it is modified to * hold the resolved target of the shortcut instead. * * Side effects: * Loads and unloads OLE package to determine if filename refers to * a shortcut. * *------------------------------------------------------------------------- */ int TclWinResolveShortcut(bufferPtr) Tcl_DString *bufferPtr; /* Holds name of file to resolve. On * return, holds resolved file name. */ { HRESULT hres; IShellLink *psl; IPersistFile *ppf; WIN32_FIND_DATA wfd; WCHAR wpath[MAX_PATH]; char *path, *ext; char realFileName[MAX_PATH]; /* * Windows system calls do not automatically resolve * shortcuts like UNIX automatically will with symbolic links. */ path = Tcl_DStringValue(bufferPtr); ext = strrchr(path, '.'); if ((ext == NULL) || (stricmp(ext, ".lnk") != 0)) { return 0; } CoInitialize(NULL); path = Tcl_DStringValue(bufferPtr); realFileName[0] = '\0'; hres = CoCreateInstance(&CLSID_ShellLink, NULL, CLSCTX_INPROC_SERVER, &IID_IShellLink, &psl); if (SUCCEEDED(hres)) { hres = psl->lpVtbl->QueryInterface(psl, &IID_IPersistFile, &ppf); if (SUCCEEDED(hres)) { MultiByteToWideChar(CP_ACP, 0, path, -1, wpath, sizeof(wpath)); hres = ppf->lpVtbl->Load(ppf, wpath, STGM_READ); if (SUCCEEDED(hres)) { hres = psl->lpVtbl->Resolve(psl, NULL, SLR_ANY_MATCH | SLR_NO_UI); if (SUCCEEDED(hres)) { hres = psl->lpVtbl->GetPath(psl, realFileName, MAX_PATH, &wfd, 0); } } ppf->lpVtbl->Release(ppf); } psl->lpVtbl->Release(psl); } CoUninitialize(); if (realFileName[0] != '\0') { Tcl_DStringSetLength(bufferPtr, 0); Tcl_DStringAppend(bufferPtr, realFileName, -1); return 1; } return 0; } #endif