search

Perl / perl5

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

Testing for taint and utf8 on magic values #7725

Open p5pRT opened 19 years ago

p5pRT commented 19 years ago

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

Searchable as RT33186$

p5pRT commented 19 years ago

From perl-5.8.0@ton.iguana.be

Created by perl-5.8.0@ton.iguana.be

#! /usr/bin/perl -wlT use strict; use Scalar​::Util qw(tainted);

sub TIEHASH {   return bless []; }

tie my %stuff\, "main"; print tainted($stuff{Foo}) ? 1 : 0; print utf8​::is_utf8($stuff{Foo}) ? 1 : 0;

Gives​: 0 0

But actually both tests should have errored out since there is no FETCH method in my tie\, so both were only testing the magic placeholder instead of the actual value (I found this when trying to test the properties of some values actually behind a properly provided FETCH).

Effectively they are missing get magics.

I think is_utf8 in universal.c should really be something like​:

XS(XS_utf8_is_utf8) {   SV *sv;   dXSARGS;   if (items != 1) Perl_croak(aTHX_ "Usage​: utf8​::is_utf8(sv)");   sv = ST(0);   SvGETMAGIC(sv);   if (SvUTF8(sv)) XSRETURN_YES;   XSRETURN_NO; }

(notice that a method like utf8​::valid uses SvPV\, which DOES get magic\, so not doing SvGETMAGIC for is_utf8 is inconsistent anyways)

For tainted I suppose the fix is in ext/List/Util/Util.xs\,

int tainted(sv)   SV *sv PROTOTYPE​: $ CODE​:   SvGETMAGIC(sv);   RETVAL = SvTAINTED(sv); OUTPUT​:   RETVAL

And the fallback perl version (in lib/Scalar/Util.pm) could be​:

sub tainted {   local($@​\, $SIG{__DIE__}\, $SIG{__WARN__});   local $^W = 0;   scalar $_[0]; # get magic   eval { kill 0 * $_[0] };   $@​ =~ /^Insecure/; }

(most code *untested*)

Perl Info ``` Flags: category=core severity=low This perlbug was built using Perl v5.8.6 - Fri Dec 24 19:25:13 CET 2004 It is being executed now by Perl v5.8.4 - Thu Jun 3 13:28:19 CEST 2004. Site configuration information for perl v5.8.4: Configured by ton at Thu Jun 3 13:28:19 CEST 2004. Summary of my perl5 (revision 5 version 8 subversion 4) configuration: Platform: osname=linux, osvers=2.6.5, archname=i686-linux-64int-ld uname='linux quasar 2.6.5 #8 mon apr 5 05:41:20 cest 2004 i686 gnulinux ' config_args='' hint=recommended, useposix=true, d_sigaction=define usethreads=undef use5005threads=undef useithreads=undef usemultiplicity=undef useperlio=define d_sfio=undef uselargefiles=define usesocks=undef use64bitint=define use64bitall=undef uselongdouble=define usemymalloc=y, bincompat5005=undef Compiler: cc='cc', ccflags ='-fno-strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64', optimize='-O2 -fomit-frame-pointer', cppflags='-fno-strict-aliasing -I/usr/local/include' ccversion='', gccversion='3.4.0 20031231 (experimental)', 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='long double', nvsize=12, Off_t='off_t', lseeksize=8 alignbytes=4, prototype=define Linker and Libraries: ld='cc', ldflags =' -L/usr/local/lib' libpth=/usr/local/lib /lib /usr/lib libs=-lnsl -ldb -ldl -lm -lcrypt -lutil -lc perllibs=-lnsl -ldl -lm -lcrypt -lutil -lc libc=/lib/libc-2.3.2.so, so=so, useshrplib=false, libperl=libperl.a gnulibc_version='2.3.2' Dynamic Linking: dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E' cccdlflags='-fpic', lddlflags='-shared -L/usr/local/lib' Locally applied patches: @INC for perl v5.8.4: /usr/lib/perl5/5.8.4/i686-linux-64int-ld /usr/lib/perl5/5.8.4 /usr/lib/perl5/site_perl/5.8.4/i686-linux-64int-ld /usr/lib/perl5/site_perl/5.8.4 /usr/lib/perl5/site_perl . Environment for perl v5.8.4: HOME=/home/ton LANG (unset) LANGUAGE (unset) LD_LIBRARY_PATH (unset) LOGDIR (unset) PATH=/home/ton/bin.Linux:/home/ton/bin:/home/ton/bin.SampleSetup:/opt/schily/bin:/usr/local/bin:/usr/local/sbin:/home/oracle/product/9.0.1/bin:/usr/local/ar/bin:/usr/games/bin:/usr/X11R6/bin:/usr/share/bin:/usr/bin:/usr/sbin:/bin:/sbin:. PERL_BADLANG (unset) SHELL=/bin/bash ```
p5pRT commented 19 years ago

From @ysth

On Sat\, Dec 25\, 2004 at 11​:52​:21PM -0000\, "perl-5. 8. 0 @​ ton. iguana. be" wrote​:

Effectively they are missing get magics.

I think is_utf8 in universal.c should really be something like​:

XS(XS_utf8_is_utf8) { SV *sv; dXSARGS; if (items != 1) Perl_croak(aTHX_ "Usage​: utf8​::is_utf8(sv)"); sv = ST(0); SvGETMAGIC(sv); if (SvUTF8(sv)) XSRETURN_YES; XSRETURN_NO; }

(notice that a method like utf8​::valid uses SvPV\, which DOES get magic\, so not doing SvGETMAGIC for is_utf8 is inconsistent anyways)

That's insufficient for overloading (which isn't handled like regular magic). I'd suggest just going ahead and doing an SvPV.

