* Move everything up one directory.
This commit is contained in:
Eelco Dolstra
141
src/lib/Hydra/Helper/CatalystUtils.pm
Normal file
141
src/lib/Hydra/Helper/CatalystUtils.pm
Normal file
@ -0,0 +1,141 @@
|
||||
package Hydra::Helper::CatalystUtils;
|
||||
|
||||
use strict;
|
||||
use Exporter;
|
||||
use Readonly;
|
||||
use Hydra::Helper::Nix;
|
||||
|
||||
our @ISA = qw(Exporter);
|
||||
our @EXPORT = qw(
|
||||
getBuild getBuildStats getLatestBuilds getChannelData
|
||||
error notFound
|
||||
requireLogin requireProjectOwner requireAdmin
|
||||
trim
|
||||
$pathCompRE $relPathRE
|
||||
);
|
||||
|
||||
|
||||
sub getBuild {
|
||||
my ($c, $id) = @_;
|
||||
my $build = $c->model('DB::Builds')->find($id);
|
||||
return $build;
|
||||
}
|
||||
|
||||
|
||||
sub getBuildStats {
|
||||
my ($c, $builds) = @_;
|
||||
|
||||
$c->stash->{finishedBuilds} = $builds->search({finished => 1}) || 0;
|
||||
|
||||
$c->stash->{succeededBuilds} = $builds->search(
|
||||
{finished => 1, buildStatus => 0},
|
||||
{join => 'resultInfo'}) || 0;
|
||||
|
||||
$c->stash->{scheduledBuilds} = $builds->search({finished => 0}) || 0;
|
||||
|
||||
$c->stash->{busyBuilds} = $builds->search(
|
||||
{finished => 0, busy => 1},
|
||||
{join => 'schedulingInfo'}) || 0;
|
||||
|
||||
$c->stash->{totalBuildTime} = $builds->search({},
|
||||
{join => 'resultInfo', select => {sum => 'stoptime - starttime'}, as => ['sum']})
|
||||
->first->get_column('sum') || 0;
|
||||
}
|
||||
|
||||
|
||||
# Return the latest build for each job.
|
||||
sub getLatestBuilds {
|
||||
my ($c, $builds, $extraAttrs) = @_;
|
||||
|
||||
my @res = ();
|
||||
|
||||
foreach my $job ($builds->search({},
|
||||
{group_by => ['project', 'attrname', 'system']}))
|
||||
{
|
||||
my $attrs =
|
||||
{ project => $job->get_column('project')
|
||||
, attrname => $job->attrname
|
||||
, system => $job->system
|
||||
, finished => 1
|
||||
};
|
||||
my ($build) = $builds->search({ %$attrs, %$extraAttrs },
|
||||
{ join => 'resultInfo', order_by => 'timestamp DESC', rows => 1 } );
|
||||
push @res, $build if defined $build;
|
||||
}
|
||||
|
||||
return [@res];
|
||||
}
|
||||
|
||||
|
||||
sub getChannelData {
|
||||
my ($c, $builds) = @_;
|
||||
|
||||
my @storePaths = ();
|
||||
foreach my $build (@{$builds}) {
|
||||
# !!! better do this in getLatestBuilds with a join.
|
||||
next unless $build->buildproducts->find({type => "nix-build"});
|
||||
next unless isValidPath($build->outpath);
|
||||
push @storePaths, $build->outpath;
|
||||
my $pkgName = $build->nixname . "-" . $build->system . "-" . $build->id;
|
||||
$c->stash->{nixPkgs}->{"${pkgName}.nixpkg"} = {build => $build, name => $pkgName};
|
||||
};
|
||||
|
||||
$c->stash->{storePaths} = [@storePaths];
|
||||
}
|
||||
|
||||
|
||||
sub error {
|
||||
my ($c, $msg) = @_;
|
||||
$c->error($msg);
|
||||
$c->detach; # doesn't return
|
||||
}
|
||||
|
||||
|
||||
sub notFound {
|
||||
my ($c, $msg) = @_;
|
||||
$c->response->status(404);
|
||||
error($c, $msg);
|
||||
}
|
||||
|
||||
|
||||
sub requireLogin {
|
||||
my ($c) = @_;
|
||||
$c->flash->{afterLogin} = $c->request->uri;
|
||||
$c->response->redirect($c->uri_for('/login'));
|
||||
$c->detach; # doesn't return
|
||||
}
|
||||
|
||||
|
||||
sub requireProjectOwner {
|
||||
my ($c, $project) = @_;
|
||||
|
||||
requireLogin($c) if !$c->user_exists;
|
||||
|
||||
error($c, "Only the project owner or administrators can perform this operation.")
|
||||
unless $c->check_user_roles('admin') || $c->user->username eq $project->owner->username;
|
||||
}
|
||||
|
||||
|
||||
sub requireAdmin {
|
||||
my ($c) = @_;
|
||||
|
||||
requireLogin($c) if !$c->user_exists;
|
||||
|
||||
error($c, "Only administrators can perform this operation.")
|
||||
unless $c->check_user_roles('admin');
|
||||
}
|
||||
|
||||
|
||||
sub trim {
|
||||
my $s = shift;
|
||||
$s =~ s/^\s+|\s+$//g;
|
||||
return $s;
|
||||
}
|
||||
|
||||
|
||||
# Security checking of filenames.
|
||||
Readonly::Scalar our $pathCompRE => "(?:[A-Za-z0-9-\+][A-Za-z0-9-\+\._]*)";
|
||||
Readonly::Scalar our $relPathRE => "(?:$pathCompRE(?:\/$pathCompRE)*)";
|
||||
|
||||
|
||||
1;
|
||||
199
src/lib/Hydra/Helper/Nix.pm
Normal file
199
src/lib/Hydra/Helper/Nix.pm
Normal file
@ -0,0 +1,199 @@
|
||||
package Hydra::Helper::Nix;
|
||||
|
||||
use strict;
|
||||
use Exporter;
|
||||
use File::Path;
|
||||
use File::Basename;
|
||||
|
||||
our @ISA = qw(Exporter);
|
||||
our @EXPORT = qw(
|
||||
isValidPath queryPathInfo
|
||||
getHydraPath getHydraDBPath openHydraDB
|
||||
registerRoot getGCRootsDir
|
||||
getPrimaryBuildsForReleaseSet getRelease getLatestSuccessfulRelease );
|
||||
|
||||
|
||||
sub isValidPath {
|
||||
my $path = shift;
|
||||
#$SIG{CHLD} = 'DEFAULT'; # !!! work around system() failing if SIGCHLD is ignored
|
||||
#return system("nix-store --check-validity $path 2> /dev/null") == 0;
|
||||
|
||||
# This is faster than calling nix-store, but it breaks abstraction...
|
||||
return -e ("/nix/var/nix/db/info/" . basename $path);
|
||||
}
|
||||
|
||||
|
||||
sub queryPathInfo {
|
||||
my $path = shift;
|
||||
|
||||
# !!! like above, this breaks abstraction. What we really need is
|
||||
# Perl bindings for libstore :-)
|
||||
|
||||
open FH, "</nix/var/nix/db/info/" . basename $path
|
||||
or die "cannot open info file for $path";
|
||||
|
||||
my $hash;
|
||||
my $deriver;
|
||||
my @refs = ();
|
||||
|
||||
while (<FH>) {
|
||||
if (/^Hash: (\S+)$/) {
|
||||
$hash = $1;
|
||||
}
|
||||
elsif (/^Deriver: (\S+)$/) {
|
||||
$deriver = $1;
|
||||
}
|
||||
elsif (/^References: (.*)$/) {
|
||||
@refs = split / /, $1;
|
||||
}
|
||||
}
|
||||
|
||||
close FH;
|
||||
|
||||
die unless defined $hash;
|
||||
|
||||
return ($hash, $deriver, \@refs);
|
||||
}
|
||||
|
||||
|
||||
sub getHydraPath {
|
||||
my $dir = $ENV{"HYDRA_DATA"};
|
||||
die "The HYDRA_DATA environment variable is not set!\n" unless defined $dir;
|
||||
die "The HYDRA_DATA directory does not exist!\n" unless -d $dir;
|
||||
return $dir;
|
||||
}
|
||||
|
||||
|
||||
sub getHydraDBPath {
|
||||
my $path = getHydraPath . '/hydra.sqlite';
|
||||
die "The Hydra database ($path) not exist!\n" unless -f $path;
|
||||
return "dbi:SQLite:$path";
|
||||
}
|
||||
|
||||
|
||||
sub openHydraDB {
|
||||
my $db = Hydra::Schema->connect(getHydraDBPath, "", "", {});
|
||||
$db->storage->dbh->do("PRAGMA synchronous = OFF;");
|
||||
return $db;
|
||||
}
|
||||
|
||||
|
||||
sub getGCRootsDir {
|
||||
die unless defined $ENV{LOGNAME};
|
||||
return "/nix/var/nix/gcroots/per-user/$ENV{LOGNAME}/hydra-roots";
|
||||
}
|
||||
|
||||
|
||||
sub registerRoot {
|
||||
my ($path) = @_;
|
||||
|
||||
my $gcRootsDir = getGCRootsDir;
|
||||
|
||||
mkpath($gcRootsDir) if !-e $gcRootsDir;
|
||||
|
||||
my $link = "$gcRootsDir/" . basename $path;
|
||||
|
||||
if (!-l $link) {
|
||||
symlink($path, $link)
|
||||
or die "cannot create symlink in $gcRootsDir to $path";
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub attrsToSQL {
|
||||
my ($attrs, $id) = @_;
|
||||
my @attrs = split / /, $attrs;
|
||||
|
||||
my $query = "1 = 1";
|
||||
|
||||
foreach my $attr (@attrs) {
|
||||
$attr =~ /^([\w-]+)=([\w-]*)$/ or die "invalid attribute in release set: $attr";
|
||||
my $name = $1;
|
||||
my $value = $2;
|
||||
# !!! 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 (select count(*) from buildinputs where build = $id and name = '$name' and value = '$value') = 1";
|
||||
}
|
||||
|
||||
return $query;
|
||||
}
|
||||
|
||||
|
||||
sub getPrimaryBuildsForReleaseSet {
|
||||
my ($project, $primaryJob) = @_;
|
||||
my @primaryBuilds = $project->builds->search(
|
||||
{ attrname => $primaryJob->job, finished => 1 },
|
||||
{ join => 'resultInfo', order_by => "timestamp DESC"
|
||||
, '+select' => ["resultInfo.releasename"], '+as' => ["releasename"]
|
||||
, where => \ attrsToSQL($primaryJob->attrs, "me.id")
|
||||
});
|
||||
return @primaryBuilds;
|
||||
}
|
||||
|
||||
|
||||
sub getRelease {
|
||||
my ($primaryBuild, $jobs) = @_;
|
||||
|
||||
my @jobs = ();
|
||||
|
||||
my $status = 0; # = okay
|
||||
|
||||
# The timestamp of the release is the highest timestamp of all
|
||||
# constitutent builds.
|
||||
my $timestamp = 0;
|
||||
|
||||
foreach my $job (@{$jobs}) {
|
||||
my $thisBuild;
|
||||
|
||||
if ($job->isprimary) {
|
||||
$thisBuild = $primaryBuild;
|
||||
} else {
|
||||
# Find a build of this job that had the primary build
|
||||
# as input. If there are multiple, prefer successful
|
||||
# ones, and then oldest. !!! order_by buildstatus is hacky
|
||||
($thisBuild) = $primaryBuild->dependentBuilds->search(
|
||||
{ attrname => $job->job, finished => 1 },
|
||||
{ join => 'resultInfo', rows => 1
|
||||
, order_by => ["buildstatus", "timestamp"]
|
||||
, where => \ attrsToSQL($job->attrs, "build.id")
|
||||
});
|
||||
}
|
||||
|
||||
if ($job->mayfail != 1) {
|
||||
if (!defined $thisBuild) {
|
||||
$status = 2 if $status == 0; # = unfinished
|
||||
} elsif ($thisBuild->resultInfo->buildstatus != 0) {
|
||||
$status = 1; # = failed
|
||||
}
|
||||
}
|
||||
|
||||
$timestamp = $thisBuild->timestamp
|
||||
if defined $thisBuild && $thisBuild->timestamp > $timestamp;
|
||||
|
||||
push @jobs, { build => $thisBuild, job => $job };
|
||||
}
|
||||
|
||||
return
|
||||
{ id => $primaryBuild->id
|
||||
, releasename => $primaryBuild->get_column('releasename')
|
||||
, jobs => [@jobs]
|
||||
, status => $status
|
||||
, timestamp => $timestamp
|
||||
};
|
||||
}
|
||||
|
||||
|
||||
sub getLatestSuccessfulRelease {
|
||||
my ($project, $primaryJob, $jobs) = @_;
|
||||
my $latest;
|
||||
foreach my $build (getPrimaryBuildsForReleaseSet($project, $primaryJob)) {
|
||||
return $build if getRelease($build, $jobs)->{status} == 0;
|
||||
}
|
||||
return undef;
|
||||
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
Reference in New Issue
Block a user