hydra/src/script/hydra-queue-runner
Eelco Dolstra 82d17a2d0b Rename hydra_*.pl to hydra-*
The underscores are ugly and the .pl extension is an implementation
detail that shouldn't be visible to the outside.

Also, get rid of the *.in files.  It's not really necessary to
generate them.  And I was always modifying the wrong file.
2011-11-30 18:14:48 +01:00

179 lines
6 KiB
Perl
Executable file

#! /var/run/current-system/sw/bin/perl -w
use strict;
use Cwd;
use File::Basename;
use POSIX qw(dup2 :sys_wait_h);
use Hydra::Schema;
use Hydra::Helper::Nix;
use IO::Handle;
use Nix::Store;
chdir getHydraPath or die;
my $db = openHydraDB;
STDOUT->autoflush();
#$SIG{CHLD} = 'IGNORE';
sub unlockDeadBuilds {
# Unlock builds whose building process has died.
txn_do($db, sub {
my @builds = $db->resultset('Builds')->search(
{finished => 0, busy => 1}, {join => 'schedulingInfo'});
foreach my $build (@builds) {
my $pid = $build->schedulingInfo->locker;
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 $$.
# So if after a minute it hasn't been updated,
# unlock the build. !!! need a better fix for those
# locking timeouts.
if ($build->schedulingInfo->starttime + 60 < time) {
$unlock = 1;
}
} elsif (kill(0, $pid) != 1) { # see if we can signal the process
$unlock = 1;
}
if ($unlock) {
print "build ", $build->id, " pid $pid died, unlocking\n";
$build->schedulingInfo->busy(0);
$build->schedulingInfo->locker("");
$build->schedulingInfo->update;
}
}
});
}
sub findBuildDependencyInQueue {
my ($build) = @_;
my $drvpath = $build->drvpath;
my @paths = reverse(split '\n', `nix-store -qR $drvpath`);
my $depBuild;
my @drvs = ();
foreach my $path (@paths) {
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;
}
sub checkBuilds {
print "looking for runnable builds...\n";
my @buildsStarted;
txn_do($db, sub {
# Get the system types for the runnable builds.
my @systemTypes = $db->resultset('Builds')->search(
{ finished => 0, busy => 0, enabled => 1, disabled => 0 },
{ join => ['schedulingInfo', 'project'], select => ['system'], as => ['system'], distinct => 1 });
# 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?
(my $systemTypeInfo) = $db->resultset('SystemTypes')->search({system => $system->system});
my $maxConcurrent = defined $systemTypeInfo ? $systemTypeInfo->maxconcurrent : 2;
my $extraAllowed = $maxConcurrent - $nrActive;
$extraAllowed = 0 if $extraAllowed < 0;
# Select the highest-priority builds to start.
my @builds = $extraAllowed == 0 ? () : $db->resultset('Builds')->search(
{ finished => 0, busy => 0, system => $system->system, enabled => 1, disabled => 0 },
{ join => ['schedulingInfo', 'project'], order_by => ["priority DESC", "timestamp"],
rows => $extraAllowed });
print "system type `", $system->system,
"': $nrActive active, $maxConcurrent allowed, ",
"starting ", scalar(@builds), " builds\n";
foreach my $build (@builds) {
my $depbuild = findBuildDependencyInQueue($build);
$build = $depbuild if defined $depbuild;
my $logfile = getcwd . "/logs/" . $build->id;
mkdir(dirname $logfile);
unlink($logfile);
$build->schedulingInfo->busy(1);
$build->schedulingInfo->locker($$);
$build->schedulingInfo->logfile($logfile);
$build->schedulingInfo->starttime(time);
$build->schedulingInfo->update;
push @buildsStarted, $build;
}
}
});
# Actually start the builds we just selected. We need to do this
# outside the transaction in case it aborts or something.
foreach my $build (@buildsStarted) {
my $id = $build->id;
print "starting build $id (", $build->project->name, ":", $build->jobset->name, ':', $build->job->name, ") on ", $build->system, "\n";
eval {
my $logfile = $build->schedulingInfo->logfile;
my $child = fork();
die unless defined $child;
if ($child == 0) {
eval {
open LOG, ">$logfile" or die "cannot create logfile $logfile";
POSIX::dup2(fileno(LOG), 1) or die;
POSIX::dup2(fileno(LOG), 2) or die;
exec("hydra-build", $id);
};
warn "cannot start build $id: $@";
POSIX::_exit(1);
}
};
if ($@) {
warn $@;
txn_do($db, sub {
$build->schedulingInfo->busy(0);
$build->schedulingInfo->locker($$);
$build->schedulingInfo->update;
});
}
}
}
if (scalar(@ARGV) == 1 && $ARGV[0] eq "--unlock") {
unlockDeadBuilds;
exit 0;
}
while (1) {
eval {
# Clean up zombies.
while ((waitpid(-1, &WNOHANG)) > 0) { };
unlockDeadBuilds;
checkBuilds;
};
warn $@ if $@;
print "sleeping...\n";
sleep(5);
}