simcop2387/DBD-SQLite-SQLcipher
1
0
Fork 0
mirror of https://github.com/DBD-SQLite/DBD-SQLite synced 2025-06-07 14:19:10 -04:00
Code Issues Releases Wiki Activity

RT#99748: replacing interpolated variables by a closure -- no risk of code injection

Browse source
This commit is contained in:
Laurent Dami 2014-10-29 06:57:17 +02:00
parent 893c47e1d8
commit 28fc0e459e
2 changed files with 29 additions and 37 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

20
lib/DBD/SQLite/VirtualTable/PerlData.pm
View file

@ -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} : $@";

46
t/virtual_table/rt_99748.t
View file

@ -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");