search

Perl / perl5

🐪 The Perl programming language
https://dev.perl.org/perl5/
Other
1.91k stars 542 forks source link

Cwd's pure perl abs_path and its test disagree on what's ok #11931

Open p5pRT opened 12 years ago

p5pRT commented 12 years ago

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

Searchable as RT109760$

p5pRT commented 12 years ago

From @ikegami

Created by @ikegami

[ Applies to 5.10.1\, 5.12.2\, 5.14.2\, blead\, etc ]

Whenever I build Perl on my web host\, I get a failure in Cwd.

# Failed test at t/cwd.t line 209. # '/home/ikegami/usr/perlbrew/build/perl-5.14.2/dist/Cwd/t/linktest' # doesn't match '(?^i​:\/home\/ikegami\/usr\/perlbrew\/build\/perl\-5\.14\.2\/dist\/Cwd\/t\/_ptrslt_\/_path_\/_to_\/_a_\/_dir_$)' # Looks like you failed 1 test of 34. ../dist/Cwd/t/cwd.t ............................................... Dubious\, test returned 1 (wstat 256\, 0x100) Failed 1/34 subtests   (less 1 skipped subtest​: 32 okay)

C\<abs_path> is a function that returns an absolute path with symbolic links resolved. The failing check tests a pure perl version of abs_path called C\<_perl_abs_path>. The pure perl version does not resolve symlinks if any ancestor of the symlink's target directory cannot be read\, and /home cannot be read on my web host.

You can test this yourself using the attached script (extracted from cwd.t) and C\<\< chmod u-r .. >>.

I don't know if C\<_perl_abs_path> should croak or if the test shouldn't fail\, but they currently disagree as to what is acceptable\, forcing me to force install Perl every time. This is especially silly since C\<_perl_abs_path> is only used when "the XS version doesn't load" (according to a comment).

- Eric

