/*

 * tclUnixFCmd.c

 *

 *      This file implements the unix specific portion of file manipulation 

 *      subcommands of the "file" command.  All filename arguments should

 *	already be translated to native format.

 *

 * Copyright (c) 1996-1998 Sun Microsystems, Inc.

 * Portions Copyright (c) 2007-2008 Nokia Corporation and/or its subsidiaries. All rights reserved.   

 *

 * See the file "license.terms" for information on usage and redistribution

 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.

 *

 * RCS: @(#) $Id: tclUnixFCmd.c,v 1.28.2.15 2007/04/29 02:19:51 das Exp $

 *

 * Portions of this code were derived from NetBSD source code which has

 * the following copyright notice:

 *

 * Copyright (c) 1988, 1993, 1994

 *      The Regents of the University of California.  All rights reserved.

 *

 * Redistribution and use in source and binary forms, with or without

 * modification, are permitted provided that the following conditions

 * are met:

 * 1. Redistributions of source code must retain the above copyright

 *    notice, this list of conditions and the following disclaimer.

 * 2. Redistributions in binary form must reproduce the above copyright

 *    notice, this list of conditions and the following disclaimer in the

 *    documentation and/or other materials provided with the distribution.

 * 3. All advertising materials mentioning features or use of this software

 *    must display the following acknowledgement:

 *      This product includes software developed by the University of

 *      California, Berkeley and its contributors.

 * 4. Neither the name of the University nor the names of its contributors

 *    may be used to endorse or promote products derived from this software

 *    without specific prior written permission.

 *

 * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND

 * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE

 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE

 * ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE

 * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL

 * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS

 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)

 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT

 * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY

 * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF

 * SUCH DAMAGE.

 */

#include "tclInt.h"

#include "tclPort.h"

#include <utime.h>

#include <grp.h>

#ifndef HAVE_ST_BLKSIZE

#ifndef NO_FSTATFS

#include <sys/statfs.h>

#endif

#endif

#ifdef HAVE_FTS

#include <fts.h>

#endif

#ifdef __SYMBIAN32__  

#include "convertPathSlashes.h"  

void TclPrint1(const char* aFmt, const char* aStr);

#endif

/*

 * The following constants specify the type of callback when

 * TraverseUnixTree() 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		GetGroupAttribute _ANSI_ARGS_((Tcl_Interp *interp,

			    int objIndex, Tcl_Obj *fileName,

			    Tcl_Obj **attributePtrPtr));

static int		GetOwnerAttribute _ANSI_ARGS_((Tcl_Interp *interp,

			    int objIndex, Tcl_Obj *fileName,

			    Tcl_Obj **attributePtrPtr));

static int		GetPermissionsAttribute _ANSI_ARGS_((

			    Tcl_Interp *interp, int objIndex,

			    Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr));

static int		SetGroupAttribute _ANSI_ARGS_((Tcl_Interp *interp,

			    int objIndex, Tcl_Obj *fileName,

			    Tcl_Obj *attributePtr));

static int		SetOwnerAttribute _ANSI_ARGS_((Tcl_Interp *interp,

			    int objIndex, Tcl_Obj *fileName,

			    Tcl_Obj *attributePtr));

static int		SetPermissionsAttribute _ANSI_ARGS_((

			    Tcl_Interp *interp, int objIndex,

			    Tcl_Obj *fileName, Tcl_Obj *attributePtr));

static int		GetModeFromPermString _ANSI_ARGS_((

			    Tcl_Interp *interp, char *modeStringPtr,

			    mode_t *modePtr));

/*

 * Prototype for the TraverseUnixTree callback function.

 */

typedef int (TraversalProc) _ANSI_ARGS_((Tcl_DString *srcPtr,

	Tcl_DString *dstPtr, CONST Tcl_StatBuf *statBufPtr, int type,

	Tcl_DString *errorPtr));

/*

 * Constants and variables necessary for file attributes subcommand.

 */

enum {

    UNIX_GROUP_ATTRIBUTE,

    UNIX_OWNER_ATTRIBUTE,

    UNIX_PERMISSIONS_ATTRIBUTE

};

CONST char *tclpFileAttrStrings[] = {

    "-group",

    "-owner",

    "-permissions",

    (char *) NULL

};

