utils/scan-build

#!/usr/bin/env perl
#
#                     The LLVM Compiler Infrastructure
#
# This file is distributed under the University of Illinois Open Source
# License. See LICENSE.TXT for details.
#
##===----------------------------------------------------------------------===##
#
# A script designed to wrap a build so that all calls to gcc are intercepted
# and piped to the static analyzer.
#
##===----------------------------------------------------------------------===##

use strict;
use warnings;
use File::Temp qw/ :mktemp /;
use FindBin qw($RealBin);
use Digest::MD5;
use File::Basename;
use Term::ANSIColor;
use Term::ANSIColor qw(:constants);

my $Verbose = 0;       # Verbose output from this script.
my $Prog = "scan-build";
my $BuildName;
my $BuildDate;

my $UseColor = ((($ENV{'TERM'} eq 'xterm-color') and -t STDOUT)
                and defined($ENV{'SCAN_BUILD_COLOR'}));

##----------------------------------------------------------------------------##
# Diagnostics
##----------------------------------------------------------------------------##

sub Diag {
  if ($UseColor) {
    print BOLD, MAGENTA "$Prog: @_";
    print RESET;
  }
  else {
    print "$Prog: @_";
  }  
}

sub DieDiag {
  if ($UseColor) {
    print BOLD, RED "$Prog: ";
    print RESET, RED @_;
    print RESET;
  }
  else {
    print "$Prog: ", @_;
  }
  exit(0);
}

##----------------------------------------------------------------------------##
# Some initial preprocessing of Clang options.
##----------------------------------------------------------------------------##

my $ClangSB = "$RealBin/clang";
my $Clang = $ClangSB;

if (! -x $ClangSB) {
  $Clang = "clang";
}

my %AvailableAnalyses;

# Query clang for analysis options.
open(PIPE, "$Clang --help |") or
  DieDiag("Cannot execute '$Clang'");
  
my $FoundAnalysis = 0;

while(<PIPE>) {
  if ($FoundAnalysis == 0) {
    if (/Available Source Code Analyses/) {
      $FoundAnalysis = 1;
    }
    
    next;
  }
    
  if (/^\s\s\s\s([^\s]+)\s(.+)$/) {
    next if ($1 =~ /-dump/ or $1 =~ /-view/ 
             or $1 =~ /-checker-simple/ or $1 =~ /-warn-uninit/);
             
    $AvailableAnalyses{$1} = $2;
    next;
  }
  
  last;
}

close (PIPE);

my %AnalysesDefaultEnabled = (
  '-warn-dead-stores' => 1,
  '-checker-cfref' => 1,
  '-warn-objc-methodsigs' => 1,
  '-warn-objc-missing-dealloc' => 1
);

##----------------------------------------------------------------------------##
# GetHTMLRunDir - Construct an HTML directory name for the current run.
##----------------------------------------------------------------------------##

sub GetHTMLRunDir {  

  die "Not enough arguments." if (@_ == 0);
  
  my $Dir = shift @_;
  
  # Get current date and time.
  
  my @CurrentTime = localtime();
  
  my $year  = $CurrentTime[5] + 1900;
  my $day   = $CurrentTime[3];
  my $month = $CurrentTime[4] + 1;
  
  my $DateString = sprintf("%d-%02d-%02d", $year, $month, $day);
  
  # Determine the run number.
  
  my $RunNumber;
  
  if (-d $Dir) {
    
    if (! -r $Dir) {
      DieDiag("directory '$Dir' exists but is not readable.\n");
    }
    
    # Iterate over all files in the specified directory.
    
    my $max = 0;
    
    opendir(DIR, $Dir);
    my @FILES= readdir(DIR); 
    closedir(DIR);
    
    foreach my $f (@FILES) {

      my @x = split/-/, $f;
      
      next if (scalar(@x) != 4);
      next if ($x[0] != $year);
      next if ($x[1] != $month);
      next if ($x[2] != $day);
      
      if ($x[3] > $max) {
        $max = $x[3];
      }      
    }
    
    $RunNumber = $max + 1;
  }
  else {
    
    if (-x $Dir) {
      DieDiag("'$Dir' exists but is not a directory.\n");
    }
    
    # $Dir does not exist.  It will be automatically created by the 
    # clang driver.  Set the run number to 1.  
    
    $RunNumber = 1;
  }
  
  die "RunNumber must be defined!" if (!defined($RunNumber));
  
  # Append the run number.
  
  return "$Dir/$DateString-$RunNumber";  
}