Perl Info ``` Flags: category=library severity=low module=Cwd Site configuration information for perl 5.10.1: Configured by Debian Project at Wed Dec 21 09:13:32 UTC 2011. Summary of my perl5 (revision 5 version 10 subversion 1) configuration: Platform: osname=linux, osvers=2.6.32-5-amd64, archname=x86_64-linux-gnu-thread-multi uname='linux barber 2.6.32-5-amd64 #1 smp thu nov 3 03:41:26 utc 2011 x86_64 gnulinux ' config_args='-Dusethreads -Duselargefiles -Dccflags=-DDEBIAN -Dcccdlflags=-fPIC -Darchname=x86_64-linux-gnu -Dprefix=/usr -Dprivlib=/usr/share/perl/5.10 -Darchlib=/usr/lib/perl/5.10 -Dvendorprefix=/usr -Dvendorlib=/usr/share/perl5 -Dvendorarch=/usr/lib/perl5 -Dsiteprefix=/usr/local -Dsitelib=/usr/local/share/perl/5.10.1 -Dsitearch=/usr/local/lib/perl/5.10.1 -Dman1dir=/usr/share/man/man1 -Dman3dir=/usr/share/man/man3 -Dsiteman1dir=/usr/local/man/man1 -Dsiteman3dir=/usr/local/man/man3 -Dman1ext=1 -Dman3ext=3perl -Dpager=/usr/bin/sensible-pager -Uafs -Ud_csh -Ud_ualarm -Uusesfio -Uusenm -DDEBUGGING=-g -Doptimize=-O2 -Duseshrplib -Dlibperl=libperl.so.5.10.1 -Dd_dosuid -des' hint=recommended, useposix=true, d_sigaction=define useithreads=define, usemultiplicity=define useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef use64bitint=define, use64bitall=define, uselongdouble=undef usemymalloc=n, bincompat5005=undef Compiler: cc='cc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -DDEBIAN -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64', optimize='-O2 -g', cppflags='-D_REENTRANT -D_GNU_SOURCE -DDEBIAN -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include' ccversion='', gccversion='4.4.5', gccosandvers='' intsize=4, longsize=8, ptrsize=8, doublesize=8, byteorder=12345678 d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16 ivtype='long', ivsize=8, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8 alignbytes=8, prototype=define Linker and Libraries: ld='cc', ldflags =' -fstack-protector -L/usr/local/lib' libpth=/usr/local/lib /lib /usr/lib /lib64 /usr/lib64 libs=-lgdbm -lgdbm_compat -ldb -ldl -lm -lpthread -lc -lcrypt perllibs=-ldl -lm -lpthread -lc -lcrypt libc=/lib/libc-2.11.3.so, so=so, useshrplib=true, libperl=libperl.so.5.10.1 gnulibc_version='2.11.3' Dynamic Linking: dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E' cccdlflags='-fPIC', lddlflags='-shared -O2 -g -L/usr/local/lib -fstack-protector' Locally applied patches: DEBPKG:debian/arm_thread_stress_timeout - http://bugs.debian.org/501970Raise the timeout of ext/threads/shared/t/stress.t to accommodate slower build hosts DEBPKG:debian/cpan_config_path - Set location of CPAN::Config to /etc/perl as /usr may not be writable. DEBPKG:debian/cpan_definstalldirs - Provide a sensible INSTALLDIRS default for modules installed from CPAN. DEBPKG:debian/db_file_ver - http://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 - http://bugs.debian.org/290336 Tweak enc2xs to follow symlinks and ignore missing @INC directories. DEBPKG:debian/errno_ver - http://bugs.debian.org/343351 Remove Errno version check due to upgrade problems with long-running processes. DEBPKG:debian/extutils_hacks - Various debian-specific ExtUtils changes 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/m68k_thread_stress - http://bugs.debian.org/495826Disable some threads tests on m68k for now due to missing TLS. DEBPKG:debian/mod_paths - Tweak @INC ordering for Debian DEBPKG:debian/module_build_man_extensions - http://bugs.debian.org/479460 Adjust Module::Build manual page extensions for the Debian Perl policy DEBPKG:debian/perl_synopsis - http://bugs.debian.org/278323 Rearrange perl.pod DEBPKG:debian/prune_libs - http://bugs.debian.org/128355 Prune the list of libraries wanted to what we actually need. DEBPKG:debian/use_gdbm - Explicitly link against -lgdbm_compat in ODBM_File/NDBM_File. DEBPKG:fixes/assorted_docs - http://bugs.debian.org/443733 [384f06a] Math::BigInt::CalcEmu documentation grammar fix DEBPKG:fixes/net_smtp_docs - http://bugs.debian.org/100195 [rt.cpan.org#36038] Document the Net::SMTP 'Port' option DEBPKG:fixes/processPL - http://bugs.debian.org/357264 [rt.cpan.org#17224] Always use PERLRUNINST when building perl modules. DEBPKG:debian/perlivp - http://bugs.debian.org/510895 Make perlivp skip include directories in /usr/local DEBPKG:fixes/pod2man-index-backslash - http://bugs.debian.org/521256Escape backslashes in .IX entries DEBPKG:debian/disable-zlib-bundling - Disable zlib bundling in Compress::Raw::Zlib DEBPKG:fixes/kfreebsd_cppsymbols - http://bugs.debian.org/533098[3b910a0] Add gcc predefined macros to $Config{cppsymbols} on GNU/kFreeBSD. DEBPKG:debian/cpanplus_definstalldirs - http://bugs.debian.org/533707Configure CPANPLUS to use the site directories by default. DEBPKG:debian/cpanplus_config_path - Save local versions of CPANPLUS::Config::System into /etc/perl. DEBPKG:fixes/kfreebsd-filecopy-pipes - http://bugs.debian.org/537555[16f708c] Fix File::Copy::copy with pipes on GNU/kFreeBSD DEBPKG:fixes/anon-tmpfile-dir - http://bugs.debian.org/528544 [perl #66452] Honor TMPDIR when open()ing an anonymous temporary file DEBPKG:fixes/abstract-sockets - http://bugs.debian.org/329291 [89904c0] Add support for Abstract namespace sockets. DEBPKG:fixes/hurd_cppsymbols - http://bugs.debian.org/544307 [eeb92b7] Add gcc predefined macros to $Config{cppsymbols} on GNU/Hurd. DEBPKG:fixes/autodie-flock - http://bugs.debian.org/543731 Allow for flock returning EAGAIN instead of EWOULDBLOCK on linux/parisc DEBPKG:fixes/archive-tar-instance-error - http://bugs.debian.org/539355[ rt.cpan.org #48879] Separate Archive::Tar instance error strings from each other DEBPKG:fixes/positive-gpos - http://bugs.debian.org/545234 [perl #69056] [c584a96] Fix \\G crash on first match DEBPKG:debian/devel-ppport-ia64-optim - http://bugs.debian.org/548943Work around an ICE on ia64 DEBPKG:fixes/trie-logic-match - http://bugs.debian.org/552291 [perl #69973] [0abd0d7] Fix a DoS in Unicode processing [CVE-2009-3626] DEBPKG:fixes/hppa-thread-eagain - http://bugs.debian.org/554218 make the threads-shared test suite more robust, fixing failures on hppa DEBPKG:fixes/crash-on-undefined-destroy - http://bugs.debian.org/564074[perl #71952] [1f15e67] Fix a NULL pointer dereference when looking for a DESTROY method DEBPKG:fixes/tainted-errno - http://bugs.debian.org/574129 [perl #61976] [be1cf43] fix an errno stringification bug in taint mode DEBPKG:fixes/safe-upgrade - http://bugs.debian.org/582978 Upgrade Safe.pm to 2.25, fixing CVE-2010-1974 DEBPKG:fixes/tell-crash - http://bugs.debian.org/578577 [f4817f3] Fix a tell() crash on bad arguments. DEBPKG:fixes/format-write-crash - http://bugs.debian.org/579537 [perl #22977] [421f30e] Fix a crash in format/write DEBPKG:fixes/arm-alignment - http://bugs.debian.org/289884 [f1c7503] Prevent gcc from optimizing the alignment test away on armel DEBPKG:fixes/fcgi-test - Fix a failure in CGI/t/fast.t when FCGI is installed DEBPKG:fixes/hurd-ccflags - http://bugs.debian.org/587901 Make hints/gnu.sh append to $ccflags rather than overriding them DEBPKG:debian/squelch-locale-warnings - http://bugs.debian.org/508764Squelch locale warnings in Debian package maintainer scripts DEBPKG:fixes/lc-numeric-docs - http://bugs.debian.org/379329 [perl #78452] [903eb63] LC_NUMERIC documentation fixes DEBPKG:fixes/lc-numeric-sprintf - http://bugs.debian.org/601549 [perl #78632] [b3fd614] Fix sprintf not to ignore LC_NUMERIC with constants DEBPKG:fixes/concat-stack-corruption - http://bugs.debian.org/596105[perl #78674] [e3393f5] Fix stack pointer corruption in pp_concat() with 'use encoding' DEBPKG:fixes/cgi-multiline-header - http://bugs.debian.org/606995[CVE-2010-2761 CVE-2010-4410 CVE-2010-4411] CGI.pm MIME boundary and multiline header vulnerabilities DEBPKG:fixes/casing-taint-cve-2011-1487 - http://bugs.debian.org/622817[perl #87336] fix unwanted taint laundering in lc(), uc() et al. DEBPKG:fixes/safe-reval-rdo-cve-2010-1447 - [PATCH] Wrap by default coderefs returned by rdo and reval DEBPKG:fixes/encode-heap-overflow - [PATCH] Fix decode_xs n-byte heap-overflow security bug in DEBPKG:fixes/digest_eval_hole - Close the eval \"require $module\" security hole in DEBPKG:fixes/unregister_signal_handler - [PATCH] main: Unregister signal handler before destroying my_perl DEBPKG:patchlevel - http://bugs.debian.org/567489 List packaged patches for 5.10.1-17squeeze3 in patchlevel.h @INC for perl 5.10.1: /etc/perl /usr/local/lib/perl/5.10.1 /usr/local/share/perl/5.10.1 /usr/lib/perl5 /usr/share/perl5 /usr/lib/perl/5.10 /usr/share/perl/5.10 /usr/local/lib/site_perl . Environment for perl 5.10.1: HOME=/home/ikegami LANG=en_US.UTF-8 LANGUAGE (unset) LC_COLLATE=C LD_LIBRARY_PATH (unset) LOGDIR (unset) PATH=/home/ikegami/usr/perlbrew/bin:.:/home/ikegami/bin:/home/ikegami/.gems/bin:/usr/lib/ruby/gems/1.8/bin/:/usr/local/bin:/usr/bin:/bin:/usr/bin/X11:/usr/games PERLBREW_BASHRC_VERSION=0.41 PERLBREW_HOME=/home/ikegami/.perlbrew PERLBREW_PATH=/home/ikegami/usr/perlbrew/bin PERLBREW_ROOT=/home/ikegami/usr/perlbrew PERL_BADLANG (unset) SHELL=/bin/bash ```
p5pRT commented 12 years ago

