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

File::Spec::Functions abs2rel confused by trailing ..s #16666

Open
p5pRT opened this issue Aug 22, 2018 · 12 comments
Open

File::Spec::Functions abs2rel confused by trailing ..s #16666

p5pRT opened this issue Aug 22, 2018 · 12 comments

Comments

@p5pRT
Copy link

p5pRT commented Aug 22, 2018

Migrated from rt.perl.org#133465 (status was 'open')

Searchable as RT133465$

@p5pRT
Copy link
Author

p5pRT commented Aug 22, 2018

From martin.peylo@nokia.com

@p5pRT
Copy link
Author

p5pRT commented Aug 22, 2018

From martin.peylo@nokia.com

When abs2rel gets a path argument with ..s that are crossing over the ..s
trailing the base argument, the result is wrong.

Example
PATH​: /home/goal/test/..
BASE​: /home/goal/test/../../base
Good result​: ../goal
Bad result​: ../..

Tested in File​::Spec versions
- 3.6301
- 3.74

Perl Info

Flags:
    category=library
    severity=high
    module=File::Spec::Functions

Site configuration information for perl 5.24.1:

Configured by Debian Project at Sun Jun 10 17:37:28 UTC 2018.

Summary of my perl5 (revision 5 version 24 subversion 1) configuration:
   
  Platform:
    osname=linux, osvers=3.16.0, archname=x86_64-linux-gnu-thread-multi
    uname='linux localhost 3.16.0 #1 smp debian 3.16.0 x86_64 gnulinux '
    config_args='-Dusethreads -Duselargefiles -Dcc=x86_64-linux-gnu-gcc -Dcpp=x86_64-linux-gnu-cpp -Dld=x86_64-linux-gnu-gcc -Dccflags=-DDEBIAN -Wdate-time -D_FORTIFY_SOURCE=2 -g -O2 -fdebug-prefix-map=/build/perl-N8J5tr/perl-5.24.1=. -fstack-protector-strong -Wformat -Werror=format-security -Dldflags= -Wl,-z,relro -Dlddlflags=-shared -Wl,-z,relro -Dcccdlflags=-fPIC -Darchname=x86_64-linux-gnu -Dprefix=/usr -Dprivlib=/usr/share/perl/5.24 -Darchlib=/usr/lib/x86_64-linux-gnu/perl/5.24 -Dvendorprefix=/usr -Dvendorlib=/usr/share/perl5 -Dvendorarch=/usr/lib/x86_64-linux-gnu/perl5/5.24 -Dsiteprefix=/usr/local -Dsitelib=/usr/local/share/perl/5.24.1 -Dsitearch=/usr/local/lib/x86_64-linux-gnu/perl/5.24.1 -Dman1dir=/usr/share/man/man1 -Dman3dir=/usr/share/man/man3 -Dsiteman1dir=/usr/local/man/man1 -Dsiteman3dir=/usr/local/man/man3 -Dusesitecustomize -Duse64bitint -Dman1ext=1 -Dman3ext=3perl
-Dpager=/usr/bin/sensible-pager -Uafs -Ud_csh -Ud_ualarm -Uusesfio -Uusenm -Ui_libutil -Uversiononly -DDEBUGGING=-g -Doptimize=-O2 -dEs -Duseshrplib -Dlibperl=libperl.so.5.24.1'
    hint=recommended, useposix=true, d_sigaction=define
    useithreads=define, usemultiplicity=define
    use64bitint=define, use64bitall=define, uselongdouble=undef
    usemymalloc=n, bincompat5005=undef
  Compiler:
    cc='x86_64-linux-gnu-gcc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -DDEBIAN -fwrapv -fno-strict-aliasing -pipe -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
    optimize='-O2 -g',
    cppflags='-D_REENTRANT -D_GNU_SOURCE -DDEBIAN -fwrapv -fno-strict-aliasing -pipe -I/usr/local/include'
    ccversion='', gccversion='6.3.0 20170516', gccosandvers=''
    intsize=4, longsize=8, ptrsize=8, doublesize=8, byteorder=12345678, doublekind=3
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16, longdblkind=3
    ivtype='long', ivsize=8, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
    alignbytes=8, prototype=define
  Linker and Libraries:
    ld='x86_64-linux-gnu-gcc', ldflags =' -fstack-protector-strong -L/usr/local/lib'
    libpth=/usr/local/lib /usr/lib/gcc/x86_64-linux-gnu/6/include-fixed /usr/include/x86_64-linux-gnu /usr/lib /lib/x86_64-linux-gnu /lib/../lib /usr/lib/x86_64-linux-gnu /usr/lib/../lib /lib
    libs=-lgdbm -lgdbm_compat -ldb -ldl -lm -lpthread -lc -lcrypt
    perllibs=-ldl -lm -lpthread -lc -lcrypt
    libc=libc-2.24.so, so=so, useshrplib=true, libperl=libperl.so.5.24
    gnulibc_version='2.24'
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E'
    cccdlflags='-fPIC', lddlflags='-shared -L/usr/local/lib -fstack-protector-strong'