sub SetHtmlEnv {
  
  die "Wrong number of arguments." if (scalar(@_) != 2);
  
  my $Args = shift;
  my $Dir = shift;
  
  die "No build command." if (scalar(@$Args) == 0);
  
  my $Cmd = $$Args[0];
  
  if ($Cmd =~ /configure/) {
    return;
  }
  
  if ($Verbose) {
    Diag("Emitting reports for this run to '$Dir'.\n");
  }
  
  $ENV{'CCC_ANALYZER_HTML'} = $Dir;
}

##----------------------------------------------------------------------------##
# ComputeDigest - Compute a digest of the specified file.
##----------------------------------------------------------------------------##

sub ComputeDigest {
  my $FName = shift;
  DieDiag("Cannot read $FName to compute Digest.\n") if (! -r $FName);  
  
  # Use Digest::MD5.  We don't have to be cryptographically secure.  We're
  # just looking for duplicate files that come from a non-malicious source.
  # We use Digest::MD5 because it is a standard Perl module that should
  # come bundled on most systems.
  
  open(FILE, $FName) or DieDiag("Cannot open $FName when computing Digest.\n");
  binmode FILE;
  my $Result = Digest::MD5->new->addfile(*FILE)->hexdigest;
  close(FILE);
  
  # Return the digest.
  
  return $Result;
}

##----------------------------------------------------------------------------##
#  UpdatePrefix - Compute the common prefix of files.
##----------------------------------------------------------------------------##

my $Prefix;

sub UpdatePrefix {
  
  my $x = shift;
  my $y = basename($x);
  $x =~ s/\Q$y\E$//;
  
  # Ignore /usr, /Library, /System, /Developer

  return if ( $x =~ /^\/usr/ or $x =~ /^\/Library/
              or $x =~ /^\/System/ or $x =~ /^\/Developer/);

  
  if (!defined $Prefix) {
    $Prefix = $x;
    return;
  }
  
  chop $Prefix while (!($x =~ /^$Prefix/));
}

sub GetPrefix {
  return $Prefix;
}

##----------------------------------------------------------------------------##
#  UpdateInFilePath - Update the path in the report file.
##----------------------------------------------------------------------------##

sub UpdateInFilePath {
  my $fname = shift;
  my $regex = shift;
  my $newtext = shift;
  
  open (RIN, $fname) or die "cannot open $fname";
  open (ROUT, ">$fname.tmp") or die "cannot open $fname.tmp";
  
  while (<RIN>) {
    s/$regex/$newtext/;
    print ROUT $_;
  }
  
  close (ROUT);
  close (RIN);
  system("mv", "$fname.tmp", $fname);
}

##----------------------------------------------------------------------------##
# ScanFile - Scan a report file for various identifying attributes.
##----------------------------------------------------------------------------##

# Sometimes a source file is scanned more than once, and thus produces
# multiple error reports.  We use a cache to solve this problem.

my %AlreadyScanned;

