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