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
1041                 autoconf && ./configure && $make )2>&1 `;
1042     my $status = $? >>8;
1043     unless($status)
1044     {
1045       my @tmp = `(WORKDIR=\$PWD
1046                   cd $exim/test
1047                   ./runtest \$WORKDIR/$exim/src/build-*/exim -CONTINUE $tests_range )2>&1`;
1048       $status = $? >>8;
1049       push @makeout, @tmp;
1050       # Prepend the failed summary log outputs for ease of reading
1051       my $fail_summary = "$exim/test/failed-summary.log";
1052       if (-f $fail_summary)
1053       {
1054         @tmp = `cat $fail_summary`;
1055         push @tmp, "\n";
1056         unshift @makeout, @tmp;
1057         unshift @makeout, "Summary of failed tests:\n";
1058       }
1059     }
1060     writelog('test',\@makeout);
1061     print "======== make test logs ===========\n",@makeout
1062       if ($verbose > 1);
1063
1064     send_result('Test',$status,\@makeout) if $status;
1065
1066     @makeout = `cat $exim/test/run-summary.log`;
1067     send_result('Test-results',$status,\@makeout) if $status;
1068
1069     $steps_completed .= " Test";
1070 }
1071
1072 sub make_ecpg_check
1073 {
1074     return unless step_wanted('ecpg-check');
1075     my @makeout;
1076     my $ecpg_dir = "$exim/src/interfaces/ecpg";
1077     if ($using_msvc)
1078     {
1079         chdir "$exim/src/tools/msvc";
1080         @makeout = `perl vcregress.pl ecpgcheck 2>&1`;
1081         chdir $branch_root;
1082     }
1083     else
1084     {
1085         @makeout = `cd  $ecpg_dir && $make NO_LOCALE=1 check 2>&1`;
1086     }
1087     my $status = $? >>8;
1088
1089     # get the log files and the regression diffs
1090     my @logs = glob("$ecpg_dir/test/log/*.log");
1091     unshift(@logs,"$ecpg_dir/test/regression.diffs")
1092       if (-e "$ecpg_dir/test/regression.diffs");
1093     foreach my $logfile (@logs)
1094     {
1095         push(@makeout,"\n\n================== $logfile ===================\n");
1096         my $handle;
1097         open($handle,$logfile);
1098         while(<$handle>)
1099         {
1100             push(@makeout,$_);
1101         }
1102         close($handle);
1103     }
1104     if ($status)
1105     {
1106         my $base = "$ecpg_dir/test/regress/tmp_check";
1107         my @trace =
1108           get_stack_trace("$base/install$installdir/bin",       "$base/data");
1109         push(@makeout,@trace);
1110     }
1111     writelog('ecpg-check',\@makeout);
1112     print "======== make ecpg check logs ===========\n",@makeout
1113       if ($verbose > 1);
1114
1115     send_result('ECPG-Check',$status,\@makeout) if $status;
1116     $steps_completed .= " ECPG-Check";
1117 }
1118
1119 sub configure
1120 {
1121     return unless step_wanted('configure');
1122     print time_str(),"creating configuration ...\n" if $verbose;
1123
1124     my $env = $EximBuild::conf{makefile_set};
1125     my $add = $EximBuild::conf{makefile_add};
1126     my $features = $EximBuild::conf{makefile_regex};
1127
1128     my $envstr = "";
1129     while (my ($key,$val) = each %$env)
1130     {
1131         $envstr .= "$key='$val'\n";
1132     }
1133     while (my ($key,$val) = each %$add)
1134     {
1135         $envstr .= "$key+='$val'\n";
1136     }
1137
1138     my $conf_path = "src/src/EDITME";
1139     my $local_conf = "src/Local/Makefile";
1140     my @confout = `cd $exim; mkdir -p src/Local 2>&1`;
1141     my @tmp = `cd $exim && cp $conf_path $local_conf 2>&1`;
1142     my $status = $? >> 8;
1143     push @confout, @tmp;
1144     if ($status == 0)
1145     {
1146         # First, let's display some directory permissions in case
1147         # permissions are causing problems.
1148         my @dir = split('/',`pwd`);
1149         chomp(@dir);
1150         my $count = scalar @dir;
1151         my $loop = 1;
1152         my $dirs = '';
1153         while ($loop < $count)
1154         {
1155           my $dir = "";
1156           foreach my $i (0 .. $loop)
1157           {
1158             $dir .= $dir[$i].'/';
1159           }
1160           $dirs .= " $dir";
1161           $loop++;
1162         }
1163         @tmp = `echo "Verify Directory Permissions"
1164                 ls -ld $dirs`;
1165         push @confout, @tmp;
1166         # Build the config file from the EDITME template
1167         @tmp = `cd $exim && echo '$envstr' >> $local_conf`;
1168         push @confout, @tmp;
1169         my $exim_user = $EximBuild::conf{master_exim_user} || 'exim';
1170         @tmp = `echo "Hardcoded Exim user info:"; id $exim_user
1171           cd $exim && perl -pi -e 's/^EXIM_USER=.*/EXIM_USER=$exim_user/' $local_conf`;
1172         push @confout, @tmp;
1173         my $me = `whoami`; chomp $me;
1174         @tmp = `echo "Build Farm user info:"; id $me
1175           cd $exim && perl -pi -e 's/^# CONFIGURE_OWNER=\$/CONFIGURE_OWNER=$me/' $local_conf`;
1176         push @confout, @tmp;
1177         my $testdir = `cd $exim && /bin/pwd`; chomp $testdir; $testdir .= "/test";
1178         my $trcf = "$testdir/trusted-configs";
1179         my $tecf = "$testdir/test-config";
1180         @tmp = `cd $exim && perl -pi -e "s%^# TRUSTED_CONFIG_LIST=.*%TRUSTED_CONFIG_LIST=$trcf%" $local_conf`;
1181         push @confout, @tmp;
1182         @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`;
1183         push @confout, @tmp;
1184         @tmp = `cd $exim && perl -pi -e 's/^EXIM_MONITOR=(.*)/# EXIM_MONITOR=\$1/' $local_conf`;
1185         push @confout, @tmp;
1186         for my $regex ( @$features )
1187         {
1188             @tmp = `cd $exim
1189                     perl -pi -e '$regex' $local_conf 2>&1
1190                     echo "Used regex: $regex" `;
1191             push @confout, @tmp;
1192         }
1193         # Add the final build file to the display output
1194         @tmp = `cd $exim
1195                 echo
1196                 echo "Contents of Local/Makefile:"
1197                 egrep '^[^#]' $local_conf `;
1198         push @confout, @tmp;
1199         # Build the config_opts array to send to the server
1200         chomp @tmp;
1201         my @config_opts = grep s/(?:LOOKUP_|EXPERIMENTAL_|USE_)(\S+)=.*/$1/,
1202                           @tmp;
1203         push @config_opts, grep s/^(?:EXIM_)(PERL|PYTHON)=.*/$1/,
1204                            @tmp;
1205         # OpenSSL doesn't have a specific USE flag
1206         push @config_opts, grep s/^(TLS_LIBS.*-l(ssl|crypto)).*/OPENSSL/,
1207                            @tmp;
1208         $EximBuild::conf{config_opts} = \@config_opts;
1209
1210         # Does not matter what the Exim version is, as long as it is valid.
1211         my $exim_ver = $EximBuild::conf{exim_test_version} || '4.82';
1212         `cd $exim
1213          echo 'EXIM_RELEASE_VERSION="$exim_ver"' > src/src/version.sh
1214          echo 'EXIM_VARIANT_VERSION=""' >> src/src/version.sh
1215          echo 'EXIM_COMPILE_NUMBER="0"' >> src/src/version.sh`;
1216
1217         # Create a trusted-configs list file
1218         @tmp = `cd $exim && echo "$tecf" > "$trcf"`;
1219         push @confout, @tmp;
1220     }
1221
1222     print "======== configure output ===========\n",@confout
1223       if ($verbose > 1);
1224
1225     writelog('configure',\@confout);
1226
1227     if ($status)
1228     {
1229         send_result('Configure',$status,\@confout);
1230     }
1231
1232     $steps_completed .= " Configure";
1233 }
1234
1235 sub find_last
1236 {
1237     my $which = shift;
1238     my $stname = $st_prefix . "last.$which";
1239     my $handle;
1240     open($handle,$stname) or return undef;
1241     my $time = <$handle>;
1242     close($handle);
1243     chomp $time;
1244     return $time + 0;
1245 }
1246
1247 sub set_last
1248 {
1249     my $which = shift;
1250     my $stname = $st_prefix . "last.$which";
1251     my $st_now = shift || time;
1252     my $handle;
1253     open($handle,">$stname") or die "opening $stname: $!";
1254     print $handle "$st_now\n";
1255     close($handle);
1256 }
1257
1258 sub send_result
1259 {
1260
1261     # clean up temp file
1262     $extraconf = undef;
1263
1264     my $stage = shift;
1265
1266     my $ts = $now || time;
1267     my $status=shift || 0;
1268     my $log = shift || [];
1269     print "======== log passed to send_result ===========\n",@$log
1270       if ($verbose > 1);
1271
1272     unshift(@$log,
1273         "Last file mtime in snapshot: ",
1274         scalar(gmtime($current_snap)),
1275         " GMT\n","===================================================\n")
1276       unless ($from_source || !$current_snap);
1277
1278     my $log_data = join("",@$log);
1279     my $confsum = "";
1280     my $changed_this_run = "";
1281     my $changed_since_success = "";
1282     $changed_this_run = join("!",@changed_files)
1283       if @changed_files;
1284     $changed_since_success = join("!",@changed_since_success)
1285       if ($stage ne 'OK' && @changed_since_success);
1286
1287     if ($stage eq 'OK')
1288     {
1289         $confsum= $saved_config;
1290     }
1291     elsif ($stage !~ /CVS|Git|SCM/ )
1292     {
1293         $confsum = get_config_summary();
1294     }
1295     else
1296     {
1297         $confsum = get_script_config_dump();
1298     }
1299
1300     my $savedata = Data::Dumper->Dump(
1301         [
1302             $changed_this_run, $changed_since_success, $branch, $status,$stage,
1303             $animal, $ts,$log_data, $confsum, $target, $verbose, $secret
1304         ],
1305         [
1306             qw(changed_this_run changed_since_success branch status stage
1307               animal ts log_data confsum target verbose secret)
1308         ]
1309     );
1310
1311     my $lrname = $st_prefix . $logdirname;
1312
1313     # might happen if there is a CVS failure and have never got further
1314     mkdir $lrname unless -d $lrname;
1315
1316     my $txfname = "$lrname/web-txn.data";
1317     my $txdhandle;
1318     open($txdhandle,">$txfname");
1319     print $txdhandle $savedata;
1320     close($txdhandle);
1321
1322     if ($nosend || $stage eq 'CVS' || $stage eq 'CVS-status' )
1323     {
1324         print "Branch: $branch\n";
1325         if ($stage eq 'OK')
1326         {
1327             print "All stages succeeded\n";
1328             set_last('success.snap',$current_snap) unless $nostatus;
1329             exit(0);
1330         }
1331         else
1332         {
1333             print "Stage $stage failed with status $status\n";
1334             exit(1);
1335         }
1336     }
1337
1338     if ($stage !~ /CVS|Git|SCM|Pre-run-port-check/ )
1339     {
1340
1341         my @logfiles = glob("$lrname/*.log");
1342         my %mtimes = map { $_ => (stat $_)[9] } @logfiles;
1343         @logfiles =
1344           map { basename $_ }( sort { $mtimes{$a} <=> $mtimes{$b} } @logfiles );
1345         my $logfiles = join(' ',@logfiles);
1346         $tar_log_cmd =~ s/\*\.log/$logfiles/;
1347         chdir($lrname);
1348         system("$tar_log_cmd 2>&1 ");
1349         chdir($branch_root);
1350
1351     }
1352     else
1353     {
1354
1355         # these would be from an earlier run, since we
1356         # do cleanlogs() after the cvs stage
1357         # so don't send them.
1358         unlink "$lrname/runlogs.tgz";
1359     }
1360
1361     my $txstatus;
1362
1363     # this should now only apply to older Msys installs. All others should
1364     # be running with perl >= 5.8 since that's required to build exim
1365     # anyway
1366     if (!$^V or $^V lt v5.8.0)
1367     {
1368
1369         unless (-x "$aux_path/run_web_txn.pl")
1370         {
1371             print "Could not locate $aux_path/run_web_txn.pl\n";
1372             exit(1);
1373         }
1374
1375         system("$aux_path/run_web_txn.pl $lrname");
1376         $txstatus = $? >> 8;
1377     }
1378     else
1379     {
1380         $txstatus = EximBuild::WebTxn::run_web_txn($lrname) ? 0 : 1;
1381
1382     }
1383
1384     if ($txstatus)
1385     {
1386         print "Web txn failed with status: $txstatus\n";
1387
1388         # if the web txn fails, restore the timestamps
1389         # so we try again the next time.
1390         set_last('status',$last_status) unless $nostatus;
1391         set_last('run.snap',$last_run_snap) unless $nostatus;
1392         exit($txstatus);
1393     }
1394
1395     unless ($stage eq 'OK' || $quiet)
1396     {
1397         print "BuildFarm member $animal failed on $branch stage $stage\n";
1398     }
1399
1400     #   print "Success!\n",$response->content
1401     #           if $print_success;
1402
1403     set_last('success.snap',$current_snap) if ($stage eq 'OK' && !$nostatus);
1404
1405     exit 0;
1406 }
1407
1408 sub get_config_summary
1409 {
1410     my $handle;
1411     my $config = "";
1412     # unless ($using_msvc)
1413     # {
1414     #     open($handle,"$exim/config.log") || return undef;
1415     #     my $start = undef;
1416     #     while (<$handle>)
1417     #     {
1418     #         if (!$start && /created by PostgreSQL configure/)
1419     #         {
1420     #             $start=1;
1421     #             s/It was/This file was/;
1422     #         }
1423     #         next unless $start;
1424     #         last if /Core tests/;
1425     #         next if /^\#/;
1426     #         next if /= <?unknown>?/;
1427
1428     #         # split up long configure line
1429     #         if (m!\$.*configure.*--with! && length > 70)
1430     #         {
1431     #             my $pos = index($_," ",70);
1432     #             substr($_,$pos+1,0,"\\\n        ") if ($pos > 0);
1433     #             $pos = index($_," ",140);
1434     #             substr($_,$pos+1,0,"\\\n        ") if ($pos > 0);
1435     #             $pos = index($_," ",210);
1436     #             substr($_,$pos+1,0,"\\\n        ") if ($pos > 0);
1437     #         }
1438     #         $config .= $_;
1439     #     }
1440     #     close($handle);
1441     #     $config .=
1442     #       "\n========================================================\n";
1443     # }
1444     $config .= get_script_config_dump();
1445     return $config;
1446 }
1447
1448 sub get_script_config_dump
1449 {
1450     my $conf = {
1451         %EximBuild::conf,  # shallow copy
1452         script_version => $VERSION,
1453         invocation_args => \@invocation_args,
1454         steps_completed => $steps_completed,
1455         orig_env => $orig_env,
1456     };
1457     delete $conf->{secret};
1458
1459     if ($conf->{scm} eq 'git') {
1460         chomp($conf->{farm}{revision} = `cd $RealBin && git describe --tags --always --dirty=+`);
1461         $conf->{farm}{cwd} = getcwd();
1462         $conf->{farm}{bindir} = $RealBin;
1463         $conf->{farm}{perl} = $^V;
1464     }
1465
1466     $Data::Dumper::Sortkeys = 1;
1467     return  Data::Dumper->Dump([$conf],['Script_Config']);
1468 }
1469
1470 sub scm_timeout
1471 {
1472     my $wait_time = shift;
1473     my $who_to_kill = getpgrp(0);
1474     my $sig = SIGTERM;
1475     $sig = -$sig;
1476     print "waiting $wait_time secs to time out process $who_to_kill\n"
1477       if $verbose;
1478     foreach my $sig (qw(INT TERM HUP QUIT))
1479     {
1480         $SIG{$sig}='DEFAULT';
1481     }
1482     sleep($wait_time);
1483     $SIG{TERM} = 'IGNORE'; # so we don't kill ourself, we're exiting anyway
1484     # kill the whole process group
1485     unless (kill $sig,$who_to_kill)
1486     {
1487         print "scm timeout kill failed\n";
1488     }
1489 }
1490
1491 sub spawn
1492 {
1493     my $coderef = shift;
1494     my $pid = fork;
1495     if (defined($pid) && $pid == 0)
1496     {
1497         exit &$coderef(@_);
1498     }
1499     return $pid;
1500 }
1501