From @ikegami

On Fri\, Feb 3\, 2012 at 10​:03 PM\, Eric Brine \perlbug\-followup@&#8203;perl\.orgwrote​:

You can test this yourself using the attached script (extracted from cwd.t) and C\<\< chmod u-r .. >>.

Oops\, now attached.

p5pRT commented 12 years ago

From @ikegami

cwdtest.pl

p5pRT commented 11 years ago

From @jkeenan

On Fri Feb 03 19​:03​:14 2012\, ikegami@​adaelis.com wrote​:

This is a bug report for perl from ikegami@​adaelis.com\, generated with the help of perlbug 1.39 running under perl 5.10.1.

----------------------------------------------------------------- [Please describe your issue here]

[ Applies to 5.10.1\, 5.12.2\, 5.14.2\, blead\, etc ]

Whenever I build Perl on my web host\, I get a failure in Cwd.

# Failed test at t/cwd.t line 209. # '/home/ikegami/usr/perlbrew/build/perl-5.14.2/dist/Cwd/t/linktest' # doesn't match '(?^i​:\/home\/ikegami\/usr\/perlbrew\/build\/perl\- 5\.14\.2\/dist\/Cwd\/t\/_ptrslt_\/_path_\/_to_\/_a_\/_dir_$)' # Looks like you failed 1 test of 34. ../dist/Cwd/t/cwd.t ............................................... Dubious\, test returned 1 (wstat 256\, 0x100) Failed 1/34 subtests (less 1 skipped subtest​: 32 okay)

C\<abs_path> is a function that returns an absolute path with symbolic links resolved. The failing check tests a pure perl version of abs_path called C\<_perl_abs_path>. The pure perl version does not resolve symlinks if any ancestor of the symlink's target directory cannot be read\, and /home cannot be read on my web host.

You can test this yourself using the attached script (extracted from cwd.t) and C\<\< chmod u-r .. >>.

I don't know if C\<_perl_abs_path> should croak or if the test shouldn't fail\, but they currently disagree as to what is acceptable\, forcing me to force install Perl every time. This is especially silly since C\<_perl_abs_path> is only used when "the XS version doesn't load" (according to a comment).

- Eric

I get your point\, but when I tried to replicate the problem on my machine in a slightly modified manner\, I got a result that suggested a problem in Cwd​::abs_path() *even before* looking at Cwd​::_perl_abs_path().

I split your test file into two separate programs so that I could create the test directories\, then modify the directory permissions as you suggested\, then create the symlink and run the second program\, which was essentially the remainder of yours. Both files are attached.

In 'a_109760_cwdtest.pl'\, I remove the test directories and symlink if they're still present from a previous run\, then create the test directories.

In the first pass\, I leave directory permissions untouched and run 'b_109760_cwdtest.pl'\, which creates the symlinks\, performs tests (which all pass)\, and then cleans up after itself.

The output is therefore​: ######### $ prove -v a_109760_cwdtest.pl a_109760_cwdtest.pl .. ok 1 - mkpath created expected number of directories 1..1 ok All tests successful. Files=1\, Tests=1\, 1 wallclock secs ( 0.12 usr 0.03 sys + 0.14 cusr 0.04 csys = 0.33 CPU) Result​: PASS

$ prove -v b_109760_cwdtest.pl b_109760_cwdtest.pl .. ok 1 - symlink to test_dir created # abs_path​: /Users/jimk/learn/perl/p5p/_ptrslt_/_path_/_to_/_a_/_dir_ ok 2 - Cwd​::abs_path matches File​::Spec->rel2abs ok 3 - Cwd​::fast_abs_path matches File​::Spec->rel2abs ok 4 - Cwd​::_perl_abs_path matches File​::Spec->rel2abs 1..4 ok All tests successful. Files=1\, Tests=4\, 0 wallclock secs ( 0.12 usr 0.04 sys + 0.15 cusr 0.07 csys = 0.38 CPU) Result​: PASS ##########

In the second pass\, I run the first program\, then chmod u-r ..\, then run the second program. This time\, the output is​:

########## $ prove -v a_109760_cwdtest.pl a_109760_cwdtest.pl .. ok 1 - mkpath created expected number of directories 1..1 ok All tests successful. Files=1\, Tests=1\, 0 wallclock secs ( 0.12 usr 0.04 sys + 0.13 cusr 0.04 csys = 0.33 CPU) Result​: PASS

$ chmod u-r ..

$ prove -v b_109760_cwdtest.pl b_109760_cwdtest.pl .. ok 1 - symlink to test_dir created # abs_path​: Use of uninitialized value $abs_path in concatenation (.) or string at b_109760_cwdtest.pl line 21. Cannot chdir back to : No such file or directory at b_109760_cwdtest.pl line 22.

1..1 # Looks like your test exited with 255 just after 1. Dubious\, test returned 255 (wstat 65280\, 0xff00) All 1 subtests passed

Test Summary Report

b_109760_cwdtest.pl (Wstat​: 65280 Tests​: 1 Failed​: 0)   Non-zero exit status​: 255 Files=1\, Tests=1\, 0 wallclock secs ( 0.12 usr 0.04 sys + 0.14 cusr 0.04 csys = 0.34 CPU) Result​: FAIL ############

