+#!/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;
+}
git://git.exim.org / buildfarm-client.git / blobdiff