run_complete (11226B)
1 #!/usr/bin/perl 2 3 # Sixgill: Static assertion checker for C/C++ programs. 4 # Copyright (C) 2009-2010 Stanford University 5 # Author: Brian Hackett 6 # 7 # This program is free software: you can redistribute it and/or modify 8 # it under the terms of the GNU General Public License as published by 9 # the Free Software Foundation, either version 3 of the License, or 10 # (at your option) any later version. 11 # 12 # This program is distributed in the hope that it will be useful, 13 # but WITHOUT ANY WARRANTY; without even the implied warranty of 14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 # GNU General Public License for more details. 16 # 17 # You should have received a copy of the GNU General Public License 18 # along with this program. If not, see <http://www.gnu.org/licenses/>. 19 20 # do a complete run of the system from raw source to reports. this requires 21 # various run_monitor processes to be running in the background (maybe on other 22 # machines) and watching a shared poll_file for jobs. if the output directory 23 # for this script already exists then an incremental analysis will be performed 24 # and the reports will only reflect the changes since the earlier run. 25 26 use strict; 27 use warnings; 28 use IO::Handle; 29 use File::Basename qw(basename dirname); 30 use Getopt::Long; 31 use Cwd; 32 33 ################################# 34 # environment specific settings # 35 ################################# 36 37 my $WORKDIR; 38 my $SIXGILL_BIN; 39 40 # poll file shared with the run_monitor script. 41 my $poll_file; 42 43 # root directory of the project. 44 my $build_dir; 45 46 # directory containing gcc wrapper scripts. 47 my $wrap_dir; 48 49 # optional file with annotations from the web interface. 50 my $ann_file = ""; 51 52 # optional output directory to do a diff against. 53 my $old_dir = ""; 54 55 # run in the foreground 56 my $foreground; 57 58 my $builder = "make -j4"; 59 60 my $suppress_logs; 61 GetOptions("build-root|b=s" => \$build_dir, 62 "poll-file=s" => \$poll_file, 63 "no-logs!" => \$suppress_logs, 64 "work-dir=s" => \$WORKDIR, 65 "sixgill-binaries|binaries|b=s" => \$SIXGILL_BIN, 66 "wrap-dir=s" => \$wrap_dir, 67 "annotations-file|annotations|a=s" => \$ann_file, 68 "old-dir|old=s" => \$old_dir, 69 "foreground!" => \$foreground, 70 "buildcommand=s" => \$builder, 71 ) 72 or die; 73 74 if (not -d $build_dir) { 75 mkdir($build_dir); 76 } 77 if ($old_dir ne "" && not -d $old_dir) { 78 die "Old directory '$old_dir' does not exist\n"; 79 } 80 81 $WORKDIR ||= "sixgill-work"; 82 mkdir($WORKDIR, 0755) if ! -d $WORKDIR; 83 $poll_file ||= "$WORKDIR/poll.file"; 84 $build_dir ||= "$WORKDIR/js-inbound-xgill"; 85 86 if (!defined $SIXGILL_BIN) { 87 chomp(my $path = `which xmanager`); 88 if ($path) { 89 use File::Basename qw(dirname); 90 $SIXGILL_BIN = dirname($path); 91 } else { 92 die "Cannot find sixgill binaries. Use the -b option."; 93 } 94 } 95 96 $wrap_dir ||= "$WORKDIR/xgill-inbound/wrap_gcc"; 97 $wrap_dir = "$SIXGILL_BIN/../scripts/wrap_gcc" if not (-e "$wrap_dir/basecc"); 98 die "Bad wrapper directory: $wrap_dir" if not (-e "$wrap_dir/basecc"); 99 100 # code to clean the project from $build_dir. 101 sub clean_project { 102 system("make clean"); 103 } 104 105 # code to build the project from $build_dir. 106 sub build_project { 107 return system($builder) >> 8; 108 } 109 110 our %kill_on_exit; 111 END { 112 for my $pid (keys %kill_on_exit) { 113 kill($pid); 114 } 115 } 116 117 # commands to start the various xgill binaries. timeouts can be specified 118 # for the backend analyses here, and a memory limit can be specified for 119 # xmanager if desired (and USE_COUNT_ALLOCATOR is defined in util/alloc.h). 120 my $xmanager = "$SIXGILL_BIN/xmanager"; 121 my $xsource = "$SIXGILL_BIN/xsource"; 122 my $xmemlocal = "$SIXGILL_BIN/xmemlocal -timeout=20"; 123 my $xinfer = "$SIXGILL_BIN/xinfer -timeout=60"; 124 my $xcheck = "$SIXGILL_BIN/xcheck -timeout=30"; 125 126 # prefix directory to strip off source files. 127 my $prefix_dir = $build_dir; 128 129 ########################## 130 # general purpose script # 131 ########################## 132 133 # Prevent ccache from being used. I don't think this does any good. The problem 134 # I'm struggling with is that if autoconf.mk still has 'ccache gcc' in it, the 135 # builds fail in a mysterious way. 136 $ENV{CCACHE_COMPILERCHECK} = 'date +%s.%N'; 137 delete $ENV{CCACHE_PREFIX}; 138 139 my $usage = "USAGE: run_complete result-dir\n"; 140 my $result_dir = shift or die $usage; 141 142 if (not $foreground) { 143 my $pid = fork(); 144 if ($pid != 0) { 145 print "Forked, exiting...\n"; 146 exit(0); 147 } 148 } 149 150 # if the result directory does not already exist, mark for a clean build. 151 my $do_clean = 0; 152 if (not (-d $result_dir)) { 153 $do_clean = 1; 154 mkdir $result_dir; 155 } 156 157 if (!$suppress_logs) { 158 my $log_file = "$result_dir/complete.log"; 159 open(OUT, ">>", $log_file) or die "append to $log_file: $!"; 160 OUT->autoflush(1); # don't buffer writes to the main log. 161 162 # redirect stdout and stderr to the log. 163 STDOUT->fdopen(\*OUT, "w"); 164 STDERR->fdopen(\*OUT, "w"); 165 } 166 167 # pids to wait on before exiting. these are collating worker output. 168 my @waitpids; 169 170 chdir $result_dir; 171 172 # to do a partial run, comment out the commands here you don't want to do. 173 174 my $status = run_build(); 175 176 # end of run commands. 177 178 for my $pid (@waitpids) { 179 waitpid($pid, 0); 180 $status ||= $? >> 8; 181 } 182 183 print "Exiting run_complete with status $status\n"; 184 exit $status; 185 186 # get the IP address which a freshly created manager is listening on. 187 sub get_manager_address 188 { 189 my $log_file = shift or die; 190 191 # give the manager one second to start, any longer and something's broken. 192 sleep(1); 193 194 my $log_data = `cat $log_file`; 195 my ($port) = $log_data =~ /Listening on ([\.\:0-9]*)/ 196 or die "no manager found"; 197 print OUT "Connecting to manager on port $port\n" unless $suppress_logs; 198 print "Connecting to manager on port $port.\n"; 199 return $1; 200 } 201 202 sub logging_suffix { 203 my ($show_logs, $log_file) = @_; 204 return $show_logs ? "2>&1 | tee $log_file" 205 : "> $log_file 2>&1"; 206 } 207 208 sub run_build 209 { 210 print "build started: "; 211 print scalar(localtime()); 212 print "\n"; 213 214 # fork off a process to run the build. 215 defined(my $pid = fork) or die; 216 217 # log file for the manager. 218 my $manager_log_file = "$result_dir/build_manager.log"; 219 220 if (!$pid) { 221 # this is the child process, fork another process to run a manager. 222 defined(my $pid = fork) or die; 223 my $logging = logging_suffix($suppress_logs, $manager_log_file); 224 exec("$xmanager -terminate-on-assert $logging") if (!$pid); 225 $kill_on_exit{$pid} = 1; 226 227 if (!$suppress_logs) { 228 # open new streams to redirect stdout and stderr. 229 open(LOGOUT, "> $result_dir/build.log"); 230 open(LOGERR, "> $result_dir/build_err.log"); 231 STDOUT->fdopen(\*LOGOUT, "w"); 232 STDERR->fdopen(\*LOGERR, "w"); 233 } 234 235 my $address = get_manager_address($manager_log_file); 236 237 # write the configuration file for the wrapper script. 238 my $config_file = "$WORKDIR/xgill.config"; 239 open(CONFIG, ">", $config_file) or die "create $config_file: $!"; 240 print CONFIG "$prefix_dir\n"; 241 print CONFIG Cwd::abs_path("$result_dir/build_xgill.log")."\n"; 242 print CONFIG "$address\n"; 243 my @extra = ("-fplugin-arg-xgill-mangle=1"); 244 push(@extra, "-fplugin-arg-xgill-annfile=$ann_file") 245 if ($ann_file ne "" && -e $ann_file); 246 print CONFIG join(" ", @extra) . "\n"; 247 close(CONFIG); 248 249 # Tell the wrapper where to find the config 250 $ENV{"XGILL_CONFIG"} = Cwd::abs_path($config_file); 251 252 # If overriding $CC, use GCCDIR to tell the wrapper scripts where the 253 # real compiler is. If $CC is not set, then the wrapper script will 254 # search $PATH anyway. 255 if (exists $ENV{CC}) { 256 $ENV{GCCDIR} = dirname($ENV{CC}); 257 } 258 259 # Force the wrapper scripts to be run in place of the compiler during 260 # whatever build process we use. 261 $ENV{CC} = "$wrap_dir/" . basename($ENV{CC} // "gcc"); 262 $ENV{CXX} = "$wrap_dir/" . basename($ENV{CXX} // "g++"); 263 264 # do the build, cleaning if necessary. 265 chdir $build_dir; 266 clean_project() if ($do_clean); 267 my $exit_status = build_project(); 268 269 # signal the manager that it's over. 270 system("$xsource -remote=$address -end-manager"); 271 272 # wait for the manager to clean up and terminate. 273 print "Waiting for manager to finish (build status $exit_status)...\n"; 274 waitpid($pid, 0); 275 my $manager_status = $?; 276 delete $kill_on_exit{$pid}; 277 278 # build is finished, the complete run can resume. 279 # return value only useful if --foreground 280 print "Exiting with status " . ($manager_status || $exit_status) . "\n"; 281 exit($manager_status || $exit_status); 282 } 283 284 # this is the complete process, wait for the build to finish. 285 waitpid($pid, 0); 286 my $status = $? >> 8; 287 print "build finished (status $status): "; 288 print scalar(localtime()); 289 print "\n"; 290 291 return $status; 292 } 293 294 sub run_pass 295 { 296 my ($name, $command) = @_; 297 my $log_file = "$result_dir/manager.$name.log"; 298 299 # extra commands to pass to the manager. 300 my $manager_extra = ""; 301 $manager_extra .= "-modset-wait=10" if ($name eq "xmemlocal"); 302 303 # fork off a manager process for the analysis. 304 defined(my $pid = fork) or die; 305 my $logging = logging_suffix($suppress_logs, $log_file); 306 exec("$xmanager $manager_extra $logging") if (!$pid); 307 308 my $address = get_manager_address($log_file); 309 310 # write the poll file for this pass. 311 if (! -d dirname($poll_file)) { 312 system("mkdir", "-p", dirname($poll_file)); 313 } 314 open(POLL, "> $poll_file"); 315 print POLL "$command\n"; 316 print POLL "$result_dir/$name\n"; 317 print POLL "$address\n"; 318 close(POLL); 319 320 print "$name started: "; 321 print scalar(localtime()); 322 print "\n"; 323 324 waitpid($pid, 0); 325 unlink($poll_file); 326 327 print "$name finished: "; 328 print scalar(localtime()); 329 print "\n"; 330 331 # collate the worker's output into a single file. make this asynchronous 332 # so we can wait a bit and make sure we get all worker output. 333 defined($pid = fork) or die; 334 335 if (!$pid) { 336 sleep(20); 337 exec("cat $name.*.log > $name.log"); 338 } 339 340 push(@waitpids, $pid); 341 } 342 343 # the names of all directories containing reports to archive. 344 my $indexes; 345 346 sub run_index 347 { 348 my ($name, $kind) = @_; 349 350 return if (not (-e "report_$kind.xdb")); 351 352 print "$name started: "; 353 print scalar(localtime()); 354 print "\n"; 355 356 # make an index for the report diff if applicable. 357 if ($old_dir ne "") { 358 system("make_index $kind $old_dir > $name.diff.log"); 359 system("mv $kind diff_$kind"); 360 $indexes .= " diff_$kind"; 361 } 362 363 # make an index for the full set of reports. 364 system("make_index $kind > $name.log"); 365 $indexes .= " $kind"; 366 367 print "$name finished: "; 368 print scalar(localtime()); 369 print "\n"; 370 } 371 372 sub archive_indexes 373 { 374 print "archive started: "; 375 print scalar(localtime()); 376 print "\n"; 377 378 system("tar -czf reports.tgz $indexes"); 379 system("rm -rf $indexes"); 380 381 print "archive finished: "; 382 print scalar(localtime()); 383 print "\n"; 384 }