* Implemented the clone feature.

This commit is contained in:
Eelco Dolstra 2009-10-26 17:01:23 +00:00
parent f72367407a
commit e25f112b82
3 changed files with 196 additions and 153 deletions

View file

@ -404,11 +404,13 @@ sub clone_submit : Chained('build') PathPart('clone/submit') Args(0) {
requireProjectOwner($c, $build->project); requireProjectOwner($c, $build->project);
my ($nixExprPath, $nixExprInput) = Hydra::Controller::Jobset::nixExprPathFromParams $c; my ($nixExprPath, $nixExprInputName) = Hydra::Controller::Jobset::nixExprPathFromParams $c;
my $jobName = trim $c->request->params->{"jobname"}; my $jobName = trim $c->request->params->{"jobname"};
error($c, "Invalid job name: $jobName") if $jobName !~ /^$jobNameRE$/; error($c, "Invalid job name: $jobName") if $jobName !~ /^$jobNameRE$/;
my $inputInfo = {};
foreach my $param (keys %{$c->request->params}) { foreach my $param (keys %{$c->request->params}) {
next unless $param =~ /^input-(\w+)-name$/; next unless $param =~ /^input-(\w+)-name$/;
my $baseName = $1; my $baseName = $1;
@ -417,14 +419,40 @@ sub clone_submit : Chained('build') PathPart('clone/submit') Args(0) {
my $inputValue = Hydra::Controller::Jobset::checkInputValue( my $inputValue = Hydra::Controller::Jobset::checkInputValue(
$c, $inputType, $c->request->params->{"input-$baseName-value"}); $c, $inputType, $c->request->params->{"input-$baseName-value"});
eval { eval {
fetchInput( # !!! fetchInput can take a long time, which might cause
# the current HTTP request to time out. So maybe this
# should be done asynchronously. But then error reporting
# becomes harder.
my $info = fetchInput(
$c->model('DB'), $build->project, $build->jobset, $c->model('DB'), $build->project, $build->jobset,
$inputName, $inputType, $inputValue); $inputName, $inputType, $inputValue);
push @{$$inputInfo{$inputName}}, $info if defined $info;
}; };
error($c, $@) if $@; error($c, $@) if $@;
} }
$c->flash->{buildMsg} = "Build XXX added to the queue."; my ($jobs, $nixExprInput) = evalJobs($inputInfo, $nixExprInputName, $nixExprPath);
my $job;
foreach my $j (@{$jobs->{job}}) {
print STDERR $j->{jobName}, "\n";
if ($j->{jobName} eq $jobName) {
error($c, "Nix expression returned multiple builds for job $jobName.")
if $job;
$job = $j;
}
}
error($c, "Nix expression did not return a job named $jobName.") unless $job;
my %currentBuilds;
my $newBuild = checkBuild(
$c->model('DB'), $build->project, $build->jobset,
$inputInfo, $nixExprInput, $job, \%currentBuilds);
error($c, "This build has already been performed.") unless $newBuild;
$c->flash->{buildMsg} = "Build " . $newBuild->id . " added to the queue.";
$c->res->redirect($c->uri_for($c->controller('Root')->action_for('queue'))); $c->res->redirect($c->uri_for($c->controller('Root')->action_for('queue')));
} }

View file

