Logo Search packages:      
Sourcecode: tcltk8.0-ja version File versions  Download package

tclWinFCmd.c

/*
 * tclWinFCmd.c
 *
 *      This file implements the Windows specific portion of file manipulation 
 *      subcommands of the "file" command. 
 *
 * Copyright (c) 1996-1997 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: tclWinFCmd.c,v 1.2 1998/09/14 18:40:19 stanton Exp $
 */

#include "tclWinInt.h"

/*
 * The following constants specify the type of callback when
 * TraverseWinTree() calls the traverseProc()
 */

#define DOTREE_PRED   1     /* pre-order directory  */
#define DOTREE_POSTD  2     /* post-order directory */
#define DOTREE_F      3     /* regular file */

/*
 * Callbacks for file attributes code.
 */

static int        GetWinFileAttributes _ANSI_ARGS_((Tcl_Interp *interp,
                      int objIndex, char *fileName,
                      Tcl_Obj **attributePtrPtr));
static int        GetWinFileLongName _ANSI_ARGS_((Tcl_Interp *interp,
                      int objIndex, char *fileName,
                      Tcl_Obj **attributePtrPtr));
static int        GetWinFileShortName _ANSI_ARGS_((Tcl_Interp *interp,
                      int objIndex, char *fileName,
                      Tcl_Obj **attributePtrPtr));
static int        SetWinFileAttributes _ANSI_ARGS_((Tcl_Interp *interp,
                      int objIndex, char *fileName,
                      Tcl_Obj *attributePtr));
static int        CannotSetAttribute _ANSI_ARGS_((Tcl_Interp *interp,
                      int objIndex, char *fileName,
                      Tcl_Obj *attributePtr));

/*
 * Constants and variables necessary for file attributes subcommand.
 */

enum {
    WIN_ARCHIVE_ATTRIBUTE,
    WIN_HIDDEN_ATTRIBUTE,
    WIN_LONGNAME_ATTRIBUTE,
    WIN_READONLY_ATTRIBUTE,
    WIN_SHORTNAME_ATTRIBUTE,
    WIN_SYSTEM_ATTRIBUTE
};

static int attributeArray[] = {FILE_ATTRIBUTE_ARCHIVE, FILE_ATTRIBUTE_HIDDEN,
      0, FILE_ATTRIBUTE_READONLY, 0, FILE_ATTRIBUTE_SYSTEM};


char *tclpFileAttrStrings[] = {"-archive", "-hidden", "-longname", "-readonly",
      "-shortname", "-system", (char *) NULL};
CONST TclFileAttrProcs tclpFileAttrProcs[] = {
      {GetWinFileAttributes, SetWinFileAttributes},
      {GetWinFileAttributes, SetWinFileAttributes},
      {GetWinFileLongName, CannotSetAttribute},
      {GetWinFileAttributes, SetWinFileAttributes},
      {GetWinFileShortName, CannotSetAttribute},
      {GetWinFileAttributes, SetWinFileAttributes}};

/*
 * Prototype for the TraverseWinTree callback function.
 */

typedef int (TraversalProc)(char *src, char *dst, DWORD attr, int type, 
      Tcl_DString *errorPtr);

/*
 * Declarations for local procedures defined in this file:
 */

static void       AttributesPosixError _ANSI_ARGS_((Tcl_Interp *interp,
                      int objIndex, char *fileName, int getOrSet));
static int        ConvertFileNameFormat _ANSI_ARGS_((Tcl_Interp *interp,
                      int objIndex, char *fileName, int longShort,
                      Tcl_Obj **attributePtrPtr));
static int        TraversalCopy(char *src, char *dst, DWORD attr, 
                        int type, Tcl_DString *errorPtr);
static int        TraversalDelete(char *src, char *dst, DWORD attr,
                        int type, Tcl_DString *errorPtr);
static int        TraverseWinTree(TraversalProc *traverseProc,
                      Tcl_DString *sourcePtr, Tcl_DString *destPtr,
                      Tcl_DString *errorPtr);


/*
 *---------------------------------------------------------------------------
 *
 * TclpRenameFile --
 *
 *      Changes the name of an existing file or directory, from src to dst.
 *    If src and dst refer to the same file or directory, does nothing
 *    and returns success.  Otherwise if dst already exists, it will be
 *    deleted and replaced by src subject to the following conditions:
 *        If src is a directory, dst may be an empty directory.
 *        If src is a file, dst may be a file.
 *    In any other situation where dst already exists, the rename will
 *    fail.  
 *
 * Results:
 *    If the directory was successfully created, returns TCL_OK.
 *    Otherwise the return value is TCL_ERROR and errno is set to
 *    indicate the error.  Some possible values for errno are:
 *
 *    EACCES:     src or dst parent directory can't be read and/or written.
 *    EEXIST:         dst is a non-empty directory.
 *    EINVAL:         src is a root directory or dst is a subdirectory of src.
 *    EISDIR:         dst is a directory, but src is not.
 *    ENOENT:         src doesn't exist.  src or dst is "".
 *    ENOTDIR:    src is a directory, but dst is not.  
 *    EXDEV:          src and dst are on different filesystems.
 *
 *    EACCES:     exists an open file already referring to src or dst.
 *    EACCES:     src or dst specify the current working directory (NT).
 *    EACCES:         src specifies a char device (nul:, com1:, etc.) 
 *    EEXIST:         dst specifies a char device (nul:, com1:, etc.) (NT)
 *    EACCES:         dst specifies a char device (nul:, com1:, etc.) (95)
 *    
 * Side effects:
 *    The implementation supports cross-filesystem renames of files,
 *    but the caller should be prepared to emulate cross-filesystem
 *    renames of directories if errno is EXDEV.
 *
 *---------------------------------------------------------------------------
 */

