Hi. I have conflicting information on DBD::Pg's support for taint mode, and
would like some clarification from you if possible.
Is there any way to tell DBD::Pg (or DBI) to raise an exception when prepare
is invoked with a tainted SQL string?
I thought this would be the default behavior, and was surprised when I ran
the demo script below.
This script requires four command-line arguments: the name of a database,
the name of a table in that database, the name of an integer-type column in
that table, and some integer. E.g., a run may look like this:
$ perl -T demo_script.pl mydb mytable mycolum 42
1
1
1
1
1
1
NB: you will need to modify the user and password parameters in the call to
DBI->connect.
The important thing to note is that the connect, prepare, and execute
methods all receive tainted arguments, but run without any problem.
Furthermore, the subsequent fetchall_arrayref also runs without any
problem.
Many thanks in advance. Perl code follows.
~K
#!/usr/bin/perl
use strict;
use warnings FATAL => 'all';
use DBI;
my $dbname = shift;
my $tablename = shift;
my $colname = shift;
my $id = shift;
my $sql = qq(SELECT * FROM "$tablename" WHERE "$colname" = \$1;);
my $connection_string = "dbi:Pg:dbname=$dbname";
# when this script is run under -T, the output from all the following
# print statements is 1; if the script is *not* run under -T, then
# they are all 0.
print +(is_tainted($dbname) ? 1 : 0), "\n";
print +(is_tainted($tablename) ? 1 : 0), "\n";
print +(is_tainted($colname) ? 1 : 0), "\n";
print +(is_tainted($id) ? 1 : 0), "\n";
print +(is_tainted($connection_string) ? 1 : 0), "\n";
print +(is_tainted($sql) ? 1 : 0), "\n";
my $dbh = DBI->connect($connection_string,
"kynn", undef,
+{
RaiseError => 1,
PrintError => 0,
PrintWarn => 0,
});
my $sth = $dbh->prepare($sql);
$sth->execute($id);
my $fetched = $sth->fetchall_arrayref;
sub is_tainted {
# this sub is adapted from Programming Perl, 3rd ed., p. 561
my $arg = shift;
my $empty = do {
no warnings 'uninitialized';
substr($arg, 0, 0);
};
local $@;
eval { eval "# $empty" };
return length($@) != 0;
}
~K
