| Subject: | CDBI::Pg taint problem |
Hello Ikebe Tomohiro,
I was having problems running Class::DBI::Pg under mod_perl with taint checking turned on. I've managed to slim the problem down to a test script below (not a mod_perl script):
$ cat test.pl
#!perl
use strict;
use warnings;
use Scalar::Util qw/ tainted /;
package CD;
use base qw(Class::DBI::Pg);
__PACKAGE__->set_db(Main => 'dbi:Pg:dbname=test', '', '');
__PACKAGE__->set_up_table('cd');
package main;
my $cd = CD->retrieve(1);
printf "%-40s tainted?\n", "name";
printf "%-40s=========\n", "="x40;
for my $name (CD->columns) {
printf "%-40s %s\n", $name, tainted($name) ? "Yes" : "no";
}
my $title = $cd->get('title');
printf "%-40s %s\n", $title, tainted($title) ? "Yes" : "no";
__END__
The table used in the example:
CREATE TABLE cd (
id SERIAL NOT NULL PRIMARY KEY,
title TEXT,
artist TEXT,
release_date DATE
);
when run I get:
$ perl -T test.pl
name tainted?
=================================================
artist no
release_date no
title no
id no
Insecure dependency in parameter 1 of DBIx::ContextualFetch::db=HASH(0x83a0a78)->prepare_cached method call while running with -T switch at /usr/local/lib/perl5/site_perl/5.8.3/Ima/DBI.pm line 391.
Attached is a patch that fixes this, I'm not sure if this is the
_right_ place to fix the problem.
Version info:
Class::DBI v0.96
Class::DBI::Pg v0.03
Ima::DBI v0.33
perl v5.8.3
Linux 2.4.20-19.9 i686 i386 GNU/Linux
Any help would be much apreciated...
Many Thanks,
Jay
--- Class/DBI/Pg.orig 2004-10-29 15:40:12.000000000 +0100
+++ Class/DBI/Pg.pm 2004-10-29 15:48:57.000000000 +0100
@@ -11,6 +11,14 @@
sub set_up_table {
my($class, $table) = @_;
my $dbh = $class->db_Main;
+
+ # As Class::DBI uses Ima::DBI, which turns taint checking on by
+ # default, if we acctually run the below code with taint checking on the
+ # column names get tainted - as they then get used later on in building
+ # queries for the database this results in taint errors (see perldoc DBI
+ # for reasons why).
+ local $dbh->{Taint} = 0;
+
my $catalog = "";
if ($class->pg_version >= 7.3) {
$catalog = 'pg_catalog.';