diff options
Diffstat (limited to 'unix/tclUnixFCmd.c')
| -rw-r--r-- | unix/tclUnixFCmd.c | 1247 |
1 files changed, 849 insertions, 398 deletions
diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c index a80df2c..3b1b6ca 100644 --- a/unix/tclUnixFCmd.c +++ b/unix/tclUnixFCmd.c @@ -2,7 +2,7 @@ * tclUnixFCmd.c * * This file implements the unix specific portion of file manipulation - * subcommands of the "file" command. All filename arguments should + * subcommands of the "file" command. All filename arguments should * already be translated to native format. * * Copyright (c) 1996-1998 Sun Microsystems, Inc. @@ -10,13 +10,11 @@ * 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.46 2005/10/07 22:35:33 hobbs 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. + * 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: @@ -25,11 +23,7 @@ * 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 + * 3. 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. * @@ -49,10 +43,13 @@ #include "tclInt.h" #include <utime.h> #include <grp.h> -#ifndef HAVE_ST_BLKSIZE +#ifndef HAVE_STRUCT_STAT_ST_BLKSIZE #ifndef NO_FSTATFS #include <sys/statfs.h> #endif +#endif /* !HAVE_STRUCT_STAT_ST_BLKSIZE */ +#ifdef HAVE_FTS +#include <fts.h> #endif /* @@ -60,51 +57,53 @@ * TraverseUnixTree() calls the traverseProc() */ -#define DOTREE_PRED 1 /* pre-order directory */ +#define DOTREE_PRED 1 /* pre-order directory */ #define DOTREE_POSTD 2 /* post-order directory */ #define DOTREE_F 3 /* regular file */ /* + * Fallback temporary file location the temporary file generation code. Can be + * overridden at compile time for when it is known that temp files can't be + * written to /tmp (hello, iOS!). + */ + +#ifndef TCL_TEMPORARY_FILE_DIRECTORY +#define TCL_TEMPORARY_FILE_DIRECTORY "/tmp" +#endif + +/* * 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, +static int GetGroupAttribute(Tcl_Interp *interp, int objIndex, + Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); +static int GetOwnerAttribute(Tcl_Interp *interp, int objIndex, + Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); +static int GetPermissionsAttribute(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)); -#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) -static int GetReadOnlyAttribute _ANSI_ARGS_((Tcl_Interp *interp, + Tcl_Obj **attributePtrPtr); +static int SetGroupAttribute(Tcl_Interp *interp, int objIndex, + Tcl_Obj *fileName, Tcl_Obj *attributePtr); +static int SetOwnerAttribute(Tcl_Interp *interp, int objIndex, + Tcl_Obj *fileName, Tcl_Obj *attributePtr); +static int SetPermissionsAttribute(Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, - Tcl_Obj **attributePtrPtr)); -static int SetReadOnlyAttribute _ANSI_ARGS_((Tcl_Interp *interp, - int objIndex, Tcl_Obj *fileName, - Tcl_Obj *attributePtr)); + Tcl_Obj *attributePtr); +static int GetModeFromPermString(Tcl_Interp *interp, + const char *modeStringPtr, mode_t *modePtr); +#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) || defined(__CYGWIN__) +static int GetUnixFileAttributes(Tcl_Interp *interp, int objIndex, + Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); +static int SetUnixFileAttributes(Tcl_Interp *interp, int objIndex, + Tcl_Obj *fileName, Tcl_Obj *attributePtr); #endif /* * 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)); +typedef int (TraversalProc)(Tcl_DString *srcPtr, Tcl_DString *dstPtr, + const Tcl_StatBuf *statBufPtr, int type, Tcl_DString *errorPtr); /* * Constants and variables necessary for file attributes subcommand. @@ -121,14 +120,24 @@ typedef int (TraversalProc) _ANSI_ARGS_((Tcl_DString *srcPtr, */ extern TclFileAttrProcs tclpFileAttrProcs[]; -extern char *tclpFileAttrStrings[]; +extern const char *const tclpFileAttrStrings[]; -#else +#else /* !DJGPP */ enum { - UNIX_GROUP_ATTRIBUTE, UNIX_OWNER_ATTRIBUTE, UNIX_PERMISSIONS_ATTRIBUTE, -#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) +#if defined(__CYGWIN__) + UNIX_ARCHIVE_ATTRIBUTE, +#endif + UNIX_GROUP_ATTRIBUTE, +#if defined(__CYGWIN__) + UNIX_HIDDEN_ATTRIBUTE, +#endif + UNIX_OWNER_ATTRIBUTE, UNIX_PERMISSIONS_ATTRIBUTE, +#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) || defined(__CYGWIN__) UNIX_READONLY_ATTRIBUTE, #endif +#if defined(__CYGWIN__) + UNIX_SYSTEM_ATTRIBUTE, +#endif #ifdef MAC_OSX_TCL MACOSX_CREATOR_ATTRIBUTE, MACOSX_TYPE_ATTRIBUTE, MACOSX_HIDDEN_ATTRIBUTE, MACOSX_RSRCLENGTH_ATTRIBUTE, @@ -136,23 +145,44 @@ enum { UNIX_INVALID_ATTRIBUTE /* lint - last enum value needs no trailing , */ }; -CONST char *tclpFileAttrStrings[] = { - "-group", "-owner", "-permissions", -#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) +MODULE_SCOPE const char *const tclpFileAttrStrings[]; +const char *const tclpFileAttrStrings[] = { +#if defined(__CYGWIN__) + "-archive", +#endif + "-group", +#if defined(__CYGWIN__) + "-hidden", +#endif + "-owner", "-permissions", +#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) || defined(__CYGWIN__) "-readonly", #endif +#if defined(__CYGWIN__) + "-system", +#endif #ifdef MAC_OSX_TCL "-creator", "-type", "-hidden", "-rsrclength", #endif - (char *) NULL + NULL }; -CONST TclFileAttrProcs tclpFileAttrProcs[] = { +MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[]; +const TclFileAttrProcs tclpFileAttrProcs[] = { +#if defined(__CYGWIN__) + {GetUnixFileAttributes, SetUnixFileAttributes}, +#endif {GetGroupAttribute, SetGroupAttribute}, +#if defined(__CYGWIN__) + {GetUnixFileAttributes, SetUnixFileAttributes}, +#endif {GetOwnerAttribute, SetOwnerAttribute}, {GetPermissionsAttribute, SetPermissionsAttribute}, -#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) - {GetReadOnlyAttribute, SetReadOnlyAttribute}, +#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) || defined(__CYGWIN__) + {GetUnixFileAttributes, SetUnixFileAttributes}, +#endif +#if defined(__CYGWIN__) + {GetUnixFileAttributes, SetUnixFileAttributes}, #endif #ifdef MAC_OSX_TCL {TclMacOSXGetFileAttribute, TclMacOSXSetFileAttribute}, @@ -161,46 +191,47 @@ CONST TclFileAttrProcs tclpFileAttrProcs[] = { {TclMacOSXGetFileAttribute, TclMacOSXSetFileAttribute}, #endif }; -#endif +#endif /* DJGPP */ /* * 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 172, so 150 is chosen to be conservative. We + * 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 + * 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 150 +#define MAX_READDIR_UNLINK_THRESHOLD 130 /* * Declarations for local procedures defined in this file: */ -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)); -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, +static int CopyFileAtts(const char *src, + const char *dst, const Tcl_StatBuf *statBufPtr); +static const char * DefaultTempDir(void); +static int DoCopyFile(const char *srcPtr, const char *dstPtr, + const Tcl_StatBuf *statBufPtr); +static int DoCreateDirectory(const char *pathPtr); +static int DoRemoveDirectory(Tcl_DString *pathPtr, + int recursive, Tcl_DString *errorPtr); +static int DoRenameFile(const char *src, const char *dst); +static int TraversalCopy(Tcl_DString *srcPtr, + Tcl_DString *dstPtr, + const Tcl_StatBuf *statBufPtr, int type, + Tcl_DString *errorPtr); +static int TraversalDelete(Tcl_DString *srcPtr, + Tcl_DString *dstPtr, + const Tcl_StatBuf *statBufPtr, int type, + Tcl_DString *errorPtr); +static int TraverseUnixTree(TraversalProc *traversalProc, Tcl_DString *sourcePtr, Tcl_DString *destPtr, - Tcl_DString *errorPtr, int doRewind)); + Tcl_DString *errorPtr, int doRewind); #ifdef PURIFY /* @@ -210,28 +241,64 @@ static int TraverseUnixTree _ANSI_ARGS_(( * passing the standard MAXPATHLEN size resolved arg. */ -static char * Realpath _ANSI_ARGS_((CONST char *path, - char *resolved)); +static char * Realpath(const char *path, char *resolved); char * -Realpath(path, resolved) - CONST char *path; - char *resolved; +Realpath( + const char *path, + char *resolved) { memset(resolved, 0, MAXPATHLEN); return realpath(path, resolved); } #else -#define Realpath realpath +# define Realpath realpath +#endif /* PURIFY */ + +#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 thread-safe, c.f. Bug 711232; if we + * might potentially be running on pre-10.3 OSX, check Darwin release at + * runtime before using realpath. + */ + +MODULE_SCOPE long tclMacOSXDarwinRelease; +# define haveRealpath (tclMacOSXDarwinRelease >= 7) +#else +# define haveRealpath 1 #endif +#endif /* NO_REALPATH */ + +#ifdef HAVE_FTS +#if defined(HAVE_STRUCT_STAT64) && !defined(__APPLE__) +/* 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. + */ + +MODULE_SCOPE 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 + * 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. @@ -239,7 +306,7 @@ Realpath(path, resolved) * In any other situation where dst already exists, the rename will fail. * * Results: - * If the directory was successfully created, returns TCL_OK. Otherwise + * 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: * @@ -260,19 +327,19 @@ Realpath(path, resolved) */ int -TclpObjRenameFile(srcPathPtr, destPathPtr) - Tcl_Obj *srcPathPtr; - Tcl_Obj *destPathPtr; +TclpObjRenameFile( + 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 +DoRenameFile( + const char *src, /* Pathname of file or dir to be renamed * (native). */ - CONST char *dst; /* New pathname of file or directory + const char *dst) /* New pathname of file or directory * (native). */ { if (rename(src, dst) == 0) { /* INTL: Native. */ @@ -300,7 +367,7 @@ DoRenameFile(src, dst) * compiled because realpath() not defined on all systems. */ - if (errno == EINVAL) { + if (errno == EINVAL && haveRealpath) { char srcPath[MAXPATHLEN], dstPath[MAXPATHLEN]; DIR *dirPtr; Tcl_DirEntry *dirEntPtr; @@ -358,12 +425,12 @@ DoRenameFile(src, dst) * * 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: + * 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 "". + * ENOENT: src doesn't exist. src or dst is "". * * Side effects: * This procedure will also copy symbolic links, block, and character @@ -376,35 +443,36 @@ DoRenameFile(src, dst) */ int -TclpObjCopyFile(srcPathPtr, destPathPtr) - Tcl_Obj *srcPathPtr; - Tcl_Obj *destPathPtr; +TclpObjCopyFile( + Tcl_Obj *srcPathPtr, + Tcl_Obj *destPathPtr) { - return DoCopyFile(Tcl_FSGetNativePath(srcPathPtr), - Tcl_FSGetNativePath(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) - CONST char *src; /* Pathname of file to be copied (native). */ - CONST char *dst; /* Pathname of file to copy to (native). */ +DoCopyFile( + 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 srcStatBuf, dstStatBuf; + Tcl_StatBuf dstStatBuf; - /* - * Have to do a stat() to determine the filetype. - */ - - if (TclOSlstat(src, &srcStatBuf) != 0) { /* INTL: Native. */ - return TCL_ERROR; - } - if (S_ISDIR(srcStatBuf.st_mode)) { + 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 + * Symlink, and some of the other calls will fail if the target exists, so * we remove it first. */ @@ -420,37 +488,41 @@ DoCopyFile(src, dst) } } - switch ((int) (srcStatBuf.st_mode & S_IFMT)) { + switch ((int) (statBufPtr->st_mode & S_IFMT)) { #ifndef DJGPP case S_IFLNK: { - char link[MAXPATHLEN]; + char linkBuf[MAXPATHLEN+1]; int length; - length = readlink(src, link, sizeof(link)); /* INTL: Native. */ + length = readlink(src, linkBuf, MAXPATHLEN); + /* INTL: Native. */ if (length == -1) { return TCL_ERROR; } - link[length] = '\0'; - if (symlink(link, dst) < 0) { /* INTL: Native. */ + linkBuf[length] = '\0'; + if (symlink(linkBuf, dst) < 0) { /* INTL: Native. */ return TCL_ERROR; } +#ifdef MAC_OSX_TCL + TclMacOSXCopyFileAttributes(src, dst, statBufPtr); +#endif break; } -#endif +#endif /* !DJGPP */ case S_IFBLK: case S_IFCHR: - if (mknod(dst, srcStatBuf.st_mode, /* INTL: Native. */ - srcStatBuf.st_rdev) < 0) { + if (mknod(dst, statBufPtr->st_mode, /* INTL: Native. */ + statBufPtr->st_rdev) < 0) { return TCL_ERROR; } - return CopyFileAtts(src, dst, &srcStatBuf); + return CopyFileAtts(src, dst, statBufPtr); case S_IFIFO: - if (mkfifo(dst, srcStatBuf.st_mode) < 0) { /* INTL: Native. */ + if (mkfifo(dst, statBufPtr->st_mode) < 0) { /* INTL: Native. */ return TCL_ERROR; } - return CopyFileAtts(src, dst, &srcStatBuf); + return CopyFileAtts(src, dst, statBufPtr); default: - return TclUnixCopyFile(src, dst, &srcStatBuf, 0); + return TclUnixCopyFile(src, dst, statBufPtr, 0); } return TCL_OK; } @@ -467,19 +539,19 @@ DoCopyFile(src, dst) * A standard Tcl result. * * Side effects: - * A file is copied. Dst will be overwritten if it exists. + * A file is copied. Dst will be overwritten if it exists. * *---------------------------------------------------------------------- */ int -TclUnixCopyFile(src, dst, statBufPtr, dontCopyAtts) - CONST char *src; /* Pathname of file to copy (native). */ - CONST char *dst; /* Pathname of file to create/overwrite +TclUnixCopyFile( + const char *src, /* Pathname of file to copy (native). */ + const char *dst, /* Pathname of file to create/overwrite * (native). */ - CONST Tcl_StatBuf *statBufPtr; + const Tcl_StatBuf *statBufPtr, /* Used to determine mode and blocksize. */ - int dontCopyAtts; /* If flag set, don't copy attributes. */ + int dontCopyAtts) /* If flag set, don't copy attributes. */ { int srcFd, dstFd; unsigned blockSize; /* Optimal I/O blocksize for filesystem */ @@ -490,7 +562,9 @@ TclUnixCopyFile(src, dst, statBufPtr, dontCopyAtts) #define BINMODE |O_BINARY #else #define BINMODE -#endif +#endif /* DJGPP */ + +#define DEFAULT_COPY_BLOCK_SIZE 4069 if ((srcFd = TclOSopen(src, O_RDONLY BINMODE, 0)) < 0) { /* INTL: Native */ return TCL_ERROR; @@ -509,31 +583,40 @@ TclUnixCopyFile(src, dst, statBufPtr, dontCopyAtts) * that's likely to be fairly efficient anyway. */ -#ifdef HAVE_ST_BLKSIZE +#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE blockSize = statBufPtr->st_blksize; -#else -#ifndef NO_FSTATFS +#elif !defined(NO_FSTATFS) { struct statfs fs; - if (fstatfs(srcFd, &fs, sizeof(fs), 0) == 0) { + if (fstatfs(srcFd, &fs) == 0) { blockSize = fs.f_bsize; } else { - blockSize = 4096; + blockSize = DEFAULT_COPY_BLOCK_SIZE; } } #else - blockSize = 4096; -#endif -#endif + blockSize = DEFAULT_COPY_BLOCK_SIZE; +#endif /* HAVE_STRUCT_STAT_ST_BLKSIZE */ + /* + * [SF Tcl Bug 1586470] Even if we HAVE_STRUCT_STAT_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 = DEFAULT_COPY_BLOCK_SIZE; + } buffer = ckalloc(blockSize); while (1) { - nread = read(srcFd, buffer, blockSize); - if ((nread == -1) || (nread == 0)) { + nread = (size_t) read(srcFd, buffer, blockSize); + if ((nread == (size_t) -1) || (nread == 0)) { break; } - if (write(dstFd, buffer, nread) != nread) { + if ((size_t) write(dstFd, buffer, nread) != nread) { nread = (size_t) -1; break; } @@ -541,7 +624,7 @@ TclUnixCopyFile(src, dst, statBufPtr, dontCopyAtts) ckfree(buffer); close(srcFd); - if ((close(dstFd) != 0) || (nread == -1)) { + if ((close(dstFd) != 0) || (nread == (size_t) -1)) { unlink(dst); /* INTL: Native. */ return TCL_ERROR; } @@ -566,8 +649,8 @@ TclUnixCopyFile(src, dst, statBufPtr, dontCopyAtts) * * 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: + * 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. @@ -580,17 +663,17 @@ TclUnixCopyFile(src, dst, statBufPtr, dontCopyAtts) */ int -TclpObjDeleteFile(pathPtr) - Tcl_Obj *pathPtr; +TclpObjDeleteFile( + Tcl_Obj *pathPtr) { return TclpDeleteFile(Tcl_FSGetNativePath(pathPtr)); } int -TclpDeleteFile(path) - CONST char *path; /* Pathname of file to be removed (native). */ +TclpDeleteFile( + const void *path) /* Pathname of file to be removed (native). */ { - if (unlink(path) != 0) { /* INTL: Native. */ + if (unlink((const char *)path) != 0) { return TCL_ERROR; } return TCL_OK; @@ -623,15 +706,15 @@ TclpDeleteFile(path) */ int -TclpObjCreateDirectory(pathPtr) - Tcl_Obj *pathPtr; +TclpObjCreateDirectory( + Tcl_Obj *pathPtr) { return DoCreateDirectory(Tcl_FSGetNativePath(pathPtr)); } static int -DoCreateDirectory(path) - CONST char *path; /* Pathname of directory to create (native). */ +DoCreateDirectory( + const char *path) /* Pathname of directory to create (native). */ { mode_t mode; @@ -675,10 +758,10 @@ DoCreateDirectory(path) */ int -TclpObjCopyDirectory(srcPathPtr, destPathPtr, errorPtr) - Tcl_Obj *srcPathPtr; - Tcl_Obj *destPathPtr; - Tcl_Obj **errorPtr; +TclpObjCopyDirectory( + Tcl_Obj *srcPathPtr, + Tcl_Obj *destPathPtr, + Tcl_Obj **errorPtr) { Tcl_DString ds; Tcl_DString srcString, dstString; @@ -687,14 +770,14 @@ TclpObjCopyDirectory(srcPathPtr, destPathPtr, errorPtr) transPtr = Tcl_FSGetTranslatedPath(NULL,srcPathPtr); Tcl_UtfToExternalDString(NULL, - (transPtr != NULL ? Tcl_GetString(transPtr) : NULL), + (transPtr != NULL ? TclGetString(transPtr) : NULL), -1, &srcString); if (transPtr != NULL) { Tcl_DecrRefCount(transPtr); } transPtr = Tcl_FSGetTranslatedPath(NULL,destPathPtr); Tcl_UtfToExternalDString(NULL, - (transPtr != NULL ? Tcl_GetString(transPtr) : NULL), + (transPtr != NULL ? TclGetString(transPtr) : NULL), -1, &dstString); if (transPtr != NULL) { Tcl_DecrRefCount(transPtr); @@ -712,7 +795,6 @@ TclpObjCopyDirectory(srcPathPtr, destPathPtr, errorPtr) } return ret; } - /* *--------------------------------------------------------------------------- @@ -741,10 +823,10 @@ TclpObjCopyDirectory(srcPathPtr, destPathPtr, errorPtr) */ int -TclpObjRemoveDirectory(pathPtr, recursive, errorPtr) - Tcl_Obj *pathPtr; - int recursive; - Tcl_Obj **errorPtr; +TclpObjRemoveDirectory( + Tcl_Obj *pathPtr, + int recursive, + Tcl_Obj **errorPtr) { Tcl_DString ds; Tcl_DString pathString; @@ -752,7 +834,7 @@ TclpObjRemoveDirectory(pathPtr, recursive, errorPtr) Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr); Tcl_UtfToExternalDString(NULL, - (transPtr != NULL ? Tcl_GetString(transPtr) : NULL), + (transPtr != NULL ? TclGetString(transPtr) : NULL), -1, &pathString); if (transPtr != NULL) { Tcl_DecrRefCount(transPtr); @@ -769,17 +851,17 @@ TclpObjRemoveDirectory(pathPtr, recursive, errorPtr) } static int -DoRemoveDirectory(pathPtr, recursive, errorPtr) - Tcl_DString *pathPtr; /* Pathname of directory to be removed +DoRemoveDirectory( + Tcl_DString *pathPtr, /* Pathname of directory to be removed * (native). */ - int recursive; /* If non-zero, removes directories that are + 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 + Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free DString * filled with UTF-8 name of file causing * error. */ { - CONST char *path; + const char *path; mode_t oldPerm = 0; int result; @@ -858,17 +940,17 @@ DoRemoveDirectory(pathPtr, recursive, errorPtr) */ static int -TraverseUnixTree(traverseProc, sourcePtr, targetPtr, errorPtr, doRewind) - TraversalProc *traverseProc;/* Function to call for every file and +TraverseUnixTree( + TraversalProc *traverseProc,/* Function to call for every file and * directory in source hierarchy. */ - Tcl_DString *sourcePtr; /* Pathname of source directory to be + Tcl_DString *sourcePtr, /* Pathname of source directory to be * traversed (native). */ - Tcl_DString *targetPtr; /* Pathname of directory to traverse in + Tcl_DString *targetPtr, /* Pathname of directory to traverse in * parallel with source directory (native). */ - Tcl_DString *errorPtr; /* If non-NULL, uninitialized or free DString + 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 + 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 @@ -877,12 +959,18 @@ TraverseUnixTree(traverseProc, sourcePtr, targetPtr, errorPtr, doRewind) * files. */ { Tcl_StatBuf statBuf; - CONST char *source, *errfile; + 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; @@ -898,9 +986,10 @@ TraverseUnixTree(traverseProc, sourcePtr, targetPtr, errorPtr, doRewind) * Process the regular file */ - return (*traverseProc)(sourcePtr, targetPtr, &statBuf, DOTREE_F, + return traverseProc(sourcePtr, targetPtr, &statBuf, DOTREE_F, errorPtr); } +#ifndef HAVE_FTS dirPtr = opendir(source); /* INTL: Native. */ if (dirPtr == NULL) { /* @@ -910,18 +999,18 @@ TraverseUnixTree(traverseProc, sourcePtr, targetPtr, errorPtr, doRewind) errfile = source; goto end; } - result = (*traverseProc)(sourcePtr, targetPtr, &statBuf, DOTREE_PRED, + result = traverseProc(sourcePtr, targetPtr, &statBuf, DOTREE_PRED, errorPtr); if (result != TCL_OK) { closedir(dirPtr); return result; } - Tcl_DStringAppend(sourcePtr, "/", 1); + TclDStringAppendLiteral(sourcePtr, "/"); sourceLen = Tcl_DStringLength(sourcePtr); if (targetPtr != NULL) { - Tcl_DStringAppend(targetPtr, "/", 1); + TclDStringAppendLiteral(targetPtr, "/"); targetLen = Tcl_DStringLength(targetPtr); } @@ -959,9 +1048,10 @@ TraverseUnixTree(traverseProc, sourcePtr, targetPtr, errorPtr, doRewind) 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. + * (since the opendir or the previous rewinddir), to avoid a + * NULL-return that may a symptom of a buggy readdir. */ + rewinddir(dirPtr); numProcessed = 0; } @@ -983,9 +1073,71 @@ TraverseUnixTree(traverseProc, sourcePtr, targetPtr, errorPtr, doRewind) * that directory. */ - result = (*traverseProc)(sourcePtr, targetPtr, &statBuf, DOTREE_POSTD, + result = traverseProc(sourcePtr, targetPtr, &statBuf, DOTREE_POSTD, errorPtr); } +#else /* HAVE_FTS */ + paths[0] = source; + fts = fts_open((char **) paths, FTS_PHYSICAL | FTS_NOCHDIR | + (noFtsStat || doRewind ? FTS_NOSTAT : 0), NULL); + if (fts == NULL) { + errfile = source; + goto end; + } + + sourceLen = Tcl_DStringLength(sourcePtr); + if (targetPtr != NULL) { + targetLen = Tcl_DStringLength(targetPtr); + } + + while ((ent = fts_read(fts)) != NULL) { + unsigned short info = ent->fts_info; + char *path = ent->fts_path + sourceLen; + unsigned short pathlen = ent->fts_pathlen - sourceLen; + int type; + Tcl_StatBuf *statBufPtr = NULL; + + if (info == FTS_DNR || info == FTS_ERR || info == FTS_NS) { + errfile = ent->fts_path; + break; + } + Tcl_DStringAppend(sourcePtr, path, pathlen); + if (targetPtr != NULL) { + Tcl_DStringAppend(targetPtr, path, pathlen); + } + switch (info) { + case FTS_D: + type = DOTREE_PRED; + break; + case FTS_DP: + type = DOTREE_POSTD; + break; + default: + type = DOTREE_F; + break; + } + if (!doRewind) { /* no need to stat for delete */ + if (noFtsStat) { + statBufPtr = &statBuf; + if (TclOSlstat(ent->fts_path, statBufPtr) != 0) { + errfile = ent->fts_path; + break; + } + } else { + statBufPtr = (Tcl_StatBuf *) ent->fts_statp; + } + } + result = traverseProc(sourcePtr, targetPtr, statBufPtr, type, + errorPtr); + if (result != TCL_OK) { + break; + } + Tcl_DStringSetLength(sourcePtr, sourceLen); + if (targetPtr != NULL) { + Tcl_DStringSetLength(targetPtr, targetLen); + } + } +#endif /* !HAVE_FTS */ end: if (errfile != NULL) { @@ -994,6 +1146,11 @@ TraverseUnixTree(traverseProc, sourcePtr, targetPtr, errorPtr, doRewind) } result = TCL_ERROR; } +#ifdef HAVE_FTS + if (fts != NULL) { + fts_close(fts); + } +#endif return result; } @@ -1017,20 +1174,20 @@ TraverseUnixTree(traverseProc, sourcePtr, targetPtr, errorPtr, doRewind) */ static int -TraversalCopy(srcPtr, dstPtr, statBufPtr, type, errorPtr) - Tcl_DString *srcPtr; /* Source pathname to copy (native). */ - Tcl_DString *dstPtr; /* Destination pathname of copy (native). */ - CONST Tcl_StatBuf *statBufPtr; +TraversalCopy( + Tcl_DString *srcPtr, /* Source pathname to copy (native). */ + Tcl_DString *dstPtr, /* Destination pathname of copy (native). */ + const Tcl_StatBuf *statBufPtr, /* Stat info for file specified by srcPtr. */ - int type; /* Reason for call - see TraverseUnixTree(). */ - Tcl_DString *errorPtr; /* If non-NULL, uninitialized or free DString + int type, /* Reason for call - see TraverseUnixTree(). */ + Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free DString * filled with UTF-8 name of file causing * error. */ { switch (type) { case DOTREE_F: - if (DoCopyFile(Tcl_DStringValue(srcPtr), - Tcl_DStringValue(dstPtr)) == TCL_OK) { + if (DoCopyFile(Tcl_DStringValue(srcPtr), Tcl_DStringValue(dstPtr), + statBufPtr) == TCL_OK) { return TCL_OK; } break; @@ -1081,13 +1238,13 @@ TraversalCopy(srcPtr, dstPtr, statBufPtr, type, errorPtr) */ static int -TraversalDelete(srcPtr, ignore, statBufPtr, type, errorPtr) - Tcl_DString *srcPtr; /* Source pathname (native). */ - Tcl_DString *ignore; /* Destination pathname (not used). */ - CONST Tcl_StatBuf *statBufPtr; +TraversalDelete( + Tcl_DString *srcPtr, /* Source pathname (native). */ + Tcl_DString *ignore, /* Destination pathname (not used). */ + const Tcl_StatBuf *statBufPtr, /* Stat info for file specified by srcPtr. */ - int type; /* Reason for call - see TraverseUnixTree(). */ - Tcl_DString *errorPtr; /* If non-NULL, uninitialized or free DString + int type, /* Reason for call - see TraverseUnixTree(). */ + Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free DString * filled with UTF-8 name of file causing * error. */ { @@ -1131,10 +1288,10 @@ TraversalDelete(srcPtr, ignore, statBufPtr, type, errorPtr) */ static int -CopyFileAtts(src, dst, statBufPtr) - CONST char *src; /* Path name of source file (native). */ - CONST char *dst; /* Path name of target file (native). */ - CONST Tcl_StatBuf *statBufPtr; +CopyFileAtts( + const char *src, /* Path name of source file (native). */ + const char *dst, /* Path name of target file (native). */ + const Tcl_StatBuf *statBufPtr) /* Stat info for source file */ { struct utimbuf tval; @@ -1169,7 +1326,6 @@ CopyFileAtts(src, dst, statBufPtr) #endif return TCL_OK; } - /* *---------------------------------------------------------------------- @@ -1189,11 +1345,11 @@ CopyFileAtts(src, dst, statBufPtr) */ static int -GetGroupAttribute(interp, objIndex, fileName, attributePtrPtr) - Tcl_Interp *interp; /* The interp we are using for errors. */ - int objIndex; /* The index of the attribute. */ - Tcl_Obj *fileName; /* The name of the file (UTF-8). */ - Tcl_Obj **attributePtrPtr; /* A pointer to return the object with. */ +GetGroupAttribute( + Tcl_Interp *interp, /* The interp we are using for errors. */ + int objIndex, /* The index of the attribute. */ + Tcl_Obj *fileName, /* The name of the file (UTF-8). */ + Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ { Tcl_StatBuf statBuf; struct group *groupPtr; @@ -1203,25 +1359,25 @@ GetGroupAttribute(interp, objIndex, fileName, attributePtrPtr) if (result != 0) { if (interp != NULL) { - Tcl_AppendResult(interp, "could not read \"", - Tcl_GetString(fileName), "\": ", - Tcl_PosixError(interp), (char *) NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "could not read \"%s\": %s", + TclGetString(fileName), Tcl_PosixError(interp))); } return TCL_ERROR; } - groupPtr = getgrgid(statBuf.st_gid); /* INTL: Native. */ + groupPtr = TclpGetGrGid(statBuf.st_gid); + if (groupPtr == NULL) { *attributePtrPtr = Tcl_NewIntObj((int) statBuf.st_gid); } else { Tcl_DString ds; - CONST char *utf; + const char *utf; utf = Tcl_ExternalToUtfDString(NULL, groupPtr->gr_name, -1, &ds); *attributePtrPtr = Tcl_NewStringObj(utf, -1); Tcl_DStringFree(&ds); } - endgrent(); return TCL_OK; } @@ -1243,11 +1399,11 @@ GetGroupAttribute(interp, objIndex, fileName, attributePtrPtr) */ static int -GetOwnerAttribute(interp, objIndex, fileName, attributePtrPtr) - Tcl_Interp *interp; /* The interp we are using for errors. */ - int objIndex; /* The index of the attribute. */ - Tcl_Obj *fileName; /* The name of the file (UTF-8). */ - Tcl_Obj **attributePtrPtr; /* A pointer to return the object with. */ +GetOwnerAttribute( + Tcl_Interp *interp, /* The interp we are using for errors. */ + int objIndex, /* The index of the attribute. */ + Tcl_Obj *fileName, /* The name of the file (UTF-8). */ + Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ { Tcl_StatBuf statBuf; struct passwd *pwPtr; @@ -1257,25 +1413,23 @@ GetOwnerAttribute(interp, objIndex, fileName, attributePtrPtr) if (result != 0) { if (interp != NULL) { - Tcl_AppendResult(interp, "could not read \"", - Tcl_GetString(fileName), "\": ", - Tcl_PosixError(interp), (char *) NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "could not read \"%s\": %s", + TclGetString(fileName), Tcl_PosixError(interp))); } return TCL_ERROR; } - pwPtr = getpwuid(statBuf.st_uid); /* INTL: Native. */ + pwPtr = TclpGetPwUid(statBuf.st_uid); + if (pwPtr == NULL) { *attributePtrPtr = Tcl_NewIntObj((int) statBuf.st_uid); } else { Tcl_DString ds; - CONST char *utf; - utf = Tcl_ExternalToUtfDString(NULL, pwPtr->pw_name, -1, &ds); - *attributePtrPtr = Tcl_NewStringObj(utf, Tcl_DStringLength(&ds)); - Tcl_DStringFree(&ds); + (void) Tcl_ExternalToUtfDString(NULL, pwPtr->pw_name, -1, &ds); + *attributePtrPtr = TclDStringToObj(&ds); } - endpwent(); return TCL_OK; } @@ -1297,11 +1451,11 @@ GetOwnerAttribute(interp, objIndex, fileName, attributePtrPtr) */ static int -GetPermissionsAttribute(interp, objIndex, fileName, attributePtrPtr) - Tcl_Interp *interp; /* The interp we are using for errors. */ - int objIndex; /* The index of the attribute. */ - Tcl_Obj *fileName; /* The name of the file (UTF-8). */ - Tcl_Obj **attributePtrPtr; /* A pointer to return the object with. */ +GetPermissionsAttribute( + Tcl_Interp *interp, /* The interp we are using for errors. */ + int objIndex, /* The index of the attribute. */ + Tcl_Obj *fileName, /* The name of the file (UTF-8). */ + Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ { Tcl_StatBuf statBuf; int result; @@ -1310,17 +1464,15 @@ GetPermissionsAttribute(interp, objIndex, fileName, attributePtrPtr) if (result != 0) { if (interp != NULL) { - Tcl_AppendResult(interp, "could not read \"", - Tcl_GetString(fileName), "\": ", - Tcl_PosixError(interp), (char *) NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "could not read \"%s\": %s", + TclGetString(fileName), Tcl_PosixError(interp))); } return TCL_ERROR; } - *attributePtrPtr = Tcl_NewObj(); - TclObjPrintf(NULL, *attributePtrPtr, "%0#5lo", - (long) (statBuf.st_mode & 0x00007FFF)); - + *attributePtrPtr = Tcl_ObjPrintf( + "%0#5lo", (long) (statBuf.st_mode & 0x00007FFF)); return TCL_OK; } @@ -1341,35 +1493,36 @@ GetPermissionsAttribute(interp, objIndex, fileName, attributePtrPtr) */ static int -SetGroupAttribute(interp, objIndex, fileName, attributePtr) - Tcl_Interp *interp; /* The interp for error reporting. */ - int objIndex; /* The index of the attribute. */ - Tcl_Obj *fileName; /* The name of the file (UTF-8). */ - Tcl_Obj *attributePtr; /* New group for file. */ +SetGroupAttribute( + Tcl_Interp *interp, /* The interp for error reporting. */ + int objIndex, /* The index of the attribute. */ + Tcl_Obj *fileName, /* The name of the file (UTF-8). */ + Tcl_Obj *attributePtr) /* New group for file. */ { long gid; int result; - CONST char *native; + const char *native; if (Tcl_GetLongFromObj(NULL, attributePtr, &gid) != TCL_OK) { Tcl_DString ds; - struct group *groupPtr; - CONST char *string; + struct group *groupPtr = NULL; + const char *string; int length; string = Tcl_GetStringFromObj(attributePtr, &length); native = Tcl_UtfToExternalDString(NULL, string, length, &ds); - groupPtr = getgrnam(native); /* INTL: Native. */ + groupPtr = TclpGetGrNam(native); /* INTL: Native. */ Tcl_DStringFree(&ds); if (groupPtr == NULL) { - endgrent(); if (interp != NULL) { - Tcl_AppendResult(interp, "could not set group for file \"", - Tcl_GetString(fileName), "\": group \"", - string, "\" does not exist", - (char *) NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "could not set group for file \"%s\":" + " group \"%s\" does not exist", + TclGetString(fileName), string)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SETGRP", + "NO_GROUP", NULL); } return TCL_ERROR; } @@ -1379,12 +1532,11 @@ SetGroupAttribute(interp, objIndex, fileName, attributePtr) native = Tcl_FSGetNativePath(fileName); result = chown(native, (uid_t) -1, (gid_t) gid); /* INTL: Native. */ - endgrent(); if (result != 0) { if (interp != NULL) { - Tcl_AppendResult(interp, "could not set group for file \"", - Tcl_GetString(fileName), "\": ", Tcl_PosixError(interp), - (char *) NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "could not set group for file \"%s\": %s", + TclGetString(fileName), Tcl_PosixError(interp))); } return TCL_ERROR; } @@ -1408,33 +1560,36 @@ SetGroupAttribute(interp, objIndex, fileName, attributePtr) */ static int -SetOwnerAttribute(interp, objIndex, fileName, attributePtr) - Tcl_Interp *interp; /* The interp for error reporting. */ - int objIndex; /* The index of the attribute. */ - Tcl_Obj *fileName; /* The name of the file (UTF-8). */ - Tcl_Obj *attributePtr; /* New owner for file. */ +SetOwnerAttribute( + Tcl_Interp *interp, /* The interp for error reporting. */ + int objIndex, /* The index of the attribute. */ + Tcl_Obj *fileName, /* The name of the file (UTF-8). */ + Tcl_Obj *attributePtr) /* New owner for file. */ { long uid; int result; - CONST char *native; + const char *native; if (Tcl_GetLongFromObj(NULL, attributePtr, &uid) != TCL_OK) { Tcl_DString ds; - struct passwd *pwPtr; - CONST char *string; + struct passwd *pwPtr = NULL; + const char *string; int length; string = Tcl_GetStringFromObj(attributePtr, &length); native = Tcl_UtfToExternalDString(NULL, string, length, &ds); - pwPtr = getpwnam(native); /* INTL: Native. */ + pwPtr = TclpGetPwNam(native); /* INTL: Native. */ Tcl_DStringFree(&ds); if (pwPtr == NULL) { if (interp != NULL) { - Tcl_AppendResult(interp, "could not set owner for file \"", - Tcl_GetString(fileName), "\": user \"", string, - "\" does not exist", (char *) NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "could not set owner for file \"%s\":" + " user \"%s\" does not exist", + TclGetString(fileName), string)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SETOWN", + "NO_USER", NULL); } return TCL_ERROR; } @@ -1442,13 +1597,13 @@ SetOwnerAttribute(interp, objIndex, fileName, attributePtr) } native = Tcl_FSGetNativePath(fileName); - result = chown(native, (uid_t) uid, (gid_t) -1); /* INTL: Native. */ + result = chown(native, (uid_t) uid, (gid_t) -1); /* INTL: Native. */ if (result != 0) { if (interp != NULL) { - Tcl_AppendResult(interp, "could not set owner for file \"", - Tcl_GetString(fileName), "\": ", Tcl_PosixError(interp), - (char *) NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "could not set owner for file \"%s\": %s", + TclGetString(fileName), Tcl_PosixError(interp))); } return TCL_ERROR; } @@ -1472,26 +1627,39 @@ SetOwnerAttribute(interp, objIndex, fileName, attributePtr) */ static int -SetPermissionsAttribute(interp, objIndex, fileName, attributePtr) - Tcl_Interp *interp; /* The interp we are using for errors. */ - int objIndex; /* The index of the attribute. */ - Tcl_Obj *fileName; /* The name of the file (UTF-8). */ - Tcl_Obj *attributePtr; /* The attribute to set. */ +SetPermissionsAttribute( + Tcl_Interp *interp, /* The interp we are using for errors. */ + int objIndex, /* The index of the attribute. */ + Tcl_Obj *fileName, /* The name of the file (UTF-8). */ + Tcl_Obj *attributePtr) /* The attribute to set. */ { long mode; mode_t newMode; - int result; - CONST char *native; + int result = TCL_ERROR; + const char *native; + const char *modeStringPtr = TclGetString(attributePtr); + int scanned = TclParseAllWhiteSpace(modeStringPtr, -1); /* - * First try if the string is a number + * First supply support for octal number format */ - if (Tcl_GetLongFromObj(NULL, attributePtr, &mode) == TCL_OK) { + if ((modeStringPtr[scanned] == '0') + && (modeStringPtr[scanned+1] >= '0') + && (modeStringPtr[scanned+1] <= '7')) { + /* Leading zero - attempt octal interpretation */ + Tcl_Obj *modeObj; + + TclNewLiteralStringObj(modeObj, "0o"); + Tcl_AppendToObj(modeObj, modeStringPtr+scanned+1, -1); + result = Tcl_GetLongFromObj(NULL, modeObj, &mode); + Tcl_DecrRefCount(modeObj); + } + if (result == TCL_OK + || Tcl_GetLongFromObj(NULL, attributePtr, &mode) == TCL_OK) { newMode = (mode_t) (mode & 0x00007FFF); } else { Tcl_StatBuf buf; - char *modeStringPtr = Tcl_GetString(attributePtr); /* * Try the forms "rwxrwxrwx" and "ugo=rwx" @@ -1503,9 +1671,9 @@ SetPermissionsAttribute(interp, objIndex, fileName, attributePtr) result = TclpObjStat(fileName, &buf); if (result != 0) { if (interp != NULL) { - Tcl_AppendResult(interp, "could not read \"", - Tcl_GetString(fileName), "\": ", - Tcl_PosixError(interp), (char *) NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "could not read \"%s\": %s", + TclGetString(fileName), Tcl_PosixError(interp))); } return TCL_ERROR; } @@ -1513,8 +1681,10 @@ SetPermissionsAttribute(interp, objIndex, fileName, attributePtr) if (GetModeFromPermString(NULL, modeStringPtr, &newMode) != TCL_OK) { if (interp != NULL) { - Tcl_AppendResult(interp, "unknown permission string format \"", - modeStringPtr, "\"", (char *) NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown permission string format \"%s\"", + modeStringPtr)); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "PERMISSION", NULL); } return TCL_ERROR; } @@ -1524,9 +1694,9 @@ SetPermissionsAttribute(interp, objIndex, fileName, attributePtr) result = chmod(native, newMode); /* INTL: Native. */ if (result != 0) { if (interp != NULL) { - Tcl_AppendResult(interp, "could not set permissions for file \"", - Tcl_GetString(fileName), "\": ", - Tcl_PosixError(interp), (char *) NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "could not set permissions for file \"%s\": %s", + TclGetString(fileName), Tcl_PosixError(interp))); } return TCL_ERROR; } @@ -1550,10 +1720,11 @@ SetPermissionsAttribute(interp, objIndex, fileName, attributePtr) *--------------------------------------------------------------------------- */ -Tcl_Obj* +Tcl_Obj * TclpObjListVolumes(void) { - Tcl_Obj *resultPtr = Tcl_NewStringObj("/",1); + Tcl_Obj *resultPtr; + TclNewLiteralStringObj(resultPtr, "/"); Tcl_IncrRefCount(resultPtr); return resultPtr; @@ -1579,10 +1750,10 @@ TclpObjListVolumes(void) */ static int -GetModeFromPermString(interp, modeStringPtr, modePtr) - Tcl_Interp *interp; /* The interp we are using for errors. */ - char *modeStringPtr; /* Permissions string */ - mode_t *modePtr; /* pointer to the mode value */ +GetModeFromPermString( + Tcl_Interp *interp, /* The interp we are using for errors. */ + const char *modeStringPtr, /* Permissions string */ + mode_t *modePtr) /* pointer to the mode value */ { mode_t newMode; mode_t oldMode; /* Storage for the value of the old mode (that @@ -1734,13 +1905,13 @@ GetModeFromPermString(interp, modeStringPtr, modePtr) } } switch (op) { - case 1 : + case 1: *modePtr = oldMode | (who & what); continue; - case 2 : + case 2: *modePtr = oldMode & ~(who & what); continue; - case 3 : + case 3: *modePtr = (oldMode & ~who) | (who & what); continue; } @@ -1769,19 +1940,19 @@ GetModeFromPermString(interp, modeStringPtr, modePtr) */ int -TclpObjNormalizePath(interp, pathPtr, nextCheckpoint) - Tcl_Interp *interp; - Tcl_Obj *pathPtr; - int nextCheckpoint; +TclpObjNormalizePath( + Tcl_Interp *interp, + Tcl_Obj *pathPtr, + int nextCheckpoint) { - char *currentPathEndPosition; + const char *currentPathEndPosition; int pathLen; char cur; - char *path = Tcl_GetStringFromObj(pathPtr, &pathLen); + const char *path = Tcl_GetStringFromObj(pathPtr, &pathLen); + Tcl_DString ds; + const char *nativePath; #ifndef NO_REALPATH char normPath[MAXPATHLEN]; - Tcl_DString ds; - CONST char *nativePath; #endif /* @@ -1800,16 +1971,24 @@ TclpObjNormalizePath(interp, pathPtr, nextCheckpoint) * For speed, try to get the entire path in one go. */ - if (nextCheckpoint == 0) { + if (nextCheckpoint == 0 && haveRealpath) { char *lastDir = strrchr(currentPathEndPosition, '/'); if (lastDir != NULL) { nativePath = Tcl_UtfToExternalDString(NULL, path, lastDir-path, &ds); if (Realpath(nativePath, normPath) != NULL) { - nextCheckpoint = lastDir - path; - goto wholeStringOk; + if (*nativePath != '/' && *normPath == '/') { + /* + * realpath has transformed a relative path into an + * absolute path, we do not know how to handle this. + */ + } else { + nextCheckpoint = lastDir - path; + goto wholeStringOk; + } } + Tcl_DStringFree(&ds); } } @@ -1825,8 +2004,6 @@ TclpObjNormalizePath(interp, pathPtr, nextCheckpoint) * Reached directory separator. */ - Tcl_DString ds; - CONST char *nativePath; int accessOk; nativePath = Tcl_UtfToExternalDString(NULL, path, @@ -1865,96 +2042,371 @@ TclpObjNormalizePath(interp, pathPtr, nextCheckpoint) */ #ifndef NO_REALPATH - /* - * If we only had '/foo' or '/' then we never increment nextCheckpoint and - * we don't need or want to go through 'Realpath'. Also, on some - * platforms, passing an empty string to 'Realpath' will give us the - * normalized pwd, which is not what we want at all! - */ + if (haveRealpath) { + /* + * If we only had '/foo' or '/' then we never increment nextCheckpoint + * and we don't need or want to go through 'Realpath'. Also, on some + * platforms, passing an empty string to 'Realpath' will give us the + * normalized pwd, which is not what we want at all! + */ - if (nextCheckpoint == 0) { - return 0; - } + if (nextCheckpoint == 0) { + return 0; + } + + nativePath = Tcl_UtfToExternalDString(NULL, path,nextCheckpoint, &ds); + if (Realpath(nativePath, normPath) != NULL) { + int newNormLen; + + wholeStringOk: + newNormLen = strlen(normPath); + if ((newNormLen == Tcl_DStringLength(&ds)) + && (strcmp(normPath, nativePath) == 0)) { + /* + * String is unchanged. + */ + + Tcl_DStringFree(&ds); - nativePath = Tcl_UtfToExternalDString(NULL, path, nextCheckpoint, &ds); - if (Realpath(nativePath, normPath) != NULL) { - int newNormLen; + /* + * Enable this to have the native FS claim normalization of + * the whole path for existing files. That would permit the + * caller to declare normalization complete without calls to + * additional filesystems. Saving lots of calls is probably + * worth the extra access() time here. When no other FS's are + * registered though, things are less clear. + * + if (0 == access(normPath, F_OK)) { + return pathLen; + } + */ + + return nextCheckpoint; + } - wholeStringOk: - newNormLen = strlen(normPath); - if ((newNormLen == Tcl_DStringLength(&ds)) - && (strcmp(normPath, nativePath) == 0)) { /* - * String is unchanged. + * Free up the native path and put in its place the converted, + * normalized path. */ Tcl_DStringFree(&ds); + Tcl_ExternalToUtfDString(NULL, normPath, (int) newNormLen, &ds); - /* - * Enable this to have the native FS claim normalization of the - * whole path for existing files. That would permit the caller to - * declare normalization complete without calls to additional - * filesystems. Saving lots of calls is probably worth the extra - * access() time here. When no other FS's are registered though, - * things are less clear. - * - if (0 == access(normPath, F_OK)) { - return pathLen; + if (path[nextCheckpoint] != '\0') { + /* + * Not at end, append remaining path. + */ + + int normLen = Tcl_DStringLength(&ds); + + Tcl_DStringAppend(&ds, path + nextCheckpoint, + pathLen - nextCheckpoint); + + /* + * We recognise up to and including the directory separator. + */ + + nextCheckpoint = normLen + 1; + } else { + /* + * We recognise the whole string. + */ + + nextCheckpoint = Tcl_DStringLength(&ds); } + + /* + * Overwrite with the normalized path. */ - return nextCheckpoint; + Tcl_SetStringObj(pathPtr, Tcl_DStringValue(&ds), + Tcl_DStringLength(&ds)); } + Tcl_DStringFree(&ds); + } +#endif /* !NO_REALPATH */ - /* - * Free up the native path and put in its place the converted, - * normalized path. - */ + return nextCheckpoint; +} + +/* + *---------------------------------------------------------------------- + * + * TclpOpenTemporaryFile, TclUnixOpenTemporaryFile -- + * + * Creates a temporary file, possibly based on the supplied bits and + * pieces of template supplied in the first three arguments. If the + * fourth argument is non-NULL, it contains a Tcl_Obj to store the name + * of the temporary file in (and it is caller's responsibility to clean + * up). If the fourth argument is NULL, try to arrange for the temporary + * file to go away once it is no longer needed. + * + * Results: + * A read-write Tcl Channel open on the file for TclpOpenTemporaryFile, + * or a file descriptor (or -1 on failure) for TclUnixOpenTemporaryFile. + * + * Side effects: + * Accesses the filesystem. Will set the contents of the Tcl_Obj fourth + * argument (if that is non-NULL). + * + *---------------------------------------------------------------------- + */ - Tcl_DStringFree(&ds); - Tcl_ExternalToUtfDString(NULL, normPath, (int) newNormLen, &ds); +Tcl_Channel +TclpOpenTemporaryFile( + Tcl_Obj *dirObj, + Tcl_Obj *basenameObj, + Tcl_Obj *extensionObj, + Tcl_Obj *resultingNameObj) +{ + int fd = TclUnixOpenTemporaryFile(dirObj, basenameObj, extensionObj, + resultingNameObj); - if (path[nextCheckpoint] != '\0') { - /* - * Not at end, append remaining path. - */ + if (fd == -1) { + return NULL; + } + return Tcl_MakeFileChannel(INT2PTR(fd), TCL_READABLE|TCL_WRITABLE); +} - int normLen = Tcl_DStringLength(&ds); +int +TclUnixOpenTemporaryFile( + Tcl_Obj *dirObj, + Tcl_Obj *basenameObj, + Tcl_Obj *extensionObj, + Tcl_Obj *resultingNameObj) +{ + Tcl_DString template, tmp; + const char *string; + int len, fd; - Tcl_DStringAppend(&ds, path + nextCheckpoint, - pathLen - nextCheckpoint); + /* + * We should also check against making more then TMP_MAX of these. + */ - /* - * We recognise up to and including the directory separator. - */ + if (dirObj) { + string = Tcl_GetStringFromObj(dirObj, &len); + Tcl_UtfToExternalDString(NULL, string, len, &template); + } else { + Tcl_DStringInit(&template); + Tcl_DStringAppend(&template, DefaultTempDir(), -1); /* INTL: native */ + } - nextCheckpoint = normLen + 1; - } else { - /* - * We recognise the whole string. - */ + TclDStringAppendLiteral(&template, "/"); - nextCheckpoint = Tcl_DStringLength(&ds); - } + if (basenameObj) { + string = Tcl_GetStringFromObj(basenameObj, &len); + Tcl_UtfToExternalDString(NULL, string, len, &tmp); + TclDStringAppendDString(&template, &tmp); + Tcl_DStringFree(&tmp); + } else { + TclDStringAppendLiteral(&template, "tcl"); + } + + TclDStringAppendLiteral(&template, "_XXXXXX"); +#ifdef HAVE_MKSTEMPS + if (extensionObj) { + string = Tcl_GetStringFromObj(extensionObj, &len); + Tcl_UtfToExternalDString(NULL, string, len, &tmp); + TclDStringAppendDString(&template, &tmp); + fd = mkstemps(Tcl_DStringValue(&template), Tcl_DStringLength(&tmp)); + Tcl_DStringFree(&tmp); + } else +#endif + { + fd = mkstemp(Tcl_DStringValue(&template)); + } + + if (fd == -1) { + Tcl_DStringFree(&template); + return -1; + } + + if (resultingNameObj) { + Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&template), + Tcl_DStringLength(&template), &tmp); + Tcl_SetStringObj(resultingNameObj, Tcl_DStringValue(&tmp), + Tcl_DStringLength(&tmp)); + Tcl_DStringFree(&tmp); + } else { /* - * Overwrite with the normalized path. + * Try to delete the file immediately since we're not reporting the + * name to anyone. Note that we're *not* handling any errors from + * this! */ - Tcl_SetStringObj(pathPtr, Tcl_DStringValue(&ds), - Tcl_DStringLength(&ds)); + unlink(Tcl_DStringValue(&template)); + errno = 0; } - Tcl_DStringFree(&ds); -#endif /* !NO_REALPATH */ + Tcl_DStringFree(&template); - return nextCheckpoint; + return fd; +} + +/* + * Helper that does *part* of what tempnam() does. + */ + +static const char * +DefaultTempDir(void) +{ + const char *dir; + struct stat buf; + + dir = getenv("TMPDIR"); + if (dir && dir[0] && stat(dir, &buf) == 0 && S_ISDIR(buf.st_mode) + && access(dir, W_OK) == 0) { + return dir; + } + +#ifdef P_tmpdir + dir = P_tmpdir; + if (stat(dir, &buf)==0 && S_ISDIR(buf.st_mode) && access(dir, W_OK)==0) { + return dir; + } +#endif + + /* + * Assume that the default location ("/tmp" if not overridden) is always + * an existing writable directory; we've no recovery mechanism if it + * isn't. + */ + + return TCL_TEMPORARY_FILE_DIRECTORY; +} + +#if defined(__CYGWIN__) + +static void +StatError( + Tcl_Interp *interp, /* The interp that has the error */ + Tcl_Obj *fileName) /* The name of the file which caused the + * error. */ +{ + TclWinConvertError(GetLastError()); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("could not read \"%s\": %s", + TclGetString(fileName), Tcl_PosixError(interp))); +} + +static WCHAR * +winPathFromObj( + Tcl_Obj *fileName) +{ + int size; + const char *native = Tcl_FSGetNativePath(fileName); + WCHAR *winPath; + + size = cygwin_conv_path(1, native, NULL, 0); + winPath = ckalloc(size); + cygwin_conv_path(1, native, winPath, size); + + return winPath; +} + +static const int attributeArray[] = { + 0x20, 0, 2, 0, 0, 1, 4}; + +/* + *---------------------------------------------------------------------- + * + * GetUnixFileAttributes + * + * Gets the readonly attribute of a file. + * + * Results: + * Standard TCL result. Returns a new Tcl_Obj in attributePtrPtr if there + * is no error. The object will have ref count 0. + * + * Side effects: + * A new object is allocated. + * + *---------------------------------------------------------------------- + */ + +static int +GetUnixFileAttributes( + Tcl_Interp *interp, /* The interp we are using for errors. */ + int objIndex, /* The index of the attribute. */ + Tcl_Obj *fileName, /* The name of the file (UTF-8). */ + Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ +{ + int fileAttributes; + WCHAR *winPath = winPathFromObj(fileName); + + fileAttributes = GetFileAttributesW(winPath); + ckfree(winPath); + + if (fileAttributes == -1) { + StatError(interp, fileName); + return TCL_ERROR; + } + + *attributePtrPtr = Tcl_NewIntObj((fileAttributes&attributeArray[objIndex])!=0); + + return TCL_OK; } -#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) +/* + *--------------------------------------------------------------------------- + * + * SetUnixFileAttributes + * + * Sets the readonly attribute of a file. + * + * Results: + * Standard TCL result. + * + * Side effects: + * The readonly attribute of the file is changed. + * + *--------------------------------------------------------------------------- + */ + +static int +SetUnixFileAttributes( + Tcl_Interp *interp, /* The interp we are using for errors. */ + int objIndex, /* The index of the attribute. */ + Tcl_Obj *fileName, /* The name of the file (UTF-8). */ + Tcl_Obj *attributePtr) /* The attribute to set. */ +{ + int yesNo, fileAttributes, old; + WCHAR *winPath; + + if (Tcl_GetBooleanFromObj(interp, attributePtr, &yesNo) != TCL_OK) { + return TCL_ERROR; + } + + winPath = winPathFromObj(fileName); + + fileAttributes = old = GetFileAttributesW(winPath); + + if (fileAttributes == -1) { + ckfree(winPath); + StatError(interp, fileName); + return TCL_ERROR; + } + + if (yesNo) { + fileAttributes |= attributeArray[objIndex]; + } else { + fileAttributes &= ~attributeArray[objIndex]; + } + + if ((fileAttributes != old) + && !SetFileAttributesW(winPath, fileAttributes)) { + ckfree(winPath); + StatError(interp, fileName); + return TCL_ERROR; + } + + ckfree(winPath); + return TCL_OK; +} +#elif defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) /* *---------------------------------------------------------------------- * - * GetReadOnlyAttribute + * GetUnixFileAttributes * * Gets the readonly attribute (user immutable flag) of a file. * @@ -1969,11 +2421,11 @@ TclpObjNormalizePath(interp, pathPtr, nextCheckpoint) */ static int -GetReadOnlyAttribute(interp, objIndex, fileName, attributePtrPtr) - Tcl_Interp *interp; /* The interp we are using for errors. */ - int objIndex; /* The index of the attribute. */ - Tcl_Obj *fileName; /* The name of the file (UTF-8). */ - Tcl_Obj **attributePtrPtr; /* A pointer to return the object with. */ +GetUnixFileAttributes( + Tcl_Interp *interp, /* The interp we are using for errors. */ + int objIndex, /* The index of the attribute. */ + Tcl_Obj *fileName, /* The name of the file (UTF-8). */ + Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ { Tcl_StatBuf statBuf; int result; @@ -1982,14 +2434,14 @@ GetReadOnlyAttribute(interp, objIndex, fileName, attributePtrPtr) if (result != 0) { if (interp != NULL) { - Tcl_AppendResult(interp, "could not read \"", - Tcl_GetString(fileName), "\": ", Tcl_PosixError(interp), - (char *) NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "could not read \"%s\": %s", + TclGetString(fileName), Tcl_PosixError(interp))); } return TCL_ERROR; } - *attributePtrPtr = Tcl_NewBooleanObj((statBuf.st_flags&UF_IMMUTABLE) != 0); + *attributePtrPtr = Tcl_NewBooleanObj(statBuf.st_flags&UF_IMMUTABLE); return TCL_OK; } @@ -1997,7 +2449,7 @@ GetReadOnlyAttribute(interp, objIndex, fileName, attributePtrPtr) /* *--------------------------------------------------------------------------- * - * SetReadOnlyAttribute + * SetUnixFileAttributes * * Sets the readonly attribute (user immutable flag) of a file. * @@ -2011,16 +2463,15 @@ GetReadOnlyAttribute(interp, objIndex, fileName, attributePtrPtr) */ static int -SetReadOnlyAttribute(interp, objIndex, fileName, attributePtr) - Tcl_Interp *interp; /* The interp we are using for errors. */ - int objIndex; /* The index of the attribute. */ - Tcl_Obj *fileName; /* The name of the file (UTF-8). */ - Tcl_Obj *attributePtr; /* The attribute to set. */ +SetUnixFileAttributes( + Tcl_Interp *interp, /* The interp we are using for errors. */ + int objIndex, /* The index of the attribute. */ + Tcl_Obj *fileName, /* The name of the file (UTF-8). */ + Tcl_Obj *attributePtr) /* The attribute to set. */ { Tcl_StatBuf statBuf; - int result; - int readonly; - CONST char *native; + int result, readonly; + const char *native; if (Tcl_GetBooleanFromObj(interp, attributePtr, &readonly) != TCL_OK) { return TCL_ERROR; @@ -2030,9 +2481,9 @@ SetReadOnlyAttribute(interp, objIndex, fileName, attributePtr) if (result != 0) { if (interp != NULL) { - Tcl_AppendResult(interp, "could not read \"", - Tcl_GetString(fileName), "\": ", Tcl_PosixError(interp), - (char *) NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "could not read \"%s\": %s", + TclGetString(fileName), Tcl_PosixError(interp))); } return TCL_ERROR; } @@ -2047,9 +2498,9 @@ SetReadOnlyAttribute(interp, objIndex, fileName, attributePtr) result = chflags(native, statBuf.st_flags); /* INTL: Native. */ if (result != 0) { if (interp != NULL) { - Tcl_AppendResult(interp, "could not set flags for file \"", - Tcl_GetString(fileName), "\": ", Tcl_PosixError(interp), - (char *) NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "could not set flags for file \"%s\": %s", + TclGetString(fileName), Tcl_PosixError(interp))); } return TCL_ERROR; } |