I read this as saying that\, once the higher directory had been rendered unreadable\, the call to Cwd​::abs_path() at line 20 essentially failed; it returned an undefined value.

#########   20 my $abs_path = Cwd​::abs_path($file);   21 note("abs_path​: $abs_path"); #########

So I doubt the problem is *only* in Cwd​::_perl_abs_path().

Thank you very much. Jim Keenan

p5pRT commented 11 years ago

From @jkeenan

a_109760_cwdtest.pl

p5pRT commented 11 years ago

From @jkeenan

b_109760_cwdtest.pl

p5pRT commented 11 years ago

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

p5pRT commented 11 years ago

From gottreu@gmail.com

This is a bug report for perl from gottreu@​gmail.com\, generated with the help of perlbug 1.39 running under perl 5.19.1.

From 5f28c1a5e9dd996eeec4fc4aade74a400a3af87e Mon Sep 17 00​:00​:00 2001 From​: Brian Gottreu \gottreu@&#8203;gmail\.com Date​: Thu\, 13 Jun 2013 14​:33​:36 -0500 Subject​: [PATCH] Skip _perl_abs_path() tests when they will fail with no ill effects MIME-Version​: 1.0 Content-Type​: multipart/mixed; boundary="------------1.7.10.4"

This is a multi-part message in MIME format. --------------1.7.10.4 Content-Type​: text/plain; charset=UTF-8; format=fixed Content-Transfer-Encoding​: 8bit

AUTHORS | 1 + dist/Cwd/t/cwd.t | 11 +++++++++++ 2 files changed\, 12 insertions(+)

--------------1.7.10.4 Content-Type​: text/x-patch; name="0001-Skip-_perl_abs_path-tests-when-they-will-fail-with-n.patch" Content-Transfer-Encoding​: 8bit Content-Disposition​: attachment; filename="0001-Skip-_perl_abs_path-tests-when-they-will-fail-with-n.patch"

Inline Patch ```diff diff --git a/AUTHORS b/AUTHORS index 44f52e2..b00e7e5 100644 --- a/AUTHORS +++ b/AUTHORS @@ -163,6 +163,7 @@ Brian Carlson Brian Clarke brian d foy Brian Fraser +Brian Gottreu Brian Greenfield Brian Grossman Brian Harrison diff --git a/dist/Cwd/t/cwd.t b/dist/Cwd/t/cwd.t index f7b03ed..3c83855 100644 --- a/dist/Cwd/t/cwd.t +++ b/dist/Cwd/t/cwd.t @@ -40,6 +40,17 @@ my $tests = 31; # _perl_abs_path() currently only works when the directory separator # is '/', so don't test it when it won't work. my $EXTRA_ABSPATH_TESTS = ($Config{prefix} =~ m/\//) && $^O ne 'cygwin'; +# _perl_abs_path() uses readdir() on all the directories in the path +# passed to it. If perl is built under /home (for example) and /home is +# set to executable but not readable, then the extra abspath tests will +# fail even though the perl built is perfectly fine. +if($EXTRA_ABSPATH_TESTS) { + my @dirs = File::Spec->splitdir(cwd()); + for(0..$#dirs) { + my $parent_dir = File::Spec->catdir(@dirs[0..$_]); + $EXTRA_ABSPATH_TESTS = 0 unless -r $parent_dir; + } +} $tests += 4 if $EXTRA_ABSPATH_TESTS; plan tests => $tests; --------------1.7.10.4-- --- ```

Flags:   category=core   severity=low

Site configuration information for perl 5.19.1​:

Configured by gottreu at Thu Jun 13 11​:58​:47 CDT 2013.

Summary of my perl5 (revision 5 version 19 subversion 1) configuration​:   Commit id​: 6b28e74b02b8a23cdbd7fd19c2874a19c37827de   Platform​:   osname=linux\, osvers=3.2.0-4-amd64\, archname=x86_64-linux   uname='linux frylock 3.2.0-4-amd64 #1 smp debian 3.2.39-2 x86_64 gnulinux '   config_args='-des -Dprefix=/home/gottreu/devperl -Dusedevel'   hint=recommended\, useposix=true\, d_sigaction=define   useithreads=undef\, usemultiplicity=undef   useperlio=define\, d_sfio=undef\, uselargefiles=define\, usesocks=undef   use64bitint=define\, use64bitall=define\, uselongdouble=undef   usemymalloc=n\, bincompat5005=undef   Compiler​:   cc='cc'\, ccflags ='-fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64'\,   optimize='-O2'\,   cppflags='-fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include'   ccversion=''\, gccversion='4.7.2'\, gccosandvers=''   intsize=4\, longsize=8\, ptrsize=8\, doublesize=8\, byteorder=12345678   d_longlong=define\, longlongsize=8\, d_longdbl=define\, longdblsize=16   ivtype='long'\, ivsize=8\, nvtype='double'\, nvsize=8\, Off_t='off_t'\, lseeksize=8   alignbytes=8\, prototype=define   Linker and Libraries​:   ld='cc'\, ldflags =' -fstack-protector -L/usr/local/lib'   libpth=/usr/local/lib /lib/x86_64-linux-gnu /lib/../lib /usr/lib/x86_64-linux-gnu /usr/lib/../lib /lib /usr/lib   libs=-lnsl -lgdbm -ldb -ldl -lm -lcrypt -lutil -lc -lgdbm_compat   perllibs=-lnsl -ldl -lm -lcrypt -lutil -lc   libc=\, so=so\, useshrplib=false\, libperl=libperl.a   gnulibc_version='2.13'   Dynamic Linking​:   dlsrc=dl_dlopen.xs\, dlext=so\, d_dlsymun=undef\, ccdlflags='-Wl\,-E'   cccdlflags='-fPIC'\, lddlflags='-shared -O2 -L/usr/local/lib -fstack-protector'

Locally applied patches​:  

@​INC for perl 5.19.1​:   /home/gottreu/devperl/lib/site_perl/5.19.1/x86_64-linux   /home/gottreu/devperl/lib/site_perl/5.19.1   /home/gottreu/devperl/lib/5.19.1/x86_64-linux   /home/gottreu/devperl/lib/5.19.1   .

