diff options
| -rw-r--r-- | ChangeLog | 12 | ||||
| -rw-r--r-- | doc/file.n | 40 | ||||
| -rw-r--r-- | generic/tclCmdAH.c | 18 | ||||
| -rw-r--r-- | tests/fCmd.test | 39 | ||||
| -rw-r--r-- | tests/fileSystem.test | 16 | ||||
| -rw-r--r-- | unix/tclUnixFile.c | 58 | ||||
| -rw-r--r-- | win/tclWinFCmd.c | 47 |
7 files changed, 183 insertions, 47 deletions
@@ -1,5 +1,17 @@ 2003-12-17 Vince Darley <vincentdarley@users.sourceforge.net> + * generic/tclCmdAH.c: + * unix/tclUnixFile.c: + * win/tclWinFCmd.c: + * tests/fCmd.test: + * tests/fileSystem.test: + * doc/file.n: final fix to support for relative links and + its implications on normalization and other parts of the + filesystem code. Fixes [Bug 859251] and some Windows + problems with recursive file delete/copy and symbolic links. + +2003-12-17 Vince Darley <vincentdarley@users.sourceforge.net> + * generic/tclPathObj.c: * tests/fileSystem.test: fix and tests for [Bug 860402] in new file normalization code. @@ -5,7 +5,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: file.n,v 1.26 2003/12/12 17:02:13 vincentdarley Exp $ +'\" RCS: @(#) $Id: file.n,v 1.27 2003/12/17 17:47:28 vincentdarley Exp $ '\" .so man.macros .TH file n 8.3 Tcl "Tcl Built-In Commands" @@ -206,30 +206,34 @@ If only one argument is given, that argument is assumed to be seems to be the case with hard links, which look just like ordinary files), then an error is returned. . -If 2 arguments are given, then these are assumed to be \fIlinkName\fR and -\fItarget\fR. If \fIlinkName\fR already exists, or if \fItarget\fR +If 2 arguments are given, then these are assumed to be \fIlinkName\fR +and \fItarget\fR. If \fIlinkName\fR already exists, or if \fItarget\fR doesn't exist, an error will be returned. Otherwise, Tcl creates a new -link called \fIlinkName\fR which points to the existing filesystem object -at \fItarget\fR, where the type of the link is platform-specific (on Unix -a symbolic link will be the default). This is useful for the case where -the user wishes to create a link in a cross-platform way, and doesn't -care what type of link is created. +link called \fIlinkName\fR which points to the existing filesystem +object at \fItarget\fR (which is also the returned value), where the +type of the link is platform-specific (on Unix a symbolic link will be +the default). This is useful for the case where the user wishes to +create a link in a cross-platform way, and doesn't care what type of +link is created. . If the user wishes to make a link of a specific type only, (and signal an error if for some reason that is not possible), then the optional \fI-linktype\fR argument should be given. Accepted values for \fI-linktype\fR are "-symbolic" and "-hard". . -On Unix, symbolic links can be made to relative paths, but on all other -platforms target paths will be converted to absolute, normalized form -before the link is created (and "~user" paths are always expanded to -absolute form). When creating links on filesystems that -either do not support any links, or do not support the specific type -requested, an error message will be returned. In particular Windows 95, -98 and ME do not support any links at present, but most Unix platforms -support both symbolic and hard links (the latter for files only), MacOS -supports symbolic links and Windows NT/2000/XP (on NTFS drives) support -symbolic directory links and hard file links. +On Unix, symbolic links can be made to relative paths, and those paths +must be relative to the actual \fIlinkName\fR's location (not to the +cwd), but on all other platforms where relative links are not supported, +target paths will always be converted to absolute, normalized form +before the link is created (and therefore relative paths are interpreted +as relative to the cwd). Furthermore, "~user" paths are always expanded +to absolute form. When creating links on filesystems that either do not +support any links, or do not support the specific type requested, an +error message will be returned. In particular Windows 95, 98 and ME do +not support any links at present, but most Unix platforms support both +symbolic and hard links (the latter for files only), MacOS supports +symbolic links and Windows NT/2000/XP (on NTFS drives) support symbolic +directory links and hard file links. .TP \fBfile lstat \fIname varName\fR . diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index 97266c0..41c9873 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -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: tclCmdAH.c,v 1.37 2003/12/12 17:02:37 vincentdarley Exp $ + * RCS: @(#) $Id: tclCmdAH.c,v 1.38 2003/12/17 17:47:28 vincentdarley Exp $ */ #include "tclInt.h" @@ -1071,7 +1071,19 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) Tcl_GetString(objv[index]), "\": that path already exists", (char *) NULL); } else if (errno == ENOENT) { - if (Tcl_FSAccess(objv[index+1], F_OK) == 0) { + /* + * There are two cases here: either the target + * doesn't exist, or the directory of the src + * doesn't exist. + */ + int access; + Tcl_Obj *dirPtr = TclFileDirname(interp, objv[index]); + if (dirPtr == NULL) { + return TCL_ERROR; + } + access = Tcl_FSAccess(dirPtr, F_OK); + Tcl_DecrRefCount(dirPtr); + if (access != 0) { Tcl_AppendResult(interp, "could not create new link \"", Tcl_GetString(objv[index]), @@ -1081,7 +1093,7 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) Tcl_AppendResult(interp, "could not create new link \"", Tcl_GetString(objv[index]), - "\" since target \"", + "\": target \"", Tcl_GetString(objv[index+1]), "\" doesn't exist", (char *) NULL); diff --git a/tests/fCmd.test b/tests/fCmd.test index 71a72cf..c0f6948 100644 --- a/tests/fCmd.test +++ b/tests/fCmd.test @@ -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: fCmd.test,v 1.34 2003/12/16 15:26:44 vincentdarley Exp $ +# RCS: @(#) $Id: fCmd.test,v 1.35 2003/12/17 17:47:28 vincentdarley Exp $ # if {[lsearch [namespace children] ::tcltest] == -1} { @@ -2154,7 +2154,7 @@ test fCmd-26.2 {TclDeleteFilesCmd: delete dir with symlink} {unixOnly notRoot} { file mkdir tfad1 file mkdir tfad2 - file link -symbolic [file join tfad2 link] tfad1 + file link -symbolic [file join tfad2 link] [file join .. tfad1] file delete -force tfad2 set r1 [file isdir tfad1] @@ -2306,7 +2306,7 @@ test fCmd-28.10 {file link: linking to nonexistent path} {linkDirectory} { set res [list [catch {file link abc.link abc2.doesnt} msg] $msg] cd [workingDirectory] set res -} {1 {could not create new link "abc.link" since target "abc2.doesnt" doesn't exist}} +} {1 {could not create new link "abc.link": target "abc2.doesnt" doesn't exist}} test fCmd-28.10.1 {file link: linking to nonexistent path} {linkDirectory} { cd [temporaryDirectory] @@ -2388,7 +2388,10 @@ test fCmd-28.15.2 {file link: copies link not dir} {linkDirectory} { cd [temporaryDirectory] file delete -force abc.link file delete -force abc2.link - +cd abc.dir +file delete -force abc.file +file delete -force abc2.file +cd .. file copy abc.file abc.dir file copy abc2.file abc.dir cd [workingDirectory] @@ -2416,12 +2419,40 @@ test fCmd-28.18 {file link: glob -type d} {linkDirectory} { set res } [lsort [list abc.link abc.dir abc2.dir]] +test fCmd-28.19 {file link: relative paths} {winOnly linkDirectory} { + cd [temporaryDirectory] + file mkdir d1/d2/d3 + set res [list [catch {file link d1/l2 d1/d2} err] $err] + lappend res [catch {file delete -force d1} err] $err +} {0 d1/d2 0 {}} + +test fCmd-28.20 {file link: relative paths} {unixOnly linkDirectory} { + cd [temporaryDirectory] + file mkdir d1/d2/d3 + list [catch {file link d1/l2 d1/d2} res] $res +} {1 {could not create new link "d1/l2": target "d1/d2" doesn't exist}} + +test fCmd-28.21 {file link: relative paths} {unixOnly linkDirectory} { + cd [temporaryDirectory] + file mkdir d1/d2/d3 + list [catch {file link d1/l2 d2} res] $res +} {0 d2} + +test fCmd-28.22 {file link: relative paths} {unixOnly linkDirectory} { + cd [temporaryDirectory] + file mkdir d1/d2/d3 + catch {file delete -force d1/l2} + list [catch {file link d1/l2 d2/d3} res] $res +} {0 d2/d3} + test fCmd-29.1 {weird memory corruption fault} { catch {set res [open [file join ~a_totally_bogus_user_id/foo bar]]} } 1 cd [temporaryDirectory] file delete -force abc.link +file delete -force d1/d2 +file delete -force d1 cd [workingDirectory] removeFile abc2.file diff --git a/tests/fileSystem.test b/tests/fileSystem.test index 3a78665..91a468f 100644 --- a/tests/fileSystem.test +++ b/tests/fileSystem.test @@ -41,13 +41,17 @@ proc testPathEqual {one two} { } if {[catch { - file link link.file gorp.file + file link link.file gorp.file + cd dir.dir file link \ - [file join dir.dir linkinside.file] \ - [file join dir.dir inside.file] + [file join linkinside.file] \ + [file join inside.file] + cd .. file link dir.link dir.dir - file link [file join dir.dir dirinside.link] \ - [file join dir.dir dirinside.dir] + cd dir.dir + file link [file join dirinside.link] \ + [file join dirinside.dir] + cd .. }]} { tcltest::testConstraint hasLinks 0 } else { @@ -121,7 +125,7 @@ test filesystem-1.10 {link normalisation: double link} {macOrUnix hasLinks} { makeDirectory dir2.file test filesystem-1.11 {link normalisation: double link, back in tree} {macOrUnix hasLinks} { - file link [file join dir2.file dir2.link] dir2.link + file link [file join dir2.file dir2.link] [file join .. dir2.link] testPathEqual [file normalize [file join dir.dir linkinside.file foo]] \ [file normalize [file join dir2.file dir2.link inside.file foo]] } {1} diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c index 66c31b9..96d2fda 100644 --- a/unix/tclUnixFile.c +++ b/unix/tclUnixFile.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: tclUnixFile.c,v 1.35 2003/12/12 17:09:34 vincentdarley Exp $ + * RCS: @(#) $Id: tclUnixFile.c,v 1.36 2003/12/17 17:47:28 vincentdarley Exp $ */ #include "tclInt.h" @@ -715,21 +715,57 @@ TclpObjLink(pathPtr, toPtr, linkAction) { if (toPtr != NULL) { CONST char *src = Tcl_FSGetNativePath(pathPtr); - CONST char *target = Tcl_FSGetNativePath(toPtr); + CONST char *target = NULL; + if (src == NULL) return NULL; - if (src == NULL || target == NULL) { - return NULL; + /* + * If we're making a symbolic link and the path is relative, + * then we must check whether it exists _relative_ to the + * directory in which the src is found (not relative to the + * current cwd which is just not relevant in this case). + * + * If we're making a hard link, then a relative path is + * just converted to absolute relative to the cwd. + */ + if ((linkAction & TCL_CREATE_SYMBOLIC_LINK) + && (Tcl_FSGetPathType(toPtr) == TCL_PATH_RELATIVE)) { + Tcl_Obj *dirPtr, *absPtr; + dirPtr = TclFileDirname(NULL, pathPtr); + if (dirPtr == NULL) { + return NULL; + } + absPtr = Tcl_FSJoinToPath(dirPtr, 1, &toPtr); + Tcl_IncrRefCount(absPtr); + if (Tcl_FSAccess(absPtr, F_OK) == -1) { + Tcl_DecrRefCount(absPtr); + Tcl_DecrRefCount(dirPtr); + /* target doesn't exist */ + errno = ENOENT; + return NULL; + } + /* + * Target exists; we'll construct the relative + * path we want below. + */ + Tcl_DecrRefCount(absPtr); + Tcl_DecrRefCount(dirPtr); + } else { + target = Tcl_FSGetNativePath(toPtr); + if (access(target, F_OK) == -1) { + /* target doesn't exist */ + errno = ENOENT; + return NULL; + } + if (target == NULL) { + return NULL; + } } + if (access(src, F_OK) != -1) { /* src exists */ errno = EEXIST; return NULL; } - if (access(target, F_OK) == -1) { - /* target doesn't exist */ - errno = ENOENT; - return NULL; - } /* * Check symbolic link flag first, since we prefer to * create these. @@ -740,8 +776,8 @@ TclpObjLink(pathPtr, toPtr, linkAction) Tcl_Obj *transPtr; /* * Now we don't want to link to the absolute, normalized path. - * Relative links are quite acceptable, as are links to '~user', - * for example. + * Relative links are quite acceptable (but links to ~user + * are not -- these must be expanded first). */ transPtr = Tcl_FSGetTranslatedPath(NULL, toPtr); if (transPtr == NULL) { diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c index 519df62..c565d33 100644 --- a/win/tclWinFCmd.c +++ b/win/tclWinFCmd.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: tclWinFCmd.c,v 1.37 2003/10/13 16:48:07 vincentdarley Exp $ + * RCS: @(#) $Id: tclWinFCmd.c,v 1.38 2003/12/17 17:47:28 vincentdarley Exp $ */ #include "tclWinInt.h" @@ -22,6 +22,7 @@ #define DOTREE_PRED 1 /* pre-order directory */ #define DOTREE_POSTD 2 /* post-order directory */ #define DOTREE_F 3 /* regular file */ +#define DOTREE_LINK 4 /* symbolic link */ /* * Callbacks for file attributes code. @@ -969,6 +970,7 @@ DoRemoveJustDirectory( * DString filled with UTF-8 name of file * causing error. */ { + DWORD attr; /* * The RemoveDirectory API acts differently under Win95/98 and NT * WRT NULL and "". Avoid passing these values. @@ -979,13 +981,24 @@ DoRemoveJustDirectory( goto end; } - if ((*tclWinProcs->removeDirectoryProc)(nativePath) != FALSE) { - return TCL_OK; + attr = (*tclWinProcs->getFileAttributesProc)(nativePath); + + if (attr & FILE_ATTRIBUTE_REPARSE_POINT) { + /* It is a symbolic link -- remove it */ + if (TclWinSymLinkDelete(nativePath, 0) == 0) { + return TCL_OK; + } + } else { + /* Ordinary directory */ + if ((*tclWinProcs->removeDirectoryProc)(nativePath) != FALSE) { + return TCL_OK; + } } + TclWinConvertError(GetLastError()); if (Tcl_GetErrno() == EACCES) { - DWORD attr = (*tclWinProcs->getFileAttributesProc)(nativePath); + attr = (*tclWinProcs->getFileAttributesProc)(nativePath); if (attr != 0xffffffff) { if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) { /* @@ -1021,6 +1034,7 @@ DoRemoveJustDirectory( * Windows 95 and Win32s report removing a non-empty directory * as EACCES, not EEXIST. If the directory is not empty, * change errno so caller knows what's going on. + */ if (TclWinGetPlatformId() != VER_PLATFORM_WIN32_NT) { @@ -1166,6 +1180,16 @@ TraverseWinTree( nativeErrfile = nativeSource; goto end; } + + if (sourceAttr & FILE_ATTRIBUTE_REPARSE_POINT) { + /* + * Process the symbolic link + */ + + return (*traverseProc)(nativeSource, nativeTarget, + DOTREE_LINK, errorPtr); + } + if ((sourceAttr & FILE_ATTRIBUTE_DIRECTORY) == 0) { /* * Process the regular file @@ -1344,10 +1368,17 @@ TraversalCopy( } break; } + case DOTREE_LINK: { + if (TclWinSymLinkCopyDirectory(nativeSrc, nativeDst) == TCL_OK) { + return TCL_OK; + } + break; + } case DOTREE_PRED: { if (DoCreateDirectory(nativeDst) == TCL_OK) { DWORD attr = (*tclWinProcs->getFileAttributesProc)(nativeSrc); - if ((*tclWinProcs->setFileAttributesProc)(nativeDst, attr) != FALSE) { + if ((*tclWinProcs->setFileAttributesProc)(nativeDst, attr) + != FALSE) { return TCL_OK; } TclWinConvertError(GetLastError()); @@ -1406,6 +1437,12 @@ TraversalDelete( } break; } + case DOTREE_LINK: { + if (DoRemoveJustDirectory(nativeSrc, 0, NULL) == TCL_OK) { + return TCL_OK; + } + break; + } case DOTREE_PRED: { return TCL_OK; } |