CONST TclFileAttrProcs tclpFileAttrProcs[] = {

    {GetGroupAttribute,		SetGroupAttribute},

    {GetOwnerAttribute,		SetOwnerAttribute},

    {GetPermissionsAttribute,	SetPermissionsAttribute}

};

/*

 * This is the maximum number of consecutive readdir/unlink calls that can be

 * made (with no intervening rewinddir or closedir/opendir) before triggering

 * a bug that makes readdir return NULL even though some directory entries

 * have not been processed.  The bug afflicts SunOS's readdir when applied to

 * ufs file systems and Darwin 6.5's (and OSX v.10.3.8's) HFS+.  JH found the

 * Darwin readdir to reset at 147, so 130 is chosen to be conservative.  We

 * can't do a general rewind on failure as NFS can create special files that

 * recreate themselves when you try and delete them.  8.4.8 added a solution

 * that was affected by a single such NFS file, this solution should not be

 * affected by less than THRESHOLD such files. [Bug 1034337]

 */

#define MAX_READDIR_UNLINK_THRESHOLD 130

/*

 * Declarations for local procedures defined in this file:

 */

static int		CopyFile _ANSI_ARGS_((CONST char *src,

			    CONST char *dst, CONST Tcl_StatBuf *statBufPtr));

static int		CopyFileAtts _ANSI_ARGS_((CONST char *src,

			    CONST char *dst, CONST Tcl_StatBuf *statBufPtr));

static int		DoCopyFile _ANSI_ARGS_((CONST char *srcPtr,

			    CONST char *dstPtr, CONST Tcl_StatBuf *statBufPtr));

static int		DoCreateDirectory _ANSI_ARGS_((CONST char *pathPtr));

static int		DoRemoveDirectory _ANSI_ARGS_((Tcl_DString *pathPtr,

			    int recursive, Tcl_DString *errorPtr));

static int		DoRenameFile _ANSI_ARGS_((CONST char *src,

			    CONST char *dst));

static int		TraversalCopy _ANSI_ARGS_((Tcl_DString *srcPtr,

			    Tcl_DString *dstPtr, CONST Tcl_StatBuf *statBufPtr,

			    int type, Tcl_DString *errorPtr));

static int		TraversalDelete _ANSI_ARGS_((Tcl_DString *srcPtr,

			    Tcl_DString *dstPtr, CONST Tcl_StatBuf *statBufPtr,

			    int type, Tcl_DString *errorPtr));

static int		TraverseUnixTree _ANSI_ARGS_((

			    TraversalProc *traversalProc,

			    Tcl_DString *sourcePtr, Tcl_DString *destPtr,

			    Tcl_DString *errorPtr, int doRewind));

#ifdef PURIFY

/*

 * realpath and purify don't mix happily.  It has been noted that realpath

 * should not be used with purify because of bogus warnings, but just

 * memset'ing the resolved path will squelch those.  This assumes we are

 * passing the standard MAXPATHLEN size resolved arg.

 */

static char *		Realpath _ANSI_ARGS_((CONST char *path,

			    char *resolved));

char *

Realpath(path, resolved)

    CONST char *path;

    char *resolved;

{

    memset(resolved, 0, MAXPATHLEN);

    return realpath(path, resolved);

}

#else

#define Realpath realpath

#endif

#ifndef NO_REALPATH

#if defined(__APPLE__) && defined(TCL_THREADS) && \

	defined(MAC_OS_X_VERSION_MIN_REQUIRED) && \

	MAC_OS_X_VERSION_MIN_REQUIRED < 1030

/*

 * prior to Darwin 7, realpath is not threadsafe, c.f. bug 711232;

 * if we might potentially be running on pre-10.3 OSX,

 * check Darwin release at runtime before using realpath.

 */

extern long tclMacOSXDarwinRelease;

#define haveRealpath (tclMacOSXDarwinRelease >= 7)

#else

#define haveRealpath 1

#endif

#endif /* NO_REALPATH */

#ifdef HAVE_FTS

#ifdef HAVE_STRUCT_STAT64

/* fts doesn't do stat64 */

#define noFtsStat 1

