require stringifies code references in tied @INC #8710

p5pRT · 2006-12-11T15:17:24Z

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

Searchable as RT41071$

p5pRT · 2006-12-11T15:17:25Z

From haj@oook.m.uunet.de

This is a bug report for perl from haj@oook.m.uunet.de,
generated with the help of perlbug 1.35 running under perl v5.8.7.

require stringifies code references in @INC iff @INC is tied

Summary: I can add a code reference to @INC, and I can tie @INC to a
class. But as soon as @INC is tied, the code reference is no longer
executed. It is interpreted as a path name instead, as if
"stringified". All four demos should behave like Demo 1, but they
don't. Demo 2 is what fails, Demo 3 and Demo 4 should narrow down
the origin of the bug.

Demo 1 shows the simple use of a code reference in @INC, which works.
Demo 2 shows the same with a tied @INC, which fails.
Demo 3 proves that the code reference is interpreted as a string.
Demo 4 shows that code references in tied @INC work, outside require.

use has the same problem but makes the demo unwieldier because I'd
need BEGIN blocks around @INC manipulations. The behaviour occurs on
Linux and Windows as well as cygwin perl.

Demo 1: I am monitoring 'use' and 'require' usage by prepending a
code reference to @INC. For brevity, in the demo this just dies:
===========================================================================
#!perl -w

sub stop_here { die "Stopped before using '$_[1]'!\n"; }
unshift @INC,(\&stop_here);
require garble;
===========================================================================
$ perl t_tie1.pl
Stopped before using 'garble.pm'!
===========================================================================

Demo 2: As above, but @INC is being tied. This should behave like
Demo 1, but instead of dying it rushes through all of @INC. For
brevity I've tied to Tie::Watch here, tying to a handmade class makes
no difference.
===========================================================================
#!perl -w
watch_it();

sub stop_here { die "Stopped before using '$_[1]'!\n"; }
unshift @INC,(\&stop_here);
require garble;

sub watch_it { ### tie @INC
use Tie::Watch;
Tie::Watch->new(-variable => \@INC, -fetch => \&verbose_fetch);
}
sub verbose_fetch { ### FETCH callback for tie
my $el = $_[0]->{-ptr}->[$_[1]];
ref $el eq 'CODE' and print STDERR "\$INC[$_[1]] is a code reference!\n";
$el;
}
===========================================================================
$ perl t_tie2.pl
$INC[0] is a code reference!
$INC[0] is a code reference!
Can't locate garble.pm in @INC (@INC contains: CODE(0x67f2f8)
/usr/lib/perl5/5.8/cygwin /usr/lib/perl5/5.8 ... at t_tie2.pl line 6.
===========================================================================

Demo 3: To prove that the code reference is interpreted as a string, I
create a directory, named like the stringified code reference, and put
a fake module into that directory. The fake module gets compiled.
===========================================================================
#!perl -w
watch_it();
create_garble();

sub stop_here { die "Stopped before using '$_[1]'!\n"; }
unshift @INC,(\&stop_here);
require garble;

sub watch_it { ### tie @INC
use Tie::Watch;
Tie::Watch->new(-variable => \@INC, -fetch => \&verbose_fetch);
}
sub verbose_fetch { ### FETCH callback for tie
my $el = $_[0]->{-ptr}->[$_[1]];
ref $el eq 'CODE' and print STDERR "\$INC[$_[1]] is a code reference!\n";
$el;
}
sub create_garble { ### create 'CODE(0x846aa4)/garble.pm'
my $coderef = \&stop_here;
mkdir "$coderef";
open GARBLE, ">", "$coderef/garble.pm"
or die "Could not open dummy module '$coderef/garble.pm': '$!'";
print GARBLE "0;\n";
close GARBLE;
}
===========================================================================
$ perl t_tie3.pl
$INC[0] is a code reference!
garble.pm did not return a true value at t_tie3.pl line 7.
===========================================================================

Demo 4: Instead of using require, I am iterating through @INC by
hand. This proves that code references in @INC are working fine.
===========================================================================
#!perl -w
watch_it();
create_garble();

