Skip Menu |
 

This queue is for tickets about the PathTools CPAN distribution.

Report information
The Basics
Id: 61451
Status: resolved
Priority: 0/
Queue: PathTools

People
Owner: Nobody in particular
Requestors: bitcard [...] volkerschatz.com
Cc:
AdminCc:

Bug Information
Severity: Normal
Broken in: 3.31
Fixed in: (no value)



Subject: [PATCH] File::Spec::UNIX->abs2rel() gets it wrong with .. components
Download (untitled) / with headers
text/plain 7.5k
Hello, File::Spec::UNIX->abs2rel() returns wrong results in a few cases, most of which involve .. path components. To reproduce, paste the following test cases into: perl -MFile::Spec::Unix -n -e 'print File::Spec::Unix->abs2rel(split),"\n";' ../foo bar/bat bar/bat ../foo foo bar/../bat . . / / Correct results when run at /home/me and no symlinks in base path: ../../../foo ../me/bar/bat ../foo . . Results for File::Spec::Unix from PathTols 3.31: ../../foo ../bar/bat ../../../foo / / The error in the first test case is due to an optimisation applied when both arguments are relative paths, which prepends "/" instead of the current directory. "/../" is then converted to "/" by canonpath(). I have replaced this optimisation by a single call to _cwd() in the following patch. This also fixes the fourth test case. Besides, I have moved checks which make sense only for absolute path arguments to the first branch of the if. *** Unix.pm.3.31 Sun May 10 10:56:08 2009 --- Unix.pm Thu Sep 16 22:56:19 2010 *************** *** 362,389 **** ($path, $base) = map $self->canonpath($_), $path, $base; if (grep $self->file_name_is_absolute($_), $path, $base) { ($path, $base) = map $self->rel2abs($_), $path, $base; - } - else { - # save a couple of cwd()s if both paths are relative - ($path, $base) = map $self->catdir('/', $_), $path, $base; - } ! my ($path_volume) = $self->splitpath($path, 1); ! my ($base_volume) = $self->splitpath($base, 1); ! # Can't relativize across volumes ! return $path unless $path_volume eq $base_volume; ! my $path_directories = ($self->splitpath($path, 1))[1]; ! my $base_directories = ($self->splitpath($base, 1))[1]; ! # For UNC paths, the user might give a volume like //foo/bar that ! # strictly speaking has no directory portion. Treat it as if it ! # had the root directory for that volume. ! if (!length($base_directories) and $self->file_name_is_absolute($base)) { ! $base_directories = $self->rootdir; } # Now, remove all leading components that are the same --- 363,395 ---- ($path, $base) = map $self->canonpath($_), $path, $base; + my $path_directories; + my $base_directories; + if (grep $self->file_name_is_absolute($_), $path, $base) { ($path, $base) = map $self->rel2abs($_), $path, $base; ! my ($path_volume) = $self->splitpath($path, 1); ! my ($base_volume) = $self->splitpath($base, 1); ! # Can't relativize across volumes ! return $path unless $path_volume eq $base_volume; ! $path_directories = ($self->splitpath($path, 1))[1]; ! $base_directories = ($self->splitpath($base, 1))[1]; ! # For UNC paths, the user might give a volume like //foo/bar that ! # strictly speaking has no directory portion. Treat it as if it ! # had the root directory for that volume. ! if (!length($base_directories) and $self->file_name_is_absolute($base)) { ! $base_directories = $self->rootdir; ! } ! } ! else { ! my $wd= ($self->splitpath($self->_cwd(), 1))[1]; ! $path_directories = $self->catdir($wd, $path); ! $base_directories = $self->catdir($wd, $base); } # Now, remove all leading components that are the same The error in the last test case arises because a root dir $base is treated specially, and catdir() does not work well for fewer than two path components. The first added line in the following patch catches that. As regards the second and third test case, they can be solved without consulting the filesystem only if no symlinks are involved. Whereever $path contains .. components, the corresponding directory has to be descended into. The following patch does this. *************** *** 391,409 **** my @basechunks = $self->splitdir( $base_directories ); if ($base_directories eq $self->rootdir) { shift @pathchunks; return $self->canonpath( $self->catpath('', $self->catdir( @pathchunks ), '') ); } while (@pathchunks && @basechunks && $self->_same($pathchunks[0], $basechunks[0])) { ! shift @pathchunks ; shift @basechunks ; } return $self->curdir unless @pathchunks || @basechunks; ! # $base now contains the directories the resulting relative path ! # must ascend out of before it can descend to $path_directory. ! my $result_dirs = $self->catdir( ($self->updir) x @basechunks, @pathchunks ); return $self->canonpath( $self->catpath('', $result_dirs, '') ); } --- 397,435 ---- my @basechunks = $self->splitdir( $base_directories ); if ($base_directories eq $self->rootdir) { + return $self->curdir if $path_directories eq $self->rootdir; shift @pathchunks; return $self->canonpath( $self->catpath('', $self->catdir( @pathchunks ), '') ); } + my @common; while (@pathchunks && @basechunks && $self->_same($pathchunks[0], $basechunks[0])) { ! push @common, shift @pathchunks ; shift @basechunks ; } return $self->curdir unless @pathchunks || @basechunks; ! # @basechunks now contains the directories the resulting relative path ! # must ascend out of before it can descend to $path_directory. If there ! # are updir components, we must descend into the corresponding directories ! # (this only works if they are no symlinks). ! my @reverse_base; ! while( defined(my $dir= shift @basechunks) ) { ! if( $dir ne $self->updir ) { ! unshift @reverse_base, $self->updir; ! push @common, $dir; ! } ! elsif( @common ) { ! if( @reverse_base && $reverse_base[0] eq $self->updir ) { ! shift @reverse_base; ! pop @common; ! } ! else { ! unshift @reverse_base, pop @common; ! } ! } ! } ! my $result_dirs = $self->catdir( @reverse_base, @pathchunks ); return $self->canonpath( $self->catpath('', $result_dirs, '') ); } It can be impossible for abs2rel() to work correctly without looking at the filesystem if $base contains symlinks. I understand from the documentation that the File::Spec modules are not meant to consult the filesystem. Even though the docs state that abs2rel() does not consult the filesystem, the implications could perhaps be made clearer, for example like this: *************** *** 348,356 **** If $path is relative, it is converted to absolute form using L</rel2abs()>. This means that it is taken to be relative to L<cwd()|Cwd>. ! No checks against the filesystem are made. On VMS, there is ! interaction with the working environment, as logicals and ! macros are expanded. Based on code written by Shigio Yamaguchi. --- 348,357 ---- If $path is relative, it is converted to absolute form using L</rel2abs()>. This means that it is taken to be relative to L<cwd()|Cwd>. ! No checks against the filesystem are made, so the result may not be correct if ! C<$base> contains symbolic links. (Apply L<Cwd::abs_path()> beforehand if that ! is a concern.) On VMS, there is interaction with the working environment, as ! logicals and macros are expanded. Based on code written by Shigio Yamaguchi. I have successfully run the PathTools test suite with the patched Unix.pm. Thank you for your time and kind regards, Volker vs@schizo, ~ > uname -a Linux schizo 2.6.31-gentoo-r6 #1 SMP Mon Dec 21 20:10:07 CET 2009 x86_64 Intel(R) Core(TM)2 CPU 6600 @ 2.40GHz GenuineIntel GNU/Linux vs@schizo, ~ > perl -MFile::Spec -e 'print $File::Spec::VERSION,"\n";' 3.31 vs@schizo, ~ > perl -v This is perl, v5.8.8 built for x86_64-linux-thread-multi
From: bitcard [...] volkerschatz.com
Attaching the complete patch, as it was garbled by pasting into the submission form.
Subject: Unix.pm.diff.gz
Download Unix.pm.diff.gz
application/x-gzip 1.4k

Message body not shown because it is not plain text.

Download (untitled) / with headers
text/plain 125b
This is now resolved in blead with commits 70b6afc16df and 593dacfb29387, but I don’t have permission to close this ticket.


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.