forked from lix-project/hydra
Move most of AddBuilds to hydra-eval-jobset
Having this stuff in a separate module is a remnant of the time when hydra-server could add builds to the queue directly. This is no longer the case.
This commit is contained in:
Eelco Dolstra
parent
7081f97f3a
commit
81ac547d2b
|
|
@ -5,7 +5,6 @@ use strict;
|
||||||
use warnings;
|
use warnings;
|
||||||
use base 'Hydra::Base::Controller::REST';
|
use base 'Hydra::Base::Controller::REST';
|
||||||
use Hydra::Helper::Nix;
|
use Hydra::Helper::Nix;
|
||||||
use Hydra::Helper::AddBuilds;
|
|
||||||
use Hydra::Helper::CatalystUtils;
|
use Hydra::Helper::CatalystUtils;
|
||||||
use Hydra::Controller::Project;
|
use Hydra::Controller::Project;
|
||||||
use JSON;
|
use JSON;
|
||||||
|
|
|
||||||
|
|
@ -5,7 +5,6 @@ use warnings;
|
||||||
use base 'Catalyst::Controller';
|
use base 'Catalyst::Controller';
|
||||||
use Hydra::Helper::Nix;
|
use Hydra::Helper::Nix;
|
||||||
use Hydra::Helper::CatalystUtils;
|
use Hydra::Helper::CatalystUtils;
|
||||||
use Hydra::Helper::AddBuilds;
|
|
||||||
use Data::Dump qw(dump);
|
use Data::Dump qw(dump);
|
||||||
use Digest::SHA1 qw(sha1_hex);
|
use Digest::SHA1 qw(sha1_hex);
|
||||||
use Config::General;
|
use Config::General;
|
||||||
|
|
|
||||||
|
|
@ -6,7 +6,6 @@ use warnings;
|
||||||
use base 'Hydra::Base::Controller::NixChannel';
|
use base 'Hydra::Base::Controller::NixChannel';
|
||||||
use Hydra::Helper::Nix;
|
use Hydra::Helper::Nix;
|
||||||
use Hydra::Helper::CatalystUtils;
|
use Hydra::Helper::CatalystUtils;
|
||||||
use Hydra::Helper::AddBuilds;
|
|
||||||
use File::stat;
|
use File::stat;
|
||||||
use File::Slurp;
|
use File::Slurp;
|
||||||
use Data::Dump qw(dump);
|
use Data::Dump qw(dump);
|
||||||
|
|
|
||||||
|
|
@ -4,7 +4,6 @@ use strict;
|
||||||
use utf8;
|
use utf8;
|
||||||
use Encode;
|
use Encode;
|
||||||
use JSON;
|
use JSON;
|
||||||
use IPC::Run;
|
|
||||||
use Nix::Store;
|
use Nix::Store;
|
||||||
use Nix::Config;
|
use Nix::Config;
|
||||||
use Hydra::Model::DB;
|
use Hydra::Model::DB;
|
||||||
|
|
@ -20,453 +19,11 @@ use Hydra::Helper::CatalystUtils;
|
||||||
|
|
||||||
our @ISA = qw(Exporter);
|
our @ISA = qw(Exporter);
|
||||||
our @EXPORT = qw(
|
our @EXPORT = qw(
|
||||||
fetchInput evalJobs checkBuild inputsToArgs
|
updateDeclarativeJobset
|
||||||
restartBuild getPrevJobsetEval updateDeclarativeJobset
|
|
||||||
handleDeclarativeJobsetBuild
|
handleDeclarativeJobsetBuild
|
||||||
);
|
);
|
||||||
|
|
||||||
|
|
||||||
sub parseJobName {
|
|
||||||
# Parse a job specification of the form `<project>:<jobset>:<job>
|
|
||||||
# [attrs]'. The project, jobset and attrs may be omitted. The
|
|
||||||
# attrs have the form `name = "value"'.
|
|
||||||
my ($s) = @_;
|
|
||||||
our $key;
|
|
||||||
our %attrs = ();
|
|
||||||
# hm, maybe I should stop programming Perl before it's too late...
|
|
||||||
$s =~ / ^ (?: (?: ($projectNameRE) : )? ($jobsetNameRE) : )? ($jobNameRE) \s*
|
|
||||||
(\[ \s* (
|
|
||||||
([\w]+) (?{ $key = $^N; }) \s* = \s* \"
|
|
||||||
([\w\-]+) (?{ $attrs{$key} = $^N; }) \"
|
|
||||||
\s* )* \])? $
|
|
||||||
/x
|
|
||||||
or die "invalid job specifier `$s'";
|
|
||||||
return ($1, $2, $3, \%attrs);
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
sub attrsToSQL {
|
|
||||||
my ($attrs, $id) = @_;
|
|
||||||
|
|
||||||
my $query = "1 = 1";
|
|
||||||
|
|
||||||
foreach my $name (keys %{$attrs}) {
|
|
||||||
my $value = $attrs->{$name};
|
|
||||||
$name =~ /^[\w\-]+$/ or die;
|
|
||||||
$value =~ /^[\w\-]+$/ or die;
|
|
||||||
# !!! Yes, this is horribly injection-prone... (though
|
|
||||||
# name/value are filtered above). Should use SQL::Abstract,
|
|
||||||
# but it can't deal with subqueries. At least we should use
|
|
||||||
# placeholders.
|
|
||||||
$query .= " and exists (select 1 from buildinputs where build = $id and name = '$name' and value = '$value')";
|
|
||||||
}
|
|
||||||
|
|
||||||
return $query;
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
sub fetchInputBuild {
|
|
||||||
my ($db, $project, $jobset, $name, $value) = @_;
|
|
||||||
|
|
||||||
my $prevBuild;
|
|
||||||
|
|
||||||
if ($value =~ /^\d+$/) {
|
|
||||||
$prevBuild = $db->resultset('Builds')->find({ id => int($value) });
|
|
||||||
} else {
|
|
||||||
my ($projectName, $jobsetName, $jobName, $attrs) = parseJobName($value);
|
|
||||||
$projectName ||= $project->name;
|
|
||||||
$jobsetName ||= $jobset->name;
|
|
||||||
|
|
||||||
# Pick the most recent successful build of the specified job.
|
|
||||||
$prevBuild = $db->resultset('Builds')->search(
|
|
||||||
{ finished => 1, project => $projectName, jobset => $jobsetName
|
|
||||||
, job => $jobName, buildStatus => 0 },
|
|
||||||
{ order_by => "me.id DESC", rows => 1
|
|
||||||
, where => \ attrsToSQL($attrs, "me.id") })->single;
|
|
||||||
}
|
|
||||||
|
|
||||||
return () if !defined $prevBuild || !isValidPath(getMainOutput($prevBuild)->path);
|
|
||||||
|
|
||||||
#print STDERR "input `", $name, "': using build ", $prevBuild->id, "\n";
|
|
||||||
|
|
||||||
my $pkgNameRE = "(?:(?:[A-Za-z0-9]|(?:-[^0-9]))+)";
|
|
||||||
my $versionRE = "(?:[A-Za-z0-9\.\-]+)";
|
|
||||||
|
|
||||||
my $relName = ($prevBuild->releasename or $prevBuild->nixname);
|
|
||||||
my $version = $2 if $relName =~ /^($pkgNameRE)-($versionRE)$/;
|
|
||||||
|
|
||||||
my $mainOutput = getMainOutput($prevBuild);
|
|
||||||
|
|
||||||
my $result =
|
|
||||||
{ storePath => $mainOutput->path
|
|
||||||
, id => $prevBuild->id
|
|
||||||
, version => $version
|
|
||||||
, outputName => $mainOutput->name
|
|
||||||
};
|
|
||||||
if (isValidPath($prevBuild->drvpath)) {
|
|
||||||
$result->{drvPath} = $prevBuild->drvpath;
|
|
||||||
}
|
|
||||||
|
|
||||||
return $result;
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
sub fetchInputSystemBuild {
|
|
||||||
my ($db, $project, $jobset, $name, $value) = @_;
|
|
||||||
|
|
||||||
my ($projectName, $jobsetName, $jobName, $attrs) = parseJobName($value);
|
|
||||||
$projectName ||= $project->name;
|
|
||||||
$jobsetName ||= $jobset->name;
|
|
||||||
|
|
||||||
my @latestBuilds = $db->resultset('LatestSucceededForJob')
|
|
||||||
->search({}, {bind => [$projectName, $jobsetName, $jobName]});
|
|
||||||
|
|
||||||
my @validBuilds = ();
|
|
||||||
foreach my $build (@latestBuilds) {
|
|
||||||
push(@validBuilds, $build) if isValidPath(getMainOutput($build)->path);
|
|
||||||
}
|
|
||||||
|
|
||||||
if (scalar(@validBuilds) == 0) {
|
|
||||||
print STDERR "input `", $name, "': no previous build available\n";
|
|
||||||
return ();
|
|
||||||
}
|
|
||||||
|
|
||||||
my @inputs = ();
|
|
||||||
|
|
||||||
foreach my $prevBuild (@validBuilds) {
|
|
||||||
my $pkgNameRE = "(?:(?:[A-Za-z0-9]|(?:-[^0-9]))+)";
|
|
||||||
my $versionRE = "(?:[A-Za-z0-9\.\-]+)";
|
|
||||||
|
|
||||||
my $relName = ($prevBuild->releasename or $prevBuild->nixname);
|
|
||||||
my $version = $2 if $relName =~ /^($pkgNameRE)-($versionRE)$/;
|
|
||||||
|
|
||||||
my $input =
|
|
||||||
{ storePath => getMainOutput($prevBuild)->path
|
|
||||||
, id => $prevBuild->id
|
|
||||||
, version => $version
|
|
||||||
, system => $prevBuild->system
|
|
||||||
};
|
|
||||||
push(@inputs, $input);
|
|
||||||
}
|
|
||||||
|
|
||||||
return @inputs;
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
sub fetchInputEval {
|
|
||||||
my ($db, $project, $jobset, $name, $value) = @_;
|
|
||||||
|
|
||||||
my $eval;
|
|
||||||
|
|
||||||
if ($value =~ /^\d+$/) {
|
|
||||||
$eval = $db->resultset('JobsetEvals')->find({ id => int($value) });
|
|
||||||
die "evaluation $eval->{id} does not exist\n" unless defined $eval;
|
|
||||||
} elsif ($value =~ /^($projectNameRE):($jobsetNameRE)$/) {
|
|
||||||
my $jobset = $db->resultset('Jobsets')->find({ project => $1, name => $2 });
|
|
||||||
die "jobset ‘$value’ does not exist\n" unless defined $jobset;
|
|
||||||
$eval = getLatestFinishedEval($jobset);
|
|
||||||
die "jobset ‘$value’ does not have a finished evaluation\n" unless defined $eval;
|
|
||||||
} elsif ($value =~ /^($projectNameRE):($jobsetNameRE):($jobNameRE)$/) {
|
|
||||||
$eval = $db->resultset('JobsetEvals')->find(
|
|
||||||
{ project => $1, jobset => $2, hasnewbuilds => 1 },
|
|
||||||
{ order_by => "id DESC", rows => 1
|
|
||||||
, where =>
|
|
||||||
\ [ # All builds in this jobset should be finished...
|
|
||||||
"not exists (select 1 from JobsetEvalMembers m join Builds b on m.build = b.id where m.eval = me.id and b.finished = 0) "
|
|
||||||
# ...and the specified build must have succeeded.
|
|
||||||
. "and exists (select 1 from JobsetEvalMembers m join Builds b on m.build = b.id where m.eval = me.id and b.job = ? and b.buildstatus = 0)"
|
|
||||||
, [ 'name', $3 ] ]
|
|
||||||
});
|
|
||||||
die "there is no successful build of ‘$value’ in a finished evaluation\n" unless defined $eval;
|
|
||||||
} else {
|
|
||||||
die;
|
|
||||||
}
|
|
||||||
|
|
||||||
my $jobs = {};
|
|
||||||
foreach my $build ($eval->builds) {
|
|
||||||
next unless $build->finished == 1 && $build->buildstatus == 0;
|
|
||||||
# FIXME: Handle multiple outputs.
|
|
||||||
my $out = $build->buildoutputs->find({ name => "out" });
|
|
||||||
next unless defined $out;
|
|
||||||
# FIXME: Should we fail if the path is not valid?
|
|
||||||
next unless isValidPath($out->path);
|
|
||||||
$jobs->{$build->get_column('job')} = $out->path;
|
|
||||||
}
|
|
||||||
|
|
||||||
return { jobs => $jobs };
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
sub fetchInput {
|
|
||||||
my ($plugins, $db, $project, $jobset, $name, $type, $value, $emailresponsible) = @_;
|
|
||||||
my @inputs;
|
|
||||||
|
|
||||||
if ($type eq "build") {
|
|
||||||
@inputs = fetchInputBuild($db, $project, $jobset, $name, $value);
|
|
||||||
}
|
|
||||||
elsif ($type eq "sysbuild") {
|
|
||||||
@inputs = fetchInputSystemBuild($db, $project, $jobset, $name, $value);
|
|
||||||
}
|
|
||||||
elsif ($type eq "eval") {
|
|
||||||
@inputs = fetchInputEval($db, $project, $jobset, $name, $value);
|
|
||||||
}
|
|
||||||
elsif ($type eq "string" || $type eq "nix") {
|
|
||||||
die unless defined $value;
|
|
||||||
@inputs = { value => $value };
|
|
||||||
}
|
|
||||||
elsif ($type eq "boolean") {
|
|
||||||
die unless defined $value && ($value eq "true" || $value eq "false");
|
|
||||||
@inputs = { value => $value };
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
my $found = 0;
|
|
||||||
foreach my $plugin (@{$plugins}) {
|
|
||||||
@inputs = $plugin->fetchInput($type, $name, $value, $project, $jobset);
|
|
||||||
if (defined $inputs[0]) {
|
|
||||||
$found = 1;
|
|
||||||
last;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
die "input `$name' has unknown type `$type'." unless $found;
|
|
||||||
}
|
|
||||||
|
|
||||||
foreach my $input (@inputs) {
|
|
||||||
$input->{type} = $type;
|
|
||||||
$input->{emailresponsible} = $emailresponsible;
|
|
||||||
}
|
|
||||||
|
|
||||||
return @inputs;
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
sub booleanToString {
|
|
||||||
my ($exprType, $value) = @_;
|
|
||||||
my $result;
|
|
||||||
if ($exprType eq "guile") {
|
|
||||||
if ($value eq "true") {
|
|
||||||
$result = "#t";
|
|
||||||
} else {
|
|
||||||
$result = "#f";
|
|
||||||
}
|
|
||||||
$result = $value;
|
|
||||||
} else {
|
|
||||||
$result = $value;
|
|
||||||
}
|
|
||||||
return $result;
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
sub buildInputToString {
|
|
||||||
my ($exprType, $input) = @_;
|
|
||||||
my $result;
|
|
||||||
if ($exprType eq "guile") {
|
|
||||||
$result = "'((file-name . \"" . ${input}->{storePath} . "\")" .
|
|
||||||
(defined $input->{revision} ? "(revision . \"" . $input->{revision} . "\")" : "") .
|
|
||||||
(defined $input->{revCount} ? "(revision-count . " . $input->{revCount} . ")" : "") .
|
|
||||||
(defined $input->{gitTag} ? "(git-tag . \"" . $input->{gitTag} . "\")" : "") .
|
|
||||||
(defined $input->{shortRev} ? "(short-revision . \"" . $input->{shortRev} . "\")" : "") .
|
|
||||||
(defined $input->{version} ? "(version . \"" . $input->{version} . "\")" : "") .
|
|
||||||
")";
|
|
||||||
} else {
|
|
||||||
$result = "{ outPath = builtins.storePath " . $input->{storePath} . "" .
|
|
||||||
"; inputType = \"" . $input->{type} . "\"" .
|
|
||||||
(defined $input->{uri} ? "; uri = \"" . $input->{uri} . "\"" : "") .
|
|
||||||
(defined $input->{revNumber} ? "; rev = " . $input->{revNumber} . "" : "") .
|
|
||||||
(defined $input->{revision} ? "; rev = \"" . $input->{revision} . "\"" : "") .
|
|
||||||
(defined $input->{revCount} ? "; revCount = " . $input->{revCount} . "" : "") .
|
|
||||||
(defined $input->{gitTag} ? "; gitTag = \"" . $input->{gitTag} . "\"" : "") .
|
|
||||||
(defined $input->{shortRev} ? "; shortRev = \"" . $input->{shortRev} . "\"" : "") .
|
|
||||||
(defined $input->{version} ? "; version = \"" . $input->{version} . "\"" : "") .
|
|
||||||
(defined $input->{outputName} ? "; outputName = \"" . $input->{outputName} . "\"" : "") .
|
|
||||||
(defined $input->{drvPath} ? "; drvPath = builtins.storePath " . $input->{drvPath} . "" : "") .
|
|
||||||
";}";
|
|
||||||
}
|
|
||||||
return $result;
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
sub inputsToArgs {
|
|
||||||
my ($inputInfo, $exprType) = @_;
|
|
||||||
my @res = ();
|
|
||||||
|
|
||||||
foreach my $input (sort keys %{$inputInfo}) {
|
|
||||||
push @res, "-I", "$input=$inputInfo->{$input}->[0]->{storePath}"
|
|
||||||
if scalar @{$inputInfo->{$input}} == 1
|
|
||||||
&& defined $inputInfo->{$input}->[0]->{storePath};
|
|
||||||
foreach my $alt (@{$inputInfo->{$input}}) {
|
|
||||||
if ($alt->{type} eq "string") {
|
|
||||||
push @res, "--argstr", $input, $alt->{value};
|
|
||||||
}
|
|
||||||
elsif ($alt->{type} eq "boolean") {
|
|
||||||
push @res, "--arg", $input, booleanToString($exprType, $alt->{value});
|
|
||||||
}
|
|
||||||
elsif ($alt->{type} eq "nix") {
|
|
||||||
die "input type ‘nix’ only supported for Nix-based jobsets\n" unless $exprType eq "nix";
|
|
||||||
push @res, "--arg", $input, $alt->{value};
|
|
||||||
}
|
|
||||||
elsif ($alt->{type} eq "eval") {
|
|
||||||
die "input type ‘eval’ only supported for Nix-based jobsets\n" unless $exprType eq "nix";
|
|
||||||
my $s = "{ ";
|
|
||||||
# FIXME: escape $_. But dots should not be escaped.
|
|
||||||
$s .= "$_ = builtins.storePath ${\$alt->{jobs}->{$_}}; "
|
|
||||||
foreach keys %{$alt->{jobs}};
|
|
||||||
$s .= "}";
|
|
||||||
push @res, "--arg", $input, $s;
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
push @res, "--arg", $input, buildInputToString($exprType, $alt);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
return @res;
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
sub evalJobs {
|
|
||||||
my ($inputInfo, $exprType, $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 $evaluator = ($exprType eq "guile") ? "hydra-eval-guile-jobs" : "hydra-eval-jobs";
|
|
||||||
|
|
||||||
my @cmd = ($evaluator, $nixExprFullPath, "--gc-roots-dir", getGCRootsDir, "-j", 1, inputsToArgs($inputInfo, $exprType));
|
|
||||||
|
|
||||||
if (defined $ENV{'HYDRA_DEBUG'}) {
|
|
||||||
sub escape {
|
|
||||||
my $s = $_;
|
|
||||||
$s =~ s/'/'\\''/g;
|
|
||||||
return "'" . $s . "'";
|
|
||||||
}
|
|
||||||
my @escaped = map escape, @cmd;
|
|
||||||
print STDERR "evaluator: @escaped\n";
|
|
||||||
}
|
|
||||||
|
|
||||||
(my $res, my $jobsJSON, my $stderr) = captureStdoutStderr(21600, @cmd);
|
|
||||||
die "$evaluator returned " . ($res & 127 ? "signal $res" : "exit code " . ($res >> 8))
|
|
||||||
. ":\n" . ($stderr ? decode("utf-8", $stderr) : "(no output)\n")
|
|
||||||
if $res;
|
|
||||||
|
|
||||||
print STDERR "$stderr";
|
|
||||||
|
|
||||||
return (decode_json($jobsJSON), $nixExprInput);
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
# Return the most recent evaluation of the given jobset (that
|
|
||||||
# optionally had new builds), or undefined if no such evaluation
|
|
||||||
# exists.
|
|
||||||
sub getPrevJobsetEval {
|
|
||||||
my ($db, $jobset, $hasNewBuilds) = @_;
|
|
||||||
my ($prevEval) = $jobset->jobsetevals(
|
|
||||||
($hasNewBuilds ? { hasnewbuilds => 1 } : { }),
|
|
||||||
{ order_by => "id DESC", rows => 1 });
|
|
||||||
return $prevEval;
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
# Check whether to add the build described by $buildInfo.
|
|
||||||
sub checkBuild {
|
|
||||||
my ($db, $jobset, $inputInfo, $nixExprInput, $buildInfo, $buildMap, $prevEval, $jobOutPathMap, $plugins) = @_;
|
|
||||||
|
|
||||||
my @outputNames = sort keys %{$buildInfo->{outputs}};
|
|
||||||
die unless scalar @outputNames;
|
|
||||||
|
|
||||||
# In various checks we can use an arbitrary output (the first)
|
|
||||||
# rather than all outputs, since if one output is the same, the
|
|
||||||
# others will be as well.
|
|
||||||
my $firstOutputName = $outputNames[0];
|
|
||||||
my $firstOutputPath = $buildInfo->{outputs}->{$firstOutputName};
|
|
||||||
|
|
||||||
my $jobName = $buildInfo->{jobName} or die;
|
|
||||||
my $drvPath = $buildInfo->{drvPath} or die;
|
|
||||||
|
|
||||||
my $build;
|
|
||||||
|
|
||||||
txn_do($db, sub {
|
|
||||||
my $job = $jobset->jobs->update_or_create({ name => $jobName });
|
|
||||||
|
|
||||||
# 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. FIXME: Checking the output paths 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?
|
|
||||||
if (defined $prevEval) {
|
|
||||||
# Only check one output: if it's the same, the other will be as well.
|
|
||||||
my $firstOutput = $outputNames[0];
|
|
||||||
my ($prevBuild) = $prevEval->builds->search(
|
|
||||||
# The "project" and "jobset" constraints are
|
|
||||||
# semantically unnecessary (because they're implied by
|
|
||||||
# the eval), but they give a factor 1000 speedup on
|
|
||||||
# the Nixpkgs jobset with PostgreSQL.
|
|
||||||
{ project => $jobset->project->name, jobset => $jobset->name, job => $jobName,
|
|
||||||
name => $firstOutputName, path => $firstOutputPath },
|
|
||||||
{ rows => 1, columns => ['id'], join => ['buildoutputs'] });
|
|
||||||
if (defined $prevBuild) {
|
|
||||||
#print STDERR " already scheduled/built as build ", $prevBuild->id, "\n";
|
|
||||||
$buildMap->{$prevBuild->id} = { id => $prevBuild->id, jobName => $jobName, new => 0, drvPath => $drvPath };
|
|
||||||
return;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
# Prevent multiple builds with the same (job, outPath) from
|
|
||||||
# being added.
|
|
||||||
my $prev = $$jobOutPathMap{$jobName . "\t" . $firstOutputPath};
|
|
||||||
if (defined $prev) {
|
|
||||||
#print STDERR " already scheduled as build ", $prev, "\n";
|
|
||||||
return;
|
|
||||||
}
|
|
||||||
|
|
||||||
my $time = time();
|
|
||||||
|
|
||||||
sub null {
|
|
||||||
my ($s) = @_;
|
|
||||||
return $s eq "" ? undef : $s;
|
|
||||||
}
|
|
||||||
|
|
||||||
# Add the build to the database.
|
|
||||||
$build = $job->builds->create(
|
|
||||||
{ timestamp => $time
|
|
||||||
, description => null($buildInfo->{description})
|
|
||||||
, license => null($buildInfo->{license})
|
|
||||||
, homepage => null($buildInfo->{homepage})
|
|
||||||
, maintainers => null($buildInfo->{maintainers})
|
|
||||||
, maxsilent => $buildInfo->{maxSilent}
|
|
||||||
, timeout => $buildInfo->{timeout}
|
|
||||||
, nixname => $buildInfo->{nixName}
|
|
||||||
, drvpath => $drvPath
|
|
||||||
, system => $buildInfo->{system}
|
|
||||||
, nixexprinput => $jobset->nixexprinput
|
|
||||||
, nixexprpath => $jobset->nixexprpath
|
|
||||||
, priority => $buildInfo->{schedulingPriority}
|
|
||||||
, finished => 0
|
|
||||||
, iscurrent => 1
|
|
||||||
, ischannel => $buildInfo->{isChannel}
|
|
||||||
});
|
|
||||||
|
|
||||||
$build->buildoutputs->create({ name => $_, path => $buildInfo->{outputs}->{$_} })
|
|
||||||
foreach @outputNames;
|
|
||||||
|
|
||||||
$buildMap->{$build->id} = { id => $build->id, jobName => $jobName, new => 1, drvPath => $drvPath };
|
|
||||||
$$jobOutPathMap{$jobName . "\t" . $firstOutputPath} = $build->id;
|
|
||||||
|
|
||||||
print STDERR "added build ${\$build->id} (${\$jobset->project->name}:${\$jobset->name}:$jobName)\n";
|
|
||||||
});
|
|
||||||
|
|
||||||
return $build;
|
|
||||||
};
|
|
||||||
|
|
||||||
|
|
||||||
sub updateDeclarativeJobset {
|
sub updateDeclarativeJobset {
|
||||||
my ($db, $project, $jobsetName, $declSpec) = @_;
|
my ($db, $project, $jobsetName, $declSpec) = @_;
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -10,6 +10,7 @@ use Hydra::Model::DB;
|
||||||
use Nix::Store;
|
use Nix::Store;
|
||||||
use Encode;
|
use Encode;
|
||||||
use Sys::Hostname::Long;
|
use Sys::Hostname::Long;
|
||||||
|
use IPC::Run;
|
||||||
|
|
||||||
our @ISA = qw(Exporter);
|
our @ISA = qw(Exporter);
|
||||||
our @EXPORT = qw(
|
our @EXPORT = qw(
|
||||||
|
|
|
||||||
|
|
@ -2,20 +2,23 @@
|
||||||
|
|
||||||
use strict;
|
use strict;
|
||||||
use utf8;
|
use utf8;
|
||||||
use Hydra::Schema;
|
|
||||||
use Hydra::Plugin;
|
|
||||||
use Hydra::Helper::Nix;
|
|
||||||
use Hydra::Helper::AddBuilds;
|
|
||||||
use Hydra::Helper::Email;
|
|
||||||
use Hydra::Model::DB;
|
|
||||||
use Digest::SHA qw(sha256_hex);
|
|
||||||
use Config::General;
|
use Config::General;
|
||||||
use Data::Dump qw(dump);
|
use Data::Dump qw(dump);
|
||||||
use Try::Tiny;
|
use Digest::SHA qw(sha256_hex);
|
||||||
use Net::Statsd;
|
use Encode;
|
||||||
use Time::HiRes qw(clock_gettime CLOCK_MONOTONIC);
|
|
||||||
use JSON;
|
|
||||||
use File::Slurp;
|
use File::Slurp;
|
||||||
|
use Hydra::Helper::AddBuilds;
|
||||||
|
use Hydra::Helper::CatalystUtils;
|
||||||
|
use Hydra::Helper::Email;
|
||||||
|
use Hydra::Helper::Nix;
|
||||||
|
use Hydra::Model::DB;
|
||||||
|
use Hydra::Plugin;
|
||||||
|
use Hydra::Schema;
|
||||||
|
use JSON;
|
||||||
|
use Net::Statsd;
|
||||||
|
use Nix::Store;
|
||||||
|
use Time::HiRes qw(clock_gettime CLOCK_MONOTONIC);
|
||||||
|
use Try::Tiny;
|
||||||
|
|
||||||
STDOUT->autoflush();
|
STDOUT->autoflush();
|
||||||
STDERR->autoflush(1);
|
STDERR->autoflush(1);
|
||||||
|
|
@ -29,6 +32,447 @@ my $plugins = [Hydra::Plugin->instantiate(db => $db, config => $config)];
|
||||||
my $dryRun = defined $ENV{'HYDRA_DRY_RUN'};
|
my $dryRun = defined $ENV{'HYDRA_DRY_RUN'};
|
||||||
|
|
||||||
|
|
||||||
|
sub parseJobName {
|
||||||
|
# Parse a job specification of the form `<project>:<jobset>:<job>
|
||||||
|
# [attrs]'. The project, jobset and attrs may be omitted. The
|
||||||
|
# attrs have the form `name = "value"'.
|
||||||
|
my ($s) = @_;
|
||||||
|
our $key;
|
||||||
|
our %attrs = ();
|
||||||
|
# hm, maybe I should stop programming Perl before it's too late...
|
||||||
|
$s =~ / ^ (?: (?: ($projectNameRE) : )? ($jobsetNameRE) : )? ($jobNameRE) \s*
|
||||||
|
(\[ \s* (
|
||||||
|
([\w]+) (?{ $key = $^N; }) \s* = \s* \"
|
||||||
|
([\w\-]+) (?{ $attrs{$key} = $^N; }) \"
|
||||||
|
\s* )* \])? $
|
||||||
|
/x
|
||||||
|
or die "invalid job specifier `$s'";
|
||||||
|
return ($1, $2, $3, \%attrs);
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
sub attrsToSQL {
|
||||||
|
my ($attrs, $id) = @_;
|
||||||
|
|
||||||
|
my $query = "1 = 1";
|
||||||
|
|
||||||
|
foreach my $name (keys %{$attrs}) {
|
||||||
|
my $value = $attrs->{$name};
|
||||||
|
$name =~ /^[\w\-]+$/ or die;
|
||||||
|
$value =~ /^[\w\-]+$/ or die;
|
||||||
|
# !!! Yes, this is horribly injection-prone... (though
|
||||||
|
# name/value are filtered above). Should use SQL::Abstract,
|
||||||
|
# but it can't deal with subqueries. At least we should use
|
||||||
|
# placeholders.
|
||||||
|
$query .= " and exists (select 1 from buildinputs where build = $id and name = '$name' and value = '$value')";
|
||||||
|
}
|
||||||
|
|
||||||
|
return $query;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
sub fetchInputBuild {
|
||||||
|
my ($db, $project, $jobset, $name, $value) = @_;
|
||||||
|
|
||||||
|
my $prevBuild;
|
||||||
|
|
||||||
|
if ($value =~ /^\d+$/) {
|
||||||
|
$prevBuild = $db->resultset('Builds')->find({ id => int($value) });
|
||||||
|
} else {
|
||||||
|
my ($projectName, $jobsetName, $jobName, $attrs) = parseJobName($value);
|
||||||
|
$projectName ||= $project->name;
|
||||||
|
$jobsetName ||= $jobset->name;
|
||||||
|
|
||||||
|
# Pick the most recent successful build of the specified job.
|
||||||
|
$prevBuild = $db->resultset('Builds')->search(
|
||||||
|
{ finished => 1, project => $projectName, jobset => $jobsetName
|
||||||
|
, job => $jobName, buildStatus => 0 },
|
||||||
|
{ order_by => "me.id DESC", rows => 1
|
||||||
|
, where => \ attrsToSQL($attrs, "me.id") })->single;
|
||||||
|
}
|
||||||
|
|
||||||
|
return () if !defined $prevBuild || !isValidPath(getMainOutput($prevBuild)->path);
|
||||||
|
|
||||||
|
#print STDERR "input `", $name, "': using build ", $prevBuild->id, "\n";
|
||||||
|
|
||||||
|
my $pkgNameRE = "(?:(?:[A-Za-z0-9]|(?:-[^0-9]))+)";
|
||||||
|
my $versionRE = "(?:[A-Za-z0-9\.\-]+)";
|
||||||
|
|
||||||
|
my $relName = ($prevBuild->releasename or $prevBuild->nixname);
|
||||||
|
my $version = $2 if $relName =~ /^($pkgNameRE)-($versionRE)$/;
|
||||||
|
|
||||||
|
my $mainOutput = getMainOutput($prevBuild);
|
||||||
|
|
||||||
|
my $result =
|
||||||
|
{ storePath => $mainOutput->path
|
||||||
|
, id => $prevBuild->id
|
||||||
|
, version => $version
|
||||||
|
, outputName => $mainOutput->name
|
||||||
|
};
|
||||||
|
if (isValidPath($prevBuild->drvpath)) {
|
||||||
|
$result->{drvPath} = $prevBuild->drvpath;
|
||||||
|
}
|
||||||
|
|
||||||
|
return $result;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
sub fetchInputSystemBuild {
|
||||||
|
my ($db, $project, $jobset, $name, $value) = @_;
|
||||||
|
|
||||||
|
my ($projectName, $jobsetName, $jobName, $attrs) = parseJobName($value);
|
||||||
|
$projectName ||= $project->name;
|
||||||
|
$jobsetName ||= $jobset->name;
|
||||||
|
|
||||||
|
my @latestBuilds = $db->resultset('LatestSucceededForJob')
|
||||||
|
->search({}, {bind => [$projectName, $jobsetName, $jobName]});
|
||||||
|
|
||||||
|
my @validBuilds = ();
|
||||||
|
foreach my $build (@latestBuilds) {
|
||||||
|
push(@validBuilds, $build) if isValidPath(getMainOutput($build)->path);
|
||||||
|
}
|
||||||
|
|
||||||
|
if (scalar(@validBuilds) == 0) {
|
||||||
|
print STDERR "input `", $name, "': no previous build available\n";
|
||||||
|
return ();
|
||||||
|
}
|
||||||
|
|
||||||
|
my @inputs = ();
|
||||||
|
|
||||||
|
foreach my $prevBuild (@validBuilds) {
|
||||||
|
my $pkgNameRE = "(?:(?:[A-Za-z0-9]|(?:-[^0-9]))+)";
|
||||||
|
my $versionRE = "(?:[A-Za-z0-9\.\-]+)";
|
||||||
|
|
||||||
|
my $relName = ($prevBuild->releasename or $prevBuild->nixname);
|
||||||
|
my $version = $2 if $relName =~ /^($pkgNameRE)-($versionRE)$/;
|
||||||
|
|
||||||
|
my $input =
|
||||||
|
{ storePath => getMainOutput($prevBuild)->path
|
||||||
|
, id => $prevBuild->id
|
||||||
|
, version => $version
|
||||||
|
, system => $prevBuild->system
|
||||||
|
};
|
||||||
|
push(@inputs, $input);
|
||||||
|
}
|
||||||
|
|
||||||
|
return @inputs;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
sub fetchInputEval {
|
||||||
|
my ($db, $project, $jobset, $name, $value) = @_;
|
||||||
|
|
||||||
|
my $eval;
|
||||||
|
|
||||||
|
if ($value =~ /^\d+$/) {
|
||||||
|
$eval = $db->resultset('JobsetEvals')->find({ id => int($value) });
|
||||||
|
die "evaluation $eval->{id} does not exist\n" unless defined $eval;
|
||||||
|
} elsif ($value =~ /^($projectNameRE):($jobsetNameRE)$/) {
|
||||||
|
my $jobset = $db->resultset('Jobsets')->find({ project => $1, name => $2 });
|
||||||
|
die "jobset ‘$value’ does not exist\n" unless defined $jobset;
|
||||||
|
$eval = getLatestFinishedEval($jobset);
|
||||||
|
die "jobset ‘$value’ does not have a finished evaluation\n" unless defined $eval;
|
||||||
|
} elsif ($value =~ /^($projectNameRE):($jobsetNameRE):($jobNameRE)$/) {
|
||||||
|
$eval = $db->resultset('JobsetEvals')->find(
|
||||||
|
{ project => $1, jobset => $2, hasnewbuilds => 1 },
|
||||||
|
{ order_by => "id DESC", rows => 1
|
||||||
|
, where =>
|
||||||
|
\ [ # All builds in this jobset should be finished...
|
||||||
|
"not exists (select 1 from JobsetEvalMembers m join Builds b on m.build = b.id where m.eval = me.id and b.finished = 0) "
|
||||||
|
# ...and the specified build must have succeeded.
|
||||||
|
. "and exists (select 1 from JobsetEvalMembers m join Builds b on m.build = b.id where m.eval = me.id and b.job = ? and b.buildstatus = 0)"
|
||||||
|
, [ 'name', $3 ] ]
|
||||||
|
});
|
||||||
|
die "there is no successful build of ‘$value’ in a finished evaluation\n" unless defined $eval;
|
||||||
|
} else {
|
||||||
|
die;
|
||||||
|
}
|
||||||
|
|
||||||
|
my $jobs = {};
|
||||||
|
foreach my $build ($eval->builds) {
|
||||||
|
next unless $build->finished == 1 && $build->buildstatus == 0;
|
||||||
|
# FIXME: Handle multiple outputs.
|
||||||
|
my $out = $build->buildoutputs->find({ name => "out" });
|
||||||
|
next unless defined $out;
|
||||||
|
# FIXME: Should we fail if the path is not valid?
|
||||||
|
next unless isValidPath($out->path);
|
||||||
|
$jobs->{$build->get_column('job')} = $out->path;
|
||||||
|
}
|
||||||
|
|
||||||
|
return { jobs => $jobs };
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
sub fetchInput {
|
||||||
|
my ($plugins, $db, $project, $jobset, $name, $type, $value, $emailresponsible) = @_;
|
||||||
|
my @inputs;
|
||||||
|
|
||||||
|
if ($type eq "build") {
|
||||||
|
@inputs = fetchInputBuild($db, $project, $jobset, $name, $value);
|
||||||
|
}
|
||||||
|
elsif ($type eq "sysbuild") {
|
||||||
|
@inputs = fetchInputSystemBuild($db, $project, $jobset, $name, $value);
|
||||||
|
}
|
||||||
|
elsif ($type eq "eval") {
|
||||||
|
@inputs = fetchInputEval($db, $project, $jobset, $name, $value);
|
||||||
|
}
|
||||||
|
elsif ($type eq "string" || $type eq "nix") {
|
||||||
|
die unless defined $value;
|
||||||
|
@inputs = { value => $value };
|
||||||
|
}
|
||||||
|
elsif ($type eq "boolean") {
|
||||||
|
die unless defined $value && ($value eq "true" || $value eq "false");
|
||||||
|
@inputs = { value => $value };
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
my $found = 0;
|
||||||
|
foreach my $plugin (@{$plugins}) {
|
||||||
|
@inputs = $plugin->fetchInput($type, $name, $value, $project, $jobset);
|
||||||
|
if (defined $inputs[0]) {
|
||||||
|
$found = 1;
|
||||||
|
last;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
die "input `$name' has unknown type `$type'." unless $found;
|
||||||
|
}
|
||||||
|
|
||||||
|
foreach my $input (@inputs) {
|
||||||
|
$input->{type} = $type;
|
||||||
|
$input->{emailresponsible} = $emailresponsible;
|
||||||
|
}
|
||||||
|
|
||||||
|
return @inputs;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
sub booleanToString {
|
||||||
|
my ($exprType, $value) = @_;
|
||||||
|
my $result;
|
||||||
|
if ($exprType eq "guile") {
|
||||||
|
if ($value eq "true") {
|
||||||
|
$result = "#t";
|
||||||
|
} else {
|
||||||
|
$result = "#f";
|
||||||
|
}
|
||||||
|
$result = $value;
|
||||||
|
} else {
|
||||||
|
$result = $value;
|
||||||
|
}
|
||||||
|
return $result;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
sub buildInputToString {
|
||||||
|
my ($exprType, $input) = @_;
|
||||||
|
my $result;
|
||||||
|
if ($exprType eq "guile") {
|
||||||
|
$result = "'((file-name . \"" . ${input}->{storePath} . "\")" .
|
||||||
|
(defined $input->{revision} ? "(revision . \"" . $input->{revision} . "\")" : "") .
|
||||||
|
(defined $input->{revCount} ? "(revision-count . " . $input->{revCount} . ")" : "") .
|
||||||
|
(defined $input->{gitTag} ? "(git-tag . \"" . $input->{gitTag} . "\")" : "") .
|
||||||
|
(defined $input->{shortRev} ? "(short-revision . \"" . $input->{shortRev} . "\")" : "") .
|
||||||
|
(defined $input->{version} ? "(version . \"" . $input->{version} . "\")" : "") .
|
||||||
|
")";
|
||||||
|
} else {
|
||||||
|
$result = "{ outPath = builtins.storePath " . $input->{storePath} . "" .
|
||||||
|
"; inputType = \"" . $input->{type} . "\"" .
|
||||||
|
(defined $input->{uri} ? "; uri = \"" . $input->{uri} . "\"" : "") .
|
||||||
|
(defined $input->{revNumber} ? "; rev = " . $input->{revNumber} . "" : "") .
|
||||||
|
(defined $input->{revision} ? "; rev = \"" . $input->{revision} . "\"" : "") .
|
||||||
|
(defined $input->{revCount} ? "; revCount = " . $input->{revCount} . "" : "") .
|
||||||
|
(defined $input->{gitTag} ? "; gitTag = \"" . $input->{gitTag} . "\"" : "") .
|
||||||
|
(defined $input->{shortRev} ? "; shortRev = \"" . $input->{shortRev} . "\"" : "") .
|
||||||
|
(defined $input->{version} ? "; version = \"" . $input->{version} . "\"" : "") .
|
||||||
|
(defined $input->{outputName} ? "; outputName = \"" . $input->{outputName} . "\"" : "") .
|
||||||
|
(defined $input->{drvPath} ? "; drvPath = builtins.storePath " . $input->{drvPath} . "" : "") .
|
||||||
|
";}";
|
||||||
|
}
|
||||||
|
return $result;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
sub inputsToArgs {
|
||||||
|
my ($inputInfo, $exprType) = @_;
|
||||||
|
my @res = ();
|
||||||
|
|
||||||
|
foreach my $input (sort keys %{$inputInfo}) {
|
||||||
|
push @res, "-I", "$input=$inputInfo->{$input}->[0]->{storePath}"
|
||||||
|
if scalar @{$inputInfo->{$input}} == 1
|
||||||
|
&& defined $inputInfo->{$input}->[0]->{storePath};
|
||||||
|
foreach my $alt (@{$inputInfo->{$input}}) {
|
||||||
|
if ($alt->{type} eq "string") {
|
||||||
|
push @res, "--argstr", $input, $alt->{value};
|
||||||
|
}
|
||||||
|
elsif ($alt->{type} eq "boolean") {
|
||||||
|
push @res, "--arg", $input, booleanToString($exprType, $alt->{value});
|
||||||
|
}
|
||||||
|
elsif ($alt->{type} eq "nix") {
|
||||||
|
die "input type ‘nix’ only supported for Nix-based jobsets\n" unless $exprType eq "nix";
|
||||||
|
push @res, "--arg", $input, $alt->{value};
|
||||||
|
}
|
||||||
|
elsif ($alt->{type} eq "eval") {
|
||||||
|
die "input type ‘eval’ only supported for Nix-based jobsets\n" unless $exprType eq "nix";
|
||||||
|
my $s = "{ ";
|
||||||
|
# FIXME: escape $_. But dots should not be escaped.
|
||||||
|
$s .= "$_ = builtins.storePath ${\$alt->{jobs}->{$_}}; "
|
||||||
|
foreach keys %{$alt->{jobs}};
|
||||||
|
$s .= "}";
|
||||||
|
push @res, "--arg", $input, $s;
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
push @res, "--arg", $input, buildInputToString($exprType, $alt);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
return @res;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
sub evalJobs {
|
||||||
|
my ($inputInfo, $exprType, $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 $evaluator = ($exprType eq "guile") ? "hydra-eval-guile-jobs" : "hydra-eval-jobs";
|
||||||
|
|
||||||
|
my @cmd = ($evaluator, $nixExprFullPath, "--gc-roots-dir", getGCRootsDir, "-j", 1, inputsToArgs($inputInfo, $exprType));
|
||||||
|
|
||||||
|
if (defined $ENV{'HYDRA_DEBUG'}) {
|
||||||
|
sub escape {
|
||||||
|
my $s = $_;
|
||||||
|
$s =~ s/'/'\\''/g;
|
||||||
|
return "'" . $s . "'";
|
||||||
|
}
|
||||||
|
my @escaped = map escape, @cmd;
|
||||||
|
print STDERR "evaluator: @escaped\n";
|
||||||
|
}
|
||||||
|
|
||||||
|
(my $res, my $jobsJSON, my $stderr) = captureStdoutStderr(21600, @cmd);
|
||||||
|
die "$evaluator returned " . ($res & 127 ? "signal $res" : "exit code " . ($res >> 8))
|
||||||
|
. ":\n" . ($stderr ? decode("utf-8", $stderr) : "(no output)\n")
|
||||||
|
if $res;
|
||||||
|
|
||||||
|
print STDERR "$stderr";
|
||||||
|
|
||||||
|
return (decode_json($jobsJSON), $nixExprInput);
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
# Return the most recent evaluation of the given jobset (that
|
||||||
|
# optionally had new builds), or undefined if no such evaluation
|
||||||
|
# exists.
|
||||||
|
sub getPrevJobsetEval {
|
||||||
|
my ($db, $jobset, $hasNewBuilds) = @_;
|
||||||
|
my ($prevEval) = $jobset->jobsetevals(
|
||||||
|
($hasNewBuilds ? { hasnewbuilds => 1 } : { }),
|
||||||
|
{ order_by => "id DESC", rows => 1 });
|
||||||
|
return $prevEval;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
# Check whether to add the build described by $buildInfo.
|
||||||
|
sub checkBuild {
|
||||||
|
my ($db, $jobset, $inputInfo, $nixExprInput, $buildInfo, $buildMap, $prevEval, $jobOutPathMap, $plugins) = @_;
|
||||||
|
|
||||||
|
my @outputNames = sort keys %{$buildInfo->{outputs}};
|
||||||
|
die unless scalar @outputNames;
|
||||||
|
|
||||||
|
# In various checks we can use an arbitrary output (the first)
|
||||||
|
# rather than all outputs, since if one output is the same, the
|
||||||
|
# others will be as well.
|
||||||
|
my $firstOutputName = $outputNames[0];
|
||||||
|
my $firstOutputPath = $buildInfo->{outputs}->{$firstOutputName};
|
||||||
|
|
||||||
|
my $jobName = $buildInfo->{jobName} or die;
|
||||||
|
my $drvPath = $buildInfo->{drvPath} or die;
|
||||||
|
|
||||||
|
my $build;
|
||||||
|
|
||||||
|
txn_do($db, sub {
|
||||||
|
my $job = $jobset->jobs->update_or_create({ name => $jobName });
|
||||||
|
|
||||||
|
# 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. FIXME: Checking the output paths 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?
|
||||||
|
if (defined $prevEval) {
|
||||||
|
# Only check one output: if it's the same, the other will be as well.
|
||||||
|
my $firstOutput = $outputNames[0];
|
||||||
|
my ($prevBuild) = $prevEval->builds->search(
|
||||||
|
# The "project" and "jobset" constraints are
|
||||||
|
# semantically unnecessary (because they're implied by
|
||||||
|
# the eval), but they give a factor 1000 speedup on
|
||||||
|
# the Nixpkgs jobset with PostgreSQL.
|
||||||
|
{ project => $jobset->project->name, jobset => $jobset->name, job => $jobName,
|
||||||
|
name => $firstOutputName, path => $firstOutputPath },
|
||||||
|
{ rows => 1, columns => ['id'], join => ['buildoutputs'] });
|
||||||
|
if (defined $prevBuild) {
|
||||||
|
#print STDERR " already scheduled/built as build ", $prevBuild->id, "\n";
|
||||||
|
$buildMap->{$prevBuild->id} = { id => $prevBuild->id, jobName => $jobName, new => 0, drvPath => $drvPath };
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
# Prevent multiple builds with the same (job, outPath) from
|
||||||
|
# being added.
|
||||||
|
my $prev = $$jobOutPathMap{$jobName . "\t" . $firstOutputPath};
|
||||||
|
if (defined $prev) {
|
||||||
|
#print STDERR " already scheduled as build ", $prev, "\n";
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
|
my $time = time();
|
||||||
|
|
||||||
|
sub null {
|
||||||
|
my ($s) = @_;
|
||||||
|
return $s eq "" ? undef : $s;
|
||||||
|
}
|
||||||
|
|
||||||
|
# Add the build to the database.
|
||||||
|
$build = $job->builds->create(
|
||||||
|
{ timestamp => $time
|
||||||
|
, description => null($buildInfo->{description})
|
||||||
|
, license => null($buildInfo->{license})
|
||||||
|
, homepage => null($buildInfo->{homepage})
|
||||||
|
, maintainers => null($buildInfo->{maintainers})
|
||||||
|
, maxsilent => $buildInfo->{maxSilent}
|
||||||
|
, timeout => $buildInfo->{timeout}
|
||||||
|
, nixname => $buildInfo->{nixName}
|
||||||
|
, drvpath => $drvPath
|
||||||
|
, system => $buildInfo->{system}
|
||||||
|
, nixexprinput => $jobset->nixexprinput
|
||||||
|
, nixexprpath => $jobset->nixexprpath
|
||||||
|
, priority => $buildInfo->{schedulingPriority}
|
||||||
|
, finished => 0
|
||||||
|
, iscurrent => 1
|
||||||
|
, ischannel => $buildInfo->{isChannel}
|
||||||
|
});
|
||||||
|
|
||||||
|
$build->buildoutputs->create({ name => $_, path => $buildInfo->{outputs}->{$_} })
|
||||||
|
foreach @outputNames;
|
||||||
|
|
||||||
|
$buildMap->{$build->id} = { id => $build->id, jobName => $jobName, new => 1, drvPath => $drvPath };
|
||||||
|
$$jobOutPathMap{$jobName . "\t" . $firstOutputPath} = $build->id;
|
||||||
|
|
||||||
|
print STDERR "added build ${\$build->id} (${\$jobset->project->name}:${\$jobset->name}:$jobName)\n";
|
||||||
|
});
|
||||||
|
|
||||||
|
return $build;
|
||||||
|
};
|
||||||
|
|
||||||
|
|
||||||
sub fetchInputs {
|
sub fetchInputs {
|
||||||
my ($project, $jobset, $inputInfo) = @_;
|
my ($project, $jobset, $inputInfo) = @_;
|
||||||
foreach my $input ($jobset->jobsetinputs->all) {
|
foreach my $input ($jobset->jobsetinputs->all) {
|
||||||
|
|
|
||||||
|
|
@ -4,7 +4,6 @@ use strict;
|
||||||
use Exporter;
|
use Exporter;
|
||||||
use Hydra::Helper::Nix;
|
use Hydra::Helper::Nix;
|
||||||
use Hydra::Model::DB;
|
use Hydra::Model::DB;
|
||||||
use Hydra::Helper::AddBuilds;
|
|
||||||
use Cwd;
|
use Cwd;
|
||||||
|
|
||||||
our @ISA = qw(Exporter);
|
our @ISA = qw(Exporter);
|
||||||
|
|
|
||||||
|
|
@ -1,7 +1,6 @@
|
||||||
use strict;
|
use strict;
|
||||||
use Hydra::Schema;
|
use Hydra::Schema;
|
||||||
use Hydra::Model::DB;
|
use Hydra::Model::DB;
|
||||||
use Hydra::Helper::AddBuilds;
|
|
||||||
use Cwd;
|
use Cwd;
|
||||||
use Setup;
|
use Setup;
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue