File Coverage

blib/lib/Perl/Critic/Policy/ValuesAndExpressions/PreventSQLInjection.pm
Criterion Covered Total %
statement 183 187 97.8
branch 105 120 87.5
condition 54 71 76.0
subroutine 27 28 96.4
pod 16 16 100.0
total 385 422 91.2


line stmt bran cond sub pod time code
1             package Perl::Critic::Policy::ValuesAndExpressions::PreventSQLInjection;
2              
3 12     12   2610807 use 5.006001;
  12         134  
4 12     12   72 use strict;
  12         27  
  12         241  
5 12     12   63 use warnings;
  12         34  
  12         664  
6              
7             our $VERSION = '2.000001';
8              
9 12     12   83 use base 'Perl::Critic::Policy';
  12         36  
  12         7218  
10              
11 12     12   694814 use Carp qw( croak );
  12         45  
  12         565  
12 12     12   84 use Perl::Critic::Utils qw( $TRUE );
  12         27  
  12         1001  
13 12     12   6995 use PPIx::QuoteLike 0.015 ();
  12         2297320  
  12         400  
14 12     12   112 use Readonly ();
  12         45  
  12         193  
15 12     12   5733 use String::InterpolatedVariables ();
  12         4458  
  12         347  
16 12     12   6235 use Try::Tiny qw( catch try );
  12         24869  
  12         33887  