Environment for perl 5.19.1​:   HOME=/home/gottreu   LANG=en_US.UTF-8   LANGUAGE (unset)   LD_LIBRARY_PATH (unset)   LOGDIR (unset)   PATH=/home/gottreu/bin​:/home/gottreu/bin​:/usr/local/bin​:/usr/bin​:/bin​:/usr/local/games​:/usr/games   PERL_BADLANG (unset)   SHELL=/bin/bash

p5pRT commented 11 years ago

From @jkeenan

On Thu Jun 13 13​:10​:46 2013\, gottreu wrote​:

This is a bug report for perl from gottreu@​gmail.com\, generated with the help of perlbug 1.39 running under perl 5.19.1.

From 5f28c1a5e9dd996eeec4fc4aade74a400a3af87e Mon Sep 17 00​:00​:00 2001 From​: Brian Gottreu \gottreu@&#8203;gmail\.com Date​: Thu\, 13 Jun 2013 14​:33​:36 -0500 Subject​: [PATCH] Skip _perl_abs_path() tests when they will fail with no ill effects MIME-Version​: 1.0 Content-Type​: multipart/mixed; boundary="------------1.7.10.4"

This is a multi-part message in MIME format. --------------1.7.10.4 Content-Type​: text/plain; charset=UTF-8; format=fixed Content-Transfer-Encoding​: 8bit

--- AUTHORS | 1 + dist/Cwd/t/cwd.t | 11 +++++++++++ 2 files changed\, 12 insertions(+)

--------------1.7.10.4 Content-Type​: text/x-patch; name="0001-Skip-_perl_abs_path-tests-when- they-will-fail-with-n.patch" Content-Transfer-Encoding​: 8bit Content-Disposition​: attachment; filename="0001-Skip-_perl_abs_path- tests-when-they-will-fail-with-n.patch"

diff --git a/AUTHORS b/AUTHORS index 44f52e2..b00e7e5 100644 --- a/AUTHORS +++ b/AUTHORS @​@​ -163\,6 +163\,7 @​@​ Brian Carlson \brian\.carlson@&#8203;cpanel\.net Brian Clarke \clarke@&#8203;appliedmeta\.com brian d foy \brian\.d\.foy@&#8203;gmail\.com Brian Fraser \fraserbn@&#8203;gmail\.com +Brian Gottreu \gottreu@&#8203;gmail\.com Brian Greenfield \briang@&#8203;cpan\.org Brian Grossman Brian Harrison \brie@&#8203;corp\.home\.net diff --git a/dist/Cwd/t/cwd.t b/dist/Cwd/t/cwd.t index f7b03ed..3c83855 100644 --- a/dist/Cwd/t/cwd.t +++ b/dist/Cwd/t/cwd.t @​@​ -40\,6 +40\,17 @​@​ my $tests = 31; # _perl_abs_path() currently only works when the directory separator # is '/'\, so don't test it when it won't work. my $EXTRA_ABSPATH_TESTS = ($Config{prefix} =~ m/\//) && $^O ne 'cygwin'; +# _perl_abs_path() uses readdir() on all the directories in the path +# passed to it. If perl is built under /home (for example) and /home is +# set to executable but not readable\, then the extra abspath tests will +# fail even though the perl built is perfectly fine. +if($EXTRA_ABSPATH_TESTS) { + my @​dirs = File​::Spec->splitdir(cwd()); + for(0..$#dirs) { + my $parent_dir = File​::Spec->catdir(@​dirs[0..$_]); + $EXTRA_ABSPATH_TESTS = 0 unless -r $parent_dir; + } +} $tests += 4 if $EXTRA_ABSPATH_TESTS; plan tests => $tests;

Thanks for the patch. Can you elaborate a bit as to how it addresses the issues raised in the earlier posts in this RT?

Thank you very much. Jim Keenan

p5pRT commented 11 years ago

From @ikegami

On Thu\, Jun 13\, 2013 at 10​:21 PM\, James E Keenan via RT \< perlbug-followup@​perl.org> wrote​:

Thanks for the patch. Can you elaborate a bit as to how it addresses the issues raised in the earlier posts in this RT?

Looking into your earlier comments\, and testing to see if the patch addresses my problem.

p5pRT commented 11 years ago

From gottreu@gmail.com

Thanks for the patch. Can you elaborate a bit as to how it addresses the issues raised in the earlier posts in this RT?

It sort of didn't. It didn't solve the actual problem of _perl_abs_path() not resolving all the paths that abs_path() can. It just made some harmlessly failing tests not fail.

This new patch is an actual fix. I just translated the bsd_realpath() C function to Perl.

This is a bug report for perl from gottreu@​gmail.com\, generated with the help of perlbug 1.39 running under perl 5.19.1.

From a380df6c6c1f9e17832236d07838efac3007a838 Mon Sep 17 00​:00​:00 2001 From​: Brian Gottreu \gottreu@&#8203;gmail\.com Date​: Thu\, 13 Jun 2013 22​:26​:22 -0500 Subject​: [PATCH] Replace _perl_abs_path() with a version that does not require readable directories\, only executable ones. It's just a Perl version of the bsd_realpath() function already used by abs_path() for Unix systems. This version mimics the behavior of abs_path() more closely than the previous version. It returns undef on failure instead of the empty string. MIME-Version​: 1.0 Content-Type​: multipart/mixed; boundary="------------1.7.10.4"

This is a multi-part message in MIME format. --------------1.7.10.4 Content-Type​: text/plain; charset=UTF-8; format=fixed Content-Transfer-Encoding​: 8bit

AUTHORS | 1 + dist/Cwd/Cwd.pm | 129 ++++++++++++++++++++++++------------------------------- 2 files changed\, 56 insertions(+)\, 74 deletions(-)

--------------1.7.10.4 Content-Type​: text/x-patch; name="0001-Replace-_perl_abs_path-with-a-version-that-does-not-.patch" Content-Transfer-Encoding​: 8bit Content-Disposition​: attachment; filename="0001-Replace-_perl_abs_path-with-a-version-that-does-not-.patch"

