Re: Bug in Class::DBI::Untaint

[prev] [thread] [next] [Date index for 2004/04/23]

--HcAYCG3uE/tztfnV
Content-Type: text/plain; charset=us-ascii
Content-Disposition: inline

Hi!

On Fri, Apr 23, 2004 at 06:24:45PM +0100, colm-cdbi@xxxxxxxxx.xx.xx wrote:

>   defined CGI::Untaint->new({ $col => +shift })->extract("-as_$type" => $col);
> ..
> I don't know enough about whether this will still untaint it properly
> but it looks like the problem is in that area anyhow.

Ah, this is definitly a helpfull hint ...

I played a little with CGI::Untaint. It successfully untaints empty string
and undef as both printable and integer. See attached file
cgi_untaint_undef.t (run it as part of CGI::Untaints 'make test')

attached is also a patch that allowes undef/empty string to be handled by
Class::DBI::Untaint  (cdbi_untaint.patch). It checks if the return value of
the extract is undef. If it is, and if the original value is also undef, it
returns true (hmm, might be neccessary to discern between defined $val and
!$val ?)

The file 01.t is an enhanced version of the CDBI::Untaint test i sent
earlier. Its in the patch, too, but I thought it might be easier to read..

I'm still not sure if there actually is a problem or if I'm just making a
fool of myself for missing something obvious :-)



        -- 
        -> Austrian Perl Workshop - 20th-22nd May - http://vienna.pm.org/ <-

#!/usr/bin/perl                               http://domm.zsi.at
for(ref bless{},just'another'perl'hacker){s-:+-$"-g&&print$_.$/}

--HcAYCG3uE/tztfnV
Content-Type: application/x-troff
Content-Disposition: attachment; filename="cgi_untaint_undef.t"
Content-Transfer-Encoding: quoted-printable

#!/usr/bin/perl -w=0A=0A# test for CGI::Untaint =0A=0Ause Test::More tests =
=3D> 5;=0A=0Ause strict;=0Ause CGI::Untaint;=0A=0Amy $data =3D { key1 =3D> =
undef,=0A	     key2 =3D> '',=0A	   };=0A=0Aok(my $h =3D CGI::Untaint->new( =
$data ), "Can create the handler");=0A=0Ais($data->extract(-as_printable =
=3D> 'key1'),  undef,  'Printable');=0Ais($data->extract(-as_integer =3D> '=
key1'),  undef,  'Integer');=0A=0Ais($data->extract(-as_printable =3D> 'key=
2'),  '',  'Printable');=0Ais($data->extract(-as_integer =3D> 'key2'),  '',=
  'Integer');=0A
--HcAYCG3uE/tztfnV
Content-Type: text/plain; charset=us-ascii
Content-Disposition: attachment; filename="cdbi_untaint.patch"

diff -Bubr Class-DBI-Untaint-0.01/lib/Class/DBI/Untaint.pm Class-DBI-Untaint-0.01_patched/lib/Class/DBI/Untaint.pm
--- Class-DBI-Untaint-0.01/lib/Class/DBI/Untaint.pm	2004-03-05 18:15:37.000000000 +0100
+++ Class-DBI-Untaint-0.01_patched/lib/Class/DBI/Untaint.pm	2004-04-23 22:05:47.000000000 +0200
@@ -11,7 +11,11 @@
 	my ($class, $col, $string, $type) = @_;
 	$class->add_constraint(
 		untaint => $col => sub {
-			CGI::Untaint->new({ $col => +shift })->extract("-as_$type" => $col);
+		    my $val=shift;
+		    my $rv=CGI::Untaint->new({ $col => $val })->extract("-as_$type" => $col);
+		    return $rv if $rv;
+		    return 1 if !$val;
+		    return;
 		});
 }
 
diff -Bubr Class-DBI-Untaint-0.01/t/01.t Class-DBI-Untaint-0.01_patched/t/01.t
--- Class-DBI-Untaint-0.01/t/01.t	2004-03-05 18:13:35.000000000 +0100
+++ Class-DBI-Untaint-0.01_patched/t/01.t	2004-04-23 22:03:25.000000000 +0200
@@ -6,7 +6,7 @@
 
 BEGIN {
 	eval "use DBD::SQLite";
-	plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 3);
+	plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 13);
 }
 
 package My::DBI;
@@ -27,24 +27,71 @@
 use base 'My::DBI';
 
 __PACKAGE__->table('orders');
-__PACKAGE__->columns(All => qw/itemid orders/);
+__PACKAGE__->columns(All => qw/itemid orders description/);
 __PACKAGE__->db_Main->do(
 	qq{
 	CREATE TABLE orders (
 		itemid INTEGER,
-		orders INTEGER
+		orders INTEGER,
+                description VARCHAR
 	)
 });
 __PACKAGE__->constrain_column(orders => Untaint => 'integer');
+__PACKAGE__->constrain_column(description => Untaint => 'printable');
 
 package main;
 
