/*

 * tclFCmd.c

 *

 *      This file implements the generic portion of file manipulation 

 *      subcommands of the "file" command. 

 *

 * Copyright (c) 1996-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: tclFCmd.c,v 1.20.2.2 2005/08/17 17:46:36 hobbs Exp $

 */

#include "tclInt.h"

#include "tclPort.h"

/*

 * Declarations for local procedures defined in this file:

 */

static int		CopyRenameOneFile _ANSI_ARGS_((Tcl_Interp *interp,

			    Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr, 

			    int copyFlag, int force));

static Tcl_Obj *	FileBasename _ANSI_ARGS_((Tcl_Interp *interp,

			    Tcl_Obj *pathPtr));

static int		FileCopyRename _ANSI_ARGS_((Tcl_Interp *interp,

			    int objc, Tcl_Obj *CONST objv[], int copyFlag));

static int		FileForceOption _ANSI_ARGS_((Tcl_Interp *interp,

			    int objc, Tcl_Obj *CONST objv[], int *forcePtr));

/*

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

 *

 * TclFileRenameCmd

 *

 *	This procedure implements the "rename" subcommand of the "file"

 *      command.  Filename arguments need to be translated to native

 *	format before being passed to platform-specific code that

 *	implements rename functionality.

 *

 * Results:

 *	A standard Tcl result.

 *

 * Side effects:

 *	See the user documentation.

 *

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

 */

int

TclFileRenameCmd(interp, objc, objv)

    Tcl_Interp *interp;		/* Interp for error reporting. */

    int objc;			/* Number of arguments. */

    Tcl_Obj *CONST objv[];	/* Argument strings passed to Tcl_FileCmd. */

{

    return FileCopyRename(interp, objc, objv, 0);

}

/*

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

 *

 * TclFileCopyCmd

 *

 *	This procedure implements the "copy" subcommand of the "file"

 *	command.  Filename arguments need to be translated to native

 *	format before being passed to platform-specific code that

 *	implements copy functionality.

 *

 * Results:

 *	A standard Tcl result.

 *

 * Side effects:

 *	See the user documentation.

 *

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

 */

int

TclFileCopyCmd(interp, objc, objv)

    Tcl_Interp *interp;		/* Used for error reporting */

    int objc;			/* Number of arguments. */

    Tcl_Obj *CONST objv[];	/* Argument strings passed to Tcl_FileCmd. */

{

    return FileCopyRename(interp, objc, objv, 1);

}

/*

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

 *

 * FileCopyRename --

 *

 *	Performs the work of TclFileRenameCmd and TclFileCopyCmd.

 *	See comments for those procedures.

 *

 * Results:

 *	See above.

 *

 * Side effects:

 *	See above.

 *

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

 */

static int

FileCopyRename(interp, objc, objv, copyFlag)

    Tcl_Interp *interp;		/* Used for error reporting. */

    int objc;			/* Number of arguments. */

    Tcl_Obj *CONST objv[];	/* Argument strings passed to Tcl_FileCmd. */

    int copyFlag;		/* If non-zero, copy source(s).  Otherwise,

				 * rename them. */

