From 28fc0e459e0587f4d17c116ba95bf7d310a2e69a Mon Sep 17 00:00:00 2001 From: Laurent Dami Date: Wed, 29 Oct 2014 06:57:17 +0200 Subject: [PATCH 1/2] RT#99748: replacing interpolated variables by a closure -- no risk of code injection --- lib/DBD/SQLite/VirtualTable/PerlData.pm | 20 +++++------ t/virtual_table/rt_99748.t | 46 ++++++++++--------------- 2 files changed, 29 insertions(+), 37 deletions(-) diff --git a/lib/DBD/SQLite/VirtualTable/PerlData.pm b/lib/DBD/SQLite/VirtualTable/PerlData.pm index 5112b1e..8b08e60 100644 --- a/lib/DBD/SQLite/VirtualTable/PerlData.pm +++ b/lib/DBD/SQLite/VirtualTable/PerlData.pm @@ -86,7 +86,7 @@ sub BEST_INDEX { $optype = $NUM; } else { - # cnstraint on regular column + # constraint on regular column my $opts = $self->{options}; $member = $opts->{arrayrefs} ? "\$row->[$col]" : $opts->{hashrefs} ? "\$row->{$self->{headers}[$col]}" @@ -94,9 +94,12 @@ sub BEST_INDEX { : die "corrupted data in ->{options}"; $optype = $self->{optypes}[$col]; } - my $op = $SQLOP2PERLOP{$constraint->{op}}[$optype]; - my $quote = $op eq '=~' ? 'm' : 'q'; - push @conditions, "(defined($member) && $member $op ${quote}{%s})"; + my $op = $SQLOP2PERLOP{$constraint->{op}}[$optype]; + push @conditions, + "(defined($member) && defined(\$vals[$ix]) && $member $op \$vals[$ix])"; + # Note : $vals[$ix] refers to an array of values passed to the + # FILTER method (see below); so the eval-ed perl code will be a + # closure on those values # info passed back to the SQLite core -- see vtab.html in sqlite doc $constraint->{argvIndex} = $ix++; @@ -182,17 +185,14 @@ sub row { } sub FILTER { - my ($self, $idxNum, $idxStr, @values) = @_; - - # escape '\' and '}' in values before they are sprintf'ed into q{%s} - @values = map {defined $_ ? quotemeta($_) : 'NULL'} @values; + my ($self, $idxNum, $idxStr, @vals) = @_; # build a method coderef to fetch matching rows my $perl_code = 'sub {my ($self, $i) = @_; my $row = $self->row($i); ' - . sprintf($idxStr, @values) + . $idxStr . '}'; - # print STDERR "PERL COODE:\n", $perl_code, "\n"; + # print STDERR "PERL CODE:\n", $perl_code, "\n"; $self->{is_wanted_row} = eval $perl_code or die "couldn't eval q{$perl_code} : $@"; diff --git a/t/virtual_table/rt_99748.t b/t/virtual_table/rt_99748.t index b289cb9..9566e08 100644 --- a/t/virtual_table/rt_99748.t +++ b/t/virtual_table/rt_99748.t @@ -9,6 +9,19 @@ use t::lib::Test qw/connect_ok $sqlite_call/; use Test::More; use Test::NoWarnings; +# tests that the MATCH operator does not allow code injection +my @interpolation_attempts = ( + '@{[die -1]}', + # '(?{die 999})', # Eval-group not allowed at runtime + '$foobar', + '$self->{row_ix}', + '$main::ARGV[ die 999 ]', + '@main::ARGV', + '$0', + '$self', + ); + + # sample data our $perl_rows = [ [1, 2, 'three'], @@ -19,30 +32,7 @@ our $perl_rows = [ [12, undef, "data\nhas\tspaces"], ]; -# tests for security holes. All of these fail when compiling the regex -my @interpolation_attempts = ( - '@[{die -1}]', - '(?{die 999})', - ); - -#if ($] > 5.008008) { - # don't really know why, but the tests below (interpolating variables - # within regexes) cause segfaults under Perl <= 5.8.8, during the END - # phase -- probably something to do with closure destruction. - push @interpolation_attempts, '$foobar', - '$self->{row_ix}', - '$main::ARGV[ die 999 ]', - ; -#} - -# unfortunately the examples below don't fail, but I don't know how to -# prevent variable interpolation (that we don't want) while keeping -# character interpolation like \n, \t, etc. (that we do want) - # '@main::ARGV', - # '$0', - # '$self', - -plan tests => 4 + 2 * 15 + @interpolation_attempts + 8; +plan tests => 4 + 2 * 15 + @interpolation_attempts + 9; my $dbh = connect_ok( RaiseError => 1, AutoCommit => 1 ); @@ -123,8 +113,7 @@ sub test_table { sub test_match_operator { my ($dbh, $table) = @_; -# my $sql = "SELECT c FROM $table WHERE c MATCH '^.i' ORDER BY c"; - my $sql = "SELECT c FROM $table WHERE c MATCH 'i' ORDER BY c"; + my $sql = "SELECT c FROM $table WHERE c MATCH '^.i' ORDER BY c"; my $res = $dbh->selectcol_arrayref($sql); is_deeply $res, [qw/six/], $sql; @@ -137,9 +126,12 @@ sub test_match_operator { is_deeply $res, [10, 11], $sql; $res = $dbh->selectcol_arrayref($sql, {}, '\}'); + is_deeply $res, [10, 11], $sql; + + $res = $dbh->selectcol_arrayref($sql, {}, '\\\\}'); is_deeply $res, [11], $sql; - $res = $dbh->selectcol_arrayref($sql, {}, '\\'); + $res = $dbh->selectcol_arrayref($sql, {}, '\\\\'); is_deeply $res, [11], $sql; $res = $dbh->selectcol_arrayref($sql, {}, "\n"); From 13e2b63d26328a6f5c0a58447db144ced5cc4d1e Mon Sep 17 00:00:00 2001 From: Laurent Dami Date: Tue, 25 Nov 2014 04:30:57 +0100 Subject: [PATCH 2/2] #99748 catch runtime errors occurring when user input for the MATCH operator is not a proper regex --- lib/DBD/SQLite/VirtualTable/PerlData.pm | 9 ++++++++- t/virtual_table/rt_99748.t | 3 ++- 2 files changed, 10 insertions(+), 2 deletions(-) diff --git a/lib/DBD/SQLite/VirtualTable/PerlData.pm b/lib/DBD/SQLite/VirtualTable/PerlData.pm index 8b08e60..d5b6bfa 100644 --- a/lib/DBD/SQLite/VirtualTable/PerlData.pm +++ b/lib/DBD/SQLite/VirtualTable/PerlData.pm @@ -214,7 +214,14 @@ sub NEXT { do { $self->{row_ix} += 1 - } until $self->EOF || $self->{is_wanted_row}->($self, $self->{row_ix}); + } until $self->EOF + || eval {$self->{is_wanted_row}->($self, $self->{row_ix})}; + + # NOTE: the eval above is required for cases when user data, injected + # into Perl comparison operators, generates errors; for example + # WHERE col MATCH '(foo' will die because the regex is not well formed + # (no matching parenthesis). In such cases no row is selected and the + # query just returns an empty list. } diff --git a/t/virtual_table/rt_99748.t b/t/virtual_table/rt_99748.t index 9566e08..7c18cdf 100644 --- a/t/virtual_table/rt_99748.t +++ b/t/virtual_table/rt_99748.t @@ -12,7 +12,8 @@ use Test::NoWarnings; # tests that the MATCH operator does not allow code injection my @interpolation_attempts = ( '@{[die -1]}', - # '(?{die 999})', # Eval-group not allowed at runtime + '(foobar', # will die - incorrect regex + '(?{die 999})', # will die - Eval-group not allowed at runtime '$foobar', '$self->{row_ix}', '$main::ARGV[ die 999 ]',