Bug#622919: libjifty-dbi-perl: security SQL injection
agostini
agostini at agostini.univ-metz.fr
Fri Apr 15 20:42:40 UTC 2011
Package: libjifty-dbi-perl
Version: 0.60-1.1
Severity: important
Jifty team discover some SQL injection weaknesses
http://lists.jifty.org/pipermail/jifty-devel/2011-April/thread.html
I send a quilt patch to the list which is a backport from 0.68 to 0.60
-- System Information:
Debian Release: 6.0.1
APT prefers proposed-updates
APT policy: (500, 'proposed-updates'), (500, 'stable')
Architecture: i386 (i686)
Kernel: Linux 2.6.32-5-686-bigmem (SMP w/2 CPU cores)
Locale: LANG=fr_FR.UTF-8, LC_CTYPE=fr_FR.UTF-8 (charmap=UTF-8)
Shell: /bin/sh linked to /bin/dash
Versions of packages libjifty-dbi-perl depends on:
ii libcache-memcached-perl 1.29-1 Perl module for using memcached se
ii libcache-simple-timedexpiry-p 0.27-2 Perl module to cache and expire ke
ii libclass-accessor-perl 0.34-1 Perl module that automatically gen
ii libclass-data-inheritable-per 0.08-1 Inheritable, overridable class dat
ii libclass-returnvalue-perl 0.55-1 A return-value object that lets yo
ii libclass-trigger-perl 0.14-1 Mix-in to add / call inheritable t
ii libclone-perl 0.31-1 recursively copy Perl datatypes
ii libdata-page-perl 2.02-1 Help when paging through sets of r
ii libdatetime-format-iso8601-pe 0.0403-2 Parses ISO8601 formats
ii libdatetime-format-strptime-p 1.5000-1 Perl module to parse and format st
ii libdatetime-perl 2:0.6100-2 module for manipulating dates, tim
ii libdbd-sqlite3-perl 1.29-3 Perl DBI driver with a self-contai
ii libdbi-perl 1.612-1 Perl Database Interface (DBI)
ii libdbix-dbschema-perl 0.39-1 Database-independent schema object
ii libexporter-lite-perl 0.02-2 lightweight subset of Exporter
ii libhash-merge-perl 0.12-1 Merges arbitrarily deep hashes int
ii liblingua-en-inflect-perl 1.892-1 Perl module to pluralize English w
ii libobject-declare-perl 0.22-2 Declarative object constructor
ii libscalar-defer-perl 0.23-1 module providing lazy evaluation f
ii libtime-duration-parse-perl 0.06-1 Parse string that represents time
ii libtime-duration-perl 1.06-3 module for rounded or exact Englis
ii libuniversal-require-perl 0.13-1 Load modules from a variable
ii liburi-perl 1.54-2 module to manipulate and access UR
ii libyaml-syck-perl 1.12-1 Perl module providing a fast, ligh
ii perl 5.10.1-17 Larry Wall's Practical Extraction
ii perl-modules [libversion-perl 5.10.1-17 Core Perl modules
libjifty-dbi-perl recommends no packages.
libjifty-dbi-perl suggests no packages.
-- no debconf information
-------------- next part --------------
--- a/lib/Jifty/DBI/Collection.pm
+++ b/lib/Jifty/DBI/Collection.pm
@@ -536,6 +536,7 @@
my $alias = shift;
my $item = shift;
return map $alias ."." . $_ ." as ". $alias ."_". $_,
+ #map $_->name, grep { !$_->virtual && !$_->computed } $item->columns;
map $_->name, grep !$_->virtual, $item->columns;
}
@@ -932,6 +933,58 @@
return ( $self->next );
}
+=head2 distinct_column_values
+
+Takes a column name and returns distinct values of the column.
+Only values in the current collection are returned.
+
+Optional arguments are C<max> and C<sort> to limit number of
+values returned and it makes sense to sort results.
+
+ $col->distinct_column_values('column');
+
+ $col->distinct_column_values(column => 'column');
+
+ $col->distinct_column_values('column', max => 10, sort => 'asc');
+
+=cut
+
+sub distinct_column_values {
+ my $self = shift;
+ my %args = (
+ column => undef,
+ sort => undef,
+ max => undef,
+ @_%2 ? (column => @_) : (@_)
+ );
+
+ return () if $self->derived;
+
+ my $query_string = $self->_build_joins;
+ if ( $self->_is_limited ) {
+ $query_string .= ' '. $self->_where_clause . " ";
+ }
+
+ my $column = 'main.'. $args{'column'};
+ $query_string = 'SELECT DISTINCT '. $column .' FROM '. $query_string;
+
+ if ( $args{'sort'} ) {
+ $query_string .= ' ORDER BY '. $column
+ .' '. ($args{'sort'} =~ /^des/i ? 'DESC' : 'ASC');
+ }
+
+ my $sth = $self->_handle->simple_query( $query_string ) or return;
+ my $value;
+ $sth->bind_col(1, \$value) or return;
+ my @col;
+ if ($args{max}) {
+ push @col, $value while 0 < $args{max}-- && $sth->fetch;
+ } else {
+ push @col, $value while $sth->fetch;
+ }
+ return @col;
+}
+
=head2 items_array_ref
Return a reference to an array containing all objects found by this
@@ -966,7 +1019,7 @@
L</record_class> method is used to determine class of the object.
Each record class at least once is loaded using require. This method is
-called each time a record fetched so load atemts are cached to avoid
+called each time a record fetched so load attempts are cached to avoid
penalties. If you're sure that all record classes are loaded before
first use then you can override this method.
@@ -1023,7 +1076,7 @@
=head2 redo_search
Takes no arguments. Tells Jifty::DBI::Collection that the next time
-it's asked for a record, it should requery the database
+it is asked for a record, it should re-execute the query.
=cut
@@ -1076,9 +1129,9 @@
=item alias
-Unless alias is set, the join criterias will be taken from EXT_LINKcolumn
-and INT_LINKcolumn and added to the criterias. If alias is set, new
-criterias about the foreign table will be added.
+Unless alias is set, the join criteria will be taken from EXT_LINKcolumn
+and INT_LINKcolumn and added to the criteria. If alias is set, new
+criteria about the foreign table will be added.
=item column
@@ -1100,7 +1153,7 @@
=item "!="
-Any other standard SQL comparision operators that your underlying
+Any other standard SQL comparison operators that your underlying
database supports are also valid.
=item "LIKE"
@@ -1117,7 +1170,7 @@
=item "ends_with"
-ENDSWITH is like LIKE, except it prepends a % to the beginning of the string
+ends_with is like LIKE, except it prepends a % to the beginning of the string
=item "IN"
@@ -1201,16 +1254,9 @@
# }}}
- # Set this to the name of the column and the alias, unless we've been
- # handed a subclause name
-
- my $qualified_column
- = $args{'alias'}
- ? $args{'alias'} . "." . $args{'column'}
- : $args{'column'};
- my $clause_id = $args{'subclause'} || $qualified_column;
-
- # XXX: when is column_obj undefined?
+ # $column_obj is undefined when the table2 argument to the join is a table
+ # name and not a collection model class. In that case, the class key
+ # doesn't exist for the join.
my $class
= $self->{joins}{ $args{alias} }
&& $self->{joins}{ $args{alias} }{class}
@@ -1222,7 +1268,44 @@
$self->new_item->_apply_input_filters(
column => $column_obj,
value_ref => \$args{'value'},
- ) if $column_obj && $column_obj->encode_on_select;
+ ) if $column_obj && $column_obj->encode_on_select && $args{operator} !~ /IS/;
+
+ # Ensure that the column has nothing fishy going on. We can't
+ # simply check $column_obj's truth because joins mostly join by
+ # table name, not class, and we don't track table_name -> class.
+ if ($args{column} =~ /\W/) {
+ warn "Possible SQL injection on column '$args{column}' in limit at @{[join(',',(caller)[1,2])]}\n";
+ %args = (
+ %args,
+ column => 'id',
+ operator => '<',
+ value => 0,
+ );
+ }
+ if ($args{operator} !~ /^(=|<|>|!=|<>|<=|>=
+ |(NOT\s*)?LIKE
+ |(NOT\s*)?(STARTS|ENDS)_?WITH
+ |(NOT\s*)?MATCHES
+ |IS(\s*NOT)?
+ |IN)$/ix) {
+ warn "Unknown operator '$args{operator}' in limit at @{[join(',',(caller)[1,2])]}\n";
+ %args = (
+ %args,
+ column => 'id',
+ operator => '<',
+ value => 0,
+ );
+ }
+
+
+ # Set this to the name of the column and the alias, unless we've been
+ # handed a subclause name
+ my $qualified_column
+ = $args{'alias'}
+ ? $args{'alias'} . "." . $args{'column'}
+ : $args{'column'};
+ my $clause_id = $args{'subclause'} || $qualified_column;
+
# make passing in an object DTRT
my $value_ref = ref( $args{value} );
@@ -1230,17 +1313,23 @@
if ( ( $value_ref ne 'ARRAY' )
&& $args{value}->isa('Jifty::DBI::Record') )
{
- $args{value} = $args{value}->id;
+ my $by = (defined $column_obj and defined $column_obj->by)
+ ? $column_obj->by
+ : 'id';
+ $args{value} = $args{value}->$by;
} elsif ( $value_ref eq 'ARRAY' ) {
# Don't modify the original reference, it isn't polite
$args{value} = [ @{ $args{value} } ];
map {
+ my $by = (defined $column_obj and defined $column_obj->by)
+ ? $column_obj->by
+ : 'id';
$_ = (
( ref $_ && $_->isa('Jifty::DBI::Record') )
- ? ( $_->id )
+ ? ( $_->$by )
: $_
- )
+ )
} @{ $args{value} };
}
}
@@ -1248,27 +1337,28 @@
#since we're changing the search criteria, we need to redo the search
$self->redo_search();
- if ( $args{'column'} ) {
-
- #If it's a like, we supply the %s around the search term
- if ( $args{'operator'} =~ /MATCHES/i ) {
- $args{'value'} = "%" . $args{'value'} . "%";
- } elsif ( $args{'operator'} =~ /STARTS_?WITH/i ) {
- $args{'value'} = $args{'value'} . "%";
- } elsif ( $args{'operator'} =~ /ENDS_?WITH/i ) {
- $args{'value'} = "%" . $args{'value'};
- }
- $args{'operator'} =~ s/(?:MATCHES|ENDS_?WITH|STARTS_?WITH)/LIKE/i;
-
- #if we're explicitly told not to to quote the value or
- # we're doing an IS or IS NOT (null), don't quote the operator.
-
- if ( $args{'quote_value'} && $args{'operator'} !~ /IS/i ) {
- if ( $value_ref eq 'ARRAY' ) {
- map { $_ = $self->_handle->quote_value($_) } @{ $args{'value'} };
- } else {
- $args{'value'} = $self->_handle->quote_value( $args{'value'} );
- }
+ #If it's a like, we supply the %s around the search term
+ if ( $args{'operator'} =~ /MATCHES/i ) {
+ $args{'value'} = "%" . $args{'value'} . "%";
+ } elsif ( $args{'operator'} =~ /STARTS_?WITH/i ) {
+ $args{'value'} = $args{'value'} . "%";
+ } elsif ( $args{'operator'} =~ /ENDS_?WITH/i ) {
+ $args{'value'} = "%" . $args{'value'};
+ }
+ $args{'operator'} =~ s/(?:MATCHES|ENDS_?WITH|STARTS_?WITH)/LIKE/i;
+
+ # Force the value to NULL (non-quoted) if the operator is IS.
+ if ($args{'operator'} =~ /^IS(\s*NOT)?$/i) {
+ $args{'quote_value'} = 0;
+ $args{'value'} = 'NULL';
+ }
+
+ # Quote the value
+ if ( $args{'quote_value'} ) {
+ if ( $value_ref eq 'ARRAY' ) {
+ map { $_ = $self->_handle->quote_value($_) } @{ $args{'value'} };
+ } else {
+ $args{'value'} = $self->_handle->quote_value( $args{'value'} );
}
}
@@ -1351,8 +1441,8 @@
=head2 open_paren CLAUSE
-Places an open paren at the current location in the given C<CLAUSE>.
-Note that this can be used for Deep Magic, and has a high likelyhood
+Places an open parenthesis at the current location in the given C<CLAUSE>.
+Note that this can be used for Deep Magic, and has a high likelihood
of allowing you to construct malformed SQL queries. Its interface
will probably change in the near future, but its presence allows for
arbitrarily complex queries.
@@ -1395,8 +1485,8 @@
=head2 close_paren CLAUSE
-Places a close paren at the current location in the given C<CLAUSE>.
-Note that this can be used for Deep Magic, and has a high likelyhood
+Places a close parenthesis at the current location in the given C<CLAUSE>.
+Note that this can be used for Deep Magic, and has a high likelihood
of allowing you to construct malformed SQL queries. Its interface
will probably change in the near future, but its presence allows for
arbitrarily complex queries.
@@ -1515,6 +1605,10 @@
the function then you have to build correct reference with alias
in the C<alias.column> format.
+If you specify C<function> and C<column>, the column (and C<alias>) will be
+wrapped in the function. This is useful for simple functions like C<min> or
+C<lower>.
+
Use array of hashes to order by many columns/functions.
Calling this I<sets> the ordering, it doesn't refine it. If you want to keep
@@ -1595,7 +1689,7 @@
$rowhash{'order'} = "ASC";
}
- if ( $rowhash{'function'} ) {
+ if ( $rowhash{'function'} and not defined $rowhash{'column'} ) {
$clause .= ( $clause ? ", " : " " );
$clause .= $rowhash{'function'} . ' ';
$clause .= $rowhash{'order'};
@@ -1603,11 +1697,17 @@
} elsif ( ( defined $rowhash{'alias'} )
and ( $rowhash{'column'} ) )
{
+ if ($rowhash{'column'} =~ /\W/) {
+ warn "Possible SQL injection in column '$rowhash{column}' in order_by\n";
+ next;
+ }
$clause .= ( $clause ? ", " : " " );
+ $clause .= $rowhash{'function'} . "(" if $rowhash{'function'};
$clause .= $rowhash{'alias'} . "." if $rowhash{'alias'};
- $clause .= $rowhash{'column'} . " ";
- $clause .= $rowhash{'order'};
+ $clause .= $rowhash{'column'};
+ $clause .= ")" if $rowhash{'function'};
+ $clause .= " " . $rowhash{'order'};
}
}
$clause = " ORDER BY$clause " if $clause;
@@ -1685,6 +1785,10 @@
} elsif ( ( $rowhash{'alias'} )
and ( $rowhash{'column'} ) )
{
+ if ($rowhash{'column'} =~ /\W/) {
+ warn "Possible SQL injection in column '$rowhash{column}' in group_by\n";
+ next;
+ }
$clause .= ( $clause ? ", " : " " );
$clause .= $rowhash{'alias'} . ".";
@@ -1748,7 +1852,7 @@
Join instructs Jifty::DBI::Collection to join two tables.
-The standard form takes a param hash with keys C<alias1>, C<column1>, C<alias2>
+The standard form takes a paramhash with keys C<alias1>, C<column1>, C<alias2>
and C<column2>. C<alias1> and C<alias2> are column aliases obtained from
$self->new_alias or a $self->limit. C<column1> and C<column2> are the columns
in C<alias1> and C<alias2> that should be linked, respectively. For this
@@ -1845,7 +1949,7 @@
=head2 first_row
Get or set the first row of the result set the database should return.
-Takes an optional single integer argrument. Returns the currently set
+Takes an optional single integer argument. Returns the currently set
integer first row that the database should return.
@@ -2085,9 +2189,9 @@
=head2 columns_in_db table
-Return a list of columns in table, lowercased.
+Return a list of columns in table, in lowercase.
-TODO: Why are they lowercased?
+TODO: Why are they in lowercase?
=cut
@@ -2167,7 +2271,7 @@
Returns list of the object's fields that should be copied.
If your subclass store references in the object that should be copied while
-clonning then you probably want override this method and add own values to
+cloning then you probably want override this method and add own values to
the list.
=cut
--- a/lib/Jifty/DBI/Handle/Oracle.pm
+++ b/lib/Jifty/DBI/Handle/Oracle.pm
@@ -251,18 +251,30 @@
= [ @{ $collection->{group_by} || [] }, { column => 'id' } ];
local $collection->{order_by} = [
map {
- ( $_->{alias} and $_->{alias} ne "main" )
- ? { %{$_}, column => "min(" . $_->{column} . ")" }
- : $_
+ my $alias = $_->{alias} || '';
+ my $column = $_->{column};
+ if ($column =~ /\W/) {
+ warn "Possible SQL injection in column '$column' in order_by\n";
+ next;
+ }
+ $alias .= '.' if $alias;
+
+ ( ( !$alias or $alias eq 'main.' ) and $column eq 'id' )
+ ? $_
+ : { %{$_}, column => undef, function => "min($alias$column)" }
} @{ $collection->{order_by} }
];
my $group = $collection->_group_clause;
my $order = $collection->_order_clause;
$$statementref
- = "SELECT main.* FROM ( SELECT main.id FROM $$statementref $group $order ) distinctquery, $table main WHERE (main.id = distinctquery.id)";
+ = "SELECT "
+ . $collection->query_columns
+ . " FROM ( SELECT main.id FROM $$statementref $group $order ) distinctquery, $table main WHERE (main.id = distinctquery.id)";
} else {
$$statementref
- = "SELECT main.* FROM ( SELECT DISTINCT main.id FROM $$statementref ) distinctquery, $table main WHERE (main.id = distinctquery.id) ";
+ = "SELECT "
+ . $collection->query_columns
+ . " FROM ( SELECT DISTINCT main.id FROM $$statementref ) distinctquery, $table main WHERE (main.id = distinctquery.id) ";
$$statementref .= $collection->_group_clause;
$$statementref .= $collection->_order_clause;
}
--- a/lib/Jifty/DBI/Handle/Pg.pm
+++ b/lib/Jifty/DBI/Handle/Pg.pm
@@ -210,12 +210,15 @@
map {
my $alias = $_->{alias} || '';
my $column = $_->{column};
+ if ($column =~ /\W/) {
+ warn "Possible SQL injection in column '$column' in order_by\n";
+ next;
+ }
$alias .= '.' if $alias;
- #warn "alias $alias => column $column\n";
( ( !$alias or $alias eq 'main.' ) and $column eq 'id' )
? $_
- : { %{$_}, alias => '', column => "min($alias$column)" }
+ : { %{$_}, column => undef, function => "min($alias$column)" }
} @{ $collection->{order_by} }
];
my $group = $collection->_group_clause;
More information about the pkg-perl-maintainers
mailing list