Repository navigation
do EXPR on dir fails but has no error code $! #14841
Description
Activity
From @bulk88
Created by @bulk88
The docs for "do EXPR" state
---------------------------------------------------------------------------
If do can read the file but cannot compile it, it returns undef and sets
an error message in $@ . If do cannot read the file, it returns undef
and sets$! to the error. Always check $ @ first, as compilation could
fail in a way that also sets $! . If the file is successfully compiled,
do returns the value of the last expression evaluated.
---------------------------------------------------------------------------Lets call do() on a dir.
---------------------------------------------------------------------------
C:\perl521\srcnewb4opt>perl -MData::Dumper -E"my $r = do q|C:\Windows|;
print Du
mper($r, $ @, $!);"
$VAR1 = undef;
$VAR2 = '';
$VAR3 = '';C:\perl521\srcnewb4opt>
C:\perl521\srcnewb4opt>perl -MData::Dumper -E"my $r = require
q|C:\Windows|; pri
nt Dumper($r, $ @, $!);"
Can't locate C:\Windows in @INC (@INC contains:
C:/perl521/srcnewb4opt/lib .) at
-e line 1.C:\perl521\srcnewb4opt>
------------------------------------------------------------------------
~$perl5.22.0 -MData::Dumper -E'my $r = do q|/bin|; print Dumper($r,$ @,$!);'
$VAR1 = undef;
$VAR2 = '';
$VAR3 = '';
~$
~$perl5.22.0 -MData::Dumper -E'my $r = require q|/bin|; print
Dumper($r,$ @,$!)>
Can't locate /bin in @INC (@INC contains:
/opt/perl32/lib/site_perl/5.22.0/PA-RISC2.0
/opt/perl32/lib/site_perl/5.22.0 /opt/perl32/lib/5.22.0/PA-RISC2.0
/opt/perl32/lib/5.22.0 .) at -e line 1.
~$
~$perl5.22.0 -MData::Dumper -E'my $r = do q|/binnofile|; print
Dumper($r,$ @,$!>
$VAR1 = undef;
$VAR2 = '';
$VAR3 = 'No such file or directory';
~$
~$perl5.22.0 -MData::Dumper -E'my $r = do q|/sbin/passwd|; print
Dumper($r,$ @,>
$VAR1 = undef;
$VAR2 = '';
$VAR3 = 'Permission denied';
~$------------------------------------------------------------------------
So where is the error in $!?
http://perl5.git.perl.org/perl.git/blob/HEAD:/t/op/do.t never tests the
numerical value of $! except against 0.http://perl5.git.perl.org/perl.git/commitdiff/b2da7ead6803119763b139be37b2cc8c8f522f75
errno = 0 is questionable API. POSIX never sets errno to 0.http://perl5.git.perl.org/perl.git/commitdiff/6b845e562be40aac749b544b6d494078c54de4aa
if it is a dir, errno is effectivly uninitializedI am proposing that do() on a directory set $!/errno to EISDIR instead of 0.
I found this bug due to me wanting to remove the -f syscall out of
buildcustomize.pl loader code at
http://perl5.git.perl.org/perl.git/blob/749f0eb1485a7bb7561d71f9539d9b7655363136:/perl.c#l2106
, the -f was added by
http://perl5.git.perl.org/perl.git/commitdiff/404ad9dc9dfa2116d2907212d3650df6870ff9bc
but later on commit
http://perl5.git.perl.org/perl.git/commitdiff/af26e4f23ae11a43d1a3ac56ed110a974e093811
started doing better diagnostics including printing $! on error, since
http://perl5.git.perl.org/perl.git/commitdiff/404ad9dc9dfa2116d2907212d3650df6870ff9bc
is a commentless commit, IDK why it is doing -f, that leads me to wonder
if its to stop do() on a dir, and I discover do() on a directory returns
no useful error in $! to show the user.Perl Info
Flags: category=core severity=low Site configuration information for perl 5.23.2: Configured by Owner at Wed Jul 22 12:17:22 2015. Summary of my perl5 (revision 5 version 23 subversion 2) configuration: Derived from: f8ccc6c719cd8ef25c59a4a21fe1bab9f6a38c5b Ancestor: 30dc90f1923c08aae65b60f713ac12490a716e10 Platform: osname=MSWin32, osvers=5.1, archname=MSWin32-x86-multi-thread uname='' config_args='undef' hint=recommended, useposix=true, d_sigaction=undef useithreads=define, usemultiplicity=define use64bitint=undef, use64bitall=undef, uselongdouble=undef usemymalloc=n, bincompat5005=undef Compiler: cc='cl', ccflags ='-nologo -GF -W3 -O1 -MD -Zi -DNDEBUG -GL -DWIN32 -D_CONSOLE -DNO_STRICT -DPERL_TEXTMODE_SCRIPTS -DPERL_IMPLICIT_CONTEXT -DPERL_IMPLICIT_SYS -D_USE_32BIT_TIME_T', optimize='-O1 -MD -Zi -DNDEBUG -GL', cppflags='-DWIN32' ccversion='13.10.6030', gccversion='', gccosandvers='' intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234, doublekind=3 d_longlong=undef, longlongsize=8, d_longdbl=define, longdblsize=8, longdblkind=0 ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='__int64', lseeksize=8 alignbytes=8, prototype=define Linker and Libraries: ld='link', ldflags ='-nologo -nodefaultlib -debug -opt:ref,icf -ltcg -libpath:"c:\perl521\lib\CORE" -machine:x86' libpth=\lib libs=oldnames.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib netapi32.lib uuid.lib ws2_32.lib mpr.lib winmm.lib version.lib odbc32.lib odbccp32.lib comctl32.lib msvcrt.lib perllibs=oldnames.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib netapi32.lib uuid.lib ws2_32.lib mpr.lib winmm.lib version.lib odbc32.lib odbccp32.lib comctl32.lib msvcrt.lib libc=msvcrt.lib, so=dll, useshrplib=true, libperl=perl523.lib gnulibc_version='' Dynamic Linking: dlsrc=dl_win32.xs, dlext=dll, d_dlsymun=undef, ccdlflags=' ' cccdlflags=' ', lddlflags='-dll -nologo -nodefaultlib -debug -opt:ref,icf -ltcg -libpath:"c:\perl521\lib\CORE" -machine:x86' Locally applied patches: uncommitted-changes a3b5f9fb00dafcb11d1766baaec76abc90f9fd06 913cec4246caa89e35bb997c168e7ea2dfcadc4f 7f279091ed7e7241570d4e4abce94248caeb8869 ba4fc2b447d5c04e1ada54027c446d03452dcb25 931a625beed2a34b7d28dca23d41b17e658509d5 83c1fffeadddac231b705fc8a420de87fd4f5ea3 41349288283615495b6de1523783d60c9fd7310b 1c2511e0acc5a19f9f52fb2be58a4e2750213e6f ce0b42da7302bf923a6e4080a343f168e4b3b526 de6cb0abd243e5772b9783a2cbeef5755a8267d6 262309092c2de925e7ae4a527174f8dc2a0ec7b7 b92342550433b215a30d5d4b9bfe55321c69f8ac 9100b351e15341ed12d22822713635b0e4e2237d e68670aedff308b76d0c1076a6073146840fb322 97bf8a2377185e29b65c2d10276fb50d0ad63d41 fefb073f144151139233ca435fb1fc9edf684fe4 87518e92cecac2acea7073cceea51ca610774fb0 ce4793f183b29c423cb9d2d993fb4399c8d46baa c4e131a911a886c1978fea41bd198d709effb11e dc013420c1f83597b1da234ce2907e675a9e3107 6962a25d62cfc67866faccd188344d479b518d4a 0b8e484270e7477903f4a13f1bea68e427a03c70 3e3bbb9b3cd1149bba698cb5d92fa3150db92d89 082ce9c667e6d73783164fa1abab61806b678b4f 638ca15aeec3bf86124489c8c913c5b42d4fee16 46e58bd2391172ab5e4a73c29fb3313bebcf00bc 0d610ac116dfe1f7752682b7e30e8019569d8adb 9b1753cf7072d34b7e4bd1ea60369cbaf80e6152 fb7e9cdd4113e4cf1a43224b3f50ca540d8fc1b4 4d5d35d9def298c0adab2e34a187efa998cea923 db95646430f250935e9615b04eecb9c0d138c515 139271cd3e9cb3cf25072ebdd400e52275c61b96 bfab049986675c47a6b5030ff9c8f39c28e7945e 31221351abb3a508c369e8203d17da077adc667b 6114e455f60b0de62a0b74edee3c9e1841d49c42 ad06c68e1547b1a860919feac7df7c509e7efbaf d6525a59e9307fd297f8bc4c5e67aae146009637 1c9e1c249f3ee943b0090563811df613ebae456e 2ad3e690162d015bf2b0cc83f073d710e8e25fe4 c3de430b4163fa2425ce1f96c6979354f493ccf4 e89d87ccef460faf57b78f904d5113b01353308b 8656412da8e4f5fd0e75563115e66dc105a29bb3 f282dc56fa0121a54a0752163e66b158b3a60e69 c1883b8b014bf0c1dad3d50b6052ef68120c7247 904c4cac2b93435ab1ae1b204e376b99fc770895 c56f8d90b66d2ad5aab73a192124dbef90a32af0 cf73cedaf40b99f39f3b4c5d0fa1aa0f125c73e3 430812d753cb6126658aa5764d72c857935e7552 923c264ef19ba3c5a3351e7ae6c73b8bde122801 a619091c6e82aa7538af9defae3262a68921e66d 04edae75060b165358c49e90531901bb186e160e cc116ce7f30f9861a5b501456e5dfaf8e57de587 e7f1d4a74b38eea00e7928f048d1981610a4bced 14071f951e2facb2599e25258093b7c4426a2b4a 003900e275f0c45375d4d02ffb0ac0fcd2eacfa2 c7a622b32220ef59969124212598b6848bcaa247 86f4502880c5cbc7a5ec1510ab05a413bfb40e03 23fd77c01aafa1987698dc47bed34bd342178516 16bc0f484029674886960a735bef3fa497aeb6de 4ad176efffec2453196c8a3f35f73c0eeed776a0 5478a2b983aa7a04b93cfaf83bb9805713bf2d3f 6ffcffbd7dc3d42844ba051086599e4f70bfdb1f bbef9e8971749a5008bb4cd805eff6a7e0c584b4 b992490dd5c64d667e649dd0ee35a658034d93c0 f7e03a1013a0b759f99885c500f0e89656a992ba a55c5245146801ac2b2be2914342a6a829670513 f832b29a2b3f71c66c6e6b76a02b5faefe0ebeb1 e27be216b1132c5c017dc516d806edf309c90386 8a62d6b8193214bd476c275fc4b083b526108223 48e9f29d31f13e3ebfb9f77ed4effa561966c7a9 42d29f360f39f2ec518ddc4b80f4284099e75689 94dbd6cfe2263c2f66825f35679153e430e506e5 37b95795022b11ae328e98d5e247a2a8ca8593ca b36000125e2dbb5bf2e2e2580b5fa7572e13a768 f8ccc6c719cd8ef25c59a4a21fe1bab9f6a38c5b @INC for perl 5.23.2: C:/perl521/site/lib C:/perl521/lib . Environment for perl 5.23.2: HOME (unset) LANG (unset) LANGUAGE (unset) LD_LIBRARY_PATH (unset) LOGDIR (unset) PATH=C:\perl521\bin;C:\Program Files\Microsoft Visual Studio .NET 2003\Common7\IDE;C:\Program Files\Microsoft Visual Studio .NET 2003\VC7\BIN;C:\Program Files\Microsoft Visual Studio .NET 2003\Common7\Tools;C:\Program Files\Microsoft Visual Studio .NET 2003\Common7\Tools\bin\prerelease;C:\WINDOWS\system32;C:\WINDOWS;C:\WINDOWS\system32\wbem; PERL_BADLANG (unset) SHELL (unset)From gdg@zplane.com
bulk88 <perlbug-followup@perl.org> [2015-08-09 13:42:44 -0700]:
# New Ticket Created by bulk88
# Please include the string: [perl #125774]
# in the subject line of all future correspondence about this issue.
# <URL: https://rt-archive.perl.org/perl5/Ticket/Display.html?id=125774 >This is a bug report for perl from bulk88@hotmail.com,
generated with the help of perlbug 1.40 running under perl 5.23.2.-----------------------------------------------------------------
[Please describe your issue here]The docs for "do EXPR" state
---------------------------------------------------------------------------
If do can read the file but cannot compile it, it returns undef and sets
an error message in $@ . If do cannot read the file, it returns undef
and sets$! to the error. Always check $ @ first, as compilation could
fail in a way that also sets $! . If the file is successfully compiled,
do returns the value of the last expression evaluated.
---------------------------------------------------------------------------[ ... ]
Would it make sense to somehow combine/consolidate the above perlbug with
this threadhttp://www.nntp.perl.org/group/perl.perl5.porters/2015/05/msg227897.html
which is an ongoing debate on the state of the "do EXPR" doc in general?
I have no technical skin the game advocating any position, just trying to be
a good "thread steward", since the above thread was started by me.The RT System itself - Status changed from 'new' to 'open'
From @ikegami
On Sun, Aug 9, 2015 at 7:04 PM, Glenn Golden <gdg@zplane.com> wrote:
Would it make sense to somehow combine/consolidate the above perlbug with
this threadbulk88 is reporting a failure of do() to report an error. This is
independent of the wording of the docs.From @ap
* Eric Brine <ikegami@adaelis.com> [2015-08-10 05:50]:
bulk88 is reporting a failure of do() to report an error. This is
independent of the wording of the docs.The reason the wording of the docs is in contention is that `do` has
an error reporting interface so crappy that we cannot even agree on how
to detect errors with it. Bulk88’s issue is just another aspect of that.
Nevertheless these tickets are distinct aspects of the same thing; their
kinship is of the “we need a metaticket about how to unhorriblify `do`
in general” kind.I had a conversation about it with RJBS that I meant to summarize and
post; I’ll get to that eventually.Regards,
--
Aristotle Pagaltzis // <http://plasmasturm.org/>From @bulk88
0001-perl-125774-fix-do-dir-returns-no.patch
From bc453c910fc935db8524e9d6ea19130407c19e9f Mon Sep 17 00:00:00 2001 From: Daniel Dragan <bulk88@hotmail.com> Date: Sun, 16 Aug 2015 04:30:23 -0400 Subject: [PATCH] [perl #125774] fix do dir returns no $! do()ing a directory was returning false/empty string in $!, which isn't an error, yet retval of do, and $@ say $! should have the error code in it. Fix this by returning EISDIR for dirs, and EINVAL for block devices, since there is no ENOTFILE, but ENOENT is inappropriate, since the block device exists. Also linux read() returns EINVAL if the underlying kernel driver does not implement a read method. Here we say read() (on a high level do()) is not implemented on a directory. Also linux swapon() uses EINVAL for paths which goto something that exists, but is of wrong type. Remove "errno = 0" and comment added in b2da7ead68, since now there is no scenario where errno is uninitialized, since the dir and block device failure branches now set errno, previously they didnt. --- pod/perldelta.pod | 6 ++++++ pp_ctl.c | 25 +++++++++++++++++-------- t/op/do.t | 14 +++++++++++++- 3 files changed, 36 insertions(+), 9 deletions(-) diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 157d9d1..2ec1f08 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -356,6 +356,12 @@ Perl can again be compiled with any Unicode version. This used to C<Name_Alias> did not exist prior to Unicode 5.0. L<Unicode::UCD> incorrectly said it did. This has been fixed. +=item * + +Calling C<do $path> on a directory or block device returned no error code in +C<$!> even though the retval of C<do> and C<$@> indicated the error is in C<$!>. +[perl #125774] + =back =head1 Known Problems diff --git a/pp_ctl.c b/pp_ctl.c index 9a81583..d80ed77 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -3505,15 +3505,22 @@ S_check_type_and_open(pTHX_ SV *name) errno EACCES, so only do a stat to separate a dir from a real EACCES caused by user perms */ #ifndef WIN32 - /* we use the value of errno later to see how stat() or open() failed. - * We don't want it set if the stat succeeded but we still failed, - * such as if the name exists, but is a directory */ - errno = 0; - st_rc = PerlLIO_stat(p, &st); - if (st_rc < 0 || S_ISDIR(st.st_mode) || S_ISBLK(st.st_mode)) { + if (st_rc < 0) return NULL; + else { + int eno; + if(S_ISBLK(st.st_mode)) { + eno = EINVAL; + goto not_file; + } + else if(S_ISDIR(st.st_mode)) { + eno = EISDIR; + not_file: + errno = eno; + return NULL; + } } #endif @@ -3525,8 +3532,10 @@ S_check_type_and_open(pTHX_ SV *name) int eno; st_rc = PerlLIO_stat(p, &st); if (st_rc >= 0) { - if(S_ISDIR(st.st_mode) || S_ISBLK(st.st_mode)) - eno = 0; + if(S_ISDIR(st.st_mode)) + eno = EISDIR; + else if(S_ISBLK(st.st_mode)) + eno = EINVAL; else eno = EACCES; errno = eno; diff --git a/t/op/do.t b/t/op/do.t index 49c0de3..7eb923d 100644 --- a/t/op/do.t +++ b/t/op/do.t @@ -7,6 +7,7 @@ BEGIN { } use strict; no warnings 'void'; +use Errno qw(ENOENT EISDIR); my $called; my $result = do{ ++$called; 'value';}; @@ -247,7 +248,7 @@ SKIP: { my $saved_errno = $!; ok(!$rv, "do returns false on io errror"); ok(!$saved_error, "\$\@ not set on io error"); - ok($saved_errno, "\$! set on io error"); + ok($saved_errno == ENOENT, "\$! is ENOENT for nonexistent file"); } # do subname should not be do "subname" @@ -280,4 +281,15 @@ SKIP: { } } +# do file $!s must be correct +{ + local @INC = ('.'); #want EISDIR not ENOENT + my $rv = do 'op'; # /t/op dir + my $saved_error = $@; + my $saved_errno = $!+0; + ok(!$rv, "do dir returns false"); + ok(!$saved_error, "\$\@ is false on do dir"); + ok($saved_errno == EISDIR, "\$! is EISDIR on do dir"); +} + done_testing(); -- 1.7.9.msysgit.0
From @rjbs
On Wed Sep 09 06:50:40 2015, bulk88 wrote:
On Sun Aug 16 03:48:41 2015, bulk88 wrote:
Since there were no comments on what the error code should be, I wrote
a patch that fixes this bug. See attached.Bump.
Is there some reason not to apply this? My reading suggests it's a solution to a demonstrable problem.
--
rjbs@cpansprout - Status changed from 'open' to 'pending release'
From @khwilliamson
Thank you for filing this report. You have helped make Perl better.
With the release yesterday of Perl 5.28.0, this and 185 other issues have been
resolved.Perl 5.28.0 may be downloaded via:
https://metacpan.org/release/XSAWYERX/perl-5.28.0If you find that the problem persists, feel free to reopen this ticket.
@khwilliamson - Status changed from 'pending release' to 'resolved'
Migrated from rt.perl.org#125774 (status was 'resolved')
Searchable as RT125774$