summaryrefslogtreecommitdiffstats
path: root/unix/tclUnixFCmd.c
diff options
context:
space:
mode:
Diffstat (limited to 'unix/tclUnixFCmd.c')
-rw-r--r--unix/tclUnixFCmd.c424
1 files changed, 295 insertions, 129 deletions
diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c
index d655990..2b6f3f3 100644
--- a/unix/tclUnixFCmd.c
+++ b/unix/tclUnixFCmd.c
@@ -48,7 +48,7 @@
#ifndef NO_FSTATFS
#include <sys/statfs.h>
#endif
-#endif
+#endif /* !HAVE_STRUCT_STAT_ST_BLKSIZE */
#ifdef HAVE_FTS
#include <fts.h>
#endif
@@ -63,6 +63,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.
*/
@@ -81,7 +91,7 @@ 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);
+ const char *modeStringPtr, mode_t *modePtr);
#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE)
static int GetReadOnlyAttribute(Tcl_Interp *interp, int objIndex,
Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr);
@@ -94,7 +104,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.
@@ -111,9 +121,9 @@ 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)
@@ -126,8 +136,8 @@ enum {
UNIX_INVALID_ATTRIBUTE /* lint - last enum value needs no trailing , */
};
-MODULE_SCOPE CONST char *tclpFileAttrStrings[];
-CONST char *tclpFileAttrStrings[] = {
+MODULE_SCOPE const char *const tclpFileAttrStrings[];
+const char *const tclpFileAttrStrings[] = {
"-group", "-owner", "-permissions",
#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE)
"-readonly",
@@ -138,8 +148,8 @@ CONST char *tclpFileAttrStrings[] = {
NULL
};
-MODULE_SCOPE CONST TclFileAttrProcs tclpFileAttrProcs[];
-CONST TclFileAttrProcs tclpFileAttrProcs[] = {
+MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[];
+const TclFileAttrProcs tclpFileAttrProcs[] = {
{GetGroupAttribute, SetGroupAttribute},
{GetOwnerAttribute, SetOwnerAttribute},
{GetPermissionsAttribute, SetPermissionsAttribute},
@@ -153,7 +163,7 @@ CONST TclFileAttrProcs tclpFileAttrProcs[] = {
{TclMacOSXGetFileAttribute, TclMacOSXSetFileAttribute},
#endif
};
-#endif
+#endif /* DJGPP */
/*
* This is the maximum number of consecutive readdir/unlink calls that can be
@@ -174,20 +184,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);
@@ -200,19 +213,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) && \
@@ -225,16 +238,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
@@ -245,9 +258,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 */
@@ -296,9 +309,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. */
@@ -406,7 +419,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. */
@@ -418,9 +431,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;
@@ -450,15 +463,16 @@ DoCopyFile(
switch ((int) (statBufPtr->st_mode & S_IFMT)) {
#ifndef DJGPP
case S_IFLNK: {
- char link[MAXPATHLEN];
+ char linkBuf[MAXPATHLEN];
int length;
- length = readlink(src, link, sizeof(link)); /* INTL: Native. */
+ length = readlink(src, linkBuf, sizeof(linkBuf));
+ /* 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
@@ -466,7 +480,7 @@ DoCopyFile(
#endif
break;
}
-#endif
+#endif /* !DJGPP */
case S_IFBLK:
case S_IFCHR:
if (mknod(dst, statBufPtr->st_mode, /* INTL: Native. */
@@ -504,10 +518,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. */
{
@@ -520,7 +534,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;
@@ -548,11 +564,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 */
/*
@@ -564,7 +580,7 @@ TclUnixCopyFile(
*/
if (blockSize <= 0) {
- blockSize = 4096;
+ blockSize = DEFAULT_COPY_BLOCK_SIZE;
}
buffer = ckalloc(blockSize);
while (1) {
@@ -627,9 +643,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;
@@ -670,7 +686,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;
@@ -817,7 +833,7 @@ DoRemoveDirectory(
* filled with UTF-8 name of file causing
* error. */
{
- CONST char *path;
+ const char *path;
mode_t oldPerm = 0;
int result;
@@ -915,7 +931,7 @@ TraverseUnixTree(
* files. */
{
Tcl_StatBuf statBuf;
- CONST char *source, *errfile;
+ const char *source, *errfile;
int result, sourceLen;
int targetLen;
#ifndef HAVE_FTS
@@ -923,7 +939,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
@@ -942,7 +958,7 @@ TraverseUnixTree(
* Process the regular file
*/
- return (*traverseProc)(sourcePtr, targetPtr, &statBuf, DOTREE_F,
+ return traverseProc(sourcePtr, targetPtr, &statBuf, DOTREE_F,
errorPtr);
}
#ifndef HAVE_FTS
@@ -955,18 +971,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);
}
@@ -1029,12 +1045,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;
@@ -1052,7 +1068,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;
@@ -1083,7 +1099,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;
@@ -1093,7 +1109,7 @@ TraverseUnixTree(
Tcl_DStringSetLength(targetPtr, targetLen);
}
}
-#endif /* HAVE_FTS */
+#endif /* !HAVE_FTS */
end:
if (errfile != NULL) {
@@ -1133,7 +1149,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
@@ -1197,7 +1213,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
@@ -1245,9 +1261,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;
@@ -1315,9 +1331,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;
}
@@ -1328,7 +1344,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);
@@ -1369,9 +1385,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;
}
@@ -1382,11 +1398,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;
}
@@ -1422,9 +1436,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;
}
@@ -1459,12 +1473,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);
@@ -1475,9 +1489,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;
}
@@ -1489,9 +1506,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;
}
@@ -1523,12 +1540,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);
@@ -1539,9 +1556,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;
}
@@ -1553,9 +1573,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;
}
@@ -1588,8 +1608,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);
/*
@@ -1623,9 +1643,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;
}
@@ -1633,8 +1653,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;
}
@@ -1644,9 +1666,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;
}
@@ -1673,7 +1695,8 @@ SetPermissionsAttribute(
Tcl_Obj *
TclpObjListVolumes(void)
{
- Tcl_Obj *resultPtr = Tcl_NewStringObj("/", 1);
+ Tcl_Obj *resultPtr;
+ TclNewLiteralStringObj(resultPtr, "/");
Tcl_IncrRefCount(resultPtr);
return resultPtr;
@@ -1701,7 +1724,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;
@@ -1894,14 +1917,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
/*
@@ -1953,8 +1976,6 @@ TclpObjNormalizePath(
* Reached directory separator.
*/
- Tcl_DString ds;
- CONST char *nativePath;
int accessOk;
nativePath = Tcl_UtfToExternalDString(NULL, path,
@@ -2005,7 +2026,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;
@@ -2080,6 +2101,152 @@ TclpObjNormalizePath(
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_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)) {
+ return dir;
+ }
+
+#ifdef P_tmpdir
+ dir = P_tmpdir;
+ if (stat(dir, &buf) == 0 && S_ISDIR(buf.st_mode) && access(dir, W_OK)) {
+ 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(HAVE_CHFLAGS) && defined(UF_IMMUTABLE)
/*
*----------------------------------------------------------------------
@@ -2112,14 +2279,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;
}
@@ -2148,9 +2315,8 @@ SetReadOnlyAttribute(
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;
@@ -2160,9 +2326,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;
}
@@ -2177,9 +2343,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;
}