#elif defined(__APPLE__) && defined(__LP64__) && \

	defined(MAC_OS_X_VERSION_MIN_REQUIRED) && \

	MAC_OS_X_VERSION_MIN_REQUIRED < 1050

/*

 * prior to Darwin 9, 64bit fts_open() without FTS_NOSTAT may crash (due to a

 * 64bit-unsafe ALIGN macro); if we could be running on pre-10.5 OSX, check

 * Darwin release at runtime and do a separate stat() if necessary.

 */

extern long tclMacOSXDarwinRelease;

#define noFtsStat (tclMacOSXDarwinRelease < 9)

#else

#define noFtsStat 0

#endif

#endif /* HAVE_FTS */

/*

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

 *

 * TclpObjRenameFile, DoRenameFile --

 *

 *      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, or src or dst is "".

 *	ENOTDIR:    src is a directory, but dst is not.  

 *	EXDEV:	    src and dst are on different filesystems.

 *	

 * Side effects:

 *	The implementation of rename may allow cross-filesystem renames,

 *	but the caller should be prepared to emulate it with copy and

 *	delete if errno is EXDEV.

 *

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

 */

int 

TclpObjRenameFile(srcPathPtr, destPathPtr)

    Tcl_Obj *srcPathPtr;

    Tcl_Obj *destPathPtr;

{

    return DoRenameFile(Tcl_FSGetNativePath(srcPathPtr), 

			Tcl_FSGetNativePath(destPathPtr));

}

static int

DoRenameFile(src, dst)

    CONST char *src;		/* Pathname of file or dir to be renamed

				 * (native). */

    CONST char *dst;		/* New pathname of file or directory

				 * (native). */

{

    if (rename(src, dst) == 0) {			/* INTL: Native. */

	return TCL_OK;

    }

    if (errno == ENOTEMPTY) {

	errno = EEXIST;

    }

    /*

     * IRIX returns EIO when you attept to move a directory into

     * itself.  We just map EIO to EINVAL get the right message on SGI.

     * Most platforms don't return EIO except in really strange cases.

     */

    if (errno == EIO) {

	errno = EINVAL;

    }

#ifndef NO_REALPATH

    /*

     * SunOS 4.1.4 reports overwriting a non-empty directory with a

     * directory as EINVAL instead of EEXIST (first rule out the correct

     * EINVAL result code for moving a directory into itself).  Must be

     * conditionally compiled because realpath() not defined on all systems.

     */

    if (errno == EINVAL && haveRealpath) {

	char srcPath[MAXPATHLEN], dstPath[MAXPATHLEN];

	DIR *dirPtr;

	Tcl_DirEntry *dirEntPtr;

	if ((Realpath((char *) src, srcPath) != NULL)	/* INTL: Native. */

		&& (Realpath((char *) dst, dstPath) != NULL) /* INTL: Native. */

		&& (strncmp(srcPath, dstPath, strlen(srcPath)) != 0)) {

	    dirPtr = opendir(dst);			/* INTL: Native. */

	    if (dirPtr != NULL) {

		while (1) {

		    dirEntPtr = TclOSreaddir(dirPtr); /* INTL: Native. */

		    if (dirEntPtr == NULL) {

			break;

		    }

		    if ((strcmp(dirEntPtr->d_name, ".") != 0) &&

			    (strcmp(dirEntPtr->d_name, "..") != 0)) {

			errno = EEXIST;

			closedir(dirPtr);

			return TCL_ERROR;

		    }

		}

		closedir(dirPtr);

	    }

	}

	errno = EINVAL;

    }

#endif	/* !NO_REALPATH */

    if (strcmp(src, "/") == 0) {

	/*

	 * Alpha reports renaming / as EBUSY and Linux reports it as EACCES,

	 * instead of EINVAL.

	 */

	errno = EINVAL;

    }

    /*

     * DEC Alpha OSF1 V3.0 returns EACCES when attempting to move a

     * file across filesystems and the parent directory of that file is

     * not writable.  Most other systems return EXDEV.  Does nothing to

     * correct this behavior.

     */

    return TCL_ERROR;

}

/*

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

 *

 * TclpObjCopyFile, DoCopyFile --

 *

 *      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 "".

 *

 * Side effects:

 *      This procedure will also copy symbolic links, block, and

 *      character devices, and fifos.  For symbolic links, the links 

 *      themselves will be copied and not what they point to.  For the

 *	other special file types, the directory entry will be copied and

 *	not the contents of the device that it refers to.

 *

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

 */

int 

TclpObjCopyFile(srcPathPtr, destPathPtr)

    Tcl_Obj *srcPathPtr;

    Tcl_Obj *destPathPtr;

{

    CONST char *src = Tcl_FSGetNativePath(srcPathPtr);

    Tcl_StatBuf srcStatBuf;

    if (TclOSlstat(src, &srcStatBuf) != 0) {		/* INTL: Native. */

	return TCL_ERROR;

    }

    return DoCopyFile(src, Tcl_FSGetNativePath(destPathPtr), &srcStatBuf);

}

static int

DoCopyFile(src, dst, statBufPtr)

    CONST char *src;	/* Pathname of file to be copied (native). */

    CONST char *dst;	/* Pathname of file to copy to (native). */

    CONST Tcl_StatBuf *statBufPtr;

			/* Used to determine filetype. */

{

    Tcl_StatBuf dstStatBuf;

    if (S_ISDIR(statBufPtr->st_mode)) {

	errno = EISDIR;

	return TCL_ERROR;

    }

    /*

     * symlink, and some of the other calls will fail if the target 

     * exists, so we remove it first

     */

    if (TclOSlstat(dst, &dstStatBuf) == 0) {		/* INTL: Native. */

	if (S_ISDIR(dstStatBuf.st_mode)) {

	    errno = EISDIR;

	    return TCL_ERROR;

	}

    }

    if (unlink(dst) != 0) {				/* INTL: Native. */

	if (errno != ENOENT) {

	    return TCL_ERROR;

	} 

    }

    switch ((int) (statBufPtr->st_mode & S_IFMT)) {

#ifndef DJGPP

        case S_IFLNK: {

	    char link[MAXPATHLEN];

	    int length;

	    length = readlink(src, link, sizeof(link)); /* INTL: Native. */

	    if (length == -1) {

		return TCL_ERROR;

	    }

	    link[length] = '\0';

	    if (symlink(link, dst) < 0) {		/* INTL: Native. */

		return TCL_ERROR;

	    }

#ifdef HAVE_COPYFILE

#ifdef WEAK_IMPORT_COPYFILE

	    if (copyfile != NULL)

#endif

	    copyfile(src, dst, NULL, COPYFILE_XATTR|COPYFILE_NOFOLLOW_SRC);

#endif

	    break;

	}

#endif

        case S_IFBLK:

        case S_IFCHR: {

#ifdef __SYMBIAN32__          

		// not supported by PIPS	    

		return TCL_ERROR;

#else

	    if (mknod(dst, statBufPtr->st_mode,		/* INTL: Native. */

		    statBufPtr->st_rdev) < 0) {

		return TCL_ERROR;

	    }

	    return CopyFileAtts(src, dst, statBufPtr);

#endif

	    }

        case S_IFIFO: {

	    if (mkfifo(dst, statBufPtr->st_mode) < 0) {	/* INTL: Native. */

		return TCL_ERROR;

	    }

	    return CopyFileAtts(src, dst, statBufPtr);

	}

        default: {

	    return CopyFile(src, dst, statBufPtr);

	}

    }

    return TCL_OK;

}

/*

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

 *

 * CopyFile - 

 *

 *      Helper function for TclpCopyFile.  Copies one regular file,

 *	using read() and write().

 *

 * Results:

 *	A standard Tcl result.

 *

 * Side effects:

 *      A file is copied.  Dst will be overwritten if it exists.

 *

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

 */

static int 

CopyFile(src, dst, statBufPtr) 

    CONST char *src;		/* Pathname of file to copy (native). */

    CONST char *dst;		/* Pathname of file to create/overwrite

				 * (native). */

    CONST Tcl_StatBuf *statBufPtr;

				/* Used to determine mode and blocksize. */

