X-Git-Url: https://git.exim.org/buildfarm-client.git/blobdiff_plain/c314f9bbd988fc5a07b455f0cd8738f178402d8a..707a4894cb762d150f48663ae8034224dfca183f:/run_branches?ds=inline

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;
+}