path: root/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;

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

##----------------------------------------------------------------------------##
# 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 = "$year-$month-$day";
  
  # Determine the run number.
  
  my $RunNumber;
  
  if (-d $Dir) {
    
    if (! -r $Dir) {
      die "error: '$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) {
      die "error: '$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) {
    print "$Prog: 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;
  die "Cannot read $FName" 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 die "Cannot open $FName.";
  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);
  `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.
    `rm -f $Dir/$FName`;
    return;
  }
  
  $AlreadyScanned{$digest} = 1;
  
  # At this point the report file is not world readable.  Make it happen.
  `chmod 644 $Dir/$FName`;
  
  # Scan the report file for tags.
  open(IN, "$Dir/$FName") or die "$Prog: 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;
  
  die "$Prog: Cannot find 'sorttable.js'.\n"
    if (! -r "$RealBin/sorttable.js");  

  `cp $RealBin/sorttable.js $Dir`;