X-Git-Url: https://git.exim.org/buildfarm-client.git/blobdiff_plain/d2798308a264b502222b6883435c7a08782a87fd..5e7717c8bfb3c94d191403c9bf4fb61ac755b5fd:/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..e5194e1
--- /dev/null
+++ b/run_branches
@@ -0,0 +1,308 @@
+#!/usr/bin/env 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 5.010;
+
+use Fcntl qw(:flock :seek);
+use File::Basename;
+use FindBin qw($RealBin);
+use Cwd;
+
+use lib $RealBin;
+use EximBuild::Options;
+
+sub branch_last_sort;
+
+# Complain on old-style use (.pl extension), but only if a
+# terminal is available.
+if ($0 =~ /(.*)\.pl$/) {
+    die "$0: Please use `@{[join ' ' => $1, @ARGV]}' instead.\n"
+        if -t;
+    exec $1, @ARGV;
+}
+
+# Most of the client code assumes that our working directory
+# is the client code directory.
+my %CALLED = (
+    cwd => cwd(),
+    argv0 => $0,
+    argv => [@ARGV],	# get a copy!
+);
+chdir $RealBin or die "$0: Can't chdir to '$RealBin': $!\n";
+#say "Changed working directory to '$RealBin'" if -t;
+
+my %branch_last;
+my $run_build = './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 "$0: only one of --run-all and --run-one permitted"
+  if ($run_all && $run_one);
+
+die "$0: need one of --run-all and --run-one"
+  unless ($run_all || $run_one);
+
+# common mistake
+die "$0: 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;
+
+# Check if auto-update is wanted and possible
+eval {
+    if (not exists $EximBuild::Conf{auto_update} or $EximBuild::Conf{auto_update})
+    {
+	my $remote = $EximBuild::Conf{auto_update} // 'origin';
+
+	die "auto-update not possible: need write permissions in @{[cwd]}\n"
+	    if not -w '.';
+
+	# Get information about our remote and calculate the chance for a
+	# successfull auto-update. Based on:
+	# http://stackoverflow.com/questions/3258243/check-if-pull-needed-in-git
+	system("git fetch $remote") == 0 or die "'git fetch $remote' failed\n";
+	my ($upstream, $local, $base) = qx'git rev-parse ...@{upstream}' or die "'git rev-parse' failed\n";
+
+	$base =~ s/^\^//;
+
+	if ($upstream ne $local) {
+
+	    if ($base ne $local) {
+		die "the merge base is not local anymore. Refusing to `git pull`\n"
+	    }
+
+	    # if we're the merge base, the ff-only should work
+	    # except if there are local changes. We won't stop, if we
+	    # fail to update, but we'll issue a warning
+	    system("git pull --ff-only $remote") == 0 or die "git pull --ff-only\n";
+
+	    say "re-execute after update";
+	    chdir $CALLED{cwd} or die "Can't chdir to $CALLED{cwd}: $!\n";
+	    exec $CALLED{argv0}, @{$CALLED{argv}};
+	    die "Can't re-exec\n";
+	}
+    }
+};
+
+if ($@) {
+    chomp $@;
+    warn "Automatic updated failed with `$@'\n"
+	."Continue anyway\n";
+}
+
+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
+    local $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;
+    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}
+  // die "$0: need global_lock_dir\n";
+
+die "$0: need r/w permissions for directory '$global_lock_dir'\n"
+    if not -d -w $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 same 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;
+}