{

    int srcFd;

    int dstFd;

    unsigned blockSize;		/* Optimal I/O blocksize for filesystem */

    char *buffer;		/* Data buffer for copy */

    size_t nread;

    if ((srcFd = TclOSopen(src, O_RDONLY, 0)) < 0) {	/* INTL: Native. */

	return TCL_ERROR;

    }

    dstFd = TclOSopen(dst, O_CREAT|O_TRUNC|O_WRONLY,	/* INTL: Native. */

	    statBufPtr->st_mode);

    if (dstFd < 0) {

	close(srcFd); 

	return TCL_ERROR;

    }

#ifdef HAVE_ST_BLKSIZE

    blockSize = statBufPtr->st_blksize;

#else

#ifndef NO_FSTATFS

    {

	struct statfs fs;

	if (fstatfs(srcFd, &fs, sizeof(fs), 0) == 0) {

	    blockSize = fs.f_bsize;

	} else {

	    blockSize = 4096;

	}

    }

#else 

    blockSize = 4096;

#endif

#endif

    /* [SF Tcl Bug 1586470] Even if we HAVE_ST_BLKSIZE, there are

     * filesystems which report a bogus value for the blocksize.  An

     * example is the Andrew Filesystem (afs), reporting a blocksize

     * of 0. When detecting such a situation we now simply fall back

     * to a hardwired default size.

     */

    if (blockSize <= 0) {

        blockSize = 4096;

    }

    buffer = ckalloc(blockSize);

    while (1) {

	nread = read(srcFd, buffer, blockSize);

	if ((nread == (size_t)-1) || (nread == 0)) {

	    break;

	}

	if (write(dstFd, buffer, nread) != nread) {

	    nread = (size_t) -1;

	    break;

	}

    }

    ckfree(buffer);

    close(srcFd);

    if ((close(dstFd) != 0) || (nread == (size_t)-1)) {

	unlink(dst);					/* INTL: Native. */

	return TCL_ERROR;

    }

    if (CopyFileAtts(src, dst, statBufPtr) == TCL_ERROR) {

	/*

	 * The copy succeeded, but setting the permissions failed, so be in

	 * a consistent state, we remove the file that was created by the

	 * copy.

	 */

	unlink(dst);					/* INTL: Native. */

	return TCL_ERROR;

    }

    return TCL_OK;

}

/*

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

 *

 * TclpObjDeleteFile, 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 "".

 *

 * Side effects:

 *      The file is deleted, even if it is read-only.

 *

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

 */

int 

TclpObjDeleteFile(pathPtr)

    Tcl_Obj *pathPtr;

{

    return TclpDeleteFile(Tcl_FSGetNativePath(pathPtr));

}

int

TclpDeleteFile(path)

    CONST char *path;	/* Pathname of file to be removed (native). */

{

    if (unlink(path) != 0) {				/* INTL: Native. */

	return TCL_ERROR;

    }

    return TCL_OK;

}

/*

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

 *

 * TclpCreateDirectory, DoCreateDirectory --

 *

 *      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 with the current umask, except that

 *	permission for u+rwx will always be added.

 *

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

 */

int 

TclpObjCreateDirectory(pathPtr)

    Tcl_Obj *pathPtr;

{

    return DoCreateDirectory(Tcl_FSGetNativePath(pathPtr));

}

static int

DoCreateDirectory(path)

    CONST char *path;	/* Pathname of directory to create (native). */

{

    mode_t mode;

    mode = umask(0);

    umask(mode);

    /*

     * umask return value is actually the inverse of the permissions.

     */

    mode = (0777 & ~mode) | S_IRUSR | S_IWUSR | S_IXUSR;

    if (mkdir(path, mode) != 0) {			/* INTL: Native. */

	return TCL_ERROR;

    }

    return TCL_OK;

}

