Hi!
I recently stumbled over some behaviour that was quite surprising to me: When I
pass a hash ref to a column accessor (or set_column), it gets passed on to
SQL::Abstract, despite the following in the docs:
http://search.cpan.org/~ribasushi/DBIx-Class/lib/DBIx/Class/Row.pm#set_column
> If passed an object or reference as a value, this method will happily attempt
> to store it, and a later "insert" or "update" will try and stringify/numify
> as appropriate.
I was expecting something like 'cannot bind a reference' or 'HASH(0x...)' ends
up being stored in the column, but instead SQL::Abstract crashed with
"SQL::Abstract::puke(): [SQL::Abstract::__ANON__] Fatal: Operator calls in
update must be in the form { -op => $arg }"
The reason I am concerned about this is because I am developing a web app that
exposes a JSON API. In the update controllers I do something quite naive (but
fairly common, I'm afraid), like:
my $rs = $schema->resultset('Object')->find($self->param('id'));
$rs->$_($json->{$_}) for qw/name .../;
$rs->update;
If someone gets the idea to send some creative JSON like this:
{ "whatever": { "-(select password from users where upper(username)='admin')":
null } }
SQL::Abstract happily translates this to:
UPDATE table SET whatever=(SELECT PASSWORD FROM USERS WHERE
UPPER(USERNAME)='ADMIN') WHERE...
and now I have the admin password in column whatever of a row I have access to,
for example.
As far as I was able to dive down into SQL::Abstract, this might be due to some
quirk of handling undef values (so it does not produce "(SELECT...) IS NULL" or
something that would break the SQL).
This does not work when doing inserts - here it does what I expect: HASH(0x...)
gets stored as value in the column. SQL::Abstract warns:
SQL::Abstract::belch(): [SQL::Abstract::__ANON__] Warning: HASH ref as bind
value in insert is not supported
It does not replace sanitising user input (which I should do!), but maybe
either the documentation should be changed or the handling of references in
store_column. My quick fix for my application was to override store_column and
die if it gets a reference (for data_types that shouldn't get them).
I have attached a short example using Mojolicious. You can run it with:
perl dbictest.pl get -M POST -H 'Content-Type: text/json' -c '{ "whatever": {
"-(select password from users where upper(username)='"'admin'"')": null } }'
/todo/hack
Ciao,
Heinz
#!/usr/bin/env perl
# perl dbictest.pl get -M POST -H 'Content-Type: text/json' -c '{ "whatever": { "-(select password from users where upper(username)='"'admin'"')": null } }' /todo/hack
# perl dbictest.pl get -M POST -H 'Content-Type: text/json' -c '{ "name": "nothack", "whatever": { "-(select password from users where upper(username)='"'admin'"')": null } }' /todo
use Mojolicious::Lite;
use Mojo::JSON qw/encode_json decode_json/;
use Modern::Perl '2015';
{
package DbicTest::Schema::Todo;
use base 'DBIx::Class::Core';
__PACKAGE__->table('todo');
__PACKAGE__->add_columns(
name => { data_type => 'text'},
whatever => { data_type => 'text'},
);
__PACKAGE__->set_primary_key('name');
sub __set_column {
my $self = shift;
my $col = $_[0];
if ((my $i = $self->result_source->column_info($col)) && ref $_[1]) {
die 'no references for '.$col.' '.$i->{data_type} unless $i->{data_type} eq 'jsonb';
}
$self->SUPER::store_column(@_);
}
package DbicTest::Schema::User;
use base 'DBIx::Class::Core';
__PACKAGE__->table('users');
__PACKAGE__->add_columns(
username => { data_type => 'text' },
password => { data_type => 'text' },
);
__PACKAGE__->set_primary_key('username');
package DbicTest::Schema;
use base 'DBIx::Class::Schema';
__PACKAGE__->register_class(Todo => 'DbicTest::Schema::Todo');
__PACKAGE__->register_class(User => 'DbicTest::Schema::User');
}
package main;
my $schema = DbicTest::Schema->connect('dbi:SQLite:./test.db');
$schema->deploy({ add_drop_table => 1 });
$schema->resultset('User')->create({
username => 'admin', password => 'supersecrethash',
});
$schema->resultset('User')->create({
username => 'sneaky', password => 'moo',
});
$schema->resultset('Todo')->create({
name => 'hack', whatever => 'hack the world!',
});
get '/todo' => sub {
my $c = shift;
my @ret = map {
{ name => $_->name, whatever => $_->whatever }
} $schema->resultset('Todo')->all;
$c->render(json => \@ret);
};
post '/todo' => sub {
my $c = shift;
my $json = decode_json $c->req->body || die 'unable to decode';
my $res = $schema->resultset('Todo')->new({});
$res->$_($json->{$_}) for qw/name whatever/;
$res->insert;
$res->discard_changes;
$c->render(json => { name => $res->name, whatever => $res->whatever });
};
post '/todo/:name' => sub {
my $c = shift;
my $json = decode_json $c->req->body || die 'unable to decode';
my $res = $schema->resultset('Todo')->find($c->param('name')) || die 'not found';
$res->whatever($json->{whatever});
#$res->set_column('whatever', $json->{whatever});
$res->update;
$res->discard_changes;
$c->render(json => { name => $res->name, whatever => $res->whatever });
};
app->start;
__DATA__
@@ exception.development.html.ep
<!DOCTYPE html>
<html>
<head><title>Server error</title></head>
<body>
<h1>Exception</h1>
<p><%= $exception->message %></p>
<h1>Stash</h1>
<pre><%= dumper $snapshot %></pre>
</body>
</html>
_______________________________________________
List: http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/dbix-class
IRC: irc.perl.org#dbix-class
SVN: http://dev.catalyst.perl.org/repos/bast/DBIx-Class/
Searchable Archive: http://www.grokbase.com/group/dbix-class@lists.scsys.co.uk
