diff options
Diffstat (limited to 'unix/tclUnixFCmd.c')
| -rw-r--r-- | unix/tclUnixFCmd.c | 641 | 
1 files changed, 477 insertions, 164 deletions
| diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c index 41b1003..3b1b6ca 100644 --- a/unix/tclUnixFCmd.c +++ b/unix/tclUnixFCmd.c @@ -10,8 +10,6 @@   * 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.65 2007/12/13 15:28:42 dgp Exp $ - *   * Portions of this code were derived from NetBSD source code which has the   * following copyright notice:   * @@ -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,11 +43,11 @@  #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 +#endif /* !HAVE_STRUCT_STAT_ST_BLKSIZE */  #ifdef HAVE_FTS  #include <fts.h>  #endif @@ -68,6 +62,16 @@  #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.   */ @@ -86,11 +90,11 @@ static int		SetPermissionsAttribute(Tcl_Interp *interp,  			    int objIndex, Tcl_Obj *fileName,  			    Tcl_Obj *attributePtr);  static int		GetModeFromPermString(Tcl_Interp *interp, -			    char *modeStringPtr, mode_t *modePtr); -#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) -static int		GetReadOnlyAttribute(Tcl_Interp *interp, int objIndex, +			    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		SetReadOnlyAttribute(Tcl_Interp *interp, int objIndex, +static int		SetUnixFileAttributes(Tcl_Interp *interp, int objIndex,  			    Tcl_Obj *fileName, Tcl_Obj *attributePtr);  #endif @@ -99,7 +103,7 @@ static int		SetReadOnlyAttribute(Tcl_Interp *interp, int objIndex,   */  typedef int (TraversalProc)(Tcl_DString *srcPtr, Tcl_DString *dstPtr, -	CONST Tcl_StatBuf *statBufPtr, int type, Tcl_DString *errorPtr); +	const Tcl_StatBuf *statBufPtr, int type, Tcl_DString *errorPtr);  /*   * Constants and variables necessary for file attributes subcommand. @@ -116,14 +120,24 @@ typedef int (TraversalProc)(Tcl_DString *srcPtr, Tcl_DString *dstPtr,   */  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, @@ -131,25 +145,44 @@ enum {      UNIX_INVALID_ATTRIBUTE /* lint - last enum value needs no trailing , */  }; -MODULE_SCOPE CONST char *tclpFileAttrStrings[]; -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      NULL  }; -MODULE_SCOPE CONST TclFileAttrProcs tclpFileAttrProcs[]; -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}, @@ -158,7 +191,7 @@ CONST TclFileAttrProcs tclpFileAttrProcs[] = {      {TclMacOSXGetFileAttribute,	TclMacOSXSetFileAttribute},  #endif  }; -#endif +#endif /* DJGPP */  /*   * This is the maximum number of consecutive readdir/unlink calls that can be @@ -179,20 +212,23 @@ CONST TclFileAttrProcs tclpFileAttrProcs[] = {   * Declarations for local procedures defined in this file:   */ -static int		CopyFileAtts(CONST char *src, -			    CONST char *dst, CONST Tcl_StatBuf *statBufPtr); -static int		DoCopyFile(CONST char *srcPtr, CONST char *dstPtr, -			    CONST Tcl_StatBuf *statBufPtr); -static int		DoCreateDirectory(CONST char *pathPtr); +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		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); +			    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); +			    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); @@ -205,19 +241,19 @@ static int		TraverseUnixTree(TraversalProc *traversalProc,   * passing the standard MAXPATHLEN size resolved arg.   */ -static char *		Realpath(CONST char *path, char *resolved); +static char *		Realpath(const char *path, char *resolved);  char *  Realpath( -    CONST char *path, +    const char *path,      char *resolved)  {      memset(resolved, 0, MAXPATHLEN);      return realpath(path, resolved);  }  #else -#define Realpath realpath -#endif +#   define Realpath	realpath +#endif /* PURIFY */  #ifndef NO_REALPATH  #if defined(__APPLE__) && defined(TCL_THREADS) && \ @@ -230,16 +266,16 @@ Realpath(   */  MODULE_SCOPE long tclMacOSXDarwinRelease; -#define haveRealpath (tclMacOSXDarwinRelease >= 7) +#   define haveRealpath	(tclMacOSXDarwinRelease >= 7)  #else -#define haveRealpath 1 +#   define haveRealpath	1  #endif  #endif /* NO_REALPATH */  #ifdef HAVE_FTS -#ifdef HAVE_STRUCT_STAT64 +#if defined(HAVE_STRUCT_STAT64) && !defined(__APPLE__)  /* fts doesn't do stat64 */ -#define noFtsStat 1 +#   define noFtsStat	1  #elif defined(__APPLE__) && defined(__LP64__) && \  	defined(MAC_OS_X_VERSION_MIN_REQUIRED) && \  	MAC_OS_X_VERSION_MIN_REQUIRED < 1050 @@ -250,9 +286,9 @@ MODULE_SCOPE long tclMacOSXDarwinRelease;   */  MODULE_SCOPE long tclMacOSXDarwinRelease; -#define noFtsStat (tclMacOSXDarwinRelease < 9) +#   define noFtsStat	(tclMacOSXDarwinRelease < 9)  #else -#define noFtsStat 0 +#   define noFtsStat	0  #endif  #endif /* HAVE_FTS */ @@ -301,9 +337,9 @@ TclpObjRenameFile(  static int  DoRenameFile( -    CONST char *src,		/* Pathname of file or dir to be renamed +    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. */ @@ -411,7 +447,7 @@ TclpObjCopyFile(      Tcl_Obj *srcPathPtr,      Tcl_Obj *destPathPtr)  { -    CONST char *src = Tcl_FSGetNativePath(srcPathPtr); +    const char *src = Tcl_FSGetNativePath(srcPathPtr);      Tcl_StatBuf srcStatBuf;      if (TclOSlstat(src, &srcStatBuf) != 0) {		/* INTL: Native. */ @@ -423,9 +459,9 @@ TclpObjCopyFile(  static int  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) +    const char *src,		/* Pathname of file to be copied (native). */ +    const char *dst,		/* Pathname of file to copy to (native). */ +    const Tcl_StatBuf *statBufPtr)  				/* Used to determine filetype. */  {      Tcl_StatBuf dstStatBuf; @@ -455,15 +491,16 @@ DoCopyFile(      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 @@ -471,7 +508,7 @@ DoCopyFile(  #endif  	break;      } -#endif +#endif /* !DJGPP */      case S_IFBLK:      case S_IFCHR:  	if (mknod(dst, statBufPtr->st_mode,		/* INTL: Native. */ @@ -509,10 +546,10 @@ DoCopyFile(  int  TclUnixCopyFile( -    CONST char *src,		/* Pathname of file to copy (native). */ -    CONST char *dst,		/* Pathname of file to create/overwrite +    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. */  { @@ -525,7 +562,9 @@ TclUnixCopyFile(  #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; @@ -544,31 +583,32 @@ TclUnixCopyFile(       * that's likely to be fairly efficient anyway.       */ -#ifdef HAVE_ST_BLKSIZE +#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE      blockSize = statBufPtr->st_blksize;  #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 /* HAVE_ST_BLKSIZE */ +    blockSize = DEFAULT_COPY_BLOCK_SIZE; +#endif /* HAVE_STRUCT_STAT_ST_BLKSIZE */      /* -     * [SF Tcl Bug 1586470] Even if we HAVE_ST_BLKSIZE, there are filesystems -     * which report a bogus value for the blocksize. An example is the Andrew -     * Filesystem (afs), reporting a blocksize of 0. When detecting such a -     * situation we now simply fall back to a hardwired default size. +     * [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 = 4096; +	blockSize = DEFAULT_COPY_BLOCK_SIZE;      }      buffer = ckalloc(blockSize);      while (1) { @@ -631,9 +671,9 @@ TclpObjDeleteFile(  int  TclpDeleteFile( -    CONST char *path)		/* Pathname of file to be removed (native). */ +    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; @@ -674,7 +714,7 @@ TclpObjCreateDirectory(  static int  DoCreateDirectory( -    CONST char *path)		/* Pathname of directory to create (native). */ +    const char *path)		/* Pathname of directory to create (native). */  {      mode_t mode; @@ -821,7 +861,7 @@ DoRemoveDirectory(  				 * filled with UTF-8 name of file causing  				 * error. */  { -    CONST char *path; +    const char *path;      mode_t oldPerm = 0;      int result; @@ -919,7 +959,7 @@ TraverseUnixTree(      				 * files. */  {      Tcl_StatBuf statBuf; -    CONST char *source, *errfile; +    const char *source, *errfile;      int result, sourceLen;      int targetLen;  #ifndef HAVE_FTS @@ -927,7 +967,7 @@ TraverseUnixTree(      Tcl_DirEntry *dirEntPtr;      DIR *dirPtr;  #else -    CONST char *paths[2] = {NULL, NULL}; +    const char *paths[2] = {NULL, NULL};      FTS *fts = NULL;      FTSENT *ent;  #endif @@ -946,7 +986,7 @@ TraverseUnixTree(  	 * Process the regular file  	 */ -	return (*traverseProc)(sourcePtr, targetPtr, &statBuf, DOTREE_F, +	return traverseProc(sourcePtr, targetPtr, &statBuf, DOTREE_F,  		errorPtr);      }  #ifndef HAVE_FTS @@ -959,18 +999,18 @@ TraverseUnixTree(  	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);      } @@ -1033,12 +1073,12 @@ TraverseUnixTree(  	 * 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 | +    fts = fts_open((char **) paths, FTS_PHYSICAL | FTS_NOCHDIR |  	    (noFtsStat || doRewind ? FTS_NOSTAT : 0), NULL);      if (fts == NULL) {  	errfile = source; @@ -1056,7 +1096,7 @@ TraverseUnixTree(  	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; @@ -1087,7 +1127,7 @@ TraverseUnixTree(  		statBufPtr = (Tcl_StatBuf *) ent->fts_statp;  	    }  	} -	result = (*traverseProc)(sourcePtr, targetPtr, statBufPtr, type, +	result = traverseProc(sourcePtr, targetPtr, statBufPtr, type,  		errorPtr);  	if (result != TCL_OK) {  	    break; @@ -1097,7 +1137,7 @@ TraverseUnixTree(  	    Tcl_DStringSetLength(targetPtr, targetLen);  	}      } -#endif /* HAVE_FTS */ +#endif /* !HAVE_FTS */    end:      if (errfile != NULL) { @@ -1137,7 +1177,7 @@ static int  TraversalCopy(      Tcl_DString *srcPtr,	/* Source pathname to copy (native). */      Tcl_DString *dstPtr,	/* Destination pathname of copy (native). */ -    CONST Tcl_StatBuf *statBufPtr, +    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 @@ -1201,7 +1241,7 @@ static int  TraversalDelete(      Tcl_DString *srcPtr,	/* Source pathname (native). */      Tcl_DString *ignore,	/* Destination pathname (not used). */ -    CONST Tcl_StatBuf *statBufPtr, +    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 @@ -1249,9 +1289,9 @@ TraversalDelete(  static int  CopyFileAtts( -    CONST char *src,		/* Path name of source file (native). */ -    CONST char *dst,		/* Path name of target file (native). */ -    CONST Tcl_StatBuf *statBufPtr) +    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; @@ -1319,9 +1359,9 @@ GetGroupAttribute(      if (result != 0) {  	if (interp != NULL) { -	    Tcl_AppendResult(interp, "could not read \"", -		    TclGetString(fileName), "\": ", -		    Tcl_PosixError(interp), NULL); +	    Tcl_SetObjResult(interp, Tcl_ObjPrintf( +		    "could not read \"%s\": %s", +		    TclGetString(fileName), Tcl_PosixError(interp)));  	}  	return TCL_ERROR;      } @@ -1332,13 +1372,12 @@ GetGroupAttribute(  	*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;  } @@ -1374,9 +1413,9 @@ GetOwnerAttribute(      if (result != 0) {  	if (interp != NULL) { -	    Tcl_AppendResult(interp, "could not read \"", -		    TclGetString(fileName), "\": ", -		    Tcl_PosixError(interp), NULL); +	    Tcl_SetObjResult(interp, Tcl_ObjPrintf( +		    "could not read \"%s\": %s", +		    TclGetString(fileName), Tcl_PosixError(interp)));  	}  	return TCL_ERROR;      } @@ -1387,13 +1426,10 @@ GetOwnerAttribute(  	*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;  } @@ -1428,9 +1464,9 @@ GetPermissionsAttribute(      if (result != 0) {  	if (interp != NULL) { -	    Tcl_AppendResult(interp, "could not read \"", -		    TclGetString(fileName), "\": ", -		    Tcl_PosixError(interp), NULL); +	    Tcl_SetObjResult(interp, Tcl_ObjPrintf( +		    "could not read \"%s\": %s", +		    TclGetString(fileName), Tcl_PosixError(interp)));  	}  	return TCL_ERROR;      } @@ -1465,12 +1501,12 @@ SetGroupAttribute(  {      long gid;      int result; -    CONST char *native; +    const char *native;      if (Tcl_GetLongFromObj(NULL, attributePtr, &gid) != TCL_OK) {  	Tcl_DString ds;  	struct group *groupPtr = NULL; -	CONST char *string; +	const char *string;  	int length;  	string = Tcl_GetStringFromObj(attributePtr, &length); @@ -1480,11 +1516,13 @@ SetGroupAttribute(  	Tcl_DStringFree(&ds);  	if (groupPtr == NULL) { -	    endgrent();  	    if (interp != NULL) { -		Tcl_AppendResult(interp, "could not set group for file \"", -			TclGetString(fileName), "\": group \"", string, -			"\" does not exist", 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;  	} @@ -1494,12 +1532,11 @@ SetGroupAttribute(      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 \"", -		    TclGetString(fileName), "\": ", Tcl_PosixError(interp), -		    NULL); +	    Tcl_SetObjResult(interp, Tcl_ObjPrintf( +		    "could not set group for file \"%s\": %s", +		    TclGetString(fileName), Tcl_PosixError(interp)));  	}  	return TCL_ERROR;      } @@ -1531,25 +1568,28 @@ SetOwnerAttribute(  {      long uid;      int result; -    CONST char *native; +    const char *native;      if (Tcl_GetLongFromObj(NULL, attributePtr, &uid) != TCL_OK) {  	Tcl_DString ds;  	struct passwd *pwPtr = NULL; -	CONST char *string; +	const char *string;  	int length;  	string = Tcl_GetStringFromObj(attributePtr, &length);  	native = Tcl_UtfToExternalDString(NULL, string, length, &ds); -	pwPtr = TclpGetPwNam(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 \"", -			TclGetString(fileName), "\": user \"", string, -			"\" does not exist", 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;  	} @@ -1561,9 +1601,9 @@ SetOwnerAttribute(      if (result != 0) {  	if (interp != NULL) { -	    Tcl_AppendResult(interp, "could not set owner for file \"", -		    TclGetString(fileName), "\": ", Tcl_PosixError(interp), -		    NULL); +	    Tcl_SetObjResult(interp, Tcl_ObjPrintf( +		    "could not set owner for file \"%s\": %s", +		    TclGetString(fileName), Tcl_PosixError(interp)));  	}  	return TCL_ERROR;      } @@ -1596,8 +1636,8 @@ SetPermissionsAttribute(      long mode;      mode_t newMode;      int result = TCL_ERROR; -    CONST char *native; -    char *modeStringPtr = TclGetString(attributePtr); +    const char *native; +    const char *modeStringPtr = TclGetString(attributePtr);      int scanned = TclParseAllWhiteSpace(modeStringPtr, -1);      /* @@ -1631,9 +1671,9 @@ SetPermissionsAttribute(  	result = TclpObjStat(fileName, &buf);  	if (result != 0) {  	    if (interp != NULL) { -		Tcl_AppendResult(interp, "could not read \"", -			TclGetString(fileName), "\": ", -			Tcl_PosixError(interp), NULL); +		Tcl_SetObjResult(interp, Tcl_ObjPrintf( +			"could not read \"%s\": %s", +			TclGetString(fileName), Tcl_PosixError(interp)));  	    }  	    return TCL_ERROR;  	} @@ -1641,8 +1681,10 @@ SetPermissionsAttribute(  	if (GetModeFromPermString(NULL, modeStringPtr, &newMode) != TCL_OK) {  	    if (interp != NULL) { -		Tcl_AppendResult(interp, "unknown permission string format \"", -			modeStringPtr, "\"", NULL); +		Tcl_SetObjResult(interp, Tcl_ObjPrintf( +			"unknown permission string format \"%s\"", +			modeStringPtr)); +		Tcl_SetErrorCode(interp, "TCL", "VALUE", "PERMISSION", NULL);  	    }  	    return TCL_ERROR;  	} @@ -1652,9 +1694,9 @@ SetPermissionsAttribute(      result = chmod(native, newMode);		/* INTL: Native. */      if (result != 0) {  	if (interp != NULL) { -	    Tcl_AppendResult(interp, "could not set permissions for file \"", -		    TclGetString(fileName), "\": ", -		    Tcl_PosixError(interp), NULL); +	    Tcl_SetObjResult(interp, Tcl_ObjPrintf( +		    "could not set permissions for file \"%s\": %s", +		    TclGetString(fileName), Tcl_PosixError(interp)));  	}  	return TCL_ERROR;      } @@ -1681,7 +1723,8 @@ SetPermissionsAttribute(  Tcl_Obj *  TclpObjListVolumes(void)  { -    Tcl_Obj *resultPtr = Tcl_NewStringObj("/", 1); +    Tcl_Obj *resultPtr; +    TclNewLiteralStringObj(resultPtr, "/");      Tcl_IncrRefCount(resultPtr);      return resultPtr; @@ -1709,7 +1752,7 @@ TclpObjListVolumes(void)  static int  GetModeFromPermString(      Tcl_Interp *interp,		/* The interp we are using for errors. */ -    char *modeStringPtr,	/* Permissions string */ +    const char *modeStringPtr, /* Permissions string */      mode_t *modePtr)		/* pointer to the mode value */  {      mode_t newMode; @@ -1902,14 +1945,14 @@ TclpObjNormalizePath(      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      /* @@ -1961,8 +2004,6 @@ TclpObjNormalizePath(  	     * Reached directory separator.  	     */ -	    Tcl_DString ds; -	    CONST char *nativePath;  	    int accessOk;  	    nativePath = Tcl_UtfToExternalDString(NULL, path, @@ -2013,7 +2054,7 @@ TclpObjNormalizePath(  	    return 0;  	} -	nativePath = Tcl_UtfToExternalDString(NULL, path, nextCheckpoint, &ds); +	nativePath = Tcl_UtfToExternalDString(NULL, path,nextCheckpoint, &ds);  	if (Realpath(nativePath, normPath) != NULL) {  	    int newNormLen; @@ -2088,11 +2129,284 @@ TclpObjNormalizePath(      return nextCheckpoint;  } -#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE)  /*   *----------------------------------------------------------------------   * - * GetReadOnlyAttribute + * 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_Channel +TclpOpenTemporaryFile( +    Tcl_Obj *dirObj, +    Tcl_Obj *basenameObj, +    Tcl_Obj *extensionObj, +    Tcl_Obj *resultingNameObj) +{ +    int fd = TclUnixOpenTemporaryFile(dirObj, basenameObj, extensionObj, +	    resultingNameObj); + +    if (fd == -1) { +	return NULL; +    } +    return Tcl_MakeFileChannel(INT2PTR(fd), TCL_READABLE|TCL_WRITABLE); +} + +int +TclUnixOpenTemporaryFile( +    Tcl_Obj *dirObj, +    Tcl_Obj *basenameObj, +    Tcl_Obj *extensionObj, +    Tcl_Obj *resultingNameObj) +{ +    Tcl_DString template, tmp; +    const char *string; +    int len, fd; + +    /* +     * We should also check against making more then TMP_MAX of these. +     */ + +    if (dirObj) { +	string = Tcl_GetStringFromObj(dirObj, &len); +	Tcl_UtfToExternalDString(NULL, string, len, &template); +    } else { +	Tcl_DStringInit(&template); +	Tcl_DStringAppend(&template, DefaultTempDir(), -1); /* INTL: native */ +    } + +    TclDStringAppendLiteral(&template, "/"); + +    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 { +	/* +	 * 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! +	 */ + +	unlink(Tcl_DStringValue(&template)); +	errno = 0; +    } +    Tcl_DStringFree(&template); + +    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; +} + +/* + *--------------------------------------------------------------------------- + * + * 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) +/* + *---------------------------------------------------------------------- + * + * GetUnixFileAttributes   *   *	Gets the readonly attribute (user immutable flag) of a file.   * @@ -2107,7 +2421,7 @@ TclpObjNormalizePath(   */  static int -GetReadOnlyAttribute( +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). */ @@ -2120,14 +2434,14 @@ GetReadOnlyAttribute(      if (result != 0) {  	if (interp != NULL) { -	    Tcl_AppendResult(interp, "could not read \"", -		    TclGetString(fileName), "\": ", Tcl_PosixError(interp), -		    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;  } @@ -2135,7 +2449,7 @@ GetReadOnlyAttribute(  /*   *---------------------------------------------------------------------------   * - * SetReadOnlyAttribute + * SetUnixFileAttributes   *   *	Sets the readonly attribute (user immutable flag) of a file.   * @@ -2149,16 +2463,15 @@ GetReadOnlyAttribute(   */  static int -SetReadOnlyAttribute( +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; @@ -2168,9 +2481,9 @@ SetReadOnlyAttribute(      if (result != 0) {  	if (interp != NULL) { -	    Tcl_AppendResult(interp, "could not read \"", -		    TclGetString(fileName), "\": ", Tcl_PosixError(interp), -		    NULL); +	    Tcl_SetObjResult(interp, Tcl_ObjPrintf( +		    "could not read \"%s\": %s", +		    TclGetString(fileName), Tcl_PosixError(interp)));  	}  	return TCL_ERROR;      } @@ -2185,9 +2498,9 @@ SetReadOnlyAttribute(      result = chflags(native, statBuf.st_flags);		/* INTL: Native. */      if (result != 0) {  	if (interp != NULL) { -	    Tcl_AppendResult(interp, "could not set flags for file \"", -		    TclGetString(fileName), "\": ", Tcl_PosixError(interp), -		    NULL); +	    Tcl_SetObjResult(interp, Tcl_ObjPrintf( +		    "could not set flags for file \"%s\": %s", +		    TclGetString(fileName), Tcl_PosixError(interp)));  	}  	return TCL_ERROR;      } | 
