forked from lix-project/hydra
* Refactoring: move fetchInput out of hydra_scheduler into a separate
module, since Controller/Build.pm needs it to create a new build.
This commit is contained in:
Eelco Dolstra
parent
57cc6ceca6
commit
e1373fa1c3
|
|
@ -5,6 +5,7 @@ use warnings;
|
|||
use base 'Hydra::Base::Controller::NixChannel';
|
||||
use Hydra::Helper::Nix;
|
||||
use Hydra::Helper::CatalystUtils;
|
||||
use Hydra::Helper::AddBuilds;
|
||||
use File::stat;
|
||||
|
||||
|
||||
|
|
@ -403,6 +404,26 @@ sub clone_submit : Chained('build') PathPart('clone/submit') Args(0) {
|
|||
|
||||
requireProjectOwner($c, $build->project);
|
||||
|
||||
my ($nixExprPath, $nixExprInput) = Hydra::Controller::Jobset::nixExprPathFromParams $c;
|
||||
|
||||
my $jobName = trim $c->request->params->{"jobname"};
|
||||
error($c, "Invalid job name: $jobName") if $jobName !~ /^$jobNameRE$/;
|
||||
|
||||
foreach my $param (keys %{$c->request->params}) {
|
||||
next unless $param =~ /^input-(\w+)-name$/;
|
||||
my $baseName = $1;
|
||||
my ($inputName, $inputType) =
|
||||
Hydra::Controller::Jobset::checkInput($c, $baseName);
|
||||
my $inputValue = Hydra::Controller::Jobset::checkInputValue(
|
||||
$c, $inputType, $c->request->params->{"input-$baseName-value"});
|
||||
eval {
|
||||
fetchInput(
|
||||
$c->model('DB'), $build->project, $build->jobset,
|
||||
$inputName, $inputType, $inputValue);
|
||||
};
|
||||
error($c, $@) if $@;
|
||||
}
|
||||
|
||||
$c->flash->{buildMsg} = "Build XXX added to the queue.";
|
||||
|
||||
$c->res->redirect($c->uri_for($c->controller('Root')->action_for('queue')));
|
||||
|
|
|
|||
|
|
@ -96,11 +96,8 @@ sub delete : Chained('jobset') PathPart Args(0) {
|
|||
}
|
||||
|
||||
|
||||
sub updateJobset {
|
||||
my ($c, $jobset) = @_;
|
||||
|
||||
my $jobsetName = trim $c->request->params->{"name"};
|
||||
error($c, "Invalid jobset name: $jobsetName") unless $jobsetName =~ /^[[:alpha:]][\w\-]*$/;
|
||||
sub nixExprPathFromParams {
|
||||
my ($c) = @_;
|
||||
|
||||
# The Nix expression path must be relative and can't contain ".." elements.
|
||||
my $nixExprPath = trim $c->request->params->{"nixexprpath"};
|
||||
|
|
@ -109,6 +106,43 @@ sub updateJobset {
|
|||
my $nixExprInput = trim $c->request->params->{"nixexprinput"};
|
||||
error($c, "Invalid Nix expression input name: $nixExprInput") unless $nixExprInput =~ /^\w+$/;
|
||||
|
||||
return ($nixExprPath, $nixExprInput);
|
||||
}
|
||||
|
||||
|
||||
sub checkInput {
|
||||
my ($c, $baseName) = @_;
|
||||
|
||||
my $inputName = trim $c->request->params->{"input-$baseName-name"};
|
||||
error($c, "Invalid input name: $inputName") unless $inputName =~ /^[[:alpha:]]\w*$/;
|
||||
|
||||
my $inputType = trim $c->request->params->{"input-$baseName-type"};
|
||||
error($c, "Invalid input type: $inputType") unless
|
||||
$inputType eq "svn" || $inputType eq "cvs" || $inputType eq "tarball" ||
|
||||
$inputType eq "string" || $inputType eq "path" || $inputType eq "boolean" ||
|
||||
$inputType eq "build";
|
||||
|
||||
return ($inputName, $inputType);
|
||||
}
|
||||
|
||||
|
||||
sub checkInputValue {
|
||||
my ($c, $type, $value) = @_;
|
||||
$value = trim $value;
|
||||
error($c, "Invalid Boolean value: $value") if
|
||||
$type eq "boolean" && !($value eq "true" || $value eq "false");
|
||||
return $value;
|
||||
}
|
||||
|
||||
|
||||
sub updateJobset {
|
||||
my ($c, $jobset) = @_;
|
||||
|
||||
my $jobsetName = trim $c->request->params->{"name"};
|
||||
error($c, "Invalid jobset name: $jobsetName") unless $jobsetName =~ /^[[:alpha:]][\w\-]*$/;
|
||||
|
||||
my ($nixExprPath, $nixExprInput) = nixExprPathFromParams $c;
|
||||
|
||||
$jobset->update(
|
||||
{ name => $jobsetName
|
||||
, description => trim($c->request->params->{"description"})
|
||||
|
|
@ -122,29 +156,21 @@ sub updateJobset {
|
|||
# Process the inputs of this jobset.
|
||||
foreach my $param (keys %{$c->request->params}) {
|
||||
next unless $param =~ /^input-(\w+)-name$/;
|
||||
my $baseName2 = $1;
|
||||
next if $baseName2 eq "template";
|
||||
print STDERR "GOT INPUT: $baseName2\n";
|
||||
my $baseName = $1;
|
||||
next if $baseName eq "template";
|
||||
|
||||
my $inputName = trim $c->request->params->{"input-$baseName2-name"};
|
||||
error($c, "Invalid input name: $inputName") unless $inputName =~ /^[[:alpha:]]\w*$/;
|
||||
|
||||
my $inputType = trim $c->request->params->{"input-$baseName2-type"};
|
||||
error($c, "Invalid input type: $inputType") unless
|
||||
$inputType eq "svn" || $inputType eq "cvs" || $inputType eq "tarball" ||
|
||||
$inputType eq "string" || $inputType eq "path" || $inputType eq "boolean" ||
|
||||
$inputType eq "build";
|
||||
my ($inputName, $inputType) = checkInput($c, $baseName);
|
||||
|
||||
$inputNames{$inputName} = 1;
|
||||
|
||||
my $input;
|
||||
if ($baseName2 =~ /^\d+$/) { # numeric base name is auto-generated, i.e. a new entry
|
||||
if ($baseName =~ /^\d+$/) { # numeric base name is auto-generated, i.e. a new entry
|
||||
$input = $jobset->jobsetinputs->create(
|
||||
{ name => $inputName
|
||||
, type => $inputType
|
||||
});
|
||||
} else { # it's an existing input
|
||||
$input = ($jobset->jobsetinputs->search({name => $baseName2}))[0];
|
||||
$input = ($jobset->jobsetinputs->search({name => $baseName}))[0];
|
||||
die unless defined $input;
|
||||
$input->update({name => $inputName, type => $inputType});
|
||||
}
|
||||
|
|
@ -152,15 +178,12 @@ sub updateJobset {
|
|||
# Update the values for this input. Just delete all the
|
||||
# current ones, then create the new values.
|
||||
$input->jobsetinputalts->delete_all;
|
||||
my $values = $c->request->params->{"input-$baseName2-values"};
|
||||
my $values = $c->request->params->{"input-$baseName-values"};
|
||||
$values = [] unless defined $values;
|
||||
$values = [$values] unless ref($values) eq 'ARRAY';
|
||||
my $altnr = 0;
|
||||
foreach my $value (@{$values}) {
|
||||
print STDERR "VALUE: $value\n";
|
||||
my $value = trim $value;
|
||||
error($c, "Invalid Boolean value: $value") if
|
||||
$inputType eq "boolean" && !($value eq "true" || $value eq "false");
|
||||
$value = checkInputValue($c, $inputType, $value);
|
||||
$input->jobsetinputalts->create({altnr => $altnr++, value => $value});
|
||||
}
|
||||
}
|
||||
|
|
|
|||
226
src/lib/Hydra/Helper/AddBuilds.pm
Normal file
226
src/lib/Hydra/Helper/AddBuilds.pm
Normal file
|
|
@ -0,0 +1,226 @@
|
|||
package Hydra::Helper::AddBuilds;
|
||||
|
||||
use strict;
|
||||
use POSIX qw(strftime);
|
||||
use Hydra::Helper::Nix;
|
||||
|
||||
our @ISA = qw(Exporter);
|
||||
our @EXPORT = qw(fetchInput);
|
||||
|
||||
|
||||
sub getStorePathHash {
|
||||
my ($storePath) = @_;
|
||||
my $hash = `nix-store --query --hash $storePath`
|
||||
or die "cannot get hash of $storePath";
|
||||
chomp $hash;
|
||||
die unless $hash =~ /^sha256:(.*)$/;
|
||||
$hash = $1;
|
||||
$hash = `nix-hash --to-base16 --type sha256 $hash`
|
||||
or die "cannot convert hash";
|
||||
chomp $hash;
|
||||
return $hash;
|
||||
}
|
||||
|
||||
|
||||
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 =~ / ^ (?: (?: ([\w\-]+) : )? ([\w\-]+) : )? ([\w\-]+) \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 fetchInput {
|
||||
my ($db, $project, $jobset, $name, $type, $value) = @_;
|
||||
|
||||
if ($type eq "path") {
|
||||
my $uri = $value;
|
||||
|
||||
my $timestamp = time;
|
||||
my $sha256;
|
||||
my $storePath;
|
||||
|
||||
# Some simple caching: don't check a path more than once every N seconds.
|
||||
(my $cachedInput) = $db->resultset('CachedPathInputs')->search(
|
||||
{srcpath => $uri, lastseen => {">", $timestamp - 60}},
|
||||
{rows => 1, order_by => "lastseen DESC"});
|
||||
|
||||
if (defined $cachedInput && isValidPath($cachedInput->storepath)) {
|
||||
$storePath = $cachedInput->storepath;
|
||||
$sha256 = $cachedInput->sha256hash;
|
||||
$timestamp = $cachedInput->timestamp;
|
||||
} else {
|
||||
|
||||
print STDERR "copying input ", $name, " from $uri\n";
|
||||
$storePath = `nix-store --add "$uri"`
|
||||
or die "Cannot copy path $uri to the Nix store.\n";
|
||||
chomp $storePath;
|
||||
|
||||
$sha256 = getStorePathHash $storePath;
|
||||
|
||||
($cachedInput) = $db->resultset('CachedPathInputs')->search(
|
||||
{srcpath => $uri, sha256hash => $sha256});
|
||||
|
||||
# Path inputs don't have a natural notion of a "revision",
|
||||
# so we simulate it by using the timestamp that we first
|
||||
# saw this path have this SHA-256 hash. So if the
|
||||
# contents of the path changes, we get a new "revision",
|
||||
# but if it doesn't change (or changes back), we don't get
|
||||
# a new "revision".
|
||||
if (!defined $cachedInput) {
|
||||
txn_do($db, sub {
|
||||
$db->resultset('CachedPathInputs')->create(
|
||||
{ srcpath => $uri
|
||||
, timestamp => $timestamp
|
||||
, lastseen => $timestamp
|
||||
, sha256hash => $sha256
|
||||
, storepath => $storePath
|
||||
});
|
||||
});
|
||||
} else {
|
||||
$timestamp = $cachedInput->timestamp;
|
||||
txn_do($db, sub {
|
||||
$cachedInput->update({lastseen => time});
|
||||
});
|
||||
}
|
||||
}
|
||||
|
||||
return
|
||||
{ type => $type
|
||||
, uri => $uri
|
||||
, storePath => $storePath
|
||||
, sha256hash => $sha256
|
||||
, revision => strftime "%Y%m%d%H%M%S", gmtime($timestamp)
|
||||
};
|
||||
}
|
||||
|
||||
elsif ($type eq "svn") {
|
||||
my $uri = $value;
|
||||
|
||||
my $sha256;
|
||||
my $storePath;
|
||||
|
||||
# First figure out the last-modified revision of the URI.
|
||||
my @cmd = (["svn", "ls", "-v", "--depth", "empty", $uri],
|
||||
"|", ["sed", 's/^ *\([0-9]*\).*/\1/']);
|
||||
my $stdout; my $stderr;
|
||||
die "Cannot get head revision of Subversion repository at `$uri':\n$stderr"
|
||||
unless IPC::Run::run(@cmd, \$stdout, \$stderr);
|
||||
my $revision = $stdout; chomp $revision;
|
||||
die unless $revision =~ /^\d+$/;
|
||||
|
||||
(my $cachedInput) = $db->resultset('CachedSubversionInputs')->search(
|
||||
{uri => $uri, revision => $revision});
|
||||
|
||||
if (defined $cachedInput && isValidPath($cachedInput->storepath)) {
|
||||
$storePath = $cachedInput->storepath;
|
||||
$sha256 = $cachedInput->sha256hash;
|
||||
} else {
|
||||
|
||||
# Then download this revision into the store.
|
||||
print STDERR "checking out Subversion input ", $name, " from $uri revision $revision\n";
|
||||
$ENV{"NIX_HASH_ALGO"} = "sha256";
|
||||
$ENV{"PRINT_PATH"} = "1";
|
||||
(my $res, $stdout, $stderr) = captureStdoutStderr(
|
||||
"nix-prefetch-svn", $uri, $revision);
|
||||
die "Cannot check out Subversion repository `$uri':\n$stderr" unless $res;
|
||||
|
||||
($sha256, $storePath) = split ' ', $stdout;
|
||||
|
||||
txn_do($db, sub {
|
||||
$db->resultset('CachedSubversionInputs')->create(
|
||||
{ uri => $uri
|
||||
, revision => $revision
|
||||
, sha256hash => $sha256
|
||||
, storepath => $storePath
|
||||
});
|
||||
});
|
||||
}
|
||||
|
||||
return
|
||||
{ type => $type
|
||||
, uri => $uri
|
||||
, storePath => $storePath
|
||||
, sha256hash => $sha256
|
||||
, revision => $revision
|
||||
};
|
||||
}
|
||||
|
||||
elsif ($type eq "build") {
|
||||
my ($projectName, $jobsetName, $jobName, $attrs) = parseJobName($value);
|
||||
$projectName ||= $project->name;
|
||||
$jobsetName ||= $jobset->name;
|
||||
|
||||
# Pick the most recent successful build of the specified job.
|
||||
(my $prevBuild) = $db->resultset('Builds')->search(
|
||||
{ finished => 1, project => $projectName, jobset => $jobsetName
|
||||
, job => $jobName, buildStatus => 0 },
|
||||
{ join => 'resultInfo', order_by => "me.id DESC", rows => 1
|
||||
, where => \ attrsToSQL($attrs, "me.id") });
|
||||
|
||||
if (!defined $prevBuild || !isValidPath($prevBuild->outpath)) {
|
||||
print STDERR "input `", $name, "': no previous build available\n";
|
||||
return undef;
|
||||
}
|
||||
|
||||
#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->resultInfo->releasename or $prevBuild->nixname);
|
||||
my $version = $2 if $relName =~ /^($pkgNameRE)-($versionRE)$/;
|
||||
|
||||
return
|
||||
{ type => "build"
|
||||
, storePath => $prevBuild->outpath
|
||||
, id => $prevBuild->id
|
||||
, version => $version
|
||||
};
|
||||
}
|
||||
|
||||
elsif ($type eq "string") {
|
||||
die unless defined $value;
|
||||
return {type => $type, value => $value};
|
||||
}
|
||||
|
||||
elsif ($type eq "boolean") {
|
||||
die unless defined $value && ($value eq "true" || $value eq "false");
|
||||
return {type => $type, value => $value};
|
||||
}
|
||||
|
||||
else {
|
||||
die "Input `" . $name . "' has unknown type `$type'.";
|
||||
}
|
||||
}
|
||||
|
|
@ -11,7 +11,7 @@ our @EXPORT = qw(
|
|||
error notFound
|
||||
requireLogin requireProjectOwner requireAdmin requirePost
|
||||
trim
|
||||
$pathCompRE $relPathRE $relNameRE
|
||||
$pathCompRE $relPathRE $relNameRE $jobNameRE
|
||||
);
|
||||
|
||||
|
||||
|
|
@ -132,8 +132,10 @@ sub trim {
|
|||
|
||||
# Security checking of filenames.
|
||||
Readonly::Scalar our $pathCompRE => "(?:[A-Za-z0-9-\+][A-Za-z0-9-\+\._]*)";
|
||||
Readonly::Scalar our $relPathRE => "(?:$pathCompRE(?:\/$pathCompRE)*)";
|
||||
Readonly::Scalar our $relPathRE => "(?:$pathCompRE(?:/$pathCompRE)*)";
|
||||
Readonly::Scalar our $relNameRE => "(?:[A-Za-z0-9-][A-Za-z0-9-\.]*)";
|
||||
Readonly::Scalar our $attrNameRE => "(?:[A-Za-z_][A-Za-z0-9_]*)";
|
||||
Readonly::Scalar our $jobNameRE => "(?:$attrNameRE(?:\\.$attrNameRE)*)";
|
||||
|
||||
|
||||
1;
|
||||
|
|
|
|||
|
|
@ -273,7 +273,6 @@ sub getLatestSuccessfulViewResult {
|
|||
return $build if getViewResult($build, $jobs)->{status} == 0;
|
||||
}
|
||||
return undef;
|
||||
|
||||
}
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -28,7 +28,7 @@
|
|||
<tbody>
|
||||
[% FOREACH input IN build.inputs -%]
|
||||
<tr>
|
||||
<td><tt>[% input.name %]</tt></td>
|
||||
<td><tt>[% input.name %]<input type="hidden" [% HTML.attributes(name => "input-$input.name-name" value => input.name) %] /></tt></td>
|
||||
<td>
|
||||
[% INCLUDE renderSelection curValue=input.type param="input-$input.name-type" options=inputTypes %]
|
||||
</td>
|
||||
|
|
|
|||
|
|
@ -5,8 +5,8 @@ use feature 'switch';
|
|||
use XML::Simple;
|
||||
use Hydra::Schema;
|
||||
use Hydra::Helper::Nix;
|
||||
use Hydra::Helper::AddBuilds;
|
||||
use IPC::Run;
|
||||
use POSIX qw(strftime);
|
||||
|
||||
|
||||
STDOUT->autoflush();
|
||||
|
|
@ -21,230 +21,11 @@ sub captureStdoutStderr {
|
|||
}
|
||||
|
||||
|
||||
sub getStorePathHash {
|
||||
my ($storePath) = @_;
|
||||
my $hash = `nix-store --query --hash $storePath`
|
||||
or die "cannot get hash of $storePath";
|
||||
chomp $hash;
|
||||
die unless $hash =~ /^sha256:(.*)$/;
|
||||
$hash = $1;
|
||||
$hash = `nix-hash --to-base16 --type sha256 $hash`
|
||||
or die "cannot convert hash";
|
||||
chomp $hash;
|
||||
return $hash;
|
||||
}
|
||||
|
||||
|
||||
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 =~ / ^ (?: (?: ([\w\-]+) : )? ([\w\-]+) : )? ([\w\-]+) \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 fetchInputAlt {
|
||||
my ($project, $jobset, $input, $alt) = @_;
|
||||
my $type = $input->type;
|
||||
|
||||
if ($type eq "path") {
|
||||
my $uri = $alt->value;
|
||||
|
||||
my $timestamp = time;
|
||||
my $sha256;
|
||||
my $storePath;
|
||||
|
||||
# Some simple caching: don't check a path more than once every N seconds.
|
||||
(my $cachedInput) = $db->resultset('CachedPathInputs')->search(
|
||||
{srcpath => $uri, lastseen => {">", $timestamp - 60}},
|
||||
{rows => 1, order_by => "lastseen DESC"});
|
||||
|
||||
if (defined $cachedInput && isValidPath($cachedInput->storepath)) {
|
||||
$storePath = $cachedInput->storepath;
|
||||
$sha256 = $cachedInput->sha256hash;
|
||||
$timestamp = $cachedInput->timestamp;
|
||||
} else {
|
||||
|
||||
print "copying input ", $input->name, " from $uri\n";
|
||||
$storePath = `nix-store --add "$uri"`
|
||||
or die "cannot copy path $uri to the Nix store";
|
||||
chomp $storePath;
|
||||
|
||||
$sha256 = getStorePathHash $storePath;
|
||||
|
||||
($cachedInput) = $db->resultset('CachedPathInputs')->search(
|
||||
{srcpath => $uri, sha256hash => $sha256});
|
||||
|
||||
# Path inputs don't have a natural notion of a "revision",
|
||||
# so we simulate it by using the timestamp that we first
|
||||
# saw this path have this SHA-256 hash. So if the
|
||||
# contents of the path changes, we get a new "revision",
|
||||
# but if it doesn't change (or changes back), we don't get
|
||||
# a new "revision".
|
||||
if (!defined $cachedInput) {
|
||||
txn_do($db, sub {
|
||||
$db->resultset('CachedPathInputs')->create(
|
||||
{ srcpath => $uri
|
||||
, timestamp => $timestamp
|
||||
, lastseen => $timestamp
|
||||
, sha256hash => $sha256
|
||||
, storepath => $storePath
|
||||
});
|
||||
});
|
||||
} else {
|
||||
$timestamp = $cachedInput->timestamp;
|
||||
txn_do($db, sub {
|
||||
$cachedInput->update({lastseen => time});
|
||||
});
|
||||
}
|
||||
}
|
||||
|
||||
return
|
||||
{ type => $type
|
||||
, uri => $uri
|
||||
, storePath => $storePath
|
||||
, sha256hash => $sha256
|
||||
, revision => strftime "%Y%m%d%H%M%S", gmtime($timestamp)
|
||||
};
|
||||
}
|
||||
|
||||
elsif ($type eq "svn") {
|
||||
my $uri = $alt->value;
|
||||
|
||||
my $sha256;
|
||||
my $storePath;
|
||||
|
||||
# First figure out the last-modified revision of the URI.
|
||||
my @cmd = (["svn", "ls", "-v", "--depth", "empty", $uri],
|
||||
"|", ["sed", 's/^ *\([0-9]*\).*/\1/']);
|
||||
my $stdout; my $stderr;
|
||||
die "cannot get head revision of Subversion repository at `$uri':\n$stderr"
|
||||
unless IPC::Run::run(@cmd, \$stdout, \$stderr);
|
||||
my $revision = $stdout; chomp $revision;
|
||||
die unless $revision =~ /^\d+$/;
|
||||
|
||||
(my $cachedInput) = $db->resultset('CachedSubversionInputs')->search(
|
||||
{uri => $uri, revision => $revision});
|
||||
|
||||
if (defined $cachedInput && isValidPath($cachedInput->storepath)) {
|
||||
$storePath = $cachedInput->storepath;
|
||||
$sha256 = $cachedInput->sha256hash;
|
||||
} else {
|
||||
|
||||
# Then download this revision into the store.
|
||||
print "checking out Subversion input ", $input->name, " from $uri revision $revision\n";
|
||||
$ENV{"NIX_HASH_ALGO"} = "sha256";
|
||||
$ENV{"PRINT_PATH"} = "1";
|
||||
(my $res, $stdout, $stderr) = captureStdoutStderr(
|
||||
"nix-prefetch-svn", $uri, $revision);
|
||||
die "cannot check out Subversion repository `$uri':\n$stderr" unless $res;
|
||||
|
||||
($sha256, $storePath) = split ' ', $stdout;
|
||||
|
||||
txn_do($db, sub {
|
||||
$db->resultset('CachedSubversionInputs')->create(
|
||||
{ uri => $uri
|
||||
, revision => $revision
|
||||
, sha256hash => $sha256
|
||||
, storepath => $storePath
|
||||
});
|
||||
});
|
||||
}
|
||||
|
||||
return
|
||||
{ type => $type
|
||||
, uri => $uri
|
||||
, storePath => $storePath
|
||||
, sha256hash => $sha256
|
||||
, revision => $revision
|
||||
};
|
||||
}
|
||||
|
||||
elsif ($type eq "build") {
|
||||
my ($projectName, $jobsetName, $jobName, $attrs) = parseJobName($alt->value);
|
||||
$projectName ||= $project->name;
|
||||
$jobsetName ||= $jobset->name;
|
||||
|
||||
# Pick the most recent successful build of the specified job.
|
||||
(my $prevBuild) = $db->resultset('Builds')->search(
|
||||
{ finished => 1, project => $projectName, jobset => $jobsetName
|
||||
, job => $jobName, buildStatus => 0 },
|
||||
{ join => 'resultInfo', order_by => "me.id DESC", rows => 1
|
||||
, where => \ attrsToSQL($attrs, "me.id") });
|
||||
|
||||
if (!defined $prevBuild || !isValidPath($prevBuild->outpath)) {
|
||||
print STDERR "input `", $input->name, "': no previous build available\n";
|
||||
return undef;
|
||||
}
|
||||
|
||||
#print STDERR "input `", $input->name, "': using build ", $prevBuild->id, "\n";
|
||||
|
||||
my $pkgNameRE = "(?:(?:[A-Za-z0-9]|(?:-[^0-9]))+)";
|
||||
my $versionRE = "(?:[A-Za-z0-9\.\-]+)";
|
||||
|
||||
my $relName = ($prevBuild->resultInfo->releasename or $prevBuild->nixname);
|
||||
my $version = $2 if $relName =~ /^($pkgNameRE)-($versionRE)$/;
|
||||
|
||||
return
|
||||
{ type => "build"
|
||||
, storePath => $prevBuild->outpath
|
||||
, id => $prevBuild->id
|
||||
, version => $version
|
||||
};
|
||||
}
|
||||
|
||||
elsif ($type eq "string") {
|
||||
die unless defined $alt->value;
|
||||
return {type => $type, value => $alt->value};
|
||||
}
|
||||
|
||||
elsif ($type eq "boolean") {
|
||||
die unless defined $alt->value && ($alt->value eq "true" || $alt->value eq "false");
|
||||
return {type => $type, value => $alt->value};
|
||||
}
|
||||
|
||||
else {
|
||||
die "input `" . $input->name . "' has unknown type `$type'";
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub fetchInputs {
|
||||
my ($project, $jobset, $inputInfo) = @_;
|
||||
foreach my $input ($jobset->jobsetinputs->all) {
|
||||
foreach my $alt ($input->jobsetinputalts->all) {
|
||||
my $info = fetchInputAlt($project, $jobset, $input, $alt);
|
||||
my $info = fetchInput($db, $project, $jobset, $input->name, $input->type, $alt->value);
|
||||
push @{$$inputInfo{$input->name}}, $info if defined $info;
|
||||
}
|
||||
}
|
||||
|
|
|
|||
Loading…
Reference in a new issue