For tainted I suppose the fix is in ext/List/Util/Util.xs\,

int tainted(sv) SV *sv PROTOTYPE​: $ CODE​: SvGETMAGIC(sv); RETVAL = SvTAINTED(sv); OUTPUT​: RETVAL

And the fallback perl version (in lib/Scalar/Util.pm) could be​:

sub tainted { local($@​\, $SIG{__DIE__}\, $SIG{__WARN__}); local $^W = 0; scalar $_[0]; # get magic eval { kill 0 * $_[0] };

* should also result in a mg_get...does it not?

$@​ =~ /^Insecure/; }

p5pRT commented 19 years ago

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

p5pRT commented 19 years ago

From perl5-porters@ton.iguana.be

In article \20041226230112\.GA3552@​e\_n\.org\,   Yitzchak Scott-Thoennes \sthoenna@​efn\.org writes​:

That's insufficient for overloading (which isn't handled like regular magic). I'd suggest just going ahead and doing an SvPV.

mm\, didn't know that\, that makes some of my XS code incomplete then. But SvPV seems apporpiate enough here.

For tainted I suppose the fix is in ext/List/Util/Util.xs\,

int tainted(sv) SV *sv PROTOTYPE​: $ CODE​: SvGETMAGIC(sv); RETVAL = SvTAINTED(sv); OUTPUT​: RETVAL

Mm\, here you probably don't want to trigger "" overload\, so SvGETMAGIC is good enough here I suppose

And the fallback perl version (in lib/Scalar/Util.pm) could be​:

sub tainted { local($@​\, $SIG{__DIE__}\, $SIG{__WARN__}); local $^W = 0; scalar $_[0]; # get magic eval { kill 0 * $_[0] };

* should also result in a mg_get...does it not?

Ah right\, it does. I had actually tested it\, but missed the fact that now it's the missing FETCH that triggers the eval with a message that doesn't match /^Secure/\, and so returns false. But normally you'd WANT to see errors that are not the Insecure one\, so this seems a bug.

So how about​:

sub tainted {   local($@​\, $SIG{__DIE__}\, $SIG{__WARN__});   local $^W = 0;   eval { kill 0 * $_[0]};   $@​ ? $@​ =~ /^Insecure/ || die $@​ : !1; }

mm\, the NaN-discussion makes me realize that not everything times 0 is 0\, so now it fails for Inf and NaN because they try to kill nan.

This seems to work for all cases I can think of​:

sub tainted {   local($@​\, $SIG{__DIE__}\, $SIG{__WARN__});   local $^W = 0;   eval { kill $_[0] && 0};   $@​ ? $@​ =~ /^Insecure/ || die $@​ : !1; }

p5pRT commented 19 years ago

From @ysth

On Mon\, Dec 27\, 2004 at 01​:27​:27AM +0000\, Ton Hospel \perl5\-porters@​ton\.iguana\.be wrote​:

In article \20041226230112\.GA3552@​e\_n\.org\, Yitzchak Scott-Thoennes \sthoenna@​efn\.org writes​:

That's insufficient for overloading (which isn't handled like regular magic). I'd suggest just going ahead and doing an SvPV.

mm\, didn't know that\, that makes some of my XS code incomplete then. But SvPV seems apporpiate enough here.

The rule is\, you can only check the UTF8 flag *after* calling SvPV (at least for 5.8.1 and later - before that only a direct stringify like "$x" would preserve the UTF8 flag). Same thing with stringified Regexp's that contain utf8 literals.

p5pRT commented 12 years ago

From @Hugmeir

On Sun Dec 26 17​:35​:35 2004\, ysth wrote​:

On Mon\, Dec 27\, 2004 at 01​:27​:27AM +0000\, Ton Hospel \<perl5- porters@​ton.iguana.be> wrote​:

In article \20041226230112\.GA3552@&#8203;e\_n\.org\, Yitzchak Scott-Thoennes \sthoenna@&#8203;efn\.org writes​:

That's insufficient for overloading (which isn't handled like regular magic). I'd suggest just going ahead and doing an SvPV.

mm\, didn't know that\, that makes some of my XS code incomplete then. But SvPV seems apporpiate enough here.

The rule is\, you can only check the UTF8 flag *after* calling SvPV (at least for 5.8.1 and later - before that only a direct stringify like "$x" would preserve the UTF8 flag). Same thing with stringified Regexp's that contain utf8 literals.

Running this on 5.14.2 and blead\, I get​: $ perl -wlT 33186.pl 0 Can't locate object method "FETCH" via package "main" at 33186.pl line 10.

So utf8​::is_utf8() was fixed\, but tainted() was not. I tried with both the XS and PP versions and got the same result. For the XS version\, the issue is in the core itself\, since sv_tainted() isn't calling get magic before checking for taintedness. So I just went and added a SvGETMAGIC(sv); to sv_taint(). That solves this ticket (and one TODO) but breaks one test in t/op/taint.t​:

{   # Bug ID 20010730.010

  my $i = 0;

  sub Tie​::TIESCALAR {   my $class = shift;   my $arg = shift;

  bless \$arg => $class;   }

  sub Tie​::FETCH {   $i ++;   ${$_ [0]}   }

  package main;

  my $bar = "The Big Bright Green Pleasure Machine";   taint_these $bar;   tie my ($foo)\, Tie => $bar;

  my $baz = $foo;

  ok $i == 1; }

Because now FETCH gets called twice\, so $i ends up as 2. Unfortunately I can't find the bug report that the test references\, and I'm already way out of my depth here\, so this is as far as I can go -- Could someone else take a look?