Use PPI to Find SQL Injection Attacks

[Ovid]

This is a quick and dirty PPI hack I threw together, but it attempts to spider through your codebase and look for SQL injection attacks. It returns some false positives, but that's better than false negatives. It could use some work, particularly since identifying something as SQL is difficult.

#!/usr/local/bin/perl

use strict;
use warnings;

use File::Find::Rule;
use PPI;

my $extensions = join '|' => qw(pm pl cgi);
my @files = File::Find::Rule->file->name(qr/\.(?:$extensions)$/)->in('
+.');

$| = 1;
my $files         = @files;
my $count         = 1;
my $bad_files     = 0;
my $total_attacks = 0;
foreach my $file (@files) {
    warn "Processing ($file)  $count out of $files\n";
    $count++;
    my $quotes     = extract_quotes($file);
    my $injections = find_injections($quotes);
    if (@$injections) {
        $bad_files++;
        $total_attacks += @$injections;
        my $possibles = join "\n--\n\t" => @$injections;
        print "\nFile $file might have injection attacks:\n\n\t$possib
+les\n";
    }
}

print <<"END_SUMMARY";
Summary
-------
Out of $files files analyzed:
    $bad_files file(s) might have SQL injection attacks.
    $total_attacks attack(s) may have been present.
END_SUMMARY


sub find_injections {
    my $quotes = shift;
    
    my @injections;
    foreach my $quote (@$quotes) {
        next unless $quote =~ /^\s*(?:select|insert|update|delete)/i;
        if ( $quote =~ /=\s*'?[\$\@]/ )
        {    # won't catch interpolated field names
            push @injections => $quote;
        }
    }
    return \@injections;
}

sub extract_quotes {
    my $file = shift;
    my $doc = PPI::Document->new( $file, readonly => 1 );
    unless ($doc) {
        warn "Could not create a document for ($file).  Skipping";
        return [];
    }
    return [
        map { $_->can('string') ? $_->string : $_->heredoc }
          @{ $doc->find('Token::Quote')   || [] },
          @{ $doc->find('Token::HereDoc') || [] }
    ];
}

sub slurp {
    my $file = shift;
    open my $fh, '<', $file or die "Cannot open ($file) for reading: $
+!";
    local $/;
    my $contents = <$fh>;
    return $contents;
}