SQL: Add IDENT() and quote_identifier options

Turns out VNDB has a few places where request data is directly used for
column names in VALUES/SET/WHERE clauses. These are already restricted
to known strings through the use of FU::Validate, but an extra layer of
protection seems warranted here.

FU/SQL.pm

@@ -5,7 +5,7 @@ use Carp 'confess';
 use experimental 'builtin', 'for_list';
 
 our @EXPORT = qw/
-    P RAW SQL
+    P RAW IDENT SQL
     PARENS INTERSPERSE COMMA
     AND OR WHERE
     SET VALUES IN
@@ -16,6 +16,7 @@ sub _obj { bless [@_], 'FU::SQL::val' }
 
 sub P :prototype($) ($p) { bless \(my $x = $p), 'FU::SQL::p' }
 sub RAW :prototype($) ($s) { _obj "$s" }
+sub IDENT :prototype($) ($s) { bless \(my $x = "$s"), 'FU::SQL::i' }
 
 # These operate on $_ and must be called with &func syntax.
 # The readonly check can be finicky.
@@ -29,7 +30,7 @@ sub COMMA { INTERSPERSE ',', @_ }
 
 sub _conditions {
     @_ == 1 && ref $_[0] eq 'HASH'
-    ? map PARENS(RAW $_,
+    ? map PARENS(IDENT $_,
         !defined $_[0]{$_}              ? ('IS NULL') :
         ref($_[0]{$_}) eq 'FU::SQL::in' ? ($_[0]{$_})
                                         : ('=', $_[0]{$_})
@@ -41,11 +42,11 @@ sub AND { !@_ || (@_ == 1 && ref $_[0] eq 'HASH' && keys $_[0]->%* == 0) ? RAW '
 sub OR  { !@_ || (@_ == 1 && ref $_[0] eq 'HASH' && keys $_[0]->%* == 0) ? RAW '1=0' : INTERSPERSE 'OR',  _conditions @_ }
 sub WHERE { SQL 'WHERE', AND @_ }
 
-sub SET($h) { SQL 'SET', COMMA map SQL(RAW $_, '=', $h->{$_}), sort keys %$h }
+sub SET($h) { SQL 'SET', COMMA map SQL(IDENT $_, '=', $h->{$_}), sort keys %$h }
 
 sub VALUES {
     @_ == 1 && ref $_[0] eq 'HASH'
-    ? SQL '(', COMMA(map RAW $_, sort keys $_[0]->%*), ') VALUES (', COMMA(map $_[0]{$_}, sort keys $_[0]->%*), ')'
+    ? SQL '(', COMMA(map IDENT $_, sort keys $_[0]->%*), ') VALUES (', COMMA(map $_[0]{$_}, sort keys $_[0]->%*), ')'
     : @_ == 1 && ref $_[0] eq 'ARRAY'
     ? SQL 'VALUES (', COMMA($_[0]->@*), ')'
     : SQL 'VALUES (', COMMA(@_), ')';
@@ -71,6 +72,10 @@ sub FU::SQL::p::_compile($self, $opt, $sql, $params) {
     $$sql .= $opt->{placeholder_style} eq 'pg' ? '$'.@$params : '?';
 }
 
+sub FU::SQL::i::_compile($self, $opt, $sql, $params) {
+    $$sql .= $opt->{quote_identifier} ? $opt->{quote_identifier}->($$self) : $$self;
+}
+
 sub FU::SQL::in::_compile($self, $opt, $sql, $params) {
     if ($opt->{in_style} eq 'pg') {
         $$sql .= '= ANY(';
@@ -87,6 +92,7 @@ sub FU::SQL::in::_compile($self, $opt, $sql, $params) {
 }
 
 sub FU::SQL::val::compile($self, %opt) {
+    !/^(placeholder_style|in_style|quote_identifier)$/ && confess "Unknown flag: $_" for keys %opt;
     $opt{placeholder_style} ||= 'dbi';
     $opt{in_style} ||= 'dbi';
     my($sql, @params) = ('');
@@ -94,7 +100,7 @@ sub FU::SQL::val::compile($self, %opt) {
     ($sql, \@params)
 }
 
-*FU::SQL::p::compile = *FU::SQL::in::compile = \*FU::SQL::val::compile;
+*FU::SQL::p::compile = *FU::SQL::i::compile = *FU::SQL::in::compile = \*FU::SQL::val::compile;
 
 1;
 __END__
@@ -156,6 +162,16 @@ C<'pg'> when your SQL is going to L<FU::Pg> or L<Pg::PQ>.
 Set the style to use for C<IN> expressions, refer to the C<IN()> function below
 for details.
 
+=item quote_identifier => $func
+
+Set a function to perform quoting of SQL identifiers. When using DBI, you can
+do:
+
+  my($sql) = $obj->compile(quote_identifier => sub { $dbh->quote_identifier(@_) });
+
+If this option is not set, identifiers are included into the raw SQL string
+without any escaping.
+
 =back
 
 =back
@@ -176,7 +192,7 @@ types of supported arguments:
 
 =item 1.
 
-B<String literals> are interpreted as raw SQL fragments.
+I<String literals> are interpreted as raw SQL fragments.
 
 =item 2.
 
@@ -184,7 +200,7 @@ Objects returned by other functions listed below are included as SQL fragments.
 
 =item 3.
 
-B<Everything else> is considered a bind parameter.
+I<Everything else> is considered a bind parameter.
 
 =back
 
@@ -244,6 +260,18 @@ Force the given C<$sql> string to be included as SQL. For example:
 
 Never use this function with untrusted input.
 
+=item IDENT($string)
+
+Mark the given string as an SQL identifier. This function is only useful if you
+use potentially untrusted input to determine which column to select or which
+table to select from, for example:
+
+  SQL 'SELECT id,', IDENT $ENV{column}, 'FROM table';
+
+B<WARNING:> By default this function is equivalent to C<RAW()> and hence
+provides no safety whatsoever. Be sure to set the C<quote_identifier> option on
+C<compile()> to get more useful behavior.
+
 =item PARENS(@args)
 
 Like C<SQL()> but surrounds the expression by parens:
@@ -279,8 +307,8 @@ C<'1=1'> (i.e. true) if C<@conditions> is an empty list.
 =item AND($hashref)
 
 A special form of C<AND()> that tests the given columns for equality instead.
-The keys of the hashref are interpreted as raw SQL and the values as bind
+The keys of the hashref are interpreted as per C<IDENT()> and the values as
-parameters.
+bind parameters.
 
   AND { id => 1, number => RAW 'random()', x => undef }
   # '( id = ? ) AND ( number = random() ) AND ( x IS NULL )'

t/sql.t

@@ -9,11 +9,15 @@ sub t($obj, $sql, $params, @opt) {
     is_deeply $gotparams, $params;
 }
 
+my @q_ident = (quote_identifier => sub($x) { $x =~ s/"/_/rg });
+
 my $x;
 t P '', '?', [''];
 t P '', '$1', [''], placeholder_style => 'pg';
 t P undef, '?', [undef];
 t RAW '', '', [];
+t IDENT '"hello"', '"hello"', [];
+t IDENT '"hello"', '_hello_', [], @q_ident;
 t SQL('select', '1'), 'select 1', [];
 t SQL('select', P '1'), 'select ?', [1];
 t SQL('select', $x = '1'), 'select ?', [1];
@@ -41,6 +45,7 @@ t WHERE($x, '1 = 2', SQL('x = ', $x)),
 t WHERE({ col1 => RAW 'NOW()', col2 => 'a'}),
   'WHERE ( col1 = NOW() ) AND ( col2 = ? )', ['a'];
 t WHERE(), 'WHERE 1=1', [];
+t WHERE({ '"x' => 1 }), 'WHERE ( _x = ? )', [1], @q_ident;
 
 t WHERE(AND('true', $x), OR($y, 'y'), AND, OR),
   'WHERE ( ( true ) AND ( ? ) ) AND ( ( ? ) OR ( y ) ) AND ( 1=1 ) AND ( 1=0 )', [$x, $y];
@@ -52,9 +57,11 @@ t SQL(SELECT => COMMA(qw/a b c/), FROM => 'table', WHERE { x => 1, a => undef })
 
 t SET({ a => 1, c => RAW 'NOW()', d => undef }),
   'SET a = ? , c = NOW() , d = ?', [1, undef];
+t SET({ '"x' => 1 }), 'SET _x = ?', [1], @q_ident;
 
 t VALUES({ a => 1, c => RAW 'NOW()', d => undef }),
   '( a , c , d ) VALUES ( ? , NOW() , ? )', [1, undef];
+t VALUES({ '"x' => 1 }), '( _x ) VALUES ( ? )', [1], @q_ident;
 
 t VALUES(1, $x, 'NOW()', RAW 'NOW()'), 'VALUES ( ? , ? , NOW() , NOW() )', [1, $x];
 t VALUES([1, $x, 'NOW()', RAW 'NOW()']), 'VALUES ( ? , ? , ? , NOW() )', [1, $x, 'NOW()'];
@@ -86,4 +93,7 @@ Hash::Util::lock_keys(%hash);
 Hash::Util::lock_value(%hash, 'v');
 t SQL($hash{v}), 'value', [];
 
+ok !eval { SQL('')->compile(oops => 1); 1 };
+like $@, qr/Unknown flag: oops/;
+
 done_testing;