Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

PATCH: File::Spec::UNIX->abs2rel() gets it wrong with ".." components #11985

Closed
p5pRT opened this issue Mar 3, 2012 · 7 comments
Closed

PATCH: File::Spec::UNIX->abs2rel() gets it wrong with ".." components #11985

p5pRT opened this issue Mar 3, 2012 · 7 comments

Comments

@p5pRT
Copy link

p5pRT commented Mar 3, 2012

Migrated from rt.perl.org#111510 (status was 'resolved')

Searchable as RT111510$

@p5pRT
Copy link
Author

p5pRT commented Mar 3, 2012

From perldoc@volkerschatz.com

  Hello,

this is a bugfix I submitted to CPAN a while ago (#61451). I have verified
that the issue persists in PathTools 3.33 and rerun the test suite with the
patched version. In the light of my experience with CPAN, I have added a line
to the POD that asks bug reports to go to perlbug@​perl.org (last hunk of the
patch​: @​@​ -469,6 +494,8 @​@​).

If you have follow-up questions, it would probably be best to CC me, though I
will try to watch the perl5-porters list archives.

Kind regards,

Volker

Here is the detailed bug description​:

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.33​:
../../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.

(hunk @​@​ -362,28 +363,32 @​@​)

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.

(hunk @​@​ -391,19 +396,39 @​@​)

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​:

(hunk @​@​ -348,9 +348,10 @​@​)

@p5pRT
Copy link
Author

p5pRT commented Mar 3, 2012

From perldoc@volkerschatz.com

Unix.pm.diff
--- Unix.pm.3.33	2012-03-03 09:14:11.352578001 +0100
+++ Unix.pm	2012-03-03 09:17:02.348578001 +0100
@@ -348,9 +348,10 @@
 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.
+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.
 
@@ -362,28 +363,32 @@
 
     ($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;
-    }
-    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);
+	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;
+	# 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];
+	$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;
+	# 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
@@ -391,19 +396,39 @@
     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])) {
-        shift @pathchunks ;
+        push @common, 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 );
+    # @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, '') );
 }
 
@@ -469,6 +494,8 @@
 This program is free software; you can redistribute it and/or modify
 it under the same terms as Perl itself.
 
+Please submit bug reports and patches to perlbug@perl.org.
+
 =head1 SEE ALSO
 
 L<File::Spec>

@p5pRT
Copy link
Author

p5pRT commented May 23, 2012

From @cpansprout

On Sat Mar 03 02​:02​:56 2012, perldoc@​volkerschatz.com wrote​:

 Hello\,

this is a bugfix I submitted to CPAN a while ago (#61451). I have
verified
that the issue persists in PathTools 3.33 and rerun the test suite
with the
patched version. In the light of my experience with CPAN, I have
added a line
to the POD that asks bug reports to go to perlbug@​perl.org (last hunk
of the
patch​: @​@​ -469,6 +494,8 @​@​).

If you have follow-up questions, it would probably be best to CC me,
though I
will try to watch the perl5-porters list archives.

Kind regards,

Volker

Thank you for the patch. It looks good to me.

Is there any chance you could add some tests to rel2abs2rel.t?

--

Father Chrysostomos

@p5pRT
Copy link
Author

p5pRT commented May 23, 2012

The RT System itself - Status changed from 'new' to 'open'

@p5pRT
Copy link
Author

p5pRT commented May 26, 2012

From perldoc@volkerschatz.com

Is there any chance you could add some tests to rel2abs2rel.t?

I don't understand what rel2abs2rel.t does; but Spec.t contains all the other
tests for Unix->abs2rel, so this seemed the place to patch​:

Inline Patch
--- Spec.t.orig 2010-07-23 09:55:30.000000000 +0200
+++ Spec.t      2012-05-26 20:54:57.608000003 +0200
@@ -135,6 +135,10 @@
  [  "Unix->abs2rel('/t1/t2/t3', '/t1')",               't2/t3'              ],
  [  "Unix->abs2rel('t1/t2/t3', 't1')",                 't2/t3'              ],
  [  "Unix->abs2rel('t1/t2/t3', 't4')",                 '../t1/t2/t3'        ],
+[  "Unix->abs2rel('.', '.')",                         '.'                  ],
+[  "Unix->abs2rel('/', '/')",                         '.'                  ],
+[  "Unix->abs2rel('../t1', 't2/t3')",                 '../../../t1'        ],
+[  "Unix->abs2rel('t1', 't2/../t3')",                 '../t1'              ],

  [ "Unix->rel2abs('t4','/t1/t2/t3')",             '/t1/t2/t3/t4'    ],
  [ "Unix->rel2abs('t4/t5','/t1/t2/t3')",          '/t1/t2/t3/t4/t5' ],


My second test case (by the original count) presents difficulties, as its result contains the name of the current directory\. For PathTools\-3\.33\, the following works​:

[ "Unix->abs2rel('t1/t2', '../t3')", '../PathTools-3.33/t1/t2' ],

If the expected result is a static string, it would have to be adapted with
every release... Unfortunately this test is independent of the other four, in
that it tests the descending into directories when $base contains leading ".."s
($base, not $path as I wrote in my OP). Probably less of a hassle to leave it
out, though.

Regards,

Volker

@p5pRT
Copy link
Author

p5pRT commented May 26, 2012

From @cpansprout

On Sat May 26 12​:05​:12 2012, perldoc@​volkerschatz.com wrote​:

Is there any chance you could add some tests to rel2abs2rel.t?

I don't understand what rel2abs2rel.t does; but Spec.t contains all
the other
tests for Unix->abs2rel, so this seemed the place to patch​:

--- Spec.t.orig 2010-07-23 09​:55​:30.000000000 +0200
+++ Spec.t 2012-05-26 20​:54​:57.608000003 +0200
@​@​ -135,6 +135,10 @​@​

Thank you. I’ve applied both your patches, as 70b6afc and
593dacf, respectively.

--

Father Chrysostomos

@p5pRT
Copy link
Author

p5pRT commented May 26, 2012

@cpansprout - Status changed from 'open' to 'resolved'

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
None yet
Projects
None yet
Development

No branches or pull requests

1 participant