/*

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

 *

 * TclpObjCopyDirectory --

 *

 *      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 TclpObjCreateDirectory and 

 *	TclpObjCopyFile 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 

TclpObjCopyDirectory(srcPathPtr, destPathPtr, errorPtr)

    Tcl_Obj *srcPathPtr;

    Tcl_Obj *destPathPtr;

    Tcl_Obj **errorPtr;

{

    Tcl_DString ds;

    Tcl_DString srcString, dstString;

    int ret;

    Tcl_Obj *transPtr;

    transPtr = Tcl_FSGetTranslatedPath(NULL,srcPathPtr);

    Tcl_UtfToExternalDString(NULL, 

			     (transPtr != NULL ? Tcl_GetString(transPtr) : NULL), 

			     -1, &srcString);

    if (transPtr != NULL) {

	Tcl_DecrRefCount(transPtr);

    }

    transPtr = Tcl_FSGetTranslatedPath(NULL,destPathPtr);

    Tcl_UtfToExternalDString(NULL, 

			     (transPtr != NULL ? Tcl_GetString(transPtr) : NULL), 

			     -1, &dstString);

    if (transPtr != NULL) {

	Tcl_DecrRefCount(transPtr);

    }

    ret = TraverseUnixTree(TraversalCopy, &srcString, &dstString, &ds, 0);

    Tcl_DStringFree(&srcString);

    Tcl_DStringFree(&dstString);

    if (ret != TCL_OK) {

	*errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);

	Tcl_DStringFree(&ds);

	Tcl_IncrRefCount(*errorPtr);

    }

    return ret;

}

/*

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

 *

 * TclpRemoveDirectory, DoRemoveDirectory --

 *

 *	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 a root directory.

 *	ENOENT:	    path doesn't exist or is "".

 * 	ENOTDIR:    path is not a directory.

 *

 * Side effects:

 *	Directory removed.  If an error occurs, the error will be returned

 *	immediately, and remaining files will not be deleted.

 *

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

 */

int 

TclpObjRemoveDirectory(pathPtr, recursive, errorPtr)

    Tcl_Obj *pathPtr;

    int recursive;

    Tcl_Obj **errorPtr;

{

    Tcl_DString ds;

    Tcl_DString pathString;

    int ret;

    Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);

    Tcl_UtfToExternalDString(NULL, 

			     (transPtr != NULL ? Tcl_GetString(transPtr) : NULL), 

			     -1, &pathString);

    if (transPtr != NULL) {

	Tcl_DecrRefCount(transPtr);

    }

    ret = DoRemoveDirectory(&pathString, recursive, &ds);

    Tcl_DStringFree(&pathString);

    if (ret != TCL_OK) {

	*errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);

	Tcl_DStringFree(&ds);

	Tcl_IncrRefCount(*errorPtr);

    }

    return ret;

}

static int

DoRemoveDirectory(pathPtr, recursive, errorPtr)

    Tcl_DString *pathPtr;	/* Pathname of directory to be removed

				 * (native). */

    int recursive;		/* If non-zero, removes directories that

				 * are nonempty.  Otherwise, will only remove

				 * empty directories. */

    Tcl_DString *errorPtr;	/* If non-NULL, uninitialized or free

				 * DString filled with UTF-8 name of file

				 * causing error. */

{

    CONST char *path;

    mode_t oldPerm = 0;

    int result;

    path = Tcl_DStringValue(pathPtr);

#ifdef __SYMBIAN32__  

    TclPrint1(" == DoRemoveDirectory() - \"%S\".\n", path);

#endif

    if (recursive != 0) {

	/* We should try to change permissions so this can be deleted */

	Tcl_StatBuf statBuf;

	int newPerm;

	if (TclOSstat(path, &statBuf) == 0) {

	    oldPerm = (mode_t) (statBuf.st_mode & 0x00007FFF);

	}

	newPerm = oldPerm | (64+128+256);

	chmod(path, (mode_t) newPerm);

    }

    if (rmdir(path) == 0) {				/* INTL: Native. */

	return TCL_OK;

    }

    if (errno == ENOTEMPTY) {

	errno = EEXIST;

    }

    result = TCL_OK;

    if ((errno != EEXIST) || (recursive == 0)) {

	if (errorPtr != NULL) {

	    Tcl_ExternalToUtfDString(NULL, path, -1, errorPtr);

	}

	result = TCL_ERROR;

    }

    /*

     * The directory is nonempty, but the recursive flag has been

     * specified, so we recursively remove all the files in the directory.

     */

    if (result == TCL_OK) {

	result = TraverseUnixTree(TraversalDelete, pathPtr, NULL, errorPtr, 1);

    }

    if ((result != TCL_OK) && (recursive != 0)) {

        /* Try to restore permissions */

        chmod(path, oldPerm);

    }

    return result;

}

