channel-copy-fix

5 files changed, 39 insertions, 25 deletions

diff --git a/ChangeLog b/ChangeLog
index 4203368..426f553 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,15 @@
+2001-09-08 Vince Darley <vincentdarley@users.sourceforge.net>
+
+	* generic/tclInt.h: 
+	* generic/tclFCmd.c:
+	* doc/FileSystem.3:
+	* generic/tclIOUtil.c: removed Tcl_FSCopyFile fallback
+	to channel copying, since the channels will not have
+	access to interpreters and the channel copying currently
+	requires an interp.  Code which required cross-platform
+	copies always has interpreters, so that solves the problem.
+	Fixes bug in TclKit.
+	
 2001-09-07  David Gravereaux <davygrvy@pobox.com>
 
 	* win/tcl.m4: Added -link50compat option so a VC6 linker makes
diff --git a/doc/FileSystem.3 b/doc/FileSystem.3
index 97bfe2c..97f1a78 100644
--- a/doc/FileSystem.3
+++ b/doc/FileSystem.3
@@ -4,7 +4,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" RCS: @(#) $Id: FileSystem.3,v 1.5 2001/09/04 18:06:34 vincentdarley Exp $
+'\" RCS: @(#) $Id: FileSystem.3,v 1.6 2001/09/08 14:05:09 vincentdarley Exp $
 '\" 
 .so man.macros
 .TH Tcl_FSCopyFile 3 8.4 Tcl "Tcl Library Procedures"
@@ -252,8 +252,8 @@ passing it in, or decrementing it.
 path name given by destPathPtr.  If the two paths given lie in the same
 filesystem (according to \fBTcl_FSGetFileSystemForPath\fR) then that
 filesystem's 'copy file' function is called (if it is non-NULL).
-Otherwise a cross-filesystem copy is attempted using a combination
-of open-r/open-w/fcopy (at the C level).
+Otherwise the function returns -1 and sets Tcl's errno to the 'EXDEV'
+posix error code (which signifies a 'cross-domain link').
 .PP
 \fBTcl_FSCopyDirectory\fR attempts to copy the directory given by srcPathPtr to the
 path name given by destPathPtr.  If the two paths given lie in the same
@@ -629,7 +629,7 @@ functions (it will use \fITcl_FSCopyFileProc\fR followed by
 implemented there is a further fallback).  However, if a
 \fITcl_FSRenameFile\fR command is issued at the C level, no such
 fallbacks occur.  This is true except for the last five entries in the
-filesystem table (lstat, load, unload, getcwd and chdir) and copyfile
+filesystem table (lstat, load, unload, getcwd and chdir)
 for which fallbacks do in fact occur at the C level.
 .PP
 Any functions which take path names in Tcl_Obj form take
diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c
index c05b7a4..042fe79 100644
--- a/generic/tclFCmd.c
+++ b/generic/tclFCmd.c
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclFCmd.c,v 1.12 2001/09/04 18:06:34 vincentdarley Exp $
+ * RCS: @(#) $Id: tclFCmd.c,v 1.13 2001/09/08 14:05:09 vincentdarley Exp $
  */
 
 #include "tclInt.h"
@@ -599,6 +599,9 @@ CopyRenameOneFile(interp, source, target, copyFlag, force)
 	}
     } else {
 	result = Tcl_FSCopyFile(source, target);
+	if ((result != TCL_OK) && (errno == EXDEV)) {
+	    result = TclCrossFilesystemCopy(interp, source, target);
+	}
 	if (result != TCL_OK) {
 	    /* 
 	     * We could examine 'errno' to double-check if the problem
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 2650ecd..771b139 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -17,7 +17,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclIOUtil.c,v 1.19 2001/09/06 17:51:00 vincentdarley Exp $
+ * RCS: @(#) $Id: tclIOUtil.c,v 1.20 2001/09/08 14:05:09 vincentdarley Exp $
  */
 
 #include "tclInt.h"
@@ -47,8 +47,6 @@ static Tcl_PathType     FSGetPathType  _ANSI_ARGS_((Tcl_Obj *pathObjPtr,
 static Tcl_PathType     GetPathType  _ANSI_ARGS_((Tcl_Obj *pathObjPtr, 
 			    Tcl_Filesystem **filesystemPtrPtr, 
 			    int *driveNameLengthPtr, Tcl_Obj **driveNameRef));
-static int              CrossFilesystemCopy _ANSI_ARGS_((Tcl_Obj *source, 
-							 Tcl_Obj *target));
 
 /*
  * Define the 'path' object type, which Tcl uses to represent
@@ -2282,11 +2280,12 @@ Tcl_FSLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr,
 		return -1;
 	    }
 	    
-	    if (CrossFilesystemCopy(pathPtr, copyToPtr) == TCL_OK) {
+	    if (TclCrossFilesystemCopy(interp, pathPtr, 
+				       copyToPtr) == TCL_OK) {
 		/* 
 		 * Do we need to set appropriate permissions 
 		 * on the file?  This may be required on some
-		 * systems.  On Unix we could do loop over
+		 * systems.  On Unix we could loop over
 		 * the file attributes, and set any that are
 		 * called "-permissions" to 0777.  Or directly:
 		 * 
@@ -2991,16 +2990,13 @@ Tcl_FSCopyFile(srcPathPtr, destPathPtr)
     if (retVal == -1) {
 	Tcl_SetErrno(EXDEV);
     }
-    if ((retVal != TCL_OK) && (errno == EXDEV)) {
-        retVal = CrossFilesystemCopy(srcPathPtr, destPathPtr);
-    }
     return retVal;
 }
 
 /*
  *---------------------------------------------------------------------------
  *
- * CrossFilesystemCopy --
+ * TclCrossFilesystemCopy --
  *
  *	Helper for above function, and for Tcl_FSLoadFile, to copy
  *	files from one filesystem to another.  This function will
@@ -3014,22 +3010,23 @@ Tcl_FSCopyFile(srcPathPtr, destPathPtr)
  *
  *---------------------------------------------------------------------------
  */
-static int 
-CrossFilesystemCopy(source, target) 
+int 
+TclCrossFilesystemCopy(interp, source, target) 
+    Tcl_Interp *interp; /* For error messages */
     Tcl_Obj *source;	/* Pathname of file to be copied (UTF-8). */
     Tcl_Obj *target;	/* Pathname of file to copy to (UTF-8). */
 {
     int result = TCL_ERROR;
     int prot = 0666;
     
-    Tcl_Channel out = Tcl_FSOpenFileChannel(NULL, target, "w", prot);
+    Tcl_Channel out = Tcl_FSOpenFileChannel(interp, target, "w", prot);
     if (out != NULL) {
 	/* It looks like we can copy it over */
-	Tcl_Channel in = Tcl_FSOpenFileChannel(NULL, source, 
+	Tcl_Channel in = Tcl_FSOpenFileChannel(interp, source, 
 					       "r", prot);
 	if (in == NULL) {
 	    /* This is very strange, we checked this above */
-	    Tcl_Close(NULL, out);
+	    Tcl_Close(interp, out);
 	} else {
 	    struct stat sourceStatBuf;
 	    struct utimbuf tval;
@@ -3038,18 +3035,18 @@ CrossFilesystemCopy(source, target)
 	     * asynchronous option to support vfs's which are
 	     * slow (e.g. network sockets).
 	     */
-	    Tcl_SetChannelOption(NULL, in, "-translation", "binary");
-	    Tcl_SetChannelOption(NULL, out, "-translation", "binary");
+	    Tcl_SetChannelOption(interp, in, "-translation", "binary");
+	    Tcl_SetChannelOption(interp, out, "-translation", "binary");
 	    
-	    if (TclCopyChannel(NULL, in, out, -1, NULL) == TCL_OK) {
+	    if (TclCopyChannel(interp, in, out, -1, NULL) == TCL_OK) {
 		result = TCL_OK;
 	    }
 	    /* 
 	     * If the copy failed, assume that copy channel left
 	     * a good error message.
 	     */
-	    Tcl_Close(NULL, in);
-	    Tcl_Close(NULL, out);
+	    Tcl_Close(interp, in);
+	    Tcl_Close(interp, out);
 	    
 	    /* Set modification date of copied file */
 	    if (Tcl_FSLstat(source, &sourceStatBuf) != 0) {
diff --git a/generic/tclInt.h b/generic/tclInt.h
index f14e415..5565338 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclInt.h,v 1.63 2001/09/04 18:06:34 vincentdarley Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.64 2001/09/08 14:05:09 vincentdarley Exp $
  */
 
 #ifndef _TCLINT
@@ -1821,6 +1821,8 @@ EXTERN Tcl_Obj*         TclpNativeSplitPath _ANSI_ARGS_((Tcl_Obj *pathPtr,
 							 int *lenPtr));
 EXTERN Tcl_PathType     TclpGetNativePathType _ANSI_ARGS_((Tcl_Obj *pathObjPtr,
 			    int *driveNameLengthPtr, Tcl_Obj **driveNameRef));
+EXTERN int 		TclCrossFilesystemCopy _ANSI_ARGS_((Tcl_Interp *interp, 
+			    Tcl_Obj *source, Tcl_Obj *target));
 EXTERN int		TclpObjDeleteFile _ANSI_ARGS_((Tcl_Obj *pathPtr));
 EXTERN int		TclpObjCopyDirectory _ANSI_ARGS_((Tcl_Obj *srcPathPtr, 
 				Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr));