From b389411494a2d873f3c42a24412e1b277b938c02 Mon Sep 17 00:00:00 2001 From: Keita Jamadam Sugama Date: Tue, 22 Oct 2024 07:05:42 +0900 Subject: [PATCH 1/4] introduce as_escape --- lib/Data/ObjectDriver/SQL.pm | 10 ++++ t/11-sql.t | 24 +++++++++- t/61-escape.t | 89 ++++++++++++++++++++++++++++++++++++ t/lib/Foo.pm | 22 +++++++++ t/schemas/foo.sql | 5 ++ 5 files changed, 149 insertions(+), 1 deletion(-) create mode 100644 t/61-escape.t create mode 100644 t/lib/Foo.pm create mode 100644 t/schemas/foo.sql diff --git a/lib/Data/ObjectDriver/SQL.pm b/lib/Data/ObjectDriver/SQL.pm index 59a2e8b..b70658c 100644 --- a/lib/Data/ObjectDriver/SQL.pm +++ b/lib/Data/ObjectDriver/SQL.pm @@ -147,6 +147,15 @@ sub as_sql_having { ''; } +sub as_escape { + my ($stmt, $escape_char) = @_; + + # escape_char can be ''(two quotes), or \\ for mysql and \ for others, but it doesn't accept any injections. + die 'escape_char length must be up to two characters' if defined($escape_char) && length($escape_char) > 2; + + return " ESCAPE '$escape_char'"; +} + sub add_where { my $stmt = shift; ## xxx Need to support old range and transform behaviors. @@ -270,6 +279,7 @@ sub _mk_term { $term = "$c $val->{op} " . ${$val->{value}}; } else { $term = "$c $val->{op} ?"; + $term .= $stmt->as_escape($val->{escape}) if $val->{escape} && $op =~ /^(?:NOT\s+)?I?LIKE$/; push @bind, $val->{value}; } } diff --git a/t/11-sql.t b/t/11-sql.t index 48c1e25..17ac499 100644 --- a/t/11-sql.t +++ b/t/11-sql.t @@ -3,7 +3,7 @@ use strict; use Data::ObjectDriver::SQL; -use Test::More tests => 95; +use Test::More tests => 103; my $stmt = ns(); ok($stmt, 'Created SQL object'); @@ -231,6 +231,28 @@ is($stmt->as_sql_where, "WHERE ((foo = ?) AND (foo = ?) AND (foo = ?))\n"); $stmt->add_where(%terms); is($stmt->as_sql_where, "WHERE ((foo = ?) AND (foo = ?) AND (foo = ?)) AND ((foo = ?) AND (foo = ?) AND (foo = ?))\n"); +## as_escape +$stmt = ns(); +$stmt->add_where(foo => {op => 'LIKE', value => '100%', escape => '\\'}); +is($stmt->as_sql_where, "WHERE (foo LIKE ? ESCAPE '\\')\n"); +is($stmt->bind->[0], '100%'); # escape doesn't automatically escape the value +$stmt = ns(); +$stmt->add_where(foo => {op => 'LIKE', value => '100\\%', escape => '\\'}); +is($stmt->as_sql_where, "WHERE (foo LIKE ? ESCAPE '\\')\n"); +is($stmt->bind->[0], '100\\%'); +$stmt = ns(); +$stmt->add_where(foo => {op => 'LIKE', value => '100%', escape => '!'}); +is($stmt->as_sql_where, "WHERE (foo LIKE ? ESCAPE '!')\n"); +$stmt = ns(); +$stmt->add_where(foo => {op => 'LIKE', value => '100%', escape => "''"}); +is($stmt->as_sql_where, "WHERE (foo LIKE ? ESCAPE '''')\n"); +$stmt = ns(); +$stmt->add_where(foo => {op => 'LIKE', value => '100%', escape => "\\'"}); +is($stmt->as_sql_where, "WHERE (foo LIKE ? ESCAPE '\\'')\n"); +$stmt = ns(); +eval { $stmt->add_where(foo => {op => 'LIKE', value => '_', escape => "!!!"}); }; +like($@, qr/length/, 'right error'); + $stmt = ns(); $stmt->add_select(foo => 'foo'); $stmt->add_select('bar'); diff --git a/t/61-escape.t b/t/61-escape.t new file mode 100644 index 0000000..db7aad3 --- /dev/null +++ b/t/61-escape.t @@ -0,0 +1,89 @@ +# $Id$ + +use strict; +use warnings; +use lib 't/lib'; +use lib 't/lib/cached'; +use Test::More; +use Test::Exception; +use DodTestUtil; + +BEGIN { + DodTestUtil->check_driver; + + unless (eval { require Cache::Memory }) { + plan skip_all => 'Tests require Cache::Memory'; + } +} + +plan tests => 5; + +use Foo; + +setup_dbs({ global => ['foo'] }); + +my $foo1 = Foo->new; +$foo1->name('foo'); +$foo1->text('100%'); +$foo1->save; + +my $foo2 = Foo->new; +$foo2->name('bar'); +$foo2->text('100_'); +$foo2->save; + +subtest 'escape_char 1' => sub { + my @got = Foo->search({ text => { op => 'LIKE', value => '100!%', escape => '!' } }); + is scalar(@got), 1, 'right number'; + is $got[0]->name, 'foo', 'right name'; +}; + +subtest 'escape_char 2' => sub { + my @got = Foo->search({ text => { op => 'LIKE', value => '100#_', escape => '#' } }); + is scalar(@got), 1, 'right number'; + is $got[0]->name, 'bar', 'right name'; +}; + +subtest 'self escape' => sub { + my @got = Foo->search({ text => { op => 'LIKE', value => '100__', escape => '_' } }); + is scalar(@got), 1, 'right number'; + is $got[0]->name, 'bar', 'right name'; +}; + +subtest 'use of special characters' => sub { + subtest 'escape_char single quote' => sub { + my @got = Foo->search({ text => { op => 'LIKE', value => "100'_", escape => "''" } }); + is scalar(@got), 1, 'right number'; + is $got[0]->name, 'bar', 'right name'; + }; + + if (Foo->driver->dbh->{Driver}->{Name} eq 'mysql') { + subtest 'escape_char single quote' => sub { + my @got = Foo->search({ text => { op => 'LIKE', value => "100'_", escape => "\\'" } }); + is scalar(@got), 1, 'right number'; + is $got[0]->name, 'bar', 'right name'; + }; + + subtest 'escape_char backslash' => sub { + my @got = Foo->search({ text => { op => 'LIKE', value => '100\\_', escape => '\\\\' } }); + is scalar(@got), 1, 'right number'; + is $got[0]->name, 'bar', 'right name'; + }; + } else { + subtest 'escape_char backslash' => sub { + my @got = Foo->search({ text => { op => 'LIKE', value => '100\\_', escape => '\\' } }); + is scalar(@got), 1, 'right number'; + is $got[0]->name, 'bar', 'right name'; + }; + } +}; + +subtest 'is safe' => sub { + eval { Foo->search({ text => { op => 'LIKE', value => '_', escape => q{!');select 'vulnerable'; -- } } }); }; + like $@, qr/escape_char length must be up to two characters/, 'error occurs'; +}; + +END { + disconnect_all(qw/Foo/); + teardown_dbs(qw( global )); +} diff --git a/t/lib/Foo.pm b/t/lib/Foo.pm new file mode 100644 index 0000000..a97a3cb --- /dev/null +++ b/t/lib/Foo.pm @@ -0,0 +1,22 @@ +# $Id$ + +package Foo; +use strict; +use warnings; +use Data::ObjectDriver::Driver::DBI; +use DodTestUtil; +use base qw( Data::ObjectDriver::BaseObject ); + +__PACKAGE__->install_properties({ + columns => ['id', 'name', 'text'], + column_defs => { + 'id' => 'integer not null auto_increment', + 'name' => 'string(25)', + 'text' => 'text', + }, + datasource => 'foo', + primary_key => 'id', + driver => Data::ObjectDriver::Driver::DBI->new(dsn => DodTestUtil::dsn('global')), +}); + +1; diff --git a/t/schemas/foo.sql b/t/schemas/foo.sql new file mode 100644 index 0000000..6101065 --- /dev/null +++ b/t/schemas/foo.sql @@ -0,0 +1,5 @@ +CREATE TABLE foo ( + id INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT, + name VARCHAR(25), + text MEDIUMTEXT +) From 5bec09919ba0670eed0a7a74565778e8f7db1146 Mon Sep 17 00:00:00 2001 From: Keita Jamadam Sugama Date: Tue, 22 Oct 2024 11:15:12 +0900 Subject: [PATCH 2/4] fix test for MariaDB --- t/61-escape.t | 18 +++++++++++++++--- 1 file changed, 15 insertions(+), 3 deletions(-) diff --git a/t/61-escape.t b/t/61-escape.t index db7aad3..1df580f 100644 --- a/t/61-escape.t +++ b/t/61-escape.t @@ -16,7 +16,7 @@ BEGIN { } } -plan tests => 5; +plan tests => 6; use Foo; @@ -32,6 +32,11 @@ $foo2->name('bar'); $foo2->text('100_'); $foo2->save; +my $foo3 = Foo->new; +$foo3->name('bar'); +$foo3->text('100!'); +$foo3->save; + subtest 'escape_char 1' => sub { my @got = Foo->search({ text => { op => 'LIKE', value => '100!%', escape => '!' } }); is scalar(@got), 1, 'right number'; @@ -45,11 +50,18 @@ subtest 'escape_char 2' => sub { }; subtest 'self escape' => sub { - my @got = Foo->search({ text => { op => 'LIKE', value => '100__', escape => '_' } }); + my @got = Foo->search({ text => { op => 'LIKE', value => '100!!', escape => '!' } }); is scalar(@got), 1, 'right number'; is $got[0]->name, 'bar', 'right name'; }; +subtest 'use wildcard charactor as escapr_char' => sub { + plan skip_all => 'MariaDB does not support it' if Foo->driver->dbh->{Driver}->{Name} eq 'MariaDB'; + my @got = Foo->search({ text => { op => 'LIKE', value => '100_%', escape => '_' } }); + is scalar(@got), 1, 'right number'; + is $got[0]->name, 'foo', 'right name'; +}; + subtest 'use of special characters' => sub { subtest 'escape_char single quote' => sub { my @got = Foo->search({ text => { op => 'LIKE', value => "100'_", escape => "''" } }); @@ -57,7 +69,7 @@ subtest 'use of special characters' => sub { is $got[0]->name, 'bar', 'right name'; }; - if (Foo->driver->dbh->{Driver}->{Name} eq 'mysql') { + if (Foo->driver->dbh->{Driver}->{Name} =~ /mysql|mariadb/i) { subtest 'escape_char single quote' => sub { my @got = Foo->search({ text => { op => 'LIKE', value => "100'_", escape => "\\'" } }); is scalar(@got), 1, 'right number'; From 95cb405bcb1351d7e52adfea068efc81a8c46280 Mon Sep 17 00:00:00 2001 From: Keita Jamadam Sugama Date: Tue, 22 Oct 2024 12:49:47 +0900 Subject: [PATCH 3/4] cleanup --- t/61-escape.t | 47 +++++++++++++++++---------------------- t/lib/{ => escape}/Foo.pm | 0 2 files changed, 21 insertions(+), 26 deletions(-) rename t/lib/{ => escape}/Foo.pm (100%) diff --git a/t/61-escape.t b/t/61-escape.t index 1df580f..dce5e15 100644 --- a/t/61-escape.t +++ b/t/61-escape.t @@ -3,17 +3,12 @@ use strict; use warnings; use lib 't/lib'; -use lib 't/lib/cached'; +use lib 't/lib/escape'; use Test::More; -use Test::Exception; use DodTestUtil; BEGIN { DodTestUtil->check_driver; - - unless (eval { require Cache::Memory }) { - plan skip_all => 'Tests require Cache::Memory'; - } } plan tests => 6; @@ -22,70 +17,70 @@ use Foo; setup_dbs({ global => ['foo'] }); -my $foo1 = Foo->new; -$foo1->name('foo'); -$foo1->text('100%'); -$foo1->save; +my $percent = Foo->new; +$percent->name('percent'); +$percent->text('100%'); +$percent->save; -my $foo2 = Foo->new; -$foo2->name('bar'); -$foo2->text('100_'); -$foo2->save; +my $underscore = Foo->new; +$underscore->name('underscore'); +$underscore->text('100_'); +$underscore->save; -my $foo3 = Foo->new; -$foo3->name('bar'); -$foo3->text('100!'); -$foo3->save; +my $exclamation = Foo->new; +$exclamation->name('exclamation'); +$exclamation->text('100!'); +$exclamation->save; subtest 'escape_char 1' => sub { my @got = Foo->search({ text => { op => 'LIKE', value => '100!%', escape => '!' } }); is scalar(@got), 1, 'right number'; - is $got[0]->name, 'foo', 'right name'; + is $got[0]->name, 'percent', 'right name'; }; subtest 'escape_char 2' => sub { my @got = Foo->search({ text => { op => 'LIKE', value => '100#_', escape => '#' } }); is scalar(@got), 1, 'right number'; - is $got[0]->name, 'bar', 'right name'; + is $got[0]->name, 'underscore', 'right name'; }; subtest 'self escape' => sub { my @got = Foo->search({ text => { op => 'LIKE', value => '100!!', escape => '!' } }); is scalar(@got), 1, 'right number'; - is $got[0]->name, 'bar', 'right name'; + is $got[0]->name, 'exclamation', 'right name'; }; subtest 'use wildcard charactor as escapr_char' => sub { plan skip_all => 'MariaDB does not support it' if Foo->driver->dbh->{Driver}->{Name} eq 'MariaDB'; my @got = Foo->search({ text => { op => 'LIKE', value => '100_%', escape => '_' } }); is scalar(@got), 1, 'right number'; - is $got[0]->name, 'foo', 'right name'; + is $got[0]->name, 'percent', 'right name'; }; subtest 'use of special characters' => sub { subtest 'escape_char single quote' => sub { my @got = Foo->search({ text => { op => 'LIKE', value => "100'_", escape => "''" } }); is scalar(@got), 1, 'right number'; - is $got[0]->name, 'bar', 'right name'; + is $got[0]->name, 'underscore', 'right name'; }; if (Foo->driver->dbh->{Driver}->{Name} =~ /mysql|mariadb/i) { subtest 'escape_char single quote' => sub { my @got = Foo->search({ text => { op => 'LIKE', value => "100'_", escape => "\\'" } }); is scalar(@got), 1, 'right number'; - is $got[0]->name, 'bar', 'right name'; + is $got[0]->name, 'underscore', 'right name'; }; subtest 'escape_char backslash' => sub { my @got = Foo->search({ text => { op => 'LIKE', value => '100\\_', escape => '\\\\' } }); is scalar(@got), 1, 'right number'; - is $got[0]->name, 'bar', 'right name'; + is $got[0]->name, 'underscore', 'right name'; }; } else { subtest 'escape_char backslash' => sub { my @got = Foo->search({ text => { op => 'LIKE', value => '100\\_', escape => '\\' } }); is scalar(@got), 1, 'right number'; - is $got[0]->name, 'bar', 'right name'; + is $got[0]->name, 'underscore', 'right name'; }; } }; diff --git a/t/lib/Foo.pm b/t/lib/escape/Foo.pm similarity index 100% rename from t/lib/Foo.pm rename to t/lib/escape/Foo.pm From 6fbf5cb8df7fe40af973b04966805f29f0a5eac7 Mon Sep 17 00:00:00 2001 From: Keita Jamadam Sugama Date: Tue, 22 Oct 2024 13:20:52 +0900 Subject: [PATCH 4/4] perltidy --- t/11-sql.t | 16 ++++++++-------- t/61-escape.t | 16 ++++++++-------- 2 files changed, 16 insertions(+), 16 deletions(-) diff --git a/t/11-sql.t b/t/11-sql.t index 17ac499..0bd0117 100644 --- a/t/11-sql.t +++ b/t/11-sql.t @@ -233,24 +233,24 @@ is($stmt->as_sql_where, "WHERE ((foo = ?) AND (foo = ?) AND (foo = ?)) AND ((foo ## as_escape $stmt = ns(); -$stmt->add_where(foo => {op => 'LIKE', value => '100%', escape => '\\'}); +$stmt->add_where(foo => { op => 'LIKE', value => '100%', escape => '\\' }); is($stmt->as_sql_where, "WHERE (foo LIKE ? ESCAPE '\\')\n"); -is($stmt->bind->[0], '100%'); # escape doesn't automatically escape the value +is($stmt->bind->[0], '100%'); # escape doesn't automatically escape the value $stmt = ns(); -$stmt->add_where(foo => {op => 'LIKE', value => '100\\%', escape => '\\'}); +$stmt->add_where(foo => { op => 'LIKE', value => '100\\%', escape => '\\' }); is($stmt->as_sql_where, "WHERE (foo LIKE ? ESCAPE '\\')\n"); -is($stmt->bind->[0], '100\\%'); +is($stmt->bind->[0], '100\\%'); $stmt = ns(); -$stmt->add_where(foo => {op => 'LIKE', value => '100%', escape => '!'}); +$stmt->add_where(foo => { op => 'LIKE', value => '100%', escape => '!' }); is($stmt->as_sql_where, "WHERE (foo LIKE ? ESCAPE '!')\n"); $stmt = ns(); -$stmt->add_where(foo => {op => 'LIKE', value => '100%', escape => "''"}); +$stmt->add_where(foo => { op => 'LIKE', value => '100%', escape => "''" }); is($stmt->as_sql_where, "WHERE (foo LIKE ? ESCAPE '''')\n"); $stmt = ns(); -$stmt->add_where(foo => {op => 'LIKE', value => '100%', escape => "\\'"}); +$stmt->add_where(foo => { op => 'LIKE', value => '100%', escape => "\\'" }); is($stmt->as_sql_where, "WHERE (foo LIKE ? ESCAPE '\\'')\n"); $stmt = ns(); -eval { $stmt->add_where(foo => {op => 'LIKE', value => '_', escape => "!!!"}); }; +eval { $stmt->add_where(foo => { op => 'LIKE', value => '_', escape => "!!!" }); }; like($@, qr/length/, 'right error'); $stmt = ns(); diff --git a/t/61-escape.t b/t/61-escape.t index dce5e15..58a8a77 100644 --- a/t/61-escape.t +++ b/t/61-escape.t @@ -34,52 +34,52 @@ $exclamation->save; subtest 'escape_char 1' => sub { my @got = Foo->search({ text => { op => 'LIKE', value => '100!%', escape => '!' } }); - is scalar(@got), 1, 'right number'; + is scalar(@got), 1, 'right number'; is $got[0]->name, 'percent', 'right name'; }; subtest 'escape_char 2' => sub { my @got = Foo->search({ text => { op => 'LIKE', value => '100#_', escape => '#' } }); - is scalar(@got), 1, 'right number'; + is scalar(@got), 1, 'right number'; is $got[0]->name, 'underscore', 'right name'; }; subtest 'self escape' => sub { my @got = Foo->search({ text => { op => 'LIKE', value => '100!!', escape => '!' } }); - is scalar(@got), 1, 'right number'; + is scalar(@got), 1, 'right number'; is $got[0]->name, 'exclamation', 'right name'; }; subtest 'use wildcard charactor as escapr_char' => sub { plan skip_all => 'MariaDB does not support it' if Foo->driver->dbh->{Driver}->{Name} eq 'MariaDB'; my @got = Foo->search({ text => { op => 'LIKE', value => '100_%', escape => '_' } }); - is scalar(@got), 1, 'right number'; + is scalar(@got), 1, 'right number'; is $got[0]->name, 'percent', 'right name'; }; subtest 'use of special characters' => sub { subtest 'escape_char single quote' => sub { my @got = Foo->search({ text => { op => 'LIKE', value => "100'_", escape => "''" } }); - is scalar(@got), 1, 'right number'; + is scalar(@got), 1, 'right number'; is $got[0]->name, 'underscore', 'right name'; }; if (Foo->driver->dbh->{Driver}->{Name} =~ /mysql|mariadb/i) { subtest 'escape_char single quote' => sub { my @got = Foo->search({ text => { op => 'LIKE', value => "100'_", escape => "\\'" } }); - is scalar(@got), 1, 'right number'; + is scalar(@got), 1, 'right number'; is $got[0]->name, 'underscore', 'right name'; }; subtest 'escape_char backslash' => sub { my @got = Foo->search({ text => { op => 'LIKE', value => '100\\_', escape => '\\\\' } }); - is scalar(@got), 1, 'right number'; + is scalar(@got), 1, 'right number'; is $got[0]->name, 'underscore', 'right name'; }; } else { subtest 'escape_char backslash' => sub { my @got = Foo->search({ text => { op => 'LIKE', value => '100\\_', escape => '\\' } }); - is scalar(@got), 1, 'right number'; + is scalar(@got), 1, 'right number'; is $got[0]->name, 'underscore', 'right name'; }; }