archie/tcl7.6/win/tclWinFCmd.c

/*
 * tclWinFCmd.c
 *
 *      This file implements the Windows specific portion of file manipulation 
 *      subcommands of the "file" command. 
 *
 * Copyright (c) 1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tclWinFCmd.c 1.12 96/10/14 14:39:16
 */

#include "tclWinInt.h"
#include "tclPort.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 */

/*
 * 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 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) {
	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 (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 */
{
    if (CreateDirectory(path, NULL) == 0) {
	TclWinConvertError(GetLastError());
	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;
    OSVERSIONINFO os;
    DWORD attr;

    if (RemoveDirectory(path) != FALSE) {
	return TCL_OK;
    }
    TclWinConvertError(GetLastError());
    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 reports removing a non-empty directory as
	     * an EACCES, not an EEXIST.  If the directory is not empty,
	     * change errno so caller knows what's going on.
	     */

	    os.dwOSVersionInfoSize = sizeof(os);
	    GetVersionEx(&os);
	    if (os.dwPlatformId == VER_PLATFORM_WIN32_WINDOWS) {
		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;
}