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