sub stop_here { die "Stopped before using '$_[1]'!\n"; }
unshift @INC,(\&stop_here);
my_require('a tied array element');

sub watch_it { ### tie @INC
use Tie::Watch;
Tie::Watch->new(-variable => \@INC, -fetch => \&verbose_fetch);
}
sub verbose_fetch { ### FETCH callback for tie
my $el = $_[0]->{-ptr}->[$_[1]];
ref $el eq 'CODE' and print STDERR "\$INC[$_[1]] is a code reference!\n";
$el;
}
sub create_garble { ### create 'CODE(0x846aa4)/garble.pm'
my $coderef = \&stop_here;
mkdir "$coderef";
open GARBLE, ">", "$coderef/garble.pm"
or die "Could not open dummy module '$coderef/garble.pm': '$!'";
print GARBLE "0;\n";
close GARBLE;
}
sub my_require { ### handmade require loop thru @INC
for my $source (@INC) {
if (ref $source eq 'CODE') {
&$source($source,'a tied array element');
}
}
}
===========================================================================
$ perl t_tie4.pl
$INC[0] is a code reference!
Stopped before using 'a tied array element'!
===========================================================================

Flags:
category=core
severity=medium

Site configuration information for perl v5.8.7:

Configured by gerrit at Fri Dec 30 02:40:15 2005.

Summary of my perl5 (revision 5 version 8 subversion 7) configuration:
Platform:
osname=cygwin, osvers=1.5.18(0.13242), archname=cygwin-thread-multi-64int
uname='cygwin_nt-5.1 inspiron 1.5.18(0.13242) 2005-07-02 20:30 i686 unknown unknown cygwin '
config_args='-de -Dmksymlinks -Duse64bitint -Dusethreads -Uusemymalloc -Doptimize=-O3 -Dman3ext=3pm -Dusesitecustomize'
hint=recommended, useposix=true, d_sigaction=define
usethreads=define use5005threads=undef useithreads=define usemultiplicity=define
useperlio=define d_sfio=undef uselargefiles=define usesocks=undef
use64bitint=define use64bitall=undef uselongdouble=undef
usemymalloc=n, bincompat5005=undef
Compiler:
cc='gcc', ccflags ='-DPERL_USE_SAFE_PUTENV -fno-strict-aliasing -pipe -I/usr/local/include',
optimize='-O3',
cppflags='-DPERL_USE_SAFE_PUTENV -fno-strict-aliasing -pipe -I/usr/local/include'
ccversion='', gccversion='3.4.4 (cygming special) (gdc 0.12, using dmd 0.125)', gccosandvers=''
intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=12345678
d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
ivtype='long long', ivsize=8, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
alignbytes=8, prototype=define
Linker and Libraries:
ld='ld2', ldflags =' -s -L/usr/local/lib'
libpth=/usr/local/lib /lib /usr/lib
libs=-lgdbm -ldb -lcrypt -lgdbm_compat
perllibs=-lcrypt -lgdbm_compat
libc=/usr/lib/libc.a, so=dll, useshrplib=true, libperl=libperl.a
gnulibc_version=''
Dynamic Linking:
dlsrc=dl_dlopen.xs, dlext=dll, d_dlsymun=undef, ccdlflags=' -s'
cccdlflags=' ', lddlflags=' -s -L/usr/local/lib'

Locally applied patches:
SPRINTF0 - fixes for sprintf formatting issues - CVE-2005-3962

@INC for perl v5.8.7:
/usr/lib/perl5/5.8/cygwin
/usr/lib/perl5/5.8
/usr/lib/perl5/site_perl/5.8/cygwin
/usr/lib/perl5/site_perl/5.8
/usr/lib/perl5/site_perl/5.8/cygwin
/usr/lib/perl5/site_perl/5.8
/usr/lib/perl5/vendor_perl/5.8/cygwin
/usr/lib/perl5/vendor_perl/5.8
/usr/lib/perl5/vendor_perl/5.8/cygwin
/usr/lib/perl5/vendor_perl/5.8
.

