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 |