17              
18              
19             Readonly::Scalar my $DESCRIPTION => 'SQL injection risk.';
20             Readonly::Scalar my $EXPLANATION =>
21             'Variables in interpolated SQL string are susceptible to SQL injection: %s';
22              
23             # Default for the name of the methods that make a variable safe to use in SQL
24             # strings.
25             Readonly::Scalar my $QUOTING_METHODS_DEFAULT => q|
26             quote_identifier
27             quote
28             |;
29              
30             # Default for the name of the packages and functions / class methods that are safe to
31             # concatenate to SQL strings.
32             Readonly::Scalar my $SAFE_FUNCTIONS_DEFAULT => q|
33             |;
34              
35             # Default for the name of the functions that are generally safe to use (because they
36             # are not expected to generate SQL calls -- unless you are doing something really,
37             # really weird.)
38             Readonly::Scalar my $SAFE_CONTEXT_DEFAULT => q|
39             die
40             warn
41             carp
42             croak
43             confess
44             |;
45              
46             # Regex to detect comments like ## SQL safe ($var1, $var2).
47             Readonly::Scalar my $SQL_SAFE_COMMENTS_REGEX => qr/
48             \A
49             (?: [#]! .*? )?
50             \s*
51             # Find the ## annotation starter.
52             [#][#]
53             \s*
54             # "SQL safe" is our keyword.
55             SQL \s+ safe
56             \s*
57             # List of safe variables between parentheses.
58             \(\s*(.*?)\s*\)
59             /ixms;
60              
61              
62             sub supported_parameters {
63             return (
64             {
65 74     74 1 1050133 name => 'quoting_methods',
66             description =>
67             'A space-separated string listing the methods that return a safely quoted value.',
68             default_string => $QUOTING_METHODS_DEFAULT,
69             behavior => 'string',
70             },
71             {
72             name => 'safe_functions',
73             description =>
74             'A space-separated string listing the functions that return a safely quoted value',
75             default_string => $SAFE_FUNCTIONS_DEFAULT,
76             behavior => 'string',
77             },
78             {
79             name => 'safe_context',
80             description =>
81             'A space-separated string listing the functions that are not subject to SQL injections',
82             default_string => $SAFE_CONTEXT_DEFAULT,
83             behavior => 'string',
84             },
85             {
86             name => 'prefer_upper_case_keywords',
87             description =>
88             'Match on SELECT, UPDATE, INSERT, DELETE but not on their lower or mixed case variants',
89             default_string => '0',
90             behavior => 'boolean',
91             },
92             );
93             }
94              
95              
96             sub default_severity {
97 36     36 1 694 return $Perl::Critic::Utils::SEVERITY_HIGHEST;
98             }
99              
100              
101             sub default_themes {
102 1     1 1 684 return qw( security );
103             }
104              
105              
106             sub applies_to {
107 75     75 1 1991 return qw(
108             PPI::Token::Quote
109             PPI::Token::HereDoc
110             );
111             }
112              
113              
114             sub prepare_to_scan_document {
115 75     75 1 959137 my $self = shift;
116 75         316 delete $self->{'_sqlsafe'};
117 75         288 return $TRUE;
118             }
119              
120              
121             sub violates {
122 116     116 1 7482 my ( $self, $element, $doc ) = @_;
123              
124 116         621 parse_config_parameters($self);
125              
126 116         519 parse_comments( $self, $doc );
127              
128             # Make sure the first string looks like a SQL statement before investigating
129             # further.
130             return ()
131 116 100       604 if !$self->is_sql_statement($element);
132              
133             # Skip this statement if we are in a safe context (e.g., die "string")
134             return ()
135 79 100       380 if $self->is_in_safe_context($element);
136              
137             # Find SQL injection vulnerabilities.
138 69         397 my $sql_injections = detect_sql_injections( $self, $element );
139              
140             # Return violations if any.
141 69 100 66     961 return defined($sql_injections) && scalar(@$sql_injections) != 0
142             ? $self->violation(
143             $DESCRIPTION,
144             sprintf(
145             $EXPLANATION,
146             join( ', ', @$sql_injections ),
147             ),
148             $element,
149             )
150             : ();
151             }
152              
153              
154             sub detect_sql_injections {
155 69     69 1 291 my ( $self, $element ) = @_;
156              
157 69         187 my $sql_injections = [];
158 69         201 my $token = $element;
159 69   66     501 while ( defined($token) && $token ne '' ) {
160             ## no critic (ControlStructures::ProhibitCascadingIfElse)
161              
162             # If the token is a string, we need to analyze it for interpolated
163             # variables.
164 336 100 100     20866 if ( $token->isa('PPI::Token::HereDoc')
    100 100        
    100 66        
    100 100        
    100 100        
    100          
    100          
165             || $token->isa('PPI::Token::Quote')
166             ) ## no critic (ControlStructures::ProhibitCascadingIfElse)
167             {
168             push(
169             @$sql_injections,
170 93 50       339 @{ analyze_string_injections( $self, $token ) || [] }
  93         417  
171             );
172             }
173              
174             # If it is a concatenation operator, continue to the next token.
175             elsif ($token->isa('PPI::Token::Operator')
176             && $token->content() eq '.' ) {
177              
178             # Skip to the next token.
179             }
180              
181             # If it is a semicolon, we're at the end of the statement and we can finish
182             # the process.
183             elsif ($token->isa('PPI::Token::Structure')
184             && $token->content() eq ';' ) {
185 56         553 last;
186             }
187              
188             # If we detect a ':' operator, we're at the end of the second argument in a
189             # ternary "... ? ... : ..." and we need to finish the process here as the
190             # third argument is not concatenated to the this string and will be
191             # analyzed separately.
192             elsif ($token->isa('PPI::Token::Operator')
193             && $token->content() eq ':' ) {
194 3         62 last;
195             }
196              
197             # If it is a list-separating comma, this list element ends here and we can
198             # finish the process.
199             elsif ($token->isa('PPI::Token::Operator')
200             && $token->content() eq ',' ) {
201 1         41 last;
202             }
203              
204             # If it is a symbol, it is concatenated to a SQL statement which is an
205             # injection risk.
206             elsif ( $token->isa('PPI::Token::Symbol') ) {
207 25         131 my ( $variable, $is_quoted )
208             = get_complete_variable( $self, $token );
209 25 100       100 if ( !$is_quoted ) {
210 19         80 my $safe_elements
211             = get_safe_elements( $self, $token->line_number() );
212             push( @$sql_injections, $variable )
213 19 100       131 if !exists( $safe_elements->{$variable} );
214             }
215             }
216              
217             # If it is a word, it may be a function/method call on a package, which is
218             # an injection risk.
219             elsif ( $token->isa('PPI::Token::Word') ) {
220              
221             # Find out if the PPO::Token::Word is the beginning of a call or not.
222 25         122 my ( $function_name, $is_quoted )
223             = get_function_name( $self, $token );
224 25 100 100     266 if ( defined($function_name) && !$is_quoted ) {
225 9         46 my $safe_elements
226             = get_safe_elements( $self, $token->line_number() );
227             push( @$sql_injections, $function_name )
228 9 100       64 if !exists( $safe_elements->{ '&' . $function_name } );
229             }
230             }
231              
232             # Move to examining the next sibling token.
233 276         3471 $token = $token->snext_sibling();
234             }
235              
236 69         723 return $sql_injections;
237             }
238              
239              
240             sub get_function_name {
241 25     25 1 80 my ( $self, $token ) = @_;
242              
243 25 50       123 croak 'The first parameter needs to be a PPI::Token::Word object'
244             if !$token->isa('PPI::Token::Word');
245              
246 25         90 my $next_sibling = $token->snext_sibling();
247             return ()
248 25 50 33     872 if !defined($next_sibling) || ( $next_sibling eq '' );
249              
250 25         1213 my ( $package, $function_name );
251              
252             # Catch Package::Name->method().
253 25 100 66     113 if ( $next_sibling->isa('PPI::Token::Operator')
    100          
254             && ( $next_sibling->content() eq '->' ) ) {
255 6         59 my $function = $next_sibling->snext_sibling();
256              
257             return ()
258 6 50 33     227 if !defined($function) || ( $function eq '' );
259             return ()
260 6 100       157 if !$function->isa('PPI::Token::Word');
261              
262 4         17 $package = $token->content();
263 4         26 $function_name = $function->content();
264              
265 4         26 $function->{'_handled'} = 1;
266             }
267              
268             # Catch Package::Name::function().
269             elsif ( $next_sibling->isa('PPI::Structure::List') ) {
270              
271             # Package::Name->method() will result in two PPI::Token::Word being
272             # detected, one for 'Package::Name' and one for 'method'. 'Package::Name'
273             # will be caught in the if() block above, but 'method' would get caught
274             # separately by this block. To prevent this, we scan the previous sibling
275             # here and skip if we find that it is a '->' operator.
276 18         319 my $previous_sibling = $token->sprevious_sibling();
277             return ()
278 18 100 66     769 if $previous_sibling->isa('PPI::Token::Operator')
279             && ( $previous_sibling->content() eq '->' );
280              
281 6         71 my $content = $token->content();
282              
283             # Catch function calls in the same namespace.
284 6 100       49 if ( $content !~ /::/ ) {
285 3         14 ( $package, $function_name ) = ( undef, $content );
286             }
287              
288             # Catch function calls in a different namespace.
289             else {
290 3         34 ( $package, $function_name ) = $content =~ /^(.*)::([^:]+)$/;
291             }
292             }
293             else {
294 1         5 return ();
295             }
296              
297             my $full_name
298 10         43 = join( '::', grep { defined($_) } ( $package, $function_name ) );
  20         72  
299             my $is_safe
300             = defined( $self->{'_safe_functions_regex'} )
301 10 100 66     118 && ( $full_name =~ $self->{'_safe_functions_regex'} )
302             ? 1
303             : 0;
304 10         58 return ( $full_name, $is_safe );
305             }
306              
307              
308             sub get_complete_variable {
309 25     25 1 89 my ( $self, $token ) = @_;
310              
311 25 50       134 croak 'The first parameter needs to be a PPI::Token::Symbol object'
312             if !$token->isa('PPI::Token::Symbol');
313              
314 25         89 my $variable = $token->content();
315 25         148 my $is_quoted = 0;
316 25         70 my $sibling = $token;
317 25         60 while (1) {
318 64         656 $sibling = $sibling->next_sibling();
319 64 50 33     2155 last if !defined($sibling) || ( $sibling eq '' );
320              
321 64 100 66     2021 if ( $sibling->isa('PPI::Token::Operator')
    100 66        
    100 100        
      100        
322             && $sibling->content() eq '->' ) {
323 22         188 $variable .= '->';
324             }
325             elsif ( $sibling->isa('PPI::Structure::Subscript') ) {
326 17         56 $variable .= $sibling->content();
327             }
328             elsif ($sibling->isa('PPI::Token::Word')
329             && $sibling->method_call()
330             && defined( $self->{'_quoting_methods_regex'} )
331             && ( $sibling->content =~ $self->{'_quoting_methods_regex'} ) ) {
332 6         390 $is_quoted = 1;
333 6         18 last;
334             }
335             else {
336 19         241 last;
337             }
338             }
339              
340 25         124 return ( $variable, $is_quoted );
341             }
342              
343              
344             sub is_sql_statement {
345 116     116 1 445 my ( $self, $token ) = @_;
346              
347 116         335 my $probably_sql = 0;
348 116 100 100     743 if ( $token->isa('PPI::Token::HereDoc')
      100        
349             && ( $token eq q{<<"SQL"} || $token eq q{<<SQL} ) ) {
350 4         155 $probably_sql = 1;
351             }
352              
353 116         765 my $content = get_token_content($token);
354              
355 116 100 100     2428 if ( !$probably_sql && $self->{_prefer_upper_case_keywords} ) {
356 2         19 return $content
357             =~ m{^ \s* (?: SELECT | INSERT | UPDATE | DELETE | ALTER | DROP | CREATE ) \b}sx;
358             }
359              
360 114         1093 return $content
361             =~ m{^ \s* (?: SELECT | INSERT | UPDATE | DELETE | ALTER | DROP | CREATE ) \b}six;
362             }
363              
364              
365             sub is_in_safe_context {
366 79     79 1 270 my ( $self, $token ) = @_;
367              
368 79 50       303 return 0 if !$self->{'_safe_context_regex'};
369              
370 79         492 my $sprevious_sibling = $token->sprevious_sibling;
371              
372 79 100 66     4117 return 0 if !defined $sprevious_sibling || $sprevious_sibling eq '';
373 78 100       2378 return 0 if !$sprevious_sibling->isa('PPI::Token::Word');
374              
375 11         179 return $sprevious_sibling->{content} =~ $self->{'_safe_context_regex'};
376             }
377              
378              
379             sub get_token_content {
380 188     188 1 478 my ($token) = @_;
381              
382             # Retrieve the string's content.
383 188 100       1092 if ( $token->isa('PPI::Token::HereDoc') ) {
    50          
384 22         88 return join( '', $token->heredoc );
385             }
386             elsif ( $token->isa('PPI::Token::Quote') ) {
387              
388             # ->string() strips off the leading and trailing quotation signs.
389 166         936 return $token->string();
390             }
391              
392 0         0 return $token->content();
393             }
394              
395              
396             sub analyze_string_injections {
397 93     93 1 332 my ( $policy, $token ) = @_;
398              
399             my $sql_injections = try {
400              
401             # Single quoted strings aren't prone to SQL injection.
402             return
403 93 100   93   7284 if $token->isa('PPI::Token::Quote::Single');
404              
405             # PPI treats HereDoc differently than Quote and QuoteLike for the moment,
406             # this may however change in the future according to the documentation of
407             # PPI.
408 72         366 my $is_heredoc = $token->isa('PPI::Token::HereDoc');
409              
410             # Retrieve the string's content.
411 72         225 my $content = get_token_content($token);
412              
413             # Find the list of variables marked as safe using "## SQL safe".
414             # Note: comments will appear at the end of the token, so we need to
415             # determine the ending line number instead of the beginning line
416             # number.
417 72         1016 my $extra_height_span = () = $content =~ /\n/g;
418 72 100       378 my $safe_elements = get_safe_elements(
419             $policy, #$self
420             $token->line_number()
421              
422             # Heredoc comments will be on the same line as the opening marker.
423             + ( $is_heredoc ? 0 : $extra_height_span ),
424             );
425              
426             # Find all the variables that appear in the string.
427 72         295 my @variables = @{ String::InterpolatedVariables::extract($content) };
  72         419  
428              
429             # Turn ${foo}, @{foo} and %{foo} into $foo, @foo and %foo.
430 72         2986 my @vars;
431 72         245 for my $var (@variables) {
432 43 100       187 if ( $var =~ m/^( \$ |@ |% ) \{ \s* ( \w+ ) \s* \}$/x ) {
433 1         6 $var = $1 . $2;
434             }
435 43         160 push @vars, $var;
436             }
437              
438             # Find all the variables that appear in the string.
439 72         237 my $unsafe_variables = [ grep { !$safe_elements->{$_} } @vars ];
  43         212  
440              
441             # Based on the token type, determine if it is interpolated and report any
442             # unsafe variables.
443 72 100       405 if ( $token->isa('PPI::Token::Quote::Double') ) {
    100          
    50          
444 61 100       299 return $unsafe_variables
445             if scalar(@$unsafe_variables) != 0;
446             }
447             elsif ( $token->isa('PPI::Token::Quote::Interpolate') ) {
448 1         6 my $raw_content = $token->content();
449 1         11 my ($lead) = $raw_content =~ /\A(qq?)([^q])/s;
450 1 50       6 croak "Unknown format for >$raw_content<"
451             if !defined($lead);
452              
453             # Skip single quoted strings.
454 1 50       6 return if $lead eq 'q';
455              
456 1 50       72 return $unsafe_variables
457             if scalar(@$unsafe_variables) != 0;
458             }
459             elsif ($is_heredoc) {
460 10         101 my $str = PPIx::QuoteLike->new($token);
461 10 100       19054 return unless $str->interpolates;
462              
463 9 100       285 return $unsafe_variables
464             if scalar(@$unsafe_variables) != 0;
465             }
466              
467 52         283 return;
468             }
469             catch {
470 0     0   0 print STDERR "Error: $_\n";
471 0         0 return;
472 93         1269 };
473              
474 93 100       3309 return defined($sql_injections)
475             ? $sql_injections
476             : [];
477             }
478              
479              
480             sub get_safe_elements {
481 100     100 1 2788 my ( $self, $line_number ) = @_;
482              
483             # Validate input and state.
484             croak 'Parsed comments not found'
485 100 50       418 if !defined( $self->{'_sqlsafe'} );
486 100 50 33     970 croak 'A line number is mandatory'
487             if !defined($line_number) || ( $line_number !~ /\A\d+\Z/ );
488              
489             # If there's nothing in the cache for that line, return immediately.
490             return {}
491 100 100       459 if !exists( $self->{'_sqlsafe'}->{$line_number} );
492              
493             # Return a hash of safe element names.
494 42         115 return { map { $_ => 1 } @{ $self->{'_sqlsafe'}->{$line_number} } };
  56         355  
  42         155  
495             }
496              
497              
498             sub parse_comments {
499 116     116 1 435 my ( $self, $doc ) = @_;
500              
501             # Only parse if we haven't done so already.
502             return
503 116 100       455 if defined( $self->{'_sqlsafe'} );
504              
505             # Parse all the comments for this document.
506 75         301 $self->{'_sqlsafe'} = {};
507 75   100     375 my $comments = $doc->find('PPI::Token::Comment') || [];
508 75         1262 foreach my $comment (@$comments) {
509              
510             # Determine if the line is a "SQL safe" comment.
511 29         307 my ($safe_elements) = $comment =~ $SQL_SAFE_COMMENTS_REGEX;
512 29 100       532 next if !defined($safe_elements);
513              
514             # Store list of safe elements for that line.
515             push(
516 27         74 @{ $self->{'_sqlsafe'}->{ $comment->line_number() } },
  27         351  
517             split( /[\s,]+(?=[\$\@\%\&])/, $safe_elements )
518             );
519             }
520              
521             #print STDERR "SQL safe elements: ", Dumper( $self->{'_sqlsafe'} ), "\n";
522 75         1050 return;
523             }
524              
525              
526             sub parse_config_parameters {
527 116     116 1 396 my ($self) = @_;
528              
529 116 100       564 if ( !exists( $self->{'_quoting_methods_regex'} ) ) {
530 74 100       649 if ( $self->{'_quoting_methods'} =~ /\w/ ) {
531             my $regex_components = join(
532             '|',
533 215         1061 grep { $_ =~ /\w/ }
534 73         986 split( /,?\s+/, $self->{'_quoting_methods'} )
535             );
536 73         853 $self->{'_quoting_methods_regex'} = qr/^(?:$regex_components)$/x;
537             }
538             else {
539 1         4 $self->{'_quoting_methods_regex'} = undef;
540             }
541             }
542              
543 116 100       482 if ( !exists( $self->{'_safe_functions_regex'} ) ) {
544 74 100       470 if ( $self->{'_safe_functions'} =~ /\w/ ) {
545             my $regex_components = join(
546             '|',
547 1         7 grep { $_ =~ /\w/ }
548 1         8 split( /,?\s+/, $self->{'_safe_functions'} )
549             );
550 1         35 $self->{'_safe_functions_regex'} = qr/^(?:$regex_components)$/x;
551             }
552             else {
553 73         346 $self->{'_safe_functions_regex'} = undef;
554             }
555             }
556              
557 116 100       520 if ( !exists( $self->{'_safe_context_regex'} ) ) {
558 74 50       394 if ( $self->{'_safe_context'} =~ /\w/ ) {
559             my $regex_components = join(
560             '|',
561 444         1429 grep { $_ =~ /\w/ }
562 74         840 split( /,?\s+/, $self->{'_safe_context'} )
563             );
564 74         647 $self->{'_safe_context_regex'} = qr/^(?:$regex_components)$/x;
565             }
566             else {
567 0         0 $self->{'_safe_context_regex'} = undef;
568             }
569             }
570              
571 116         366 return;
572             }
573              
574              
575             1;
576              
577             # ABSTRACT: Prevent SQL injection in interpolated strings.
578              
579             __END__
580              
581             =pod
582              
583             =encoding UTF-8
584              
585             =head1 NAME
586              
587             Perl::Critic::Policy::ValuesAndExpressions::PreventSQLInjection - Prevent SQL injection in interpolated strings.
588              
589             =head1 VERSION
590              
591             version 2.000001
592              
593             =head1 DESCRIPTION
594              
595             When building SQL statements manually instead of using an ORM, any input must
596             be quoted or passed using placeholders to prevent the introduction of SQL
597             injection vectors. This policy attempts to detect the most common sources of
598             SQL injection in manually crafted SQL statements, by detecting the use of
599             variables inside interpolated strings that look like SQL statements.
600              
601             In other words, this policy searches for code such as:
602              
603             my $sql = "SELECT * FROM $table WHERE field = $value";
604              
605             But would leave alone:
606              
607             my $string = "Hello $world";
608              
609             =head1 AFFILIATION
610              
611             This is a standalone policy not part of a larger PerlCritic Policies group.
612              
613             =head1 CONFIGURATION
614              
615             =head2 quoting_methods
616              
617             A space-separated list of methods that are known to always return a safely
618             quoted result.
619              
620             For example, to declare C<custom_quote()> as safe, add the following to your
621             C<.perlcriticrc>:
622              
623             [ValuesAndExpressions::PreventSQLInjection]
624             quoting_methods = 'custom_quote'
625              
626             By default, C<quote()> and C<quote_identifier> are considered safe, given their
627             ubiquity in code that uses DBI. Note however that specifying manually a new
628             list for C<quoting_methods> will override those defaults, so you will have to
629             do this if you want to keep the two default methods but add your custom one to
630             the list:
631              
632             [ValuesAndExpressions::PreventSQLInjection]
633             quoting_methods = 'quote quote_identifier custom_quote'
634              
635             =head2 safe_functions
636              
637             A space-separated string listing the functions that always return a safely
638             quoted value.
639              
640             For example, to declare C<quote_function()> and
641             C<My::Package::quote_external_function()> as safe, add the following to your
642             C<.perlcriticrc>:
643              
644             [ValuesAndExpressions::PreventSQLInjection]
645             safe_functions = 'quote_function My::Package::quote_external_function'
646              
647             By default, no functions are considered safe.
648              
649             =head2 prefer_upper_case_keywords
650              
651             A boolean indicating whether you'd prefer to detect only SELECT, INSERT, UPDATE
652             and DELETE or also their lower and mixed case variants. This setting will be
653             ignored if we find a heredoc with the C<SQL> marker. Use this judiciously, but
654             it can help to prevent false positives like C<"update account_id in test">.
655              
656             Defaults to 0.
657              
658             [ValuesAndExpressions::PreventSQLInjection]
659             prefer_upper_case_keywords = 1
660              
661             =head1 MARKING ELEMENTS AS SAFE
662              
663             You can disable this policy on a particular string with the usual PerlCritic
664             syntax:
665              
666             my $sql = "SELECT * FROM table WHERE field = $value"; ## no critic (PreventSQLInjection)
667              
668             This is however not recommended, even if you know that $value is safe because
669             it was previously quoted with something such as:
670              
671             my $value = $dbh->quote( $user_value );
672              
673             The risk there is that someone will later modify your code and introduce unsafe
674             variables by accident, which will then not get reported. To prevent this, this
675             module has a special C<## SQL safe (...)> syntax described below.
676              
677             =head2 Marking variables as safe
678              
679             To indicate that a variable has been manually checked and determined to be
680             safe, add a comment on the same line using this syntax: C<## SQL safe ($var1,
681             $var2, ...)>.
682              
683             For example:
684              
685             my $sql = "SELECT * FROM table WHERE field = $value"; ## SQL safe($value)
686              
687             That said, you should always convert your code to use placeholders instead
688             where possible.
689              
690             =head2 Marking functions / class methods as safe
691              
692             To indicate that a function or class method has been manually checked and
693             determined that it will always return a safe output, add comment on the same
694             line using the C<## SQL safe(function_name>) syntax:
695              
696             my $sql = "SELECT * FROM table WHERE field = "
697             . some_safe_method( $value ); ## SQL safe (&some_safe_method)
698              
699             my $sql = "SELECT * FROM table WHERE field = "
700             . Package::Name::some_safe_method( $value ); ## SQL safe (&Package::Name::some_safe_method)
701              
702             Note that class methods (a function called with C<-E<gt>> on a package name)
703             still need to be declared with C<::> in the list of safe elements:
704              
705             my $sql = "SELECT * FROM table WHERE field = "
706             . Package::Name->some_safe_method( $value ); ## SQL safe (&Package::Name::some_safe_method)
707              
708             =head2 SQL safe syntax notes
709              
710             =over 4
711              
712             =item *
713              
714             This policy supports both comma-separated and space-separated lists to
715             describe safe variables. In other words, C<## SQL safe ($var1, $var2, ...)> and
716             C<## SQL safe ($var1 $var2 ...)> are strictly equivalent.
717              
718             =item *
719              
720             You can mix function names and variables in the comments to describe safe elements:
721              
722             C<## SQL safe ($var1, &function_name, $var2, ...)>
723              
724             =back
725              
726             =head1 LIMITATIONS
727              
728             There are B<many> sources of SQL injection flaws, and this module comes with no guarantee whatsoever. It focuses on the most obvious flaws, but you should still learn more about SQL injection techniques to manually detect more advanced issues.
729              
730             Possible future improvements for this module:
731              
732             =over 4
733              
734             =item * Detect use of sprintf()
735              
736             This should probably be considered a violation:
737              
738             my $sql = sprintf(
739             'SELECT * FROM %s',
740             $table
741             );
742              
743             =item * Detect use of constants
744              
745             This should not be considered a violation, since constants cannot be modified
746             by user input:
747              
748             use Const::Fast;
749             const my $FOOBAR => 12;
750              
751             $dbh->do("SELECT name FROM categories WHERE id = $FOOBAR");
752              
753             =item * Detect SQL string modifications.
754              
755             Currently, this module only analyzes strings when they are declared, and does not account for later modifications.
756              
757             This should be reviewed as part of this module:
758              
759             my $sql = "select from ";
760             $sql .= $table;
761              
762             As well as this:
763              
764             my $sql = "select from ";
765             $sql = "$sql $table";
766              
767             =item
768              
769             =back
770              
771             =head1 FUNCTIONS
772              
773             =head2 supported_parameters()
774              
775             Return an array with information about the parameters supported.
776              
777             my @supported_parameters = $policy->supported_parameters();
778              
779             =head2 default_severity()
780              
781             Return the default severity for this policy.
782              
783             my $default_severity = $policy->default_severity();
784              
785             =head2 default_themes()
786              
787             Return the default themes this policy is included in.
788              
789             my $default_themes = $policy->default_themes();
790              
791             =head2 applies_to()
792              
793             Return the class of elements this policy applies to.
794              
795             my $class = $policy->applies_to();
796              
797             =head2 prepare_to_scan_document()
798              
799             Sets up policy ($self) for each new document before scanning.
800              
801             my $bool = $policy->prepare_to_scan_document();
802              
803             =head2 violates()
804              
805             Check an element for violations against this policy.
806              
807             my $policy->violates(
808             $element,
809             $document,
810             );
811              
812             =head1 INTERNAL FUNCTIONS
813              
814             =head2 detect_sql_injections()
815              
816             Detect SQL injections vulnerabilities tied to the PPI element specified.
817              
818             my $sql_injections = detect_sql_injections( $policy, $element );
819              
820             =head2 get_function_name()
821              
822             Retrieve full name (including the package name) of a class function/method
823             based on a PPI::Token::Word object, and indicate if it is a call that returns
824             quoted data making it safe to include directly into SQL strings.
825              
826             my ( $function_name, $is_quoted ) = get_function_name( $policy, $token );
827              
828             =head2 get_complete_variable()
829              
830             Retrieve a complete variable starting with a PPI::Token::Symbol object, and
831             indicate if the variable has used a quoting method to make it safe to use
832             directly in SQL strings.
833              
834             my ( $variable, $is_quoted ) = get_complete_variable( $policy, $token );
835              
836             For example, if you have $variable->{test}->[0] in your code, PPI will identify
837             $variable as a PPI::Token::Symbol, and calling this function on that token will
838             return the whole "$variable->{test}->[0]" string.
839              
840             =head2 is_sql_statement()
841              
842             Return a boolean indicating whether a string is potentially the beginning of a SQL statement.
843              
844             my $is_sql_statement = $self->is_sql_statement( $token );
845              
846             =head2 is_in_safe_context()
847              
848             Return a boolean indicating whether a string is used in a safe context (e.g., die "string").
849              
850             my $is_in_safe_context = is_in_safe_context( $token );
851              
852             =head2 get_token_content()
853              
854             Return the text content of a PPI token.
855              
856             my $content = get_token_content( $token );
857              
858             =head2 analyze_string_injections()
859              
860             Analyze a token representing a string and returns an arrayref of variables that
861             are potential SQL injection vectors.
862              
863             my $sql_injection_vector_names = analyze_string_injections(
864             $policy,
865             $token,
866             );
867              
868             =head2 get_safe_elements()
869              
870             Return a hashref with safe element names as the keys.
871              
872             my $safe_elements = get_safe_elements(
873             $policy,
874             $line_number,
875             );
876              
877             =head2 parse_comments()
878              
879             Parse the comments for the current document and identify elements marked as
880             SQL safe.
881              
882             parse_comments(
883             $policy,
884             $ppi_document,
885             );
886              
887             =head2 parse_config_parameters()
888              
889             Parse the parameters from the C<.perlcriticrc> file, if any are specified
890             there.
891              
892             parse_config_parameters( $policy );
893              
894             =head1 BUGS
895              
896             Please report any bugs or feature requests through the web interface at
897             L<https://github.com/oalders/Perl-Critic-Policy-ValuesAndExpressions-PreventSQLInjection/issues>.
898             I will be notified, and then you'll automatically be notified of progress on
899             your bug as I make changes.
900              
901             =head1 SUPPORT
902              
903             You can find documentation for this module with the perldoc command.
904              
905             perldoc Perl::Critic::Policy::ValuesAndExpressions::PreventSQLInjection
906              
907             You can also look for information at:
908              
909             =over 4
910              
911             =item * GitHub (report bugs there)
912              
913             L<https://github.com/oalders/Perl-Critic-Policy-ValuesAndExpressions-PreventSQLInjection/issues>
914              
915             =item * CPAN Ratings
916              
917             L<http://cpanratings.perl.org/d/Perl-Critic-Policy-ValuesAndExpressions-PreventSQLInjection>
918              
919             =item * MetaCPAN
920              
921             L<https://metacpan.org/release/Perl-Critic-Policy-ValuesAndExpressions-PreventSQLInjection>
922              
923             =back
924              
925             =head1 AUTHOR
926              
927             "Guillaume Aubert <aubertg at cpan.org>"
928              
929             =head1 COPYRIGHT AND LICENSE
930              
931             This software is copyright (c) 2013 by Guillaume Aubert.
932              
933             This is free software; you can redistribute it and/or modify it under
934             the same terms as the Perl 5 programming language system itself.
935              
936             =cut