/*

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

 *

 * TraverseUnixTree --

 *

 *      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 TraverseUnixTree, 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 

TraverseUnixTree(traverseProc, sourcePtr, targetPtr, errorPtr, doRewind)

    TraversalProc *traverseProc;/* Function to call for every file and

				 * directory in source hierarchy. */

    Tcl_DString *sourcePtr;	/* Pathname of source directory to be

				 * traversed (native). */

    Tcl_DString *targetPtr;	/* Pathname of directory to traverse in

				 * parallel with source directory (native). */

    Tcl_DString *errorPtr;	/* If non-NULL, uninitialized or free

				 * DString filled with UTF-8 name of file

				 * causing error. */

    int doRewind;		/* Flag indicating that to ensure complete

    				 * traversal of source hierarchy, the readdir

    				 * loop should be rewound whenever

    				 * traverseProc has returned TCL_OK; this is

    				 * required when traverseProc modifies the

    				 * source hierarchy, e.g. by deleting files. */

{

    Tcl_StatBuf statBuf;

    CONST char *source, *errfile;

    int result, sourceLen;

    int targetLen;

#ifndef HAVE_FTS

    int numProcessed = 0;

    Tcl_DirEntry *dirEntPtr;

    DIR *dirPtr;

#else

    CONST char *paths[2] = {NULL, NULL};

    FTS *fts = NULL;

    FTSENT *ent;

#endif

    errfile = NULL;

    result = TCL_OK;

    targetLen = 0;		/* lint. */

    source = Tcl_DStringValue(sourcePtr);

    if (TclOSlstat(source, &statBuf) != 0) {		/* INTL: Native. */

	errfile = source;

	goto end;

    }

    if (!S_ISDIR(statBuf.st_mode)) {

	/*

	 * Process the regular file

	 */

	return (*traverseProc)(sourcePtr, targetPtr, &statBuf, DOTREE_F,

		errorPtr);

    }

#ifndef HAVE_FTS

    dirPtr = opendir(source);				/* INTL: Native. */

    if (dirPtr == NULL) {

	/* 

	 * Can't read directory

	 */

	errfile = source;

	goto end;

    }

    result = (*traverseProc)(sourcePtr, targetPtr, &statBuf, DOTREE_PRED,

	    errorPtr);

    if (result != TCL_OK) {

	closedir(dirPtr);

	return result;

    }

    Tcl_DStringAppend(sourcePtr, "/", 1);

    sourceLen = Tcl_DStringLength(sourcePtr);

    if (targetPtr != NULL) {

	Tcl_DStringAppend(targetPtr, "/", 1);

	targetLen = Tcl_DStringLength(targetPtr);

    }

    while ((dirEntPtr = TclOSreaddir(dirPtr)) != NULL) { /* INTL: Native. */

	if ((dirEntPtr->d_name[0] == '.')

		&& ((dirEntPtr->d_name[1] == '\0')

			|| (strcmp(dirEntPtr->d_name, "..") == 0))) {

	    continue;

	}

	/*

	 * Append name after slash, and recurse on the file.

	 */

	Tcl_DStringAppend(sourcePtr, dirEntPtr->d_name, -1);

	if (targetPtr != NULL) {

	    Tcl_DStringAppend(targetPtr, dirEntPtr->d_name, -1);

	}

	result = TraverseUnixTree(traverseProc, sourcePtr, targetPtr,

		errorPtr, doRewind);

	if (result != TCL_OK) {

	    break;

	} else {

	    numProcessed++;

	}

	/*

	 * Remove name after slash.

	 */

	Tcl_DStringSetLength(sourcePtr, sourceLen);

	if (targetPtr != NULL) {

	    Tcl_DStringSetLength(targetPtr, targetLen);

	}

	if (doRewind && (numProcessed > MAX_READDIR_UNLINK_THRESHOLD)) {

	    /*

	     * Call rewinddir if we've called unlink or rmdir so many times

	     * (since the opendir or the previous rewinddir), to avoid

	     * a NULL-return that may a symptom of a buggy readdir.

	     */

	    rewinddir(dirPtr);

	    numProcessed = 0;

	}

    }

    closedir(dirPtr);