Locally applied patches:
    DEBPKG:debian/cpan_definstalldirs - Provide a sensible INSTALLDIRS default for modules installed from CPAN.
    DEBPKG:debian/db_file_ver - https://bugs.debian.org/340047 Remove overly restrictive DB_File version check.
    DEBPKG:debian/doc_info - Replace generic man(1) instructions with Debian-specific information.
    DEBPKG:debian/enc2xs_inc - https://bugs.debian.org/290336 Tweak enc2xs to follow symlinks and ignore missing @INC directories.
    DEBPKG:debian/errno_ver - https://bugs.debian.org/343351 Remove Errno version check due to upgrade problems with long-running processes.
    DEBPKG:debian/libperl_embed_doc - https://bugs.debian.org/186778 Note that libperl-dev package is required for embedded linking
    DEBPKG:fixes/respect_umask - Respect umask during installation
    DEBPKG:debian/writable_site_dirs - Set umask approproately for site install directories
    DEBPKG:debian/extutils_set_libperl_path - EU:MM: set location of libperl.a under /usr/lib
    DEBPKG:debian/no_packlist_perllocal - Don't install .packlist or perllocal.pod for perl or vendor
    DEBPKG:debian/fakeroot - Postpone LD_LIBRARY_PATH evaluation to the binary targets.
    DEBPKG:debian/instmodsh_doc - Debian policy doesn't install .packlist files for core or vendor.
    DEBPKG:debian/ld_run_path - Remove standard libs from LD_RUN_PATH as per Debian policy.
    DEBPKG:debian/libnet_config_path - Set location of libnet.cfg to /etc/perl/Net as /usr may not be writable.
    DEBPKG:debian/mod_paths - Tweak @INC ordering for Debian
    DEBPKG:debian/prune_libs - https://bugs.debian.org/128355 Prune the list of libraries wanted to what we actually need.
    DEBPKG:fixes/net_smtp_docs - [rt.cpan.org #36038] https://bugs.debian.org/100195 Document the Net::SMTP 'Port' option
    DEBPKG:debian/perlivp - https://bugs.debian.org/510895 Make perlivp skip include directories in /usr/local
    DEBPKG:debian/deprecate-with-apt - https://bugs.debian.org/747628 Point users to Debian packages of deprecated core modules
    DEBPKG:debian/squelch-locale-warnings - https://bugs.debian.org/508764 Squelch locale warnings in Debian package maintainer scripts
    DEBPKG:debian/skip-upstream-git-tests - Skip tests specific to the upstream Git repository
    DEBPKG:debian/patchlevel - https://bugs.debian.org/567489 List packaged patches for 5.24.1-3+deb9u4 in patchlevel.h
    DEBPKG:debian/skip-kfreebsd-crash - https://bugs.debian.org/628493 [perl #96272] Skip a crashing test case in t/op/threads.t on GNU/kFreeBSD
    DEBPKG:fixes/document_makemaker_ccflags - https://bugs.debian.org/628522 [rt.cpan.org #68613] Document that CCFLAGS should include $Config{ccflags}
    DEBPKG:debian/find_html2text - https://bugs.debian.org/640479 Configure CPAN::Distribution with correct name of html2text
    DEBPKG:debian/perl5db-x-terminal-emulator.patch - https://bugs.debian.org/668490 Invoke x-terminal-emulator rather than xterm in perl5db.pl
    DEBPKG:debian/cpan-missing-site-dirs - https://bugs.debian.org/688842 Fix CPAN::FirstTime defaults with nonexisting site dirs if a parent is writable
    DEBPKG:fixes/memoize_storable_nstore - [rt.cpan.org #77790] https://bugs.debian.org/587650 Memoize::Storable: respect 'nstore' option not respected
    DEBPKG:debian/regen-skip - Skip a regeneration check in unrelated git repositories
    DEBPKG:debian/makemaker-pasthru - https://bugs.debian.org/758471 Pass LD settings through to subdirectories
    DEBPKG:debian/makemaker-manext - https://bugs.debian.org/247370 Make EU::MakeMaker honour MANnEXT settings in generated manpage headers
    DEBPKG:debian/devel-ppport-reproducibility - https://bugs.debian.org/801523 Sort the list of XS code files when generating RealPPPort.xs
    DEBPKG:debian/encode-unicode-bom-doc - https://bugs.debian.org/798727 Document Debian backport of Encode::Unicode fix
    DEBPKG:debian/kfreebsd-softupdates - https://bugs.debian.org/796798 Work around Debian Bug#796798
    DEBPKG:fixes/autodie-scope - https://bugs.debian.org/798096 Fix a scoping issue with "no autodie" and the "system" sub
    DEBPKG:fixes/crosscompile-no-targethost - [23695c0] [perl #127234] Fix the Configure escape with usecrosscompile but no targethost
    DEBPKG:fixes/memoize-pod - [rt.cpan.org #89441] Fix POD errors in Memoize
    DEBPKG:fixes/ok-pod - Added encoding for pod.
    DEBPKG:debian/hurd-softupdates - https://bugs.debian.org/822735 Fix t/op/stat.t failures on hurd
    DEBPKG:fixes/nntp_docs - https://bugs.debian.org/51962 Net::NNTP: Correct innd/nnrpd confusion in relation to Reader option
    DEBPKG:fixes/math_complex_doc_great_circle - https://bugs.debian.org/697567 [rt.cpan.org #114104] Math::Trig: clarify definition of great_circle_midpoint
    DEBPKG:fixes/math_complex_doc_see_also - https://bugs.debian.org/697568 [rt.cpan.org #114105] Math::Trig: add missing SEE ALSO
    DEBPKG:fixes/math_complex_doc_angle_units - https://bugs.debian.org/731505 [rt.cpan.org #114106] Math::Trig: document angle units
    DEBPKG:fixes/cpan_web_link - https://bugs.debian.org/367291 CPAN: Add link to main CPAN web site
    DEBPKG:fixes/time_piece_doc - https://bugs.debian.org/817925 Time::Piece: Improve documentation for add_months and add_years
    DEBPKG:fixes/perlbug-refactor - https://bugs.debian.org/822463 [perl #128020] perlbug: Refactor duplicated file reading code
    DEBPKG:fixes/perlbug-linewrap - https://bugs.debian.org/822463 [perl #128020] perlbug: wrap overly long lines
    DEBPKG:fixes/hurd_sigaction - https://bugs.debian.org/825016 [d54f4ed] ext/POSIX/t/sigaction.t: Skip uid and pid tests on GNU/Hurd
    DEBPKG:fixes/hurd_hints - [4694301] https://bugs.debian.org/825020 [perl #128279] Modify hints for Hurd per Debian ticket 825020.
    DEBPKG:fixes/extutils-parsexs-reproducibility - [perl #128517] https://bugs.debian.org/829296 Make the output of ExtUtils::ParseXS reproducible
    DEBPKG:debian/CVE-2016-1238/sitecustomize-in-etc - Look for sitecustomize.pl in /etc/perl rather than sitelib on Debian systems
    DEBPKG:debian/CVE-2016-1238/test-suite-without-dot - [perl #127810] Patch unit tests to explicitly insert "." into @INC when needed.
    DEBPKG:debian/CVE-2016-1238/eumm-without-dot - [perl #127810] Add PERL_USE_UNSAFE_INC support to EU::MM for fortify_inc support.
    DEBPKG:debian/CVE-2016-1238/cpan-without-dot - [perl #127810] Set PERL_USE_UNSAFE_INC for cpan usage
    DEBPKG:debian/document_inc_removal - Document in perlvar that we remove '.' from @INC by default
    DEBPKG:fixes/extutils_makemaker_reproducible - https://bugs.debian.org/835815 https://bugs.debian.org/834190 Make perllocal.pod files reproducible
    DEBPKG:debian/CVE-2016-1238/remove-inc-test - Remove test for '.' in @INC as it might not be
    DEBPKG:fixes/file_path_hurd_errno - File-Path: Fix test failure in Hurd due to hard-coded ENOENT
    DEBPKG:debian/hppa_op_optimize_workaround - https://bugs.debian.org/838613 Temporarily lower the optimization of op.c on hppa due to gcc-6 problems
    DEBPKG:fixes/test-builder-warning - https://bugs.debian.org/840968 Silence a 'used only once' warning in Test::Builder
    DEBPKG:fixes/longdblinf-randomness - [dd68853] [perl #130133] https://bugs.debian.org/844752 Configure: fix garbage filtering with 80-bit long doubles
    DEBPKG:debian/installman-utf8 - https://bugs.debian.org/840211 Generate man pages with UTF-8 characters
    DEBPKG:fixes/list_assign_leak - [1050723] [perl #130766] https://bugs.debian.org/855064 avoid a leak in list assign from/to magic values
    DEBPKG:fixes/perlfunc_inc_doc - [a03e9f8] https://bugs.debian.org/839536 [perl #130832] Documentation fixes for '.' possibly no longer being in @INC
    DEBPKG:fixes/file_path_chmod_race - https://bugs.debian.org/863870 [rt.cpan.org #121951] Prevent directory chmod race attack.
    DEBPKG:fixes/extutils_file_path_compat - Correct the order of tests of chmod(). (#294)
    DEBPKG:debian/customized - Update customized.dat for files patched in Debian
    DEBPKG:fixes/getopt-long-1 - https://bugs.debian.org/855532 [rt.cpan.org #114999] Fix bug RT#114999
    DEBPKG:fixes/getopt-long-2 - [rt.cpan.org #120300] Withdraw part of commit 5d9947fb445327c7299d8beb009d609bc70066c0, which tries to implement more GNU getopt_long campatibility. GNU
    DEBPKG:fixes/getopt-long-3 - provide a default value for optional arguments
    DEBPKG:fixes/getopt-long-4 - https://bugs.debian.org/864544 [rt.cpan.org #122068] Fix issue #122068.
    DEBPKG:fixes/fbm-instr-crash - [bb152a4] [perl #131575] https://bugs.debian.org/864782 don't call Perl_fbm_instr() with negative length
    DEBPKG:debian/CVE-2016-1238/base-pm-amends-pt2 - [1afa289] Limit dotless-INC effect on base.pm with guard:
    DEBPKG:fixes/CVE-2017-12837 - https://bugs.debian.org/875596 [perl #131582] [f7e5417] regcomp [perl #131582]
    DEBPKG:fixes/CVE-2017-12883 - https://bugs.debian.org/875597 [perl #131598] [40b3cda] PATCH: [perl #131598]
    DEBPKG:fixes/CVE-2018-6797 - [perl #132227] (perl #132227) restart a node if we change to uni rules within the node and encounter a sharp S
    DEBPKG:fixes/CVE-2018-6798/pt1 - [perl #132063] Heap buffer overflow
    DEBPKG:fixes/CVE-2018-6798/pt2 - [perl #132063] v5.24.3: fix TRIE_READ_CHAR and DECL_TRIE_TYPE to account for non-utf8 target
    DEBPKG:fixes/CVE-2018-6798/pt3 - [perl #132063] (perl #132063) we should no longer warn for this code
    DEBPKG:fixes/CVE-2018-6913 - [perl #131844] (perl #131844) fix various space calculation issues in pp_pack.c
    DEBPKG:fixes/CVE-2018-12015-Archive-Tar-directory-traversal - https://bugs.debian.org/900834 [rt.cpan.org #125523] Remove existing files before overwriting them


@INC for perl 5.24.1:
    /etc/perl
    /usr/local/lib/x86_64-linux-gnu/perl/5.24.1
    /usr/local/share/perl/5.24.1
    /usr/lib/x86_64-linux-gnu/perl5/5.24
    /usr/share/perl5
    /usr/lib/x86_64-linux-gnu/perl/5.24
    /usr/share/perl/5.24
    /usr/local/lib/site_perl
    /usr/lib/x86_64-linux-gnu/perl-base


Environment for perl 5.24.1:
    HOME=/home/dems5uk4
    LANG=en_US.utf8
    LANGUAGE=en_US:en
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=/home/dems5uk4/perl5/perlbrew/bin:/home/dems5uk4/GIT/wireshark-build/run/:/opt/cov-analysis-linux64-2017.07-SP1/bin:/home/dems5uk4/local/bin:/home/dems5uk4/.local/bin:/home/dems5uk4/local/gcc-arm-none-eabi-6_2-2016q4/bin:/usr/lib/ccache:/usr/local/bin:/usr/bin:/bin:/usr/local/games:/usr/games
    PERLBREW_HOME=/home/dems5uk4/.perlbrew
    PERLBREW_ROOT=/home/dems5uk4/perl5/perlbrew
    PERLBREW_SHELLRC_VERSION=0.84
    PERL_BADLANG (unset)
    SHELL=/bin/bash

--------------1.40.perlbug
Content-Type: text/x-patch; name="abs2rel_confused.pl"
Content-Transfer-Encoding: 8bit
Content-Disposition: attachment; filename="abs2rel_confused.pl"

#!/usr/bin/perl
use File::Spec::Functions qw/abs2rel/;

my $path  = "/home/goal/test/..";
my $apath = "/home/goal";
my $base  = "/home/goal/test/../../base";

print "PATH: $path\n";
print "BASE: $base\n";

print "Good " . abs2rel($apath, $base) . "\n";
print "Bad  " . abs2rel($path, $base) . "\n";

--------------1.40.perlbug--

@p5pRT
Copy link
Author

p5pRT commented Aug 22, 2018

From @jkeenan

On Wed, 22 Aug 2018 09​:12​:39 GMT, martin.peylo@​nokia.com wrote​:

Does the program attached correctly describe your problem?

(When run as 'prove -v 133465-abs2rel-func.t', the 4th test fails while the 5th test unexpectedly passes.)

Thank you very much.

--
James E Keenan (jkeenan@​cpan.org)

@p5pRT
Copy link
Author

p5pRT commented Aug 22, 2018

From @jkeenan

#!/usr/bin/env perl
use 5.10.0;
use warnings;
use Carp;
use File​::Path 2.15 qw(make_path);
use File​::Spec;
use File​::Spec​::Functions qw(abs2rel);
use File​::Temp qw(tempdir);
use Cwd;
use Test​::More;

my $tdir = tempdir(CLEANUP => 1);
my $testingdir = File​::Spec->catdir($tdir, 'testing');
my @​created = make_path($testingdir, { mode => 0711 });
chdir $testingdir or croak "AAA​: Unable to chdir to $testingdir";

my $startdir = cwd();
pass("Starting out from $startdir");

@​created = make_path('goal/test', { mode => 0711 });
my $testdir = File​::Spec->catdir($startdir, 'goal', 'test');
croak "Unable to locate $testdir" unless -d $testdir;
chdir_test($startdir, $testdir, 'BBB');

my $goaldir = File​::Spec->catdir($startdir, 'goal');
chdir_test($startdir, $goaldir, 'CCC');

my $dest = "$testingdir/goal/test/..";
chdir_test($startdir, $dest, 'DDD');

@​created = make_path('base', { mode => 0711 });
my $bdir = File​::Spec->catdir($startdir, 'base');
croak "Unable to locate $bdir" unless -d $bdir;
chdir_test($startdir, $bdir, 'EEE');

my $base = "$testingdir/goal/test/../../base";
chdir $base or croak "FFF​: Unable to chdir to $base";
my $thisdir = cwd();
is($thisdir, $bdir, "Having chdir-ed to $base, I'm now in $thisdir");

my $rel_path = abs2rel($dest, $base);
pass("relative path as calculated by abs2rel()​: $rel_path");
chdir $rel_path or croak "GGG​: Unable to chdir to $rel_path";
my $enddir = cwd();
is($enddir, $goaldir,
  "Having chdir-ed to $rel_path, I'm now in $goaldir as expected");
is($enddir, $tdir,
  "Having chdir-ed to $rel_path, I'm now in $tdir -- contrary to expectation");

done_testing();

sub chdir_test {
  my ($startdir, $d, $str) = @​_;
  chdir $d or croak "$str​: Unable to chdir to $d";
  chdir $startdir or croak "${str}1​: Unable to chdir back to $startdir";
  return 1;
}
__END__

@p5pRT
Copy link
Author

p5pRT commented Aug 22, 2018

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

@p5pRT
Copy link
Author

p5pRT commented Aug 23, 2018

From @jkeenan

On Wed, 22 Aug 2018 15​:15​:15 GMT, jkeenan wrote​:

On Wed, 22 Aug 2018 09​:12​:39 GMT, martin.peylo@​nokia.com wrote​:

Does the program attached correctly describe your problem?

(When run as 'prove -v 133465-abs2rel-func.t', the 4th test fails
while the 5th test unexpectedly passes.)

Thank you very much.

Attached is another test file, written with directories named after the style used in dist/PathTools/t/Spec.t, which confirms the problem.

The problem lies in this part of the definition of abs2rel() in lib/File/Spec/Unix.pm​:

#####
  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;
  }
  }
  }
#####

To see a version of this block with some debugging code added, see​: https://github.com/jkeenan/PathTools/tree/rt-133465-abs2rel

Thank you very much.
--
James E Keenan (jkeenan@​cpan.org)

@p5pRT
Copy link
Author

p5pRT commented Aug 23, 2018

From @jkeenan

#!/usr/bin/env perl
use strict;
use warnings;
use File​::Path 2.15 qw(make_path);
use File​::Spec;
use File​::Temp qw(tempdir);
use Cwd;
use Test​::More;
#use Data​::Dump qw(dd pp);

my $od = cwd();
{
  my $tdir = tempdir(CLEANUP => 1);
  my $testingdir = File​::Spec->catdir($tdir, 'testing');
  my @​created = make_path($testingdir, { mode => 0711 });
  chdir $testingdir or die "Unable to chdir to $testingdir​: $!";
 
  my $startdir = cwd();
  pass("Starting out from $startdir");

  my @​d = map { File​::Spec->catdir($startdir, File​::Spec->splitdir($_)) } ('t1/t2/t3', 't1/t4');
  @​created = make_path(@​d, { mode => 0711 });
  my $destdir = File​::Spec->catdir($startdir, File​::Spec->splitdir('t1/t2'));
  for my $d (@​d, $destdir) {
  ok(-d $d, "Created $d for testing");
  }
  chdir $d[1] or die "Unable to chdir to $d[1]​: $!";
  my $expected_relpath = File​::Spec->catdir("..", "t2");
  chdir $expected_relpath or die "Unable to chdir via relative path​: $!";
  my $thisdir = cwd();
  is($thisdir, $destdir,
  "chdir via relative path brought us to $destdir, as expected");
  chdir $startdir or die "Unable to get back to $startdir​: $!";
 
  my @​e = map { File​::Spec->catdir($startdir, File​::Spec->splitdir($_)) }
  ('t1/t2/t3/..', 't1/t2/t3/../../t4');
  for my $e (@​e) {
  ok(-d $e, "Previously created $e for testing");
  }
  chdir $e[1] or die "Unable to chdir to $e[1]​: $!";
  chdir $expected_relpath or die "Unable to chdir via relative path​: $!";
  $thisdir = cwd();
  my $expected_thisdir = File​::Spec->catdir($startdir, File​::Spec->splitdir('t1/t2'));
  is($thisdir, $expected_thisdir,
  "chdir via relative path brought us to $expected_thisdir, as expected");
  chdir $startdir or die "Unable to get back to $startdir​: $!";

  chdir $e[1] or die "Unable to chdir to $e[1]​: $!";
  my $calculated_relpath = File​::Spec->abs2rel($e[1], $e[0]);
  is($calculated_relpath, $expected_relpath,
  "abs2rel() calculated relative path as expected ($expected_relpath)");
  chdir $calculated_relpath or die "Unable to chdir via calculated relative path​: $!";
  $thisdir = cwd();
  is($thisdir, $expected_thisdir,
  "chdir via relative path brought us to $expected_thisdir, as expected");
  chdir $startdir or die "Unable to get back to $startdir​: $!";

  chdir $od or die "Unable to get back to where we started​: $!";
}

done_testing;

@p5pRT
Copy link
Author

p5pRT commented Aug 24, 2018

From martin.peylo@nokia.com

Hi,

Yes, I guess so - it seems to come to the same conclusion "in real life" as my sample did "virtually".

When run as you instruct, it also fails in my environment as you describe.

Thank you for picking that up so fast,
Martin

-----Original Message-----
From​: James E Keenan via RT <perlbug-followup@​perl.org>
Sent​: Wednesday, August 22, 2018 8​:45 PM
To​: Peylo, Martin (Nokia - FI/Espoo) <martin.peylo@​nokia.com>
Subject​: [perl #133465] File​::Spec​::Functions abs2rel confused by trailing ..s

On Wed, 22 Aug 2018 09​:12​:39 GMT, martin.peylo@​nokia.com wrote​:

Does the program attached correctly describe your problem?

(When run as 'prove -v 133465-abs2rel-func.t', the 4th test fails while the 5th test unexpectedly passes.)

Thank you very much.

--
James E Keenan (jkeenan@​cpan.org)

@p5pRT
Copy link
Author

p5pRT commented Aug 24, 2018

From @jkeenan

On Thu, 23 Aug 2018 14​:46​:49 GMT, jkeenan wrote​:

On Wed, 22 Aug 2018 15​:15​:15 GMT, jkeenan wrote​:

On Wed, 22 Aug 2018 09​:12​:39 GMT, martin.peylo@​nokia.com wrote​:

Does the program attached correctly describe your problem?

(When run as 'prove -v 133465-abs2rel-func.t', the 4th test fails
while the 5th test unexpectedly passes.)

Thank you very much.

Attached is another test file, written with directories named after
the style used in dist/PathTools/t/Spec.t, which confirms the problem.

The problem lies in this part of the definition of abs2rel() in
lib/File/Spec/Unix.pm​:

#####
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;
}
}
}
#####

To see a version of this block with some debugging code added, see​:
https://github.com/jkeenan/PathTools/tree/rt-133465-abs2rel

Thank you very much.

1. There was one conceptual error in the test file, 133465-spec-abs2rel.t, that I attached to this RT yesterday. So please treat that as superseded. I am attaching a new test file, 2-133465-spec-abs2rel.t, which (a) corrects that error; (b) refactors a lot of the code into subroutines for readability; and (c) adds an additional test case.

2. Sadly, the additional test case added in 1(c) shows that we have even more problems with File​::Spec->abs2rel() than that reported originally by Martin Peylo. In the case he reported, there were updirs ('..') in the middle of the base path and an updir at the end of the destination path. The second test case in the attachment pertains to no updirs in the base path and an updir at the end of the destination path. In that case abs2rel() calculates a *valid* relative path -- valid in the sense that if you're in the base directory and use the relative path as the argument to 'chdir', you will get to the expected location -- but not the *simplest* relative path. Instead, in this case abs2rel() calculates a relative path with updirs in it.

3. Not yet examined​: cases where there are updirs in the base path.

Thank you very much.
--
James E Keenan (jkeenan@​cpan.org)

@p5pRT
Copy link
Author

p5pRT commented Aug 24, 2018

From @jkeenan

#!/usr/bin/env perl
use strict;
use warnings;
use File​::Path 2.15 qw(make_path);
use File​::Spec;
use File​::Temp qw(tempdir);
use Cwd;
use Test​::More;
#use Data​::Dump qw(dd pp);

my $od = cwd();
{
  # Elaboration of case reported in RT 133465​:
  # ('t1/t2/t3/..', 't1/t2/t3/../../t4');
  # i.e., updir at end of dest path and in middle of base path

  my $tdir = tempdir(CLEANUP => 1);
  my $startdir = startdir_setup($tdir);

  my $setup_args = {
  startdir => $startdir,
  dest_needed => 't1/t2/t3',
  base_needed => 't1/t4',
  dest_real => 't1/t2',
  relpath_components => [ "..", "t2" ],
  };
  my $expected_relpath = manual_directory_setup($setup_args);
 
  my $test_args = {
  startdir => $startdir,
  test_dest => 't1/t2/t3/..',
  test_base => 't1/t2/t3/../../t4',
  };
  my @​e = confirm_test_paths_created($test_args);

  my $chdir_args = {
  startdir => $startdir,
  expected_relpath => $expected_relpath,
  e => [ @​e ],
  %{$setup_args},
  };
  my $expected_thisdir = confirm_chdir_via_expected_relpath($chdir_args);

  my $use_abs2rel_args = {
  startdir => $startdir,
  e => [ @​e ],
  expected_relpath => $expected_relpath,
  expected_thisdir => $expected_thisdir,
  };
  calculate_relpath_via_abs2rel($use_abs2rel_args);

  chdir $od or die "Unable to get back to where we started​: $!";
}

{
  # Case where updirs are at end of dest path, none in base path​:
  # (('t1/t2/t3/..', 't1/t5/t6'));
  # abs2rel() calculates a *valid* relative path but not the
  # *simplest* relative path

  my $tdir = tempdir(CLEANUP => 1);
  my $startdir = startdir_setup($tdir);

  my $setup_args = {
  startdir => $startdir,
  dest_needed => 't1/t2/t3',
  base_needed => 't1/t5/t6',
  dest_real => 't1/t2',
  relpath_components => [ "..", "..", "t2" ],
  };
  my $expected_relpath = manual_directory_setup($setup_args);

  my $test_args = {
  startdir => $startdir,
  test_dest => 't1/t2/t3/..',
  test_base => 't1/t5/t6',
  };
  my @​e = confirm_test_paths_created($test_args);

  my $chdir_args = {
  startdir => $startdir,
  expected_relpath => $expected_relpath,
  e => [ @​e ],
  %{$setup_args},
  };
  my $expected_thisdir = confirm_chdir_via_expected_relpath($chdir_args);

  my $use_abs2rel_args = {
  startdir => $startdir,
  e => [ @​e ],
  expected_relpath => $expected_relpath,
  expected_thisdir => $expected_thisdir,
  };
  calculate_relpath_via_abs2rel($use_abs2rel_args);
  chdir $od or die "Unable to get back to where we started​: $!";
}

done_testing;

#################### SUBROUTINES ####################

sub startdir_setup {
  my $tdir = shift;
  my $testingdir = File​::Spec->catdir($tdir, 'testing');
  my @​created = make_path($testingdir, { mode => 0711 });
  chdir $testingdir or die "Unable to chdir to $testingdir​: $!";
  my $startdir = cwd();
  pass("Starting out from $startdir");
  return $startdir;
}

sub manual_directory_setup {
  my $args = shift;
  my @​d = map { File​::Spec->catdir($args->{startdir}, File​::Spec->splitdir($_)) }
  ($args->{dest_needed}, $args->{base_needed});
  my @​created = make_path(@​d, { mode => 0711 });
  my $destdir = File​::Spec->catdir($args->{startdir}, File​::Spec->splitdir($args->{dest_real}));
  for my $d (@​d, $destdir) {
  ok(-d $d, "Created $d for testing");
  }
  chdir $d[1] or die "Unable to chdir to $d[1]​: $!";
  my $expected_relpath = File​::Spec->catdir(@​{$args->{relpath_components}});
  chdir $expected_relpath or die "Unable to chdir via relative path​: $!";
  my $thisdir = cwd();
  is($thisdir, $destdir,
  "chdir via relative path '$expected_relpath' brought us to $destdir, as expected");
  chdir $args->{startdir} or die "Unable to get back to $args-&gt;{startdir}​: $!";
  return $expected_relpath;
}

sub confirm_test_paths_created {
  my $args = shift;
  my @​e = map { File​::Spec->catdir($args->{startdir}, File​::Spec->splitdir($_)) }
  ($args->{test_dest}, $args->{test_base});
  # destination # starting point
  for my $e (@​e) {
  ok(-d $e, "Previously created $e for testing");
  }
  return @​e;
}

sub confirm_chdir_via_expected_relpath {
  my $args = shift;
  chdir $args->{e}->[1] or die "Unable to chdir to $args-&gt;{e}-&gt;[1]​: $!";
  chdir $args-&gt;{expected_relpath} or die "Unable to chdir via relative path​: $!";
  my $thisdir = cwd();
  my $expected_thisdir =
  File​::Spec->catdir($args->{startdir}, File​::Spec->splitdir($args->{dest_real}));
  is($thisdir, $expected_thisdir,
  "chdir via relative path brought us to $expected_thisdir, as expected");
  chdir $args->{startdir} or die "Unable to get back to $args-&gt;{startdir}​: $!";
  return $expected_thisdir;
}

sub calculate_relpath_via_abs2rel {
  my $args = shift;
  chdir $args->{e}->[1] or die "Unable to chdir to $args-&gt;{e}-&gt;[1]​: $!";
  my $calculated_relpath = File​::Spec->abs2rel(@​{$args->{e}});
  is($calculated_relpath, $args->{expected_relpath},
  "abs2rel() calculated relative path ($calculated_relpath) as expected ($args->{expected_relpath})");
  chdir $calculated_relpath or die "Unable to chdir via calculated relative path​: $!";
  my $thisdir = cwd();
  is($thisdir, $args->{expected_thisdir},
  "chdir via calculated relative path ($calculated_relpath) brought us to $args->{expected_thisdir}, as expected");
  chdir $args->{startdir} or die "Unable to get back to $args-&gt;{startdir}​: $!";
  return 1;
}

@p5pRT
Copy link
Author

p5pRT commented Aug 24, 2018

From @jkeenan

On Fri, 24 Aug 2018 16​:09​:33 GMT, jkeenan wrote​:

On Thu, 23 Aug 2018 14​:46​:49 GMT, jkeenan wrote​:

On Wed, 22 Aug 2018 15​:15​:15 GMT, jkeenan wrote​:

On Wed, 22 Aug 2018 09​:12​:39 GMT, martin.peylo@​nokia.com wrote​:

Does the program attached correctly describe your problem?

(When run as 'prove -v 133465-abs2rel-func.t', the 4th test fails
while the 5th test unexpectedly passes.)

Thank you very much.

Attached is another test file, written with directories named after
the style used in dist/PathTools/t/Spec.t, which confirms the
problem.

The problem lies in this part of the definition of abs2rel() in
lib/File/Spec/Unix.pm​:

#####
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;
}
}
}
#####

To see a version of this block with some debugging code added, see​:
https://github.com/jkeenan/PathTools/tree/rt-133465-abs2rel

Thank you very much.

1. There was one conceptual error in the test file, 133465-spec-
abs2rel.t, that I attached to this RT yesterday. So please treat that
as superseded. I am attaching a new test file, 2-133465-spec-
abs2rel.t, which (a) corrects that error; (b) refactors a lot of the
code into subroutines for readability; and (c) adds an additional test
case.

2. Sadly, the additional test case added in 1(c) shows that we have
even more problems with File​::Spec->abs2rel() than that reported
originally by Martin Peylo. In the case he reported, there were
updirs ('..') in the middle of the base path and an updir at the end
of the destination path. The second test case in the attachment
pertains to no updirs in the base path and an updir at the end of the
destination path. In that case abs2rel() calculates a *valid*
relative path -- valid in the sense that if you're in the base
directory and use the relative path as the argument to 'chdir', you
will get to the expected location -- but not the *simplest* relative
path. Instead, in this case abs2rel() calculates a relative path with
updirs in it.

3. Not yet examined​: cases where there are updirs in the base path.

Thank you very much.

For good measure, in attachment 3-133465-spec-abs2rel.t, I have added two more test cases, in each of which the destination path contains updirs ('..') in the middle of the path.

These cases give results similar to those in the second block, i.e., abs2rel() composes a relative path which is *valid* for the purpose of chdir-ing from the base path to the destination path but which is not the *simplest* possible spelling of that relative path.

Thank you very much.
Jim Keenan

--
James E Keenan (jkeenan@​cpan.org)

@p5pRT
Copy link
Author

p5pRT commented Aug 24, 2018

From @jkeenan

#!/usr/bin/env perl
use strict;
use warnings;
use File​::Path 2.15 qw(make_path);
use File​::Spec;
use File​::Temp qw(tempdir);
use Cwd;
use Test​::More;
#use Data​::Dump qw(dd pp);

my $od = cwd();
{
  my $msg = <<END_OF_NOTE;
Case 1​: Elaboration of case reported in RT 133465​:
  ('t1/t2/t3/..', 't1/t2/t3/../../t4')
i.e., updir at end of dest path and in middle of base path
END_OF_NOTE

  note($msg);

  my $tdir = tempdir(CLEANUP => 1);
  my $startdir = startdir_setup($tdir);

  my $setup_args = {
  startdir => $startdir,
  dest_needed => [ 't1/t2/t3' ],
  base_needed => 't1/t4',
  dest_real => 't1/t2',
  relpath_components => [ "..", "t2" ],
  };
  my $expected_relpath = manual_directory_setup($setup_args);
 
  my $test_args = {
  startdir => $startdir,
  test_dest => 't1/t2/t3/..',
  test_base => 't1/t2/t3/../../t4',
  };
  my @​e = confirm_test_paths_created($test_args);

  my $chdir_args = {
  startdir => $startdir,
  expected_relpath => $expected_relpath,
  e => [ @​e ],
  %{$setup_args},
  };
  my $expected_thisdir = confirm_chdir_via_expected_relpath($chdir_args);

  my $use_abs2rel_args = {
  startdir => $startdir,
  e => [ @​e ],
  expected_relpath => $expected_relpath,
  expected_thisdir => $expected_thisdir,
  };
  calculate_relpath_via_abs2rel($use_abs2rel_args);

  chdir $od or die "Unable to get back to where we started​: $!";
}

{
  my $msg = <<END_OF_NOTE;
Case 2​: updirs are at end of dest path; none in base path​:
  ('t1/t2/t3/..', 't1/t5/t6')
abs2rel() calculates *valid* relative path but not *simplest* relative path
END_OF_NOTE

  note($msg);

  my $tdir = tempdir(CLEANUP => 1);
  my $startdir = startdir_setup($tdir);

  my $setup_args = {
  startdir => $startdir,
  dest_needed => [ 't1/t2/t3' ],
  base_needed => 't1/t5/t6',
  dest_real => 't1/t2',
  relpath_components => [ "..", "..", "t2" ],
  };
  my $expected_relpath = manual_directory_setup($setup_args);

  my $test_args = {
  startdir => $startdir,
  test_dest => 't1/t2/t3/..',
  test_base => 't1/t5/t6',
  };
  my @​e = confirm_test_paths_created($test_args);

  my $chdir_args = {
  startdir => $startdir,
  expected_relpath => $expected_relpath,
  e => [ @​e ],
  %{$setup_args},
  };
  my $expected_thisdir = confirm_chdir_via_expected_relpath($chdir_args);

  my $use_abs2rel_args = {
  startdir => $startdir,
  e => [ @​e ],
  expected_relpath => $expected_relpath,
  expected_thisdir => $expected_thisdir,
  };
  calculate_relpath_via_abs2rel($use_abs2rel_args);
 
  chdir $od or die "Unable to get back to where we started​: $!";
}

{
  my $msg = <<END_OF_NOTE;
Case 3​: updirs are in middle of dest path; none in base path​:
  ('t1/t2/t3/../../t4/t5', 't1/t6/t7')
abs2rel() calculates *valid* relative path but not *simplest* relative path
END_OF_NOTE

  note($msg);

  my $tdir = tempdir(CLEANUP => 1);
  my $startdir = startdir_setup($tdir);

  my $setup_args = {
  startdir => $startdir,
  dest_needed => [ 't1/t2/t3', 't1/t4/t5' ],
  base_needed => 't1/t6/t7',
  dest_real => 't1/t4/t5',
  relpath_components => [ "..", "..", "t4", "t5" ],
  };
  my $expected_relpath = manual_directory_setup($setup_args);

  my $test_args = {
  startdir => $startdir,
  test_dest => 't1/t2/t3/../../t4/t5',
  test_base => 't1/t6/t7',
  };
  my @​e = confirm_test_paths_created($test_args);

  my $chdir_args = {
  startdir => $startdir,
  expected_relpath => $expected_relpath,
  e => [ @​e ],
  %{$setup_args},
  };
  my $expected_thisdir = confirm_chdir_via_expected_relpath($chdir_args);

  my $use_abs2rel_args = {
  startdir => $startdir,
  e => [ @​e ],
  expected_relpath => $expected_relpath,
  expected_thisdir => $expected_thisdir,
  };
  calculate_relpath_via_abs2rel($use_abs2rel_args);

  chdir $od or die "Unable to get back to where we started​: $!";
}

{
  my $msg = <<END_OF_NOTE;
Case 4​: updirs are both in middle of, and at end of dest path; none in base path​:
  ('t1/t2/t3/../../t4/t5/..', 't1/t6/t7')
abs2rel() calculates *valid* relative path but not *simplest* relative path
END_OF_NOTE

  note($msg);

  my $tdir = tempdir(CLEANUP => 1);
  my $startdir = startdir_setup($tdir);

  my $setup_args = {
  startdir => $startdir,
  dest_needed => [ 't1/t2/t3', 't1/t4/t5' ],
  base_needed => 't1/t6/t7',
  dest_real => 't1/t4',
  relpath_components => [ "..", "..", "t4", "t5", ".." ],
  };
  my $expected_relpath = manual_directory_setup($setup_args);

  my $test_args = {
  startdir => $startdir,
  test_dest => 't1/t2/t3/../../t4/t5/..',
  test_base => 't1/t6/t7',
  };
  my @​e = confirm_test_paths_created($test_args);

  my $chdir_args = {
  startdir => $startdir,
  expected_relpath => $expected_relpath,
  e => [ @​e ],
  %{$setup_args},
  };
  my $expected_thisdir = confirm_chdir_via_expected_relpath($chdir_args);

  my $use_abs2rel_args = {
  startdir => $startdir,
  e => [ @​e ],
  expected_relpath => $expected_relpath,
  expected_thisdir => $expected_thisdir,
  };
  calculate_relpath_via_abs2rel($use_abs2rel_args);

  chdir $od or die "Unable to get back to where we started​: $!";
}

done_testing;

#################### SUBROUTINES ####################

sub startdir_setup {
  my $tdir = shift;
  my $testingdir = File​::Spec->catdir($tdir, 'testing');
  my @​created = make_path($testingdir, { mode => 0711 });
  chdir $testingdir or die "Unable to chdir to $testingdir​: $!";
  my $startdir = cwd();
  pass("Starting out from $startdir");
  return $startdir;
}

sub manual_directory_setup {
  my $args = shift;
  my @​d = map { File​::Spec->catdir($args->{startdir}, File​::Spec->splitdir($_)) }
  (@​{$args->{dest_needed}}, $args->{base_needed});
  my @​created = make_path(@​d, { mode => 0711 });
  my $destdir = File​::Spec->catdir($args->{startdir}, File​::Spec->splitdir($args->{dest_real}));
  for my $d (@​d, $destdir) {
  ok(-d $d, "Created $d for testing");
  }
  chdir $d[1] or die "Unable to chdir to $d[1]​: $!";
  my $expected_relpath = File​::Spec->catdir(@​{$args->{relpath_components}});
  chdir $expected_relpath or die "Unable to chdir via relative path​: $!";
  my $thisdir = cwd();
  is($thisdir, $destdir,
  "chdir via relative path '$expected_relpath' brought us to $destdir, as expected");
  chdir $args->{startdir} or die "Unable to get back to $args-&gt;{startdir}​: $!";
  return $expected_relpath;
}

sub confirm_test_paths_created {
  my $args = shift;
  my @​e = map { File​::Spec->catdir($args->{startdir}, File​::Spec->splitdir($_)) }
  ($args->{test_dest}, $args->{test_base});
  # destination # starting point
  for my $e (@​e) {
  ok(-d $e, "Previously created $e for testing");
  }
  return @​e;
}

sub confirm_chdir_via_expected_relpath {
  my $args = shift;
  chdir $args->{e}->[1] or die "Unable to chdir to $args-&gt;{e}-&gt;[1]​: $!";
  chdir $args-&gt;{expected_relpath} or die "Unable to chdir via relative path​: $!";
  my $thisdir = cwd();
  my $expected_thisdir =
  File​::Spec->catdir($args->{startdir}, File​::Spec->splitdir($args->{dest_real}));
  is($thisdir, $expected_thisdir,
  "chdir via relative path brought us to $expected_thisdir, as expected");
  chdir $args->{startdir} or die "Unable to get back to $args-&gt;{startdir}​: $!";
  return $expected_thisdir;
}

sub calculate_relpath_via_abs2rel {
  my $args = shift;
  chdir $args->{e}->[1] or die "Unable to chdir to $args-&gt;{e}-&gt;[1]​: $!";
  my $calculated_relpath = File​::Spec->abs2rel(@​{$args->{e}});
  is($calculated_relpath, $args->{expected_relpath},
  "abs2rel() calculated relative path ($calculated_relpath) as expected ($args->{expected_relpath})");
  chdir $calculated_relpath or die "Unable to chdir via calculated relative path​: $!";
  my $thisdir = cwd();
  is($thisdir, $args->{expected_thisdir},
  "chdir via calculated relative path ($calculated_relpath) brought us to $args->{expected_thisdir}, as expected");
  chdir $args->{startdir} or die "Unable to get back to $args-&gt;{startdir}​: $!";
  return 1;
}

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

2 participants