{

    int i, result, force;

    Tcl_StatBuf statBuf; 

    Tcl_Obj *target;

    i = FileForceOption(interp, objc - 2, objv + 2, &force);

    if (i < 0) {

	return TCL_ERROR;

    }

    i += 2;

    if ((objc - i) < 2) {

	Tcl_AppendResult(interp, "wrong # args: should be \"", 

		Tcl_GetString(objv[0]), " ", Tcl_GetString(objv[1]), 

		" ?options? source ?source ...? target\"", 

		(char *) NULL);

	return TCL_ERROR;

    }

    /*

     * If target doesn't exist or isn't a directory, try the copy/rename.

     * More than 2 arguments is only valid if the target is an existing

     * directory.

     */

    target = objv[objc - 1];

    if (Tcl_FSConvertToPathType(interp, target) != TCL_OK) {

	return TCL_ERROR;

    }

    result = TCL_OK;

    /*

     * Call Tcl_FSStat() so that if target is a symlink that points to a

     * directory we will put the sources in that directory instead of

     * overwriting the symlink.

     */

    if ((Tcl_FSStat(target, &statBuf) != 0) || !S_ISDIR(statBuf.st_mode)) {

	if ((objc - i) > 2) {

	    errno = ENOTDIR;

	    Tcl_PosixError(interp);

	    Tcl_AppendResult(interp, "error ",

		    ((copyFlag) ? "copying" : "renaming"), ": target \"",

		    Tcl_GetString(target), "\" is not a directory", 

		    (char *) NULL);

	    result = TCL_ERROR;

	} else {

	    /*

	     * Even though already have target == translated(objv[i+1]),

	     * pass the original argument down, so if there's an error, the

	     * error message will reflect the original arguments.

	     */

	    result = CopyRenameOneFile(interp, objv[i], objv[i + 1], copyFlag,

		    force);

	}

	return result;

    }

    /*

     * Move each source file into target directory.  Extract the basename

     * from each source, and append it to the end of the target path.

     */

    for ( ; i < objc - 1; i++) {

	Tcl_Obj *jargv[2];

	Tcl_Obj *source, *newFileName;

	Tcl_Obj *temp;

	source = FileBasename(interp, objv[i]);

	if (source == NULL) {

	    result = TCL_ERROR;

	    break;

	}

	jargv[0] = objv[objc - 1];

	jargv[1] = source;

	temp = Tcl_NewListObj(2, jargv);

	newFileName = Tcl_FSJoinPath(temp, -1);

	Tcl_IncrRefCount(newFileName);

	result = CopyRenameOneFile(interp, objv[i], newFileName, copyFlag,

		force);

	Tcl_DecrRefCount(newFileName);

	Tcl_DecrRefCount(temp);

	Tcl_DecrRefCount(source);

	if (result == TCL_ERROR) {

	    break;

	}

    }

    return result;

}

/*

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

 *

 * TclFileMakeDirsCmd

 *

 *	This procedure implements the "mkdir" subcommand of the "file"

 *      command.  Filename arguments need to be translated to native

 *	format before being passed to platform-specific code that

 *	implements mkdir functionality.

 *

 * Results:

 *	A standard Tcl result.

 *

 * Side effects:

 *	See the user documentation.

 *

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

 */

int

TclFileMakeDirsCmd(interp, objc, objv)

    Tcl_Interp *interp;		/* Used for error reporting. */

    int objc;			/* Number of arguments */

    Tcl_Obj *CONST objv[];	/* Argument strings passed to Tcl_FileCmd. */

