From e8b43db1be149b33a510f281789b13d6e266797d Mon Sep 17 00:00:00 2001 From: vincentdarley Date: Sat, 8 Sep 2001 14:05:08 +0000 Subject: channel-copy-fix --- ChangeLog | 12 ++++++++++++ doc/FileSystem.3 | 8 ++++---- generic/tclFCmd.c | 5 ++++- generic/tclIOUtil.c | 35 ++++++++++++++++------------------- generic/tclInt.h | 4 +++- 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 + + * 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 * 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)); -- cgit v0.12