Logo Search packages:      
Sourcecode: tcl8.3 version File versions  Download package

tclWinFile.c

/* 
 * 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.7.2.3 2002/10/15 20:25:22 hobbs 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' represents the attributes of the file, but we only
       * want to retrieve this info if it is absolutely necessary
       * because it is an expensive call.
       */

      attr = 0;

      if (tail == NULL) {
          int typeOk = 1;
          if (types != NULL) {
            if (types->perm != 0) {
                attr = (*tclWinProcs->getFileAttributesProc)(nativeName);
                if (
                  ((types->perm & TCL_GLOB_PERM_RONLY) &&
                        !(attr & FILE_ATTRIBUTE_READONLY)) ||
                  ((types->perm & TCL_GLOB_PERM_HIDDEN) &&
                        !(attr & FILE_ATTRIBUTE_HIDDEN)) ||
                  ((types->perm & TCL_GLOB_PERM_R) &&
                        (TclpAccess(fname, R_OK) != 0)) ||
                  ((types->perm & TCL_GLOB_PERM_W) &&
                        (TclpAccess(fname, W_OK) != 0)) ||
                  ((types->perm & TCL_GLOB_PERM_X) &&
                        (TclpAccess(fname, X_OK) != 0))
                  ) {
                  typeOk = 0;
                }
            }
            if (typeOk && types->type != 0) {
                struct stat buf;
                /*
                 * We must match at least one flag to be listed
                 */
                typeOk = 0;
                if (TclpLstat(fname, &buf) >= 0) {
                  /*
                   * In order bcdpfls as in 'find -t'
                   */
                  if (
                      ((types->type & TCL_GLOB_TYPE_BLOCK) &&
                            S_ISBLK(buf.st_mode)) ||
                      ((types->type & TCL_GLOB_TYPE_CHAR) &&
                            S_ISCHR(buf.st_mode)) ||
                      ((types->type & TCL_GLOB_TYPE_DIR) &&
                            S_ISDIR(buf.st_mode)) ||
                      ((types->type & TCL_GLOB_TYPE_PIPE) &&
                            S_ISFIFO(buf.st_mode)) ||
                      ((types->type & TCL_GLOB_TYPE_FILE) &&
                            S_ISREG(buf.st_mode))
#ifdef S_ISLNK
                      || ((types->type & TCL_GLOB_TYPE_LINK) &&
                            S_ISLNK(buf.st_mode))
#endif
#ifdef S_ISSOCK
                      || ((types->type & TCL_GLOB_TYPE_SOCK) &&
                            S_ISSOCK(buf.st_mode))
#endif
                      ) {
                      typeOk = 1;
                  }
                } else {
                  /* Posix error occurred */
                }
            }           
          } 
          if (typeOk) {
            Tcl_ListObjAppendElement(interp, resultPtr, 
                  Tcl_NewStringObj(fname, Tcl_DStringLength(dirPtr)));
          }
      } else {
          attr = (*tclWinProcs->getFileAttributesProc)(nativeName);
          if (attr & FILE_ATTRIBUTE_DIRECTORY) {
            Tcl_DStringAppend(dirPtr, "/", 1);
            result = TclDoGlob(interp, separators, dirPtr, tail, types);
            if (result != TCL_OK) {
                break;
            }
          }
      }
      /*
       * Free ds here to ensure that nativeName is valid above.
       */

      Tcl_DStringFree(&ds);

      Tcl_DStringSetLength(dirPtr, dirLength);
    }

    FindClose(handle);
    Tcl_DStringFree(&dirString);
    Tcl_DStringFree(&patternString);

    return result;

    error:
    Tcl_DStringFree(&dirString);
    TclWinConvertError(GetLastError());
    Tcl_ResetResult(interp);
    Tcl_AppendResult(interp, message, Tcl_DStringValue(dirPtr), "\": ", 
          Tcl_PosixError(interp), (char *) NULL);
    return TCL_ERROR;
}

/* 
 * TclpMatchFiles --
 * 
 * This function is now obsolete.  Call the above function 
 * 'TclpMatchFilesTypes' instead.
 */