@ -1,11 +1,14 @@
package Hydra::Helper::AddBuilds; package Hydra::Helper::AddBuilds;
use strict; use strict;
use feature 'switch';
use XML::Simple;
use POSIX qw(strftime); use POSIX qw(strftime);
use IPC::Run;
use Hydra::Helper::Nix; use Hydra::Helper::Nix;
our @ISA = qw(Exporter); our @ISA = qw(Exporter);
our @EXPORT = qw(fetchInput); our @EXPORT = qw(fetchInput evalJobs checkBuild);
sub getStorePathHash { sub getStorePathHash {
@ -224,3 +227,162 @@ sub fetchInput {
die "Input `" . $name . "' has unknown type `$type'."; die "Input `" . $name . "' has unknown type `$type'.";
} }
} }
sub inputsToArgs {
my ($inputInfo) = @_;
my @res = ();
foreach my $input (keys %{$inputInfo}) {
foreach my $alt (@{$inputInfo->{$input}}) {
given ($alt->{type}) {
when ("string") {
push @res, "--argstr", $input, $alt->{value};
}
when ("boolean") {
push @res, "--arg", $input, $alt->{value};
}
when (["svn", "path", "build"]) {
push @res, "--arg", $input, (
"{ outPath = builtins.storePath " . $alt->{storePath} . "" .
(defined $alt->{revision} ? "; rev = \"" . $alt->{revision} . "\"" : "") .
(defined $alt->{version} ? "; version = \"" . $alt->{version} . "\"" : "") .
";}"
);
}
}
}
}
return @res;
}
sub captureStdoutStderr {
my $stdin = ""; my $stdout; my $stderr;
my $res = IPC::Run::run(\@_, \$stdin, \$stdout, \$stderr);
return ($res, $stdout, $stderr);
}
sub evalJobs {
my ($inputInfo, $nixExprInputName, $nixExprPath) = @_;
my $nixExprInput = $inputInfo->{$nixExprInputName}->[0]
or die "Cannot find the input containing the job expression.\n";
die "Multiple alternatives for the input containing the Nix expression are not supported.\n"
if scalar @{$inputInfo->{$nixExprInputName}} != 1;
my $nixExprFullPath = $nixExprInput->{storePath} . "/" . $nixExprPath;
(my $res, my $jobsXml, my $stderr) = captureStdoutStderr(
"hydra_eval_jobs", $nixExprFullPath, "--gc-roots-dir", getGCRootsDir,
inputsToArgs($inputInfo));
die "Cannot evaluate the Nix expression containing the jobs:\n$stderr" unless $res;
print STDERR "$stderr";
my $jobs = XMLin(
$jobsXml,
ForceArray => ['error', 'job', 'arg'],
KeyAttr => [],
SuppressEmpty => '')
or die "cannot parse XML output";
return ($jobs, $nixExprInput);
}
# Check whether to add the build described by $buildInfo.
sub checkBuild {
my ($db, $project, $jobset, $inputInfo, $nixExprInput, $buildInfo, $currentBuilds) = @_;
my $jobName = $buildInfo->{jobName};
my $drvPath = $buildInfo->{drvPath};
my $outPath = $buildInfo->{outPath};
my $priority = 100;
$priority = int($buildInfo->{schedulingPriority})
if $buildInfo->{schedulingPriority} =~ /^\d+$/;
my $build;
txn_do($db, sub {
# Update the last evaluation time in the database.
my $job = $jobset->jobs->update_or_create(
{ name => $jobName
, lastevaltime => time
});
$job->update({firstevaltime => time})
unless defined $job->firstevaltime;
# Don't add a build that has already been scheduled for this
# job, or has been built but is still a "current" build for
# this job. Note that this means that if the sources of a job
# are changed from A to B and then reverted to A, three builds
# will be performed (though the last one will probably use the
# cached result from the first). This ensures that the builds
# with the highest ID will always be the ones that we want in
# the channels.
# !!! Checking $outPath doesn't take meta-attributes into
# account. For instance, do we want a new build to be
# scheduled if the meta.maintainers field is changed?
my @previousBuilds = $job->builds->search({outPath => $outPath, isCurrent => 1});
if (scalar(@previousBuilds) > 0) {
print STDERR "already scheduled/built\n";
$currentBuilds->{$_->id} = 1 foreach @previousBuilds;
return;
}
# Nope, so add it.
$build = $job->builds->create(
{ finished => 0
, timestamp => time()
, description => $buildInfo->{description}
, longdescription => $buildInfo->{longDescription}
, license => $buildInfo->{license}
, homepage => $buildInfo->{homepage}
, maintainers => $buildInfo->{maintainers}
, nixname => $buildInfo->{nixName}
, drvpath => $drvPath
, outpath => $outPath
, system => $buildInfo->{system}
, iscurrent => 1
, nixexprinput => $jobset->nixexprinput
, nixexprpath => $jobset->nixexprpath
});
print STDERR "added to queue as build ", $build->id, "\n";
$currentBuilds->{$build->id} = 1;
$build->create_related('buildschedulinginfo',
{ priority => $priority
, busy => 0
, locker => ""
});
my %inputs;
$inputs{$jobset->nixexprinput} = $nixExprInput;
foreach my $arg (@{$buildInfo->{arg}}) {
$inputs{$arg->{name}} = $inputInfo->{$arg->{name}}->[$arg->{altnr}]
|| die "invalid input";
}
foreach my $name (keys %inputs) {
my $input = $inputs{$name};
$build->buildinputs_builds->create(
{ name => $name
, type => $input->{type}
, uri => $input->{uri}
, revision => $input->{revision}
, value => $input->{value}
, dependency => $input->{id}
, path => $input->{storePath} || "" # !!! temporary hack
, sha256hash => $input->{sha256hash}
});
}
});
return $build;
};

