From e1373fa1c3dd94750ff86fe2224fee5db14de8de Mon Sep 17 00:00:00 2001 From: Eelco Dolstra Date: Mon, 26 Oct 2009 15:39:14 +0000 Subject: [PATCH] * Refactoring: move fetchInput out of hydra_scheduler into a separate module, since Controller/Build.pm needs it to create a new build. --- src/lib/Hydra/Controller/Build.pm | 21 +++ src/lib/Hydra/Controller/Jobset.pm | 71 +++++--- src/lib/Hydra/Helper/AddBuilds.pm | 226 ++++++++++++++++++++++++++ src/lib/Hydra/Helper/CatalystUtils.pm | 8 +- src/lib/Hydra/Helper/Nix.pm | 1 - src/root/clone-build.tt | 2 +- src/script/hydra_scheduler.pl | 223 +------------------------ 7 files changed, 302 insertions(+), 250 deletions(-) create mode 100644 src/lib/Hydra/Helper/AddBuilds.pm diff --git a/src/lib/Hydra/Controller/Build.pm b/src/lib/Hydra/Controller/Build.pm index e72a7a70..508c6ce6 100644 --- a/src/lib/Hydra/Controller/Build.pm +++ b/src/lib/Hydra/Controller/Build.pm @@ -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'))); diff --git a/src/lib/Hydra/Controller/Jobset.pm b/src/lib/Hydra/Controller/Jobset.pm index 786fd47b..50e9e848 100644 --- a/src/lib/Hydra/Controller/Jobset.pm +++ b/src/lib/Hydra/Controller/Jobset.pm @@ -96,12 +96,9 @@ 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"}; error($c, "Invalid Nix expression path: $nixExprPath") if $nixExprPath !~ /^$relPathRE$/; @@ -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}); } } diff --git a/src/lib/Hydra/Helper/AddBuilds.pm b/src/lib/Hydra/Helper/AddBuilds.pm new file mode 100644 index 00000000..87ab6751 --- /dev/null +++ b/src/lib/Hydra/Helper/AddBuilds.pm @@ -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 `:: + # [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'."; + } +} diff --git a/src/lib/Hydra/Helper/CatalystUtils.pm b/src/lib/Hydra/Helper/CatalystUtils.pm index edc13383..ae003a15 100644 --- a/src/lib/Hydra/Helper/CatalystUtils.pm +++ b/src/lib/Hydra/Helper/CatalystUtils.pm @@ -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 $relNameRE =>"(?:[A-Za-z0-9-][A-Za-z0-9-\.]*)"; +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; diff --git a/src/lib/Hydra/Helper/Nix.pm b/src/lib/Hydra/Helper/Nix.pm index 346f47d1..6022a0cd 100644 --- a/src/lib/Hydra/Helper/Nix.pm +++ b/src/lib/Hydra/Helper/Nix.pm @@ -273,7 +273,6 @@ sub getLatestSuccessfulViewResult { return $build if getViewResult($build, $jobs)->{status} == 0; } return undef; - } diff --git a/src/root/clone-build.tt b/src/root/clone-build.tt index 560c9634..4e058614 100644 --- a/src/root/clone-build.tt +++ b/src/root/clone-build.tt @@ -28,7 +28,7 @@ [% FOREACH input IN build.inputs -%] - [% input.name %] + [% input.name %] "input-$input.name-name" value => input.name) %] /> [% INCLUDE renderSelection curValue=input.type param="input-$input.name-type" options=inputTypes %] diff --git a/src/script/hydra_scheduler.pl b/src/script/hydra_scheduler.pl index 496c875d..3f977c34 100755 --- a/src/script/hydra_scheduler.pl +++ b/src/script/hydra_scheduler.pl @@ -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 `:: - # [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; } }