Subversion Repositories or1k_old

/*

 * 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.

 *

 * RCS: @(#) $Id: tclWinFile.c,v 1.1.1.1 2002-01-16 10:25:38 markom Exp $

 */

#include "tclWinInt.h"

#include <sys/stat.h>

#ifndef __WIN32__

#include <shlobj.h>

#endif

/*

 * 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;

    }

    /* CYGNUS LOCAL: On cygwin, we must use chdir.  Otherwise, the

       cygwin notion of the current directory will get messed up.  */

#ifdef __CYGWIN__

    if (chdir(dirName) < 0) {

#else

    if (!SetCurrentDirectory(dirName)) {

        TclWinConvertError(GetLastError());

#endif

        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

/*

 *----------------------------------------------------------------------

 *

 * TclpStat, TclpLstat --

 *

 *      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

TclpStat(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);

#if ! defined (_MSC_VER) && ! defined (__CYGWIN__)

    /*

     * 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;

}

/*

 *---------------------------------------------------------------------------

 *

 * TclpAccess --

 *

 *      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

TclpAccess(

    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;

}