diff options
Diffstat (limited to 'unix/tclUnixFCmd.c')
| -rw-r--r-- | unix/tclUnixFCmd.c | 608 |
1 files changed, 465 insertions, 143 deletions
diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c index b5450b1..3b1b6ca 100644 --- a/unix/tclUnixFCmd.c +++ b/unix/tclUnixFCmd.c @@ -47,7 +47,7 @@ #ifndef NO_FSTATFS #include <sys/statfs.h> #endif -#endif +#endif /* !HAVE_STRUCT_STAT_ST_BLKSIZE */ #ifdef HAVE_FTS #include <fts.h> #endif @@ -62,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. */ @@ -80,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 @@ -93,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. @@ -110,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, @@ -125,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}, @@ -152,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 @@ -173,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); @@ -199,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) && \ @@ -224,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 #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 @@ -244,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 */ @@ -295,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. */ @@ -405,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. */ @@ -417,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; @@ -449,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 @@ -465,7 +508,7 @@ DoCopyFile( #endif break; } -#endif +#endif /* !DJGPP */ case S_IFBLK: case S_IFCHR: if (mknod(dst, statBufPtr->st_mode, /* INTL: Native. */ @@ -503,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. */ { @@ -519,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; @@ -547,11 +592,11 @@ TclUnixCopyFile( if (fstatfs(srcFd, &fs) == 0) { blockSize = fs.f_bsize; } else { - blockSize = 4096; + blockSize = DEFAULT_COPY_BLOCK_SIZE; } } #else - blockSize = 4096; + blockSize = DEFAULT_COPY_BLOCK_SIZE; #endif /* HAVE_STRUCT_STAT_ST_BLKSIZE */ /* @@ -563,7 +608,7 @@ TclUnixCopyFile( */ if (blockSize <= 0) { - blockSize = 4096; + blockSize = DEFAULT_COPY_BLOCK_SIZE; } buffer = ckalloc(blockSize); while (1) { @@ -626,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; @@ -669,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; @@ -816,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; @@ -914,7 +959,7 @@ TraverseUnixTree( * files. */ { Tcl_StatBuf statBuf; - CONST char *source, *errfile; + const char *source, *errfile; int result, sourceLen; int targetLen; #ifndef HAVE_FTS @@ -922,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 @@ -941,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 @@ -954,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); } @@ -1028,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; @@ -1051,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; @@ -1082,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; @@ -1092,7 +1137,7 @@ TraverseUnixTree( Tcl_DStringSetLength(targetPtr, targetLen); } } -#endif /* HAVE_FTS */ +#endif /* !HAVE_FTS */ end: if (errfile != NULL) { @@ -1132,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 @@ -1196,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 @@ -1244,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; @@ -1314,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; } @@ -1327,7 +1372,7 @@ 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); @@ -1368,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; } @@ -1381,11 +1426,9 @@ 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); } return TCL_OK; } @@ -1421,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; } @@ -1458,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); @@ -1474,9 +1517,12 @@ SetGroupAttribute( if (groupPtr == NULL) { 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; } @@ -1488,9 +1534,9 @@ SetGroupAttribute( 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; } @@ -1522,12 +1568,12 @@ 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); @@ -1538,9 +1584,12 @@ SetOwnerAttribute( 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; } @@ -1552,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; } @@ -1587,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); /* @@ -1622,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; } @@ -1632,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; } @@ -1643,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; } @@ -1672,7 +1723,8 @@ SetPermissionsAttribute( Tcl_Obj * TclpObjListVolumes(void) { - Tcl_Obj *resultPtr = Tcl_NewStringObj("/", 1); + Tcl_Obj *resultPtr; + TclNewLiteralStringObj(resultPtr, "/"); Tcl_IncrRefCount(resultPtr); return resultPtr; @@ -1700,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; @@ -1893,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 /* @@ -1952,8 +2004,6 @@ TclpObjNormalizePath( * Reached directory separator. */ - Tcl_DString ds; - CONST char *nativePath; int accessOk; nativePath = Tcl_UtfToExternalDString(NULL, path, @@ -2004,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; @@ -2079,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. * @@ -2098,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). */ @@ -2111,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; } @@ -2126,7 +2449,7 @@ GetReadOnlyAttribute( /* *--------------------------------------------------------------------------- * - * SetReadOnlyAttribute + * SetUnixFileAttributes * * Sets the readonly attribute (user immutable flag) of a file. * @@ -2140,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; @@ -2159,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; } @@ -2176,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; } |