Inline Patch ```diff diff --git a/AUTHORS b/AUTHORS index 44f52e2..b00e7e5 100644 --- a/AUTHORS +++ b/AUTHORS @@ -163,6 +163,7 @@ Brian Carlson Brian Clarke brian d foy Brian Fraser +Brian Gottreu Brian Greenfield Brian Grossman Brian Harrison diff --git a/dist/Cwd/Cwd.pm b/dist/Cwd/Cwd.pm index 5cbb9d8..062e03c 100644 --- a/dist/Cwd/Cwd.pm +++ b/dist/Cwd/Cwd.pm @@ -536,82 +536,63 @@ sub chdir { } -sub _perl_abs_path -{ - my $start = @_ ? shift : '.'; - my($dotdots, $cwd, @pst, @cst, $dir, @tst); - - unless (@cst = stat( $start )) - { - _carp("stat($start): $!"); - return ''; +sub _perl_abs_path { + # NOTE that this routine assumes that '/' is the only directory separator. + my $path = @_ ? shift : '.'; + my $resolved; + my $next_token; + my $left; + my $symlinks; + return '/' if $path eq '/'; + if($path =~ m{^/(.+)}) { + $resolved = '/'; + $left = $1; } - - unless (-d _) { - # Make sure we can be invoked on plain files, not just directories. - # NOTE that this routine assumes that '/' is the only directory separator. - - my ($dir, $file) = $start =~ m{^(.*)/(.+)$} - or return cwd() . '/' . $start; - - # Can't use "-l _" here, because the previous stat was a stat(), not an lstat(). - if (-l $start) { - my $link_target = readlink($start); - die "Can't resolve link $start: $!" unless defined $link_target; - - require File::Spec; - $link_target = $dir . '/' . $link_target - unless File::Spec->file_name_is_absolute($link_target); - - return abs_path($link_target); - } - - return $dir ? abs_path($dir) . "/$file" : "/$file"; + else { + $resolved = cwd(); + $left = $path; } - - $cwd = ''; - $dotdots = $start; - do - { - $dotdots .= '/..'; - @pst = @cst; - local *PARENT; - unless (opendir(PARENT, $dotdots)) - { - # probably a permissions issue. Try the native command. - require File::Spec; - return File::Spec->rel2abs( $start, _backtick_pwd() ); - } - unless (@cst = stat($dotdots)) - { - _carp("stat($dotdots): $!"); - closedir(PARENT); - return ''; - } - if ($pst[0] == $cst[0] && $pst[1] == $cst[1]) - { - $dir = undef; - } - else - { - do - { - unless (defined ($dir = readdir(PARENT))) - { - _carp("readdir($dotdots): $!"); - closedir(PARENT); - return ''; - } - $tst[0] = $pst[0]+1 unless (@tst = lstat("$dotdots/$dir")) - } - while ($dir eq '.' || $dir eq '..' || $tst[0] != $pst[0] || - $tst[1] != $pst[1]); - } - $cwd = (defined $dir ? "$dir" : "" ) . "/$cwd" ; - closedir(PARENT); - } while (defined $dir); - chop($cwd) unless $cwd eq '/'; # drop the trailing / - $cwd; + while($left ne '' and $left =~ m{^(.*?)(?:/|$)(.*)}) { + $next_token = $1; + $left = $2; + $resolved .= '/' unless $resolved =~ m{/$}; + if($next_token eq '') { next; } + if($next_token eq '.') { next; } + if($next_token eq '..') { + if($resolved ne '/') { + $resolved =~ s{/[^/]+/$}{/}; + } + next; + } + my $resolved_parent = $resolved; + $resolved .= $next_token; + my @sb; + @sb = lstat($resolved); + unless(@sb) { + return undef if $path =~ m{/$}; + return $resolved if $left eq '' and -x $resolved_parent; + return undef; + } + if(-l $resolved) { + my $symlink; + return undef if ++$symlinks > 50; + $symlink = readlink($resolved); + unless($symlink) { return undef; } + if($symlink =~ m{^/}) { + $resolved = '/'; + } + elsif(length($resolved) > 1) { + $resolved =~ s{/[^/]+$}{}; + } + if($left ne '') { + $symlink .= '/' unless $symlink =~ m{/$}; + $symlink .= $left; + } + $left = $symlink; + } + } + $resolved =~ s{/$}{} if length($resolved) > 1; + return $resolved; } --------------1.7.10.4-- --- ```

Flags:   category=core   severity=low

Site configuration information for perl 5.19.1​:

Configured by gottreu at Thu Jun 13 17​:46​:12 CDT 2013.

Summary of my perl5 (revision 5 version 19 subversion 1) configuration​:   Derived from​: 9152021db0fe677bcc7f8460e5d5419a79462abc   Platform​:   osname=linux\, osvers=3.2.0-4-amd64\, archname=x86_64-linux   uname='linux frylock 3.2.0-4-amd64 #1 smp debian 3.2.39-2 x86_64 gnulinux '   config_args='-des -Dprefix=/home/gottreu/devperl2 -Dusedevel'   hint=recommended\, useposix=true\, d_sigaction=define   useithreads=undef\, usemultiplicity=undef   useperlio=define\, d_sfio=undef\, uselargefiles=define\, usesocks=undef   use64bitint=define\, use64bitall=define\, uselongdouble=undef   usemymalloc=n\, bincompat5005=undef   Compiler​:   cc='cc'\, ccflags ='-fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64'\,   optimize='-O2'\,   cppflags='-fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include'   ccversion=''\, gccversion='4.7.2'\, gccosandvers=''   intsize=4\, longsize=8\, ptrsize=8\, doublesize=8\, byteorder=12345678   d_longlong=define\, longlongsize=8\, d_longdbl=define\, longdblsize=16   ivtype='long'\, ivsize=8\, nvtype='double'\, nvsize=8\, Off_t='off_t'\, lseeksize=8   alignbytes=8\, prototype=define   Linker and Libraries​:   ld='cc'\, ldflags =' -fstack-protector -L/usr/local/lib'   libpth=/usr/local/lib /lib/x86_64-linux-gnu /lib/../lib /usr/lib/x86_64-linux-gnu /usr/lib/../lib /lib /usr/lib   libs=-lnsl -lgdbm -ldb -ldl -lm -lcrypt -lutil -lc -lgdbm_compat   perllibs=-lnsl -ldl -lm -lcrypt -lutil -lc   libc=\, so=so\, useshrplib=false\, libperl=libperl.a   gnulibc_version='2.13'   Dynamic Linking​:   dlsrc=dl_dlopen.xs\, dlext=so\, d_dlsymun=undef\, ccdlflags='-Wl\,-E'   cccdlflags='-fPIC'\, lddlflags='-shared -O2 -L/usr/local/lib -fstack-protector'

