2010-09-30 14:29:15 +00:00
|
|
|
#! @perl@ -w -I@nix@/libexec/nix
|
2008-11-10 13:33:12 +00:00
|
|
|
|
|
|
|
use strict;
|
2008-11-11 14:45:33 +00:00
|
|
|
use Cwd;
|
2008-11-28 14:36:04 +00:00
|
|
|
use File::Basename;
|
2008-11-29 01:20:13 +00:00
|
|
|
use POSIX qw(dup2 :sys_wait_h);
|
2008-11-25 11:09:15 +00:00
|
|
|
use Hydra::Schema;
|
2008-11-28 14:36:04 +00:00
|
|
|
use Hydra::Helper::Nix;
|
2011-08-19 16:09:14 +00:00
|
|
|
use IO::Handle;
|
2010-04-13 08:42:44 +00:00
|
|
|
use Nix;
|
2008-11-10 13:33:12 +00:00
|
|
|
|
2008-11-28 14:36:04 +00:00
|
|
|
chdir getHydraPath or die;
|
|
|
|
my $db = openHydraDB;
|
2008-11-10 13:33:12 +00:00
|
|
|
|
2009-04-22 22:59:54 +00:00
|
|
|
STDOUT->autoflush();
|
|
|
|
|
2008-11-29 01:20:13 +00:00
|
|
|
#$SIG{CHLD} = 'IGNORE';
|
2008-11-29 01:01:22 +00:00
|
|
|
|
2008-11-10 13:33:12 +00:00
|
|
|
|
2008-11-28 11:16:53 +00:00
|
|
|
sub unlockDeadBuilds {
|
|
|
|
# Unlock builds whose building process has died.
|
2009-04-22 22:43:04 +00:00
|
|
|
txn_do($db, sub {
|
2008-11-28 11:16:53 +00:00
|
|
|
my @builds = $db->resultset('Builds')->search(
|
2008-11-28 11:00:55 +00:00
|
|
|
{finished => 0, busy => 1}, {join => 'schedulingInfo'});
|
2008-11-28 11:16:53 +00:00
|
|
|
foreach my $build (@builds) {
|
|
|
|
my $pid = $build->schedulingInfo->locker;
|
2008-11-29 01:20:13 +00:00
|
|
|
my $unlock = 0;
|
|
|
|
if ($pid == $$) {
|
|
|
|
# Work around sqlite locking timeouts: if the child
|
|
|
|
# barfed because of a locked DB before updating the
|
|
|
|
# `locker' field, then `locker' is still set to $$.
|
2008-11-29 01:26:51 +00:00
|
|
|
# So if after a minute it hasn't been updated,
|
2008-11-29 01:20:13 +00:00
|
|
|
# unlock the build. !!! need a better fix for those
|
|
|
|
# locking timeouts.
|
2008-11-29 01:26:51 +00:00
|
|
|
if ($build->schedulingInfo->starttime + 60 < time) {
|
2008-11-29 01:20:13 +00:00
|
|
|
$unlock = 1;
|
|
|
|
}
|
|
|
|
} elsif (kill(0, $pid) != 1) { # see if we can signal the process
|
|
|
|
$unlock = 1;
|
|
|
|
}
|
|
|
|
if ($unlock) {
|
2008-11-28 11:16:53 +00:00
|
|
|
print "build ", $build->id, " pid $pid died, unlocking\n";
|
|
|
|
$build->schedulingInfo->busy(0);
|
|
|
|
$build->schedulingInfo->locker("");
|
|
|
|
$build->schedulingInfo->update;
|
2008-11-28 11:00:55 +00:00
|
|
|
}
|
2008-11-10 13:33:12 +00:00
|
|
|
}
|
2008-11-28 11:00:55 +00:00
|
|
|
});
|
|
|
|
}
|
2008-11-10 13:33:12 +00:00
|
|
|
|
2010-08-31 16:19:33 +00:00
|
|
|
|
2010-04-13 08:42:44 +00:00
|
|
|
sub findBuildDependencyInQueue {
|
|
|
|
my ($build) = @_;
|
|
|
|
my $drvpath = $build->drvpath;
|
|
|
|
my @paths = reverse(split '\n', `nix-store -qR $drvpath`);
|
2010-04-23 11:33:06 +00:00
|
|
|
|
2010-08-31 16:19:33 +00:00
|
|
|
my $depBuild;
|
|
|
|
my @drvs = ();
|
2010-04-13 08:42:44 +00:00
|
|
|
foreach my $path (@paths) {
|
2010-08-31 16:19:33 +00:00
|
|
|
push @drvs, $path if $path =~ /\.drv$/ && $path ne $drvpath;
|
|
|
|
}
|
|
|
|
|
|
|
|
return unless scalar @drvs > 0;
|
|
|
|
|
|
|
|
($depBuild) = $db->resultset('Builds')->search(
|
|
|
|
{ drvpath => [ @drvs ], finished => 0, busy => 0, enabled => 1, disabled => 0 },
|
|
|
|
{ join => ['schedulingInfo', 'project'], rows => 1 } ) ;
|
|
|
|
return $depBuild;
|
2010-04-13 08:42:44 +00:00
|
|
|
}
|
2008-11-10 13:33:12 +00:00
|
|
|
|
2010-08-31 16:19:33 +00:00
|
|
|
|
2008-11-28 11:16:53 +00:00
|
|
|
sub checkBuilds {
|
|
|
|
print "looking for runnable builds...\n";
|
2008-11-10 13:33:12 +00:00
|
|
|
|
2008-11-28 11:16:53 +00:00
|
|
|
my @buildsStarted;
|
2008-11-10 13:33:12 +00:00
|
|
|
|
2009-04-22 22:43:04 +00:00
|
|
|
txn_do($db, sub {
|
2008-11-10 13:33:12 +00:00
|
|
|
|
2008-11-26 14:20:50 +00:00
|
|
|
# Get the system types for the runnable builds.
|
|
|
|
my @systemTypes = $db->resultset('Builds')->search(
|
2008-11-30 18:53:58 +00:00
|
|
|
{ finished => 0, busy => 0, enabled => 1, disabled => 0 },
|
2009-10-08 11:19:17 +00:00
|
|
|
{ join => ['schedulingInfo', 'project'], select => ['system'], as => ['system'], distinct => 1 });
|
2010-04-13 08:42:44 +00:00
|
|
|
|
2008-11-26 14:20:50 +00:00
|
|
|
# For each system type, select up to the maximum number of
|
|
|
|
# concurrent build for that system type. Choose the highest
|
|
|
|
# priority builds first, then the oldest builds.
|
|
|
|
foreach my $system (@systemTypes) {
|
|
|
|
# How many builds are already currently executing for this
|
|
|
|
# system type?
|
|
|
|
my $nrActive = $db->resultset('Builds')->search(
|
|
|
|
{finished => 0, busy => 1, system => $system->system},
|
|
|
|
{join => 'schedulingInfo'})->count;
|
|
|
|
|
|
|
|
# How many extra builds can we start?
|
2008-12-16 16:26:33 +00:00
|
|
|
(my $systemTypeInfo) = $db->resultset('SystemTypes')->search({system => $system->system});
|
2008-11-26 17:14:27 +00:00
|
|
|
my $maxConcurrent = defined $systemTypeInfo ? $systemTypeInfo->maxconcurrent : 2;
|
|
|
|
my $extraAllowed = $maxConcurrent - $nrActive;
|
2008-11-26 14:20:50 +00:00
|
|
|
$extraAllowed = 0 if $extraAllowed < 0;
|
|
|
|
|
|
|
|
# Select the highest-priority builds to start.
|
2008-11-28 11:16:53 +00:00
|
|
|
my @builds = $extraAllowed == 0 ? () : $db->resultset('Builds')->search(
|
2008-11-30 18:53:58 +00:00
|
|
|
{ finished => 0, busy => 0, system => $system->system, enabled => 1, disabled => 0 },
|
|
|
|
{ join => ['schedulingInfo', 'project'], order_by => ["priority DESC", "timestamp"],
|
2008-11-26 14:20:50 +00:00
|
|
|
rows => $extraAllowed });
|
|
|
|
|
|
|
|
print "system type `", $system->system,
|
2008-11-26 17:14:27 +00:00
|
|
|
"': $nrActive active, $maxConcurrent allowed, ",
|
2008-11-28 11:16:53 +00:00
|
|
|
"starting ", scalar(@builds), " builds\n";
|
2008-11-26 14:20:50 +00:00
|
|
|
|
2008-11-28 11:16:53 +00:00
|
|
|
foreach my $build (@builds) {
|
2010-04-23 11:33:06 +00:00
|
|
|
my $depbuild = findBuildDependencyInQueue($build);
|
2010-08-31 16:19:33 +00:00
|
|
|
$build = $depbuild if defined $depbuild;
|
2010-04-13 08:42:44 +00:00
|
|
|
|
2008-11-28 11:16:53 +00:00
|
|
|
my $logfile = getcwd . "/logs/" . $build->id;
|
2008-11-28 14:36:04 +00:00
|
|
|
mkdir(dirname $logfile);
|
2008-11-27 19:06:11 +00:00
|
|
|
unlink($logfile);
|
2008-11-28 11:16:53 +00:00
|
|
|
$build->schedulingInfo->busy(1);
|
|
|
|
$build->schedulingInfo->locker($$);
|
|
|
|
$build->schedulingInfo->logfile($logfile);
|
|
|
|
$build->schedulingInfo->starttime(time);
|
|
|
|
$build->schedulingInfo->update;
|
|
|
|
push @buildsStarted, $build;
|
2008-11-26 14:20:50 +00:00
|
|
|
}
|
2008-11-10 13:33:12 +00:00
|
|
|
}
|
|
|
|
});
|
|
|
|
|
2008-11-26 14:20:50 +00:00
|
|
|
# Actually start the builds we just selected. We need to do this
|
|
|
|
# outside the transaction in case it aborts or something.
|
2008-11-28 11:16:53 +00:00
|
|
|
foreach my $build (@buildsStarted) {
|
|
|
|
my $id = $build->id;
|
2009-03-31 16:09:04 +00:00
|
|
|
print "starting build $id (", $build->project->name, ":", $build->jobset->name, ':', $build->job->name, ") on ", $build->system, "\n";
|
2008-11-10 13:33:12 +00:00
|
|
|
eval {
|
2008-11-28 11:16:53 +00:00
|
|
|
my $logfile = $build->schedulingInfo->logfile;
|
2008-11-11 10:27:36 +00:00
|
|
|
my $child = fork();
|
|
|
|
die unless defined $child;
|
|
|
|
if ($child == 0) {
|
2008-11-28 14:36:04 +00:00
|
|
|
eval {
|
|
|
|
open LOG, ">$logfile" or die "cannot create logfile $logfile";
|
|
|
|
POSIX::dup2(fileno(LOG), 1) or die;
|
|
|
|
POSIX::dup2(fileno(LOG), 2) or die;
|
2008-11-28 16:13:06 +00:00
|
|
|
exec("hydra_build.pl", $id);
|
2008-11-28 14:36:04 +00:00
|
|
|
};
|
|
|
|
warn "cannot start build $id: $@";
|
2008-11-26 14:20:50 +00:00
|
|
|
POSIX::_exit(1);
|
2008-11-11 10:27:36 +00:00
|
|
|
}
|
2008-11-10 13:33:12 +00:00
|
|
|
};
|
|
|
|
if ($@) {
|
|
|
|
warn $@;
|
2009-04-22 22:43:04 +00:00
|
|
|
txn_do($db, sub {
|
2008-11-28 11:16:53 +00:00
|
|
|
$build->schedulingInfo->busy(0);
|
|
|
|
$build->schedulingInfo->locker($$);
|
|
|
|
$build->schedulingInfo->update;
|
2008-11-10 13:33:12 +00:00
|
|
|
});
|
|
|
|
}
|
|
|
|
}
|
2008-11-11 10:27:36 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
|
2009-03-12 14:18:30 +00:00
|
|
|
if (scalar(@ARGV) == 1 && $ARGV[0] eq "--unlock") {
|
|
|
|
unlockDeadBuilds;
|
|
|
|
exit 0;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2008-11-11 10:27:36 +00:00
|
|
|
while (1) {
|
|
|
|
eval {
|
2008-11-29 01:20:13 +00:00
|
|
|
# Clean up zombies.
|
|
|
|
while ((waitpid(-1, &WNOHANG)) > 0) { };
|
|
|
|
|
2008-11-28 11:16:53 +00:00
|
|
|
unlockDeadBuilds;
|
2008-11-29 01:20:13 +00:00
|
|
|
|
2008-11-28 11:16:53 +00:00
|
|
|
checkBuilds;
|
2008-11-11 10:27:36 +00:00
|
|
|
};
|
|
|
|
warn $@ if $@;
|
2008-11-10 13:33:12 +00:00
|
|
|
|
|
|
|
print "sleeping...\n";
|
2008-11-12 11:09:21 +00:00
|
|
|
sleep(5);
|
2008-11-10 13:33:12 +00:00
|
|
|
}
|