int
TclpRenameFile(
    char *src,                /* Pathname of file or dir to be renamed. */ 
    char *dst)                /* New pathname for file or directory. */
{
    DWORD srcAttr, dstAttr;
    
    /*
     * Would throw an exception under NT if one of the arguments is a 
     * char block device.
     */

    try {
      if (MoveFile(src, dst) != FALSE) {
          return TCL_OK;
      }
    } except (-1) {}

    TclWinConvertError(GetLastError());

    srcAttr = GetFileAttributes(src);
    dstAttr = GetFileAttributes(dst);
    if (srcAttr == (DWORD) -1) {
      srcAttr = 0;
    }
    if (dstAttr == (DWORD) -1) {
      dstAttr = 0;
    }

    if (errno == EBADF) {
      errno = EACCES;
      return TCL_ERROR;
    }
    if ((errno == EACCES) && (TclWinGetPlatformId() == VER_PLATFORM_WIN32s)) {
      if ((srcAttr != 0) && (dstAttr != 0)) {
          /*
           * Win32s reports trying to overwrite an existing file or directory
           * as EACCES.
           */

          errno = EEXIST;
      }
    }
    if (errno == EACCES) {
      decode:
      if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) {
          char srcPath[MAX_PATH], dstPath[MAX_PATH];
          int srcArgc, dstArgc;
          char **srcArgv, **dstArgv;
          char *srcRest, *dstRest;
          int size;

          size = GetFullPathName(src, sizeof(srcPath), srcPath, &srcRest);
          if ((size == 0) || (size > sizeof(srcPath))) {
            return TCL_ERROR;
          }
          size = GetFullPathName(dst, sizeof(dstPath), dstPath, &dstRest);
          if ((size == 0) || (size > sizeof(dstPath))) {
            return TCL_ERROR;
          }
          if (srcRest == NULL) {
            srcRest = srcPath + strlen(srcPath);
          }
          if (strnicmp(srcPath, dstPath, srcRest - srcPath) == 0) {
            /*
             * Trying to move a directory into itself.
             */

            errno = EINVAL;
            return TCL_ERROR;
          }
          Tcl_SplitPath(srcPath, &srcArgc, &srcArgv);
          Tcl_SplitPath(dstPath, &dstArgc, &dstArgv);
          if (srcArgc == 1) {
            /*
             * They are trying to move a root directory.  Whether
             * or not it is across filesystems, this cannot be
             * done.
             */

            errno = EINVAL;
          } else if ((srcArgc > 0) && (dstArgc > 0) &&
                (stricmp(srcArgv[0], dstArgv[0]) != 0)) {
            /*
             * If src is a directory and dst filesystem != src
             * filesystem, errno should be EXDEV.  It is very
             * important to get this behavior, so that the caller
             * can respond to a cross filesystem rename by
             * simulating it with copy and delete.  The MoveFile
             * system call already handles the case of moving a
             * file between filesystems.
             */

            errno = EXDEV;
          }

          ckfree((char *) srcArgv);
          ckfree((char *) dstArgv);
      }

      /*
       * Other types of access failure is that dst is a read-only
       * filesystem, that an open file referred to src or dest, or that
       * src or dest specified the current working directory on the
       * current filesystem.  EACCES is returned for those cases.
       */

    } else if (errno == EEXIST) {
      /*
       * Reports EEXIST any time the target already exists.  If it makes
       * sense, remove the old file and try renaming again.
       */

      if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) {
          if (dstAttr & FILE_ATTRIBUTE_DIRECTORY) {
            /*
             * Overwrite empty dst directory with src directory.  The
             * following call will remove an empty directory.  If it
             * fails, it's because it wasn't empty.
             */

            if (TclpRemoveDirectory(dst, 0, NULL) == TCL_OK) {
                /*
                 * Now that that empty directory is gone, we can try
                 * renaming again.  If that fails, we'll put this empty
                 * directory back, for completeness.
                 */

                if (MoveFile(src, dst) != FALSE) {
                  return TCL_OK;
                }

                /*
                 * Some new error has occurred.  Don't know what it
                 * could be, but report this one.
                 */

                TclWinConvertError(GetLastError());
                CreateDirectory(dst, NULL);
                SetFileAttributes(dst, dstAttr);
                if (errno == EACCES) {
                  /*
                   * Decode the EACCES to a more meaningful error.
                   */

                  goto decode;
                }
            }
          } else {      /* (dstAttr & FILE_ATTRIBUTE_DIRECTORY) == 0 */
            errno = ENOTDIR;
          }
      } else {    /* (srcAttr & FILE_ATTRIBUTE_DIRECTORY) == 0 */
          if (dstAttr & FILE_ATTRIBUTE_DIRECTORY) {
            errno = EISDIR;
          } else {
            /*
             * Overwrite existing file by:
             * 
             * 1. Rename existing file to temp name.
             * 2. Rename old file to new name.
             * 3. If success, delete temp file.  If failure,
             *    put temp file back to old name.
             */

            char tempName[MAX_PATH];
            int result, size;
            char *rest;
            
            size = GetFullPathName(dst, sizeof(tempName), tempName, &rest);
            if ((size == 0) || (size > sizeof(tempName)) || (rest == NULL)) {
                return TCL_ERROR;
            }
            *rest = '\0';
            result = TCL_ERROR;
            if (GetTempFileName(tempName, "tclr", 0, tempName) != 0) {
                /*
                 * Strictly speaking, need the following DeleteFile and
                 * MoveFile to be joined as an atomic operation so no
                 * other app comes along in the meantime and creates the
                 * same temp file.
                 */
                 
                DeleteFile(tempName);
                if (MoveFile(dst, tempName) != FALSE) {
                  if (MoveFile(src, dst) != FALSE) {
                      SetFileAttributes(tempName, FILE_ATTRIBUTE_NORMAL);
                      DeleteFile(tempName);
                      return TCL_OK;
                  } else {
                      DeleteFile(dst);
                      MoveFile(tempName, dst);
                  }
                } 

                /*
                 * Can't backup dst file or move src file.  Return that
                 * error.  Could happen if an open file refers to dst.
                 */

                TclWinConvertError(GetLastError());
                if (errno == EACCES) {
                  /*
                   * Decode the EACCES to a more meaningful error.
                   */

                  goto decode;
                }
            }
            return result;
          }
      }
    }
    return TCL_ERROR;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclpCopyFile --
 *
 *      Copy a single file (not a directory).  If dst already exists and
 *    is not a directory, it is removed.
 *
 * Results:
 *    If the file was successfully copied, returns TCL_OK.  Otherwise
 *    the return value is TCL_ERROR and errno is set to indicate the
 *    error.  Some possible values for errno are:
 *
 *    EACCES:     src or dst parent directory can't be read and/or written.
 *    EISDIR:         src or dst is a directory.
 *    ENOENT:         src doesn't exist.  src or dst is "".
 *
 *    EACCES:     exists an open file already referring to dst (95).
 *    EACCES:         src specifies a char device (nul:, com1:, etc.) (NT)
 *    ENOENT:         src specifies a char device (nul:, com1:, etc.) (95)
 *
 * Side effects:
 *    It is not an error to copy to a char device.
 *
 *---------------------------------------------------------------------------
 */