-my $order = My::Order->create({ itemid => 10, orders => 103 });
-isa_ok $order => "My::Order";
+{
+    my $order = My::Order->create({ itemid => 10, orders => 103 });
+    isa_ok $order => "My::Order";
 
-eval { $order->orders("foo") };
-like $@, qr/fails 'untaint' constraint/, "Can't set a string";
+    eval { $order->orders("foo") };
+    like $@, qr/fails 'untaint' constraint/, "Can't set a string";
+}
+
+{
+    my $order = eval { My::Order->create({ itemid => 13, orders => "ten" }) };
+    like $@, qr/fails 'untaint' constraint/, "Can't create with a string";
+}
+
+{
+    my $order = My::Order->create({ itemid => 16, orders=>5 });
+
+    eval { $order->orders(0) };
+    is($@,'','no error');
+    is($order->orders,0,'0 orders');
+    $order->update;
+}
+
+{
+    my $order = My::Order->create({ itemid => 18, description=>'foo' });
+    $order->autoupdate(1);
+    is($order->description,'foo','description ok');
 
-my $order2 = eval { My::Order->create({ itemid => 13, orders => "ten" }) };
-like $@, qr/fails 'untaint' constraint/, "Can't create with a string";
+    eval {$order->description('bar')};
+    is($order->description,'bar','description after update');
 
+    eval {$order->description('')};
+    is($order->description,'','description empty after another update');
+
+    eval {$order->description(undef)};
+    is($order->description,undef,'description undef after another update');
+
+}
+
+{
+    my $not_printable="Hello ".chr(17).chr(0)."World";
+    my $order = My::Order->create({ itemid => 19 });
+    eval { $order->description($not_printable) };
+    like $@, qr/fails 'untaint' constraint/, "Can't update with not printable string";
+
+    eval { $order->description('printable') };
+    $order->update;
+    is $@, '', "Can update with printable string";
+
+    eval { $order->description('') };
+    $order->update;
+    is $@, '', "Can update with empty string";
+    is $order->description,'','is empty';
+
+}

--HcAYCG3uE/tztfnV
Content-Type: application/x-troff
Content-Disposition: attachment; filename="01.t"
Content-Transfer-Encoding: quoted-printable

#!/usr/bin/perl -w=0A=0Ause strict;=0A=0Ause Test::More;=0A=0ABEGIN {=0A	ev=
al "use DBD::SQLite";=0A	plan $@ ? (skip_all =3D> 'needs DBD::SQLite for te=
sting') : (tests =3D> 13);=0A}=0A=0Apackage My::DBI;=0A=0Ause base 'Class::=
DBI';=0Ause Class::DBI::Untaint;=0A=0Ause File::Temp qw/tempfile/;=0Amy (un=
def, $DB) =3D tempfile();=0Amy @DSN =3D ("dbi:SQLite:dbname=3D$DB", '', '',=
 { AutoCommit =3D> 1 });=0A=0AEND { unlink $DB if -e $DB }=0A=0A__PACKAGE__=
->set_db(Main =3D> @DSN);=0A=0Apackage My::Order;=0A=0Ause base 'My::DBI';=
=0A=0A__PACKAGE__->table('orders');=0A__PACKAGE__->columns(All =3D> qw/item=
id orders description/);=0A__PACKAGE__->db_Main->do(=0A	qq{=0A	CREATE TABLE=
 orders (=0A		itemid INTEGER,=0A		orders INTEGER,=0A                descrip=
tion VARCHAR=0A	)=0A});=0A__PACKAGE__->constrain_column(orders =3D> Untaint=
 =3D> 'integer');=0A__PACKAGE__->constrain_column(description =3D> Untaint =
=3D> 'printable');=0A=0Apackage main;=0A=0A{=0A    my $order =3D My::Order-=
>create({ itemid =3D> 10, orders =3D> 103 });=0A    isa_ok $order =3D> "My:=
:Order";=0A=0A    eval { $order->orders("foo") };=0A    like $@, qr/fails '=
untaint' constraint/, "Can't set a string";=0A}=0A=0A{=0A    my $order =3D =
eval { My::Order->create({ itemid =3D> 13, orders =3D> "ten" }) };=0A    li=
ke $@, qr/fails 'untaint' constraint/, "Can't create with a string";=0A}=0A=
=0A{=0A    my $order =3D My::Order->create({ itemid =3D> 16, orders=3D>5 })=
;=0A=0A    eval { $order->orders(0) };=0A    is($@,'','no error');=0A    is=
($order->orders,0,'0 orders');=0A    $order->update;=0A}=0A=0A{=0A    my $o=
rder =3D My::Order->create({ itemid =3D> 18, description=3D>'foo' });=0A   =
 $order->autoupdate(1);=0A    is($order->description,'foo','description ok'=
);=0A=0A    eval {$order->description('bar')};=0A    is($order->description=
,'bar','description after update');=0A=0A    eval {$order->description('')}=
;=0A    is($order->description,'','description empty after another update')=
;=0A=0A    eval {$order->description(undef)};=0A    is($order->description,=
undef,'description undef after another update');=0A=0A}=0A=0A{=0A    my $no=
t_printable=3D"Hello ".chr(17).chr(0)."World";=0A    my $order =3D My::Orde=
r->create({ itemid =3D> 19 });=0A    eval { $order->description($not_printa=
ble) };=0A    like $@, qr/fails 'untaint' constraint/, "Can't update with n=
ot printable string";=0A=0A    eval { $order->description('printable') };=
=0A    $order->update;=0A    is $@, '', "Can update with printable string";=
=0A=0A    eval { $order->description('') };=0A    $order->update;=0A    is =
$@, '', "Can update with empty string";=0A    is $order->description,'','is=
 empty';=0A=0A}=0A
--HcAYCG3uE/tztfnV--