*
 * Copyright (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-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: tclIOUtil.c,v 1.19 2001/09/06 17:51:00 vincentdarley Exp $
 * RCS: @(#) $Id: tclIOUtil.c,v 1.20 2001/09/08 14:05:09 vincentdarley Exp $
 */

#include "tclInt.h"
#include "tclPort.h"

/*
 * Prototypes for procedures defined later in this file.  The last

static int 		FindSplitPos _ANSI_ARGS_((char *path, char *separator));
static Tcl_PathType     FSGetPathType  _ANSI_ARGS_((Tcl_Obj *pathObjPtr, 
			    Tcl_Filesystem **filesystemPtrPtr, 
			    int *driveNameLengthPtr));
static Tcl_PathType     GetPathType  _ANSI_ARGS_((Tcl_Obj *pathObjPtr, 
			    Tcl_Filesystem **filesystemPtrPtr, 
			    int *driveNameLengthPtr, Tcl_Obj **driveNameRef));
static int              CrossFilesystemCopy _ANSI_ARGS_((Tcl_Obj *source, 
							 Tcl_Obj *target));

/*
 * Define the 'path' object type, which Tcl uses to represent
 * file paths internally.
 */
Tcl_ObjType tclFsPathType = {
    "path",				/* name */

		 * this filesystem, and we must avoid a possible
		 * infinite loop. 
		 */
		Tcl_DecrRefCount(copyToPtr);
		return -1;
	    }
	    
	    if (TclCrossFilesystemCopy(interp, pathPtr, 
	    if (CrossFilesystemCopy(pathPtr, copyToPtr) == TCL_OK) {
				       copyToPtr) == TCL_OK) {
		/* 
		 * Do we need to set appropriate permissions 
		 * on the file?  This may be required on some
		 * systems.  On Unix we could do loop over
		 * systems.  On Unix we could loop over
		 * the file attributes, and set any that are
		 * called "-permissions" to 0777.  Or directly:
		 * 
		 * Tcl_Obj* perm = Tcl_NewStringObj("0777",-1);
		 * Tcl_IncrRefCount(perm);
		 * Tcl_FSFileAttrsSet(NULL, 2, copyToPtr, perm);
		 * Tcl_DecrRefCount(perm);

	if (proc != NULL) {
	    retVal = (*proc)(srcPathPtr, destPathPtr);
	}
    }
    if (retVal == -1) {
	Tcl_SetErrno(EXDEV);
    }
    if ((retVal != TCL_OK) && (errno == EXDEV)) {
        retVal = CrossFilesystemCopy(srcPathPtr, destPathPtr);
    }
    return retVal;
}

/*
 *---------------------------------------------------------------------------
 *
 * CrossFilesystemCopy --
 * TclCrossFilesystemCopy --
 *
 *	Helper for above function, and for Tcl_FSLoadFile, to copy
 *	files from one filesystem to another.  This function will
 *	overwrite the target file if it already exists.
 *
 * Results:
 *      Standard Tcl error code.
 *
 * Side effects:
 *	A file may be created.
 *
 *---------------------------------------------------------------------------
 */
static int 
CrossFilesystemCopy(source, target) 
int 
TclCrossFilesystemCopy(interp, source, target) 
    Tcl_Interp *interp; /* For error messages */
    Tcl_Obj *source;	/* Pathname of file to be copied (UTF-8). */
    Tcl_Obj *target;	/* Pathname of file to copy to (UTF-8). */
{
    int result = TCL_ERROR;
    int prot = 0666;
    
    Tcl_Channel out = Tcl_FSOpenFileChannel(NULL, target, "w", prot);
    Tcl_Channel out = Tcl_FSOpenFileChannel(interp, target, "w", prot);
    if (out != NULL) {
	/* It looks like we can copy it over */
	Tcl_Channel in = Tcl_FSOpenFileChannel(NULL, source, 
	Tcl_Channel in = Tcl_FSOpenFileChannel(interp, source, 
					       "r", prot);
	if (in == NULL) {
	    /* This is very strange, we checked this above */
	    Tcl_Close(NULL, out);
	    Tcl_Close(interp, out);
	} else {
	    struct stat sourceStatBuf;
	    struct utimbuf tval;
	    /* 
	     * Copy it synchronously.  We might wish to add an
	     * asynchronous option to support vfs's which are
	     * slow (e.g. network sockets).
	     */
	    Tcl_SetChannelOption(NULL, in, "-translation", "binary");
	    Tcl_SetChannelOption(NULL, out, "-translation", "binary");
	    Tcl_SetChannelOption(interp, in, "-translation", "binary");
	    Tcl_SetChannelOption(interp, out, "-translation", "binary");
	    
	    if (TclCopyChannel(NULL, in, out, -1, NULL) == TCL_OK) {
	    if (TclCopyChannel(interp, in, out, -1, NULL) == TCL_OK) {
		result = TCL_OK;
	    }
	    /* 
	     * If the copy failed, assume that copy channel left
	     * a good error message.
	     */
	    Tcl_Close(NULL, in);
	    Tcl_Close(NULL, out);
	    Tcl_Close(interp, in);
	    Tcl_Close(interp, out);
	    
	    /* Set modification date of copied file */
	    if (Tcl_FSLstat(source, &sourceStatBuf) != 0) {
		tval.actime = sourceStatBuf.st_atime;
		tval.modtime = sourceStatBuf.st_mtime;
		Tcl_FSUtime(source, &tval);
	    }