{

    Tcl_Obj *errfile;

    int result, i, j, pobjc;

    Tcl_Obj *split = NULL;

    Tcl_Obj *target = NULL;

    Tcl_StatBuf statBuf;

    errfile = NULL;

    result = TCL_OK;

    for (i = 2; i < objc; i++) {

	if (Tcl_FSConvertToPathType(interp, objv[i]) != TCL_OK) {

	    result = TCL_ERROR;

	    break;

	}

	split = Tcl_FSSplitPath(objv[i],&pobjc);

	if (pobjc == 0) {

	    errno = ENOENT;

	    errfile = objv[i];

	    break;

	}

	for (j = 0; j < pobjc; j++) {

	    target = Tcl_FSJoinPath(split, j + 1);

	    Tcl_IncrRefCount(target);

	    /*

	     * Call Tcl_FSStat() so that if target is a symlink that

	     * points to a directory we will create subdirectories in

	     * that directory.

	     */

	    if (Tcl_FSStat(target, &statBuf) == 0) {

		if (!S_ISDIR(statBuf.st_mode)) {

		    errno = EEXIST;

		    errfile = target;

		    goto done;

		}

	    } else if (errno != ENOENT) {

		/*

		 * If Tcl_FSStat() failed and the error is anything

		 * other than non-existence of the target, throw the

		 * error.

		 */

		errfile = target;

		goto done;

	    } else if (Tcl_FSCreateDirectory(target) != TCL_OK) {

		/*

		 * Create might have failed because of being in a race

		 * condition with another process trying to create the

		 * same subdirectory.

		 */

		if (errno == EEXIST) {

		    if ((Tcl_FSStat(target, &statBuf) == 0)

			    && S_ISDIR(statBuf.st_mode)) {

			/*

			 * It is a directory that wasn't there before,

			 * so keep going without error.

			 */

			Tcl_ResetResult(interp);

		    } else {

			errfile = target;

			goto done;

		    }

		} else {

		    errfile = target;

		    goto done;

		}

	    }

 	    /* Forget about this sub-path */

	    Tcl_DecrRefCount(target);

	    target = NULL;

	}

	Tcl_DecrRefCount(split);

	split = NULL;

    }

    done:

    if (errfile != NULL) {

	Tcl_AppendResult(interp, "can't create directory \"",

		Tcl_GetString(errfile), "\": ", Tcl_PosixError(interp), 

		(char *) NULL);

	result = TCL_ERROR;

    }

    if (split != NULL) {

	Tcl_DecrRefCount(split);

    }

    if (target != NULL) {

	Tcl_DecrRefCount(target);

    }

    return result;

}

/*

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

 *

 * TclFileDeleteCmd

 *

 *	This procedure implements the "delete" subcommand of the "file"

 *      command.

 *

 * Results:

 *	A standard Tcl result.

 *

 * Side effects:

 *	See the user documentation.

 *

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

 */

int

TclFileDeleteCmd(interp, objc, objv)

    Tcl_Interp *interp;		/* Used for error reporting */

    int objc;			/* Number of arguments */

    Tcl_Obj *CONST objv[];	/* Argument strings passed to Tcl_FileCmd. */

{

    int i, force, result;

    Tcl_Obj *errfile;

    Tcl_Obj *errorBuffer = NULL;

    i = FileForceOption(interp, objc - 2, objv + 2, &force);

    if (i < 0) {

	return TCL_ERROR;

    }

    i += 2;

    if ((objc - i) < 1) {

	Tcl_AppendResult(interp, "wrong # args: should be \"", 

		Tcl_GetString(objv[0]), " ", Tcl_GetString(objv[1]), 

		" ?options? file ?file ...?\"", (char *) NULL);

	return TCL_ERROR;

    }

    errfile = NULL;

    result = TCL_OK;

    for ( ; i < objc; i++) {

	Tcl_StatBuf statBuf;

	errfile = objv[i];

	if (Tcl_FSConvertToPathType(interp, objv[i]) != TCL_OK) {

	    result = TCL_ERROR;

	    goto done;

	}

	/*

	 * Call lstat() to get info so can delete symbolic link itself.

	 */

	if (Tcl_FSLstat(objv[i], &statBuf) != 0) {

	    /*

	     * Trying to delete a file that does not exist is not

	     * considered an error, just a no-op

	     */

	    if (errno != ENOENT) {

		result = TCL_ERROR;

	    }

	} else if (S_ISDIR(statBuf.st_mode)) {

	    /* 

	     * We own a reference count on errorBuffer, if it was set

	     * as a result of this call. 

	     */

	    result = Tcl_FSRemoveDirectory(objv[i], force, &errorBuffer);

	    if (result != TCL_OK) {

		if ((force == 0) && (errno == EEXIST)) {

		    Tcl_AppendResult(interp, "error deleting \"", 

			    Tcl_GetString(objv[i]),

			    "\": directory not empty", (char *) NULL);

		    Tcl_PosixError(interp);

		    goto done;

		}

		/* 

		 * If possible, use the untranslated name for the file.

		 */

		errfile = errorBuffer;

		/* FS supposed to check between translated objv and errfile */

		if (Tcl_FSEqualPaths(objv[i], errfile)) {

		    errfile = objv[i];

		}

	    }

	} else {

	    result = Tcl_FSDeleteFile(objv[i]);

	}

	if (result != TCL_OK) {

	    result = TCL_ERROR;

	    /* 

	     * It is important that we break on error, otherwise we

	     * might end up owning reference counts on numerous

	     * errorBuffers.

	     */

	    break;

	}

    }

    if (result != TCL_OK) {

	if (errfile == NULL) {

	    /* 

	     * We try to accomodate poor error results from our 

	     * Tcl_FS calls 

	     */

	    Tcl_AppendResult(interp, "error deleting unknown file: ", 

		    Tcl_PosixError(interp), (char *) NULL);

	} else {

	    Tcl_AppendResult(interp, "error deleting \"", 

		    Tcl_GetString(errfile), "\": ", 

		    Tcl_PosixError(interp), (char *) NULL);

	}

    } 

    done:

    if (errorBuffer != NULL) {

	Tcl_DecrRefCount(errorBuffer);

    }

    return result;

}

