develooper Front page | perl.perl5.porters | Postings from December 2004

[perl #33186] Testing for taint and utf8 on magic values

Thread Next
From:
perl-5 . 8 . 0 @ ton . iguana . be
Date:
December 26, 2004 02:11
Subject:
[perl #33186] Testing for taint and utf8 on magic values
Message ID:
rt-3.0.11-33186-103537.2.31117908074523@perl.org
# New Ticket Created by  perl-5.8.0@ton.iguana.be 
# Please include the string:  [perl #33186]
# in the subject line of all future correspondence about this issue. 
# <URL: http://rt.perl.org:80/rt3/Ticket/Display.html?id=33186 >



This is a bug report for perl from perl-5.8.0@ton.iguana.be,
generated with the help of perlbug 1.35 running under perl v5.8.4.


-----------------------------------------------------------------
[Please enter your report here]

#! /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*)

[Please do not change anything below this line]
-----------------------------------------------------------------
---
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


Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About