select() where can't receive array reference to preve...
...nd SQL injection easily(not...
... | ... |
@@ -1,3 +1,7 @@ |
1 |
+0.1641 |
|
2 |
+ select() where can't receive array reference to prevend SQL injection easily(not backward compatible. sorry. use where() instead) |
|
3 |
+ added experimental safety_column_name attribute |
|
4 |
+ fix SQL injection security hole about column name |
|
1 | 5 |
0.1640 |
2 | 6 |
autoload DBI method |
3 | 7 |
removed experimental expand |
... | ... |
@@ -1,6 +1,6 @@ |
1 | 1 |
package DBIx::Custom; |
2 | 2 |
|
3 |
-our $VERSION = '0.1640'; |
|
3 |
+our $VERSION = '0.1641'; |
|
4 | 4 |
|
5 | 5 |
use 5.008001; |
6 | 6 |
use strict; |
... | ... |
@@ -24,7 +24,8 @@ __PACKAGE__->attr( |
24 | 24 |
dbi_option => sub { {} }, |
25 | 25 |
query_builder => sub { DBIx::Custom::QueryBuilder->new }, |
26 | 26 |
result_class => 'DBIx::Custom::Result', |
27 |
- base_table => sub { DBIx::Custom::Table->new(dbi => shift) } |
|
27 |
+ base_table => sub { DBIx::Custom::Table->new(dbi => shift) }, |
|
28 |
+ safety_column_name => sub { qr/^[\w\.]*$/ } |
|
28 | 29 |
); |
29 | 30 |
|
30 | 31 |
__PACKAGE__->attr( |
... | ... |
@@ -235,7 +236,7 @@ sub delete { |
235 | 236 |
my $table = $args{table} || ''; |
236 | 237 |
croak qq{"table" option must be specified} unless $table; |
237 | 238 |
my $where = $args{where} || {}; |
238 |
- my $append = $args{append}; |
|
239 |
+ my $append = $args{append}; |
|
239 | 240 |
my $filter = $args{filter}; |
240 | 241 |
my $allow_delete_all = $args{allow_delete_all}; |
241 | 242 |
|
... | ... |
@@ -248,18 +249,21 @@ sub delete { |
248 | 249 |
$w->clause($clause); |
249 | 250 |
$w->param($where); |
250 | 251 |
} |
251 |
- else { $w = $where } |
|
252 |
- |
|
252 |
+ elsif (ref $where eq 'DBIx::Custom::Where') { |
|
253 |
+ $w = $where; |
|
254 |
+ $where = $w->param; |
|
255 |
+ } |
|
253 | 256 |
croak qq{"where" must be hash refernce or DBIx::Custom::Where object} |
254 | 257 |
unless ref $w eq 'DBIx::Custom::Where'; |
255 | 258 |
|
256 |
- $where = $w->param; |
|
259 |
+ # String where |
|
260 |
+ my $swhere = "$w"; |
|
257 | 261 |
|
258 | 262 |
croak qq{"where" must be specified} |
259 |
- if "$w" eq '' && !$allow_delete_all; |
|
263 |
+ if $swhere eq '' && !$allow_delete_all; |
|
260 | 264 |
|
261 | 265 |
# Source of SQL |
262 |
- my $source = "delete from $table $w"; |
|
266 |
+ my $source = "delete from $table $swhere"; |
|
263 | 267 |
$source .= " $append" if $append; |
264 | 268 |
|
265 | 269 |
# Create query |
... | ... |
@@ -376,12 +380,18 @@ sub insert { |
376 | 380 |
my $append = $args{append} || ''; |
377 | 381 |
my $filter = $args{filter}; |
378 | 382 |
|
379 |
- # Insert keys |
|
380 |
- my @insert_keys = keys %$param; |
|
383 |
+ # Columns |
|
384 |
+ my @columns; |
|
385 |
+ my $safety = $self->safety_column_name; |
|
386 |
+ foreach my $column (keys %$param) { |
|
387 |
+ croak qq{"$column" is not safety column name} |
|
388 |
+ unless $column =~ /$safety/; |
|
389 |
+ push @columns, $column; |
|
390 |
+ } |
|
381 | 391 |
|
382 |
- # Templte for insert |
|
392 |
+ # SQL |
|
383 | 393 |
my $source = "insert into $table {insert_param " |
384 |
- . join(' ', @insert_keys) . '}'; |
|
394 |
+ . join(' ', @columns) . '}'; |
|
385 | 395 |
$source .= " $append" if $append; |
386 | 396 |
|
387 | 397 |
# Create query |
... | ... |
@@ -478,7 +488,7 @@ sub select { |
478 | 488 |
: []; |
479 | 489 |
croak qq{"table" option must be specified} unless @$tables; |
480 | 490 |
my $columns = $args{column} || []; |
481 |
- my $where = $args{where}; |
|
491 |
+ my $where = $args{where} || {}; |
|
482 | 492 |
my $relation = $args{relation}; |
483 | 493 |
my $append = $args{append}; |
484 | 494 |
my $filter = $args{filter}; |
... | ... |
@@ -504,39 +514,30 @@ sub select { |
504 | 514 |
} |
505 | 515 |
$source =~ s/, $/ /; |
506 | 516 |
|
507 |
- # Where clause |
|
508 |
- my $param; |
|
509 |
- my $wexists; |
|
517 |
+ # Where |
|
518 |
+ my $w; |
|
510 | 519 |
if (ref $where eq 'HASH') { |
511 |
- $param = $where; |
|
512 |
- $wexists = keys %$where; |
|
513 |
- |
|
514 |
- if ($wexists) { |
|
515 |
- $source .= 'where ('; |
|
516 |
- foreach my $where_key (keys %$where) { |
|
517 |
- $source .= "{= $where_key} and "; |
|
518 |
- } |
|
519 |
- $source =~ s/ and $//; |
|
520 |
- $source .= ') '; |
|
521 |
- } |
|
522 |
- } |
|
523 |
- elsif (ref $where eq 'ARRAY') { |
|
524 |
- my $w = $where->[0] || ''; |
|
525 |
- $param = $where->[1]; |
|
526 |
- |
|
527 |
- $wexists = $w =~ /\S/; |
|
528 |
- $source .= "where ($w) " if $wexists; |
|
520 |
+ my $clause = ['and']; |
|
521 |
+ push @$clause, "{= $_}" for keys %$where; |
|
522 |
+ $w = $self->where; |
|
523 |
+ $w->clause($clause); |
|
524 |
+ $w->param($where); |
|
529 | 525 |
} |
530 | 526 |
elsif (ref $where eq 'DBIx::Custom::Where') { |
531 |
- $param = $where->param; |
|
532 |
- my $w = $where->to_string; |
|
533 |
- $wexists = $w =~ /\S/; |
|
534 |
- $source .= $w; |
|
527 |
+ $w = $where; |
|
528 |
+ $where = $w->param; |
|
535 | 529 |
} |
536 | 530 |
|
531 |
+ croak qq{"where" must be hash reference or DBIx::Custom::Where object} |
|
532 |
+ unless ref $w eq 'DBIx::Custom::Where'; |
|
533 |
+ |
|
534 |
+ # String where |
|
535 |
+ my $swhere = "$w"; |
|
536 |
+ $source .= "$swhere "; |
|
537 |
+ |
|
537 | 538 |
# Relation |
538 | 539 |
if ($relation) { |
539 |
- $source .= $wexists ? "and " : "where "; |
|
540 |
+ $source .= $swhere eq '' ? "where " : "and "; |
|
540 | 541 |
foreach my $rkey (keys %$relation) { |
541 | 542 |
$source .= "$rkey = " . $relation->{$rkey} . " and "; |
542 | 543 |
} |
... | ... |
@@ -552,8 +553,8 @@ sub select { |
552 | 553 |
|
553 | 554 |
# Execute query |
554 | 555 |
my $result = $self->execute( |
555 |
- $query, param => $param, filter => $filter, |
|
556 |
- table => $tables); |
|
556 |
+ $query, param => $where, filter => $filter, |
|
557 |
+ table => $tables); |
|
557 | 558 |
|
558 | 559 |
return $result; |
559 | 560 |
} |
... | ... |
@@ -608,15 +609,24 @@ sub update { |
608 | 609 |
croak qq{"table" option must be specified} unless $table; |
609 | 610 |
my $param = $args{param} || {}; |
610 | 611 |
my $where = $args{where} || {}; |
611 |
- my $append = $args{append} || ''; |
|
612 |
+ my $append = $args{append} || ''; |
|
612 | 613 |
my $filter = $args{filter}; |
613 | 614 |
my $allow_update_all = $args{allow_update_all}; |
614 | 615 |
|
615 | 616 |
# Update keys |
616 |
- my @update_keys = keys %$param; |
|
617 |
- |
|
617 |
+ my @clumns = keys %$param; |
|
618 |
+ |
|
619 |
+ # Columns |
|
620 |
+ my @columns; |
|
621 |
+ my $safety = $self->safety_column_name; |
|
622 |
+ foreach my $column (keys %$param) { |
|
623 |
+ croak qq{"$column" is not safety column name} |
|
624 |
+ unless $column =~ /$safety/; |
|
625 |
+ push @columns, $column; |
|
626 |
+ } |
|
627 |
+ |
|
618 | 628 |
# Update clause |
619 |
- my $update_clause = '{update_param ' . join(' ', @update_keys) . '}'; |
|
629 |
+ my $update_clause = '{update_param ' . join(' ', @clumns) . '}'; |
|
620 | 630 |
|
621 | 631 |
# Where |
622 | 632 |
my $w; |
... | ... |
@@ -627,18 +637,22 @@ sub update { |
627 | 637 |
$w->clause($clause); |
628 | 638 |
$w->param($where); |
629 | 639 |
} |
630 |
- else { $w = $where } |
|
640 |
+ elsif (ref $where eq 'DBIx::Custom::Where') { |
|
641 |
+ $w = $where; |
|
642 |
+ $where = $w->param; |
|
643 |
+ } |
|
631 | 644 |
|
632 | 645 |
croak qq{"where" must be hash refernce or DBIx::Custom::Where object} |
633 | 646 |
unless ref $w eq 'DBIx::Custom::Where'; |
634 | 647 |
|
635 |
- $where = $w->param; |
|
648 |
+ # String where |
|
649 |
+ my $swhere = "$w"; |
|
636 | 650 |
|
637 | 651 |
croak qq{"where" must be specified} |
638 |
- if "$w" eq '' && !$allow_update_all; |
|
652 |
+ if "$swhere" eq '' && !$allow_update_all; |
|
639 | 653 |
|
640 | 654 |
# Source of SQL |
641 |
- my $source = "update $table $update_clause $w"; |
|
655 |
+ my $source = "update $table $update_clause $swhere"; |
|
642 | 656 |
$source .= " $append" if $append; |
643 | 657 |
|
644 | 658 |
# Rearrange parameters |
... | ... |
@@ -670,7 +684,12 @@ sub update { |
670 | 684 |
sub update_all { shift->update(allow_update_all => 1, @_) }; |
671 | 685 |
|
672 | 686 |
sub where { |
673 |
- return DBIx::Custom::Where->new(query_builder => shift->query_builder) |
|
687 |
+ my $self = shift; |
|
688 |
+ |
|
689 |
+ return DBIx::Custom::Where->new( |
|
690 |
+ query_builder => $self->query_builder, |
|
691 |
+ safety_column_name => $self->safety_column_name |
|
692 |
+ ); |
|
674 | 693 |
} |
675 | 694 |
|
676 | 695 |
sub _bind { |
... | ... |
@@ -1195,16 +1214,6 @@ C<filter> is filters when parameter binding is executed. |
1195 | 1214 |
C<query> is if you don't execute sql and get L<DBIx::Custom::Query> object as return value. |
1196 | 1215 |
default to 0. This is experimental. |
1197 | 1216 |
|
1198 |
-If you use more complex condition, |
|
1199 |
-you can specify a array reference to C<where> argument. |
|
1200 |
- |
|
1201 |
- my $result = $dbi->select( |
|
1202 |
- table => 'book', |
|
1203 |
- column => ['title', 'author'], |
|
1204 |
- where => ['{= title} or {like author}', |
|
1205 |
- {title => '%Perl%', author => 'Ken'}] |
|
1206 |
- ); |
|
1207 |
- |
|
1208 | 1217 |
First element is a string. it contains tags, |
1209 | 1218 |
such as "{= title} or {like author}". |
1210 | 1219 |
Second element is paramters. |
... | ... |
@@ -14,7 +14,7 @@ use Carp 'croak'; |
14 | 14 |
push @DBIx::Custom::CARP_NOT, __PACKAGE__; |
15 | 15 |
|
16 | 16 |
__PACKAGE__->attr( |
17 |
- [qw/param query_builder/], |
|
17 |
+ [qw/param query_builder safety_column_name/], |
|
18 | 18 |
clause => sub { [] }, |
19 | 19 |
); |
20 | 20 |
|
... | ... |
@@ -75,6 +75,9 @@ sub _parse { |
75 | 75 |
croak qq{Each tag contains one column name: tag "$clause"} |
76 | 76 |
unless @$columns == 1; |
77 | 77 |
my $column = $columns->[0]; |
78 |
+ my $safety = $self->safety_column_name; |
|
79 |
+ croak qq{"$column" is not safety column name} |
|
80 |
+ unless $column =~ /$safety/; |
|
78 | 81 |
|
79 | 82 |
# Column count up |
80 | 83 |
my $count = ++$count->{$column}; |
... | ... |
@@ -1,9 +0,0 @@ |
1 |
-#!perl -T |
|
2 |
- |
|
3 |
-use Test::More tests => 1; |
|
4 |
- |
|
5 |
-BEGIN { |
|
6 |
- use_ok('DBIx::Custom' ); |
|
7 |
-} |
|
8 |
- |
|
9 |
-diag( "Testing DBIx::Custom $DBIx::Custom::VERSION, Perl $], $^X" ); |
... | ... |
@@ -230,6 +230,8 @@ is_deeply($rows, [{key1 => 1, key2 => 2}], 'insert append'); |
230 | 230 |
eval{$dbi->insert(table => 'table1', noexist => 1)}; |
231 | 231 |
like($@, qr/noexist/, "invalid argument"); |
232 | 232 |
|
233 |
+eval{$dbi->insert(table => 'table', param => {';' => 1})}; |
|
234 |
+like($@, qr/safety/); |
|
233 | 235 |
|
234 | 236 |
test 'update'; |
235 | 237 |
$dbi = DBIx::Custom->connect($NEW_ARGS->{0}); |
... | ... |
@@ -300,6 +302,12 @@ $dbi->update(table => 'table1', param => {key1 => 3}, where => $where); |
300 | 302 |
$result = $dbi->select(table => 'table1'); |
301 | 303 |
is_deeply($result->fetch_hash_all, [{key1 => 3, key2 => 2}], 'delete() where'); |
302 | 304 |
|
305 |
+eval{$dbi->update(table => 'table1', param => {';' => 1})}; |
|
306 |
+like($@, qr/safety/); |
|
307 |
+ |
|
308 |
+eval{$dbi->update(table => 'table1', param => {'key1' => 1}, where => {';' => 1})}; |
|
309 |
+like($@, qr/safety/); |
|
310 |
+ |
|
303 | 311 |
test 'update_all'; |
304 | 312 |
$dbi = DBIx::Custom->connect($NEW_ARGS->{0}); |
305 | 313 |
$dbi->execute($CREATE_TABLE->{1}); |
... | ... |
@@ -363,6 +371,9 @@ eval{$dbi->delete(table => 'table1')}; |
363 | 371 |
like($@, qr/"where" must be specified/, |
364 | 372 |
"where key-value pairs not specified"); |
365 | 373 |
|
374 |
+eval{$dbi->delete(table => 'table1', where => {';' => 1})}; |
|
375 |
+like($@, qr/safety/); |
|
376 |
+ |
|
366 | 377 |
test 'delete_all'; |
367 | 378 |
$dbi = DBIx::Custom->connect($NEW_ARGS->{0}); |
368 | 379 |
$dbi->execute($CREATE_TABLE->{0}); |
... | ... |
@@ -389,9 +400,6 @@ is_deeply($rows, [{key1 => 1}, {key1 => 3}], "table and columns and where key"); |
389 | 400 |
$rows = $dbi->select(table => 'table1', where => {key1 => 1})->fetch_hash_all; |
390 | 401 |
is_deeply($rows, [{key1 => 1, key2 => 2}], "table and columns and where key"); |
391 | 402 |
|
392 |
-$rows = $dbi->select(table => 'table1', where => ['{= key1} and {= key2}', {key1 => 1, key2 => 2}])->fetch_hash_all; |
|
393 |
-is_deeply($rows, [{key1 => 1, key2 => 2}], "table and columns and where string"); |
|
394 |
- |
|
395 | 403 |
$rows = $dbi->select(table => 'table1', column => ['key1'], where => {key1 => 3})->fetch_hash_all; |
396 | 404 |
is_deeply($rows, [{key1 => 3}], "table and columns and where key"); |
397 | 405 |
|
... | ... |
@@ -853,11 +861,6 @@ $result = $dbi->select(table => 'table1', where => {}); |
853 | 861 |
$row = $result->fetch_hash_first; |
854 | 862 |
is_deeply($row, {key1 => 1, key2 => 2}); |
855 | 863 |
|
856 |
-$result = $dbi->select(table => 'table1', where => [' ', {}]); |
|
857 |
-$row = $result->fetch_hash_first; |
|
858 |
-is_deeply($row, {key1 => 1, key2 => 2}); |
|
859 |
- |
|
860 |
- |
|
861 | 864 |
test 'select query option'; |
862 | 865 |
$dbi = DBIx::Custom->connect($NEW_ARGS->{0}); |
863 | 866 |
$dbi->execute($CREATE_TABLE->{0}); |