int 
TclpCopyFile(
    char *src,                /* Pathname of file to be copied. */
    char *dst)                /* Pathname of file to copy to. */
{
    /*
     * Would throw an exception under NT if one of the arguments is a char
     * block device.
     */

    try {
      if (CopyFile(src, dst, 0) != FALSE) {
          return TCL_OK;
      }
    } except (-1) {}

    TclWinConvertError(GetLastError());
    if (errno == EBADF) {
      errno = EACCES;
      return TCL_ERROR;
    }
    if (errno == EACCES) {
      DWORD srcAttr, dstAttr;

      srcAttr = GetFileAttributes(src);
      dstAttr = GetFileAttributes(dst);
      if (srcAttr != (DWORD) -1) {
          if (dstAttr == (DWORD) -1) {
            dstAttr = 0;
          }
          if ((srcAttr & FILE_ATTRIBUTE_DIRECTORY) ||
                (dstAttr & FILE_ATTRIBUTE_DIRECTORY)) {
            errno = EISDIR;
          }
          if (dstAttr & FILE_ATTRIBUTE_READONLY) {
            SetFileAttributes(dst, dstAttr & ~FILE_ATTRIBUTE_READONLY);
            if (CopyFile(src, dst, 0) != FALSE) {
                return TCL_OK;
            }
            /*
             * Still can't copy onto dst.  Return that error, and
             * restore attributes of dst.
             */

            TclWinConvertError(GetLastError());
            SetFileAttributes(dst, dstAttr);
          }
      }
    }
    return TCL_ERROR;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclpDeleteFile --
 *
 *      Removes a single file (not a directory).
 *
 * Results:
 *    If the file was successfully deleted, returns TCL_OK.  Otherwise
 *    the return value is TCL_ERROR and errno is set to indicate the
 *    error.  Some possible values for errno are:
 *
 *    EACCES:     a parent directory can't be read and/or written.
 *    EISDIR:         path is a directory.
 *    ENOENT:         path doesn't exist or is "".
 *
 *    EACCES:     exists an open file already referring to path.
 *    EACCES:         path is a char device (nul:, com1:, etc.)
 *
 * Side effects:
 *      The file is deleted, even if it is read-only.
 *
 *---------------------------------------------------------------------------
 */

int
TclpDeleteFile(
    char *path)               /* Pathname of file to be removed. */
{
    DWORD attr;

    if (DeleteFile(path) != FALSE) {
      return TCL_OK;
    }
    TclWinConvertError(GetLastError());
    if (path[0] == '\0') {
      /*
       * Win32s thinks that "" is the same as "." and then reports EISDIR
       * instead of ENOENT.
       */

      errno = ENOENT;
    } else if (errno == EACCES) {
        attr = GetFileAttributes(path);
      if (attr != (DWORD) -1) {
          if (attr & FILE_ATTRIBUTE_DIRECTORY) {
            /*
             * Windows NT reports removing a directory as EACCES instead
             * of EISDIR.
             */

            errno = EISDIR;
          } else if (attr & FILE_ATTRIBUTE_READONLY) {
            SetFileAttributes(path, attr & ~FILE_ATTRIBUTE_READONLY);
            if (DeleteFile(path) != FALSE) {
                return TCL_OK;
            }
            TclWinConvertError(GetLastError());
            SetFileAttributes(path, attr);
          }
      }
    } else if (errno == ENOENT) {
        attr = GetFileAttributes(path);
      if (attr != (DWORD) -1) {
          if (attr & FILE_ATTRIBUTE_DIRECTORY) {
            /*
             * Windows 95 reports removing a directory as ENOENT instead 
             * of EISDIR. 
             */

            errno = EISDIR;
          }
      }
    } else if (errno == EINVAL) {
      /*
       * Windows NT reports removing a char device as EINVAL instead of
       * EACCES.
       */

      errno = EACCES;
    }

    return TCL_ERROR;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclpCreateDirectory --
 *
 *      Creates the specified directory.  All parent directories of the
 *    specified directory must already exist.  The directory is
 *    automatically created with permissions so that user can access
 *    the new directory and create new files or subdirectories in it.
 *
 * Results:
 *    If the directory was successfully created, returns TCL_OK.
 *    Otherwise the return value is TCL_ERROR and errno is set to
 *    indicate the error.  Some possible values for errno are:
 *
 *    EACCES:     a parent directory can't be read and/or written.
 *    EEXIST:         path already exists.
 *    ENOENT:         a parent directory doesn't exist.
 *
 * Side effects:
 *      A directory is created.
 *
 *---------------------------------------------------------------------------
 */

int
TclpCreateDirectory(
    char *path)               /* Pathname of directory to create */
{
    int error;

    if (CreateDirectory(path, NULL) == 0) {
      error = GetLastError();
      if (TclWinGetPlatformId() == VER_PLATFORM_WIN32s) {
          if ((error == ERROR_ACCESS_DENIED) 
                && (GetFileAttributes(path) != (DWORD) -1)) {
            error = ERROR_FILE_EXISTS;
          }
      }
      TclWinConvertError(error);
      return TCL_ERROR;
    }   
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclpCopyDirectory --
 *
 *      Recursively copies a directory.  The target directory dst must
 *    not already exist.  Note that this function does not merge two
 *    directory hierarchies, even if the target directory is an an
 *    empty directory.
 *
 * Results:
 *    If the directory was successfully copied, returns TCL_OK.
 *    Otherwise the return value is TCL_ERROR, errno is set to indicate
 *    the error, and the pathname of the file that caused the error
 *    is stored in errorPtr.  See TclpCreateDirectory and TclpCopyFile
 *    for a description of possible values for errno.
 *
 * Side effects:
 *      An exact copy of the directory hierarchy src will be created
 *    with the name dst.  If an error occurs, the error will
 *      be returned immediately, and remaining files will not be
 *    processed.
 *
 *---------------------------------------------------------------------------
 */

int
TclpCopyDirectory(
    char *src,                /* Pathname of directory to be copied. */
    char *dst,                /* Pathname of target directory. */
    Tcl_DString *errorPtr)    /* If non-NULL, initialized DString for
                         * error reporting. */
{
    int result;
    Tcl_DString srcBuffer;
    Tcl_DString dstBuffer;

    Tcl_DStringInit(&srcBuffer);
    Tcl_DStringInit(&dstBuffer);
    Tcl_DStringAppend(&srcBuffer, src, -1);
    Tcl_DStringAppend(&dstBuffer, dst, -1);
    result = TraverseWinTree(TraversalCopy, &srcBuffer, &dstBuffer, 
          errorPtr);
    Tcl_DStringFree(&srcBuffer);
    Tcl_DStringFree(&dstBuffer);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TclpRemoveDirectory -- 
 *
 *    Removes directory (and its contents, if the recursive flag is set).
 *
 * Results:
 *    If the directory was successfully removed, returns TCL_OK.
 *    Otherwise the return value is TCL_ERROR, errno is set to indicate
 *    the error, and the pathname of the file that caused the error
 *    is stored in errorPtr.  Some possible values for errno are:
 *
 *    EACCES:     path directory can't be read and/or written.
 *    EEXIST:         path is a non-empty directory.
 *    EINVAL:         path is root directory or current directory.
 *    ENOENT:         path doesn't exist or is "".
 *    ENOTDIR:    path is not a directory.
 *
 *    EACCES:         path is a char device (nul:, com1:, etc.) (95)
 *    EINVAL:         path is a char device (nul:, com1:, etc.) (NT)
 *
 * Side effects:
 *    Directory removed.  If an error occurs, the error will be returned
 *    immediately, and remaining files will not be deleted.
 *
 *----------------------------------------------------------------------
 */

int
TclpRemoveDirectory(
    char *path,               /* Pathname of directory to be removed. */
    int recursive,            /* If non-zero, removes directories that
                         * are nonempty.  Otherwise, will only remove
                         * empty directories. */
    Tcl_DString *errorPtr)    /* If non-NULL, initialized DString for
                         * error reporting. */
{
    int result;
    Tcl_DString buffer;
    DWORD attr;

    if (RemoveDirectory(path) != FALSE) {
      return TCL_OK;
    }
    TclWinConvertError(GetLastError());
    if (path[0] == '\0') {
      /*
       * Win32s thinks that "" is the same as "." and then reports EACCES
       * instead of ENOENT.
       */

      errno = ENOENT;
    }
    if (errno == EACCES) {
      attr = GetFileAttributes(path);
      if (attr != (DWORD) -1) {
          if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
            /* 
             * Windows 95 reports calling RemoveDirectory on a file as an 
             * EACCES, not an ENOTDIR.
             */
            
            errno = ENOTDIR;
            goto end;
          }

          if (attr & FILE_ATTRIBUTE_READONLY) {
            attr &= ~FILE_ATTRIBUTE_READONLY;
            if (SetFileAttributes(path, attr) == FALSE) {
                goto end;
            }
            if (RemoveDirectory(path) != FALSE) {
                return TCL_OK;
            }
            TclWinConvertError(GetLastError());
            SetFileAttributes(path, attr | FILE_ATTRIBUTE_READONLY);
          }

          /* 
           * Windows 95 and Win32s report removing a non-empty directory 
           * as EACCES, not EEXIST.  If the directory is not empty,
           * change errno so caller knows what's going on.
           */

          if (TclWinGetPlatformId() != VER_PLATFORM_WIN32_NT) {
            HANDLE handle;
            WIN32_FIND_DATA data;
            Tcl_DString buffer;
            char *find;
            int len;

            Tcl_DStringInit(&buffer);
            find = Tcl_DStringAppend(&buffer, path, -1);
            len = Tcl_DStringLength(&buffer);
            if ((len > 0) && (find[len - 1] != '\\')) {
                Tcl_DStringAppend(&buffer, "\\", 1);
            }
            find = Tcl_DStringAppend(&buffer, "*.*", 3);
            handle = FindFirstFile(find, &data);
            if (handle != INVALID_HANDLE_VALUE) {
                while (1) {
                  if ((strcmp(data.cFileName, ".") != 0)
                        && (strcmp(data.cFileName, "..") != 0)) {
                      /*
                       * Found something in this directory.
                       */

                      errno = EEXIST;
                      break;
                  }
                  if (FindNextFile(handle, &data) == FALSE) {
                      break;
                  }
                }
                FindClose(handle);
            }
            Tcl_DStringFree(&buffer);
          }
      }
    }
    if (errno == ENOTEMPTY) {
      /* 
       * The caller depends on EEXIST to signify that the directory is
       * not empty, not ENOTEMPTY. 
       */

      errno = EEXIST;
    }
    if ((recursive != 0) && (errno == EEXIST)) {
      /*
       * The directory is nonempty, but the recursive flag has been
       * specified, so we recursively remove all the files in the directory.
       */

      Tcl_DStringInit(&buffer);
      Tcl_DStringAppend(&buffer, path, -1);
      result = TraverseWinTree(TraversalDelete, &buffer, NULL, errorPtr);
      Tcl_DStringFree(&buffer);
      return result;
    }

    end:
    if (errorPtr != NULL) {
        Tcl_DStringAppend(errorPtr, path, -1);
    }
    return TCL_ERROR;
}

/*
 *---------------------------------------------------------------------------
 *
 * TraverseWinTree --
 *
 *      Traverse directory tree specified by sourcePtr, calling the function 
 *    traverseProc for each file and directory encountered.  If destPtr 
 *    is non-null, each of name in the sourcePtr directory is appended to 
 *    the directory specified by destPtr and passed as the second argument 
 *    to traverseProc() .
 *
 * Results:
 *      Standard Tcl result.
 *
 * Side effects:
 *      None caused by TraverseWinTree, however the user specified 
 *    traverseProc() may change state.  If an error occurs, the error will
 *      be returned immediately, and remaining files will not be processed.
 *
 *---------------------------------------------------------------------------
 */

static int 
TraverseWinTree(
    TraversalProc *traverseProc,/* Function to call for every file and
                         * directory in source hierarchy. */
    Tcl_DString *sourcePtr,   /* Pathname of source directory to be
                         * traversed. */
    Tcl_DString *targetPtr,   /* Pathname of directory to traverse in
                         * parallel with source directory. */
    Tcl_DString *errorPtr)    /* If non-NULL, an initialized DString for
                         * error reporting. */
{
    DWORD sourceAttr;
    char *source, *target, *errfile;
    int result, sourceLen, targetLen, sourceLenOriginal, targetLenOriginal;
    HANDLE handle;
    WIN32_FIND_DATA data;

    result = TCL_OK;
    source = Tcl_DStringValue(sourcePtr);
    sourceLenOriginal = Tcl_DStringLength(sourcePtr);
    if (targetPtr != NULL) {
      target = Tcl_DStringValue(targetPtr);
      targetLenOriginal = Tcl_DStringLength(targetPtr);
    } else {
      target = NULL;
      targetLenOriginal = 0;
    }

    errfile = NULL;

    sourceAttr = GetFileAttributes(source);
    if (sourceAttr == (DWORD) -1) {
      errfile = source;
      goto end;
    }
    if ((sourceAttr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
      /*
       * Process the regular file
       */

      return (*traverseProc)(source, target, sourceAttr, DOTREE_F, errorPtr);
    }

    /*
     * When given the pathname of the form "c:\" (one that already ends
     * with a backslash), must make sure not to add another "\" to the end
     * otherwise it will try to access a network drive.  
     */

    sourceLen = sourceLenOriginal;
    if ((sourceLen > 0) && (source[sourceLen - 1] != '\\')) {
      Tcl_DStringAppend(sourcePtr, "\\", 1);
      sourceLen++;
    }
    source = Tcl_DStringAppend(sourcePtr, "*.*", 3); 
    handle = FindFirstFile(source, &data);
    Tcl_DStringSetLength(sourcePtr, sourceLen);
    if (handle == INVALID_HANDLE_VALUE) {
      /* 
       * Can't read directory
       */

      TclWinConvertError(GetLastError());
      errfile = source;
      goto end;
    }

    result = (*traverseProc)(source, target, sourceAttr, DOTREE_PRED, errorPtr);
    if (result != TCL_OK) {
      FindClose(handle);
      return result;
    }

    if (targetPtr != NULL) {
      targetLen = targetLenOriginal;
      if ((targetLen > 0) && (target[targetLen - 1] != '\\')) {
          target = Tcl_DStringAppend(targetPtr, "\\", 1);
          targetLen++;
      }
    }

    while (1) {
      if ((strcmp(data.cFileName, ".") != 0)
              && (strcmp(data.cFileName, "..") != 0)) {
          /* 
           * Append name after slash, and recurse on the file. 
           */

          Tcl_DStringAppend(sourcePtr, data.cFileName, -1);
          if (targetPtr != NULL) {
            Tcl_DStringAppend(targetPtr, data.cFileName, -1);
          }
          result = TraverseWinTree(traverseProc, sourcePtr, targetPtr, 
                errorPtr);
          if (result != TCL_OK) {
            break;
          }

          /*
           * Remove name after slash.
           */

          Tcl_DStringSetLength(sourcePtr, sourceLen);
          if (targetPtr != NULL) {
            Tcl_DStringSetLength(targetPtr, targetLen);
          }
      }
      if (FindNextFile(handle, &data) == FALSE) {
          break;
      }
    }
    FindClose(handle);

    /*
     * Strip off the trailing slash we added
     */

    Tcl_DStringSetLength(sourcePtr, sourceLenOriginal);
    source = Tcl_DStringValue(sourcePtr);
    if (targetPtr != NULL) {
      Tcl_DStringSetLength(targetPtr, targetLenOriginal);
      target = Tcl_DStringValue(targetPtr);
    }

    if (result == TCL_OK) {
      /*
       * Call traverseProc() on a directory after visiting all the
       * files in that directory.
       */

      result = (*traverseProc)(source, target, sourceAttr, 
            DOTREE_POSTD, errorPtr);
    }
    end:
    if (errfile != NULL) {
      TclWinConvertError(GetLastError());
      if (errorPtr != NULL) {
          Tcl_DStringAppend(errorPtr, errfile, -1);
      }
      result = TCL_ERROR;
    }
          
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TraversalCopy
 *
 *      Called from TraverseUnixTree in order to execute a recursive
 *      copy of a directory.
 *
 * Results:
 *      Standard Tcl result.
 *
 * Side effects:
 *      Depending on the value of type, src may be copied to dst.
 *      
 *----------------------------------------------------------------------
 */

static int 
TraversalCopy(
    char *src,                /* Source pathname to copy. */
    char *dst,                /* Destination pathname of copy. */
    DWORD srcAttr,            /* File attributes for src. */
    int type,                 /* Reason for call - see TraverseWinTree() */
    Tcl_DString *errorPtr)    /* If non-NULL, initialized DString for
                         * error return. */
{
    switch (type) {
      case DOTREE_F:
          if (TclpCopyFile(src, dst) == TCL_OK) {
            return TCL_OK;
          }
          break;

      case DOTREE_PRED:
          if (TclpCreateDirectory(dst) == TCL_OK) {
            if (SetFileAttributes(dst, srcAttr) != FALSE) {
                return TCL_OK;
            }
            TclWinConvertError(GetLastError());
          }
          break;

        case DOTREE_POSTD:
          return TCL_OK;

    }

    /*
     * There shouldn't be a problem with src, because we already
     * checked it to get here.
     */

    if (errorPtr != NULL) {
      Tcl_DStringAppend(errorPtr, dst, -1);
    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * TraversalDelete --
 *
 *      Called by procedure TraverseWinTree for every file and
 *      directory that it encounters in a directory hierarchy. This
 *      procedure unlinks files, and removes directories after all the
 *      containing files have been processed.
 *
 * Results:
 *      Standard Tcl result.
 *
 * Side effects:
 *      Files or directory specified by src will be deleted. If an
 *      error occurs, the windows error is converted to a Posix error
 *      and errno is set accordingly.
 *
 *----------------------------------------------------------------------
 */

static int
TraversalDelete( 
    char *src,                /* Source pathname. */
    char *ignore,       /* Destination pathname (not used). */
    DWORD srcAttr,            /* File attributes for src (not used). */
    int type,                 /* Reason for call - see TraverseWinTree(). */
    Tcl_DString *errorPtr)    /* If non-NULL, initialized DString for
                         * error return. */
{
    switch (type) {
      case DOTREE_F:
          if (TclpDeleteFile(src) == TCL_OK) {
            return TCL_OK;
          }
          break;

      case DOTREE_PRED:
          return TCL_OK;

      case DOTREE_POSTD:
          if (TclpRemoveDirectory(src, 0, NULL) == TCL_OK) {
            return TCL_OK;
          }
          break;

    }

    if (errorPtr != NULL) {
      Tcl_DStringAppend(errorPtr, src, -1);
    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * AttributesPosixError --
 *
 *    Sets the object result with the appropriate error.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      The interp's object result is set with an error message
 *    based on the objIndex, fileName and errno.
 *
 *----------------------------------------------------------------------
 */

static void
AttributesPosixError(
    Tcl_Interp *interp,       /* The interp that has the error */
    int objIndex,       /* The attribute which caused the problem. */
    char *fileName,           /* The name of the file which caused the 
                         * error. */
    int getOrSet)       /* 0 for get; 1 for set */
{
    TclWinConvertError(GetLastError());
    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), 
          "cannot ", getOrSet ? "set" : "get", " attribute \"", 
          tclpFileAttrStrings[objIndex], "\" for file \"", fileName, 
          "\": ", Tcl_PosixError(interp), (char *) NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * GetWinFileAttributes --
 *
 *      Returns a Tcl_Obj containing the value of a file attribute.
 *    This routine gets the -hidden, -readonly or -system attribute.
 *
 * Results:
 *      Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object
 *    will have ref count 0. If the return value is not TCL_OK,
 *    attributePtrPtr is not touched.
 *
 * Side effects:
 *      A new object is allocated if the file is valid.
 *
 *----------------------------------------------------------------------
 */

static int
GetWinFileAttributes(
    Tcl_Interp *interp,           /* The interp we are using for errors. */
    int objIndex,           /* The index of the attribute. */
    char *fileName,               /* The name of the file. */
    Tcl_Obj **attributePtrPtr)          /* A pointer to return the object with. */
{
    DWORD result = GetFileAttributes(fileName);

    if (result == 0xFFFFFFFF) {
      AttributesPosixError(interp, objIndex, fileName, 0);
      return TCL_ERROR;
    }

    *attributePtrPtr = Tcl_NewBooleanObj(result & attributeArray[objIndex]);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ConvertFileNameFormat --
 *
 *      Returns a Tcl_Obj containing either the long or short version of the 
 *    file name.
 *
 * Results:
 *      Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object
 *    will have ref count 0. If the return value is not TCL_OK,
 *    attributePtrPtr is not touched.
 *
 * Side effects:
 *      A new object is allocated if the file is valid.
 *
 *----------------------------------------------------------------------
 */

static int
ConvertFileNameFormat(
    Tcl_Interp *interp,           /* The interp we are using for errors. */
    int objIndex,           /* The index of the attribute. */
    char *fileName,               /* The name of the file. */
    int longShort,                /* 0 to short name, 1 to long name. */
    Tcl_Obj **attributePtrPtr)          /* A pointer to return the object with. */
{
    HANDLE findHandle;
    WIN32_FIND_DATA findData;
    int pathArgc, i;
    char **pathArgv, **newPathArgv;
    char *currentElement, *resultStr;
    Tcl_DString resultDString;
    int result = TCL_OK;

    Tcl_SplitPath(fileName, &pathArgc, &pathArgv);
    newPathArgv = (char **) ckalloc(pathArgc * sizeof(char *));

    i = 0;
    if ((pathArgv[0][0] == '/') 
          || ((strlen(pathArgv[0]) == 3) && (pathArgv[0][1] == ':'))) {
      newPathArgv[0] = (char *) ckalloc(strlen(pathArgv[0]) + 1);
      strcpy(newPathArgv[0], pathArgv[0]);
      i = 1;
    } 
    for ( ; i < pathArgc; i++) {
      if (strcmp(pathArgv[i], ".") == 0) {
          currentElement = ckalloc(2);
          strcpy(currentElement, ".");
      } else if (strcmp(pathArgv[i], "..") == 0) {
          currentElement = ckalloc(3);
          strcpy(currentElement, "..");
      } else {
          int useLong;

          Tcl_DStringInit(&resultDString);
          resultStr = Tcl_JoinPath(i + 1, pathArgv, &resultDString);
          findHandle = FindFirstFile(resultStr, &findData);
          if (findHandle == INVALID_HANDLE_VALUE) {
            pathArgc = i - 1;
            AttributesPosixError(interp, objIndex, fileName, 0);
            result = TCL_ERROR;
            Tcl_DStringFree(&resultDString);
            goto cleanup;
          }
          if (longShort) {
            if (findData.cFileName[0] != '\0') {
                useLong = 1;
            } else {
                useLong = 0;
            }
          } else {
            if (findData.cAlternateFileName[0] == '\0') {
                useLong = 1;
            } else {
                useLong = 0;
            }
          }
          if (useLong) {
            currentElement = ckalloc(strlen(findData.cFileName) + 1);
            strcpy(currentElement, findData.cFileName);
          } else {
            currentElement = ckalloc(strlen(findData.cAlternateFileName) 
                  + 1);
            strcpy(currentElement, findData.cAlternateFileName);
          }
          Tcl_DStringFree(&resultDString);
          FindClose(findHandle);
      }
      newPathArgv[i] = currentElement;
    }

    Tcl_DStringInit(&resultDString);
    resultStr = Tcl_JoinPath(pathArgc, newPathArgv, &resultDString);
    *attributePtrPtr = Tcl_NewStringObj(resultStr, Tcl_DStringLength(&resultDString));
    Tcl_DStringFree(&resultDString);

cleanup:
    for (i = 0; i < pathArgc; i++) {
      ckfree(newPathArgv[i]);
    }
    ckfree((char *) newPathArgv);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * GetWinFileLongName --
 *
 *      Returns a Tcl_Obj containing the short version of the file
 *    name.
 *
 * Results:
 *      Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object
 *    will have ref count 0. If the return value is not TCL_OK,
 *    attributePtrPtr is not touched.
 *
 * Side effects:
 *      A new object is allocated if the file is valid.
 *
 *----------------------------------------------------------------------
 */

static int
GetWinFileLongName(
    Tcl_Interp *interp,           /* The interp we are using for errors. */
    int objIndex,           /* The index of the attribute. */
    char *fileName,               /* The name of the file. */
    Tcl_Obj **attributePtrPtr)          /* A pointer to return the object with. */
{
    return ConvertFileNameFormat(interp, objIndex, fileName, 1, attributePtrPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * GetWinFileShortName --
 *
 *      Returns a Tcl_Obj containing the short version of the file
 *    name.
 *
 * Results:
 *      Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object
 *    will have ref count 0. If the return value is not TCL_OK,
 *    attributePtrPtr is not touched.
 *
 * Side effects:
 *      A new object is allocated if the file is valid.
 *
 *----------------------------------------------------------------------
 */

static int
GetWinFileShortName(
    Tcl_Interp *interp,           /* The interp we are using for errors. */
    int objIndex,           /* The index of the attribute. */
    char *fileName,               /* The name of the file. */
    Tcl_Obj **attributePtrPtr)          /* A pointer to return the object with. */
{
    return ConvertFileNameFormat(interp, objIndex, fileName, 0, attributePtrPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * SetWinFileAttributes --
 *
 *    Set the file attributes to the value given by attributePtr.
 *    This routine sets the -hidden, -readonly, or -system attributes.
 *
 * Results:
 *      Standard TCL error.
 *
 * Side effects:
 *      The file's attribute is set.
 *
 *----------------------------------------------------------------------
 */

static int
SetWinFileAttributes(
    Tcl_Interp *interp,           /* The interp we are using for errors. */
    int objIndex,           /* The index of the attribute. */
    char *fileName,               /* The name of the file. */
    Tcl_Obj *attributePtr)        /* The new value of the attribute. */
{
    DWORD fileAttributes = GetFileAttributes(fileName);
    int yesNo;
    int result;

    if (fileAttributes == 0xFFFFFFFF) {
      AttributesPosixError(interp, objIndex, fileName, 1);
      return TCL_ERROR;
    }

    result = Tcl_GetBooleanFromObj(interp, attributePtr, &yesNo);
    if (result != TCL_OK) {
      return result;
    }

    if (yesNo) {
      fileAttributes |= (attributeArray[objIndex]);
    } else {
      fileAttributes &= ~(attributeArray[objIndex]);
    }

    if (!SetFileAttributes(fileName, fileAttributes)) {
      AttributesPosixError(interp, objIndex, fileName, 1);
      return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * SetWinFileLongName --
 *
 *    The attribute in question is a readonly attribute and cannot
 *    be set.
 *
 * Results:
 *      TCL_ERROR
 *
 * Side effects:
 *      The object result is set to a pertinant error message.
 *
 *----------------------------------------------------------------------
 */

static int
CannotSetAttribute(
    Tcl_Interp *interp,           /* The interp we are using for errors. */
    int objIndex,           /* The index of the attribute. */
    char *fileName,               /* The name of the file. */
    Tcl_Obj *attributePtr)        /* The new value of the attribute. */
{
    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), 
          "cannot set attribute \"", tclpFileAttrStrings[objIndex],
          "\" for file \"", fileName, "\" : attribute is readonly", 
          (char *) NULL);
    return TCL_ERROR;
}


/*
 *---------------------------------------------------------------------------
 *
 * TclpListVolumes --
 *
 *    Lists the currently mounted volumes
 *
 * Results:
 *    A standard Tcl result.  Will always be TCL_OK, since there is no way
 *    that this command can fail.  Also, the interpreter's result is set to 
 *    the list of volumes.
 *
 * Side effects:
 *    None
 *
 *---------------------------------------------------------------------------
 */

int
TclpListVolumes( 
    Tcl_Interp *interp)    /* Interpreter to which to pass the volume list */
{
    Tcl_Obj *resultPtr, *elemPtr;
    char buf[4];
    int i;

    resultPtr = Tcl_GetObjResult(interp);

    buf[1] = ':';
    buf[2] = '/';
    buf[3] = '\0';

    /*
     * On Win32s: 
     * GetLogicalDriveStrings() isn't implemented.
     * GetLogicalDrives() returns incorrect information.
     */

    for (i = 0; i < 26; i++) {
        buf[0] = (char) ('a' + i);
      if (GetVolumeInformation(buf, NULL, 0, NULL, NULL, NULL, NULL, 0)  
            || (GetLastError() == ERROR_NOT_READY)) {
          elemPtr = Tcl_NewStringObj(buf, -1);
          Tcl_ListObjAppendElement(NULL, resultPtr, elemPtr);
      }
    }
    return TCL_OK;      
}

Generated by  Doxygen 1.6.0   Back to index