r72831 - in /branches/squeeze/libjifty-dbi-perl: debian/changelog lib/Jifty/DBI/Collection.pm lib/Jifty/DBI/Handle/Oracle.pm lib/Jifty/DBI/Handle/Pg.pm

gregoa at users.alioth.debian.org gregoa at users.alioth.debian.org
Tue Apr 19 21:59:39 UTC 2011


Author: gregoa
Date: Tue Apr 19 21:59:33 2011
New Revision: 72831

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=72831
Log:
* Team upload.
* [SECURITY] Apply patch prepared by upstream that backports fixes for SQL
  injection weaknesses (closes: #622919).

Modified:
    branches/squeeze/libjifty-dbi-perl/debian/changelog
    branches/squeeze/libjifty-dbi-perl/lib/Jifty/DBI/Collection.pm
    branches/squeeze/libjifty-dbi-perl/lib/Jifty/DBI/Handle/Oracle.pm
    branches/squeeze/libjifty-dbi-perl/lib/Jifty/DBI/Handle/Pg.pm

Modified: branches/squeeze/libjifty-dbi-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/branches/squeeze/libjifty-dbi-perl/debian/changelog?rev=72831&op=diff
==============================================================================
--- branches/squeeze/libjifty-dbi-perl/debian/changelog (original)
+++ branches/squeeze/libjifty-dbi-perl/debian/changelog Tue Apr 19 21:59:33 2011
@@ -1,3 +1,11 @@
+libjifty-dbi-perl (0.60-1+squeeze1) UNRELEASED; urgency=high
+
+  * Team upload.
+  * [SECURITY] Apply patch prepared by upstream that backports fixes for SQL
+    injection weaknesses (closes: #622919).
+
+ -- gregor herrmann <gregoa at debian.org>  Tue, 19 Apr 2011 23:53:52 +0200
+
 libjifty-dbi-perl (0.60-1) unstable; urgency=low
 
   [ Jonathan Yu ]

Modified: branches/squeeze/libjifty-dbi-perl/lib/Jifty/DBI/Collection.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/squeeze/libjifty-dbi-perl/lib/Jifty/DBI/Collection.pm?rev=72831&op=diff
==============================================================================
--- branches/squeeze/libjifty-dbi-perl/lib/Jifty/DBI/Collection.pm (original)
+++ branches/squeeze/libjifty-dbi-perl/lib/Jifty/DBI/Collection.pm Tue Apr 19 21:59:33 2011
@@ -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.
-
-TODO: Why are they lowercased?
+Return a list of columns in table, in lowercase.
+
+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

Modified: branches/squeeze/libjifty-dbi-perl/lib/Jifty/DBI/Handle/Oracle.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/squeeze/libjifty-dbi-perl/lib/Jifty/DBI/Handle/Oracle.pm?rev=72831&op=diff
==============================================================================
--- branches/squeeze/libjifty-dbi-perl/lib/Jifty/DBI/Handle/Oracle.pm (original)
+++ branches/squeeze/libjifty-dbi-perl/lib/Jifty/DBI/Handle/Oracle.pm Tue Apr 19 21:59:33 2011
@@ -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;
     }

Modified: branches/squeeze/libjifty-dbi-perl/lib/Jifty/DBI/Handle/Pg.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/squeeze/libjifty-dbi-perl/lib/Jifty/DBI/Handle/Pg.pm?rev=72831&op=diff
==============================================================================
--- branches/squeeze/libjifty-dbi-perl/lib/Jifty/DBI/Handle/Pg.pm (original)
+++ branches/squeeze/libjifty-dbi-perl/lib/Jifty/DBI/Handle/Pg.pm Tue Apr 19 21:59:33 2011
@@ -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-cvs-commits mailing list