perl5
perl5 copied to clipboard
Perl
Testing for taint and utf8 on magic values
From [email protected]
Created by [email protected]
#! /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
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/; }
From [email protected]
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; }
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.
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@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.
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?