summaryrefslogtreecommitdiffstats
path: root/win/tclWinFile.c
diff options
context:
space:
mode:
Diffstat (limited to 'win/tclWinFile.c')
-rw-r--r--win/tclWinFile.c647
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;
+}
+