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*)

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/;
}

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

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;
}

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?