Locally applied patches​:  

@​INC for perl 5.19.1​:   /home/gottreu/perl5/lib/perl5/x86_64-linux-gnu-thread-multi   /home/gottreu/perl5/lib/perl5   /home/gottreu/devperl2/lib/site_perl/5.19.1/x86_64-linux   /home/gottreu/devperl2/lib/site_perl/5.19.1   /home/gottreu/devperl2/lib/5.19.1/x86_64-linux   /home/gottreu/devperl2/lib/5.19.1   .

Environment for perl 5.19.1​:   HOME=/home/gottreu   LANG=en_US.UTF-8   LANGUAGE (unset)   LD_LIBRARY_PATH (unset)   LOGDIR (unset)   PATH=/home/gottreu/bin​:/home/gottreu/perl5/bin​:/home/gottreu/perl5/perlbrew/bin​:/usr/local/bin​:/usr/bin​:/bin​:/usr/local/games​:/usr/games   PERL5LIB=/home/gottreu/perl5/lib/perl5/x86_64-linux-gnu-thread-multi​:/home/gottreu/perl5/lib/perl5   PERLBREW_BASHRC_VERSION=0.42   PERLBREW_HOME=/home/gottreu/.perlbrew   PERLBREW_PATH=/home/gottreu/perl5/perlbrew/bin   PERLBREW_ROOT=/home/gottreu/perl5/perlbrew   PERL_BADLANG (unset)   PERL_LOCAL_LIB_ROOT=/home/gottreu/perl5   PERL_MB_OPT=--install_base /home/gottreu/perl5   PERL_MM_OPT=INSTALL_BASE=/home/gottreu/perl5   SHELL=/bin/bash

p5pRT commented 11 years ago

From @ikegami

On Sat\, Feb 23\, 2013 at 8​:35 PM\, James E Keenan via RT \< perlbug-followup@​perl.org> wrote​:

$ prove -v b_109760_cwdtest.pl

b_109760_cwdtest.pl .. ok 1 - symlink to test_dir created # abs_path​: Use of uninitialized value $abs_path in concatenation (.) or string at b_109760_cwdtest.pl line 21. Cannot chdir back to : No such file or directory at b_109760_cwdtest.pl line 22.

I don't get that. I get something similar if I run "b" twice without running "a" in between

ok 1 - symlink to test_dir created Use of uninitialized value $abs_path in concatenation (.) or string at b.plline 21. # abs_path​: linktest​: No such file or directory at b.pl line 22. 1..1 # Looks like your test exited with 255 just after 1.

But if I execute the commands you executed in the order you said you did\, I get​:

ok 1 - symlink to test_dir created # abs_path​: /home/ikegami/projects/perl/_ptrslt_/_path_/_to_/_a_/_dir_ ok 2 - Cwd​::abs_path matches File​::Spec->rel2abs ok 3 - Cwd​::fast_abs_path matches File​::Spec->rel2abs not ok 4 - Cwd​::_perl_abs_path matches File​::Spec->rel2abs # Failed test 'Cwd​::_perl_abs_path matches File​::Spec->rel2abs' # at b.pl line 31. # '/home/ikegami/projects/perl/linktest' # doesn't match '(?^i​:\/home\/ikegami\/projects\/perl\/_ptrslt_\/_path_\/_to_\/_a_\/_dir_$)' 1..4 # Looks like you failed 1 test of 4.

Brian's first patch ("Skip _perl_abs_path() tests when they will fail with no ill effects") does address the problem I reported\, and in an acceptable manner.

I don't have time to look at his alternate/second patch right now.

- Eric

p5pRT commented 11 years ago

From gottreu@gmail.com

Attached is a test (dist/Cwd/t/abs_path.t) that makes sure _perl_abs_path() and abs_path() return the same results.

p5pRT commented 11 years ago

From gottreu@gmail.com

#!./perl -w

use strict;

# XXX All the crossplatform stuff is cargo-cultedly copied from cwd.t use Cwd;

chdir 't';

use Config; use File​::Spec; use File​::Path qw(make_path remove_tree);

use lib File​::Spec->catdir('t'\, 'lib'); use Test​::More;

# _perl_abs_path() currently only works when the directory separator # is '/'\, so don't test it when it won't work. unless(($Config{prefix} =~ m/\//) && $^O ne 'cygwin') {   plan skip_all => "only check _perl_abs_path() when the directory separator is '/'"; }

my @​real_dirs = qw(   _base_   _base_/ok   _base_/ok/dir   _base_/unreadable   _base_/unreadable/dir   _base_/unexec   _base_/unexec/dir   _base_/nothing   _base_/nothing/dir );

my @​real_files = qw(   _base_/ok/file1   _base_/ok/dir/file2   _base_/unreadable/file3   _base_/unreadable/dir/file4   _base_/unexec/file5   _base_/unexec/dir/file6   _base_/nothing/file7   _base_/nothing/dir/file8 );

my %valid_links = qw(   _base_/link-ok0 ok   _base_/link-ok1 ok/file1   _base_/link-ok2 ok/dir   _base_/link-ok3 ok/dir/file2   _base_/link-unreadable0 unreadable   _base_/link-unreadable1 unreadable/file3   _base_/link-unreadable2 unreadable/dir   _base_/link-unreadable3 unreadable/dir/file4

  _base_/link-bin /bin   _base_/link-rm /bin/rm );

