* Implemented the clone feature.
This commit is contained in:
parent
f72367407a
commit
e25f112b82
|
@ -404,11 +404,13 @@ sub clone_submit : Chained('build') PathPart('clone/submit') Args(0) {
|
|||
|
||||
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"};
|
||||
error($c, "Invalid job name: $jobName") if $jobName !~ /^$jobNameRE$/;
|
||||
|
||||
my $inputInfo = {};
|
||||
|
||||
foreach my $param (keys %{$c->request->params}) {
|
||||
next unless $param =~ /^input-(\w+)-name$/;
|
||||
my $baseName = $1;
|
||||
|
@ -417,14 +419,40 @@ sub clone_submit : Chained('build') PathPart('clone/submit') Args(0) {
|
|||
my $inputValue = Hydra::Controller::Jobset::checkInputValue(
|
||||
$c, $inputType, $c->request->params->{"input-$baseName-value"});
|
||||
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,
|
||||
$inputName, $inputType, $inputValue);
|
||||
push @{$$inputInfo{$inputName}}, $info if defined $info;
|
||||
};
|
||||
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')));
|
||||
}
|
||||
|
|
|
@ -1,11 +1,14 @@
|
|||
package Hydra::Helper::AddBuilds;
|
||||
|
||||
use strict;
|
||||
use feature 'switch';
|
||||
use XML::Simple;
|
||||
use POSIX qw(strftime);
|
||||
use IPC::Run;
|
||||
use Hydra::Helper::Nix;
|
||||
|
||||
our @ISA = qw(Exporter);
|
||||
our @EXPORT = qw(fetchInput);
|
||||
our @EXPORT = qw(fetchInput evalJobs checkBuild);
|
||||
|
||||
|
||||
sub getStorePathHash {
|
||||
|
@ -224,3 +227,162 @@ sub fetchInput {
|
|||
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;
|
||||
};
|
||||
|
|
|
@ -2,11 +2,9 @@
|
|||
|
||||
use strict;
|
||||
use feature 'switch';
|
||||
use XML::Simple;
|
||||
use Hydra::Schema;
|
||||
use Hydra::Helper::Nix;
|
||||
use Hydra::Helper::AddBuilds;
|
||||
use IPC::Run;
|
||||
|
||||
|
||||
STDOUT->autoflush();
|
||||
|
@ -14,13 +12,6 @@ STDOUT->autoflush();
|
|||
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 {
|
||||
my ($project, $jobset, $inputInfo) = @_;
|
||||
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 {
|
||||
my ($jobset, $errorMsg) = @_;
|
||||
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 {
|
||||
my @list = @_;
|
||||
for (my $n = scalar @list - 1; $n > 0; $n--) {
|
||||
|
@ -181,31 +51,14 @@ sub checkJobset {
|
|||
fetchInputs($project, $jobset, $inputInfo);
|
||||
|
||||
# Evaluate the job expression.
|
||||
my $nixExprInput = $inputInfo->{$jobset->nixexprinput}->[0]
|
||||
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";
|
||||
my ($jobs, $nixExprInput) = evalJobs($inputInfo, $jobset->nixexprinput, $jobset->nixexprpath);
|
||||
|
||||
# Schedule each successfully evaluated job.
|
||||
my %currentBuilds;
|
||||
foreach my $job (permute @{$jobs->{job}}) {
|
||||
next if $job->{jobName} eq "";
|
||||
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 {
|
||||
|
|
Loading…
Reference in a new issue