Environment for perl v5.8.7:
CYGWIN=ntsec tty title
CYGWIN_ROOT=d:\programme\cygwin
HOME=/usr/haj
LANG (unset)
LANGUAGE (unset)
LD_LIBRARY_PATH (unset)
LOGDIR (unset)
PATH=.:/usr/haj/bin:/usr/heimdal/bin:/usr/local/bin:/usr/bin:/bin:.:/usr/bin:/usr/X11R6/bin:/cygdrive/c/WIN/system32:/cygdrive/c/WIN:/cygdrive/c/WIN/system32/WBEM:/d/programme/texmf/miktex/bin:/d/Perl/bin/:/cygdrive/c/WIN/system32:/cygdrive/c/WIN:/cygdrive/c/WIN/System32/Wbem:/cygdrive/c/PROGRA~~1/COMMON~~1/System:/cygdrive/c/PROGRA~~1/openFT/BIN:/cygdrive/c/PROGRA~~1/DeskView/system:/usr/haj/winbin:/usr/bin:/cygdrive/c/WIN/Wrapper:/cygdrive/c/Program Files/MIT/Kerberos/bin:/d/programme/Nmap
PERL5_CPANPLUS_CONFIG=/usr/local/lib/CPANPLUS/config
PERL_BADLANG (unset)
SHELL (unset)

p5pRT · 2006-12-16T04:29:00Z

From rick@bort.ca

On Dec 11 2006, haj@oook.m.uunet.de wrote:

require stringifies code references in @INC iff @INC is tied

The following patch fixes this.

--
Rick Delaney
rick@bort.ca

Inline Patch

