|
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(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 run_build |
|
203 { |
|
204 print "build started: "; |
|
205 print scalar(localtime()); |
|
206 print "\n"; |
|
207 |
|
208 # fork off a process to run the build. |
|
209 defined(my $pid = fork) or die; |
|
210 |
|
211 # log file for the manager. |
|
212 my $manager_log_file = "$result_dir/build_manager.log"; |
|
213 |
|
214 if (!$pid) { |
|
215 # this is the child process, fork another process to run a manager. |
|
216 defined(my $pid = fork) or die; |
|
217 exec("$xmanager -terminate-on-assert > $manager_log_file 2>&1") if (!$pid); |
|
218 $kill_on_exit{$pid} = 1; |
|
219 |
|
220 if (!$suppress_logs) { |
|
221 # open new streams to redirect stdout and stderr. |
|
222 open(LOGOUT, "> $result_dir/build.log"); |
|
223 open(LOGERR, "> $result_dir/build_err.log"); |
|
224 STDOUT->fdopen(\*LOGOUT, "w"); |
|
225 STDERR->fdopen(\*LOGERR, "w"); |
|
226 } |
|
227 |
|
228 my $address = get_manager_address($manager_log_file); |
|
229 |
|
230 # write the configuration file for the wrapper script. |
|
231 my $config_file = "$WORKDIR/xgill.config"; |
|
232 open(CONFIG, ">", $config_file) or die "create $config_file: $!"; |
|
233 print CONFIG "$prefix_dir\n"; |
|
234 print CONFIG Cwd::abs_path("$result_dir/build_xgill.log")."\n"; |
|
235 print CONFIG "$address\n"; |
|
236 my @extra = ("-fplugin-arg-xgill-mangle=1"); |
|
237 push(@extra, "-fplugin-arg-xgill-annfile=$ann_file") |
|
238 if ($ann_file ne "" && -e $ann_file); |
|
239 print CONFIG join(" ", @extra) . "\n"; |
|
240 close(CONFIG); |
|
241 |
|
242 # Tell the wrapper where to find the config |
|
243 $ENV{"XGILL_CONFIG"} = Cwd::abs_path($config_file); |
|
244 |
|
245 # update the PATH so that the build will see the wrappers. |
|
246 $ENV{"PATH"} = "$wrap_dir:" . $ENV{"PATH"}; |
|
247 |
|
248 # do the build, cleaning if necessary. |
|
249 chdir $build_dir; |
|
250 clean_project() if ($do_clean); |
|
251 my $exit_status = build_project(); |
|
252 |
|
253 # signal the manager that it's over. |
|
254 system("$xsource -remote=$address -end-manager"); |
|
255 |
|
256 # wait for the manager to clean up and terminate. |
|
257 print "Waiting for manager to finish (build status $exit_status)...\n"; |
|
258 waitpid($pid, 0); |
|
259 my $manager_status = $?; |
|
260 delete $kill_on_exit{$pid}; |
|
261 |
|
262 # build is finished, the complete run can resume. |
|
263 # return value only useful if --foreground |
|
264 print "Exiting with status " . ($manager_status || $exit_status) . "\n"; |
|
265 exit($manager_status || $exit_status); |
|
266 } |
|
267 |
|
268 # this is the complete process, wait for the build to finish. |
|
269 waitpid($pid, 0); |
|
270 my $status = $? >> 8; |
|
271 print "build finished (status $status): "; |
|
272 print scalar(localtime()); |
|
273 print "\n"; |
|
274 |
|
275 return $status; |
|
276 } |
|
277 |
|
278 sub run_pass |
|
279 { |
|
280 my ($name, $command) = @_; |
|
281 my $log_file = "$result_dir/manager.$name.log"; |
|
282 |
|
283 # extra commands to pass to the manager. |
|
284 my $manager_extra = ""; |
|
285 $manager_extra .= "-modset-wait=10" if ($name eq "xmemlocal"); |
|
286 |
|
287 # fork off a manager process for the analysis. |
|
288 defined(my $pid = fork) or die; |
|
289 exec("$xmanager $manager_extra > $log_file 2>&1") if (!$pid); |
|
290 |
|
291 my $address = get_manager_address($log_file); |
|
292 |
|
293 # write the poll file for this pass. |
|
294 if (! -d dirname($poll_file)) { |
|
295 system("mkdir", "-p", dirname($poll_file)); |
|
296 } |
|
297 open(POLL, "> $poll_file"); |
|
298 print POLL "$command\n"; |
|
299 print POLL "$result_dir/$name\n"; |
|
300 print POLL "$address\n"; |
|
301 close(POLL); |
|
302 |
|
303 print "$name started: "; |
|
304 print scalar(localtime()); |
|
305 print "\n"; |
|
306 |
|
307 waitpid($pid, 0); |
|
308 unlink($poll_file); |
|
309 |
|
310 print "$name finished: "; |
|
311 print scalar(localtime()); |
|
312 print "\n"; |
|
313 |
|
314 # collate the worker's output into a single file. make this asynchronous |
|
315 # so we can wait a bit and make sure we get all worker output. |
|
316 defined($pid = fork) or die; |
|
317 |
|
318 if (!$pid) { |
|
319 sleep(20); |
|
320 exec("cat $name.*.log > $name.log"); |
|
321 } |
|
322 |
|
323 push(@waitpids, $pid); |
|
324 } |
|
325 |
|
326 # the names of all directories containing reports to archive. |
|
327 my $indexes; |
|
328 |
|
329 sub run_index |
|
330 { |
|
331 my ($name, $kind) = @_; |
|
332 |
|
333 return if (not (-e "report_$kind.xdb")); |
|
334 |
|
335 print "$name started: "; |
|
336 print scalar(localtime()); |
|
337 print "\n"; |
|
338 |
|
339 # make an index for the report diff if applicable. |
|
340 if ($old_dir ne "") { |
|
341 system("make_index $kind $old_dir > $name.diff.log"); |
|
342 system("mv $kind diff_$kind"); |
|
343 $indexes .= " diff_$kind"; |
|
344 } |
|
345 |
|
346 # make an index for the full set of reports. |
|
347 system("make_index $kind > $name.log"); |
|
348 $indexes .= " $kind"; |
|
349 |
|
350 print "$name finished: "; |
|
351 print scalar(localtime()); |
|
352 print "\n"; |
|
353 } |
|
354 |
|
355 sub archive_indexes |
|
356 { |
|
357 print "archive started: "; |
|
358 print scalar(localtime()); |
|
359 print "\n"; |
|
360 |
|
361 system("tar -czf reports.tgz $indexes"); |
|
362 system("rm -rf $indexes"); |
|
363 |
|
364 print "archive finished: "; |
|
365 print scalar(localtime()); |
|
366 print "\n"; |
|
367 } |