/*

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

 *

 * CopyRenameOneFile

 *

 *	Copies or renames specified source file or directory hierarchy

 *	to the specified target.  

 *

 * Results:

 *	A standard Tcl result.

 *

 * Side effects:

 *	Target is overwritten if the force flag is set.  Attempting to

 *	copy/rename a file onto a directory or a directory onto a file

 *	will always result in an error.  

 *

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

 */

static int

CopyRenameOneFile(interp, source, target, copyFlag, force) 

    Tcl_Interp *interp;		/* Used for error reporting. */

    Tcl_Obj *source;		/* Pathname of file to copy.  May need to

				 * be translated. */

    Tcl_Obj *target;		/* Pathname of file to create/overwrite.

				 * May need to be translated. */

    int copyFlag;		/* If non-zero, copy files.  Otherwise,

				 * rename them. */

    int force;			/* If non-zero, overwrite target file if it

				 * exists.  Otherwise, error if target already

				 * exists. */

{

    int result;

    Tcl_Obj *errfile, *errorBuffer;

    /* If source is a link, then this is the real file/directory */

    Tcl_Obj *actualSource = NULL;

    Tcl_StatBuf sourceStatBuf, targetStatBuf;

    if (Tcl_FSConvertToPathType(interp, source) != TCL_OK) {

	return TCL_ERROR;

    }

    if (Tcl_FSConvertToPathType(interp, target) != TCL_OK) {

	return TCL_ERROR;

    }

    errfile = NULL;

    errorBuffer = NULL;

    result = TCL_ERROR;

    /*

     * We want to copy/rename links and not the files they point to, so we

     * use lstat(). If target is a link, we also want to replace the 

     * link and not the file it points to, so we also use lstat() on the

     * target.

     */

    if (Tcl_FSLstat(source, &sourceStatBuf) != 0) {

	errfile = source;

	goto done;

    }

    if (Tcl_FSLstat(target, &targetStatBuf) != 0) {

	if (errno != ENOENT) {

	    errfile = target;

	    goto done;

	}

    } else {

	if (force == 0) {

	    errno = EEXIST;

	    errfile = target;

	    goto done;

	}

        /* 

         * Prevent copying or renaming a file onto itself.  Under Windows, 

         * stat always returns 0 for st_ino.  However, the Windows-specific 

         * code knows how to deal with copying or renaming a file on top of

         * itself.  It might be a good idea to write a stat that worked.

         */

        if ((sourceStatBuf.st_ino != 0) && (targetStatBuf.st_ino != 0)) {

            if ((sourceStatBuf.st_ino == targetStatBuf.st_ino) &&

            	    (sourceStatBuf.st_dev == targetStatBuf.st_dev)) {

            	result = TCL_OK;

            	goto done;

            }

        }