From f0908a739b98b2f21b272ec808d6d22a3739356e Mon Sep 17 00:00:00 2001 From: vincentdarley Date: Thu, 29 Jan 2004 13:01:24 +0000 Subject: fix to file normalization with links --- ChangeLog | 4 ++++ generic/tclPathObj.c | 54 +++++++++++++++++++++++++++++++++++++++++----------- 2 files changed, 47 insertions(+), 11 deletions(-) diff --git a/ChangeLog b/ChangeLog index 7d3e573..df6d4e1 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,9 @@ 2004-01-29 Vince Darley + * generic/tclPathObj.c: fix to [Bug 883143] in file normalization + +2004-01-29 Vince Darley + * doc/file.n: * generic/tclFCmd.c * generic/tclTest.c diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index 5be3447..4391d46 100644 --- a/generic/tclPathObj.c +++ b/generic/tclPathObj.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: tclPathObj.c,v 1.22 2004/01/29 10:28:20 vincentdarley Exp $ + * RCS: @(#) $Id: tclPathObj.c,v 1.23 2004/01/29 13:01:24 vincentdarley Exp $ */ #include "tclInt.h" @@ -246,16 +246,48 @@ TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr) if (!first || (tclPlatform == TCL_PLATFORM_UNIX)) { link = Tcl_FSLink(retVal, NULL, 0); if (link != NULL) { - /* Got a link */ - Tcl_DecrRefCount(retVal); - retVal = link; - linkStr = Tcl_GetStringFromObj(retVal, &curLen); - /* Convert to forward-slashes on windows */ - if (tclPlatform == TCL_PLATFORM_WINDOWS) { - int i; - for (i = 0; i < curLen; i++) { - if (linkStr[i] == '\\') { - linkStr[i] = '/'; + /* + * Got a link. Need to check if the link + * is relative or absolute, for those platforms + * where relative links exist. + */ + if ((tclPlatform != TCL_PLATFORM_WINDOWS) + && (Tcl_FSGetPathType(link) == TCL_PATH_RELATIVE)) { + /* + * We need to follow this link which is + * relative to retVal's directory. This + * means concatenating the link onto + * the directory of the path so far. + */ + CONST char *path = Tcl_GetStringFromObj(retVal, + &curLen); + while (--curLen >= 0) { + if (IsSeparatorOrNull(path[curLen])) { + break; + } + } + if (Tcl_IsShared(retVal)) { + Tcl_DecrRefCount(retVal); + retVal = Tcl_DuplicateObj(retVal); + Tcl_IncrRefCount(retVal); + } + /* We want the trailing slash */ + Tcl_SetObjLength(retVal, curLen+1); + Tcl_AppendObjToObj(retVal, link); + Tcl_DecrRefCount(link); + linkStr = Tcl_GetStringFromObj(retVal, &curLen); + } else { + /* Absolute link */ + Tcl_DecrRefCount(retVal); + retVal = link; + linkStr = Tcl_GetStringFromObj(retVal, &curLen); + /* Convert to forward-slashes on windows */ + if (tclPlatform == TCL_PLATFORM_WINDOWS) { + int i; + for (i = 0; i < curLen; i++) { + if (linkStr[i] == '\\') { + linkStr[i] = '/'; + } } } } -- cgit v0.12