Perl::Critic for Security Audits
Casey West – casey@geeknest.com – @caseywest
Sunday, January 15, 12
Slide 2
Slide 2 text
CASE STUDY: WEB SECURITY
• Cross Site Scripting (XSS)
• Input isn’t validated.
• Input ins’t sanitized.
• Unscrutinized input used as
output.
• Successful attack!
• SQL Injection Attack
• Input isn’t validated.
• Input isn’t sanitized.
• Database queries are
unprotected.
• Successful attack!
Sunday, January 15, 12
Slide 3
Slide 3 text
CROSS SITE SCRIPTING (XSS)
• Strategically formed HTML.
• Injected JavaScript to control end-user’s experience.
• Can allow account takeover; app takeover.
• Can cripple your app.
Sunday, January 15, 12
Slide 4
Slide 4 text
XSS EXAMPLE
What’s your name?
Casey West
Submit
Sunday, January 15, 12
Slide 5
Slide 5 text
XSS EXAMPLE
What’s your name?
alert('Out of cheese error!');
Submit
Sunday, January 15, 12
Slide 6
Slide 6 text
XSS EXAMPLE
use CGI;
my $cgi = CGI->new;
my $name = $cgi->param('name');
print "Hello, $name, how are you?";
Sunday, January 15, 12
Slide 7
Slide 7 text
BAD PROGRAMMER.
NO COOKIE!
Sunday, January 15, 12
Slide 8
Slide 8 text
XSS EXAMPLE FIXED
my $name = $cgi->escapeHTML(
$cgi->param('name')
);
print "Hello, $name, how are you?";
Sunday, January 15, 12
Slide 9
Slide 9 text
SQL INJECTION ATTACK
• Form/API user input with special SQL sequences.
• Can cause data loss; data corruption.
• Can cause data leaks.
• Can cripple your app.
Sunday, January 15, 12
Slide 10
Slide 10 text
SQL INJECTION EXAMPLE
Sunday, January 15, 12
Slide 11
Slide 11 text
SQL INJECTION EXAMPLE
What’s your name?
Casey West
Submit
Sunday, January 15, 12
Slide 12
Slide 12 text
SQL INJECTION EXAMPLE
What’s your name?
Mr. O'Casey West
Submit
Sunday, January 15, 12
Slide 13
Slide 13 text
SQL INJECTION EXAMPLE
What's your name?
Sunday, January 15, 12
Slide 14
Slide 14 text
SQL INJECTION EXAMPLE
use CGI;
use DBI;
my $cgi = CGI->new;
my $name = $cgi->param('name');
my $id = $cgi->param('id');
$dbh->do("UPDATE users SET name='$name'
WHERE id=$id");
Sunday, January 15, 12
Slide 15
Slide 15 text
BAD PROGRAMMER.
NO COOKIE!
Sunday, January 15, 12
Slide 16
Slide 16 text
SQL INJECTION EXAMPLE
FIXED
my $name = $dbh->quote(
$cgi->param('name'));
my $id = $dbh->quote(
$cgi->param('id'));
$dbh->do("UPDATE users SET name=$name
WHERE id=$id");
Sunday, January 15, 12
Slide 17
Slide 17 text
SQL INJECTION EXAMPLE
FIXED
my $id = $cgi->param('id');
if ($id =~ /\D+/) {
die "Invalid input: go kiss a cactus.";
}
my $name = $dbh->quote(
$cgi->param('name'));
Sunday, January 15, 12
Slide 18
Slide 18 text
THESE SECURITY
VULNERABILITIES ARE
SERIOUSLY BAD.
Like, depending on what your app does you can get shamed,
fired, sued, indicted, or thrown in Federal pound-me-in-the-ass
prison.
Sunday, January 15, 12
Slide 19
Slide 19 text
YOU NEED TO FIND
AND FIX THEM BEFORE AN
ATTACKER DOES.
Or your boss, a third-party auditing company, your partner’s
boyfriend, or certain members of the Perl community who shall
remain anonymous (no guessing; chuckle if you know).
Sunday, January 15, 12
Slide 20
Slide 20 text
STATIC ANALYSIS
Take advantage of patterns in your project source code.
Sunday, January 15, 12
Slide 21
Slide 21 text
WRITING A POLICY
The anatomy of a Perl::Critic Policy.
Sunday, January 15, 12
Slide 22
Slide 22 text
THE PREAMBLE
package Perl::Critic::Policy::For::Stuff;
use strict;
use warnings;
use Readonly;
use Perl::Critic::Utils qw[:all];
use base 'Perl::Critic::Policy';
Readonly::Scalar my $DESC => 'For Stuff';
Readonly::Scalar my $EXPL => [45];
Sunday, January 15, 12
Slide 23
Slide 23 text
THE CONFIGURATION
sub default_severity { $SEVERITY_HIGH }
sub default_themes { return qw[custom] }
sub applies_to { 'PPI::Token::Word' }
Sunday, January 15, 12
Slide 24
Slide 24 text
THE MONEY
sub violates {
my ($self, $elem) = @_;
return unless $elem eq "print";
my @args = parse_arg_list($elem);
return unless @args > 2;
return $self->violation(
$DESC, $EXPL, $elem
)
};
Sunday, January 15, 12
Slide 25
Slide 25 text
THE POSTAMBLE
1;
Sunday, January 15, 12
Slide 26
Slide 26 text
A SCRIPT TO BIND THEM
#!/usr/bin/perl
use Perl::Critic;
my $critic = Perl::Critic->new(
'-single-policy' =>
'Perl::Critic::Policy::For::Stuff');
print $critic->critique($_) for @ARGV;
Sunday, January 15, 12
Slide 27
Slide 27 text
EXAMPLE "PROBLEM" SCRIPT
#!/usr/bin/perl
print "one";
print "two", "three", "and four.";
Sunday, January 15, 12
Slide 28
Slide 28 text
DECONSTRUCTING IT
shell> cpanm PPI::Dumper;
shell> ppi_dumper -WC sample-program.pl
Sunday, January 15, 12
Slide 29
Slide 29 text
DECONSTRUCTING IT
# print "one";
PPI::Document
PPI::Statement
PPI::Token::Word 'print'
PPI::Token::Quote::Double '"one"'
PPI::Token::Structure ';'
Sunday, January 15, 12
RUN THE POLICY
shell> perl our-policy.pl sample-
program.pl
For Stuff at line 3, column 1. See page
45 of PBP.
Sunday, January 15, 12
Slide 32
Slide 32 text
EXAMPLE "PROBLEM" SCRIPT
#!/usr/bin/perl
print "one";
print "two", "three", "and four.";
Sunday, January 15, 12
Slide 33
Slide 33 text
WRITING A POLICY
• Come up with a clever name.
• Subclass Perl::Critic::Policy.
• Tell Parser when to notify you of interesting code.
• Walk the parse tree to find violations.
Sunday, January 15, 12
Slide 34
Slide 34 text
FINDING POTENTIAL XSS
VULNERABILITIES
A false-positive, paranoid approach.
Sunday, January 15, 12
Slide 35
Slide 35 text
THE PREAMBLE
package Perl::Critic::Policy::XSS::Print;
use Readonly;
use Perl::Critic::Utils qw[:all];
use base 'Perl::Critic::Policy';
Readonly::Scalar my $DESC =>
'Suspect output in CGI script';
Readonly::Scalar my $EXPL =>
'Potential XSS attack vulnerability';
Sunday, January 15, 12
Slide 36
Slide 36 text
THE CONFIGURATION
sub default_severity { $SEVERITY_HIGH }
sub default_themes { qw[custom] }
sub applies_to { 'PPI::Token::Word' }
Sunday, January 15, 12
Slide 37
Slide 37 text
THE MONEY
sub violates {
my ($self, $elem) = @_;
return unless $elem eq "print";
my @suspect_arguments;
for my $arg (parse_arg_list($elem)) {
# ... Find suspect arguments.
}
return unless @suspect_arguments;
$self->violation($DESC, $EXPL, $elem);
}
Sunday, January 15, 12
Slide 38
Slide 38 text
FIND SUSPECT ARGUMENTS
for my $arg (parse_arg_list($elem)) {
next if @{$arg} == 1 &&
$self->is_boring_string($arg->[0]);
# ...
}
Sunday, January 15, 12
Slide 39
Slide 39 text
FIND SUSPECT ARGUMENTS
next if grep {
is_method_call($_) && (
$_ eq "redirect" || (
$_ eq "start_html" && $self-
>is_boring_string(first_arg($_))
)
)
} @{$arg};
Sunday, January 15, 12
Slide 40
Slide 40 text
FIND SUSPECT ARGUMENTS
for my $arg (parse_arg_list($elem)) {
# weed out the boring stuff...
push @suspect_arguments, $arg;
}
Sunday, January 15, 12
Slide 41
Slide 41 text
WHAT'S A BORING
ARGUMENT?
Sunday, January 15, 12
Slide 42
Slide 42 text
WHAT'S A BORING
ARGUMENT?
• A Number
• A Single Quoted String
• A String Literal
• A Double Quoted String without Interpolations
• An Quote-like operator (qq{}) without Interpolations
• A Literal Here Doc
Sunday, January 15, 12
Slide 43
Slide 43 text
AVOID BORING ARGUMENTS
sub is_boring_string {
my ($self, $elem) = @_;
my $PT = 'PPI::Token';
return 1 if
$elem->isa("$PT::Number") ||
$elem->isa("$PT::Quote::Single") ||
$elem->isa("$PT::Quote::Literal");
}
Sunday, January 15, 12
Slide 44
Slide 44 text
AVOID BORING ARGUMENTS
sub is_boring_string {
my ($self, $elem) = @_;
my $PT = 'PPI::Token';
# ...
return 1 if
$elem->isa("$PT::Quote::Double") &&
!$elem->interpolations;
}
Sunday, January 15, 12
Slide 45
Slide 45 text
AVOID BORING ARGUMENTS
sub is_boring_string {
my ($self, $elem) = @_;
my $PT = 'PPI::Token';
# ...
return undef if
$elem->isa("$PT::Quote::Interpolate")
&& $elem->content =~
/(?
Slide 46
Slide 46 text
AVOID BORING ARGUMENTS
sub is_boring_string {
my ($self, $elem) = @_;
my $PT = 'PPI::Token';
# ...
return 1 if
$elem->isa("$PT::HereDoc")
&& $elem->content =~
/'$/
}
Sunday, January 15, 12
Slide 47
Slide 47 text
RECAP XSS APPROACH
• Find all print statements.
• Inspect arguments to print for suspect content.
• Filter out uninteresting strings, such as single quoted.
• Report the rest.
Sunday, January 15, 12
Slide 48
Slide 48 text
APPROACH UPGRADE
• For all interesting strings, find interpolations.
• Walk up the source tree and find its origins.
• Was the variable assignment interesting?
Sunday, January 15, 12
Slide 49
Slide 49 text
FINDING POTENTIAL
SQL INJECTION
VULNERABILITIES
A false-positive, paranoid approach.
Sunday, January 15, 12
Slide 50
Slide 50 text
THE PREAMBLE
package
Perl::Critic::Policty::SQL::Inject;
Readonly::Scalar my $DESC =>
'Interpolated string as SQL expression';
Readonly::Scalar my $EXPL =>
'Potential SQL injection vulnerability';
Sunday, January 15, 12
Slide 51
Slide 51 text
THE CONFIGURATION
sub default_security { $SEVERITY_HIGH }
sub default_themes { qw[custom] }
sub applies_to { 'PPI::Token::Word' }
Sunday, January 15, 12
Slide 52
Slide 52 text
THE MONEY
sub violates {
my ($self, $elem) = @_;
return unless
$self->method_is_suspect($elem);
return unless
$self->first_arg_is_interesting(
$elem);
# ...
}
Sunday, January 15, 12
Slide 53
Slide 53 text
THE MONEY
sub violates {
my ($self, $elem) = @_;
# ...
my @vars =
$self->find_variables_in_arg($elem);
return unless @vars;
$self->violation($DESC, $EXPL, $elem);
}
Sunday, January 15, 12
Slide 54
Slide 54 text
IS THIS METHOD SUSPECT?
sub method_is_suspect {
my ($self, $elem) = @_;
return is_method_call($elem) &&
grep { $elem eq $_ }
qw[do prepare];
}
Sunday, January 15, 12
Slide 55
Slide 55 text
IS FIRST ARGUMENT
INTERESTING?
sub first_arg_is_interesting {
my ($self, $elem) = @_;
my $arg = first_arg($elem);
my $pt = 'PPI::Token';
return
$arg->isa("$PT::Quote::Interpolate")
|| ($arg->isa("$PT::Quote::Double")
&& $arg->interpolations)
|| $arg->isa("$PT::Symbol");
}
Sunday, January 15, 12
Slide 56
Slide 56 text
LOOK FOR VARIABLES
IN FIRST ARGUMENT
sub find_variables_in_arg {
my ($self, $elem) = @_;
$self->find_variables_in_string(
$elem, first_arg($elem)
);
}
Sunday, January 15, 12
Slide 57
Slide 57 text
FINDING VARIABLES
IN A STRING
sub find_variables_in_string {
my ($self, $elem, $string) = @_;
@words = words_from_string(
$string->can('string') ?
$string->string : "$string"
);
my @vars;
for my $word (@words) { ... }
return @vars;
}
Sunday, January 15, 12
Slide 58
Slide 58 text
FINDING VARIABLES
IN A STRING
for my $word (@words) {
my $wdoc = PPI::Document->new(\$word);
my ($first) = $wdoc->
find_first('PPI::Statement')->
schildren;
if ($first &&
$first->isa('PPI::Token::Quote')) {
# We should traverse this...
}
}
Sunday, January 15, 12
Slide 59
Slide 59 text
FINDING VARIABLES
IN A STRING
if ($first &&
$first->isa('PPI::Token::Quote')) {
my @found = $self-
>find_variables_in_string($elem, $first);
push @vars, @found if @found;
next;
}
Sunday, January 15, 12
Slide 60
Slide 60 text
FINDING VARIABLES
IN A STRING
for my $word (@words) {
my $wdoc = PPI::Document->new(\$word);
# If this word is quoted, traverse.
my $sym = $wdoc->
find_first('PPI::Token::Symbol');
next unless $sym;
push @vars, $sym;
}
Sunday, January 15, 12
Slide 61
Slide 61 text
APPROACH UPGRADE
• Walk up the source tree looking for variable declarations.
• Filter arguments with variables whose assignment isn't
interesting.
• Look for statements validating/sanitizing variables.
• Look for $dbh->quote() assignments; filter.
Sunday, January 15, 12
Slide 62
Slide 62 text
USEFUL RESOURCES
• Perl::Critic
• Perl::Critic::DEVELOPER
• PPI Read the parser sources!
• PPI::Dumper / ppi_dumper -CWl
• Perl::Critic::Utils
Sunday, January 15, 12
Slide 63
Slide 63 text
THANK YOU
Casey West – casey@geeknest.com – @caseywest
Sunday, January 15, 12