ef80039c6b131b0d11f954406dc5230c8a84e6b0
[buildfarm-client.git] / run_build
1 #!/usr/bin/env perl
2
3 =comment
4
5 Copyright (c) 2003-2010, Andrew Dunstan
6
7 See accompanying License file for license details
8
9 =cut
10
11 ####################################################
12
13 =comment
14
15  NAME: run_build - script to run exim buildfarm
16
17  SYNOPSIS:
18
19   run_build [option ...] [branchname]
20
21  AUTHOR: Andrew Dunstan
22
23  DOCUMENTATION:
24
25   See http://wiki.exim.org/wiki/PostgreSQL_Buildfarm_Howto
26
27  REPOSITORY:
28
29   https://github.com/EximBuildFarm/client-code
30
31 =cut
32
33 ###################################################
34
35 our $VERSION = 'REL_0.1';
36
37 use strict;
38 use warnings;
39 use Config;
40 use Fcntl qw(:flock :seek);
41 use File::Path;
42 use File::Copy;
43 use File::Basename;
44 use File::Temp;
45 use File::Spec;
46 use FindBin qw'$RealBin';
47 use IO::Handle;
48 use POSIX qw(:signal_h strftime);
49 use Data::Dumper;
50 use Cwd qw(abs_path getcwd);
51 use File::Find ();
52
53 # save a copy of the original enviroment for reporting
54 # save it early to reduce the risk of prior mangling
55 use vars qw($orig_env);
56
57 BEGIN
58 {
59     $orig_env = {};
60     while (my ($k,$v) = each %ENV)
61     {
62
63         # report all the keys but only values for whitelisted settings
64         # this is to stop leaking of things like passwords
65         $orig_env->{$k} =(
66             (
67                     $k =~ /^PG(?!PASSWORD)|MAKE|CC|CPP|FLAG|LIBRAR|INCLUDE/
68                   ||$k =~/^(HOME|LOGNAME|USER|PATH|SHELL)$/
69             )
70             ? $v
71             : 'xxxxxx'
72         );
73     }
74 }
75
76 use EximBuild::SCM;
77 use EximBuild::Options;
78 use EximBuild::WebTxn;
79
80 if ($0 =~ /(.*)\.pl$/) {
81     die "$0: Please use `@{[join ' ' => $1, @ARGV]}' instead.\n"
82         if -t;
83     exec $1, @ARGV;
84 }
85
86 die "$0: please use an umask of 022\n"
87     if umask > 022;
88
89 my %module_hooks;
90 my $orig_dir = getcwd();
91 push @INC, $orig_dir;
92
93 umask 022;
94
95 # make sure we exit nicely on any normal interrupt
96 # so the cleanup handler gets called.
97 # that lets us stop the db if it's running and
98 # remove the inst and exim directories
99 # so the next run can start clean.
100
101 foreach my $sig (qw(INT TERM HUP QUIT))
102 {
103     $SIG{$sig}=\&interrupt_exit;
104 }
105
106 # copy command line before processing - so we can later report it
107 # unmunged
108
109 my @invocation_args = (@ARGV);
110
111 # process the command line
112 EximBuild::Options::fetch_options();
113
114 die "only one of --from-source and --from-source-clean allowed"
115   if ($from_source && $from_source_clean);
116
117 die "only one of --skip-steps and --only-steps allowed"
118   if ($skip_steps && $only_steps);
119
120 $verbose=1 if (defined($verbose) && $verbose==0);
121 $verbose ||= 0; # stop complaints about undefined var in numeric comparison
122
123 if ($testmode)
124 {
125     $verbose=1 unless $verbose;
126     $forcerun = 1;
127     $nostatus = 1;
128     $nosend = 1;
129
130 }
131
132 use vars qw(%skip_steps %only_steps);
133 $skip_steps ||= "";
134 if ($skip_steps =~ /\S/)
135 {
136     %skip_steps = map {$_ => 1} split(/\s+/,$skip_steps);
137 }
138 $only_steps ||= "";
139 if ($only_steps =~ /\S/)
140 {
141     %only_steps = map {$_ => 1} split(/(\s+|[:,])/,$only_steps);
142 }
143
144 # Currently only specifying a branch is actually used.
145 # Specifying a different repo is just a wishlist item .
146 use vars qw($branch $repo);
147 my ($arg1,$arg2) = (shift,shift);
148 $branch = $arg2 ? $arg2 :
149           $arg1 ? $arg1 :
150           'HEAD';
151 $repo = $arg2 ? $arg1 : 'exim';
152 my $explicit_branch = $branch;
153
154 print_help() if ($help);
155
156 #
157 # process config file
158 #
159 require $buildconf;
160 #use Data::Dumper;
161 #die Dumper \%EximBuild::conf;
162
163
164 # Does not seem to be necessary
165 #die "$0: permissions on '$EximBuild::conf{build_root}' should be >= 0775\n"
166 #    if -d $EximBuild::conf{build_root}
167 #      and ((stat $EximBuild::conf{build_root})[2] & 0775) != 0775;
168
169
170 # get the config data into some local variables
171 my (
172     $buildroot,$target,$animal, $print_success,
173     $aux_path,$trigger_exclude,$trigger_include,$secret,
174     $keep_errs,$force_every, $make, $optional_steps,
175     $use_vpath,$tar_log_cmd, $using_msvc, $extra_config,
176     $make_jobs, $core_file_glob, $global_lock_dir
177   )
178   =@EximBuild::conf{
179     qw(build_root target animal print_success aux_path trigger_exclude
180       trigger_include secret keep_error_builds force_every make optional_steps
181       use_vpath tar_log_cmd using_msvc extra_config make_jobs core_file_glob global_lock_dir)
182   };
183
184 # This should be done more generally, for all the scripts
185 # including the $buildconf. For now this is duplicated
186 # in a similiar war in run_branches.
187 $global_lock_dir //= $buildroot // die "$0: need global_lock_dir\n";
188
189 die "$0: need read/write permissions on '$global_lock_dir': $!\n"
190     if not -r -w $global_lock_dir;
191
192 #default is no parallel build
193 $make_jobs ||= 1;
194
195 # default core file pattern is Linux, which used to be hardcoded
196 $core_file_glob ||= 'core*';
197
198 # legacy name
199 if (defined($EximBuild::conf{trigger_filter}))
200 {
201     $trigger_exclude = $EximBuild::conf{trigger_filter};
202 }
203
204 my  $scm_timeout_secs = $EximBuild::conf{scm_timeout_secs}
205   || $EximBuild::conf{cvs_timeout_secs};
206
207 print scalar(localtime()),": buildfarm run for $animal:$branch starting\n"
208   if $verbose;
209
210 # Allow commandline overrides of conf variables
211 foreach my $arg ( @{$EximBuild::Options::overrides} )
212 {
213   if (my ($key,$val) = split '=', $arg)
214   {
215     $EximBuild::conf{$key} = $val;
216     printf "Commandline override: '$key' = '%s'\n", $EximBuild::conf{$key}
217       if $verbose;
218   }
219 }
220
221 if (ref($force_every) eq 'HASH')
222 {
223     $force_every = $force_every->{$branch} || $force_every->{default};
224 }
225
226 my $scm = new EximBuild::SCM \%EximBuild::conf;
227
228 my $buildport;
229
230 if (exists $EximBuild::conf{base_port})
231 {
232     $buildport = $EximBuild::conf{base_port};
233     if ($branch =~ /REL(\d+)_(\d+)/)
234     {
235         $buildport += (10 * ($1 - 7)) + $2;
236     }
237 }
238 else
239 {
240
241     # support for legacy config style
242     $buildport = $EximBuild::conf{branch_ports}->{$branch} || 5999;
243 }
244
245 $ENV{EXTRA_REGRESS_OPTS} = "--port=$buildport";
246
247 $tar_log_cmd ||= "tar -z -cf runlogs.tgz *.log";
248
249 my $logdirname = "lastrun-logs";
250
251 if ($from_source || $from_source_clean)
252 {
253     $from_source ||= $from_source_clean;
254     die "sourceroot $from_source not absolute"
255       unless $from_source =~ m!^/!;
256
257     # we need to know where the lock should go, so unless the path
258     # contains HEAD we require it to be specified.
259     die "must specify branch explicitly with from_source"
260       unless ($explicit_branch || $from_source =~ m!/HEAD/!);
261     $verbose ||= 1;
262     $nosend=1;
263     $nostatus=1;
264     $use_vpath = undef;
265     $logdirname = "fromsource-logs";
266 }
267
268 my @locales;
269 if ($branch eq 'HEAD' || $branch ge 'REL8_4')
270 {
271
272     # non-C locales are not regression-safe before 8.4
273     @locales = @{$EximBuild::conf{locales}} if exists $EximBuild::conf{locales};
274 }
275 unshift(@locales,'C') unless grep {$_ eq "C"} @locales;
276
277 # sanity checks
278 # several people have run into these
279
280 if ( `uname -s 2>&1 ` =~ /CYGWIN/i )
281 {
282     my @procs = `ps -ef`;
283     die "cygserver not running" unless(grep {/cygserver/} @procs);
284 }
285 my $ccachedir;
286 if ( $ccachedir = $EximBuild::conf{build_env}->{CCACHE_DIR} )
287 {
288
289     # ccache is smart enough to create what you tell it is the cache dir, but
290     # not smart enough to build the whole path. mkpath croaks on error, so
291     # we just let it.
292
293     mkpath $ccachedir;
294     $ccachedir = abs_path($ccachedir);
295 }
296
297 if ($^V lt v5.8.0)
298 {
299     die "no aux_path in config file" unless $aux_path;
300 }
301
302 die "cannot run as root/Administrator" unless ($using_msvc or $> > 0);
303
304 my $devnull = $using_msvc ? "nul" : "/dev/null";
305
306 if (!$from_source)
307 {
308     $scm->check_access($using_msvc);
309 }
310
311 my $st_prefix = "$animal.";
312
313 my $exim = $from_source  || $scm->get_build_path($use_vpath);
314
315 # set environment from config
316 while (my ($envkey,$envval) = each %{$EximBuild::conf{build_env}})
317 {
318     $ENV{$envkey}=$envval;
319 }
320
321 # change to buildroot for this branch or die
322 die "no buildroot" unless $buildroot;
323
324 unless ($buildroot =~ m!^/!
325     or($using_msvc and $buildroot =~ m![a-z]:[/\\]!i ))
326 {
327     die "buildroot $buildroot not absolute";
328 }
329
330 die "$buildroot does not exist or is not a directory" unless -d $buildroot;
331
332 chdir $buildroot || die "chdir to $buildroot: $!";
333
334 mkdir $branch unless -d $branch;
335 chdir $branch || die "chdir to $buildroot/$branch";
336
337 # rename legacy status files/directories
338 foreach my $oldfile (glob("last*"))
339 {
340     move $oldfile, "$st_prefix$oldfile";
341 }
342
343 my $branch_root = getcwd();
344
345 # Normally we would require GNU Make, but allow farm
346 # configuration to override this
347 die "$make is not GNU Make - please fix config file"
348   unless check_make();
349
350 # set up modules
351 foreach my $module (@{$EximBuild::conf{modules}})
352 {
353
354     # fill in the name of the module here, so use double quotes
355     # so everything BUT the module name needs to be escaped
356     my $str = qq!
357          require EximBuild::Modules::$module;
358          EximBuild::Modules::${module}::setup(
359               \$buildroot,
360               \$branch,
361               \\\%EximBuild::conf,
362               \$exim);
363     !;
364     eval $str;
365
366     # make errors fatal
367     die $@ if $@;
368 }
369
370 # acquire the lock
371
372 my $lockfile;
373 my $have_lock;
374
375 open($lockfile, ">builder.LCK") || die "opening lockfile: $!";
376
377 # only one builder at a time allowed per branch
378 # having another build running is not a failure, and so we do not output
379 # a failure message under this condition.
380 if ($from_source)
381 {
382     die "acquiring lock in $buildroot/$branch/builder.LCK"
383       unless flock($lockfile,LOCK_EX|LOCK_NB);
384 }
385 elsif ( !flock($lockfile,LOCK_EX|LOCK_NB) )
386 {
387     print "Another process holds the lock on "
388       ."$buildroot/$branch/builder.LCK. Exiting."
389       if ($verbose);
390     exit(0);
391 }
392
393 die "$buildroot/$branch has $exim or inst directories!"
394   if ((!$from_source && -d $exim) || -d "inst");
395
396 # we are OK to run if we get here
397 $have_lock = 1;
398
399 # check if file present for forced run
400 my $forcefile = $st_prefix . "force-one-run";
401 if (-e $forcefile)
402 {
403     $forcerun = 1;
404     unlink $forcefile;
405 }
406
407 # try to allow core files to be produced.
408 # another way would be for the calling environment
409 # to call ulimit. We do this in an eval so failure is
410 # not fatal.
411 eval{
412     require BSD::Resource;
413     BSD::Resource->import();
414
415     # explicit sub calls here. using & keeps compiler happy
416     my $coreok = setrlimit(&RLIMIT_CORE,&RLIM_INFINITY,&RLIM_INFINITY);
417     die "setrlimit" unless $coreok;
418 };
419 warn "failed to unlimit core size: $@" if $@ && $verbose > 1;
420
421 # the time we take the snapshot
422 my $now=time;
423 my $installdir = "$buildroot/$branch/inst";
424 my $dbstarted;
425
426 my $extraconf;
427
428 # cleanup handler for all exits
429 END
430 {
431
432     # clean up temp file
433     unlink $ENV{TEMP_CONFIG} if $extraconf;
434
435     # if we have the lock we must already be in the build root, so
436     # removing things there should be safe.
437     # there should only be anything to cleanup if we didn't have
438     # success.
439     if ( $have_lock && -d "$exim")
440     {
441         if ($dbstarted)
442         {
443             chdir $installdir;
444             system(qq{"bin/pg_ctl" -D data stop >$devnull 2>&1});
445             foreach my $loc (@locales)
446             {
447                 next unless -d "data-$loc";
448                 system(qq{"bin/pg_ctl" -D "data-$loc" stop >$devnull 2>&1});
449             }
450             chdir $branch_root;
451         }
452         if ( !$from_source && $keep_errs)
453         {
454             print "moving kept error trees\n" if $verbose;
455             my $timestr = strftime "%Y-%m-%d_%H-%M-%S", localtime($now);
456             unless (move("$exim", "eximkeep.$timestr"))
457             {
458                 print "error renaming '$exim' to 'eximkeep.$timestr': $!";
459             }
460             if (-d "inst")
461             {
462                 unless(move("inst", "instkeep.$timestr"))
463                 {
464                     print "error renaming 'inst' to 'instkeep.$timestr': $!";
465                 }
466             }
467         }
468         else
469         {
470             rmtree("inst") unless $keepall;
471             rmtree("$exim") unless ($from_source || $keepall);
472         }
473
474         # only keep the cache in cases of success
475         rmtree("$ccachedir") if $ccachedir;
476     }
477
478     # get the modules to clean up after themselves
479     process_module_hooks('cleanup');
480
481     if ($have_lock)
482     {
483         if ($use_vpath)
484         {
485
486             # vpath builds leave some stuff lying around in the
487             # source dir, unfortunately. This should clean it up.
488             $scm->cleanup();
489         }
490         close($lockfile);
491         unlink("builder.LCK");
492     }
493 }
494
495 # Prepend the DEFAULT settings (if any) to any settings for the
496 # branch. Since we're mangling this, deep clone $extra_config
497 # so the config object is kept as given. This is done using
498 # Dumper() because the MSys DTK perl doesn't have Storable. This
499 # is less efficient but it hardly matters here for this shallow
500 # structure.
501
502 $extra_config = eval Dumper($extra_config);
503
504 if ($extra_config &&  $extra_config->{DEFAULT})
505 {
506     if (!exists  $extra_config->{$branch})
507     {
508         $extra_config->{$branch} =      $extra_config->{DEFAULT};
509     }
510     else
511     {
512         unshift(@{$extra_config->{$branch}}, @{$extra_config->{DEFAULT}});
513     }
514 }
515
516 if ($extra_config && $extra_config->{$branch})
517 {
518     my $tmpname;
519     ($extraconf,$tmpname) =File::Temp::tempfile(
520         'buildfarm-XXXXXX',
521         DIR => File::Spec->tmpdir(),
522         UNLINK => 1
523     );
524     die 'no $tmpname!' unless $tmpname;
525     $ENV{TEMP_CONFIG} = $tmpname;
526     foreach my $line (@{$extra_config->{$branch}})
527     {
528         print $extraconf "$line\n";
529     }
530     autoflush $extraconf 1;
531 }
532
533 use vars qw($steps_completed);
534 $steps_completed = "";
535
536 my @changed_files;
537 my @changed_since_success;
538 my $last_config;
539 my $last_status;
540 my $last_run_snap;
541 my $last_success_snap;
542 my $current_config;
543 my $current_snap;
544 my @filtered_files;
545 my $savescmlog = "";
546
547 if ($from_source_clean)
548 {
549     print time_str(),"cleaning source in $exim ...\n";
550     clean_from_source();
551 }
552 elsif (!$from_source)
553 {
554
555     # see if we need to run the tests (i.e. if either something has changed or
556     # we have gone over the force_every heartbeat time)
557
558     print time_str(),"checking out source ...\n" if $verbose;
559
560     my $timeout_pid;
561
562     $timeout_pid = spawn(\&scm_timeout,$scm_timeout_secs)
563       if $scm_timeout_secs;
564
565     $savescmlog = $scm->checkout($branch);
566     $steps_completed = "SCM-checkout";
567
568     process_module_hooks('checkout',$savescmlog);
569
570     if ($timeout_pid)
571     {
572
573         # don't kill me, I finished in time
574         if (kill(SIGTERM, $timeout_pid))
575         {
576
577             # reap the zombie
578             waitpid($timeout_pid,0);
579         }
580     }
581
582     print time_str(),"checking if build run needed ...\n" if $verbose;
583
584     # transition to new time processing
585     unlink "last.success";
586
587     # get the timestamp data
588     $last_config = find_last('config') || 0;
589     $last_status = find_last('status') || 0;
590     $last_run_snap = find_last('run.snap');
591     $last_success_snap = find_last('success.snap');
592     $forcerun = 1 unless (defined($last_run_snap));
593
594     # If config file changed, force a rebuild
595     ($current_config) = (stat $orig_dir.'/'.$buildconf)[9];
596     if (defined $current_config && $current_config > $last_config)
597     {
598       $last_status = 0;
599       set_last('config',$current_config) unless $nostatus;
600     }
601
602     # updated by find_changed to last mtime of any file in the repo
603     $current_snap=0;
604
605     # see if we need to force a build
606     $last_status = 0
607       if ( $last_status
608         && $force_every
609         &&$last_status+($force_every*3600) < $now);
610     $last_status = 0 if $forcerun;
611
612     # see what's changed since the last time we did work
613     $scm->find_changed(\$current_snap,$last_run_snap, $last_success_snap,
614         \@changed_files,\@changed_since_success);
615
616     #ignore changes to files specified by the trigger exclude filter, if any
617     if (defined($trigger_exclude))
618     {
619         @filtered_files = grep { !m[$trigger_exclude] } @changed_files;
620     }
621     else
622     {
623         @filtered_files = @changed_files;
624     }
625
626     #ignore changes to files NOT specified by the trigger include filter, if any
627     if (defined($trigger_include))
628     {
629         @filtered_files = grep { m[$trigger_include] } @filtered_files;
630     }
631
632     my $modules_need_run;
633
634     process_module_hooks('need-run',\$modules_need_run);
635
636     # if no build required do nothing
637     if ($last_status && !@filtered_files && !$modules_need_run)
638     {
639         print time_str(),
640           "No build required: last status = ",scalar(gmtime($last_status)),
641           " GMT, current snapshot = ",scalar(gmtime($current_snap))," GMT,",
642           " changed files = ",scalar(@filtered_files),"\n"
643           if $verbose;
644         rmtree("$exim");
645         exit 0;
646     }
647
648     # get version info on both changed files sets
649     # XXX modules support?
650
651     $scm->get_versions(\@changed_files);
652     $scm->get_versions(\@changed_since_success);
653
654 } # end of unless ($from_source)
655
656 cleanlogs();
657
658 writelog('SCM-checkout',$savescmlog) unless $from_source;
659 $scm->log_id() unless $from_source;
660
661 # copy/create according to vpath/scm settings
662
663 if ($use_vpath)
664 {
665     print time_str(),"creating vpath build dir $exim ...\n" if $verbose;
666     mkdir $exim || die "making $exim: $!";
667 }
668 elsif (!$from_source && $scm->copy_source_required())
669 {
670     print time_str(),"copying source to $exim ...\n" if $verbose;
671
672     $scm->copy_source($using_msvc);
673 }
674
675 process_module_hooks('setup-target');
676
677 # start working
678
679 set_last('status',$now) unless $nostatus;
680 set_last('run.snap',$current_snap) unless $nostatus;
681
682 my $started_times = 0;
683 print time_str(),"running configure ...\n" if $verbose;
684
685 # each of these routines will call send_result, which calls exit,
686 # on any error, so each step depends on success in the previous
687 # steps.
688 configure();
689
690 make();
691
692 display_features();
693
694 make_test() if (check_optional_step('test'));
695
696 make_doc() if (check_optional_step('make-doc'));
697
698 ##check_port_is_ok($buildport,'Post');
699
700 # if we get here everything went fine ...
701
702 my $saved_config = get_config_summary();
703
704 rmtree("inst"); # only keep failures
705 rmtree("$exim") unless ($from_source || $keepall);
706
707 print(time_str(),"OK\n") if $verbose;
708
709 send_result("OK");
710
711 exit;
712
713 ############## end of main program ###########################
714
715 sub print_help
716 {
717     print qq!
718 usage: $0 [options] [branch]
719
720  where options are one or more of:
721
722   --nosend                  = don't send results
723   --nostatus                = don't set status files
724   --force                   = force a build run (ignore status files)
725   --from-source=/path       = use source in path, not from SCM
726   or
727   --from-source-clean=/path = same as --from-source, run make distclean first
728   --config=/path/to/file    = alternative location for config file
729   --keepall                 = keep directories if an error occurs
730   --verbose[=n]             = verbosity (default 1) 2 or more = huge output.
731   --quiet                   = suppress normal error message
732   --test                    = short for --nosend --nostatus --verbose --force
733   --skip-steps=list         = skip certain steps
734   --only-steps=list         = only do certain steps, not allowed with skip-steps
735                               lists can be comma, colon, or space separated
736
737 Default branch is HEAD. Usually only the --config option should be necessary.
738
739 !;
740     exit(0);
741 }
742
743 sub time_str
744 {
745     my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
746     return sprintf("[%.2d:%.2d:%.2d] ",$hour, $min, $sec);
747 }
748
749 sub step_wanted
750 {
751     my $step = shift;
752     return $only_steps{$step} if $only_steps;
753     return !$skip_steps{$step} if $skip_steps;
754     return 1; # default is everything is wanted
755 }
756
757 sub register_module_hooks
758 {
759     my $who = shift;
760     my $what = shift;
761     while (my ($hook,$func) = each %$what)
762     {
763         $module_hooks{$hook} ||= [];
764         push(@{$module_hooks{$hook}},[$func,$who]);
765     }
766 }
767
768 sub process_module_hooks
769 {
770     my $hook = shift;
771
772     # pass remaining args (if any) to module func
773     foreach my $module (@{$module_hooks{$hook}})
774     {
775         my ($func,$module_instance) = @$module;
776         &$func($module_instance, @_);
777     }
778 }
779
780 sub check_optional_step
781 {
782     my $step = shift;
783     my $oconf;
784     my $shandle;
785
786     return undef unless ref($oconf = $optional_steps->{$step});
787     if ($oconf->{branches})
788     {
789         return undef unless grep {$_ eq $branch} @{$oconf->{branches}};
790     }
791
792     my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =localtime(time);
793     return undef if (exists $oconf->{min_hour} &&  $hour < $oconf->{min_hour});
794     return undef if (exists $oconf->{max_hour} &&  $hour > $oconf->{max_hour});
795     return undef if (exists $oconf->{dow}
796         &&grep {$_ eq $wday} @{$oconf->{dow}});
797
798     my $last_step = $last_status = find_last("$step") || 0;
799     ## If made it *to* these optional steps, we just run them and reset last time
800     #return undef unless ($forcerun ||
801     #                     time >$last_step + (3600 * $oconf->{min_hours_since}));
802     set_last("$step") unless $nostatus;
803
804     return 1;
805 }
806
807 sub clean_from_source
808 {
809     if (-e "$exim/GNUmakefile")
810     {
811
812         # fixme for MSVC
813         my @makeout = `cd $exim && $make distclean 2>&1`;
814         my $status = $? >>8;
815         writelog('distclean',\@makeout);
816         print "======== distclean log ===========\n",@makeout if ($verbose > 1);
817         send_result('distclean',$status,\@makeout) if $status;
818     }
819 }
820
821 sub interrupt_exit
822 {
823     my $signame = shift;
824     print "Exiting on signal $signame\n";
825     exit(1);
826 }
827
828 sub cleanlogs
829 {
830     my $lrname = $st_prefix . $logdirname;
831     rmtree("$lrname");
832     mkdir "$lrname" || die "can't make $lrname dir: $!";
833 }
834
835 sub writelog
836 {
837     my $stage = shift;
838     my $loglines = shift;
839     my $handle;
840     my $lrname = $st_prefix . $logdirname;
841     open($handle,">$lrname/$stage.log") || die $!;
842     print $handle @$loglines;
843     close($handle);
844 }
845
846 sub display_features
847 {
848     return unless step_wanted('features');
849     my @out = `cd $exim
850                src/build-*/exim -C test/confs/0000 -bV `;
851     my $status = $? >>8;
852     writelog('features',\@out);
853     print "======== features log ===========\n",@out if ($verbose > 1);
854     send_result('Features',$status,\@out) if $status;
855     $steps_completed .= " Features";
856 }
857
858 sub check_make
859 {
860     # Allow farm member to configure non-GNU make
861     my $non_gnu_make = $EximBuild::conf{non_gnu_make};
862     if (!defined $non_gnu_make ||
863         (defined $non_gnu_make && $non_gnu_make == 1)) {
864       return 'OK';
865     }
866     my @out = `$make -v 2>&1`;
867     return undef unless ($? == 0 && grep {/GNU Make/} @out);
868     return 'OK';
869 }
870
871 sub make
872 {
873     return unless step_wanted('make');
874     print time_str(),"running make ...\n" if $verbose;
875     my $make_args = join(' ',$EximBuild::conf{make_args});
876     my (@makeout);
877     my $make_cmd = $make;
878     $make_cmd = "$make -j $make_jobs"
879       if ($make_jobs > 1 && ($branch eq 'HEAD' || $branch ge 'REL9_1'));
880     @makeout = `cd $exim/src && $make_cmd $make_args 2>&1`;
881     my $status = $? >>8;
882     writelog('make',\@makeout);
883     print "======== make log ===========\n",@makeout if ($verbose > 1);
884     send_result('Make',$status,\@makeout) if $status;
885     $steps_completed .= " Make";
886 }
887
888 sub make_doc
889 {
890     return unless step_wanted('make-doc');
891     print time_str(),"running make doc ...\n" if $verbose;
892
893     my (@makeout);
894     @makeout = `cd $exim/doc/doc-docbook/ && \
895                 EXIM_VER="4.82" $make everything 2>&1`;
896     my $status = $? >>8;
897     writelog('make-doc',\@makeout);
898     print "======== make doc log ===========\n",@makeout if ($verbose > 1);
899     send_result('Doc',$status,\@makeout) if $status;
900     $steps_completed .= " Doc";
901 }
902
903 sub get_stack_trace
904 {
905     my $bindir = shift;
906     my $pgdata = shift;
907
908     # no core = no result
909     my @cores = glob("$pgdata/$core_file_glob");
910     return () unless @cores;
911
912     # no gdb = no result
913     system "gdb --version > $devnull 2>&1";
914     my $status = $? >>8;
915     return () if $status;
916
917     my $cmdfile = "./gdbcmd";
918     my $handle;
919     open($handle, ">$cmdfile");
920     print $handle "bt\n";
921     close($handle);
922
923     my @trace;
924
925     foreach my $core (@cores)
926     {
927         my @onetrace = `gdb -x $cmdfile --batch $bindir/exim $core 2>&1`;
928         push(@trace,
929             "\n\n================== stack trace: $core ==================\n",
930             @onetrace);
931     }
932
933     unlink $cmdfile;
934
935     return @trace;
936 }
937
938 sub make_install_check
939 {
940     my $locale = shift;
941     return unless step_wanted('install-check');
942     print time_str(),"running make installcheck ($locale)...\n" if $verbose;
943
944     my @checklog;
945     unless ($using_msvc)
946     {
947         @checklog = `cd $exim/src/test/regress && $make installcheck 2>&1`;
948     }
949     else
950     {
951         chdir "$exim/src/tools/msvc";
952         @checklog = `perl vcregress.pl installcheck 2>&1`;
953         chdir $branch_root;
954     }
955     my $status = $? >>8;
956     my @logfiles =
957       ("$exim/src/test/regress/regression.diffs","$installdir/logfile");
958     foreach my $logfile(@logfiles)
959     {
960         next unless (-e $logfile );
961         push(@checklog,"\n\n================== $logfile ==================\n");
962         my $handle;
963         open($handle,$logfile);
964         while(<$handle>)
965         {
966             push(@checklog,$_);
967         }
968         close($handle);
969     }
970     if ($status)
971     {
972         my @trace =
973           get_stack_trace("$installdir/bin","$installdir/data-$locale");
974         push(@checklog,@trace);
975     }
976     writelog("install-check-$locale",\@checklog);
977     print "======== make installcheck log ===========\n",@checklog
978       if ($verbose > 1);
979     send_result("InstallCheck-$locale",$status,\@checklog) if $status;
980     $steps_completed .= " InstallCheck-$locale";
981 }
982
983 sub make_isolation_check
984 {
985     my $locale = shift;
986     return unless step_wanted('isolation-check');
987     my @makeout;
988     unless ($using_msvc)
989     {
990         my $cmd =
991           "cd $exim/src/test/isolation && $make NO_LOCALE=1 installcheck";
992         @makeout = `$cmd 2>&1`;
993     }
994     else
995     {
996         chdir "$exim/src/tools/msvc";
997         @makeout = `perl vcregress.pl isolationcheck 2>&1`;
998         chdir $branch_root;
999     }
1000
1001     my $status = $? >>8;
1002
1003     # get the log files and the regression diffs
1004     my @logs = glob("$exim/src/test/isolation/log/*.log");
1005     push(@logs,"$installdir/logfile");
1006     unshift(@logs,"$exim/src/test/isolation/regression.diffs")
1007       if (-e "$exim/src/test/isolation/regression.diffs");
1008     foreach my $logfile (@logs)
1009     {
1010         push(@makeout,"\n\n================== $logfile ===================\n");
1011         my $handle;
1012         open($handle,$logfile);
1013         while(<$handle>)
1014         {
1015             push(@makeout,$_);
1016         }
1017         close($handle);
1018     }
1019     if ($status)
1020     {
1021         my @trace =
1022           get_stack_trace("$installdir/bin","$installdir/data-$locale");
1023         push(@makeout,@trace);
1024     }
1025     writelog('isolation-check',\@makeout);
1026     print "======== make isolation check logs ===========\n",@makeout
1027       if ($verbose > 1);
1028
1029     send_result('IsolationCheck',$status,\@makeout) if $status;
1030     $steps_completed .= " IsolationCheck";
1031 }
1032
1033 sub make_test
1034 {
1035     return unless step_wanted('test');
1036     print time_str(),"running make test ...\n" if $verbose;
1037     my $tests_range = $EximBuild::conf{range_num_tests} || "1 4";
1038     my @makeout;
1039     @makeout =`(cd $exim/test
1040                 autoconf && ./configure && $make )2>&1 `;
1041     my $status = $? >>8;
1042     unless($status)
1043     {
1044       my @tmp = `(WORKDIR=\$PWD
1045                   cd $exim/test
1046                   ./runtest \$WORKDIR/$exim/src/build-*/exim -CONTINUE $tests_range )2>&1`;
1047       $status = $? >>8;
1048       push @makeout, @tmp;
1049       # Prepend the failed summary log outputs for ease of reading
1050       my $fail_summary = "$exim/test/failed-summary.log";
1051       if (-f $fail_summary)
1052       {
1053         @tmp = `cat $fail_summary`;
1054         push @tmp, "\n";
1055         unshift @makeout, @tmp;
1056         unshift @makeout, "Summary of failed tests:\n";
1057       }
1058     }
1059     writelog('test',\@makeout);
1060     print "======== make test logs ===========\n",@makeout
1061       if ($verbose > 1);
1062
1063     send_result('Test',$status,\@makeout) if $status;
1064     $steps_completed .= " Test";
1065 }
1066
1067 sub make_ecpg_check
1068 {
1069     return unless step_wanted('ecpg-check');
1070     my @makeout;
1071     my $ecpg_dir = "$exim/src/interfaces/ecpg";
1072     if ($using_msvc)
1073     {
1074         chdir "$exim/src/tools/msvc";
1075         @makeout = `perl vcregress.pl ecpgcheck 2>&1`;
1076         chdir $branch_root;
1077     }
1078     else
1079     {
1080         @makeout = `cd  $ecpg_dir && $make NO_LOCALE=1 check 2>&1`;
1081     }
1082     my $status = $? >>8;
1083
1084     # get the log files and the regression diffs
1085     my @logs = glob("$ecpg_dir/test/log/*.log");
1086     unshift(@logs,"$ecpg_dir/test/regression.diffs")
1087       if (-e "$ecpg_dir/test/regression.diffs");
1088     foreach my $logfile (@logs)
1089     {
1090         push(@makeout,"\n\n================== $logfile ===================\n");
1091         my $handle;
1092         open($handle,$logfile);
1093         while(<$handle>)
1094         {
1095             push(@makeout,$_);
1096         }
1097         close($handle);
1098     }
1099     if ($status)
1100     {
1101         my $base = "$ecpg_dir/test/regress/tmp_check";
1102         my @trace =
1103           get_stack_trace("$base/install$installdir/bin",       "$base/data");
1104         push(@makeout,@trace);
1105     }
1106     writelog('ecpg-check',\@makeout);
1107     print "======== make ecpg check logs ===========\n",@makeout
1108       if ($verbose > 1);
1109
1110     send_result('ECPG-Check',$status,\@makeout) if $status;
1111     $steps_completed .= " ECPG-Check";
1112 }
1113
1114 sub configure
1115 {
1116     return unless step_wanted('configure');
1117     print time_str(),"creating configuration ...\n" if $verbose;
1118
1119     my $env = $EximBuild::conf{makefile_set};
1120     my $add = $EximBuild::conf{makefile_add};
1121     my $features = $EximBuild::conf{makefile_regex};
1122
1123     my $envstr = "";
1124     while (my ($key,$val) = each %$env)
1125     {
1126         $envstr .= "$key='$val'\n";
1127     }
1128     while (my ($key,$val) = each %$add)
1129     {
1130         $envstr .= "$key+='$val'\n";
1131     }
1132
1133     my $conf_path = "src/src/EDITME";
1134     my $local_conf = "src/Local/Makefile";
1135     my @confout = `cd $exim; mkdir -p src/Local 2>&1`;
1136     my @tmp = `cd $exim && cp $conf_path $local_conf 2>&1`;
1137     my $status = $? >> 8;
1138     push @confout, @tmp;
1139     if ($status == 0)
1140     {
1141         # First, let's display some directory permissions in case
1142         # permissions are causing problems.
1143         my @dir = split('/',`pwd`);
1144         chomp(@dir);
1145         my $count = scalar @dir;
1146         my $loop = 1;
1147         my $dirs = '';
1148         while ($loop < $count)
1149         {
1150           my $dir = "";
1151           foreach my $i (0 .. $loop)
1152           {
1153             $dir .= $dir[$i].'/';
1154           }
1155           $dirs .= " $dir";
1156           $loop++;
1157         }
1158         @tmp = `echo "Verify Directory Permissions"
1159                 ls -ld $dirs`;
1160         push @confout, @tmp;
1161         # Build the config file from the EDITME template
1162         @tmp = `cd $exim && echo '$envstr' >> $local_conf`;
1163         push @confout, @tmp;
1164         my $exim_user = $EximBuild::conf{master_exim_user} || 'exim';
1165         @tmp = `echo "Hardcoded Exim user info:"; id $exim_user
1166           cd $exim && perl -pi -e 's/^EXIM_USER=.*/EXIM_USER=$exim_user/' $local_conf`;
1167         push @confout, @tmp;
1168         my $me = `whoami`; chomp $me;
1169         @tmp = `echo "Build Farm user info:"; id $me
1170           cd $exim && perl -pi -e 's/^# CONFIGURE_OWNER=\$/CONFIGURE_OWNER=$me/' $local_conf`;
1171         push @confout, @tmp;
1172         my $testdir = `cd $exim && /bin/pwd`; chomp $testdir; $testdir .= "/test";
1173         my $trcf = "$testdir/trusted-configs";
1174         my $tecf = "$testdir/test-config";
1175         @tmp = `cd $exim && perl -pi -e "s%^# TRUSTED_CONFIG_LIST=.*%TRUSTED_CONFIG_LIST=$trcf%" $local_conf`;
1176         push @confout, @tmp;
1177         @tmp = `cd $exim && perl -pi -e 's/^# WHITELIST_D_MACROS=.*/WHITELIST_D_MACROS=DIR:EXIM_PATH:AA:ACL:ACLRCPT:ACL_MAIL:ACL_PREDATA:ACL_RCPT:AFFIX:ALLOW:ARG1:ARG2:AUTHF:AUTHS:AUTH_ID_DOMAIN:BAD:BANNER:BB:BR:BRB:CERT:COM:COMMAND_USER:CONNECTCOND:CONTROL:CREQCIP:CREQMAC:CRL:CSS:D6:DATA:DCF:DDF:DEFAULTDWC:DELAY:DETAILS:DRATELIMIT:DYNAMIC_OPTION:ELI:ERROR_DETAILS:ERT:FAKE:FALLBACK:FILTER:FILTER_PREPEND_HOME:FORBID:FORBID_SMTP_CODE:FUSER:HAI:HAP:HARDLIMIT:HEADER_LINE_MAXSIZE:HEADER_MAXSIZE:HELO_MSG:HL:HOSTS:HOSTS_AVOID_TLS:HOSTS_MAX_TRY:HVH:IFACE:IGNORE_QUOTA:INC:INSERT:IP1:IP2:LAST:LDAPSERVERS:LENCHECK:LIMIT:LIST:LOG_SELECTOR:LS:MAXNM:MESSAGE_LOGS:MSIZE:NOTDAEMON:ONCE:ONLY:OPT:OPTION:ORDER:PAH:PEX:PORT:PTBC:QDG:QOLL:QUOTA:QUOTA_FILECOUNT:QWM:RCPT_MSG:REMEMBER:REQUIRE:RETRY:RETRY1:RETRY2:RETURN:RETURN_ERROR_DETAILS:REWRITE:ROUTE_DATA:RRATELIMIT:RT:S:SELECTOR:SELF:SERVER:SERVERS:SREQCIP:SREQMAC:SRV:STD:STRICT:SUB:SUBMISSION_OPTIONS:TIMEOUTDEFER:TIMES:TRUSTED:TRYCLEAR:UL:USE_SENDER:UTF8:VALUE:WMF:X:Y/' $local_conf`;
1178         push @confout, @tmp;
1179         @tmp = `cd $exim && perl -pi -e 's/^EXIM_MONITOR=(.*)/# EXIM_MONITOR=\$1/' $local_conf`;
1180         push @confout, @tmp;
1181         for my $regex ( @$features )
1182         {
1183             @tmp = `cd $exim
1184                     perl -pi -e '$regex' $local_conf 2>&1
1185                     echo "Used regex: $regex" `;
1186             push @confout, @tmp;
1187         }
1188         # Add the final build file to the display output
1189         @tmp = `cd $exim
1190                 echo
1191                 echo "Contents of Local/Makefile:"
1192                 egrep '^[^#]' $local_conf `;
1193         push @confout, @tmp;
1194         # Build the config_opts array to send to the server
1195         chomp @tmp;
1196         my @config_opts = grep s/(?:LOOKUP_|EXPERIMENTAL_|USE_)(\S+)=.*/$1/,
1197                           @tmp;
1198         push @config_opts, grep s/^(?:EXIM_)(PERL|PYTHON)=.*/$1/,
1199                            @tmp;
1200         # OpenSSL doesn't have a specific USE flag
1201         push @config_opts, grep s/^(TLS_LIBS.*-l(ssl|crypto)).*/OPENSSL/,
1202                            @tmp;
1203         $EximBuild::conf{config_opts} = \@config_opts;
1204
1205         # Does not matter what the Exim version is, as long as it is valid.
1206         my $exim_ver = $EximBuild::conf{exim_test_version} || '4.82';
1207         `cd $exim
1208          echo 'EXIM_RELEASE_VERSION="$exim_ver"' > src/src/version.sh
1209          echo 'EXIM_VARIANT_VERSION=""' >> src/src/version.sh
1210          echo 'EXIM_COMPILE_NUMBER="0"' >> src/src/version.sh`;
1211
1212         # Create a trusted-configs list file
1213         @tmp = `cd $exim && echo "$tecf" > "$trcf"`;
1214         push @confout, @tmp;
1215     }
1216
1217     print "======== configure output ===========\n",@confout
1218       if ($verbose > 1);
1219
1220     writelog('configure',\@confout);
1221
1222     if ($status)
1223     {
1224         send_result('Configure',$status,\@confout);
1225     }
1226
1227     $steps_completed .= " Configure";
1228 }
1229
1230 sub find_last
1231 {
1232     my $which = shift;
1233     my $stname = $st_prefix . "last.$which";
1234     my $handle;
1235     open($handle,$stname) or return undef;
1236     my $time = <$handle>;
1237     close($handle);
1238     chomp $time;
1239     return $time + 0;
1240 }
1241
1242 sub set_last
1243 {
1244     my $which = shift;
1245     my $stname = $st_prefix . "last.$which";
1246     my $st_now = shift || time;
1247     my $handle;
1248     open($handle,">$stname") or die "opening $stname: $!";
1249     print $handle "$st_now\n";
1250     close($handle);
1251 }
1252
1253 sub send_result
1254 {
1255
1256     # clean up temp file
1257     $extraconf = undef;
1258
1259     my $stage = shift;
1260
1261     my $ts = $now || time;
1262     my $status=shift || 0;
1263     my $log = shift || [];
1264     print "======== log passed to send_result ===========\n",@$log
1265       if ($verbose > 1);
1266
1267     unshift(@$log,
1268         "Last file mtime in snapshot: ",
1269         scalar(gmtime($current_snap)),
1270         " GMT\n","===================================================\n")
1271       unless ($from_source || !$current_snap);
1272
1273     my $log_data = join("",@$log);
1274     my $confsum = "";
1275     my $changed_this_run = "";
1276     my $changed_since_success = "";
1277     $changed_this_run = join("!",@changed_files)
1278       if @changed_files;
1279     $changed_since_success = join("!",@changed_since_success)
1280       if ($stage ne 'OK' && @changed_since_success);
1281
1282     if ($stage eq 'OK')
1283     {
1284         $confsum= $saved_config;
1285     }
1286     elsif ($stage !~ /CVS|Git|SCM/ )
1287     {
1288         $confsum = get_config_summary();
1289     }
1290     else
1291     {
1292         $confsum = get_script_config_dump();
1293     }
1294
1295     my $savedata = Data::Dumper->Dump(
1296         [
1297             $changed_this_run, $changed_since_success, $branch, $status,$stage,
1298             $animal, $ts,$log_data, $confsum, $target, $verbose, $secret
1299         ],
1300         [
1301             qw(changed_this_run changed_since_success branch status stage
1302               animal ts log_data confsum target verbose secret)
1303         ]
1304     );
1305
1306     my $lrname = $st_prefix . $logdirname;
1307
1308     # might happen if there is a CVS failure and have never got further
1309     mkdir $lrname unless -d $lrname;
1310
1311     my $txfname = "$lrname/web-txn.data";
1312     my $txdhandle;
1313     open($txdhandle,">$txfname");
1314     print $txdhandle $savedata;
1315     close($txdhandle);
1316
1317     if ($nosend || $stage eq 'CVS' || $stage eq 'CVS-status' )
1318     {
1319         print "Branch: $branch\n";
1320         if ($stage eq 'OK')
1321         {
1322             print "All stages succeeded\n";
1323             set_last('success.snap',$current_snap) unless $nostatus;
1324             exit(0);
1325         }
1326         else
1327         {
1328             print "Stage $stage failed with status $status\n";
1329             exit(1);
1330         }
1331     }
1332
1333     if ($stage !~ /CVS|Git|SCM|Pre-run-port-check/ )
1334     {
1335
1336         my @logfiles = glob("$lrname/*.log");
1337         my %mtimes = map { $_ => (stat $_)[9] } @logfiles;
1338         @logfiles =
1339           map { basename $_ }( sort { $mtimes{$a} <=> $mtimes{$b} } @logfiles );
1340         my $logfiles = join(' ',@logfiles);
1341         $tar_log_cmd =~ s/\*\.log/$logfiles/;
1342         chdir($lrname);
1343         system("$tar_log_cmd 2>&1 ");
1344         chdir($branch_root);
1345
1346     }
1347     else
1348     {
1349
1350         # these would be from an earlier run, since we
1351         # do cleanlogs() after the cvs stage
1352         # so don't send them.
1353         unlink "$lrname/runlogs.tgz";
1354     }
1355
1356     my $txstatus;
1357
1358     # this should now only apply to older Msys installs. All others should
1359     # be running with perl >= 5.8 since that's required to build exim
1360     # anyway
1361     if (!$^V or $^V lt v5.8.0)
1362     {
1363
1364         unless (-x "$aux_path/run_web_txn.pl")
1365         {
1366             print "Could not locate $aux_path/run_web_txn.pl\n";
1367             exit(1);
1368         }
1369
1370         system("$aux_path/run_web_txn.pl $lrname");
1371         $txstatus = $? >> 8;
1372     }
1373     else
1374     {
1375         $txstatus = EximBuild::WebTxn::run_web_txn($lrname) ? 0 : 1;
1376
1377     }
1378
1379     if ($txstatus)
1380     {
1381         print "Web txn failed with status: $txstatus\n";
1382
1383         # if the web txn fails, restore the timestamps
1384         # so we try again the next time.
1385         set_last('status',$last_status) unless $nostatus;
1386         set_last('run.snap',$last_run_snap) unless $nostatus;
1387         exit($txstatus);
1388     }
1389
1390     unless ($stage eq 'OK' || $quiet)
1391     {
1392         print "BuildFarm member $animal failed on $branch stage $stage\n";
1393     }
1394
1395     #   print "Success!\n",$response->content
1396     #           if $print_success;
1397
1398     set_last('success.snap',$current_snap) if ($stage eq 'OK' && !$nostatus);
1399
1400     exit 0;
1401 }
1402
1403 sub get_config_summary
1404 {
1405     my $handle;
1406     my $config = "";
1407     # unless ($using_msvc)
1408     # {
1409     #     open($handle,"$exim/config.log") || return undef;
1410     #     my $start = undef;
1411     #     while (<$handle>)
1412     #     {
1413     #         if (!$start && /created by PostgreSQL configure/)
1414     #         {
1415     #             $start=1;
1416     #             s/It was/This file was/;
1417     #         }
1418     #         next unless $start;
1419     #         last if /Core tests/;
1420     #         next if /^\#/;
1421     #         next if /= <?unknown>?/;
1422
1423     #         # split up long configure line
1424     #         if (m!\$.*configure.*--with! && length > 70)
1425     #         {
1426     #             my $pos = index($_," ",70);
1427     #             substr($_,$pos+1,0,"\\\n        ") if ($pos > 0);
1428     #             $pos = index($_," ",140);
1429     #             substr($_,$pos+1,0,"\\\n        ") if ($pos > 0);
1430     #             $pos = index($_," ",210);
1431     #             substr($_,$pos+1,0,"\\\n        ") if ($pos > 0);
1432     #         }
1433     #         $config .= $_;
1434     #     }
1435     #     close($handle);
1436     #     $config .=
1437     #       "\n========================================================\n";
1438     # }
1439     $config .= get_script_config_dump();
1440     return $config;
1441 }
1442
1443 sub get_script_config_dump
1444 {
1445     my $conf = {
1446         %EximBuild::conf,  # shallow copy
1447         script_version => $VERSION,
1448         invocation_args => \@invocation_args,
1449         steps_completed => $steps_completed,
1450         orig_env => $orig_env,
1451     };
1452     delete $conf->{secret};
1453
1454     if ($conf->{scm} eq 'git') {
1455         chomp($conf->{farm}{revision} = `cd $RealBin && git describe --tags --always --dirty=+`);
1456         $conf->{farm}{cwd} = getcwd();
1457         $conf->{farm}{bindir} = $RealBin;
1458     }
1459
1460     $Data::Dumper::Sortkeys = 1;
1461     return  Data::Dumper->Dump([$conf],['Script_Config']);
1462 }
1463
1464 sub scm_timeout
1465 {
1466     my $wait_time = shift;
1467     my $who_to_kill = getpgrp(0);
1468     my $sig = SIGTERM;
1469     $sig = -$sig;
1470     print "waiting $wait_time secs to time out process $who_to_kill\n"
1471       if $verbose;
1472     foreach my $sig (qw(INT TERM HUP QUIT))
1473     {
1474         $SIG{$sig}='DEFAULT';
1475     }
1476     sleep($wait_time);
1477     $SIG{TERM} = 'IGNORE'; # so we don't kill ourself, we're exiting anyway
1478     # kill the whole process group
1479     unless (kill $sig,$who_to_kill)
1480     {
1481         print "scm timeout kill failed\n";
1482     }
1483 }
1484
1485 sub spawn
1486 {
1487     my $coderef = shift;
1488     my $pid = fork;
1489     if (defined($pid) && $pid == 0)
1490     {
1491         exit &$coderef(@_);
1492     }
1493     return $pid;
1494 }
1495