Source code
Revision control
Copy as Markdown
Other Tools
#!/usr/bin/perl
# Sixgill: Static assertion checker for C/C++ programs.
# Copyright (C) 2009-2010 Stanford University
# Author: Brian Hackett
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# do a complete run of the system from raw source to reports. this requires
# various run_monitor processes to be running in the background (maybe on other
# machines) and watching a shared poll_file for jobs. if the output directory
# for this script already exists then an incremental analysis will be performed
# and the reports will only reflect the changes since the earlier run.
use strict;
use warnings;
use IO::Handle;
use File::Basename qw(basename dirname);
use Getopt::Long;
use Cwd;
#################################
# environment specific settings #
#################################
my $WORKDIR;
my $SIXGILL_BIN;
# poll file shared with the run_monitor script.
my $poll_file;
# root directory of the project.
my $build_dir;
# directory containing gcc wrapper scripts.
my $wrap_dir;
# optional file with annotations from the web interface.
my $ann_file = "";
# optional output directory to do a diff against.
my $old_dir = "";
# run in the foreground
my $foreground;
my $builder = "make -j4";
my $suppress_logs;
GetOptions("build-root|b=s" => \$build_dir,
"poll-file=s" => \$poll_file,
"no-logs!" => \$suppress_logs,
"work-dir=s" => \$WORKDIR,
"sixgill-binaries|binaries|b=s" => \$SIXGILL_BIN,
"wrap-dir=s" => \$wrap_dir,
"annotations-file|annotations|a=s" => \$ann_file,
"old-dir|old=s" => \$old_dir,
"foreground!" => \$foreground,
"buildcommand=s" => \$builder,
)
or die;
if (not -d $build_dir) {
mkdir($build_dir);
}
if ($old_dir ne "" && not -d $old_dir) {
die "Old directory '$old_dir' does not exist\n";
}
$WORKDIR ||= "sixgill-work";
mkdir($WORKDIR, 0755) if ! -d $WORKDIR;
$poll_file ||= "$WORKDIR/poll.file";
$build_dir ||= "$WORKDIR/js-inbound-xgill";
if (!defined $SIXGILL_BIN) {
chomp(my $path = `which xmanager`);
if ($path) {
use File::Basename qw(dirname);
$SIXGILL_BIN = dirname($path);
} else {
die "Cannot find sixgill binaries. Use the -b option.";
}
}
$wrap_dir ||= "$WORKDIR/xgill-inbound/wrap_gcc";
$wrap_dir = "$SIXGILL_BIN/../scripts/wrap_gcc" if not (-e "$wrap_dir/basecc");
die "Bad wrapper directory: $wrap_dir" if not (-e "$wrap_dir/basecc");
# code to clean the project from $build_dir.
sub clean_project {
system("make clean");
}
# code to build the project from $build_dir.
sub build_project {
return system($builder) >> 8;
}
our %kill_on_exit;
END {
for my $pid (keys %kill_on_exit) {
kill($pid);
}
}
# commands to start the various xgill binaries. timeouts can be specified
# for the backend analyses here, and a memory limit can be specified for
# xmanager if desired (and USE_COUNT_ALLOCATOR is defined in util/alloc.h).
my $xmanager = "$SIXGILL_BIN/xmanager";
my $xsource = "$SIXGILL_BIN/xsource";
my $xmemlocal = "$SIXGILL_BIN/xmemlocal -timeout=20";
my $xinfer = "$SIXGILL_BIN/xinfer -timeout=60";
my $xcheck = "$SIXGILL_BIN/xcheck -timeout=30";
# prefix directory to strip off source files.
my $prefix_dir = $build_dir;
##########################
# general purpose script #
##########################
# Prevent ccache from being used. I don't think this does any good. The problem
# I'm struggling with is that if autoconf.mk still has 'ccache gcc' in it, the
# builds fail in a mysterious way.
$ENV{CCACHE_COMPILERCHECK} = 'date +%s.%N';
delete $ENV{CCACHE_PREFIX};
my $usage = "USAGE: run_complete result-dir\n";
my $result_dir = shift or die $usage;
if (not $foreground) {
my $pid = fork();
if ($pid != 0) {
print "Forked, exiting...\n";
exit(0);
}
}
# if the result directory does not already exist, mark for a clean build.
my $do_clean = 0;
if (not (-d $result_dir)) {
$do_clean = 1;
mkdir $result_dir;
}
if (!$suppress_logs) {
my $log_file = "$result_dir/complete.log";
open(OUT, ">>", $log_file) or die "append to $log_file: $!";
OUT->autoflush(1); # don't buffer writes to the main log.
# redirect stdout and stderr to the log.
STDOUT->fdopen(\*OUT, "w");
STDERR->fdopen(\*OUT, "w");
}
# pids to wait on before exiting. these are collating worker output.
my @waitpids;
chdir $result_dir;
# to do a partial run, comment out the commands here you don't want to do.
my $status = run_build();
# end of run commands.
for my $pid (@waitpids) {
waitpid($pid, 0);
$status ||= $? >> 8;
}
print "Exiting run_complete with status $status\n";
exit $status;
# get the IP address which a freshly created manager is listening on.
sub get_manager_address
{
my $log_file = shift or die;
# give the manager one second to start, any longer and something's broken.
sleep(1);
my $log_data = `cat $log_file`;
my ($port) = $log_data =~ /Listening on ([\.\:0-9]*)/
or die "no manager found";
print OUT "Connecting to manager on port $port\n" unless $suppress_logs;
print "Connecting to manager on port $port.\n";
return $1;
}
sub logging_suffix {
my ($show_logs, $log_file) = @_;
return $show_logs ? "2>&1 | tee $log_file"
: "> $log_file 2>&1";
}
sub run_build
{
print "build started: ";
print scalar(localtime());
print "\n";
# fork off a process to run the build.
defined(my $pid = fork) or die;
# log file for the manager.
my $manager_log_file = "$result_dir/build_manager.log";
if (!$pid) {
# this is the child process, fork another process to run a manager.
defined(my $pid = fork) or die;
my $logging = logging_suffix($suppress_logs, $manager_log_file);
exec("$xmanager -terminate-on-assert $logging") if (!$pid);
$kill_on_exit{$pid} = 1;
if (!$suppress_logs) {
# open new streams to redirect stdout and stderr.
open(LOGOUT, "> $result_dir/build.log");
open(LOGERR, "> $result_dir/build_err.log");
STDOUT->fdopen(\*LOGOUT, "w");
STDERR->fdopen(\*LOGERR, "w");
}
my $address = get_manager_address($manager_log_file);
# write the configuration file for the wrapper script.
my $config_file = "$WORKDIR/xgill.config";
open(CONFIG, ">", $config_file) or die "create $config_file: $!";
print CONFIG "$prefix_dir\n";
print CONFIG Cwd::abs_path("$result_dir/build_xgill.log")."\n";
print CONFIG "$address\n";
my @extra = ("-fplugin-arg-xgill-mangle=1");
push(@extra, "-fplugin-arg-xgill-annfile=$ann_file")
if ($ann_file ne "" && -e $ann_file);
print CONFIG join(" ", @extra) . "\n";
close(CONFIG);
# Tell the wrapper where to find the config
$ENV{"XGILL_CONFIG"} = Cwd::abs_path($config_file);
# If overriding $CC, use GCCDIR to tell the wrapper scripts where the
# real compiler is. If $CC is not set, then the wrapper script will
# search $PATH anyway.
if (exists $ENV{CC}) {
$ENV{GCCDIR} = dirname($ENV{CC});
}
# Force the wrapper scripts to be run in place of the compiler during
# whatever build process we use.
$ENV{CC} = "$wrap_dir/" . basename($ENV{CC} // "gcc");
$ENV{CXX} = "$wrap_dir/" . basename($ENV{CXX} // "g++");
# do the build, cleaning if necessary.
chdir $build_dir;
clean_project() if ($do_clean);
my $exit_status = build_project();
# signal the manager that it's over.
system("$xsource -remote=$address -end-manager");
# wait for the manager to clean up and terminate.
print "Waiting for manager to finish (build status $exit_status)...\n";
waitpid($pid, 0);
my $manager_status = $?;
delete $kill_on_exit{$pid};
# build is finished, the complete run can resume.
# return value only useful if --foreground
print "Exiting with status " . ($manager_status || $exit_status) . "\n";
exit($manager_status || $exit_status);
}
# this is the complete process, wait for the build to finish.
waitpid($pid, 0);
my $status = $? >> 8;
print "build finished (status $status): ";
print scalar(localtime());
print "\n";
return $status;
}
sub run_pass
{
my ($name, $command) = @_;
my $log_file = "$result_dir/manager.$name.log";
# extra commands to pass to the manager.
my $manager_extra = "";
$manager_extra .= "-modset-wait=10" if ($name eq "xmemlocal");
# fork off a manager process for the analysis.
defined(my $pid = fork) or die;
my $logging = logging_suffix($suppress_logs, $log_file);
exec("$xmanager $manager_extra $logging") if (!$pid);
my $address = get_manager_address($log_file);
# write the poll file for this pass.
if (! -d dirname($poll_file)) {
system("mkdir", "-p", dirname($poll_file));
}
open(POLL, "> $poll_file");
print POLL "$command\n";
print POLL "$result_dir/$name\n";
print POLL "$address\n";
close(POLL);
print "$name started: ";
print scalar(localtime());
print "\n";
waitpid($pid, 0);
unlink($poll_file);
print "$name finished: ";
print scalar(localtime());
print "\n";
# collate the worker's output into a single file. make this asynchronous
# so we can wait a bit and make sure we get all worker output.
defined($pid = fork) or die;
if (!$pid) {
sleep(20);
exec("cat $name.*.log > $name.log");
}
push(@waitpids, $pid);
}
# the names of all directories containing reports to archive.
my $indexes;
sub run_index
{
my ($name, $kind) = @_;
return if (not (-e "report_$kind.xdb"));
print "$name started: ";
print scalar(localtime());
print "\n";
# make an index for the report diff if applicable.
if ($old_dir ne "") {
system("make_index $kind $old_dir > $name.diff.log");
system("mv $kind diff_$kind");
$indexes .= " diff_$kind";
}
# make an index for the full set of reports.
system("make_index $kind > $name.log");
$indexes .= " $kind";
print "$name finished: ";
print scalar(localtime());
print "\n";
}
sub archive_indexes
{
print "archive started: ";
print scalar(localtime());
print "\n";
system("tar -czf reports.tgz $indexes");
system("rm -rf $indexes");
print "archive finished: ";
print scalar(localtime());
print "\n";
}