|
/* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tcl_base/tclwinfile.c,v 1.1.1.1 2001/06/13 04:49:10 dtashley Exp $ */ |
|
|
|
|
|
/* |
|
|
* 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.1.1.1 2001/06/13 04:49:10 dtashley Exp $ |
|
|
*/ |
|
|
|
|
|
#include "tclWinInt.h" |
|
|
#include <sys/stat.h> |
|
|
#include <shlobj.h> |
|
|
#include <lmaccess.h> /* 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 = (*tclWinProcs->getFileAttributesProc)(nativeName); |
|
|
Tcl_DStringFree(&ds); |
|
|
|
|
|
if (tail == NULL) { |
|
|
int typeOk = 1; |
|
|
if (types != NULL) { |
|
|
if (types->perm != 0) { |
|
|
if ( |
|
|
((types->perm & TCL_GLOB_PERM_RONLY) && |
|
|
!(attr & FILE_ATTRIBUTE_READONLY)) || |
|
|
((types->perm & TCL_GLOB_PERM_HIDDEN) && |
|
|
!(attr & FILE_ATTRIBUTE_HIDDEN)) || |
|
|
((types->perm & TCL_GLOB_PERM_R) && |
|
|
(TclpAccess(fname, R_OK) != 0)) || |
|
|
((types->perm & TCL_GLOB_PERM_W) && |
|
|
(TclpAccess(fname, W_OK) != 0)) || |
|
|
((types->perm & TCL_GLOB_PERM_X) && |
|
|
(TclpAccess(fname, X_OK) != 0)) |
|
|
) { |
|
|
typeOk = 0; |
|
|
} |
|
|
} |
|
|
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 if (attr & FILE_ATTRIBUTE_DIRECTORY) { |
|
|
Tcl_DStringAppend(dirPtr, "/", 1); |
|
|
result = TclDoGlob(interp, separators, dirPtr, tail, types); |
|
|
if (result != TCL_OK) { |
|
|
break; |
|
|
} |
|
|
} |
|
|
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; |
|
|
} |
|
|
|
|
|
/* |
|
|
*---------------------------------------------------------------------- |
|
|
* |
|
|
* 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 |
|
|
|
|
|
|
|
|
/* $History: tclwinfile.c $ |
|
|
* |
|
|
* ***************** Version 1 ***************** |
|
|
* User: Dtashley Date: 1/02/01 Time: 12:39a |
|
|
* Created in $/IjuScripter, IjuConsole/Source/Tcl Base |
|
|
* Initial check-in. |
|
|
*/ |
|
|
|
|
|
/* End of TCLWINFILE.C */ |
|
| 1 |
|
/* $Header$ */ |
| 2 |
|
/* |
| 3 |
|
* tclWinFile.c -- |
| 4 |
|
* |
| 5 |
|
* This file contains temporary wrappers around UNIX file handling |
| 6 |
|
* functions. These wrappers map the UNIX functions to Win32 HANDLE-style |
| 7 |
|
* files, which can be manipulated through the Win32 console redirection |
| 8 |
|
* interfaces. |
| 9 |
|
* |
| 10 |
|
* Copyright (c) 1995-1998 Sun Microsystems, Inc. |
| 11 |
|
* |
| 12 |
|
* See the file "license.terms" for information on usage and redistribution |
| 13 |
|
* of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
| 14 |
|
* |
| 15 |
|
* RCS: @(#) $Id: tclwinfile.c,v 1.1.1.1 2001/06/13 04:49:10 dtashley Exp $ |
| 16 |
|
*/ |
| 17 |
|
|
| 18 |
|
#include "tclWinInt.h" |
| 19 |
|
#include <sys/stat.h> |
| 20 |
|
#include <shlobj.h> |
| 21 |
|
#include <lmaccess.h> /* For TclpGetUserHome(). */ |
| 22 |
|
|
| 23 |
|
static time_t ToCTime(FILETIME fileTime); |
| 24 |
|
|
| 25 |
|
typedef NET_API_STATUS NET_API_FUNCTION NETUSERGETINFOPROC |
| 26 |
|
(LPWSTR servername, LPWSTR username, DWORD level, LPBYTE *bufptr); |
| 27 |
|
|
| 28 |
|
typedef NET_API_STATUS NET_API_FUNCTION NETAPIBUFFERFREEPROC |
| 29 |
|
(LPVOID Buffer); |
| 30 |
|
|
| 31 |
|
typedef NET_API_STATUS NET_API_FUNCTION NETGETDCNAMEPROC |
| 32 |
|
(LPWSTR servername, LPWSTR domainname, LPBYTE *bufptr); |
| 33 |
|
|
| 34 |
|
|
| 35 |
|
/* |
| 36 |
|
*--------------------------------------------------------------------------- |
| 37 |
|
* |
| 38 |
|
* TclpFindExecutable -- |
| 39 |
|
* |
| 40 |
|
* This procedure computes the absolute path name of the current |
| 41 |
|
* application, given its argv[0] value. |
| 42 |
|
* |
| 43 |
|
* Results: |
| 44 |
|
* A dirty UTF string that is the path to the executable. At this |
| 45 |
|
* point we may not know the system encoding. Convert the native |
| 46 |
|
* string value to UTF using the default encoding. The assumption |
| 47 |
|
* is that we will still be able to parse the path given the path |
| 48 |
|
* name contains ASCII string and '/' chars do not conflict with |
| 49 |
|
* other UTF chars. |
| 50 |
|
* |
| 51 |
|
* Side effects: |
| 52 |
|
* The variable tclNativeExecutableName gets filled in with the file |
| 53 |
|
* name for the application, if we figured it out. If we couldn't |
| 54 |
|
* figure it out, tclNativeExecutableName is set to NULL. |
| 55 |
|
* |
| 56 |
|
*--------------------------------------------------------------------------- |
| 57 |
|
*/ |
| 58 |
|
|
| 59 |
|
char * |
| 60 |
|
TclpFindExecutable(argv0) |
| 61 |
|
CONST char *argv0; /* The value of the application's argv[0] |
| 62 |
|
* (native). */ |
| 63 |
|
{ |
| 64 |
|
Tcl_DString ds; |
| 65 |
|
WCHAR wName[MAX_PATH]; |
| 66 |
|
|
| 67 |
|
if (argv0 == NULL) { |
| 68 |
|
return NULL; |
| 69 |
|
} |
| 70 |
|
if (tclNativeExecutableName != NULL) { |
| 71 |
|
return tclNativeExecutableName; |
| 72 |
|
} |
| 73 |
|
|
| 74 |
|
/* |
| 75 |
|
* Under Windows we ignore argv0, and return the path for the file used to |
| 76 |
|
* create this process. |
| 77 |
|
*/ |
| 78 |
|
|
| 79 |
|
(*tclWinProcs->getModuleFileNameProc)(NULL, wName, MAX_PATH); |
| 80 |
|
Tcl_WinTCharToUtf((TCHAR *) wName, -1, &ds); |
| 81 |
|
|
| 82 |
|
tclNativeExecutableName = ckalloc((unsigned) (Tcl_DStringLength(&ds) + 1)); |
| 83 |
|
strcpy(tclNativeExecutableName, Tcl_DStringValue(&ds)); |
| 84 |
|
Tcl_DStringFree(&ds); |
| 85 |
|
|
| 86 |
|
TclWinNoBackslash(tclNativeExecutableName); |
| 87 |
|
return tclNativeExecutableName; |
| 88 |
|
} |
| 89 |
|
|
| 90 |
|
/* |
| 91 |
|
*---------------------------------------------------------------------- |
| 92 |
|
* |
| 93 |
|
* TclpMatchFilesTypes -- |
| 94 |
|
* |
| 95 |
|
* This routine is used by the globbing code to search a |
| 96 |
|
* directory for all files which match a given pattern. |
| 97 |
|
* |
| 98 |
|
* Results: |
| 99 |
|
* If the tail argument is NULL, then the matching files are |
| 100 |
|
* added to the the interp's result. Otherwise, TclDoGlob is called |
| 101 |
|
* recursively for each matching subdirectory. The return value |
| 102 |
|
* is a standard Tcl result indicating whether an error occurred |
| 103 |
|
* in globbing. |
| 104 |
|
* |
| 105 |
|
* Side effects: |
| 106 |
|
* None. |
| 107 |
|
* |
| 108 |
|
*---------------------------------------------------------------------- */ |
| 109 |
|
|
| 110 |
|
int |
| 111 |
|
TclpMatchFilesTypes( |
| 112 |
|
Tcl_Interp *interp, /* Interpreter to receive results. */ |
| 113 |
|
char *separators, /* Directory separators to pass to TclDoGlob. */ |
| 114 |
|
Tcl_DString *dirPtr, /* Contains path to directory to search. */ |
| 115 |
|
char *pattern, /* Pattern to match against. */ |
| 116 |
|
char *tail, /* Pointer to end of pattern. Tail must |
| 117 |
|
* point to a location in pattern and must |
| 118 |
|
* not be static.*/ |
| 119 |
|
GlobTypeData *types) /* Object containing list of acceptable types. |
| 120 |
|
* May be NULL. */ |
| 121 |
|
{ |
| 122 |
|
char drivePat[] = "?:\\"; |
| 123 |
|
const char *message; |
| 124 |
|
char *dir, *newPattern, *root; |
| 125 |
|
int matchDotFiles; |
| 126 |
|
int dirLength, result = TCL_OK; |
| 127 |
|
Tcl_DString dirString, patternString; |
| 128 |
|
DWORD attr, volFlags; |
| 129 |
|
HANDLE handle; |
| 130 |
|
WIN32_FIND_DATAT data; |
| 131 |
|
BOOL found; |
| 132 |
|
Tcl_DString ds; |
| 133 |
|
TCHAR *nativeName; |
| 134 |
|
Tcl_Obj *resultPtr; |
| 135 |
|
|
| 136 |
|
/* |
| 137 |
|
* Convert the path to normalized form since some interfaces only |
| 138 |
|
* accept backslashes. Also, ensure that the directory ends with a |
| 139 |
|
* separator character. |
| 140 |
|
*/ |
| 141 |
|
|
| 142 |
|
dirLength = Tcl_DStringLength(dirPtr); |
| 143 |
|
Tcl_DStringInit(&dirString); |
| 144 |
|
if (dirLength == 0) { |
| 145 |
|
Tcl_DStringAppend(&dirString, ".\\", 2); |
| 146 |
|
} else { |
| 147 |
|
char *p; |
| 148 |
|
|
| 149 |
|
Tcl_DStringAppend(&dirString, Tcl_DStringValue(dirPtr), |
| 150 |
|
Tcl_DStringLength(dirPtr)); |
| 151 |
|
for (p = Tcl_DStringValue(&dirString); *p != '\0'; p++) { |
| 152 |
|
if (*p == '/') { |
| 153 |
|
*p = '\\'; |
| 154 |
|
} |
| 155 |
|
} |
| 156 |
|
p--; |
| 157 |
|
if ((*p != '\\') && (*p != ':')) { |
| 158 |
|
Tcl_DStringAppend(&dirString, "\\", 1); |
| 159 |
|
} |
| 160 |
|
} |
| 161 |
|
dir = Tcl_DStringValue(&dirString); |
| 162 |
|
|
| 163 |
|
/* |
| 164 |
|
* First verify that the specified path is actually a directory. |
| 165 |
|
*/ |
| 166 |
|
|
| 167 |
|
nativeName = Tcl_WinUtfToTChar(dir, Tcl_DStringLength(&dirString), &ds); |
| 168 |
|
attr = (*tclWinProcs->getFileAttributesProc)(nativeName); |
| 169 |
|
Tcl_DStringFree(&ds); |
| 170 |
|
|
| 171 |
|
if ((attr == 0xffffffff) || ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0)) { |
| 172 |
|
Tcl_DStringFree(&dirString); |
| 173 |
|
return TCL_OK; |
| 174 |
|
} |
| 175 |
|
|
| 176 |
|
/* |
| 177 |
|
* Next check the volume information for the directory to see whether |
| 178 |
|
* comparisons should be case sensitive or not. If the root is null, then |
| 179 |
|
* we use the root of the current directory. If the root is just a drive |
| 180 |
|
* specifier, we use the root directory of the given drive. |
| 181 |
|
*/ |
| 182 |
|
|
| 183 |
|
switch (Tcl_GetPathType(dir)) { |
| 184 |
|
case TCL_PATH_RELATIVE: |
| 185 |
|
found = GetVolumeInformationA(NULL, NULL, 0, NULL, NULL, |
| 186 |
|
&volFlags, NULL, 0); |
| 187 |
|
break; |
| 188 |
|
case TCL_PATH_VOLUME_RELATIVE: |
| 189 |
|
if (dir[0] == '\\') { |
| 190 |
|
root = NULL; |
| 191 |
|
} else { |
| 192 |
|
root = drivePat; |
| 193 |
|
*root = dir[0]; |
| 194 |
|
} |
| 195 |
|
found = GetVolumeInformationA(root, NULL, 0, NULL, NULL, |
| 196 |
|
&volFlags, NULL, 0); |
| 197 |
|
break; |
| 198 |
|
case TCL_PATH_ABSOLUTE: |
| 199 |
|
if (dir[1] == ':') { |
| 200 |
|
root = drivePat; |
| 201 |
|
*root = dir[0]; |
| 202 |
|
found = GetVolumeInformationA(root, NULL, 0, NULL, NULL, |
| 203 |
|
&volFlags, NULL, 0); |
| 204 |
|
} else if (dir[1] == '\\') { |
| 205 |
|
char *p; |
| 206 |
|
|
| 207 |
|
p = strchr(dir + 2, '\\'); |
| 208 |
|
p = strchr(p + 1, '\\'); |
| 209 |
|
p++; |
| 210 |
|
nativeName = Tcl_WinUtfToTChar(dir, p - dir, &ds); |
| 211 |
|
found = (*tclWinProcs->getVolumeInformationProc)(nativeName, |
| 212 |
|
NULL, 0, NULL, NULL, &volFlags, NULL, 0); |
| 213 |
|
Tcl_DStringFree(&ds); |
| 214 |
|
} |
| 215 |
|
break; |
| 216 |
|
} |
| 217 |
|
|
| 218 |
|
if (found == 0) { |
| 219 |
|
message = "couldn't read volume information for \""; |
| 220 |
|
goto error; |
| 221 |
|
} |
| 222 |
|
|
| 223 |
|
/* |
| 224 |
|
* In Windows, although some volumes may support case sensitivity, Windows |
| 225 |
|
* doesn't honor case. So in globbing we need to ignore the case |
| 226 |
|
* of file names. |
| 227 |
|
*/ |
| 228 |
|
|
| 229 |
|
Tcl_DStringInit(&patternString); |
| 230 |
|
newPattern = Tcl_DStringAppend(&patternString, pattern, tail - pattern); |
| 231 |
|
Tcl_UtfToLower(newPattern); |
| 232 |
|
|
| 233 |
|
/* |
| 234 |
|
* We need to check all files in the directory, so append a *.* |
| 235 |
|
* to the path. |
| 236 |
|
*/ |
| 237 |
|
|
| 238 |
|
dir = Tcl_DStringAppend(&dirString, "*.*", 3); |
| 239 |
|
nativeName = Tcl_WinUtfToTChar(dir, -1, &ds); |
| 240 |
|
handle = (*tclWinProcs->findFirstFileProc)(nativeName, &data); |
| 241 |
|
Tcl_DStringFree(&ds); |
| 242 |
|
|
| 243 |
|
if (handle == INVALID_HANDLE_VALUE) { |
| 244 |
|
message = "couldn't read directory \""; |
| 245 |
|
goto error; |
| 246 |
|
} |
| 247 |
|
|
| 248 |
|
/* |
| 249 |
|
* Clean up the tail pointer. Leave the tail pointing to the |
| 250 |
|
* first character after the path separator or NULL. |
| 251 |
|
*/ |
| 252 |
|
|
| 253 |
|
if (*tail == '\\') { |
| 254 |
|
tail++; |
| 255 |
|
} |
| 256 |
|
if (*tail == '\0') { |
| 257 |
|
tail = NULL; |
| 258 |
|
} else { |
| 259 |
|
tail++; |
| 260 |
|
} |
| 261 |
|
|
| 262 |
|
/* |
| 263 |
|
* Check to see if the pattern needs to compare with dot files. |
| 264 |
|
*/ |
| 265 |
|
|
| 266 |
|
if ((newPattern[0] == '.') |
| 267 |
|
|| ((pattern[0] == '\\') && (pattern[1] == '.'))) { |
| 268 |
|
matchDotFiles = 1; |
| 269 |
|
} else { |
| 270 |
|
matchDotFiles = 0; |
| 271 |
|
} |
| 272 |
|
|
| 273 |
|
/* |
| 274 |
|
* Now iterate over all of the files in the directory. |
| 275 |
|
*/ |
| 276 |
|
|
| 277 |
|
resultPtr = Tcl_GetObjResult(interp); |
| 278 |
|
for (found = 1; found != 0; |
| 279 |
|
found = (*tclWinProcs->findNextFileProc)(handle, &data)) { |
| 280 |
|
TCHAR *nativeMatchResult; |
| 281 |
|
char *name, *fname; |
| 282 |
|
|
| 283 |
|
if (tclWinProcs->useWide) { |
| 284 |
|
nativeName = (TCHAR *) data.w.cFileName; |
| 285 |
|
} else { |
| 286 |
|
nativeName = (TCHAR *) data.a.cFileName; |
| 287 |
|
} |
| 288 |
|
name = Tcl_WinTCharToUtf(nativeName, -1, &ds); |
| 289 |
|
|
| 290 |
|
/* |
| 291 |
|
* Check to see if the file matches the pattern. We need to convert |
| 292 |
|
* the file name to lower case for comparison purposes. Note that we |
| 293 |
|
* are ignoring the case sensitivity flag because Windows doesn't honor |
| 294 |
|
* case even if the volume is case sensitive. If the volume also |
| 295 |
|
* doesn't preserve case, then we previously returned the lower case |
| 296 |
|
* form of the name. This didn't seem quite right since there are |
| 297 |
|
* non-case-preserving volumes that actually return mixed case. So now |
| 298 |
|
* we are returning exactly what we get from the system. |
| 299 |
|
*/ |
| 300 |
|
|
| 301 |
|
Tcl_UtfToLower(name); |
| 302 |
|
nativeMatchResult = NULL; |
| 303 |
|
|
| 304 |
|
if ((matchDotFiles == 0) && (name[0] == '.')) { |
| 305 |
|
/* |
| 306 |
|
* Ignore hidden files. |
| 307 |
|
*/ |
| 308 |
|
} else if (Tcl_StringMatch(name, newPattern) != 0) { |
| 309 |
|
nativeMatchResult = nativeName; |
| 310 |
|
} |
| 311 |
|
Tcl_DStringFree(&ds); |
| 312 |
|
|
| 313 |
|
if (nativeMatchResult == NULL) { |
| 314 |
|
continue; |
| 315 |
|
} |
| 316 |
|
|
| 317 |
|
/* |
| 318 |
|
* If the file matches, then we need to process the remainder of the |
| 319 |
|
* path. If there are more characters to process, then ensure matching |
| 320 |
|
* files are directories and call TclDoGlob. Otherwise, just add the |
| 321 |
|
* file to the result. |
| 322 |
|
*/ |
| 323 |
|
|
| 324 |
|
name = Tcl_WinTCharToUtf(nativeMatchResult, -1, &ds); |
| 325 |
|
Tcl_DStringAppend(dirPtr, name, -1); |
| 326 |
|
Tcl_DStringFree(&ds); |
| 327 |
|
|
| 328 |
|
fname = Tcl_DStringValue(dirPtr); |
| 329 |
|
nativeName = Tcl_WinUtfToTChar(fname, Tcl_DStringLength(dirPtr), &ds); |
| 330 |
|
attr = (*tclWinProcs->getFileAttributesProc)(nativeName); |
| 331 |
|
Tcl_DStringFree(&ds); |
| 332 |
|
|
| 333 |
|
if (tail == NULL) { |
| 334 |
|
int typeOk = 1; |
| 335 |
|
if (types != NULL) { |
| 336 |
|
if (types->perm != 0) { |
| 337 |
|
if ( |
| 338 |
|
((types->perm & TCL_GLOB_PERM_RONLY) && |
| 339 |
|
!(attr & FILE_ATTRIBUTE_READONLY)) || |
| 340 |
|
((types->perm & TCL_GLOB_PERM_HIDDEN) && |
| 341 |
|
!(attr & FILE_ATTRIBUTE_HIDDEN)) || |
| 342 |
|
((types->perm & TCL_GLOB_PERM_R) && |
| 343 |
|
(TclpAccess(fname, R_OK) != 0)) || |
| 344 |
|
((types->perm & TCL_GLOB_PERM_W) && |
| 345 |
|
(TclpAccess(fname, W_OK) != 0)) || |
| 346 |
|
((types->perm & TCL_GLOB_PERM_X) && |
| 347 |
|
(TclpAccess(fname, X_OK) != 0)) |
| 348 |
|
) { |
| 349 |
|
typeOk = 0; |
| 350 |
|
} |
| 351 |
|
} |
| 352 |
|
if (typeOk && types->type != 0) { |
| 353 |
|
struct stat buf; |
| 354 |
|
/* |
| 355 |
|
* We must match at least one flag to be listed |
| 356 |
|
*/ |
| 357 |
|
typeOk = 0; |
| 358 |
|
if (TclpLstat(fname, &buf) >= 0) { |
| 359 |
|
/* |
| 360 |
|
* In order bcdpfls as in 'find -t' |
| 361 |
|
*/ |
| 362 |
|
if ( |
| 363 |
|
((types->type & TCL_GLOB_TYPE_BLOCK) && |
| 364 |
|
S_ISBLK(buf.st_mode)) || |
| 365 |
|
((types->type & TCL_GLOB_TYPE_CHAR) && |
| 366 |
|
S_ISCHR(buf.st_mode)) || |
| 367 |
|
((types->type & TCL_GLOB_TYPE_DIR) && |
| 368 |
|
S_ISDIR(buf.st_mode)) || |
| 369 |
|
((types->type & TCL_GLOB_TYPE_PIPE) && |
| 370 |
|
S_ISFIFO(buf.st_mode)) || |
| 371 |
|
((types->type & TCL_GLOB_TYPE_FILE) && |
| 372 |
|
S_ISREG(buf.st_mode)) |
| 373 |
|
#ifdef S_ISLNK |
| 374 |
|
|| ((types->type & TCL_GLOB_TYPE_LINK) && |
| 375 |
|
S_ISLNK(buf.st_mode)) |
| 376 |
|
#endif |
| 377 |
|
#ifdef S_ISSOCK |
| 378 |
|
|| ((types->type & TCL_GLOB_TYPE_SOCK) && |
| 379 |
|
S_ISSOCK(buf.st_mode)) |
| 380 |
|
#endif |
| 381 |
|
) { |
| 382 |
|
typeOk = 1; |
| 383 |
|
} |
| 384 |
|
} else { |
| 385 |
|
/* Posix error occurred */ |
| 386 |
|
} |
| 387 |
|
} |
| 388 |
|
} |
| 389 |
|
if (typeOk) { |
| 390 |
|
Tcl_ListObjAppendElement(interp, resultPtr, |
| 391 |
|
Tcl_NewStringObj(fname, Tcl_DStringLength(dirPtr))); |
| 392 |
|
} |
| 393 |
|
} else if (attr & FILE_ATTRIBUTE_DIRECTORY) { |
| 394 |
|
Tcl_DStringAppend(dirPtr, "/", 1); |
| 395 |
|
result = TclDoGlob(interp, separators, dirPtr, tail, types); |
| 396 |
|
if (result != TCL_OK) { |
| 397 |
|
break; |
| 398 |
|
} |
| 399 |
|
} |
| 400 |
|
Tcl_DStringSetLength(dirPtr, dirLength); |
| 401 |
|
} |
| 402 |
|
|
| 403 |
|
FindClose(handle); |
| 404 |
|
Tcl_DStringFree(&dirString); |
| 405 |
|
Tcl_DStringFree(&patternString); |
| 406 |
|
|
| 407 |
|
return result; |
| 408 |
|
|
| 409 |
|
error: |
| 410 |
|
Tcl_DStringFree(&dirString); |
| 411 |
|
TclWinConvertError(GetLastError()); |
| 412 |
|
Tcl_ResetResult(interp); |
| 413 |
|
Tcl_AppendResult(interp, message, Tcl_DStringValue(dirPtr), "\": ", |
| 414 |
|
Tcl_PosixError(interp), (char *) NULL); |
| 415 |
|
return TCL_ERROR; |
| 416 |
|
} |
| 417 |
|
|
| 418 |
|
/* |
| 419 |
|
* TclpMatchFiles -- |
| 420 |
|
* |
| 421 |
|
* This function is now obsolete. Call the above function |
| 422 |
|
* 'TclpMatchFilesTypes' instead. |
| 423 |
|
*/ |
| 424 |
|
int |
| 425 |
|
TclpMatchFiles( |
| 426 |
|
Tcl_Interp *interp, /* Interpreter to receive results. */ |
| 427 |
|
char *separators, /* Directory separators to pass to TclDoGlob. */ |
| 428 |
|
Tcl_DString *dirPtr, /* Contains path to directory to search. */ |
| 429 |
|
char *pattern, /* Pattern to match against. */ |
| 430 |
|
char *tail) /* Pointer to end of pattern. Tail must |
| 431 |
|
* point to a location in pattern and must |
| 432 |
|
* not be static.*/ |
| 433 |
|
{ |
| 434 |
|
return TclpMatchFilesTypes(interp,separators,dirPtr,pattern,tail,NULL); |
| 435 |
|
} |
| 436 |
|
|
| 437 |
|
/* |
| 438 |
|
*---------------------------------------------------------------------- |
| 439 |
|
* |
| 440 |
|
* TclpGetUserHome -- |
| 441 |
|
* |
| 442 |
|
* This function takes the passed in user name and finds the |
| 443 |
|
* corresponding home directory specified in the password file. |
| 444 |
|
* |
| 445 |
|
* Results: |
| 446 |
|
* The result is a pointer to a string specifying the user's home |
| 447 |
|
* directory, or NULL if the user's home directory could not be |
| 448 |
|
* determined. Storage for the result string is allocated in |
| 449 |
|
* bufferPtr; the caller must call Tcl_DStringFree() when the result |
| 450 |
|
* is no longer needed. |
| 451 |
|
* |
| 452 |
|
* Side effects: |
| 453 |
|
* None. |
| 454 |
|
* |
| 455 |
|
*---------------------------------------------------------------------- |
| 456 |
|
*/ |
| 457 |
|
|
| 458 |
|
char * |
| 459 |
|
TclpGetUserHome(name, bufferPtr) |
| 460 |
|
CONST char *name; /* User name for desired home directory. */ |
| 461 |
|
Tcl_DString *bufferPtr; /* Uninitialized or free DString filled |
| 462 |
|
* with name of user's home directory. */ |
| 463 |
|
{ |
| 464 |
|
char *result; |
| 465 |
|
HINSTANCE netapiInst; |
| 466 |
|
|
| 467 |
|
result = NULL; |
| 468 |
|
|
| 469 |
|
Tcl_DStringInit(bufferPtr); |
| 470 |
|
|
| 471 |
|
netapiInst = LoadLibraryA("netapi32.dll"); |
| 472 |
|
if (netapiInst != NULL) { |
| 473 |
|
NETAPIBUFFERFREEPROC *netApiBufferFreeProc; |
| 474 |
|
NETGETDCNAMEPROC *netGetDCNameProc; |
| 475 |
|
NETUSERGETINFOPROC *netUserGetInfoProc; |
| 476 |
|
|
| 477 |
|
netApiBufferFreeProc = (NETAPIBUFFERFREEPROC *) |
| 478 |
|
GetProcAddress(netapiInst, "NetApiBufferFree"); |
| 479 |
|
netGetDCNameProc = (NETGETDCNAMEPROC *) |
| 480 |
|
GetProcAddress(netapiInst, "NetGetDCName"); |
| 481 |
|
netUserGetInfoProc = (NETUSERGETINFOPROC *) |
| 482 |
|
GetProcAddress(netapiInst, "NetUserGetInfo"); |
| 483 |
|
if ((netUserGetInfoProc != NULL) && (netGetDCNameProc != NULL) |
| 484 |
|
&& (netApiBufferFreeProc != NULL)) { |
| 485 |
|
USER_INFO_1 *uiPtr; |
| 486 |
|
Tcl_DString ds; |
| 487 |
|
int nameLen, badDomain; |
| 488 |
|
char *domain; |
| 489 |
|
WCHAR *wName, *wHomeDir, *wDomain; |
| 490 |
|
WCHAR buf[MAX_PATH]; |
| 491 |
|
|
| 492 |
|
badDomain = 0; |
| 493 |
|
nameLen = -1; |
| 494 |
|
wDomain = NULL; |
| 495 |
|
domain = strchr(name, '@'); |
| 496 |
|
if (domain != NULL) { |
| 497 |
|
Tcl_DStringInit(&ds); |
| 498 |
|
wName = Tcl_UtfToUniCharDString(domain + 1, -1, &ds); |
| 499 |
|
badDomain = (*netGetDCNameProc)(NULL, wName, |
| 500 |
|
(LPBYTE *) &wDomain); |
| 501 |
|
Tcl_DStringFree(&ds); |
| 502 |
|
nameLen = domain - name; |
| 503 |
|
} |
| 504 |
|
if (badDomain == 0) { |
| 505 |
|
Tcl_DStringInit(&ds); |
| 506 |
|
wName = Tcl_UtfToUniCharDString(name, nameLen, &ds); |
| 507 |
|
if ((*netUserGetInfoProc)(wDomain, wName, 1, |
| 508 |
|
(LPBYTE *) &uiPtr) == 0) { |
| 509 |
|
wHomeDir = uiPtr->usri1_home_dir; |
| 510 |
|
if ((wHomeDir != NULL) && (wHomeDir[0] != L'\0')) { |
| 511 |
|
Tcl_UniCharToUtfDString(wHomeDir, lstrlenW(wHomeDir), |
| 512 |
|
bufferPtr); |
| 513 |
|
} else { |
| 514 |
|
/* |
| 515 |
|
* User exists but has no home dir. Return |
| 516 |
|
* "{Windows Drive}:/users/default". |
| 517 |
|
*/ |
| 518 |
|
|
| 519 |
|
GetWindowsDirectoryW(buf, MAX_PATH); |
| 520 |
|
Tcl_UniCharToUtfDString(buf, 2, bufferPtr); |
| 521 |
|
Tcl_DStringAppend(bufferPtr, "/users/default", -1); |
| 522 |
|
} |
| 523 |
|
result = Tcl_DStringValue(bufferPtr); |
| 524 |
|
(*netApiBufferFreeProc)((void *) uiPtr); |
| 525 |
|
} |
| 526 |
|
Tcl_DStringFree(&ds); |
| 527 |
|
} |
| 528 |
|
if (wDomain != NULL) { |
| 529 |
|
(*netApiBufferFreeProc)((void *) wDomain); |
| 530 |
|
} |
| 531 |
|
} |
| 532 |
|
FreeLibrary(netapiInst); |
| 533 |
|
} |
| 534 |
|
if (result == NULL) { |
| 535 |
|
/* |
| 536 |
|
* Look in the "Password Lists" section of system.ini for the |
| 537 |
|
* local user. There are also entries in that section that begin |
| 538 |
|
* with a "*" character that are used by Windows for other |
| 539 |
|
* purposes; ignore user names beginning with a "*". |
| 540 |
|
*/ |
| 541 |
|
|
| 542 |
|
char buf[MAX_PATH]; |
| 543 |
|
|
| 544 |
|
if (name[0] != '*') { |
| 545 |
|
if (GetPrivateProfileStringA("Password Lists", name, "", buf, |
| 546 |
|
MAX_PATH, "system.ini") > 0) { |
| 547 |
|
/* |
| 548 |
|
* User exists, but there is no such thing as a home |
| 549 |
|
* directory in system.ini. Return "{Windows drive}:/". |
| 550 |
|
*/ |
| 551 |
|
|
| 552 |
|
GetWindowsDirectoryA(buf, MAX_PATH); |
| 553 |
|
Tcl_DStringAppend(bufferPtr, buf, 3); |
| 554 |
|
result = Tcl_DStringValue(bufferPtr); |
| 555 |
|
} |
| 556 |
|
} |
| 557 |
|
} |
| 558 |
|
|
| 559 |
|
return result; |
| 560 |
|
} |
| 561 |
|
|
| 562 |
|
/* |
| 563 |
|
*--------------------------------------------------------------------------- |
| 564 |
|
* |
| 565 |
|
* TclpAccess -- |
| 566 |
|
* |
| 567 |
|
* This function replaces the library version of access(), fixing the |
| 568 |
|
* following bugs: |
| 569 |
|
* |
| 570 |
|
* 1. access() returns that all files have execute permission. |
| 571 |
|
* |
| 572 |
|
* Results: |
| 573 |
|
* See access documentation. |
| 574 |
|
* |
| 575 |
|
* Side effects: |
| 576 |
|
* See access documentation. |
| 577 |
|
* |
| 578 |
|
*--------------------------------------------------------------------------- |
| 579 |
|
*/ |
| 580 |
|
|
| 581 |
|
int |
| 582 |
|
TclpAccess( |
| 583 |
|
CONST char *path, /* Path of file to access (UTF-8). */ |
| 584 |
|
int mode) /* Permission setting. */ |
| 585 |
|
{ |
| 586 |
|
Tcl_DString ds; |
| 587 |
|
TCHAR *nativePath; |
| 588 |
|
DWORD attr; |
| 589 |
|
|
| 590 |
|
nativePath = Tcl_WinUtfToTChar(path, -1, &ds); |
| 591 |
|
attr = (*tclWinProcs->getFileAttributesProc)(nativePath); |
| 592 |
|
Tcl_DStringFree(&ds); |
| 593 |
|
|
| 594 |
|
if (attr == 0xffffffff) { |
| 595 |
|
/* |
| 596 |
|
* File doesn't exist. |
| 597 |
|
*/ |
| 598 |
|
|
| 599 |
|
TclWinConvertError(GetLastError()); |
| 600 |
|
return -1; |
| 601 |
|
} |
| 602 |
|
|
| 603 |
|
if ((mode & W_OK) && (attr & FILE_ATTRIBUTE_READONLY)) { |
| 604 |
|
/* |
| 605 |
|
* File is not writable. |
| 606 |
|
*/ |
| 607 |
|
|
| 608 |
|
Tcl_SetErrno(EACCES); |
| 609 |
|
return -1; |
| 610 |
|
} |
| 611 |
|
|
| 612 |
|
if (mode & X_OK) { |
| 613 |
|
CONST char *p; |
| 614 |
|
|
| 615 |
|
if (attr & FILE_ATTRIBUTE_DIRECTORY) { |
| 616 |
|
/* |
| 617 |
|
* Directories are always executable. |
| 618 |
|
*/ |
| 619 |
|
|
| 620 |
|
return 0; |
| 621 |
|
} |
| 622 |
|
p = strrchr(path, '.'); |
| 623 |
|
if (p != NULL) { |
| 624 |
|
p++; |
| 625 |
|
if ((stricmp(p, "exe") == 0) |
| 626 |
|
|| (stricmp(p, "com") == 0) |
| 627 |
|
|| (stricmp(p, "bat") == 0)) { |
| 628 |
|
/* |
| 629 |
|
* File that ends with .exe, .com, or .bat is executable. |
| 630 |
|
*/ |
| 631 |
|
|
| 632 |
|
return 0; |
| 633 |
|
} |
| 634 |
|
} |
| 635 |
|
Tcl_SetErrno(EACCES); |
| 636 |
|
return -1; |
| 637 |
|
} |
| 638 |
|
|
| 639 |
|
return 0; |
| 640 |
|
} |
| 641 |
|
|
| 642 |
|
/* |
| 643 |
|
*---------------------------------------------------------------------- |
| 644 |
|
* |
| 645 |
|
* TclpChdir -- |
| 646 |
|
* |
| 647 |
|
* This function replaces the library version of chdir(). |
| 648 |
|
* |
| 649 |
|
* Results: |
| 650 |
|
* See chdir() documentation. |
| 651 |
|
* |
| 652 |
|
* Side effects: |
| 653 |
|
* See chdir() documentation. |
| 654 |
|
* |
| 655 |
|
*---------------------------------------------------------------------- |
| 656 |
|
*/ |
| 657 |
|
|
| 658 |
|
int |
| 659 |
|
TclpChdir(path) |
| 660 |
|
CONST char *path; /* Path to new working directory (UTF-8). */ |
| 661 |
|
{ |
| 662 |
|
int result; |
| 663 |
|
Tcl_DString ds; |
| 664 |
|
TCHAR *nativePath; |
| 665 |
|
|
| 666 |
|
nativePath = Tcl_WinUtfToTChar(path, -1, &ds); |
| 667 |
|
result = (*tclWinProcs->setCurrentDirectoryProc)(nativePath); |
| 668 |
|
Tcl_DStringFree(&ds); |
| 669 |
|
|
| 670 |
|
if (result == 0) { |
| 671 |
|
TclWinConvertError(GetLastError()); |
| 672 |
|
return -1; |
| 673 |
|
} |
| 674 |
|
return 0; |
| 675 |
|
} |
| 676 |
|
|
| 677 |
|
/* |
| 678 |
|
*---------------------------------------------------------------------- |
| 679 |
|
* |
| 680 |
|
* TclpGetCwd -- |
| 681 |
|
* |
| 682 |
|
* This function replaces the library version of getcwd(). |
| 683 |
|
* |
| 684 |
|
* Results: |
| 685 |
|
* The result is a pointer to a string specifying the current |
| 686 |
|
* directory, or NULL if the current directory could not be |
| 687 |
|
* determined. If NULL is returned, an error message is left in the |
| 688 |
|
* interp's result. Storage for the result string is allocated in |
| 689 |
|
* bufferPtr; the caller must call Tcl_DStringFree() when the result |
| 690 |
|
* is no longer needed. |
| 691 |
|
* |
| 692 |
|
* Side effects: |
| 693 |
|
* None. |
| 694 |
|
* |
| 695 |
|
*---------------------------------------------------------------------- |
| 696 |
|
*/ |
| 697 |
|
|
| 698 |
|
char * |
| 699 |
|
TclpGetCwd(interp, bufferPtr) |
| 700 |
|
Tcl_Interp *interp; /* If non-NULL, used for error reporting. */ |
| 701 |
|
Tcl_DString *bufferPtr; /* Uninitialized or free DString filled |
| 702 |
|
* with name of current directory. */ |
| 703 |
|
{ |
| 704 |
|
WCHAR buffer[MAX_PATH]; |
| 705 |
|
char *p; |
| 706 |
|
|
| 707 |
|
if ((*tclWinProcs->getCurrentDirectoryProc)(MAX_PATH, buffer) == 0) { |
| 708 |
|
TclWinConvertError(GetLastError()); |
| 709 |
|
if (interp != NULL) { |
| 710 |
|
Tcl_AppendResult(interp, |
| 711 |
|
"error getting working directory name: ", |
| 712 |
|
Tcl_PosixError(interp), (char *) NULL); |
| 713 |
|
} |
| 714 |
|
return NULL; |
| 715 |
|
} |
| 716 |
|
|
| 717 |
|
/* |
| 718 |
|
* Watch for the wierd Windows c:\\UNC syntax. |
| 719 |
|
*/ |
| 720 |
|
|
| 721 |
|
if (tclWinProcs->useWide) { |
| 722 |
|
WCHAR *native; |
| 723 |
|
|
| 724 |
|
native = (WCHAR *) buffer; |
| 725 |
|
if ((native[0] != '\0') && (native[1] == ':') |
| 726 |
|
&& (native[2] == '\\') && (native[3] == '\\')) { |
| 727 |
|
native += 2; |
| 728 |
|
} |
| 729 |
|
Tcl_WinTCharToUtf((TCHAR *) native, -1, bufferPtr); |
| 730 |
|
} else { |
| 731 |
|
char *native; |
| 732 |
|
|
| 733 |
|
native = (char *) buffer; |
| 734 |
|
if ((native[0] != '\0') && (native[1] == ':') |
| 735 |
|
&& (native[2] == '\\') && (native[3] == '\\')) { |
| 736 |
|
native += 2; |
| 737 |
|
} |
| 738 |
|
Tcl_WinTCharToUtf((TCHAR *) native, -1, bufferPtr); |
| 739 |
|
} |
| 740 |
|
|
| 741 |
|
/* |
| 742 |
|
* Convert to forward slashes for easier use in scripts. |
| 743 |
|
*/ |
| 744 |
|
|
| 745 |
|
for (p = Tcl_DStringValue(bufferPtr); *p != '\0'; p++) { |
| 746 |
|
if (*p == '\\') { |
| 747 |
|
*p = '/'; |
| 748 |
|
} |
| 749 |
|
} |
| 750 |
|
return Tcl_DStringValue(bufferPtr); |
| 751 |
|
} |
| 752 |
|
|
| 753 |
|
/* |
| 754 |
|
*---------------------------------------------------------------------- |
| 755 |
|
* |
| 756 |
|
* TclpStat -- |
| 757 |
|
* |
| 758 |
|
* This function replaces the library version of stat(), fixing |
| 759 |
|
* the following bugs: |
| 760 |
|
* |
| 761 |
|
* 1. stat("c:") returns an error. |
| 762 |
|
* 2. Borland stat() return time in GMT instead of localtime. |
| 763 |
|
* 3. stat("\\server\mount") would return error. |
| 764 |
|
* 4. Accepts slashes or backslashes. |
| 765 |
|
* 5. st_dev and st_rdev were wrong for UNC paths. |
| 766 |
|
* |
| 767 |
|
* Results: |
| 768 |
|
* See stat documentation. |
| 769 |
|
* |
| 770 |
|
* Side effects: |
| 771 |
|
* See stat documentation. |
| 772 |
|
* |
| 773 |
|
*---------------------------------------------------------------------- |
| 774 |
|
*/ |
| 775 |
|
|
| 776 |
|
int |
| 777 |
|
TclpStat(path, statPtr) |
| 778 |
|
CONST char *path; /* Path of file to stat (UTF-8). */ |
| 779 |
|
struct stat *statPtr; /* Filled with results of stat call. */ |
| 780 |
|
{ |
| 781 |
|
Tcl_DString ds; |
| 782 |
|
TCHAR *nativePath; |
| 783 |
|
WIN32_FIND_DATAT data; |
| 784 |
|
HANDLE handle; |
| 785 |
|
DWORD attr; |
| 786 |
|
WCHAR nativeFullPath[MAX_PATH]; |
| 787 |
|
TCHAR *nativePart; |
| 788 |
|
char *p, *fullPath; |
| 789 |
|
int dev, mode; |
| 790 |
|
|
| 791 |
|
/* |
| 792 |
|
* Eliminate file names containing wildcard characters, or subsequent |
| 793 |
|
* call to FindFirstFile() will expand them, matching some other file. |
| 794 |
|
*/ |
| 795 |
|
|
| 796 |
|
if (strpbrk(path, "?*") != NULL) { |
| 797 |
|
Tcl_SetErrno(ENOENT); |
| 798 |
|
return -1; |
| 799 |
|
} |
| 800 |
|
|
| 801 |
|
nativePath = Tcl_WinUtfToTChar(path, -1, &ds); |
| 802 |
|
handle = (*tclWinProcs->findFirstFileProc)(nativePath, &data); |
| 803 |
|
if (handle == INVALID_HANDLE_VALUE) { |
| 804 |
|
/* |
| 805 |
|
* FindFirstFile() doesn't work on root directories, so call |
| 806 |
|
* GetFileAttributes() to see if the specified file exists. |
| 807 |
|
*/ |
| 808 |
|
|
| 809 |
|
attr = (*tclWinProcs->getFileAttributesProc)(nativePath); |
| 810 |
|
if (attr == 0xffffffff) { |
| 811 |
|
Tcl_DStringFree(&ds); |
| 812 |
|
Tcl_SetErrno(ENOENT); |
| 813 |
|
return -1; |
| 814 |
|
} |
| 815 |
|
|
| 816 |
|
/* |
| 817 |
|
* Make up some fake information for this file. It has the |
| 818 |
|
* correct file attributes and a time of 0. |
| 819 |
|
*/ |
| 820 |
|
|
| 821 |
|
memset(&data, 0, sizeof(data)); |
| 822 |
|
data.a.dwFileAttributes = attr; |
| 823 |
|
} else { |
| 824 |
|
FindClose(handle); |
| 825 |
|
} |
| 826 |
|
|
| 827 |
|
(*tclWinProcs->getFullPathNameProc)(nativePath, MAX_PATH, nativeFullPath, |
| 828 |
|
&nativePart); |
| 829 |
|
|
| 830 |
|
Tcl_DStringFree(&ds); |
| 831 |
|
fullPath = Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds); |
| 832 |
|
|
| 833 |
|
dev = -1; |
| 834 |
|
if ((fullPath[0] == '\\') && (fullPath[1] == '\\')) { |
| 835 |
|
char *p; |
| 836 |
|
DWORD dw; |
| 837 |
|
TCHAR *nativeVol; |
| 838 |
|
Tcl_DString volString; |
| 839 |
|
|
| 840 |
|
p = strchr(fullPath + 2, '\\'); |
| 841 |
|
p = strchr(p + 1, '\\'); |
| 842 |
|
if (p == NULL) { |
| 843 |
|
/* |
| 844 |
|
* Add terminating backslash to fullpath or |
| 845 |
|
* GetVolumeInformation() won't work. |
| 846 |
|
*/ |
| 847 |
|
|
| 848 |
|
fullPath = Tcl_DStringAppend(&ds, "\\", 1); |
| 849 |
|
p = fullPath + Tcl_DStringLength(&ds); |
| 850 |
|
} else { |
| 851 |
|
p++; |
| 852 |
|
} |
| 853 |
|
nativeVol = Tcl_WinUtfToTChar(fullPath, p - fullPath, &volString); |
| 854 |
|
dw = (DWORD) -1; |
| 855 |
|
(*tclWinProcs->getVolumeInformationProc)(nativeVol, NULL, 0, &dw, |
| 856 |
|
NULL, NULL, NULL, 0); |
| 857 |
|
/* |
| 858 |
|
* GetFullPathName() turns special devices like "NUL" into "\\.\NUL", |
| 859 |
|
* but GetVolumeInformation() returns failure for "\\.\NUL". This |
| 860 |
|
* will cause "NUL" to get a drive number of -1, which makes about |
| 861 |
|
* as much sense as anything since the special devices don't live on |
| 862 |
|
* any drive. |
| 863 |
|
*/ |
| 864 |
|
|
| 865 |
|
dev = dw; |
| 866 |
|
Tcl_DStringFree(&volString); |
| 867 |
|
} else if ((fullPath[0] != '\0') && (fullPath[1] == ':')) { |
| 868 |
|
dev = Tcl_UniCharToLower(fullPath[0]) - 'a'; |
| 869 |
|
} |
| 870 |
|
Tcl_DStringFree(&ds); |
| 871 |
|
|
| 872 |
|
attr = data.a.dwFileAttributes; |
| 873 |
|
mode = (attr & FILE_ATTRIBUTE_DIRECTORY) ? S_IFDIR | S_IEXEC : S_IFREG; |
| 874 |
|
mode |= (attr & FILE_ATTRIBUTE_READONLY) ? S_IREAD : S_IREAD | S_IWRITE; |
| 875 |
|
p = strrchr(path, '.'); |
| 876 |
|
if (p != NULL) { |
| 877 |
|
if ((lstrcmpiA(p, ".exe") == 0) |
| 878 |
|
|| (lstrcmpiA(p, ".com") == 0) |
| 879 |
|
|| (lstrcmpiA(p, ".bat") == 0) |
| 880 |
|
|| (lstrcmpiA(p, ".pif") == 0)) { |
| 881 |
|
mode |= S_IEXEC; |
| 882 |
|
} |
| 883 |
|
} |
| 884 |
|
|
| 885 |
|
/* |
| 886 |
|
* Propagate the S_IREAD, S_IWRITE, S_IEXEC bits to the group and |
| 887 |
|
* other positions. |
| 888 |
|
*/ |
| 889 |
|
|
| 890 |
|
mode |= (mode & 0x0700) >> 3; |
| 891 |
|
mode |= (mode & 0x0700) >> 6; |
| 892 |
|
|
| 893 |
|
statPtr->st_dev = (dev_t) dev; |
| 894 |
|
statPtr->st_ino = 0; |
| 895 |
|
statPtr->st_mode = (unsigned short) mode; |
| 896 |
|
statPtr->st_nlink = 1; |
| 897 |
|
statPtr->st_uid = 0; |
| 898 |
|
statPtr->st_gid = 0; |
| 899 |
|
statPtr->st_rdev = (dev_t) dev; |
| 900 |
|
statPtr->st_size = data.a.nFileSizeLow; |
| 901 |
|
statPtr->st_atime = ToCTime(data.a.ftLastAccessTime); |
| 902 |
|
statPtr->st_mtime = ToCTime(data.a.ftLastWriteTime); |
| 903 |
|
statPtr->st_ctime = ToCTime(data.a.ftCreationTime); |
| 904 |
|
return 0; |
| 905 |
|
} |
| 906 |
|
|
| 907 |
|
static time_t |
| 908 |
|
ToCTime( |
| 909 |
|
FILETIME fileTime) /* UTC Time to convert to local time_t. */ |
| 910 |
|
{ |
| 911 |
|
FILETIME localFileTime; |
| 912 |
|
SYSTEMTIME systemTime; |
| 913 |
|
struct tm tm; |
| 914 |
|
|
| 915 |
|
if (FileTimeToLocalFileTime(&fileTime, &localFileTime) == 0) { |
| 916 |
|
return 0; |
| 917 |
|
} |
| 918 |
|
if (FileTimeToSystemTime(&localFileTime, &systemTime) == 0) { |
| 919 |
|
return 0; |
| 920 |
|
} |
| 921 |
|
tm.tm_sec = systemTime.wSecond; |
| 922 |
|
tm.tm_min = systemTime.wMinute; |
| 923 |
|
tm.tm_hour = systemTime.wHour; |
| 924 |
|
tm.tm_mday = systemTime.wDay; |
| 925 |
|
tm.tm_mon = systemTime.wMonth - 1; |
| 926 |
|
tm.tm_year = systemTime.wYear - 1900; |
| 927 |
|
tm.tm_wday = 0; |
| 928 |
|
tm.tm_yday = 0; |
| 929 |
|
tm.tm_isdst = -1; |
| 930 |
|
|
| 931 |
|
return mktime(&tm); |
| 932 |
|
} |
| 933 |
|
|
| 934 |
|
#if 0 |
| 935 |
|
|
| 936 |
|
/* |
| 937 |
|
* Borland's stat doesn't take into account localtime. |
| 938 |
|
*/ |
| 939 |
|
|
| 940 |
|
if ((result == 0) && (buf->st_mtime != 0)) { |
| 941 |
|
TIME_ZONE_INFORMATION tz; |
| 942 |
|
int time, bias; |
| 943 |
|
|
| 944 |
|
time = GetTimeZoneInformation(&tz); |
| 945 |
|
bias = tz.Bias; |
| 946 |
|
if (time == TIME_ZONE_ID_DAYLIGHT) { |
| 947 |
|
bias += tz.DaylightBias; |
| 948 |
|
} |
| 949 |
|
bias *= 60; |
| 950 |
|
buf->st_atime -= bias; |
| 951 |
|
buf->st_ctime -= bias; |
| 952 |
|
buf->st_mtime -= bias; |
| 953 |
|
} |
| 954 |
|
|
| 955 |
|
#endif |
| 956 |
|
|
| 957 |
|
|
| 958 |
|
#if 0 |
| 959 |
|
/* |
| 960 |
|
*------------------------------------------------------------------------- |
| 961 |
|
* |
| 962 |
|
* TclWinResolveShortcut -- |
| 963 |
|
* |
| 964 |
|
* Resolve a potential Windows shortcut to get the actual file or |
| 965 |
|
* directory in question. |
| 966 |
|
* |
| 967 |
|
* Results: |
| 968 |
|
* Returns 1 if the shortcut could be resolved, or 0 if there was |
| 969 |
|
* an error or if the filename was not a shortcut. |
| 970 |
|
* If bufferPtr did hold the name of a shortcut, it is modified to |
| 971 |
|
* hold the resolved target of the shortcut instead. |
| 972 |
|
* |
| 973 |
|
* Side effects: |
| 974 |
|
* Loads and unloads OLE package to determine if filename refers to |
| 975 |
|
* a shortcut. |
| 976 |
|
* |
| 977 |
|
*------------------------------------------------------------------------- |
| 978 |
|
*/ |
| 979 |
|
|
| 980 |
|
int |
| 981 |
|
TclWinResolveShortcut(bufferPtr) |
| 982 |
|
Tcl_DString *bufferPtr; /* Holds name of file to resolve. On |
| 983 |
|
* return, holds resolved file name. */ |
| 984 |
|
{ |
| 985 |
|
HRESULT hres; |
| 986 |
|
IShellLink *psl; |
| 987 |
|
IPersistFile *ppf; |
| 988 |
|
WIN32_FIND_DATA wfd; |
| 989 |
|
WCHAR wpath[MAX_PATH]; |
| 990 |
|
char *path, *ext; |
| 991 |
|
char realFileName[MAX_PATH]; |
| 992 |
|
|
| 993 |
|
/* |
| 994 |
|
* Windows system calls do not automatically resolve |
| 995 |
|
* shortcuts like UNIX automatically will with symbolic links. |
| 996 |
|
*/ |
| 997 |
|
|
| 998 |
|
path = Tcl_DStringValue(bufferPtr); |
| 999 |
|
ext = strrchr(path, '.'); |
| 1000 |
|
if ((ext == NULL) || (stricmp(ext, ".lnk") != 0)) { |
| 1001 |
|
return 0; |
| 1002 |
|
} |
| 1003 |
|
|
| 1004 |
|
CoInitialize(NULL); |
| 1005 |
|
path = Tcl_DStringValue(bufferPtr); |
| 1006 |
|
realFileName[0] = '\0'; |
| 1007 |
|
hres = CoCreateInstance(&CLSID_ShellLink, NULL, CLSCTX_INPROC_SERVER, |
| 1008 |
|
&IID_IShellLink, &psl); |
| 1009 |
|
if (SUCCEEDED(hres)) { |
| 1010 |
|
hres = psl->lpVtbl->QueryInterface(psl, &IID_IPersistFile, &ppf); |
| 1011 |
|
if (SUCCEEDED(hres)) { |
| 1012 |
|
MultiByteToWideChar(CP_ACP, 0, path, -1, wpath, sizeof(wpath)); |
| 1013 |
|
hres = ppf->lpVtbl->Load(ppf, wpath, STGM_READ); |
| 1014 |
|
if (SUCCEEDED(hres)) { |
| 1015 |
|
hres = psl->lpVtbl->Resolve(psl, NULL, |
| 1016 |
|
SLR_ANY_MATCH | SLR_NO_UI); |
| 1017 |
|
if (SUCCEEDED(hres)) { |
| 1018 |
|
hres = psl->lpVtbl->GetPath(psl, realFileName, MAX_PATH, |
| 1019 |
|
&wfd, 0); |
| 1020 |
|
} |
| 1021 |
|
} |
| 1022 |
|
ppf->lpVtbl->Release(ppf); |
| 1023 |
|
} |
| 1024 |
|
psl->lpVtbl->Release(psl); |
| 1025 |
|
} |
| 1026 |
|
CoUninitialize(); |
| 1027 |
|
|
| 1028 |
|
if (realFileName[0] != '\0') { |
| 1029 |
|
Tcl_DStringSetLength(bufferPtr, 0); |
| 1030 |
|
Tcl_DStringAppend(bufferPtr, realFileName, -1); |
| 1031 |
|
return 1; |
| 1032 |
|
} |
| 1033 |
|
return 0; |
| 1034 |
|
} |
| 1035 |
|
#endif |
| 1036 |
|
|
| 1037 |
|
/* End of tclwinfile.c */ |
Parent Directory
| 
Revision Log
| 
Patch