X-Git-Url: https://git.exim.org/buildfarm-client.git/blobdiff_plain/c314f9bbd988fc5a07b455f0cd8738f178402d8a..707a4894cb762d150f48663ae8034224dfca183f:/run_branches diff --git a/run_branches b/run_branches deleted file mode 120000 index cfa3bcc..0000000 --- a/run_branches +++ /dev/null @@ -1 +0,0 @@ -run_branches.pl \ No newline at end of file diff --git a/run_branches b/run_branches new file mode 100755 index 0000000..e837aa9 --- /dev/null +++ b/run_branches @@ -0,0 +1,254 @@ +#!/usr/bin/perl + +=comment + +Copyright (c) 2003-2010, Andrew Dunstan + +See accompanying License file for license details + +=cut + +use vars qw($VERSION); $VERSION = 'REL_0.1'; + +use strict; +use warnings; +use Fcntl qw(:flock :seek); +use EximBuild::Options; +use File::Basename; + +if ($0 =~ /(.*)\.pl$/) { + die "$0: Please use `@{[join ' ' => $1, @ARGV]}' instead.\n" + if -t; + exec $1, @ARGV; +} + +my %branch_last; +sub branch_last_sort; + +my $run_build; +($run_build = $0) =~ s/run_branches/run_build/; + +my($run_all, $run_one); +my %extra_options =( + 'run-all' => \$run_all, + 'run-one' => \$run_one, +); + +# process the command line +EximBuild::Options::fetch_options(%extra_options); + +# no non-option args allowed here +die("$0: non-option arguments not permitted") + if @ARGV; + +die "only one of --run-all and --run-one permitted" + if ($run_all && $run_one); + +die "need one of --run-all and --run-one" + unless ($run_all || $run_one); + +# common mistake +die "need group searchable homedir" + unless (stat($ENV{HOME}) & 0550 == 0550); + +# set up a "branch" variable for processing the config file +use vars qw($branch); +$branch = 'global'; + +# +# process config file +# +require $buildconf; + +unless ( + ( + ref $EximBuild::conf{branches_to_build} eq 'ARRAY' + &&@{$EximBuild::conf{branches_to_build}} + ) + ||$EximBuild::conf{branches_to_build} =~ + /^(ALL|HEAD_PLUS_LATEST|HEAD_PLUS_LATEST2)$/ + ) +{ + die "no branches_to_build specified in $buildconf"; +} + +my @branches; +if (ref $EximBuild::conf{branches_to_build}) +{ + @branches = @{$EximBuild::conf{branches_to_build}}; +} +elsif ($EximBuild::conf{branches_to_build} =~ + /^(ALL|HEAD_PLUS_LATEST|HEAD_PLUS_LATEST2)$/ ) +{ + + # Need to set the path here so we make sure we pick up the right perl. + # It has to be the perl that the build script would choose + # i.e. specially *not* the MinGW SDK perl that is invoked for the + # build script, which means we need to put the path back the way it was + # when we're done + my $save_path = $ENV{PATH}; + $ENV{PATH} = $EximBuild::conf{build_env}->{PATH} + if ($EximBuild::conf{build_env}->{PATH}); + (my $url = $EximBuild::conf{target}) =~s/cgi-bin.*/branches_of_interest.txt/; + my $branches_of_interest = `perl -MLWP::Simple -e "getprint(q{$url})"`; + die "getting branches of interest" unless $branches_of_interest; + $ENV{PATH} = $save_path; + push(@branches,$_)foreach (split(/\s+/,$branches_of_interest)); + #splice(@branches,0,-2) + # if $EximBuild::conf{branches_to_build} eq 'HEAD_PLUS_LATEST'; + #splice(@branches,0,-3) + # if $EximBuild::conf{branches_to_build} eq 'HEAD_PLUS_LATEST2'; +} + +@branches = apply_throttle(@branches); + +my $global_lock_dir = + $EximBuild::conf{global_lock_dir} + ||$EximBuild::conf{build_root} + ||''; + +unless ($global_lock_dir && -d $global_lock_dir) +{ + die "no global lock directory: $global_lock_dir"; +} + +# acquire the lock + +my $lockfile; + +my $lockfilename = "$global_lock_dir/GLOBAL.lck"; + +open($lockfile, ">$lockfilename") || die "opening lockfile: $!"; + +if ( !flock($lockfile,LOCK_EX|LOCK_NB) ) +{ + print "Another process holds the lock on " ."$lockfilename. Exiting.\n" + if ($verbose); + exit(0); +} + +if ($run_all) +{ + foreach my $brnch(@branches) + { + run_branch($brnch); + } +} +elsif ($run_one) +{ + + # sort the branches by the order in which they last did actual work + # then try running them in that order until one does some work + + %branch_last = map {$_ => find_last_status($_)} @branches; + foreach my $brnch(sort branch_last_sort @branches) + { + run_branch($brnch); + my $new_status = find_last_status($brnch); + last if $new_status != $branch_last{$brnch}; + } +} + +exit 0; + +########################################################## + +sub run_branch +{ + my $branch = shift; + my @args = ($run_build,EximBuild::Options::standard_option_list(), $branch); + + # Explicitly use perl from the path (and not this perl, so don't use $^X) + # This script needs to run on Cygwin with non-cygwin perl if it's running + # in tandem with AS/MinGW perl, since Cygwin perl doesn't honor locks + # the samne way, and the global lock fails. But the build script needs + # to run with the native perl, even on Cygwin, which it picks up from + # the path. (Head exploding yet?). + system("perl",@args); +} + +sub branch_last_sort +{ + return $branch_last{$a} <=> $branch_last{$b}; +} + +sub find_last_status +{ + my $brnch = shift; + my $status_file = + "$EximBuild::conf{build_root}/$brnch/$EximBuild::conf{animal}.last.status"; + return 0 unless (-e $status_file); + my $handle; + open($handle,$status_file) || dir $!; + my $ts = <$handle>; + chomp $ts; + close($handle); + return $ts + 0; +} + +sub apply_throttle +{ + my @branches = @_; + return @branches unless exists $EximBuild::conf{throttle}; + my @result; + my %throttle = %{$EximBuild::conf{throttle}}; + + # implement throttle keywords ALL !HEAD and !RECENT + my @candidates; + my $replacement; + if (exists $throttle{ALL}) + { + @candidates = @branches; + $replacement = $throttle{ALL}; + } + elsif (exists $throttle{'!HEAD'}) + { + @candidates = grep { $_ ne 'HEAD' } @branches; + $replacement = $throttle{'!HEAD'}; + } + elsif (exists $throttle{'!RECENT'}) + { + + # sort branches, make sure we get numeric major version sorting right + my @stable = grep { $_ ne 'HEAD' } @branches; + s/^REL(\d)_/0$1/ foreach (@stable); + @stable = sort @stable; + s/^REL0/REL/ foreach (@stable); + pop @stable; # remove latest + @candidates = @stable; + $replacement = $throttle{'!RECENT'}; + } + foreach my $cand (@candidates) + { + + # only supply this for the branch if there isn't already + # a throttle + $throttle{$cand} ||= $replacement; + } + + # apply throttle filters + foreach my $branch(@branches) + { + my $this_throttle = $throttle{$branch}; + unless (defined $this_throttle) + { + push(@result,$branch); + next; + } + my $minh = $this_throttle->{min_hours_since}; + my $ts = find_last_status($branch); + next + if ( $ts + && (defined $minh) + &&($minh && $minh < ((time - $ts) / 3600.0))); + if (exists $this_throttle->{allowed_hours}) + { + my @allowed_hours = split(/,/,$this_throttle->{allowed_hours}); + my $hour = (localtime(time))[2]; + next unless grep {$_ == $hour} @allowed_hours; + } + push(@result,$branch); + } + + return @result; +}