diff -pruN perl-current/pp_ctl.c perl-current-dev/pp_ctl.c
--- perl-current/pp_ctl.c	2006-12-01 17:54:37.000000000 -0500
+++ perl-current-dev/pp_ctl.c	2006-12-15 14:51:30.000000000 -0500
@@ -3150,6 +3150,8 @@ PP(pp_require)
 	    for (i = 0; i <= AvFILL(ar); i++) {
 		SV * const dirsv = *av_fetch(ar, i, TRUE);
 
+		if (SvTIED_mg((SV*)ar, PERL_MAGIC_tied))
+		    mg_get(dirsv);
 		if (SvROK(dirsv)) {
 		    int count;
 		    SV **svp;
diff -pruN perl-current/t/op/inccode-tie.t perl-current-dev/t/op/inccode-tie.t
--- perl-current/t/op/inccode-tie.t	1969-12-31 19:00:00.000000000 -0500
+++ perl-current-dev/t/op/inccode-tie.t	2006-12-15 14:48:53.000000000 -0500
@@ -0,0 +1,15 @@
+#!./perl
+
+# Calls all tests in op/inccode.t after tying @INC first.
+
+use Tie::Array;
+my @orig_INC = @INC;
+tie @INC, 'Tie::StdArray';
+@INC = @orig_INC;
+for my $file ('./op/inccode.t', './t/op/inccode.t', ':op:inccode.t') {
+    if (-r $file) {
+	do $file;
+	exit;
+    }
+}
+die "Cannot find ./op/inccode.t or ./t/op/inccode.t\n";
diff -pruN perl-current/t/op/inccode.t perl-current-dev/t/op/inccode.t
--- perl-current/t/op/inccode.t	2006-11-08 10:35:31.000000000 -0500
+++ perl-current-dev/t/op/inccode.t	2006-12-15 14:53:06.000000000 -0500
@@ -202,10 +202,12 @@ is( $ret, 'abc', 'do "abc.pl" sees retur
 
 {
     my $filename = $^O eq 'MacOS' ? ':Foo:Foo.pm' : './Foo.pm';
-    local @INC;
+    #local @INC; # local fails on tied @INC
+    my @old_INC = @INC; # because local doesn't work on tied arrays
     @INC = sub { $filename = 'seen'; return undef; };
     eval { require $filename; };
     is( $filename, 'seen', 'the coderef sees fully-qualified pathnames' );
+    @INC = @old_INC;
 }
 
 exit if $minitest;

p5pRT · 2006-12-16T04:29:00Z

From rick@bort.ca

41071.patch

diff -pruN perl-current/pp_ctl.c perl-current-dev/pp_ctl.c
--- perl-current/pp_ctl.c	2006-12-01 17:54:37.000000000 -0500
+++ perl-current-dev/pp_ctl.c	2006-12-15 14:51:30.000000000 -0500
@@ -3150,6 +3150,8 @@ PP(pp_require)
 	    for (i = 0; i <= AvFILL(ar); i++) {
 		SV * const dirsv = *av_fetch(ar, i, TRUE);
 
+		if (SvTIED_mg((SV*)ar, PERL_MAGIC_tied))
+		    mg_get(dirsv);
 		if (SvROK(dirsv)) {
 		    int count;
 		    SV **svp;
diff -pruN perl-current/t/op/inccode-tie.t perl-current-dev/t/op/inccode-tie.t
--- perl-current/t/op/inccode-tie.t	1969-12-31 19:00:00.000000000 -0500
+++ perl-current-dev/t/op/inccode-tie.t	2006-12-15 14:48:53.000000000 -0500
@@ -0,0 +1,15 @@
+#!./perl
+
+# Calls all tests in op/inccode.t after tying @INC first.
+
+use Tie::Array;
+my @orig_INC = @INC;
+tie @INC, 'Tie::StdArray';
+@INC = @orig_INC;
+for my $file ('./op/inccode.t', './t/op/inccode.t', ':op:inccode.t') {
+    if (-r $file) {
+	do $file;
+	exit;
+    }
+}
+die "Cannot find ./op/inccode.t or ./t/op/inccode.t\n";
diff -pruN perl-current/t/op/inccode.t perl-current-dev/t/op/inccode.t
--- perl-current/t/op/inccode.t	2006-11-08 10:35:31.000000000 -0500
+++ perl-current-dev/t/op/inccode.t	2006-12-15 14:53:06.000000000 -0500
@@ -202,10 +202,12 @@ is( $ret, 'abc', 'do "abc.pl" sees retur
 
 {
     my $filename = $^O eq 'MacOS' ? ':Foo:Foo.pm' : './Foo.pm';
-    local @INC;
+    #local @INC; # local fails on tied @INC
+    my @old_INC = @INC; # because local doesn't work on tied arrays
     @INC = sub { $filename = 'seen'; return undef; };
     eval { require $filename; };
     is( $filename, 'seen', 'the coderef sees fully-qualified pathnames' );
+    @INC = @old_INC;
 }
 
 exit if $minitest;

p5pRT · 2006-12-16T04:29:01Z

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

p5pRT · 2006-12-18T15:37:53Z

From @smpeters

On Fri Dec 15 20:29:00 2006, rickdelaney wrote:

On Dec 11 2006, haj@oook.m.uunet.de wrote:

require stringifies code references in @INC iff @INC is tied

The following patch fixes this.

Thanks! I applied this patch as change #29584.

p5pRT · 2006-12-18T15:37:54Z

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

p5pRT closed this as completed Dec 18, 2006

p5pRT added Severity Medium distro-cygwin type-core labels Oct 18, 2019

Provide feedback

Saved searches

Use saved searches to filter your results more quickly

require stringifies code references in tied @INC #8710

require stringifies code references in tied @INC #8710

p5pRT commented Dec 11, 2006

p5pRT commented Dec 11, 2006

p5pRT commented Dec 16, 2006

p5pRT commented Dec 16, 2006

p5pRT commented Dec 16, 2006

p5pRT commented Dec 18, 2006

p5pRT commented Dec 18, 2006

require stringifies code references in tied @INC #8710

require stringifies code references in tied @INC #8710

Comments

p5pRT commented Dec 11, 2006

p5pRT commented Dec 11, 2006

From haj@oook.m.uunet.de

p5pRT commented Dec 16, 2006

From rick@bort.ca

p5pRT commented Dec 16, 2006

From rick@bort.ca

p5pRT commented Dec 16, 2006

p5pRT commented Dec 18, 2006

From @smpeters

p5pRT commented Dec 18, 2006