sl@0: /* sl@0: * tclUnixFCmd.c sl@0: * sl@0: * This file implements the unix specific portion of file manipulation sl@0: * subcommands of the "file" command. All filename arguments should sl@0: * already be translated to native format. sl@0: * sl@0: * Copyright (c) 1996-1998 Sun Microsystems, Inc. sl@0: * Portions Copyright (c) 2007-2008 Nokia Corporation and/or its subsidiaries. All rights reserved. sl@0: * sl@0: * See the file "license.terms" for information on usage and redistribution sl@0: * of this file, and for a DISCLAIMER OF ALL WARRANTIES. sl@0: * sl@0: * RCS: @(#) $Id: tclUnixFCmd.c,v 1.28.2.15 2007/04/29 02:19:51 das Exp $ sl@0: * sl@0: * Portions of this code were derived from NetBSD source code which has sl@0: * the following copyright notice: sl@0: * sl@0: * Copyright (c) 1988, 1993, 1994 sl@0: * The Regents of the University of California. All rights reserved. sl@0: * sl@0: * Redistribution and use in source and binary forms, with or without sl@0: * modification, are permitted provided that the following conditions sl@0: * are met: sl@0: * 1. Redistributions of source code must retain the above copyright sl@0: * notice, this list of conditions and the following disclaimer. sl@0: * 2. Redistributions in binary form must reproduce the above copyright sl@0: * notice, this list of conditions and the following disclaimer in the sl@0: * documentation and/or other materials provided with the distribution. sl@0: * 3. All advertising materials mentioning features or use of this software sl@0: * must display the following acknowledgement: sl@0: * This product includes software developed by the University of sl@0: * California, Berkeley and its contributors. sl@0: * 4. Neither the name of the University nor the names of its contributors sl@0: * may be used to endorse or promote products derived from this software sl@0: * without specific prior written permission. sl@0: * sl@0: * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND sl@0: * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE sl@0: * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE sl@0: * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE sl@0: * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL sl@0: * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS sl@0: * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) sl@0: * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT sl@0: * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY sl@0: * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF sl@0: * SUCH DAMAGE. sl@0: */ sl@0: sl@0: #include "tclInt.h" sl@0: #include "tclPort.h" sl@0: #include sl@0: #include sl@0: #ifndef HAVE_ST_BLKSIZE sl@0: #ifndef NO_FSTATFS sl@0: #include sl@0: #endif sl@0: #endif sl@0: #ifdef HAVE_FTS sl@0: #include sl@0: #endif sl@0: sl@0: #ifdef __SYMBIAN32__ sl@0: #include "convertPathSlashes.h" sl@0: void TclPrint1(const char* aFmt, const char* aStr); sl@0: #endif sl@0: /* sl@0: * The following constants specify the type of callback when sl@0: * TraverseUnixTree() calls the traverseProc() sl@0: */ sl@0: sl@0: #define DOTREE_PRED 1 /* pre-order directory */ sl@0: #define DOTREE_POSTD 2 /* post-order directory */ sl@0: #define DOTREE_F 3 /* regular file */ sl@0: sl@0: /* sl@0: * Callbacks for file attributes code. sl@0: */ sl@0: sl@0: static int GetGroupAttribute _ANSI_ARGS_((Tcl_Interp *interp, sl@0: int objIndex, Tcl_Obj *fileName, sl@0: Tcl_Obj **attributePtrPtr)); sl@0: static int GetOwnerAttribute _ANSI_ARGS_((Tcl_Interp *interp, sl@0: int objIndex, Tcl_Obj *fileName, sl@0: Tcl_Obj **attributePtrPtr)); sl@0: static int GetPermissionsAttribute _ANSI_ARGS_(( sl@0: Tcl_Interp *interp, int objIndex, sl@0: Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr)); sl@0: static int SetGroupAttribute _ANSI_ARGS_((Tcl_Interp *interp, sl@0: int objIndex, Tcl_Obj *fileName, sl@0: Tcl_Obj *attributePtr)); sl@0: static int SetOwnerAttribute _ANSI_ARGS_((Tcl_Interp *interp, sl@0: int objIndex, Tcl_Obj *fileName, sl@0: Tcl_Obj *attributePtr)); sl@0: static int SetPermissionsAttribute _ANSI_ARGS_(( sl@0: Tcl_Interp *interp, int objIndex, sl@0: Tcl_Obj *fileName, Tcl_Obj *attributePtr)); sl@0: static int GetModeFromPermString _ANSI_ARGS_(( sl@0: Tcl_Interp *interp, char *modeStringPtr, sl@0: mode_t *modePtr)); sl@0: sl@0: /* sl@0: * Prototype for the TraverseUnixTree callback function. sl@0: */ sl@0: sl@0: typedef int (TraversalProc) _ANSI_ARGS_((Tcl_DString *srcPtr, sl@0: Tcl_DString *dstPtr, CONST Tcl_StatBuf *statBufPtr, int type, sl@0: Tcl_DString *errorPtr)); sl@0: sl@0: /* sl@0: * Constants and variables necessary for file attributes subcommand. sl@0: */ sl@0: sl@0: enum { sl@0: UNIX_GROUP_ATTRIBUTE, sl@0: UNIX_OWNER_ATTRIBUTE, sl@0: UNIX_PERMISSIONS_ATTRIBUTE sl@0: }; sl@0: sl@0: CONST char *tclpFileAttrStrings[] = { sl@0: "-group", sl@0: "-owner", sl@0: "-permissions", sl@0: (char *) NULL sl@0: }; sl@0: sl@0: CONST TclFileAttrProcs tclpFileAttrProcs[] = { sl@0: {GetGroupAttribute, SetGroupAttribute}, sl@0: {GetOwnerAttribute, SetOwnerAttribute}, sl@0: {GetPermissionsAttribute, SetPermissionsAttribute} sl@0: }; sl@0: sl@0: /* sl@0: * This is the maximum number of consecutive readdir/unlink calls that can be sl@0: * made (with no intervening rewinddir or closedir/opendir) before triggering sl@0: * a bug that makes readdir return NULL even though some directory entries sl@0: * have not been processed. The bug afflicts SunOS's readdir when applied to sl@0: * ufs file systems and Darwin 6.5's (and OSX v.10.3.8's) HFS+. JH found the sl@0: * Darwin readdir to reset at 147, so 130 is chosen to be conservative. We sl@0: * can't do a general rewind on failure as NFS can create special files that sl@0: * recreate themselves when you try and delete them. 8.4.8 added a solution sl@0: * that was affected by a single such NFS file, this solution should not be sl@0: * affected by less than THRESHOLD such files. [Bug 1034337] sl@0: */ sl@0: sl@0: #define MAX_READDIR_UNLINK_THRESHOLD 130 sl@0: sl@0: /* sl@0: * Declarations for local procedures defined in this file: sl@0: */ sl@0: sl@0: static int CopyFile _ANSI_ARGS_((CONST char *src, sl@0: CONST char *dst, CONST Tcl_StatBuf *statBufPtr)); sl@0: static int CopyFileAtts _ANSI_ARGS_((CONST char *src, sl@0: CONST char *dst, CONST Tcl_StatBuf *statBufPtr)); sl@0: static int DoCopyFile _ANSI_ARGS_((CONST char *srcPtr, sl@0: CONST char *dstPtr, CONST Tcl_StatBuf *statBufPtr)); sl@0: static int DoCreateDirectory _ANSI_ARGS_((CONST char *pathPtr)); sl@0: static int DoRemoveDirectory _ANSI_ARGS_((Tcl_DString *pathPtr, sl@0: int recursive, Tcl_DString *errorPtr)); sl@0: static int DoRenameFile _ANSI_ARGS_((CONST char *src, sl@0: CONST char *dst)); sl@0: static int TraversalCopy _ANSI_ARGS_((Tcl_DString *srcPtr, sl@0: Tcl_DString *dstPtr, CONST Tcl_StatBuf *statBufPtr, sl@0: int type, Tcl_DString *errorPtr)); sl@0: static int TraversalDelete _ANSI_ARGS_((Tcl_DString *srcPtr, sl@0: Tcl_DString *dstPtr, CONST Tcl_StatBuf *statBufPtr, sl@0: int type, Tcl_DString *errorPtr)); sl@0: static int TraverseUnixTree _ANSI_ARGS_(( sl@0: TraversalProc *traversalProc, sl@0: Tcl_DString *sourcePtr, Tcl_DString *destPtr, sl@0: Tcl_DString *errorPtr, int doRewind)); sl@0: sl@0: #ifdef PURIFY sl@0: /* sl@0: * realpath and purify don't mix happily. It has been noted that realpath sl@0: * should not be used with purify because of bogus warnings, but just sl@0: * memset'ing the resolved path will squelch those. This assumes we are sl@0: * passing the standard MAXPATHLEN size resolved arg. sl@0: */ sl@0: static char * Realpath _ANSI_ARGS_((CONST char *path, sl@0: char *resolved)); sl@0: sl@0: char * sl@0: Realpath(path, resolved) sl@0: CONST char *path; sl@0: char *resolved; sl@0: { sl@0: memset(resolved, 0, MAXPATHLEN); sl@0: return realpath(path, resolved); sl@0: } sl@0: #else sl@0: #define Realpath realpath sl@0: #endif sl@0: sl@0: #ifndef NO_REALPATH sl@0: #if defined(__APPLE__) && defined(TCL_THREADS) && \ sl@0: defined(MAC_OS_X_VERSION_MIN_REQUIRED) && \ sl@0: MAC_OS_X_VERSION_MIN_REQUIRED < 1030 sl@0: /* sl@0: * prior to Darwin 7, realpath is not threadsafe, c.f. bug 711232; sl@0: * if we might potentially be running on pre-10.3 OSX, sl@0: * check Darwin release at runtime before using realpath. sl@0: */ sl@0: extern long tclMacOSXDarwinRelease; sl@0: #define haveRealpath (tclMacOSXDarwinRelease >= 7) sl@0: #else sl@0: #define haveRealpath 1 sl@0: #endif sl@0: #endif /* NO_REALPATH */ sl@0: sl@0: #ifdef HAVE_FTS sl@0: #ifdef HAVE_STRUCT_STAT64 sl@0: /* fts doesn't do stat64 */ sl@0: #define noFtsStat 1 sl@0: #elif defined(__APPLE__) && defined(__LP64__) && \ sl@0: defined(MAC_OS_X_VERSION_MIN_REQUIRED) && \ sl@0: MAC_OS_X_VERSION_MIN_REQUIRED < 1050 sl@0: /* sl@0: * prior to Darwin 9, 64bit fts_open() without FTS_NOSTAT may crash (due to a sl@0: * 64bit-unsafe ALIGN macro); if we could be running on pre-10.5 OSX, check sl@0: * Darwin release at runtime and do a separate stat() if necessary. sl@0: */ sl@0: extern long tclMacOSXDarwinRelease; sl@0: #define noFtsStat (tclMacOSXDarwinRelease < 9) sl@0: #else sl@0: #define noFtsStat 0 sl@0: #endif sl@0: #endif /* HAVE_FTS */ sl@0: sl@0: sl@0: /* sl@0: *--------------------------------------------------------------------------- sl@0: * sl@0: * TclpObjRenameFile, DoRenameFile -- sl@0: * sl@0: * Changes the name of an existing file or directory, from src to dst. sl@0: * If src and dst refer to the same file or directory, does nothing sl@0: * and returns success. Otherwise if dst already exists, it will be sl@0: * deleted and replaced by src subject to the following conditions: sl@0: * If src is a directory, dst may be an empty directory. sl@0: * If src is a file, dst may be a file. sl@0: * In any other situation where dst already exists, the rename will sl@0: * fail. sl@0: * sl@0: * Results: sl@0: * If the directory was successfully created, returns TCL_OK. sl@0: * Otherwise the return value is TCL_ERROR and errno is set to sl@0: * indicate the error. Some possible values for errno are: sl@0: * sl@0: * EACCES: src or dst parent directory can't be read and/or written. sl@0: * EEXIST: dst is a non-empty directory. sl@0: * EINVAL: src is a root directory or dst is a subdirectory of src. sl@0: * EISDIR: dst is a directory, but src is not. sl@0: * ENOENT: src doesn't exist, or src or dst is "". sl@0: * ENOTDIR: src is a directory, but dst is not. sl@0: * EXDEV: src and dst are on different filesystems. sl@0: * sl@0: * Side effects: sl@0: * The implementation of rename may allow cross-filesystem renames, sl@0: * but the caller should be prepared to emulate it with copy and sl@0: * delete if errno is EXDEV. sl@0: * sl@0: *--------------------------------------------------------------------------- sl@0: */ sl@0: sl@0: int sl@0: TclpObjRenameFile(srcPathPtr, destPathPtr) sl@0: Tcl_Obj *srcPathPtr; sl@0: Tcl_Obj *destPathPtr; sl@0: { sl@0: return DoRenameFile(Tcl_FSGetNativePath(srcPathPtr), sl@0: Tcl_FSGetNativePath(destPathPtr)); sl@0: } sl@0: sl@0: static int sl@0: DoRenameFile(src, dst) sl@0: CONST char *src; /* Pathname of file or dir to be renamed sl@0: * (native). */ sl@0: CONST char *dst; /* New pathname of file or directory sl@0: * (native). */ sl@0: { sl@0: if (rename(src, dst) == 0) { /* INTL: Native. */ sl@0: return TCL_OK; sl@0: } sl@0: if (errno == ENOTEMPTY) { sl@0: errno = EEXIST; sl@0: } sl@0: sl@0: /* sl@0: * IRIX returns EIO when you attept to move a directory into sl@0: * itself. We just map EIO to EINVAL get the right message on SGI. sl@0: * Most platforms don't return EIO except in really strange cases. sl@0: */ sl@0: sl@0: if (errno == EIO) { sl@0: errno = EINVAL; sl@0: } sl@0: sl@0: #ifndef NO_REALPATH sl@0: /* sl@0: * SunOS 4.1.4 reports overwriting a non-empty directory with a sl@0: * directory as EINVAL instead of EEXIST (first rule out the correct sl@0: * EINVAL result code for moving a directory into itself). Must be sl@0: * conditionally compiled because realpath() not defined on all systems. sl@0: */ sl@0: sl@0: if (errno == EINVAL && haveRealpath) { sl@0: char srcPath[MAXPATHLEN], dstPath[MAXPATHLEN]; sl@0: DIR *dirPtr; sl@0: Tcl_DirEntry *dirEntPtr; sl@0: sl@0: if ((Realpath((char *) src, srcPath) != NULL) /* INTL: Native. */ sl@0: && (Realpath((char *) dst, dstPath) != NULL) /* INTL: Native. */ sl@0: && (strncmp(srcPath, dstPath, strlen(srcPath)) != 0)) { sl@0: dirPtr = opendir(dst); /* INTL: Native. */ sl@0: if (dirPtr != NULL) { sl@0: while (1) { sl@0: dirEntPtr = TclOSreaddir(dirPtr); /* INTL: Native. */ sl@0: if (dirEntPtr == NULL) { sl@0: break; sl@0: } sl@0: if ((strcmp(dirEntPtr->d_name, ".") != 0) && sl@0: (strcmp(dirEntPtr->d_name, "..") != 0)) { sl@0: errno = EEXIST; sl@0: closedir(dirPtr); sl@0: return TCL_ERROR; sl@0: } sl@0: } sl@0: closedir(dirPtr); sl@0: } sl@0: } sl@0: errno = EINVAL; sl@0: } sl@0: #endif /* !NO_REALPATH */ sl@0: sl@0: if (strcmp(src, "/") == 0) { sl@0: /* sl@0: * Alpha reports renaming / as EBUSY and Linux reports it as EACCES, sl@0: * instead of EINVAL. sl@0: */ sl@0: sl@0: errno = EINVAL; sl@0: } sl@0: sl@0: /* sl@0: * DEC Alpha OSF1 V3.0 returns EACCES when attempting to move a sl@0: * file across filesystems and the parent directory of that file is sl@0: * not writable. Most other systems return EXDEV. Does nothing to sl@0: * correct this behavior. sl@0: */ sl@0: sl@0: return TCL_ERROR; sl@0: } sl@0: sl@0: /* sl@0: *--------------------------------------------------------------------------- sl@0: * sl@0: * TclpObjCopyFile, DoCopyFile -- sl@0: * sl@0: * Copy a single file (not a directory). If dst already exists and sl@0: * is not a directory, it is removed. sl@0: * sl@0: * Results: sl@0: * If the file was successfully copied, returns TCL_OK. Otherwise sl@0: * the return value is TCL_ERROR and errno is set to indicate the sl@0: * error. Some possible values for errno are: sl@0: * sl@0: * EACCES: src or dst parent directory can't be read and/or written. sl@0: * EISDIR: src or dst is a directory. sl@0: * ENOENT: src doesn't exist. src or dst is "". sl@0: * sl@0: * Side effects: sl@0: * This procedure will also copy symbolic links, block, and sl@0: * character devices, and fifos. For symbolic links, the links sl@0: * themselves will be copied and not what they point to. For the sl@0: * other special file types, the directory entry will be copied and sl@0: * not the contents of the device that it refers to. sl@0: * sl@0: *--------------------------------------------------------------------------- sl@0: */ sl@0: sl@0: int sl@0: TclpObjCopyFile(srcPathPtr, destPathPtr) sl@0: Tcl_Obj *srcPathPtr; sl@0: Tcl_Obj *destPathPtr; sl@0: { sl@0: CONST char *src = Tcl_FSGetNativePath(srcPathPtr); sl@0: Tcl_StatBuf srcStatBuf; sl@0: sl@0: if (TclOSlstat(src, &srcStatBuf) != 0) { /* INTL: Native. */ sl@0: return TCL_ERROR; sl@0: } sl@0: sl@0: return DoCopyFile(src, Tcl_FSGetNativePath(destPathPtr), &srcStatBuf); sl@0: } sl@0: sl@0: static int sl@0: DoCopyFile(src, dst, statBufPtr) sl@0: CONST char *src; /* Pathname of file to be copied (native). */ sl@0: CONST char *dst; /* Pathname of file to copy to (native). */ sl@0: CONST Tcl_StatBuf *statBufPtr; sl@0: /* Used to determine filetype. */ sl@0: { sl@0: Tcl_StatBuf dstStatBuf; sl@0: sl@0: if (S_ISDIR(statBufPtr->st_mode)) { sl@0: errno = EISDIR; sl@0: return TCL_ERROR; sl@0: } sl@0: sl@0: /* sl@0: * symlink, and some of the other calls will fail if the target sl@0: * exists, so we remove it first sl@0: */ sl@0: sl@0: if (TclOSlstat(dst, &dstStatBuf) == 0) { /* INTL: Native. */ sl@0: if (S_ISDIR(dstStatBuf.st_mode)) { sl@0: errno = EISDIR; sl@0: return TCL_ERROR; sl@0: } sl@0: } sl@0: if (unlink(dst) != 0) { /* INTL: Native. */ sl@0: if (errno != ENOENT) { sl@0: return TCL_ERROR; sl@0: } sl@0: } sl@0: sl@0: switch ((int) (statBufPtr->st_mode & S_IFMT)) { sl@0: #ifndef DJGPP sl@0: case S_IFLNK: { sl@0: char link[MAXPATHLEN]; sl@0: int length; sl@0: sl@0: length = readlink(src, link, sizeof(link)); /* INTL: Native. */ sl@0: if (length == -1) { sl@0: return TCL_ERROR; sl@0: } sl@0: link[length] = '\0'; sl@0: if (symlink(link, dst) < 0) { /* INTL: Native. */ sl@0: return TCL_ERROR; sl@0: } sl@0: #ifdef HAVE_COPYFILE sl@0: #ifdef WEAK_IMPORT_COPYFILE sl@0: if (copyfile != NULL) sl@0: #endif sl@0: copyfile(src, dst, NULL, COPYFILE_XATTR|COPYFILE_NOFOLLOW_SRC); sl@0: #endif sl@0: break; sl@0: } sl@0: #endif sl@0: case S_IFBLK: sl@0: case S_IFCHR: { sl@0: #ifdef __SYMBIAN32__ sl@0: // not supported by PIPS sl@0: return TCL_ERROR; sl@0: #else sl@0: if (mknod(dst, statBufPtr->st_mode, /* INTL: Native. */ sl@0: statBufPtr->st_rdev) < 0) { sl@0: return TCL_ERROR; sl@0: } sl@0: return CopyFileAtts(src, dst, statBufPtr); sl@0: #endif sl@0: } sl@0: case S_IFIFO: { sl@0: if (mkfifo(dst, statBufPtr->st_mode) < 0) { /* INTL: Native. */ sl@0: return TCL_ERROR; sl@0: } sl@0: return CopyFileAtts(src, dst, statBufPtr); sl@0: } sl@0: default: { sl@0: return CopyFile(src, dst, statBufPtr); sl@0: } sl@0: } sl@0: return TCL_OK; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * CopyFile - sl@0: * sl@0: * Helper function for TclpCopyFile. Copies one regular file, sl@0: * using read() and write(). sl@0: * sl@0: * Results: sl@0: * A standard Tcl result. sl@0: * sl@0: * Side effects: sl@0: * A file is copied. Dst will be overwritten if it exists. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static int sl@0: CopyFile(src, dst, statBufPtr) sl@0: CONST char *src; /* Pathname of file to copy (native). */ sl@0: CONST char *dst; /* Pathname of file to create/overwrite sl@0: * (native). */ sl@0: CONST Tcl_StatBuf *statBufPtr; sl@0: /* Used to determine mode and blocksize. */ sl@0: { sl@0: int srcFd; sl@0: int dstFd; sl@0: unsigned blockSize; /* Optimal I/O blocksize for filesystem */ sl@0: char *buffer; /* Data buffer for copy */ sl@0: size_t nread; sl@0: sl@0: if ((srcFd = TclOSopen(src, O_RDONLY, 0)) < 0) { /* INTL: Native. */ sl@0: return TCL_ERROR; sl@0: } sl@0: sl@0: dstFd = TclOSopen(dst, O_CREAT|O_TRUNC|O_WRONLY, /* INTL: Native. */ sl@0: statBufPtr->st_mode); sl@0: if (dstFd < 0) { sl@0: close(srcFd); sl@0: return TCL_ERROR; sl@0: } sl@0: sl@0: #ifdef HAVE_ST_BLKSIZE sl@0: blockSize = statBufPtr->st_blksize; sl@0: #else sl@0: #ifndef NO_FSTATFS sl@0: { sl@0: struct statfs fs; sl@0: if (fstatfs(srcFd, &fs, sizeof(fs), 0) == 0) { sl@0: blockSize = fs.f_bsize; sl@0: } else { sl@0: blockSize = 4096; sl@0: } sl@0: } sl@0: #else sl@0: blockSize = 4096; sl@0: #endif sl@0: #endif sl@0: sl@0: /* [SF Tcl Bug 1586470] Even if we HAVE_ST_BLKSIZE, there are sl@0: * filesystems which report a bogus value for the blocksize. An sl@0: * example is the Andrew Filesystem (afs), reporting a blocksize sl@0: * of 0. When detecting such a situation we now simply fall back sl@0: * to a hardwired default size. sl@0: */ sl@0: sl@0: if (blockSize <= 0) { sl@0: blockSize = 4096; sl@0: } sl@0: buffer = ckalloc(blockSize); sl@0: while (1) { sl@0: nread = read(srcFd, buffer, blockSize); sl@0: if ((nread == (size_t)-1) || (nread == 0)) { sl@0: break; sl@0: } sl@0: if (write(dstFd, buffer, nread) != nread) { sl@0: nread = (size_t) -1; sl@0: break; sl@0: } sl@0: } sl@0: sl@0: ckfree(buffer); sl@0: close(srcFd); sl@0: if ((close(dstFd) != 0) || (nread == (size_t)-1)) { sl@0: unlink(dst); /* INTL: Native. */ sl@0: return TCL_ERROR; sl@0: } sl@0: if (CopyFileAtts(src, dst, statBufPtr) == TCL_ERROR) { sl@0: /* sl@0: * The copy succeeded, but setting the permissions failed, so be in sl@0: * a consistent state, we remove the file that was created by the sl@0: * copy. sl@0: */ sl@0: sl@0: unlink(dst); /* INTL: Native. */ sl@0: return TCL_ERROR; sl@0: } sl@0: return TCL_OK; sl@0: } sl@0: sl@0: /* sl@0: *--------------------------------------------------------------------------- sl@0: * sl@0: * TclpObjDeleteFile, TclpDeleteFile -- sl@0: * sl@0: * Removes a single file (not a directory). sl@0: * sl@0: * Results: sl@0: * If the file was successfully deleted, returns TCL_OK. Otherwise sl@0: * the return value is TCL_ERROR and errno is set to indicate the sl@0: * error. Some possible values for errno are: sl@0: * sl@0: * EACCES: a parent directory can't be read and/or written. sl@0: * EISDIR: path is a directory. sl@0: * ENOENT: path doesn't exist or is "". sl@0: * sl@0: * Side effects: sl@0: * The file is deleted, even if it is read-only. sl@0: * sl@0: *--------------------------------------------------------------------------- sl@0: */ sl@0: sl@0: int sl@0: TclpObjDeleteFile(pathPtr) sl@0: Tcl_Obj *pathPtr; sl@0: { sl@0: return TclpDeleteFile(Tcl_FSGetNativePath(pathPtr)); sl@0: } sl@0: sl@0: int sl@0: TclpDeleteFile(path) sl@0: CONST char *path; /* Pathname of file to be removed (native). */ sl@0: { sl@0: if (unlink(path) != 0) { /* INTL: Native. */ sl@0: return TCL_ERROR; sl@0: } sl@0: return TCL_OK; sl@0: } sl@0: sl@0: /* sl@0: *--------------------------------------------------------------------------- sl@0: * sl@0: * TclpCreateDirectory, DoCreateDirectory -- sl@0: * sl@0: * Creates the specified directory. All parent directories of the sl@0: * specified directory must already exist. The directory is sl@0: * automatically created with permissions so that user can access sl@0: * the new directory and create new files or subdirectories in it. sl@0: * sl@0: * Results: sl@0: * If the directory was successfully created, returns TCL_OK. sl@0: * Otherwise the return value is TCL_ERROR and errno is set to sl@0: * indicate the error. Some possible values for errno are: sl@0: * sl@0: * EACCES: a parent directory can't be read and/or written. sl@0: * EEXIST: path already exists. sl@0: * ENOENT: a parent directory doesn't exist. sl@0: * sl@0: * Side effects: sl@0: * A directory is created with the current umask, except that sl@0: * permission for u+rwx will always be added. sl@0: * sl@0: *--------------------------------------------------------------------------- sl@0: */ sl@0: sl@0: int sl@0: TclpObjCreateDirectory(pathPtr) sl@0: Tcl_Obj *pathPtr; sl@0: { sl@0: return DoCreateDirectory(Tcl_FSGetNativePath(pathPtr)); sl@0: } sl@0: sl@0: static int sl@0: DoCreateDirectory(path) sl@0: CONST char *path; /* Pathname of directory to create (native). */ sl@0: { sl@0: mode_t mode; sl@0: sl@0: mode = umask(0); sl@0: umask(mode); sl@0: sl@0: /* sl@0: * umask return value is actually the inverse of the permissions. sl@0: */ sl@0: sl@0: mode = (0777 & ~mode) | S_IRUSR | S_IWUSR | S_IXUSR; sl@0: sl@0: if (mkdir(path, mode) != 0) { /* INTL: Native. */ sl@0: return TCL_ERROR; sl@0: } sl@0: return TCL_OK; sl@0: } sl@0: sl@0: /* sl@0: *--------------------------------------------------------------------------- sl@0: * sl@0: * TclpObjCopyDirectory -- sl@0: * sl@0: * Recursively copies a directory. The target directory dst must sl@0: * not already exist. Note that this function does not merge two sl@0: * directory hierarchies, even if the target directory is an an sl@0: * empty directory. sl@0: * sl@0: * Results: sl@0: * If the directory was successfully copied, returns TCL_OK. sl@0: * Otherwise the return value is TCL_ERROR, errno is set to indicate sl@0: * the error, and the pathname of the file that caused the error sl@0: * is stored in errorPtr. See TclpObjCreateDirectory and sl@0: * TclpObjCopyFile for a description of possible values for errno. sl@0: * sl@0: * Side effects: sl@0: * An exact copy of the directory hierarchy src will be created sl@0: * with the name dst. If an error occurs, the error will sl@0: * be returned immediately, and remaining files will not be sl@0: * processed. sl@0: * sl@0: *--------------------------------------------------------------------------- sl@0: */ sl@0: sl@0: int sl@0: TclpObjCopyDirectory(srcPathPtr, destPathPtr, errorPtr) sl@0: Tcl_Obj *srcPathPtr; sl@0: Tcl_Obj *destPathPtr; sl@0: Tcl_Obj **errorPtr; sl@0: { sl@0: Tcl_DString ds; sl@0: Tcl_DString srcString, dstString; sl@0: int ret; sl@0: Tcl_Obj *transPtr; sl@0: sl@0: transPtr = Tcl_FSGetTranslatedPath(NULL,srcPathPtr); sl@0: Tcl_UtfToExternalDString(NULL, sl@0: (transPtr != NULL ? Tcl_GetString(transPtr) : NULL), sl@0: -1, &srcString); sl@0: if (transPtr != NULL) { sl@0: Tcl_DecrRefCount(transPtr); sl@0: } sl@0: transPtr = Tcl_FSGetTranslatedPath(NULL,destPathPtr); sl@0: Tcl_UtfToExternalDString(NULL, sl@0: (transPtr != NULL ? Tcl_GetString(transPtr) : NULL), sl@0: -1, &dstString); sl@0: if (transPtr != NULL) { sl@0: Tcl_DecrRefCount(transPtr); sl@0: } sl@0: sl@0: ret = TraverseUnixTree(TraversalCopy, &srcString, &dstString, &ds, 0); sl@0: sl@0: Tcl_DStringFree(&srcString); sl@0: Tcl_DStringFree(&dstString); sl@0: sl@0: if (ret != TCL_OK) { sl@0: *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); sl@0: Tcl_DStringFree(&ds); sl@0: Tcl_IncrRefCount(*errorPtr); sl@0: } sl@0: return ret; sl@0: } sl@0: sl@0: sl@0: /* sl@0: *--------------------------------------------------------------------------- sl@0: * sl@0: * TclpRemoveDirectory, DoRemoveDirectory -- sl@0: * sl@0: * Removes directory (and its contents, if the recursive flag is set). sl@0: * sl@0: * Results: sl@0: * If the directory was successfully removed, returns TCL_OK. sl@0: * Otherwise the return value is TCL_ERROR, errno is set to indicate sl@0: * the error, and the pathname of the file that caused the error sl@0: * is stored in errorPtr. Some possible values for errno are: sl@0: * sl@0: * EACCES: path directory can't be read and/or written. sl@0: * EEXIST: path is a non-empty directory. sl@0: * EINVAL: path is a root directory. sl@0: * ENOENT: path doesn't exist or is "". sl@0: * ENOTDIR: path is not a directory. sl@0: * sl@0: * Side effects: sl@0: * Directory removed. If an error occurs, the error will be returned sl@0: * immediately, and remaining files will not be deleted. sl@0: * sl@0: *--------------------------------------------------------------------------- sl@0: */ sl@0: sl@0: int sl@0: TclpObjRemoveDirectory(pathPtr, recursive, errorPtr) sl@0: Tcl_Obj *pathPtr; sl@0: int recursive; sl@0: Tcl_Obj **errorPtr; sl@0: { sl@0: Tcl_DString ds; sl@0: Tcl_DString pathString; sl@0: int ret; sl@0: Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr); sl@0: sl@0: Tcl_UtfToExternalDString(NULL, sl@0: (transPtr != NULL ? Tcl_GetString(transPtr) : NULL), sl@0: -1, &pathString); sl@0: if (transPtr != NULL) { sl@0: Tcl_DecrRefCount(transPtr); sl@0: } sl@0: ret = DoRemoveDirectory(&pathString, recursive, &ds); sl@0: Tcl_DStringFree(&pathString); sl@0: sl@0: if (ret != TCL_OK) { sl@0: *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); sl@0: Tcl_DStringFree(&ds); sl@0: Tcl_IncrRefCount(*errorPtr); sl@0: } sl@0: return ret; sl@0: } sl@0: sl@0: static int sl@0: DoRemoveDirectory(pathPtr, recursive, errorPtr) sl@0: Tcl_DString *pathPtr; /* Pathname of directory to be removed sl@0: * (native). */ sl@0: int recursive; /* If non-zero, removes directories that sl@0: * are nonempty. Otherwise, will only remove sl@0: * empty directories. */ sl@0: Tcl_DString *errorPtr; /* If non-NULL, uninitialized or free sl@0: * DString filled with UTF-8 name of file sl@0: * causing error. */ sl@0: { sl@0: CONST char *path; sl@0: mode_t oldPerm = 0; sl@0: int result; sl@0: sl@0: path = Tcl_DStringValue(pathPtr); sl@0: sl@0: #ifdef __SYMBIAN32__ sl@0: TclPrint1(" == DoRemoveDirectory() - \"%S\".\n", path); sl@0: #endif sl@0: sl@0: if (recursive != 0) { sl@0: /* We should try to change permissions so this can be deleted */ sl@0: Tcl_StatBuf statBuf; sl@0: int newPerm; sl@0: sl@0: if (TclOSstat(path, &statBuf) == 0) { sl@0: oldPerm = (mode_t) (statBuf.st_mode & 0x00007FFF); sl@0: } sl@0: sl@0: newPerm = oldPerm | (64+128+256); sl@0: chmod(path, (mode_t) newPerm); sl@0: } sl@0: sl@0: if (rmdir(path) == 0) { /* INTL: Native. */ sl@0: return TCL_OK; sl@0: } sl@0: if (errno == ENOTEMPTY) { sl@0: errno = EEXIST; sl@0: } sl@0: sl@0: result = TCL_OK; sl@0: if ((errno != EEXIST) || (recursive == 0)) { sl@0: if (errorPtr != NULL) { sl@0: Tcl_ExternalToUtfDString(NULL, path, -1, errorPtr); sl@0: } sl@0: result = TCL_ERROR; sl@0: } sl@0: sl@0: /* sl@0: * The directory is nonempty, but the recursive flag has been sl@0: * specified, so we recursively remove all the files in the directory. sl@0: */ sl@0: sl@0: if (result == TCL_OK) { sl@0: result = TraverseUnixTree(TraversalDelete, pathPtr, NULL, errorPtr, 1); sl@0: } sl@0: sl@0: if ((result != TCL_OK) && (recursive != 0)) { sl@0: /* Try to restore permissions */ sl@0: chmod(path, oldPerm); sl@0: } sl@0: return result; sl@0: } sl@0: sl@0: /* sl@0: *--------------------------------------------------------------------------- sl@0: * sl@0: * TraverseUnixTree -- sl@0: * sl@0: * Traverse directory tree specified by sourcePtr, calling the function sl@0: * traverseProc for each file and directory encountered. If destPtr sl@0: * is non-null, each of name in the sourcePtr directory is appended to sl@0: * the directory specified by destPtr and passed as the second argument sl@0: * to traverseProc() . sl@0: * sl@0: * Results: sl@0: * Standard Tcl result. sl@0: * sl@0: * Side effects: sl@0: * None caused by TraverseUnixTree, however the user specified sl@0: * traverseProc() may change state. If an error occurs, the error will sl@0: * be returned immediately, and remaining files will not be processed. sl@0: * sl@0: *--------------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static int sl@0: TraverseUnixTree(traverseProc, sourcePtr, targetPtr, errorPtr, doRewind) sl@0: TraversalProc *traverseProc;/* Function to call for every file and sl@0: * directory in source hierarchy. */ sl@0: Tcl_DString *sourcePtr; /* Pathname of source directory to be sl@0: * traversed (native). */ sl@0: Tcl_DString *targetPtr; /* Pathname of directory to traverse in sl@0: * parallel with source directory (native). */ sl@0: Tcl_DString *errorPtr; /* If non-NULL, uninitialized or free sl@0: * DString filled with UTF-8 name of file sl@0: * causing error. */ sl@0: int doRewind; /* Flag indicating that to ensure complete sl@0: * traversal of source hierarchy, the readdir sl@0: * loop should be rewound whenever sl@0: * traverseProc has returned TCL_OK; this is sl@0: * required when traverseProc modifies the sl@0: * source hierarchy, e.g. by deleting files. */ sl@0: { sl@0: Tcl_StatBuf statBuf; sl@0: CONST char *source, *errfile; sl@0: int result, sourceLen; sl@0: int targetLen; sl@0: #ifndef HAVE_FTS sl@0: int numProcessed = 0; sl@0: Tcl_DirEntry *dirEntPtr; sl@0: DIR *dirPtr; sl@0: #else sl@0: CONST char *paths[2] = {NULL, NULL}; sl@0: FTS *fts = NULL; sl@0: FTSENT *ent; sl@0: #endif sl@0: sl@0: errfile = NULL; sl@0: result = TCL_OK; sl@0: targetLen = 0; /* lint. */ sl@0: sl@0: source = Tcl_DStringValue(sourcePtr); sl@0: if (TclOSlstat(source, &statBuf) != 0) { /* INTL: Native. */ sl@0: errfile = source; sl@0: goto end; sl@0: } sl@0: if (!S_ISDIR(statBuf.st_mode)) { sl@0: /* sl@0: * Process the regular file sl@0: */ sl@0: sl@0: return (*traverseProc)(sourcePtr, targetPtr, &statBuf, DOTREE_F, sl@0: errorPtr); sl@0: } sl@0: #ifndef HAVE_FTS sl@0: dirPtr = opendir(source); /* INTL: Native. */ sl@0: if (dirPtr == NULL) { sl@0: /* sl@0: * Can't read directory sl@0: */ sl@0: sl@0: errfile = source; sl@0: goto end; sl@0: } sl@0: result = (*traverseProc)(sourcePtr, targetPtr, &statBuf, DOTREE_PRED, sl@0: errorPtr); sl@0: if (result != TCL_OK) { sl@0: closedir(dirPtr); sl@0: return result; sl@0: } sl@0: sl@0: Tcl_DStringAppend(sourcePtr, "/", 1); sl@0: sourceLen = Tcl_DStringLength(sourcePtr); sl@0: sl@0: if (targetPtr != NULL) { sl@0: Tcl_DStringAppend(targetPtr, "/", 1); sl@0: targetLen = Tcl_DStringLength(targetPtr); sl@0: } sl@0: sl@0: while ((dirEntPtr = TclOSreaddir(dirPtr)) != NULL) { /* INTL: Native. */ sl@0: if ((dirEntPtr->d_name[0] == '.') sl@0: && ((dirEntPtr->d_name[1] == '\0') sl@0: || (strcmp(dirEntPtr->d_name, "..") == 0))) { sl@0: continue; sl@0: } sl@0: sl@0: /* sl@0: * Append name after slash, and recurse on the file. sl@0: */ sl@0: sl@0: Tcl_DStringAppend(sourcePtr, dirEntPtr->d_name, -1); sl@0: if (targetPtr != NULL) { sl@0: Tcl_DStringAppend(targetPtr, dirEntPtr->d_name, -1); sl@0: } sl@0: result = TraverseUnixTree(traverseProc, sourcePtr, targetPtr, sl@0: errorPtr, doRewind); sl@0: if (result != TCL_OK) { sl@0: break; sl@0: } else { sl@0: numProcessed++; sl@0: } sl@0: sl@0: /* sl@0: * Remove name after slash. sl@0: */ sl@0: sl@0: Tcl_DStringSetLength(sourcePtr, sourceLen); sl@0: if (targetPtr != NULL) { sl@0: Tcl_DStringSetLength(targetPtr, targetLen); sl@0: } sl@0: if (doRewind && (numProcessed > MAX_READDIR_UNLINK_THRESHOLD)) { sl@0: /* sl@0: * Call rewinddir if we've called unlink or rmdir so many times sl@0: * (since the opendir or the previous rewinddir), to avoid sl@0: * a NULL-return that may a symptom of a buggy readdir. sl@0: */ sl@0: rewinddir(dirPtr); sl@0: numProcessed = 0; sl@0: } sl@0: } sl@0: closedir(dirPtr); sl@0: sl@0: /* sl@0: * Strip off the trailing slash we added sl@0: */ sl@0: sl@0: Tcl_DStringSetLength(sourcePtr, sourceLen - 1); sl@0: if (targetPtr != NULL) { sl@0: Tcl_DStringSetLength(targetPtr, targetLen - 1); sl@0: } sl@0: sl@0: if (result == TCL_OK) { sl@0: /* sl@0: * Call traverseProc() on a directory after visiting all the sl@0: * files in that directory. sl@0: */ sl@0: sl@0: result = (*traverseProc)(sourcePtr, targetPtr, &statBuf, DOTREE_POSTD, sl@0: errorPtr); sl@0: } sl@0: #else /* HAVE_FTS */ sl@0: paths[0] = source; sl@0: fts = fts_open((char**)paths, FTS_PHYSICAL | FTS_NOCHDIR | sl@0: (noFtsStat || doRewind ? FTS_NOSTAT : 0), NULL); sl@0: if (fts == NULL) { sl@0: errfile = source; sl@0: goto end; sl@0: } sl@0: sl@0: sourceLen = Tcl_DStringLength(sourcePtr); sl@0: if (targetPtr != NULL) { sl@0: targetLen = Tcl_DStringLength(targetPtr); sl@0: } sl@0: sl@0: while ((ent = fts_read(fts)) != NULL) { sl@0: unsigned short info = ent->fts_info; sl@0: char * path = ent->fts_path + sourceLen; sl@0: unsigned short pathlen = ent->fts_pathlen - sourceLen; sl@0: int type; sl@0: Tcl_StatBuf *statBufPtr = NULL; sl@0: sl@0: if (info == FTS_DNR || info == FTS_ERR || info == FTS_NS) { sl@0: errfile = ent->fts_path; sl@0: break; sl@0: } sl@0: Tcl_DStringAppend(sourcePtr, path, pathlen); sl@0: if (targetPtr != NULL) { sl@0: Tcl_DStringAppend(targetPtr, path, pathlen); sl@0: } sl@0: switch (info) { sl@0: case FTS_D: sl@0: type = DOTREE_PRED; sl@0: break; sl@0: case FTS_DP: sl@0: type = DOTREE_POSTD; sl@0: break; sl@0: default: sl@0: type = DOTREE_F; sl@0: break; sl@0: } sl@0: if (!doRewind) { /* no need to stat for delete */ sl@0: if (noFtsStat) { sl@0: statBufPtr = &statBuf; sl@0: if (TclOSlstat(ent->fts_path, statBufPtr) != 0) { sl@0: errfile = ent->fts_path; sl@0: break; sl@0: } sl@0: } else { sl@0: statBufPtr = ent->fts_statp; sl@0: } sl@0: } sl@0: result = (*traverseProc)(sourcePtr, targetPtr, statBufPtr, type, sl@0: errorPtr); sl@0: if (result != TCL_OK) { sl@0: break; sl@0: } sl@0: Tcl_DStringSetLength(sourcePtr, sourceLen); sl@0: if (targetPtr != NULL) { sl@0: Tcl_DStringSetLength(targetPtr, targetLen); sl@0: } sl@0: } sl@0: #endif /* HAVE_FTS */ sl@0: sl@0: end: sl@0: if (errfile != NULL) { sl@0: if (errorPtr != NULL) { sl@0: Tcl_ExternalToUtfDString(NULL, errfile, -1, errorPtr); sl@0: } sl@0: result = TCL_ERROR; sl@0: } sl@0: #ifdef HAVE_FTS sl@0: if (fts != NULL) { sl@0: fts_close(fts); sl@0: } sl@0: #endif /* HAVE_FTS */ sl@0: sl@0: return result; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * TraversalCopy sl@0: * sl@0: * Called from TraverseUnixTree in order to execute a recursive copy sl@0: * of a directory. sl@0: * sl@0: * Results: sl@0: * Standard Tcl result. sl@0: * sl@0: * Side effects: sl@0: * The file or directory src may be copied to dst, depending on sl@0: * the value of type. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static int sl@0: TraversalCopy(srcPtr, dstPtr, statBufPtr, type, errorPtr) sl@0: Tcl_DString *srcPtr; /* Source pathname to copy (native). */ sl@0: Tcl_DString *dstPtr; /* Destination pathname of copy (native). */ sl@0: CONST Tcl_StatBuf *statBufPtr; sl@0: /* Stat info for file specified by srcPtr. */ sl@0: int type; /* Reason for call - see TraverseUnixTree(). */ sl@0: Tcl_DString *errorPtr; /* If non-NULL, uninitialized or free sl@0: * DString filled with UTF-8 name of file sl@0: * causing error. */ sl@0: { sl@0: switch (type) { sl@0: case DOTREE_F: sl@0: if (DoCopyFile(Tcl_DStringValue(srcPtr), Tcl_DStringValue(dstPtr), sl@0: statBufPtr) == TCL_OK) { sl@0: return TCL_OK; sl@0: } sl@0: break; sl@0: sl@0: case DOTREE_PRED: sl@0: if (DoCreateDirectory(Tcl_DStringValue(dstPtr)) == TCL_OK) { sl@0: return TCL_OK; sl@0: } sl@0: break; sl@0: sl@0: case DOTREE_POSTD: sl@0: if (CopyFileAtts(Tcl_DStringValue(srcPtr), sl@0: Tcl_DStringValue(dstPtr), statBufPtr) == TCL_OK) { sl@0: return TCL_OK; sl@0: } sl@0: break; sl@0: sl@0: } sl@0: sl@0: /* sl@0: * There shouldn't be a problem with src, because we already checked it sl@0: * to get here. sl@0: */ sl@0: sl@0: if (errorPtr != NULL) { sl@0: Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(dstPtr), sl@0: Tcl_DStringLength(dstPtr), errorPtr); sl@0: } sl@0: return TCL_ERROR; sl@0: } sl@0: sl@0: /* sl@0: *--------------------------------------------------------------------------- sl@0: * sl@0: * TraversalDelete -- sl@0: * sl@0: * Called by procedure TraverseUnixTree for every file and directory sl@0: * that it encounters in a directory hierarchy. This procedure unlinks sl@0: * files, and removes directories after all the containing files sl@0: * have been processed. sl@0: * sl@0: * Results: sl@0: * Standard Tcl result. sl@0: * sl@0: * Side effects: sl@0: * Files or directory specified by src will be deleted. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static int sl@0: TraversalDelete(srcPtr, ignore, statBufPtr, type, errorPtr) sl@0: Tcl_DString *srcPtr; /* Source pathname (native). */ sl@0: Tcl_DString *ignore; /* Destination pathname (not used). */ sl@0: CONST Tcl_StatBuf *statBufPtr; sl@0: /* Stat info for file specified by srcPtr. */ sl@0: int type; /* Reason for call - see TraverseUnixTree(). */ sl@0: Tcl_DString *errorPtr; /* If non-NULL, uninitialized or free sl@0: * DString filled with UTF-8 name of file sl@0: * causing error. */ sl@0: { sl@0: switch (type) { sl@0: case DOTREE_F: { sl@0: if (TclpDeleteFile(Tcl_DStringValue(srcPtr)) == 0) { sl@0: return TCL_OK; sl@0: } sl@0: break; sl@0: } sl@0: case DOTREE_PRED: { sl@0: return TCL_OK; sl@0: } sl@0: case DOTREE_POSTD: { sl@0: if (DoRemoveDirectory(srcPtr, 0, NULL) == 0) { sl@0: return TCL_OK; sl@0: } sl@0: break; sl@0: } sl@0: } sl@0: if (errorPtr != NULL) { sl@0: Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(srcPtr), sl@0: Tcl_DStringLength(srcPtr), errorPtr); sl@0: } sl@0: return TCL_ERROR; sl@0: } sl@0: sl@0: /* sl@0: *--------------------------------------------------------------------------- sl@0: * sl@0: * CopyFileAtts -- sl@0: * sl@0: * Copy the file attributes such as owner, group, permissions, sl@0: * and modification date from one file to another. sl@0: * sl@0: * Results: sl@0: * Standard Tcl result. sl@0: * sl@0: * Side effects: sl@0: * user id, group id, permission bits, last modification time, and sl@0: * last access time are updated in the new file to reflect the sl@0: * old file. sl@0: * sl@0: *--------------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static int sl@0: CopyFileAtts(src, dst, statBufPtr) sl@0: CONST char *src; /* Path name of source file (native). */ sl@0: CONST char *dst; /* Path name of target file (native). */ sl@0: CONST Tcl_StatBuf *statBufPtr; sl@0: /* Stat info for source file */ sl@0: { sl@0: struct utimbuf tval; sl@0: mode_t newMode; sl@0: sl@0: newMode = statBufPtr->st_mode sl@0: & (S_ISUID | S_ISGID | S_IRWXU | S_IRWXG | S_IRWXO); sl@0: sl@0: /* sl@0: * Note that if you copy a setuid file that is owned by someone sl@0: * else, and you are not root, then the copy will be setuid to you. sl@0: * The most correct implementation would probably be to have the sl@0: * copy not setuid to anyone if the original file was owned by sl@0: * someone else, but this corner case isn't currently handled. sl@0: * It would require another lstat(), or getuid(). sl@0: */ sl@0: sl@0: if (chmod(dst, newMode)) { /* INTL: Native. */ sl@0: newMode &= ~(S_ISUID | S_ISGID); sl@0: if (chmod(dst, newMode)) { /* INTL: Native. */ sl@0: return TCL_ERROR; sl@0: } sl@0: } sl@0: sl@0: tval.actime = statBufPtr->st_atime; sl@0: tval.modtime = statBufPtr->st_mtime; sl@0: sl@0: if (utime(dst, &tval)) { /* INTL: Native. */ sl@0: return TCL_ERROR; sl@0: } sl@0: #ifdef HAVE_COPYFILE sl@0: #ifdef WEAK_IMPORT_COPYFILE sl@0: if (copyfile != NULL) sl@0: #endif sl@0: copyfile(src, dst, NULL, COPYFILE_XATTR|COPYFILE_ACL); sl@0: #endif sl@0: return TCL_OK; sl@0: } sl@0: sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * GetGroupAttribute sl@0: * sl@0: * Gets the group attribute of a file. sl@0: * sl@0: * Results: sl@0: * Standard TCL result. Returns a new Tcl_Obj in attributePtrPtr sl@0: * if there is no error. sl@0: * sl@0: * Side effects: sl@0: * A new object is allocated. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static int sl@0: GetGroupAttribute(interp, objIndex, fileName, attributePtrPtr) sl@0: Tcl_Interp *interp; /* The interp we are using for errors. */ sl@0: int objIndex; /* The index of the attribute. */ sl@0: Tcl_Obj *fileName; /* The name of the file (UTF-8). */ sl@0: Tcl_Obj **attributePtrPtr; /* A pointer to return the object with. */ sl@0: { sl@0: Tcl_StatBuf statBuf; sl@0: struct group *groupPtr; sl@0: int result; sl@0: sl@0: result = TclpObjStat(fileName, &statBuf); sl@0: sl@0: if (result != 0) { sl@0: Tcl_AppendResult(interp, "could not read \"", sl@0: Tcl_GetString(fileName), "\": ", sl@0: Tcl_PosixError(interp), (char *) NULL); sl@0: return TCL_ERROR; sl@0: } sl@0: sl@0: groupPtr = TclpGetGrGid(statBuf.st_gid); sl@0: sl@0: if (result == -1 || groupPtr == NULL) { sl@0: *attributePtrPtr = Tcl_NewIntObj((int) statBuf.st_gid); sl@0: } else { sl@0: Tcl_DString ds; sl@0: CONST char *utf; sl@0: sl@0: utf = Tcl_ExternalToUtfDString(NULL, groupPtr->gr_name, -1, &ds); sl@0: *attributePtrPtr = Tcl_NewStringObj(utf, -1); sl@0: Tcl_DStringFree(&ds); sl@0: } sl@0: endgrent(); sl@0: return TCL_OK; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * GetOwnerAttribute sl@0: * sl@0: * Gets the owner attribute of a file. sl@0: * sl@0: * Results: sl@0: * Standard TCL result. Returns a new Tcl_Obj in attributePtrPtr sl@0: * if there is no error. sl@0: * sl@0: * Side effects: sl@0: * A new object is allocated. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static int sl@0: GetOwnerAttribute(interp, objIndex, fileName, attributePtrPtr) sl@0: Tcl_Interp *interp; /* The interp we are using for errors. */ sl@0: int objIndex; /* The index of the attribute. */ sl@0: Tcl_Obj *fileName; /* The name of the file (UTF-8). */ sl@0: Tcl_Obj **attributePtrPtr; /* A pointer to return the object with. */ sl@0: { sl@0: Tcl_StatBuf statBuf; sl@0: struct passwd *pwPtr; sl@0: int result; sl@0: sl@0: result = TclpObjStat(fileName, &statBuf); sl@0: sl@0: if (result != 0) { sl@0: Tcl_AppendResult(interp, "could not read \"", sl@0: Tcl_GetString(fileName), "\": ", sl@0: Tcl_PosixError(interp), (char *) NULL); sl@0: return TCL_ERROR; sl@0: } sl@0: sl@0: pwPtr = TclpGetPwUid(statBuf.st_uid); sl@0: sl@0: if (result == -1 || pwPtr == NULL) { sl@0: *attributePtrPtr = Tcl_NewIntObj((int) statBuf.st_uid); sl@0: } else { sl@0: Tcl_DString ds; sl@0: CONST char *utf; sl@0: sl@0: utf = Tcl_ExternalToUtfDString(NULL, pwPtr->pw_name, -1, &ds); sl@0: *attributePtrPtr = Tcl_NewStringObj(utf, Tcl_DStringLength(&ds)); sl@0: Tcl_DStringFree(&ds); sl@0: } sl@0: endpwent(); sl@0: return TCL_OK; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * GetPermissionsAttribute sl@0: * sl@0: * Gets the group attribute of a file. sl@0: * sl@0: * Results: sl@0: * Standard TCL result. Returns a new Tcl_Obj in attributePtrPtr sl@0: * if there is no error. The object will have ref count 0. sl@0: * sl@0: * Side effects: sl@0: * A new object is allocated. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static int sl@0: GetPermissionsAttribute(interp, objIndex, fileName, attributePtrPtr) sl@0: Tcl_Interp *interp; /* The interp we are using for errors. */ sl@0: int objIndex; /* The index of the attribute. */ sl@0: Tcl_Obj *fileName; /* The name of the file (UTF-8). */ sl@0: Tcl_Obj **attributePtrPtr; /* A pointer to return the object with. */ sl@0: { sl@0: Tcl_StatBuf statBuf; sl@0: char returnString[7]; sl@0: int result; sl@0: sl@0: result = TclpObjStat(fileName, &statBuf); sl@0: sl@0: if (result != 0) { sl@0: Tcl_AppendResult(interp, "could not read \"", sl@0: Tcl_GetString(fileName), "\": ", sl@0: Tcl_PosixError(interp), (char *) NULL); sl@0: return TCL_ERROR; sl@0: } sl@0: sl@0: sprintf(returnString, "%0#5lo", (long) (statBuf.st_mode & 0x00007FFF)); sl@0: sl@0: *attributePtrPtr = Tcl_NewStringObj(returnString, -1); sl@0: sl@0: return TCL_OK; sl@0: } sl@0: sl@0: /* sl@0: *--------------------------------------------------------------------------- sl@0: * sl@0: * SetGroupAttribute -- sl@0: * sl@0: * Sets the group of the file to the specified group. sl@0: * sl@0: * Results: sl@0: * Standard TCL result. sl@0: * sl@0: * Side effects: sl@0: * As above. sl@0: * sl@0: *--------------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static int sl@0: SetGroupAttribute(interp, objIndex, fileName, attributePtr) sl@0: Tcl_Interp *interp; /* The interp for error reporting. */ sl@0: int objIndex; /* The index of the attribute. */ sl@0: Tcl_Obj *fileName; /* The name of the file (UTF-8). */ sl@0: Tcl_Obj *attributePtr; /* New group for file. */ sl@0: { sl@0: long gid; sl@0: int result; sl@0: CONST char *native; sl@0: sl@0: if (Tcl_GetLongFromObj(NULL, attributePtr, &gid) != TCL_OK) { sl@0: Tcl_DString ds; sl@0: struct group *groupPtr; sl@0: CONST char *string; sl@0: int length; sl@0: sl@0: string = Tcl_GetStringFromObj(attributePtr, &length); sl@0: native = Tcl_UtfToExternalDString(NULL, string, length, &ds); sl@0: groupPtr = TclpGetGrNam(native); /* INTL: Native. */ sl@0: Tcl_DStringFree(&ds); sl@0: sl@0: if (groupPtr == NULL) { sl@0: endgrent(); sl@0: Tcl_AppendResult(interp, "could not set group for file \"", sl@0: Tcl_GetString(fileName), "\": group \"", sl@0: string, "\" does not exist", sl@0: (char *) NULL); sl@0: return TCL_ERROR; sl@0: } sl@0: gid = groupPtr->gr_gid; sl@0: } sl@0: sl@0: native = Tcl_FSGetNativePath(fileName); sl@0: result = chown(native, (uid_t) -1, (gid_t) gid); /* INTL: Native. */ sl@0: sl@0: endgrent(); sl@0: if (result != 0) { sl@0: Tcl_AppendResult(interp, "could not set group for file \"", sl@0: Tcl_GetString(fileName), "\": ", Tcl_PosixError(interp), sl@0: (char *) NULL); sl@0: return TCL_ERROR; sl@0: } sl@0: return TCL_OK; sl@0: } sl@0: sl@0: /* sl@0: *--------------------------------------------------------------------------- sl@0: * sl@0: * SetOwnerAttribute -- sl@0: * sl@0: * Sets the owner of the file to the specified owner. sl@0: * sl@0: * Results: sl@0: * Standard TCL result. sl@0: * sl@0: * Side effects: sl@0: * As above. sl@0: * sl@0: *--------------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static int sl@0: SetOwnerAttribute(interp, objIndex, fileName, attributePtr) sl@0: Tcl_Interp *interp; /* The interp for error reporting. */ sl@0: int objIndex; /* The index of the attribute. */ sl@0: Tcl_Obj *fileName; /* The name of the file (UTF-8). */ sl@0: Tcl_Obj *attributePtr; /* New owner for file. */ sl@0: { sl@0: long uid; sl@0: int result; sl@0: CONST char *native; sl@0: sl@0: if (Tcl_GetLongFromObj(NULL, attributePtr, &uid) != TCL_OK) { sl@0: Tcl_DString ds; sl@0: struct passwd *pwPtr; sl@0: CONST char *string; sl@0: int length; sl@0: sl@0: string = Tcl_GetStringFromObj(attributePtr, &length); sl@0: native = Tcl_UtfToExternalDString(NULL, string, length, &ds); sl@0: pwPtr = TclpGetPwNam(native); /* INTL: Native. */ sl@0: Tcl_DStringFree(&ds); sl@0: sl@0: if (pwPtr == NULL) { sl@0: endpwent(); sl@0: Tcl_AppendResult(interp, "could not set owner for file \"", sl@0: Tcl_GetString(fileName), "\": user \"", sl@0: string, "\" does not exist", sl@0: (char *) NULL); sl@0: return TCL_ERROR; sl@0: } sl@0: uid = pwPtr->pw_uid; sl@0: } sl@0: sl@0: native = Tcl_FSGetNativePath(fileName); sl@0: result = chown(native, (uid_t) uid, (gid_t) -1); /* INTL: Native. */ sl@0: sl@0: endpwent(); sl@0: if (result != 0) { sl@0: Tcl_AppendResult(interp, "could not set owner for file \"", sl@0: Tcl_GetString(fileName), "\": ", sl@0: Tcl_PosixError(interp), (char *) NULL); sl@0: return TCL_ERROR; sl@0: } sl@0: return TCL_OK; sl@0: } sl@0: sl@0: /* sl@0: *--------------------------------------------------------------------------- sl@0: * sl@0: * SetPermissionsAttribute sl@0: * sl@0: * Sets the file to the given permission. sl@0: * sl@0: * Results: sl@0: * Standard TCL result. sl@0: * sl@0: * Side effects: sl@0: * The permission of the file is changed. sl@0: * sl@0: *--------------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static int sl@0: SetPermissionsAttribute(interp, objIndex, fileName, attributePtr) sl@0: Tcl_Interp *interp; /* The interp we are using for errors. */ sl@0: int objIndex; /* The index of the attribute. */ sl@0: Tcl_Obj *fileName; /* The name of the file (UTF-8). */ sl@0: Tcl_Obj *attributePtr; /* The attribute to set. */ sl@0: { sl@0: long mode; sl@0: mode_t newMode; sl@0: int result; sl@0: CONST char *native; sl@0: sl@0: /* sl@0: * First try if the string is a number sl@0: */ sl@0: if (Tcl_GetLongFromObj(NULL, attributePtr, &mode) == TCL_OK) { sl@0: newMode = (mode_t) (mode & 0x00007FFF); sl@0: } else { sl@0: Tcl_StatBuf buf; sl@0: char *modeStringPtr = Tcl_GetString(attributePtr); sl@0: sl@0: /* sl@0: * Try the forms "rwxrwxrwx" and "ugo=rwx" sl@0: * sl@0: * We get the current mode of the file, in order to allow for sl@0: * ug+-=rwx style chmod strings. sl@0: */ sl@0: result = TclpObjStat(fileName, &buf); sl@0: if (result != 0) { sl@0: Tcl_AppendResult(interp, "could not read \"", sl@0: Tcl_GetString(fileName), "\": ", sl@0: Tcl_PosixError(interp), (char *) NULL); sl@0: return TCL_ERROR; sl@0: } sl@0: newMode = (mode_t) (buf.st_mode & 0x00007FFF); sl@0: sl@0: if (GetModeFromPermString(NULL, modeStringPtr, &newMode) != TCL_OK) { sl@0: Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), sl@0: "unknown permission string format \"", sl@0: modeStringPtr, "\"", (char *) NULL); sl@0: return TCL_ERROR; sl@0: } sl@0: } sl@0: sl@0: native = Tcl_FSGetNativePath(fileName); sl@0: result = chmod(native, newMode); /* INTL: Native. */ sl@0: if (result != 0) { sl@0: Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), sl@0: "could not set permissions for file \"", sl@0: Tcl_GetString(fileName), "\": ", sl@0: Tcl_PosixError(interp), (char *) NULL); sl@0: return TCL_ERROR; sl@0: } sl@0: return TCL_OK; sl@0: } sl@0: sl@0: /* sl@0: *--------------------------------------------------------------------------- sl@0: * sl@0: * TclpObjListVolumes -- sl@0: * sl@0: * Lists the currently mounted volumes, which on UNIX is just /. sl@0: * sl@0: * Results: sl@0: * The list of volumes. sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *--------------------------------------------------------------------------- sl@0: */ sl@0: sl@0: Tcl_Obj* sl@0: TclpObjListVolumes(void) sl@0: { sl@0: Tcl_Obj *resultPtr = Tcl_NewStringObj("/",1); sl@0: sl@0: Tcl_IncrRefCount(resultPtr); sl@0: return resultPtr; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * GetModeFromPermString -- sl@0: * sl@0: * This procedure is invoked to process the "file permissions" sl@0: * Tcl command, to check for a "rwxrwxrwx" or "ugoa+-=rwxst" string. sl@0: * See the user documentation for details on what it does. sl@0: * sl@0: * Results: sl@0: * A standard Tcl result. sl@0: * sl@0: * Side effects: sl@0: * See the user documentation. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static int sl@0: GetModeFromPermString(interp, modeStringPtr, modePtr) sl@0: Tcl_Interp *interp; /* The interp we are using for errors. */ sl@0: char *modeStringPtr; /* Permissions string */ sl@0: mode_t *modePtr; /* pointer to the mode value */ sl@0: { sl@0: mode_t newMode; sl@0: mode_t oldMode; /* Storage for the value of the old mode sl@0: * (that is passed in), to allow for the sl@0: * chmod style manipulation */ sl@0: int i,n, who, op, what, op_found, who_found; sl@0: sl@0: /* sl@0: * We start off checking for an "rwxrwxrwx" style permissions string sl@0: */ sl@0: if (strlen(modeStringPtr) != 9) { sl@0: goto chmodStyleCheck; sl@0: } sl@0: sl@0: newMode = 0; sl@0: for (i = 0; i < 9; i++) { sl@0: switch (*(modeStringPtr+i)) { sl@0: case 'r': sl@0: if ((i%3) != 0) { sl@0: goto chmodStyleCheck; sl@0: } sl@0: newMode |= (1<<(8-i)); sl@0: break; sl@0: case 'w': sl@0: if ((i%3) != 1) { sl@0: goto chmodStyleCheck; sl@0: } sl@0: newMode |= (1<<(8-i)); sl@0: break; sl@0: case 'x': sl@0: if ((i%3) != 2) { sl@0: goto chmodStyleCheck; sl@0: } sl@0: newMode |= (1<<(8-i)); sl@0: break; sl@0: case 's': sl@0: if (((i%3) != 2) || (i > 5)) { sl@0: goto chmodStyleCheck; sl@0: } sl@0: newMode |= (1<<(8-i)); sl@0: newMode |= (1<<(11-(i/3))); sl@0: break; sl@0: case 'S': sl@0: if (((i%3) != 2) || (i > 5)) { sl@0: goto chmodStyleCheck; sl@0: } sl@0: newMode |= (1<<(11-(i/3))); sl@0: break; sl@0: case 't': sl@0: if (i != 8) { sl@0: goto chmodStyleCheck; sl@0: } sl@0: newMode |= (1<<(8-i)); sl@0: newMode |= (1<<9); sl@0: break; sl@0: case 'T': sl@0: if (i != 8) { sl@0: goto chmodStyleCheck; sl@0: } sl@0: newMode |= (1<<9); sl@0: break; sl@0: case '-': sl@0: break; sl@0: default: sl@0: /* sl@0: * Oops, not what we thought it was, so go on sl@0: */ sl@0: goto chmodStyleCheck; sl@0: } sl@0: } sl@0: *modePtr = newMode; sl@0: return TCL_OK; sl@0: sl@0: chmodStyleCheck: sl@0: /* sl@0: * We now check for an "ugoa+-=rwxst" style permissions string sl@0: */ sl@0: sl@0: for (n = 0 ; *(modeStringPtr+n) != '\0' ; n = n + i) { sl@0: oldMode = *modePtr; sl@0: who = op = what = op_found = who_found = 0; sl@0: for (i = 0 ; *(modeStringPtr+n+i) != '\0' ; i++ ) { sl@0: if (!who_found) { sl@0: /* who */ sl@0: switch (*(modeStringPtr+n+i)) { sl@0: case 'u' : sl@0: who |= 0x9c0; sl@0: continue; sl@0: case 'g' : sl@0: who |= 0x438; sl@0: continue; sl@0: case 'o' : sl@0: who |= 0x207; sl@0: continue; sl@0: case 'a' : sl@0: who |= 0xfff; sl@0: continue; sl@0: } sl@0: } sl@0: who_found = 1; sl@0: if (who == 0) { sl@0: who = 0xfff; sl@0: } sl@0: if (!op_found) { sl@0: /* op */ sl@0: switch (*(modeStringPtr+n+i)) { sl@0: case '+' : sl@0: op = 1; sl@0: op_found = 1; sl@0: continue; sl@0: case '-' : sl@0: op = 2; sl@0: op_found = 1; sl@0: continue; sl@0: case '=' : sl@0: op = 3; sl@0: op_found = 1; sl@0: continue; sl@0: default : sl@0: return TCL_ERROR; sl@0: } sl@0: } sl@0: /* what */ sl@0: switch (*(modeStringPtr+n+i)) { sl@0: case 'r' : sl@0: what |= 0x124; sl@0: continue; sl@0: case 'w' : sl@0: what |= 0x92; sl@0: continue; sl@0: case 'x' : sl@0: what |= 0x49; sl@0: continue; sl@0: case 's' : sl@0: what |= 0xc00; sl@0: continue; sl@0: case 't' : sl@0: what |= 0x200; sl@0: continue; sl@0: case ',' : sl@0: break; sl@0: default : sl@0: return TCL_ERROR; sl@0: } sl@0: if (*(modeStringPtr+n+i) == ',') { sl@0: i++; sl@0: break; sl@0: } sl@0: } sl@0: switch (op) { sl@0: case 1 : sl@0: *modePtr = oldMode | (who & what); sl@0: continue; sl@0: case 2 : sl@0: *modePtr = oldMode & ~(who & what); sl@0: continue; sl@0: case 3 : sl@0: *modePtr = (oldMode & ~who) | (who & what); sl@0: continue; sl@0: } sl@0: } sl@0: return TCL_OK; sl@0: } sl@0: sl@0: /* sl@0: *--------------------------------------------------------------------------- sl@0: * sl@0: * TclpObjNormalizePath -- sl@0: * sl@0: * This function scans through a path specification and replaces sl@0: * it, in place, with a normalized version. A normalized version sl@0: * is one in which all symlinks in the path are replaced with sl@0: * their expanded form (except a symlink at the very end of the sl@0: * path). sl@0: * sl@0: * Results: sl@0: * The new 'nextCheckpoint' value, giving as far as we could sl@0: * understand in the path. sl@0: * sl@0: * Side effects: sl@0: * The pathPtr string, is modified. sl@0: * sl@0: *--------------------------------------------------------------------------- sl@0: */ sl@0: int sl@0: TclpObjNormalizePath(interp, pathPtr, nextCheckpoint) sl@0: Tcl_Interp *interp; sl@0: Tcl_Obj *pathPtr; sl@0: int nextCheckpoint; sl@0: { sl@0: char *currentPathEndPosition; sl@0: int pathLen; sl@0: char cur; sl@0: char *path = Tcl_GetStringFromObj(pathPtr, &pathLen); sl@0: #ifndef NO_REALPATH sl@0: char normPath[MAXPATHLEN]; sl@0: Tcl_DString ds; sl@0: CONST char *nativePath; sl@0: #endif sl@0: /* sl@0: * We add '1' here because if nextCheckpoint is zero we know sl@0: * that '/' exists, and if it isn't zero, it must point at sl@0: * a directory separator which we also know exists. sl@0: */ sl@0: currentPathEndPosition = path + nextCheckpoint; sl@0: if (*currentPathEndPosition == '/') { sl@0: currentPathEndPosition++; sl@0: } sl@0: sl@0: #ifndef NO_REALPATH sl@0: /* For speed, try to get the entire path in one go */ sl@0: if (nextCheckpoint == 0 && haveRealpath) { sl@0: char *lastDir = strrchr(currentPathEndPosition, '/'); sl@0: if (lastDir != NULL) { sl@0: nativePath = Tcl_UtfToExternalDString(NULL, path, sl@0: lastDir - path, &ds); sl@0: sl@0: if (Realpath(nativePath, normPath) != NULL) { sl@0: sl@0: if (*nativePath != '/' && *normPath == '/') { sl@0: /* sl@0: * realpath has transformed a relative path into an sl@0: * absolute path, we do not know how to handle this. sl@0: */ sl@0: } else { sl@0: nextCheckpoint = lastDir - path; sl@0: goto wholeStringOk; sl@0: } sl@0: } sl@0: Tcl_DStringFree(&ds); sl@0: } sl@0: } sl@0: /* Else do it the slow way */ sl@0: #endif sl@0: sl@0: while (1) { sl@0: cur = *currentPathEndPosition; sl@0: if ((cur == '/') && (path != currentPathEndPosition)) { sl@0: /* Reached directory separator */ sl@0: Tcl_DString ds; sl@0: CONST char *nativePath; sl@0: int accessOk; sl@0: sl@0: nativePath = Tcl_UtfToExternalDString(NULL, path, sl@0: currentPathEndPosition - path, &ds); sl@0: accessOk = access(nativePath, F_OK); sl@0: Tcl_DStringFree(&ds); sl@0: if (accessOk != 0) { sl@0: /* File doesn't exist */ sl@0: break; sl@0: } sl@0: /* Update the acceptable point */ sl@0: nextCheckpoint = currentPathEndPosition - path; sl@0: } else if (cur == 0) { sl@0: /* Reached end of string */ sl@0: break; sl@0: } sl@0: currentPathEndPosition++; sl@0: } sl@0: /* sl@0: * We should really now convert this to a canonical path. We do sl@0: * that with 'realpath' if we have it available. Otherwise we could sl@0: * step through every single path component, checking whether it is a sl@0: * symlink, but that would be a lot of work, and most modern OSes sl@0: * have 'realpath'. sl@0: */ sl@0: #ifndef NO_REALPATH sl@0: if (haveRealpath) { sl@0: /* sl@0: * If we only had '/foo' or '/' then we never increment nextCheckpoint sl@0: * and we don't need or want to go through 'Realpath'. Also, on some sl@0: * platforms, passing an empty string to 'Realpath' will give us the sl@0: * normalized pwd, which is not what we want at all! sl@0: */ sl@0: if (nextCheckpoint == 0) return 0; sl@0: sl@0: nativePath = Tcl_UtfToExternalDString(NULL, path, nextCheckpoint, &ds); sl@0: sl@0: if (Realpath(nativePath, normPath) != NULL) { sl@0: int newNormLen; sl@0: wholeStringOk: sl@0: newNormLen = strlen(normPath); sl@0: if ((newNormLen == Tcl_DStringLength(&ds)) sl@0: && (strcmp(normPath, nativePath) == 0)) { sl@0: /* String is unchanged */ sl@0: Tcl_DStringFree(&ds); sl@0: if (path[nextCheckpoint] != '\0') { sl@0: nextCheckpoint++; sl@0: } sl@0: return nextCheckpoint; sl@0: } sl@0: sl@0: /* sl@0: * Free up the native path and put in its place the sl@0: * converted, normalized path. sl@0: */ sl@0: Tcl_DStringFree(&ds); sl@0: Tcl_ExternalToUtfDString(NULL, normPath, (int) newNormLen, &ds); sl@0: sl@0: if (path[nextCheckpoint] != '\0') { sl@0: /* not at end, append remaining path */ sl@0: int normLen = Tcl_DStringLength(&ds); sl@0: Tcl_DStringAppend(&ds, path + nextCheckpoint, sl@0: pathLen - nextCheckpoint); sl@0: /* sl@0: * We recognise up to and including the directory sl@0: * separator. sl@0: */ sl@0: nextCheckpoint = normLen + 1; sl@0: } else { sl@0: /* We recognise the whole string */ sl@0: nextCheckpoint = Tcl_DStringLength(&ds); sl@0: } sl@0: /* sl@0: * Overwrite with the normalized path. sl@0: */ sl@0: Tcl_SetStringObj(pathPtr, Tcl_DStringValue(&ds), sl@0: Tcl_DStringLength(&ds)); sl@0: } sl@0: Tcl_DStringFree(&ds); sl@0: } sl@0: #endif /* !NO_REALPATH */ sl@0: sl@0: return nextCheckpoint; sl@0: }