sub ScanFile {
  
  my $Index = shift;
  my $Dir = shift;
  my $FName = shift;
  
  # Compute a digest for the report file.  Determine if we have already
  # scanned a file that looks just like it.
  
  my $digest = ComputeDigest("$Dir/$FName");

  if (defined($AlreadyScanned{$digest})) {
    # Redundant file.  Remove it.
    system ("rm", "-f", "$Dir/$FName");
    return;
  }
  
  $AlreadyScanned{$digest} = 1;
  
  # At this point the report file is not world readable.  Make it happen.
  system ("chmod", "644", "$Dir/$FName");
  
  # Scan the report file for tags.
  open(IN, "$Dir/$FName") or DieDiag("Cannot open '$Dir/$FName'\n");

  my $BugDesc = "";
  my $BugFile = "";
  my $BugPathLength = 1;
  my $BugLine = 0;
  
  while (<IN>) {
    
    if (/<!-- BUGDESC (.*) -->$/) {
      $BugDesc = $1;
    }
    elsif (/<!-- BUGFILE (.*) -->$/) {
      $BugFile = $1;
      UpdatePrefix($BugFile);
    }
    elsif (/<!-- BUGPATHLENGTH (.*) -->$/) {
      $BugPathLength = $1;
    }
    elsif (/<!-- BUGLINE (.*) -->$/) {
      $BugLine = $1;    
    }
  }

  close(IN);
    
  push @$Index,[ $FName, $BugDesc, $BugFile, $BugLine, $BugPathLength ];
}

##----------------------------------------------------------------------------##
# CopyJS - Copy JavaScript code to target directory.
##----------------------------------------------------------------------------##

sub CopyJS {

  my $Dir = shift;
  
  DieDiag("Cannot find 'sorttable.js'.\n")
    if (! -r "$RealBin/sorttable.js");  

  system ("cp", "$RealBin/sorttable.js", "$Dir");

  DieDiag("Could not copy 'sorttable.js' to '$Dir'.\n")
    if (! -r "$Dir/sorttable.js");
}

##----------------------------------------------------------------------------##
# Postprocess - Postprocess the results of an analysis scan.
##----------------------------------------------------------------------------##

