On Wed, Aug 21, 2002 at 11:26:17AM +1000, Bradley Baetz wrote:
> On Tue, 20 Aug 2002, Tim Bunce wrote:
>
> > On Tue, Aug 20, 2002 at 07:18:23PM +1000, Bradley Baetz wrote:
>
> > Ah. I think ExampleP predates _get_fbav. I'll mandate that all
> > drivers must use _get_fbav (either in C or perl) to get the row
> > buffer. So the right approach here is to use $sth->_get_fbav()
> > and then deal with whatever knock-on effects appear.
>
> I can't work out how to use this from the perl code to get the correct
> results. Whatever I try, I can't seem to either get the tatint tests to
> pass, or not regress other tests I'm sure I'm missing something obvious...
>
> However, _get_fbav has the comment that the TAINT; "affects sv_setsv()'s
> called within same perl statement".
>
> In the perl code, I'm not in the same statement, and there aren't any
> sv_setsv's (since the entire hash isn't tainted, only (possibly) values
> within it) - is that the problem?
Probably (well spotted). There's a $sth->_set_fbav( \@fieldvalues) method
you could try that copies the supplied values into the row array.
> I can't find docs on most of the XS taint stuff you do, so I'm not sure if
> I'm reading this correctly.
Yeah, taint internals aren't well documented. I had to work it out
from the perl source code.
> > > If I reenable that part of the code, then the taint tests pass, but
> > > selectall_hashref fails at the ->bind_col in DBI.pm because $index is
> > > tainted; this is presumably why that was disabled.
> >
> > Um, not sure what that's about off-hand. Can you repost once you've
> > switched ExampleP over to using $sth->_get_fbav()?
>
> If I could do that, then I can leave that code disabled, so its OK.
>
> Anyway, I've attached a patch (w/o docs, for the moment) which fails the
> tests for when the output stuff is meant to be tainted. I also decided to
> name the attributes TaintIn and TaintOut rather than TaintInput and
> TaintOutput, for no real reason except personal preference.
Okay.
> Let me know what you think.
Great work so far, thanks.
Try using _set_fbav(). If that doesn't work then try reenabling the TaintOut
logic in the dispatch code, but only if the methodname starts with 'fetch'.
Tim.
> Bradley
Content-Description: patch
> diff -ur DBI-1.30/DBI.xs DBI/DBI.xs
> --- DBI-1.30/DBI.xs Fri Jul 19 00:23:51 2002
> +++ DBI/DBI.xs Tue Aug 20 16:20:05 2002
> @@ -932,8 +932,9 @@
> if (DBIc_is(imp_xxh, DBIcf_BegunWork)) sv_catpv(flags,"BegunWork ");
> if (DBIc_is(imp_xxh, DBIcf_LongTruncOk)) sv_catpv(flags,"LongTruncOk ");
> if (DBIc_is(imp_xxh, DBIcf_MultiThread)) sv_catpv(flags,"MultiThread ");
> - if (DBIc_is(imp_xxh, DBIcf_Taint)) sv_catpv(flags,"Taint ");
> + if (DBIc_is(imp_xxh, DBIcf_TaintOut)) sv_catpv(flags,"TaintOut ");
> if (DBIc_is(imp_xxh, DBIcf_Profile)) sv_catpv(flags,"Profile ");
> + if (DBIc_is(imp_xxh, DBIcf_TaintIn)) sv_catpv(flags,"TaintIn ");
> PerlIO_printf(DBILOGFP,"%s FLAGS 0x%lx: %s\n", pad, (long)DBIc_FLAGS(imp_xxh),
>SvPV(flags,lna));
> PerlIO_printf(DBILOGFP,"%s PARENT %s\n", pad,
>neatsvpv((SV*)DBIc_PARENT_H(imp_xxh),0));
> PerlIO_printf(DBILOGFP,"%s KIDS %ld (%ld Active)\n", pad,
> @@ -1109,7 +1110,7 @@
> if ( (av = DBIc_FIELDS_AV(imp_sth)) == Nullav)
> av = dbih_setup_fbav(imp_sth);
>
> - if (DBIc_is(imp_sth, DBIcf_Taint)) {
> + if (DBIc_is(imp_sth, DBIcf_TaintOut)) {
> dTHR;
> TAINT; /* affects sv_setsv()'s called within same perl statement */
> }
> @@ -1321,7 +1322,14 @@
> }
> }
> else if (strEQ(key, "Taint")) {
> - DBIc_set(imp_xxh,DBIcf_Taint, on);
> + /* 'Taint' is a shortcut for both in and out mode */
> + DBIc_set(imp_xxh,DBIcf_TaintIn|DBIcf_TaintOut, on);
> + }
> + else if (strEQ(key, "TaintIn")) {
> + DBIc_set(imp_xxh,DBIcf_TaintIn, on);
> + }
> + else if (strEQ(key, "TaintOut")) {
> + DBIc_set(imp_xxh,DBIcf_TaintOut, on);
> }
> else if (htype<=DBIt_DB && keylen==10 && strEQ(key, "CachedKids")) {
> D_imp_dbh(h); /* XXX also for drh */
> @@ -1536,7 +1544,14 @@
> valuesv = boolSV(DBIc_has(imp_xxh,DBIcf_MultiThread));
> }
> else if (keylen==5 && strEQ(key, "Taint")) {
> - valuesv = boolSV(DBIc_has(imp_xxh,DBIcf_Taint));
> + valuesv = boolSV(DBIc_has(imp_xxh,DBIcf_TaintIn) &&
> + DBIc_has(imp_xxh,DBIcf_TaintOut));
> + }
> + else if (keylen==7 && strEQ(key, "TaintIn")) {
> + valuesv = boolSV(DBIc_has(imp_xxh,DBIcf_TaintIn));
> + }
> + else if (keylen==8 && strEQ(key, "TaintOut")) {
> + valuesv = boolSV(DBIc_has(imp_xxh,DBIcf_TaintOut));
> }
> else if (htype<=DBIt_DB && keylen==10 && strEQ(key, "AutoCommit")) {
> valuesv = boolSV(DBIc_has(imp_xxh,DBIcf_AutoCommit));
> @@ -2144,7 +2159,7 @@
> }
>
> if (tainting && items > 1 /* method call has args */
> - && DBIc_is(imp_xxh, DBIcf_Taint) /* taint checks requested */
> + && DBIc_is(imp_xxh, DBIcf_TaintIn) /* taint checks requested */
> && !(ima && ima->flags & IMA_NO_TAINT_IN)
> ) {
> for(i=1; i < items; ++i) {
> @@ -2337,7 +2352,7 @@
> }
> PerlIO_printf(logfp,"%c%c <- %s",
> (call_depth > 1) ? '0'+call_depth-1 : ' ',
> - (DBIc_is(imp_xxh, DBIcf_Taint)) ? 'T' : ' ',
> + (DBIc_is(imp_xxh, DBIcf_TaintIn|DBIcf_TaintOut)) ? 'T' : ' ',
> meth_name);
> if (debug==1 && items>=2) { /* make level 1 more useful */
> /* we only have the first two parameters available here */
> @@ -2401,7 +2416,7 @@
> }
>
> if (tainting
> - && DBIc_is(imp_xxh, DBIcf_Taint) /* taint checks requested */
> + && DBIc_is(imp_xxh, DBIcf_TaintOut) /* taint checks requested */
> /* XXX this would taint *everything* being returned from *any* */
> /* method that doesn't have IMA_NO_TAINT_OUT set. */
> /* DISABLED: just tainting fetched data in get_fbav seems ok */
> Only in DBI: DBI.xs~
> diff -ur DBI-1.30/DBIXS.h DBI/DBIXS.h
> --- DBI-1.30/DBIXS.h Mon Jul 15 21:19:04 2002
> +++ DBI/DBIXS.h Tue Aug 20 18:52:14 2002
> @@ -227,11 +227,12 @@
> #define DBIcf_AutoCommit 0x000200 /* dbh only. used by drivers */
> #define DBIcf_LongTruncOk 0x000400 /* truncation to LongReadLen is okay */
> #define DBIcf_MultiThread 0x000800 /* allow multiple threads to enter */
> -#define DBIcf_Taint 0x001000 /* taint fetched data */
> +#define DBIcf_TaintIn 0x001000 /* taint fetched data */
> #define DBIcf_ShowErrorStatement 0x002000 /* include Statement in error */
> #define DBIcf_BegunWork 0x004000 /* between begin_work & commit/rollback */
> #define DBIcf_HandleError 0x008000 /* has coderef in HandleError attribute */
> #define DBIcf_Profile 0x010000 /* profile activity on this handle */
> +#define DBIcf_TaintOut 0x020000 /* Check inputs for taintedness */
>
> #define DBIcf_INHERITMASK /* what NOT to pass on to children */ \
> (U32)( DBIcf_COMSET | DBIcf_IMPSET | DBIcf_ACTIVE | DBIcf_IADESTROY
> \
> Only in DBI: DBIXS.h~
> Only in DBI: Makefile.old
> diff -ur DBI-1.30/lib/DBD/ExampleP.pm DBI/lib/DBD/ExampleP.pm
> --- DBI-1.30/lib/DBD/ExampleP.pm Mon Jul 15 21:19:20 2002
> +++ DBI/lib/DBD/ExampleP.pm Wed Aug 21 11:09:14 2002
> @@ -326,6 +326,8 @@
> $sth->finish;
> return;
> }
> + # untaint $f so that we can use this for DBI taint tests
> + ($f) = ($f =~ m/^(.*)$/);
> my $file = $haveFileSpec
> ? File::Spec->catfile($dir, $f) : "$dir/$f";
> # put in all the data fields
> @@ -334,7 +336,7 @@
>
> # return just what fields the query asks for
> my @new = @s{ @{$sth->{NAME}} };
> -
> +
> return $sth->_set_fbav(\@new);
> }
> *fetchrow_arrayref = \&fetch;
> Only in DBI/lib/DBD: ExampleP.pm~
> diff -ur DBI-1.30/lib/DBI/PurePerl.pm DBI/lib/DBI/PurePerl.pm
> --- DBI-1.30/lib/DBI/PurePerl.pm Mon Jul 15 21:19:22 2002
> +++ DBI/lib/DBI/PurePerl.pm Wed Aug 21 11:04:18 2002
> @@ -134,6 +134,8 @@
> ShowErrorStatement
> Statement
> Taint
> + TaintIn
> + TaintOut
> TraceLevel
> Version
> Warn
> @@ -492,6 +494,9 @@
> $i++;
> }
> }
> + if ($key eq "Taint") {
> + return ($h->{'TaintIn'} && $h->{'TaintOut'});
> + }
> my $v = $h->{$key};
> if (!defined $v && !exists $h->{$key}) {
> local $^W; # hide undef warnings
> @@ -507,6 +512,13 @@
> unless $value == -900 || $value == -901;
> $value = ($value == -901);
> }
> + elsif (($key eq 'Taint' || $key eq 'TaintIn' || $key eq 'TaintOut')) {
> + Carp::croak(sprintf "Can't set %s->{%s}: Taint mode not supported by
>DBI::PurePerl",$h,$key);
> + }
> + elsif ($key eq 'Taint') {
> + $h->{'TaintIn'} = $h->{'TaintOut'} = $value;
> + return 1;
> + }
> elsif (!$is_valid_attribute{$key} && $key =~ /^[A-Z]/ && !exists $h->{$key}) {
> Carp::croak(sprintf "Can't set %s->{%s}: unrecognised attribute or invalid
>value %s",
> $h,$key,$value);
> @@ -752,6 +764,8 @@
> InactiveDestroy
> Kids
> Taint
> + TaintIn
> + TaintOut
> TraceLevel
>
> (and probably others)
> Only in DBI/lib/DBI: PurePerl.pm~
> diff -ur DBI-1.30/t/10examp.t DBI/t/10examp.t
> --- DBI-1.30/t/10examp.t Mon Jul 15 21:19:08 2002
> +++ DBI/t/10examp.t Wed Aug 21 11:18:27 2002
> @@ -35,11 +35,13 @@
> DBI->trace(3,$trace_file); # enable trace before first driver load
>
> my $r;
> -my $dbh = DBI->connect('dbi:ExampleP(AutoCommit=>1 ,Taint = 1):', undef, undef);
> +my $dbh = DBI->connect('dbi:ExampleP(AutoCommit=>1):', undef, undef);
> die "Unable to connect to ExampleP driver: $DBI::errstr" unless $dbh;
> ok(0, $dbh);
> ok(0, ref $dbh);
>
> +$dbh->{Taint} = 1 unless $DBI::PurePerl;
> +
> if (0) {
> DBI->trace(9,undef);
> warn DBI::dump_handle($dbh,"dump_handle",1);
> @@ -67,7 +69,7 @@
> #$dbh->trace(2);
> $dbh->{AutoCommit} = 1;
> $dbh->{PrintError} = 0;
> -ok(0, $dbh->{Taint} == 1);
> +ok(0, $dbh->{Taint} == 1) unless $DBI::PurePerl && ok(0,1);
> ok(0, $dbh->{AutoCommit} == 1);
> ok(0, $dbh->{PrintError} == 0);
> #$dbh->trace(0); die;
> @@ -158,6 +160,38 @@
> ok(0, "@{[sort keys %{$csr_b->{NAME_uc_hash}}]}" eq "MODE NAME SIZE");
> ok(0, "@{[sort values %{$csr_b->{NAME_uc_hash}}]}" eq "0 1 2");
>
> +if ($DBI::PurePerl) {
> + warn " Taint mode switching tests skipped\n";
> + ok(0,1) foreach (1..15);
> +} else {
> + # Check Taint* attribute switching
> +
> + #$dbh->{'Taint'} = 1; # set in connect
> + ok(0, $dbh->{'Taint'});
> + ok(0, $dbh->{'TaintIn'} == 1);
> + ok(0, $dbh->{'TaintOut'} == 1);
> +
> + $dbh->{'TaintOut'} = 0;
> + ok(0, $dbh->{'Taint'} == 0);
> + ok(0, $dbh->{'TaintIn'} == 1);
> + ok(0, $dbh->{'TaintOut'} == 0);
> +
> + $dbh->{'Taint'} = 0;
> + ok(0, $dbh->{'Taint'} == 0);
> + ok(0, $dbh->{'TaintIn'} == 0);
> + ok(0, $dbh->{'TaintOut'} == 0);
> +
> + $dbh->{'TaintIn'} = 1;
> + ok(0, $dbh->{'Taint'} == 0);
> + ok(0, $dbh->{'TaintIn'} == 1);
> + ok(0, $dbh->{'TaintOut'} == 0);
> +
> + $dbh->{'TaintOut'} = 1;
> + ok(0, $dbh->{'Taint'} == 1);
> + ok(0, $dbh->{'TaintIn'} == 1);
> + ok(0, $dbh->{'TaintOut'} == 1);
> +}
> +
> # get a dir always readable on all platforms
> my $dir = getcwd() || cwd();
> $dir = VMS::Filespec::unixify($dir) if $^O eq 'VMS';
> @@ -173,7 +207,7 @@
> #$csr_a->trace(2);
> ok(0, $csr_a->bind_columns(undef, \($col0, $col1, $col2)) );
> ok(0, $csr_a->execute( $dir ));
> -ok(0, $csr_a->{Taint} = 1);
> +ok(0, $csr_a->{Taint} = 1) unless $DBI::PurePerl && ok(0,1);
>
> @row_a = $csr_a->fetchrow_array;
> ok(0, @row_a);
> @@ -189,29 +223,81 @@
> my $foo;
> return ! eval { ($foo=join('',@_)), kill 0; 1; };
> }
> -if (is_tainted($^X)) {
> +if (is_tainted($^X) && !$DBI::PurePerl) {
> print "Taint attribute test enabled\n";
> - ok(0, is_tainted($row_a[0]) );
> - ok(0, is_tainted($row_a[1]) );
> - ok(0, is_tainted($row_a[2]) );
> - # check simple method call values
> - ok(0, 1);
> - # check simple attribute values
> - ok(0, 1); # is_tainted($dbh->{AutoCommit}) );
> - # check nested attribute values (where a ref is returned)
> + $dbh->{'Taint'} = 0;
> + my $st;
> + eval { $st = $dbh->prepare($std_sql); };
> + ok(0, ref $st);
> +
> + ok(0, $st->{'Taint'} == 0);
> +
> + ok(0, $st->execute( $dir ));
> +
> + my @row = $st->fetchrow_array;
> + ok(0, @row);
> +
> + ok(0, !is_tainted($row[0]));
> + ok(0, !is_tainted($row[1]));
> + ok(0, !is_tainted($row[2]));
> +
> + $st->{'TaintIn'} = 1;
> +
> + @row = $st->fetchrow_array;
> + ok(0, @row);
> +
> + ok(0, !is_tainted($row[0]));
> + ok(0, !is_tainted($row[1]));
> + ok(0, !is_tainted($row[2]));
> +
> + $st->{'TaintOut'} = 1;
> +
> + @row = $st->fetchrow_array;
> + ok(0, @row);
> +
> + ok(0, is_tainted($row[0]));
> + ok(0, is_tainted($row[1]));
> + ok(0, is_tainted($row[2]));
> +
> + $st->finish;
> +
> + # check simple method call values
> + #ok(0, 1);
> + # check simple attribute values
> + #ok(0, 1); # is_tainted($dbh->{AutoCommit}) );
> + # check nested attribute values (where a ref is returned)
> #ok(0, is_tainted($csr_a->{NAME}->[0]) );
> - # check checking for tainted values
> - eval { $dbh->prepare($^X); 1; };
> - ok(0, $@ =~ /Insecure dependency/, $@);
> - eval { $csr_a->execute($^X); 1; };
> - ok(0, $@ =~ /Insecure dependency/, $@);
> + # check checking for tainted values
> +
> + $dbh->{'Taint'} = $csr_a->{'Taint'} = 1;
> + eval { $dbh->prepare($^X); 1; };
> + ok(0, $@ =~ /Insecure dependency/, $@);
> + eval { $csr_a->execute($^X); 1; };
> + ok(0, $@ =~ /Insecure dependency/, $@);
> undef $@;
> +
> + $dbh->{'TaintIn'} = $csr_a->{'TaintIn'} = 0;
> +
> + eval { $dbh->prepare($^X); 1; };
> + ok(0, !$@);
> + eval { $csr_a->execute($^X); 1; };
> + ok(0, !$@);
> +
> + # Reset taint status to what it was before this block, so that
> + # tests later in the file don't get confused
> + $dbh->{'Taint'} = $csr_a->{'Taint'} = 1;
> }
> else {
> warn " Taint attribute tests skipped\n";
> - ok(0,1) foreach (1..7);
> + ok(0,1) foreach (1..19);
> +}
> +
> +unless ($DBI::PurePerl) {
> + $csr_a->{Taint} = 0;
> + ok(0, $csr_a->{Taint} == 0);
> +} else {
> + ok(0, 1);
> }
> -$csr_a->{Taint} = 0;
>
> ok(0, $csr_b->bind_param(1, $dir));
> ok(0, $csr_b->execute());
> @@ -574,4 +660,4 @@
> }
> ok(0, (%tables == 0));
>
> -BEGIN { $tests = 215; }
> +BEGIN { $tests = 243; }
> Only in DBI/t: 10examp.t~
> Only in DBI/t: zz_01basics_pp.t
> Only in DBI/t: zz_02dbidrv_pp.t
> Only in DBI/t: zz_03hleak_pp.t
> Only in DBI/t: zz_04mods_pp.t
> Only in DBI/t: zz_05thrclone_pp.t
> Only in DBI/t: zz_10examp_pp.t
> Only in DBI/t: zz_15array_pp.t
> Only in DBI/t: zz_20meta_pp.t
> Only in DBI/t: zz_30subclass_pp.t
> Only in DBI/t: zz_40profile_pp.t
> Only in DBI/t: zz_60preparse_pp.t
> Only in DBI/t: zz_70shell_pp.t
> Only in DBI/t: zz_80proxy_pp.t