my %broken_links = qw(   _base_/link-unexec0 unexec   _base_/link-unexec1 unexec/file5   _base_/link-unexec2 unexec/dir   _base_/link-unexec3 unexec/dir/file6

  _base_/link-nothing0 nothing   _base_/link-nothing1 nothing/file7   _base_/link-nothing2 nothing/dir   _base_/link-nothing3 nothing/dir/file8

  _base_/link-loop link-loop

  _base_/link-non-existant non-existant   _base_/link-non-existant2 non/existant/dirs );

my @​reg_paths = qw(   _base_/../_base_/ok/file1   _base_/ok/dir/../file1   _base_/ok//file1   _base_/./ok/./file1   _base_/unreadable/dir/../../ok/file1   _base_/unreadable/../ok/file1   _base_/unexec/dir/../../ok/file1   _base_/unexec/../ok/file1   _base_/non-existant );

my @​link_paths = qw(   _base_/link-ok2/file2   _base_/link-ok2/../file1

  _base_/link-ok2/file1   _base_/link-ok2/../file2 );

#my $tests = 1 + list_files("don't run cwd()"); my $tests = 1 + 3*list_reg_files() + 3*list_symlinks(); plan tests => $tests; my $cwd; my $CWD_WORKS = 0;

my $IsVMS = $^O eq 'VMS'; my $vms_unix_rpt = 0; if ($IsVMS) {   require VMS​::Filespec;   use Carp;   use Carp​::Heavy;   if (eval 'require VMS​::Feature') {   $vms_unix_rpt = VMS​::Feature​::current("filename_unix_report");   } else {   my $unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';   $vms_unix_rpt = $unix_rpt =~ /^[ET1]/i;   } }

SKIP​: {   # Must find an external pwd (or equivalent) command.   my $pwd = $^O eq 'MSWin32' ? "cmd" : "pwd";   my $pwd_cmd = ($^O eq "NetWare") ? "cd" :   (grep { -x && -f } map { "$_/$pwd$Config{exe_ext}" }   split m/$Config{path_sep}/\, $ENV{PATH})[0];   $pwd_cmd = 'SHOW DEFAULT' if $IsVMS;   if ($^O eq 'MSWin32') {   $pwd_cmd =~ s{/}{\\}g;   $pwd_cmd = "$pwd_cmd /c cd";   }   $pwd_cmd =~ s{\\}{/}g if ($^O eq 'dos');

  skip "No native pwd command found to test against"\, 1 unless $pwd_cmd;

  local @​ENV{qw(PATH IFS CDPATH ENV BASH_ENV)};   my ($pwd_cmd_untainted) = $pwd_cmd =~ /^(.+)$/; # Untaint.   chomp(my $start = `$pwd_cmd_untainted`);

  # Win32's cd returns native C​:\ style   $start =~ s{\\}{/}g if ($^O eq 'MSWin32' || $^O eq "NetWare");   if ($IsVMS) {   # DCL SHOW DEFAULT has leading spaces   $start =~ s/^\s+//;

  # When in UNIX report mode\, need to convert to compare it.   if ($vms_unix_rpt) {   $start = VMS​::Filespec​::unixpath($start);   # Remove trailing slash.   $start =~ s{/$}{};   }   }   skip("'$pwd_cmd' failed\, nothing to test against"\, 1) if $?;   skip("/afs seen\, paths unlikely to match"\, 1) if $start =~ m{/afs/};

  # Darwin's getcwd(3) (which Cwd.xs​:bsd_realpath() uses which   # Cwd.pm​:getcwd uses) has some magic related to the PWD   # environment variable​: if PWD is set to a directory that   # looks about right (guess​: has the same (dev\,ino) as the '.'?)\,   # the PWD is returned. However\, if that path contains   # symlinks\, the path will not be equal to the one returned by   # /bin/pwd (which probably uses the usual walking upwards in   # the path -trick). This situation is easy to reproduce since   # /tmp is a symlink to /private/tmp. Therefore we invalidate   # the PWD to force getcwd(3) to (re)compute the cwd in full.   # Admittedly fixing this in the Cwd module would be better   # long-term solution but deleting $ENV{PWD} should not be   # done light-heartedly. --jhi   delete $ENV{PWD} if $^O eq 'darwin';

  $cwd = cwd;   is($cwd\, $start\, 'cwd()') and $CWD_WORKS=1; }

eval {   create_files();   SKIP​: {   compare_perl_and_xs( list_reg_files() );   compare_perl_and_xs( map { "$_/" } list_reg_files() );   if($CWD_WORKS) {   compare_perl_and_xs( map { "$cwd/$_" } list_reg_files() );   } else {   skip "cwd() may not be correct"\, scalar(list_reg_files());   }   }

  SKIP​: {   skip "no symlinks on this platform"\, (list_symlinks() * 3)   unless $Config{d_symlink};   compare_perl_and_xs( list_symlinks() );   compare_perl_and_xs( map { "$_/" } list_symlinks() );   if($CWD_WORKS) {   compare_perl_and_xs( map { "$cwd/$_" } list_symlinks() );   } else {   skip "cwd() may not be correct"\, scalar(list_symlinks());   }   } }; delete_files();

sub list_reg_files {   my @​all = (@​real_dirs\, @​real_files\, @​reg_paths);   return @​all; }

sub list_symlinks {   my @​all = (sort(keys %valid_links)\, sort(keys %broken_links)\, @​link_paths);   return @​all; }

sub compare_perl_and_xs {   my @​files = @​_;   for my $file (@​files) {   my $c = Cwd​::abs_path($file);   my $p = Cwd​::_perl_abs_path($file);   is($p\, $c) or diag("path​: $file");   } }

sub create_files {   make_path($_) for @​real_dirs;   system("touch $_") for @​real_files;   symlink($valid_links{$_}\, $_) for keys %valid_links;   symlink($broken_links{$_}\, $_) for keys %broken_links;   chmod 0311\, '_base_/unreadable';   chmod 0644\, '_base_/unexec';   chmod 0200\, '_base_/nothing'; }

sub delete_files {   remove_tree("_base_"); }