sub Postprocess {
  
  my $Dir = shift;
  my $BaseDir = shift;
  
  die "No directory specified." if (!defined($Dir));
  die "No base directory specified." if (!defined($BaseDir));
  
  if (! -d $Dir) {
    Diag("No bugs found.\n");
    return 0;
  }
  
  opendir(DIR, $Dir);
  my @files = grep(/^report-.*\.html$/,readdir(DIR));
  closedir(DIR);

  if (scalar(@files) == 0) {
    Diag("Removing directory '$Dir' because it contains no reports.\n");
    system ("rm", "-fR", $Dir);
    
    # Remove the base directory if it contains no files (don't use '-R').
    system ("rm", "-f", $BaseDir);
    
    Diag("No bugs found.\n");
    return 0;
  }
  
  # Scan each report file and build an index.
  
  my @Index;
    
  foreach my $file (@files) { ScanFile(\@Index, $Dir, $file); }
  
  # Generate an index.html file.
  
  my $FName = "$Dir/index.html";
  
  open(OUT, ">$FName") or DieDiag("Cannot create file '$FName'\n");
  
  # Print out the header.
  
print OUT <<ENDTEXT;
<html>
<head>
<style type="text/css">
 body { color:#000000; background-color:#ffffff }
 body { font-family: Helvetica, sans-serif; font-size:9pt }
 h1 { font-size:12pt }
 table.sortable thead {
   background-color:#eee; color:#666666;
   font-weight: bold; cursor: default;
   text-align:center;
   border-top: 2px solid #000000;
   border-bottom: 2px solid #000000;
   font-weight: bold; font-family: Verdana
 } 
 table.sortable { border: 1px #000000 solid }
 table.sortable { border-collapse: collapse; border-spacing: 0px }
 td { border-bottom: 1px #000000 dotted }
 td { padding:5px; padding-left:8px; padding-right:8px }
 td { text-align:left; font-size:9pt }
 td.View   { padding-left: 10px }
</style>
<script src="sorttable.js"></script>
<script language='javascript' type="text/javascript">
function SetDisplay(RowClass, DisplayVal)
{
  var Rows = document.getElementsByTagName("tr");
  for ( var i = 0 ; i < Rows.length; ++i ) {
    if (Rows[i].className == RowClass) {
      Rows[i].style.display = DisplayVal;
    }
  }
}
  
function ToggleDisplay(CheckButton, ClassName) {
  if (CheckButton.checked) {
    SetDisplay(ClassName, "");
  }
  else {
    SetDisplay(ClassName, "none");
  }
}
</script>
</head>
<body>
ENDTEXT

  # Print out the summary table.
  
  my %Totals;
  
  for my $row ( @Index ) {
    
    #my $bug_type = lc($row->[1]);
    my $bug_type = ($row->[1]);
    
    if (!defined($Totals{$bug_type})) {
      $Totals{$bug_type} = 1;
    }
    else {
      $Totals{$bug_type}++;
    }
  }
  
  print OUT "<h3>Summary</h3>";
    
  if (defined($BuildName)) {
    print OUT "\n<p>Results in this analysis run are based on analyzer build <b>$BuildName</b>.</p>\n"
  }
  
print OUT <<ENDTEXT;
<table class="sortable">
<tr>
  <td>Bug Type</td>
  <td>Quantity</td>
  <td class="sorttable_nosort">Display?</td>
</tr>
ENDTEXT
  
  for my $key ( sort { $a cmp $b } keys %Totals ) {
    my $x = lc($key);
    $x =~ s/\s[,]/_/g;
    print OUT "<tr><td>$key</td><td>$Totals{$key}</td><td><input type=\"checkbox\" onClick=\"ToggleDisplay(this,'bt_$x');\" checked/></td></tr>\n";
  }

  # Print out the table of errors.

print OUT <<ENDTEXT;
</table>
<h3>Reports</h3>
<table class="sortable">
<tr>
  <td class="sorttable_sorted">Bug Type<span id="sorttable_sortfwdind">&nbsp;&#x25BE;</span>
  <td>File</td>
  <td>Line</td>
  <td>Path Length</td>
  <td class="sorttable_nosort"></td>
</tr>
ENDTEXT

  my $prefix = GetPrefix();
  my $regex;
  my $InFileRegex;
  my $InFilePrefix = "File:</td><td>";
  
  if (defined($prefix)) { 
    $regex = qr/^\Q$prefix\E/is;    
    $InFileRegex = qr/\Q$InFilePrefix$prefix\E/is;
  }    

  for my $row ( sort { $a->[1] cmp $b->[1] } @Index ) {
    
    my $x = lc($row->[1]);
    $x =~ s/\s[,]/_/g;
    
    print OUT "<tr class=\"bt_$x\">\n";

    my $ReportFile = $row->[0];

    print OUT " <td class=\"DESC\">";
    #print OUT lc($row->[1]);
    print OUT $row->[1];
    print OUT "</td>\n";
    
    # Update the file prefix.
    
    my $fname = $row->[2];
    if (defined($regex)) {      
      $fname =~ s/$regex//;
      UpdateInFilePath("$Dir/$ReportFile", $InFileRegex, $InFilePrefix)
    }

    print OUT "<td>$fname</td>\n";

    # Print the rest of the columns.
    
    for my $j ( 3 .. $#{$row} ) {
      print OUT "<td>$row->[$j]</td>\n"
    }

    # Emit the "View" link.
    
    print OUT " <td class=\"View\"><a href=\"$ReportFile#EndPath\">View</a></td>\n";
    
    # End the row.
    print OUT "</tr>\n";
  }
  
  print OUT "</table>\n</body></html>\n";  
  close(OUT);

  CopyJS($Dir);

  # Make sure $Dir and $BaseDir are world readable/executable.
  system("chmod", "755", $Dir);
  system("chmod", "755", $BaseDir);

  my $Num = scalar(@Index);
  Diag("$Num bugs found.\n");
  if ($Num > 0 && -r "$Dir/index.html") {
    Diag("Open '$Dir/index.html' to examine bug reports.\n");
  }
  
  return $Num;
}

##----------------------------------------------------------------------------##
# RunBuildCommand - Run the build command.
##----------------------------------------------------------------------------##

sub AddIfNotPresent {
  my $Args = shift;
  my $Arg = shift;  
  my $found = 0;
  
  foreach my $k (@$Args) {
    if ($k eq $Arg) {
      $found = 1;
      last;
    }
  }
  
  if ($found == 0) {
    push @$Args, $Arg;
  }
}

sub RunBuildCommand {
  
  my $Args = shift;
  my $IgnoreErrors = shift;
  my $Cmd = $Args->[0];
  my $CCAnalyzer = shift;
  
  # Get only the part of the command after the last '/'.
  if ($Cmd =~ /\/([^\/]+)$/) {
    $Cmd = $1;
  }
  
  if ($Cmd eq "gcc" or $Cmd eq "cc" or $Cmd eq "llvm-gcc") {
    shift @$Args;
    unshift @$Args, $CCAnalyzer;
  }
  elsif ($IgnoreErrors) {
    if ($Cmd eq "make" or $Cmd eq "gmake") {
      AddIfNotPresent($Args,"-k");
      AddIfNotPresent($Args,"-i");
    }
    elsif ($Cmd eq "xcodebuild") {
      AddIfNotPresent($Args,"-PBXBuildsContinueAfterErrors=YES");
    }
  } 
  
  if ($Cmd eq "xcodebuild") {
    # Disable distributed builds for xcodebuild.
    AddIfNotPresent($Args,"-nodistribute");

    # Disable PCH files until clang supports them.
    AddIfNotPresent($Args,"GCC_PRECOMPILE_PREFIX_HEADER=NO");
    
    # When 'CC' is set, xcodebuild uses it to do all linking, even if we are
    # linking C++ object files.  Set 'LDPLUSPLUS' so that xcodebuild uses 'g++'
    # when linking such files.
    my $LDPLUSPLUS = `which g++`;
    $LDPLUSPLUS =~ s/\015?\012//;  # strip newlines
    $ENV{'LDPLUSPLUS'} = $LDPLUSPLUS;    
  }
  
  return system(@$Args);
}

##----------------------------------------------------------------------------##
# DisplayHelp - Utility function to display all help options.
##----------------------------------------------------------------------------##

sub DisplayHelp {
  
print <<ENDTEXT;
USAGE: $Prog [options] <build command> [build options]

ENDTEXT

  if (defined($BuildName)) {
    print "ANALYZER BUILD: $BuildName ($BuildDate)\n\n";
  }

print <<ENDTEXT;
OPTIONS:

 -o             - Target directory for HTML report files.  Subdirectories
                  will be created as needed to represent separate "runs" of
                  the analyzer.  If this option is not specified, a directory
                  is created in /tmp to store the reports.

 -h             - Display this message.
 --help

 -k             - Add a "keep on going" option to the specified build command.
 --keep-going     This option currently supports make and xcodebuild.
                  This is a convenience option; one can specify this
                  behavior directly using build options.

 --status-bugs  - By default, the exit status of $Prog is the same as the
                  executed build command.  Specifying this option causes the
                  exit status of $Prog to be 1 if it found potential bugs
                  and 0 otherwise.

 -v             - Verbose output from $Prog and the analyzer.
                  A second and third "-v" increases verbosity.

 -V             - View analysis results in a web browser when the build
 --view           completes.

ENDTEXT

  print " Available Source Code Analyses (multiple analyses may be specified):\n\n";

  foreach my $Analysis (sort keys %AvailableAnalyses) {
    if (defined($AnalysesDefaultEnabled{$Analysis})) {
      print " (+)";
    }
    else {
      print "    ";
    }
    
    print " $Analysis  $AvailableAnalyses{$Analysis}\n";
  }
  
print <<ENDTEXT

 NOTE: "(+)" indicates that an analysis is enabled by default unless one
       or more analysis options are specified

BUILD OPTIONS

 You can specify any build option acceptable to the build command.

EXAMPLE

 $Prog -o /tmp/myhtmldir make -j4
     
 The above example causes analysis reports to be deposited into
 a subdirectory of "/tmp/myhtmldir" and to run "make" with the "-j4" option.
 A different subdirectory is created each time $Prog analyzes a project.
 The analyzer should support most parallel builds, but not distributed builds.

ENDTEXT
}

##----------------------------------------------------------------------------##
# Process command-line arguments.
##----------------------------------------------------------------------------##

my $HtmlDir;           # Parent directory to store HTML files.
my $IgnoreErrors = 0;  # Ignore build errors.
my $ViewResults  = 0;  # View results when the build terminates.
my $ExitStatusFoundBugs = 0; # Exit status reflects whether bugs were found
my @AnalysesToRun;


if (!@ARGV) {
  DisplayHelp();
  exit 1;
}

while (@ARGV) {
  
  # Scan for options we recognize.
  
  my $arg = $ARGV[0];

  if ($arg eq "-h" or $arg eq "--help") {
    DisplayHelp();
    exit 0;
  }
  
  if (defined($AvailableAnalyses{$arg})) {
    shift @ARGV;
    push @AnalysesToRun, $arg;
    next;
  }
  
  if ($arg eq "-o") {
    shift @ARGV;
        
    if (!@ARGV) {
      DieDiag("'-o' option requires a target directory name.\n");
    }
    
    $HtmlDir = shift @ARGV;
    next;
  }
  
  if ($arg eq "-k" or $arg eq "--keep-going") {
    shift @ARGV;
    $IgnoreErrors = 1;
    next;
  }
  
  if ($arg eq "-v") {
    shift @ARGV;
    $Verbose++;
    next;
  }
  
  if ($arg eq "-V" or $arg eq "--view") {
    shift @ARGV;
    $ViewResults = 1;    
    next;
  }
  
  if ($arg eq "--status-bugs") {
    shift @ARGV;
    $ExitStatusFoundBugs = 1;
    next;
  }
  
  DieDiag("unrecognized option '$arg'\n") if ($arg =~ /^-/);
  
  last;
}

if (!@ARGV) {
  Diag("No build command specified.\n\n");
  DisplayHelp();
  exit 1;
}

# Determine the output directory for the HTML reports.

if (!defined($HtmlDir)) {
  
  $HtmlDir = mkdtemp("/tmp/$Prog-XXXXXX");
  
  if (!defined($HtmlDir)) {
    DieDiag("Cannot create HTML directory in /tmp.\n");
  }
  
  if (!$Verbose) {
    Diag("Using '$HtmlDir' as base HTML report directory.\n");
  }
}

my $BaseDir = $HtmlDir;
$HtmlDir = GetHTMLRunDir($HtmlDir);

# Set the appropriate environment variables.

SetHtmlEnv(\@ARGV, $HtmlDir);

my $Cmd = "$RealBin/ccc-analyzer";

DieDiag("Executable 'ccc-analyzer' does not exist at '$Cmd'\n")
  if (! -x $Cmd);

if (! -x $ClangSB) {
  Diag("'clang' executable not found in '$RealBin'.\n");
  Diag("Using 'clang' from path.\n");
}

$ENV{'CC'} = $Cmd;
$ENV{'CLANG'} = $Clang;

if ($Verbose >= 2) {
  $ENV{'CCC_ANALYZER_VERBOSE'} = 1;
}

if ($Verbose >= 3) {
  $ENV{'CCC_ANALYZER_LOG'} = 1;
}

if (scalar(@AnalysesToRun) == 0) {
  foreach my $key (keys %AnalysesDefaultEnabled) {
    push @AnalysesToRun,$key;
  }
}

$ENV{'CCC_ANALYZER_ANALYSIS'} = join ' ',@AnalysesToRun;

# Run the build.

my $ExitStatus = RunBuildCommand(\@ARGV, $IgnoreErrors, $Cmd);

# Postprocess the HTML directory.

my $NumBugs = Postprocess($HtmlDir, $BaseDir);

if ($ViewResults and -r "$HtmlDir/index.html") {
  # Only works on Mac OS X (for now).
  print "Viewing analysis results: '$HtmlDir/index.html'\n";
  system("open", "$HtmlDir/index.html");
}

if ($ExitStatusFoundBugs) {
  exit 1 if ($NumBugs > 0);
  exit 0;
}

exit $ExitStatus;