int
TclpMatchFiles(
    Tcl_Interp *interp,       /* Interpreter to receive results. */
    char *separators,         /* Directory separators to pass to TclDoGlob. */
    Tcl_DString *dirPtr,      /* Contains path to directory to search. */
    char *pattern,            /* Pattern to match against. */
    char *tail)               /* Pointer to end of pattern.  Tail must
                         * point to a location in pattern and must
                         * not be static.*/
{
    return TclpMatchFilesTypes(interp,separators,dirPtr,pattern,tail,NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * TclpGetUserHome --
 *
 *    This function takes the passed in user name and finds the
 *    corresponding home directory specified in the password file.
 *
 * Results:
 *    The result is a pointer to a string specifying the user's home
 *    directory, or NULL if the user's home directory could not be
 *    determined.  Storage for the result string is allocated in
 *    bufferPtr; the caller must call Tcl_DStringFree() when the result
 *    is no longer needed.
 *
 * Side effects:
 *    None.
 *
 *----------------------------------------------------------------------
 */

char *
TclpGetUserHome(name, bufferPtr)
    CONST char *name;         /* User name for desired home directory. */
    Tcl_DString *bufferPtr;   /* Uninitialized or free DString filled
                         * with name of user's home directory. */
{
    char *result;
    HINSTANCE netapiInst;

    result = NULL;

    Tcl_DStringInit(bufferPtr);

    netapiInst = LoadLibraryA("netapi32.dll");
    if (netapiInst != NULL) {
      NETAPIBUFFERFREEPROC *netApiBufferFreeProc;
      NETGETDCNAMEPROC *netGetDCNameProc;
      NETUSERGETINFOPROC *netUserGetInfoProc;

      netApiBufferFreeProc = (NETAPIBUFFERFREEPROC *)
            GetProcAddress(netapiInst, "NetApiBufferFree");
      netGetDCNameProc = (NETGETDCNAMEPROC *) 
            GetProcAddress(netapiInst, "NetGetDCName");
      netUserGetInfoProc = (NETUSERGETINFOPROC *) 
            GetProcAddress(netapiInst, "NetUserGetInfo");
      if ((netUserGetInfoProc != NULL) && (netGetDCNameProc != NULL)
            && (netApiBufferFreeProc != NULL)) {
          USER_INFO_1 *uiPtr;
          Tcl_DString ds;
          int nameLen, badDomain;
          char *domain;
          WCHAR *wName, *wHomeDir, *wDomain;
          WCHAR buf[MAX_PATH];

          badDomain = 0;
          nameLen = -1;
          wDomain = NULL;
          domain = strchr(name, '@');
          if (domain != NULL) {
            Tcl_DStringInit(&ds);
            wName = Tcl_UtfToUniCharDString(domain + 1, -1, &ds);
            badDomain = (*netGetDCNameProc)(NULL, wName,
                  (LPBYTE *) &wDomain);
            Tcl_DStringFree(&ds);
            nameLen = domain - name;
          }
          if (badDomain == 0) {
            Tcl_DStringInit(&ds);
            wName = Tcl_UtfToUniCharDString(name, nameLen, &ds);
            if ((*netUserGetInfoProc)(wDomain, wName, 1, 
                  (LPBYTE *) &uiPtr) == 0) {
                wHomeDir = uiPtr->usri1_home_dir;
                if ((wHomeDir != NULL) && (wHomeDir[0] != L'\0')) {
                  Tcl_UniCharToUtfDString(wHomeDir, lstrlenW(wHomeDir),
                        bufferPtr);
                } else {
                  /* 
                   * User exists but has no home dir.  Return
                   * "{Windows Drive}:/users/default".
                   */

                  GetWindowsDirectoryW(buf, MAX_PATH);
                  Tcl_UniCharToUtfDString(buf, 2, bufferPtr);
                  Tcl_DStringAppend(bufferPtr, "/users/default", -1);
                }
                result = Tcl_DStringValue(bufferPtr);
                (*netApiBufferFreeProc)((void *) uiPtr);
            }
            Tcl_DStringFree(&ds);
          }
          if (wDomain != NULL) {
            (*netApiBufferFreeProc)((void *) wDomain);
          }
      }
      FreeLibrary(netapiInst);
    }
    if (result == NULL) {
      /*
       * Look in the "Password Lists" section of system.ini for the 
       * local user.  There are also entries in that section that begin 
       * with a "*" character that are used by Windows for other 
       * purposes; ignore user names beginning with a "*".
       */

      char buf[MAX_PATH];

      if (name[0] != '*') {
          if (GetPrivateProfileStringA("Password Lists", name, "", buf, 
                MAX_PATH, "system.ini") > 0) {
            /* 
             * User exists, but there is no such thing as a home 
             * directory in system.ini.  Return "{Windows drive}:/".
             */

            GetWindowsDirectoryA(buf, MAX_PATH);
            Tcl_DStringAppend(bufferPtr, buf, 3);
            result = Tcl_DStringValue(bufferPtr);
          }
      }
    }

    return result;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclpAccess --
 *
 *    This function replaces the library version of access(), fixing the
 *    following bugs:
 * 
 *    1. access() returns that all files have execute permission.
 *
 * Results:
 *    See access documentation.
 *
 * Side effects:
 *    See access documentation.
 *
 *---------------------------------------------------------------------------
 */

int
TclpAccess(
    CONST char *path,         /* Path of file to access (UTF-8). */
    int mode)                 /* Permission setting. */
{
    Tcl_DString ds;
    TCHAR *nativePath;
    DWORD attr;

    nativePath = Tcl_WinUtfToTChar(path, -1, &ds);
    attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
    Tcl_DStringFree(&ds);

    if (attr == 0xffffffff) {
      /*
       * File doesn't exist. 
       */

      TclWinConvertError(GetLastError());
      return -1;
    }

    if ((mode & W_OK) && (attr & FILE_ATTRIBUTE_READONLY)) {
      /*
       * File is not writable.
       */

      Tcl_SetErrno(EACCES);
      return -1;
    }

    if (mode & X_OK) {
        CONST char *p;

      if (attr & FILE_ATTRIBUTE_DIRECTORY) {
          /*
           * Directories are always executable. 
           */
          
          return 0;
      }
      p = strrchr(path, '.');
      if (p != NULL) {
          p++;
          if ((stricmp(p, "exe") == 0)
                || (stricmp(p, "com") == 0)
                || (stricmp(p, "bat") == 0)) {
            /*
             * File that ends with .exe, .com, or .bat is executable.
             */

            return 0;
          }
      }
      Tcl_SetErrno(EACCES);
      return -1;
    }

    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * TclpChdir --
 *
 *    This function replaces the library version of chdir().
 *
 * Results:
 *    See chdir() documentation.
 *
 * Side effects:
 *    See chdir() documentation.  
 *
 *----------------------------------------------------------------------
 */

int
TclpChdir(path)
    CONST char *path;         /* Path to new working directory (UTF-8). */
{
    int result;
    Tcl_DString ds;
    TCHAR *nativePath;

    nativePath = Tcl_WinUtfToTChar(path, -1, &ds);
    result = (*tclWinProcs->setCurrentDirectoryProc)(nativePath);
    Tcl_DStringFree(&ds);

    if (result == 0) {
      TclWinConvertError(GetLastError());
      return -1;
    }
    return 0;
}

#ifdef __CYGWIN__
/*
 *---------------------------------------------------------------------------
 *
 * TclpReadlink --
 *
 *     This function replaces the library version of readlink().
 *
 * Results:
 *     The result is a pointer to a string specifying the contents
 *     of the symbolic link given by 'path', or NULL if the symbolic
 *     link could not be read.  Storage for the result string is
 *     allocated in bufferPtr; the caller must call Tcl_DStringFree()
 *     when the result is no longer needed.
 *
 * Side effects:
 *     See readlink() documentation.
 *
 *---------------------------------------------------------------------------
 */

char *
TclpReadlink(path, linkPtr)
    CONST char *path;          /* Path of file to readlink (UTF-8). */
    Tcl_DString *linkPtr;      /* Uninitialized or free DString filled
                                * with contents of link (UTF-8). */
{
    char link[MAXPATHLEN];
    int length;
    char *native;
    Tcl_DString ds;

    native = Tcl_UtfToExternalDString(NULL, path, -1, &ds);
    length = readlink(native, link, sizeof(link));     /* INTL: Native. */
    Tcl_DStringFree(&ds);
    
    if (length < 0) {
      return NULL;
    }

    Tcl_ExternalToUtfDString(NULL, link, length, linkPtr);
    return Tcl_DStringValue(linkPtr);
}
#endif /* __CYGWIN__ */

/*
 *----------------------------------------------------------------------
 *
 * TclpGetCwd --
 *
 *    This function replaces the library version of getcwd().
 *
 * Results:
 *    The result is a pointer to a string specifying the current
 *    directory, or NULL if the current directory could not be
 *    determined.  If NULL is returned, an error message is left in the
 *    interp's result.  Storage for the result string is allocated in
 *    bufferPtr; the caller must call Tcl_DStringFree() when the result
 *    is no longer needed.
 *
 * Side effects:
 *    None.
 *
 *----------------------------------------------------------------------
 */

char *
TclpGetCwd(interp, bufferPtr)
    Tcl_Interp *interp;       /* If non-NULL, used for error reporting. */
    Tcl_DString *bufferPtr;   /* Uninitialized or free DString filled
                         * with name of current directory. */
{
    WCHAR buffer[MAX_PATH];
    char *p;

    if ((*tclWinProcs->getCurrentDirectoryProc)(MAX_PATH, buffer) == 0) {
      TclWinConvertError(GetLastError());
      if (interp != NULL) {
          Tcl_AppendResult(interp,
                "error getting working directory name: ",
                Tcl_PosixError(interp), (char *) NULL);
      }
      return NULL;
    }

    /*
     * Watch for the wierd Windows c:\\UNC syntax.
     */

    if (tclWinProcs->useWide) {
      WCHAR *native;

      native = (WCHAR *) buffer;
      if ((native[0] != '\0') && (native[1] == ':') 
            && (native[2] == '\\') && (native[3] == '\\')) {
          native += 2;
      }
      Tcl_WinTCharToUtf((TCHAR *) native, -1, bufferPtr);
    } else {
      char *native;

      native = (char *) buffer;
      if ((native[0] != '\0') && (native[1] == ':') 
            && (native[2] == '\\') && (native[3] == '\\')) {
          native += 2;
      }
      Tcl_WinTCharToUtf((TCHAR *) native, -1, bufferPtr);
    }

    /*
     * Convert to forward slashes for easier use in scripts.
     */
            
    for (p = Tcl_DStringValue(bufferPtr); *p != '\0'; p++) {
      if (*p == '\\') {
          *p = '/';
      }
    }
    return Tcl_DStringValue(bufferPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclpStat --
 *
 *    This function replaces the library version of stat(), fixing 
 *    the following bugs:
 *
 *    1. stat("c:") returns an error.
 *    2. Borland stat() return time in GMT instead of localtime.
 *    3. stat("\\server\mount") would return error.
 *    4. Accepts slashes or backslashes.
 *    5. st_dev and st_rdev were wrong for UNC paths.
 *
 * Results:
 *    See stat documentation.
 *
 * Side effects:
 *    See stat documentation.
 *
 *----------------------------------------------------------------------
 */

int
TclpStat(path, statPtr)
    CONST char *path;         /* Path of file to stat (UTF-8). */
    struct stat *statPtr;     /* Filled with results of stat call. */
{
    Tcl_DString ds;
    TCHAR *nativePath;
    WIN32_FIND_DATAT data;
    HANDLE handle;
    DWORD attr;
    WCHAR nativeFullPath[MAX_PATH];
    TCHAR *nativePart;
    char *p, *fullPath;
    int dev, mode;

    /*
     * Eliminate file names containing wildcard characters, or subsequent 
     * call to FindFirstFile() will expand them, matching some other file.
     */

    if (strpbrk(path, "?*") != NULL) {
      Tcl_SetErrno(ENOENT);
      return -1;
    }

    /*
     * Ensure correct file sizes by forcing the OS to write any
     * pending data to disk. This is done only for channels which are
     * dirty, i.e. have been written to since the last flush here.
     */

    TclWinFlushDirtyChannels ();

    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

Generated by  Doxygen 1.6.0   Back to index