Slide 1

Slide 1 text

Perl::Critic for Security Audits Casey West – [email protected] – @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

Slide 30

Slide 30 text

DECONSTRUCTING IT # print "two", "three", "and four."; PPI::Statement PPI::Token::Word 'print' PPI::Token::Quote::Double '"two"' PPI::Token::Operator ',' PPI::Token::Quote::Double '"three"' PPI::Token::Operator ',' PPI::Token::Quote::Double '"and four."' PPI::Token::Structure ';' Sunday, January 15, 12

Slide 31

Slide 31 text

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 – [email protected] – @caseywest Sunday, January 15, 12