View file

@ -2,11 +2,9 @@
use strict; use strict;
use feature 'switch'; use feature 'switch';
use XML::Simple;
use Hydra::Schema; use Hydra::Schema;
use Hydra::Helper::Nix; use Hydra::Helper::Nix;
use Hydra::Helper::AddBuilds; use Hydra::Helper::AddBuilds;
use IPC::Run;
STDOUT->autoflush(); STDOUT->autoflush();
@ -14,13 +12,6 @@ STDOUT->autoflush();
my $db = openHydraDB; my $db = openHydraDB;
sub captureStdoutStderr {
my $stdin = ""; my $stdout; my $stderr;
my $res = IPC::Run::run(\@_, \$stdin, \$stdout, \$stderr);
return ($res, $stdout, $stderr);
}
sub fetchInputs { sub fetchInputs {
my ($project, $jobset, $inputInfo) = @_; my ($project, $jobset, $inputInfo) = @_;
foreach my $input ($jobset->jobsetinputs->all) { foreach my $input ($jobset->jobsetinputs->all) {
@ -32,98 +23,6 @@ sub fetchInputs {
} }
# Check whether to add the build described by $buildInfo.
sub checkBuild {
my ($project, $jobset, $inputInfo, $nixExprInput, $buildInfo, $currentBuilds) = @_;
my $jobName = $buildInfo->{jobName};
my $drvPath = $buildInfo->{drvPath};
my $outPath = $buildInfo->{outPath};
my $priority = 100;
$priority = int($buildInfo->{schedulingPriority})
if $buildInfo->{schedulingPriority} =~ /^\d+$/;
txn_do($db, sub {
# Update the last evaluation time in the database.
my $job = $jobset->jobs->update_or_create(
{ name => $jobName
, lastevaltime => time
});
$job->update({firstevaltime => time})
unless defined $job->firstevaltime;
# Don't add a build that has already been scheduled for this
# job, or has been built but is still a "current" build for
# this job. Note that this means that if the sources of a job
# are changed from A to B and then reverted to A, three builds
# will be performed (though the last one will probably use the
# cached result from the first). This ensures that the builds
# with the highest ID will always be the ones that we want in
# the channels.
# !!! Checking $outPath doesn't take meta-attributes into
# account. For instance, do we want a new build to be
# scheduled if the meta.maintainers field is changed?
my @previousBuilds = $job->builds->search({outPath => $outPath, isCurrent => 1});
if (scalar(@previousBuilds) > 0) {
print "already scheduled/built\n";
$currentBuilds->{$_->id} = 1 foreach @previousBuilds;
return;
}
# Nope, so add it.
my $build = $job->builds->create(
{ finished => 0
, timestamp => time()
, description => $buildInfo->{description}
, longdescription => $buildInfo->{longDescription}
, license => $buildInfo->{license}
, homepage => $buildInfo->{homepage}
, maintainers => $buildInfo->{maintainers}
, nixname => $buildInfo->{nixName}
, drvpath => $drvPath
, outpath => $outPath
, system => $buildInfo->{system}
, iscurrent => 1
, nixexprinput => $jobset->nixexprinput
, nixexprpath => $jobset->nixexprpath
});
print "added to queue as build ", $build->id, "\n";
$currentBuilds->{$build->id} = 1;
$build->create_related('buildschedulinginfo',
{ priority => $priority
, busy => 0
, locker => ""
});
my %inputs;
$inputs{$jobset->nixexprinput} = $nixExprInput;
foreach my $arg (@{$buildInfo->{arg}}) {
$inputs{$arg->{name}} = $inputInfo->{$arg->{name}}->[$arg->{altnr}]
|| die "invalid input";
}
foreach my $name (keys %inputs) {
my $input = $inputs{$name};
$build->buildinputs_builds->create(
{ name => $name
, type => $input->{type}
, uri => $input->{uri}
, revision => $input->{revision}
, value => $input->{value}
, dependency => $input->{id}
, path => $input->{storePath} || "" # !!! temporary hack
, sha256hash => $input->{sha256hash}
});
}
});
};
sub setJobsetError { sub setJobsetError {
my ($jobset, $errorMsg) = @_; my ($jobset, $errorMsg) = @_;
eval { eval {
@ -134,35 +33,6 @@ sub setJobsetError {
} }
sub inputsToArgs {
my ($inputInfo) = @_;
my @res = ();
foreach my $input (keys %{$inputInfo}) {
foreach my $alt (@{$inputInfo->{$input}}) {
given ($alt->{type}) {
when ("string") {
push @res, "--argstr", $input, $alt->{value};
}
when ("boolean") {
push @res, "--arg", $input, $alt->{value};
}
when (["svn", "path", "build"]) {
push @res, "--arg", $input, (
"{ outPath = builtins.storePath " . $alt->{storePath} . "" .
(defined $alt->{revision} ? "; rev = \"" . $alt->{revision} . "\"" : "") .
(defined $alt->{version} ? "; version = \"" . $alt->{version} . "\"" : "") .
";}"
);
}
}
}
}
return @res;
}
sub permute { sub permute {
my @list = @_; my @list = @_;
for (my $n = scalar @list - 1; $n > 0; $n--) { for (my $n = scalar @list - 1; $n > 0; $n--) {
@ -181,31 +51,14 @@ sub checkJobset {
fetchInputs($project, $jobset, $inputInfo); fetchInputs($project, $jobset, $inputInfo);
# Evaluate the job expression. # Evaluate the job expression.
my $nixExprInput = $inputInfo->{$jobset->nixexprinput}->[0] my ($jobs, $nixExprInput) = evalJobs($inputInfo, $jobset->nixexprinput, $jobset->nixexprpath);
or die "cannot find the input containing the job expression";
die "multiple alternatives for the input containing the Nix expression are not supported"
if scalar @{$inputInfo->{$jobset->nixexprinput}} != 1;
my $nixExprPath = $nixExprInput->{storePath} . "/" . $jobset->nixexprpath;
(my $res, my $jobsXml, my $stderr) = captureStdoutStderr(
"hydra_eval_jobs", $nixExprPath, "--gc-roots-dir", getGCRootsDir,
inputsToArgs($inputInfo));
die "cannot evaluate the Nix expression containing the jobs:\n$stderr" unless $res;
print STDERR "$stderr";
my $jobs = XMLin($jobsXml,
ForceArray => ['error', 'job', 'arg'],
KeyAttr => [],
SuppressEmpty => '')
or die "cannot parse XML output";
# Schedule each successfully evaluated job. # Schedule each successfully evaluated job.
my %currentBuilds; my %currentBuilds;
foreach my $job (permute @{$jobs->{job}}) { foreach my $job (permute @{$jobs->{job}}) {
next if $job->{jobName} eq ""; next if $job->{jobName} eq "";
print "considering job " . $job->{jobName} . "\n"; print "considering job " . $job->{jobName} . "\n";
checkBuild($project, $jobset, $inputInfo, $nixExprInput, $job, \%currentBuilds); checkBuild($db, $project, $jobset, $inputInfo, $nixExprInput, $job, \%currentBuilds);
} }
txn_do($db, sub { txn_do($db, sub {