Front page | perl.perl5.porters |
Postings from February 2004
[perl #27052] File::Spec->canonpath("a\\..\\..\\b") returns wrong value for Win 32
From:
Dinger, Tom
Date:
February 24, 2004 20:29
Subject:
[perl #27052] File::Spec->canonpath("a\\..\\..\\b") returns wrong value for Win 32
Message ID:
rt-3.0.8-27052-79782.19.3345216057917@perl.org
# New Ticket Created by "Dinger, Tom"
# Please include the string: [perl #27052]
# in the subject line of all future correspondence about this issue.
# <URL: http://rt.perl.org:80/rt3/Ticket/Display.html?id=27052 >
This is a bug report for perl from tom.dinger@scansoft.com,
generated with the help of perlbug 1.34 running under perl v5.8.3.
-----------------------------------------------------------------
[Please enter your report here]
Under Windows (using File::Spec::Win32), the call
File::Spec->canonpath('a\\..\\..\\b\\c') returns the wrong value: 'b\\c'.
It should return '..\\b\\c'.
This bug first appeared in the Perl 5.8.1 release; Perl 5.8.0 does not
have this problem.
In Perl 5.8.0, the behavior of canonpath() for Win32.pm was very similar
to that for Unix.pm: no ".." directory entries were removed from the
path. For UNIX systems this is appropriate, as symbolic and hard links
may make "a/b/../c" different than "a/c".
In Perl 5.8.1, a number of multiple-dot transformations were added to the
Win32 support: changing "a\\...\\b" into "a\\..\\..\\b", removing redundant
double-dots, etc. If all paths handed to canonpath() are absolute paths,
then it works correctly, but if the path is a relative path, it may make
a mistake when trying to eliminate the ".." path elements -- apparently
it sometimes treats a relative path as absolute, and since '\\..\\a' is the
same as 'a' on Windows, it was changing '..\\a' to 'a' as well in some
situations.
Compounding the problem is that canonpath() is used by other functions
as well, so catfile() and catpath() also suffer errors.
Attached is acontext-diff of the changes I have made and tested for the
canonpath() function in lib/File/Spec/Win32.pm, and additional tests for
the problems (and fix) in lib/File/Spec/t/Spec.t.
###################################################################
--- lib\File\Spec\Win32.pm.orig Tue Sep 16 01:54:20 2003
+++ lib\File\Spec\Win32.pm Tue Feb 24 13:05:22 2004
@@ -5,7 +5,7 @@
use vars qw(@ISA $VERSION);
require File::Spec::Unix;
-$VERSION = '1.4';
+$VERSION = '1.5';
@ISA = qw(File::Spec::Unix);
@@ -140,28 +140,53 @@
$path =~ s{^\\\.\.$}{\\}; # \.. -> \
1 while $path =~ s{^\\\.\.}{}; # \..\xx -> \xx
- my ($vol,$dirs,$file) = $self->splitpath($path);
- my @dirs = $self->splitdir($dirs);
- my (@base_dirs, @path_dirs);
- my $dest = \@base_dirs;
- for my $dir (@dirs){
- $dest = \@path_dirs if $dir eq $self->updir;
- push @$dest, $dir;
- }
- # for each .. in @path_dirs pop one item from
- # @base_dirs
- while (my $dir = shift @path_dirs){
- unless ($dir eq $self->updir){
- unshift @path_dirs, $dir;
- last;
- }
- pop @base_dirs;
- }
- $path = $self->catpath(
- $vol,
- $self->catdir(@base_dirs, @path_dirs),
- $file
- );
+ my ($vol,$dirs,$file) = $self->splitpath($path,1);
+
+ # The previous version of the code did completely the wrong thing in
+ # at least one important case:
+ #
+ # input result should be
+ # ----------- ------ ---------
+ # a\..\..\b\c b\c ..\b\c
+ #
+ # So this is a simpler rewrite.
+
+ my @dirs = $self->splitdir( $dirs );
+
+ # We walk through the list, looking for pairs ("x\..") to toss,
+ # e.g. "a\x\..\b" --> "a\b".
+ # But if the previous element is '..' we cannot toss this one.
+ # If the previous element is '', we can toss this one, but not the
+ # previous one (it stands for the root of the file system).
+
+ for ( my $i = 1; $i < @dirs; )
+ {
+ if ( ($i == 0) or ($dirs[$i] ne $self->updir) )
+ {
+ ++$i; # skip this one, nothing to do.
+ }
+ elsif ( ($i == 1) and ($dirs[$i-1] eq '') )
+ {
+ # E.g. "C:\..\stuff" --> "C:\stuff"
+ splice @dirs, $i, 1; # and leave $i alone.
+ }
+ elsif ( $dirs[$i-1] ne $self->updir )
+ {
+ # E.g. "a\b\..\c" --> "a\c"
+ splice @dirs, $i - 1, 2;
+ --$i; # the next one to check
+ }
+ else
+ {
+ ++$i; # don't remove this one.
+ }
+ }
+
+ $path = $self->catpath( $vol, $self->catdir(@dirs), $file );
+
+# $path .= '.' if substr($path,-1,1) eq ':'; # change "X:" into "X:."
+ $path .= '.' if $path eq ''; # change "" into "."
+
return $path;
}
--- lib\File\Spec\t\Spec.t.orig Fri Dec 19 09:01:46 2003
+++ lib\File\Spec\t\Spec.t Tue Feb 24 13:07:32 2004
@@ -201,6 +201,10 @@
[ "Win32->catfile('.\\a','b','c')", 'a\\b\\c' ],
[ "Win32->catfile('c')", 'c' ],
[ "Win32->catfile('.\\c')", 'c' ],
+[ "Win32->catfile('a','b','..','.\\c')", 'a\\c' ],
+[ "Win32->catfile('a','..','b','.\\c')", 'b\\c' ],
+[ "Win32->catfile('a','..','..','b','.\\c')", '..\\b\\c' ],
+[ "Win32->catfile('..','a','b','.\\c')", '..\\a\\b\\c' ],
[ "Win32->canonpath('')", '' ],
@@ -224,6 +228,15 @@
[ "Win32->canonpath('\\..\\')", '\\' ],
[ "Win32->canonpath('/../')", '\\' ],
[ "Win32->canonpath('/..\\')", '\\' ],
+[ "Win32->canonpath('..\\a')", '..\\a' ],
+[ "Win32->canonpath('..\\..\\a')", '..\\..\\a' ],
+[ "Win32->canonpath('a\\..\\..\\b')", '..\\b' ],
+[ "Win32->canonpath('a\\..\\..\\b\\..\\c\\d\\..\\e')", '..\\c\\e' ],
+[ "Win32->canonpath('c:\\a\\..')", 'C:\\' ],
+[ "Win32->canonpath('c:a\\..')", 'C:' ],
+[ "Win32->canonpath('c:\\a\\..\\')", 'C:\\' ],
+[ "Win32->canonpath('c:a\\..\\')", 'C:' ],
+[ "Win32->canonpath('a\\..\\')", '.' ],
[ "Win32->can('_cwd')", '/CODE/' ],
# FakeWin32 subclass (see below) just sets CWD to C:\one\two
###################################################################
[Please do not change anything below this line]
-----------------------------------------------------------------
---
Flags:
category=library
severity=high
---
Site configuration information for perl v5.8.3:
Configured by ActiveState at Tue Feb 3 00:28:38 2004.
Summary of my perl5 (revision 5 version 8 subversion 3) configuration:
Platform:
osname=MSWin32, osvers=4.0, archname=MSWin32-x86-multi-thread
uname=''
config_args='undef'
hint=recommended, useposix=true, d_sigaction=undef
usethreads=undef use5005threads=undef useithreads=define
usemultiplicity=define
useperlio=define d_sfio=undef uselargefiles=define usesocks=undef
use64bitint=undef use64bitall=undef uselongdouble=undef
usemymalloc=n, bincompat5005=undef
Compiler:
cc='cl', ccflags ='-nologo -Gf -W3 -MD -Zi -DNDEBUG -O1 -DWIN32
-D_CONSOLE -DNO_STRICT -DHAVE_DES_FCRYPT -DNO_HASH_SEED
-DPERL_IMPLICIT_CONTEXT -DPERL_IMPLICIT_SYS -DUSE_PERLIO
-DPERL_MSVCRT_READFIX',
optimize='-MD -Zi -DNDEBUG -O1',
cppflags='-DWIN32'
ccversion='', gccversion='', gccosandvers=''
intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
d_longlong=undef, longlongsize=8, d_longdbl=define, longdblsize=10
ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='__int64',
lseeksize=8
alignbytes=8, prototype=define
Linker and Libraries:
ld='link', ldflags ='-nologo -nodefaultlib -debug -opt:ref,icf
-libpath:"C:\Perl583\lib\CORE" -machine:x86'
libpth=C:\PROGRA~1\MICROS~3\VC98\lib
libs= oldnames.lib kernel32.lib user32.lib gdi32.lib winspool.lib
comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib netapi32.lib
uuid.lib wsock32.lib mpr.lib winmm.lib version.lib odbc32.lib odbccp32.lib
msvcrt.lib
perllibs= oldnames.lib kernel32.lib user32.lib gdi32.lib winspool.lib
comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib netapi32.lib
uuid.lib wsock32.lib mpr.lib winmm.lib version.lib odbc32.lib odbccp32.lib
msvcrt.lib
libc=msvcrt.lib, so=dll, useshrplib=yes, libperl=perl58.lib
gnulibc_version='undef'
Dynamic Linking:
dlsrc=dl_win32.xs, dlext=dll, d_dlsymun=undef, ccdlflags=' '
cccdlflags=' ', lddlflags='-dll -nologo -nodefaultlib -debug
-opt:ref,icf -libpath:"C:\Perl583\lib\CORE" -machine:x86'
Locally applied patches:
ACTIVEPERL_LOCAL_PATCHES_ENTRY
22218 Remove the caveat about detached threads crashing on Windows
22201 Avoid threads+win32 crash by freeing Perl interpreter slightly
later
22169 Display 'out of memeory' errors using low-level I/O
22159 Upgrade to Time::Hires 1.55
22120 Make 'Configure -Dcf_by=...' work
22051 Upgrade to Time::HiRes 1.54
21540 Fix backward-compatibility issues in if.pm
---
@INC for perl v5.8.3:
c:\perl583\site\lib
c:\perl583\lib
c:\lib\perl5
c:\lib\perl
c:/Perl583/lib
c:/Perl583/site/lib
.
---
Environment for perl v5.8.3:
HOME (unset)
LANG (unset)
LANGUAGE (unset)
LD_LIBRARY_PATH (unset)
LOGDIR (unset)
PATH=C:\VisStd71\Common7\IDE;C:\VisStd71\VC7\BIN;C:\VisStd71\Common7\Tools;C
:\VisStd71\Common7\Tools\bin\prerelease;C:\VisStd71\Common7\Tools\bin;C:\Vis
Std71\SDK\v1.1\bin;C:\VisStd71\SDK\v1.1\v1.1.4322;c:\ScanSoft\ntbin;c:\ScanS
oft\bin;c:\bin\win32;c:\bin\nt;c:\bin\arepa;c:\bin\dos;C:\WINNT\system32;C:\
WINNT;C:\WINNT\System32\Wbem
PERL5LIB=c:\perl583\site\lib;c:\perl583\lib;c:\lib\perl5;c:\lib\perl
PERL_BADLANG (unset)
PERL_DIR=C:\perl582
SHELL (unset)
-
[perl #27052] File::Spec->canonpath("a\\..\\..\\b") returns wrong value for Win 32
by Dinger, Tom