Initial revision

1 files changed, 647 insertions, 0 deletions

diff --git a/win/tclWinFile.c b/win/tclWinFile.c
new file mode 100644
index 0000000..9d97b02
--- /dev/null
+++ b/win/tclWinFile.c
@@ -0,0 +1,647 @@
+/* 
+ * 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-1996 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tclWinFile.c 1.45 97/10/29 19:08:35
+ */
+
+#include "tclWinInt.h"
+#include <sys/stat.h>
+#include <shlobj.h>
+
+/*
+ * The variable below caches the name of the current working directory
+ * in order to avoid repeated calls to getcwd.  The string is malloc-ed.
+ * NULL means the cache needs to be refreshed.
+ */
+
+static char *currentDir =  NULL;
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FindExecutable --
+ *
+ *	This procedure computes the absolute path name of the current
+ *	application, given its argv[0] value.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The variable tclExecutableName gets filled in with the file
+ *	name for the application, if we figured it out.  If we couldn't
+ *	figure it out, Tcl_FindExecutable is set to NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_FindExecutable(argv0)
+    char *argv0;		/* The value of the application's argv[0]. */
+{
+    Tcl_DString buffer;
+    int length;
+
+    Tcl_DStringInit(&buffer);
+
+    if (tclExecutableName != NULL) {
+	ckfree(tclExecutableName);
+	tclExecutableName = NULL;
+    }
+
+    /*
+     * Under Windows we ignore argv0, and return the path for the file used to
+     * create this process.
+     */
+
+    Tcl_DStringSetLength(&buffer, MAX_PATH+1);
+    length = GetModuleFileName(NULL, Tcl_DStringValue(&buffer), MAX_PATH+1);
+    if (length > 0) {
+	tclExecutableName = (char *) ckalloc((unsigned) (length + 1));
+	strcpy(tclExecutableName, Tcl_DStringValue(&buffer));
+    }
+    Tcl_DStringFree(&buffer);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclMatchFiles --
+ *
+ *	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 interp->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
+TclMatchFiles(interp, separators, dirPtr, pattern, tail)
+    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. */
+{
+    char drivePattern[4] = "?:\\";
+    char *newPattern, *p, *dir, *root, c;
+    char *src, *dest;
+    int length, matchDotFiles;
+    int result = TCL_OK;
+    int baseLength = Tcl_DStringLength(dirPtr);
+    Tcl_DString buffer;
+    DWORD atts, volFlags;
+    HANDLE handle;
+    WIN32_FIND_DATA data;
+    BOOL found;
+
+    /*
+     * Convert the path to normalized form since some interfaces only
+     * accept backslashes.  Also, ensure that the directory ends with a
+     * separator character.
+     */
+
+    Tcl_DStringInit(&buffer);
+    if (baseLength == 0) {
+	Tcl_DStringAppend(&buffer, ".", 1);
+    } else {
+	Tcl_DStringAppend(&buffer, Tcl_DStringValue(dirPtr),
+		Tcl_DStringLength(dirPtr));
+    }
+    for (p = Tcl_DStringValue(&buffer); *p != '\0'; p++) {
+	if (*p == '/') {
+	    *p = '\\';
+	}
+    }
+    p--;
+    if (*p != '\\' && *p != ':') {
+	Tcl_DStringAppend(&buffer, "\\", 1);
+    }
+    dir = Tcl_DStringValue(&buffer);
+    
+    /*
+     * First verify that the specified path is actually a directory.
+     */
+
+    atts = GetFileAttributes(dir);
+    if ((atts == 0xFFFFFFFF) || ((atts & FILE_ATTRIBUTE_DIRECTORY) == 0)) {
+	Tcl_DStringFree(&buffer);
+	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 = GetVolumeInformation(NULL, NULL, 0, NULL,
+		    NULL, &volFlags, NULL, 0);
+	    break;
+	case TCL_PATH_VOLUME_RELATIVE:
+	    if (*dir == '\\') {
+		root = NULL;
+	    } else {
+		root = drivePattern;
+		*root = *dir;
+	    }
+	    found = GetVolumeInformation(root, NULL, 0, NULL,
+		    NULL, &volFlags, NULL, 0);
+	    break;
+	case TCL_PATH_ABSOLUTE:
+	    if (dir[1] == ':') {
+		root = drivePattern;
+		*root = *dir;
+		found = GetVolumeInformation(root, NULL, 0, NULL,
+			NULL, &volFlags, NULL, 0);
+	    } else if (dir[1] == '\\') {
+		p = strchr(dir+2, '\\');
+		p = strchr(p+1, '\\');
+		p++;
+		c = *p;
+		*p = 0;
+		found = GetVolumeInformation(dir, NULL, 0, NULL,
+			NULL, &volFlags, NULL, 0);
+		*p = c;
+	    }
+	    break;
+    }
+
+    if (!found) {
+	Tcl_DStringFree(&buffer);
+	TclWinConvertError(GetLastError());
+	Tcl_ResetResult(interp);
+	Tcl_AppendResult(interp, "couldn't read volume information for \"",
+		dirPtr->string, "\": ", Tcl_PosixError(interp), (char *) NULL);
+	return TCL_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.
+     */
+
+    length = tail - pattern;
+    newPattern = ckalloc(length+1);
+    for (src = pattern, dest = newPattern; src < tail; src++, dest++) {
+	*dest = (char) tolower(*src);
+    }
+    *dest = '\0';
+    
+    /*
+     * We need to check all files in the directory, so append a *.*
+     * to the path. 
+     */
+
+
+    dir = Tcl_DStringAppend(&buffer, "*.*", 3);
+
+    /*
+     * Now open the directory for reading and iterate over the contents.
+     */
+
+    handle = FindFirstFile(dir, &data);
+    Tcl_DStringFree(&buffer);
+
+    if (handle == INVALID_HANDLE_VALUE) {
+	TclWinConvertError(GetLastError());
+	Tcl_ResetResult(interp);
+	Tcl_AppendResult(interp, "couldn't read directory \"",
+		dirPtr->string, "\": ", Tcl_PosixError(interp), (char *) NULL);
+	ckfree(newPattern);
+	return TCL_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.
+     */
+
+    Tcl_DStringInit(&buffer);
+    for (found = 1; found; found = FindNextFile(handle, &data)) {
+	char *matchResult;
+
+	/*
+	 * Ignore hidden files.
+	 */
+
+	if (!matchDotFiles && (data.cFileName[0] == '.')) {
+	    continue;
+	}
+
+	/*
+	 * Check to see if the file matches the pattern.  We need to convert
+	 * the file name to lower case for comparison purposes.  Note that we
+	 * are ignoring the case sensitivity flag because Windows doesn't honor
+	 * case even if the volume is case sensitive.  If the volume also
+	 * doesn't preserve case, then we return the lower case form of the
+	 * name, otherwise we return the system form.
+	 */
+
+	matchResult = NULL;
+	Tcl_DStringSetLength(&buffer, 0);
+	Tcl_DStringAppend(&buffer, data.cFileName, -1);
+	for (p = buffer.string; *p != '\0'; p++) {
+	    *p = (char) tolower(*p);
+	}
+	if (Tcl_StringMatch(buffer.string, newPattern)) {
+	    if (volFlags & FS_CASE_IS_PRESERVED) {
+		matchResult = data.cFileName;
+	    } else {
+		matchResult = buffer.string;
+	    }	
+	}
+
+	if (matchResult == 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.
+	 */
+
+	Tcl_DStringSetLength(dirPtr, baseLength);
+	Tcl_DStringAppend(dirPtr, matchResult, -1);
+	if (tail == NULL) {
+	    Tcl_AppendElement(interp, dirPtr->string);
+	} else {
+	    atts = GetFileAttributes(dirPtr->string);
+	    if (atts & FILE_ATTRIBUTE_DIRECTORY) {
+		Tcl_DStringAppend(dirPtr, "/", 1);
+		result = TclDoGlob(interp, separators, dirPtr, tail);
+		if (result != TCL_OK) {
+		    break;
+		}
+	    }
+	}
+    }
+
+    Tcl_DStringFree(&buffer);
+    FindClose(handle);
+    ckfree(newPattern);
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclChdir --
+ *
+ *	Change the current working directory.
+ *
+ * Results:
+ *	The result is a standard Tcl result.  If an error occurs and 
+ *	interp isn't NULL, an error message is left in interp->result.
+ *
+ * Side effects:
+ *	The working directory for this application is changed.  Also
+ *	the cache maintained used by TclGetCwd is deallocated and
+ *	set to NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclChdir(interp, dirName)
+    Tcl_Interp *interp;		/* If non NULL, used for error reporting. */
+    char *dirName;     		/* Path to new working directory. */
+{
+    if (currentDir != NULL) {
+	ckfree(currentDir);
+	currentDir = NULL;
+    }
+    if (!SetCurrentDirectory(dirName)) {
+	TclWinConvertError(GetLastError());
+	if (interp != NULL) {
+	    Tcl_AppendResult(interp, "couldn't change working directory to \"",
+		    dirName, "\": ", Tcl_PosixError(interp), (char *) NULL);
+	}
+	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetCwd --
+ *
+ *	Return the path name of the current working directory.
+ *
+ * Results:
+ *	The result is the full path name of the current working
+ *	directory, or NULL if an error occurred while figuring it
+ *	out.  If an error occurs and interp isn't NULL, an error
+ *	message is left in interp->result.
+ *
+ * Side effects:
+ *	The path name is cached to avoid having to recompute it
+ *	on future calls;  if it is already cached, the cached
+ *	value is returned.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TclGetCwd(interp)
+    Tcl_Interp *interp;		/* If non NULL, used for error reporting. */
+{
+    static char buffer[MAXPATHLEN+1];
+    char *bufPtr, *p;
+
+    if (currentDir == NULL) {
+	if (GetCurrentDirectory(MAXPATHLEN+1, buffer) == 0) {
+	    TclWinConvertError(GetLastError());
+	    if (interp != NULL) {
+		if (errno == ERANGE) {
+		    Tcl_SetResult(interp,
+			    "working directory name is too long",
+			    TCL_STATIC);
+		} else {
+		    Tcl_AppendResult(interp,
+			    "error getting working directory name: ",
+			    Tcl_PosixError(interp), (char *) NULL);
+		}
+	    }
+	    return NULL;
+	}
+	/*
+	 * Watch for the wierd Windows '95 c:\\UNC syntax.
+	 */
+
+	if (buffer[0] != '\0' && buffer[1] == ':' && buffer[2] == '\\'
+		&& buffer[3] == '\\') {
+	    bufPtr = &buffer[2];
+	} else {
+	    bufPtr = buffer;
+	}
+
+	/*
+	 * Convert to forward slashes for easier use in scripts.
+	 */
+
+	for (p = bufPtr; *p != '\0'; p++) {
+	    if (*p == '\\') {
+		*p = '/';
+	    }
+	}
+    }
+    return bufPtr;
+}
+
+#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
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclWinStat, TclWinLstat --
+ *
+ *	These functions replace the library versions of stat and lstat.
+ *
+ *	The stat and lstat functions provided by some Windows compilers 
+ *	are incomplete.  Ideally, a complete rewrite of stat would go
+ *	here; now, the only fix is that stat("c:") used to return an
+ *	error instead infor for current dir on specified drive.
+ *
+ * Results:
+ *	See stat documentation.
+ *
+ * Side effects:
+ *	See stat documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclWinStat(path, buf)
+    CONST char *path;		/* Path of file to stat (in current CP). */
+    struct stat *buf;		/* Filled with results of stat call. */
+{
+    char name[4];
+    int result;
+
+    if ((strlen(path) == 2) && (path[1] == ':')) {
+	strcpy(name, path);
+	name[2] = '.';
+	name[3] = '\0';
+	path = name;
+    }
+
+#undef stat
+
+    result = stat(path, buf);
+
+#ifndef _MSC_VER
+
+    /*
+     * 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
+
+    return result;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclWinAccess --
+ *
+ *	This function replaces the library version of access.
+ *
+ *	The library version of access returns that all files have execute
+ *	permission.
+ *
+ * Results:
+ *	See access documentation.
+ *
+ * Side effects:
+ *	See access documentation.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TclWinAccess(
+    CONST char *path,		/* Path of file to access (in current CP). */
+    int mode)			/* Permission setting. */
+{
+    int result;
+    CONST char *p;
+
+#undef access
+
+    result = access(path, mode);
+
+    if (result == 0) {
+	if (mode & 1) {
+	    if (GetFileAttributes(path) & 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;
+		}
+	    }
+	    errno = EACCES;
+	    return -1;
+	}
+    }
+    return result;
+}
+