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?
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.
> > 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.
Let me know what you think.
Bradley
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
