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