Implementation of TIP #210.

2 files changed, 138 insertions, 18 deletions

diff --git a/unix/configure.in b/unix/configure.in
index 61153a5..e5dc12b 100644
--- a/unix/configure.in
+++ b/unix/configure.in
@@ -3,7 +3,7 @@ dnl	This file is an input file used by the GNU "autoconf" program to
 dnl	generate the file "configure", which is run during Tcl installation
 dnl	to configure the system for the local environment.
 #
-# RCS: @(#) $Id: configure.in,v 1.189 2008/10/14 20:08:21 dgp Exp $
+# RCS: @(#) $Id: configure.in,v 1.190 2008/11/29 18:17:19 dkf Exp $
 
 AC_INIT([tcl],[8.6])
 AC_PREREQ(2.59)
@@ -244,24 +244,24 @@ fi
 SC_TIME_HANDLER
 
 #--------------------------------------------------------------------
-#	Some systems (e.g., IRIX 4.0.5) lack the st_blksize field
-#	in struct stat.  But we might be able to use fstatfs instead.
+#	Some systems (e.g., IRIX 4.0.5) lack the st_blksize field in struct
+#	stat. But we might be able to use fstatfs instead.
 #--------------------------------------------------------------------
 
 AC_STRUCT_ST_BLKSIZE
 AC_CHECK_FUNC(fstatfs, , [AC_DEFINE(NO_FSTATFS, 1, [Do we have fstatfs()?])])
 
 #--------------------------------------------------------------------
-#       Some system have no memcmp or it does not work with 8 bit
-#       data, this checks it and add memcmp.o to LIBOBJS if needed
+#       Some system have no memcmp or it does not work with 8 bit data, this
+#       checks it and add memcmp.o to LIBOBJS if needed
 #--------------------------------------------------------------------
 
 AC_FUNC_MEMCMP
 
 #--------------------------------------------------------------------
-#       Some system like SunOS 4 and other BSD like systems
-#       have no memmove (we assume they have bcopy instead).
-#       {The replacement define is in compat/string.h}
+#       Some system like SunOS 4 and other BSD like systems have no memmove
+#       (we assume they have bcopy instead). {The replacement define is in
+#       compat/string.h}
 #--------------------------------------------------------------------
 
 AC_CHECK_FUNC(memmove, , [
@@ -269,8 +269,8 @@ AC_CHECK_FUNC(memmove, , [
     AC_DEFINE(NO_STRING_H, 1, [Do we have <string.h>?]) ])
 
 #--------------------------------------------------------------------
-#	On some systems strstr is broken: it returns a pointer even
-#	even if the original string is empty.
+#	On some systems strstr is broken: it returns a pointer even even if
+#	the original string is empty.
 #--------------------------------------------------------------------
 
 SC_TCL_CHECK_BROKEN_FUNC(strstr, [
@@ -486,10 +486,10 @@ fi
 SC_ENABLE_LANGINFO
 
 #--------------------------------------------------------------------
-# Check for support of chflags function
+# Check for support of chflags and mkstemps functions
 #--------------------------------------------------------------------
 
-AC_CHECK_FUNCS(chflags)
+AC_CHECK_FUNCS(chflags mkstemps)
 
 #--------------------------------------------------------------------
 # Check for support of isnan() function or macro
@@ -552,7 +552,7 @@ else
 fi
 
 #--------------------------------------------------------------------
-# Check for support of fts functions (readdir replacement)
+#	Check for support of fts functions (readdir replacement)
 #--------------------------------------------------------------------
 
 AC_CACHE_CHECK([for fts], tcl_cv_api_fts, [
@@ -570,10 +570,9 @@ if test $tcl_cv_api_fts = yes; then
 fi
 
 #--------------------------------------------------------------------
-#	The statements below check for systems where POSIX-style
-#	non-blocking I/O (O_NONBLOCK) doesn't work or is unimplemented. 
-#	On these systems (mostly older ones), use the old BSD-style
-#	FIONBIO approach instead.
+#	The statements below check for systems where POSIX-style non-blocking
+#	I/O (O_NONBLOCK) doesn't work or is unimplemented. On these systems
+#	(mostly older ones), use the old BSD-style FIONBIO approach instead.
 #--------------------------------------------------------------------
 
 SC_BLOCKING_STYLE
diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c
index 868e98e..442c6d6 100644
--- a/unix/tclUnixFCmd.c
+++ b/unix/tclUnixFCmd.c
@@ -10,7 +10,7 @@
  * 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.69 2008/10/26 12:45:04 dkf Exp $
+ * RCS: @(#) $Id: tclUnixFCmd.c,v 1.70 2008/11/29 18:17:19 dkf Exp $
  *
  * Portions of this code were derived from NetBSD source code which has the
  * following copyright notice:
@@ -181,6 +181,7 @@ const TclFileAttrProcs tclpFileAttrProcs[] = {
 
 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);
@@ -2090,6 +2091,126 @@ TclpObjNormalizePath(
     return nextCheckpoint;
 }
 
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpOpenTemporaryFile --
+ *
+ *	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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Channel
+TclpOpenTemporaryFile(
+    Tcl_Obj *dirObj,
+    Tcl_Obj *basenameObj,
+    Tcl_Obj *extensionObj,
+    Tcl_Obj *resultingNameObj)
+{
+    Tcl_Channel chan;
+    Tcl_DString template, tmp;
+    const char *string;
+    int len, fd;
+
+    if (dirObj) {
+	string = Tcl_GetStringFromObj(dirObj, &len);
+	Tcl_UtfToExternalDString(NULL, string, len, &template);
+    } else {
+	Tcl_DStringInit(&template);
+	Tcl_DStringAppend(&template, DefaultTempDir(), -1); /* INTL: native */
+    }
+
+    Tcl_DStringAppend(&template, "/", -1);
+
+    if (basenameObj) {
+	string = Tcl_GetStringFromObj(basenameObj, &len);
+	Tcl_UtfToExternalDString(NULL, string, len, &tmp);
+	Tcl_DStringAppend(&template, Tcl_DStringValue(&tmp), -1);
+	Tcl_DStringFree(&tmp);
+    } else {
+	Tcl_DStringAppend(&template, "tcl", -1);
+    }
+
+    Tcl_DStringAppend(&template, "_XXXXXX", -1);
+
+#ifdef HAVE_MKSTEMPS
+    if (extensionObj) {
+	string = Tcl_GetStringFromObj(extensionObj, &len);
+	Tcl_UtfToExternalDString(NULL, string, len, &tmp);
+	Tcl_DStringAppend(&template, Tcl_DStringValue(&tmp), -1);
+	fd = mkstemps(Tcl_DStringValue(&template), Tcl_DStringLength(&tmp));
+	Tcl_DStringFree(&tmp);
+    } else
+#endif
+    {
+	fd = mkstemp(Tcl_DStringValue(&template));
+    }
+
+    if (fd == -1) {
+	return NULL;
+    }
+    chan = Tcl_MakeFileChannel(INT2PTR(fd), TCL_READABLE|TCL_WRITABLE);
+    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 chan;
+}
+
+/*
+ * 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 "/tmp" is always an existing writable directory; we've no
+     * recovery mechanism if it isn't.
+     */
+
+    return "/tmp";
+}
+
 #if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE)
 /*
  *----------------------------------------------------------------------