diff options
| -rw-r--r-- | ChangeLog | 18 | ||||
| -rw-r--r-- | generic/tclPathObj.c | 12 | ||||
| -rw-r--r-- | tests/fileSystem.test | 70 |
3 files changed, 92 insertions, 8 deletions
@@ -1,3 +1,9 @@ +2006-03-02 Don Porter <dgp@users.sourceforge.net> + + * generic/tclPathObj.c: Fix for failed normalization of + * tests/fileSystem.test: paths with /../ that lead back + to the root of the filesystem, like /foo/.. [Bug 1379287]. + 2006-03-01 Reinhard Max <max@suse.de> * unix/installManPage: Fix the script for manpages that have @@ -6,10 +12,10 @@ 2006-02-28 Don Porter <dgp@users.sourceforge.net> - * generic/tclBasic.c: Corrections to be sure that TCL_EVAL_GLOBAL - * tests/namespace.test: evaluations act the same as [uplevel #0] - * tests/parse.test: evaluations, even when execution traces or - * tests/trace.test: invocations of [::unknown] are present. + * generic/tclBasic.c: Corrections to be sure that TCL_EVAL_GLOBAL + * tests/namespace.test: evaluations act the same as [uplevel #0] + * tests/parse.test: evaluations, even when execution traces or + * tests/trace.test: invocations of [::unknown] are present. [Bug 1439836]. 2006-02-22 Don Porter <dgp@users.sourceforge.net> @@ -25,8 +31,8 @@ 2006-02-16 Don Porter <dgp@users.sourceforge.net> - * generic/tclIndexObj.c: Disallow the "ambiguous" error message - * tests/indexObj.test: when TCL_EXACT matching is requested. + * generic/tclIndexObj.c: Disallow the "ambiguous" error message + * tests/indexObj.test: when TCL_EXACT matching is requested. * tests/ioCmd.test: 2006-02-15 Don Porter <dgp@users.sourceforge.net> diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index 9ed241a..0cc577b 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.49 2006/01/12 18:35:28 vasiljevic Exp $ + * RCS: @(#) $Id: tclPathObj.c,v 1.50 2006/03/03 04:32:11 dgp Exp $ */ #include "tclInt.h" @@ -309,12 +309,20 @@ TclFSNormalizeAbsolutePath( * Either way, we now remove the last path element. */ - while (--curLen >= 0) { + while (--curLen > 0) { if (IsSeparatorOrNull(linkStr[curLen])) { Tcl_SetObjLength(retVal, curLen); break; } } + if (curLen == 0) { + /* Attempt to .. beyond root becomes root: "/" */ + if (dirSep[3] != 0) { + Tcl_SetObjLength(retVal, 0); + } else { + Tcl_SetObjLength(retVal, 1); + } + } } dirSep += 3; oldDirSep = dirSep; diff --git a/tests/fileSystem.test b/tests/fileSystem.test index 3c0bac2..7487743 100644 --- a/tests/fileSystem.test +++ b/tests/fileSystem.test @@ -370,6 +370,76 @@ test filesystem-1.41 {file normalisation with repeated separators} {win} { set res "ok" } } {ok} +test filesystem-1.42 {file normalisation .. beyond root (Bug 1379287)} { + set a [file norm /xxx/..] + set b [file norm /] + + if {![string equal $a $b]} { + set res "Paths should be equal: $a , $b" + } else { + set res "ok" + } +} {ok} +test filesystem-1.42.1 {file normalisation .. beyond root (Bug 1379287)} { + set a [file norm /xxx/../] + set b [file norm /] + + if {![string equal $a $b]} { + set res "Paths should be equal: $a , $b" + } else { + set res "ok" + } +} {ok} +test filesystem-1.43 {file normalisation .. beyond root (Bug 1379287)} { + set a [file norm /xxx/foo/../..] + set b [file norm /] + + if {![string equal $a $b]} { + set res "Paths should be equal: $a , $b" + } else { + set res "ok" + } +} {ok} +test filesystem-1.43.1 {file normalisation .. beyond root (Bug 1379287)} { + set a [file norm /xxx/foo/../../] + set b [file norm /] + + if {![string equal $a $b]} { + set res "Paths should be equal: $a , $b" + } else { + set res "ok" + } +} {ok} +test filesystem-1.44 {file normalisation .. beyond root (Bug 1379287)} { + set a [file norm /xxx/foo/../../bar] + set b [file norm /bar] + + if {![string equal $a $b]} { + set res "Paths should be equal: $a , $b" + } else { + set res "ok" + } +} {ok} +test filesystem-1.45 {file normalisation .. beyond root (Bug 1379287)} { + set a [file norm /xxx/../../bar] + set b [file norm /bar] + + if {![string equal $a $b]} { + set res "Paths should be equal: $a , $b" + } else { + set res "ok" + } +} {ok} +test filesystem-1.46 {file normalisation .. beyond root (Bug 1379287)} { + set a [file norm /xxx/../bar] + set b [file norm /bar] + + if {![string equal $a $b]} { + set res "Paths should be equal: $a , $b" + } else { + set res "ok" + } +} {ok} test filesystem-2.0 {new native path} {unix} { foreach f [lsort [glob -nocomplain /usr/bin/c*]] { |