2011-11-30 16:32:50 +00:00
#! /var/run/current-system/sw/bin/perl -w
2009-01-13 14:02:07 +00:00
use strict;
use File::Path;
use File::Basename;
2011-11-30 14:25:28 +00:00
use Nix::Store;
2009-01-13 14:02:07 +00:00
use Hydra::Schema;
use Hydra::Helper::Nix;
2012-03-13 11:10:19 +00:00
use Hydra::Model::DB;
2009-02-06 14:17:25 +00:00
use POSIX qw(strftime);
2009-01-13 14:02:07 +00:00
2012-03-13 11:10:19 +00:00
my $db = Hydra::Model::DB->new();
2009-01-13 14:02:07 +00:00
my %roots;
2012-03-07 14:02:31 +00:00
sub addRoot {
2009-01-13 14:02:07 +00:00
my ($path) = @_;
2012-03-07 14:02:31 +00:00
registerRoot($path);
2009-01-13 14:02:07 +00:00
$roots{$path} = 1;
}
2012-03-07 14:02:31 +00:00
my @columns = ( "id", "project", "jobset", "job", "system", "finished", "outpath", "drvpath", "timestamp" );
2009-02-06 14:17:25 +00:00
sub keepBuild {
my ($build) = @_;
2012-03-07 14:02:31 +00:00
print STDERR " keeping ", ($build->finished ? "" : "scheduled "), "build ", $build->id, " (",
$build->get_column('project'), ":", $build->get_column('jobset'), ":", $build->get_column('job'), "; ",
$build->system, "; ",
2010-02-15 10:21:11 +00:00
strftime("%Y-%m-%d %H:%M:%S", localtime($build->timestamp)), ")\n";
2009-02-06 14:17:25 +00:00
if (isValidPath($build->outpath)) {
2012-03-07 14:02:31 +00:00
addRoot $build->outpath;
2009-02-06 14:17:25 +00:00
} else {
2012-03-07 14:02:31 +00:00
print STDERR " warning: output ", $build->outpath, " has disappeared\n" if $build->finished;
}
if (!$build->finished) {
if (isValidPath($build->drvpath)) {
addRoot $build->drvpath;
} else {
print STDERR " warning: derivation ", $build->drvpath, " has disappeared\n";
}
2009-02-06 14:17:25 +00:00
}
}
2009-01-13 14:02:07 +00:00
2012-03-07 14:12:47 +00:00
# Read the current GC roots. We need to do that here so that we don't
# delete roots that were added while we were determining the desired
# roots.
print STDERR "*** reading current roots...\n";
my $gcRootsDir = getGCRootsDir;
opendir DIR, $gcRootsDir or die;
my @roots = readdir DIR;
closedir DIR;
2012-03-07 14:02:31 +00:00
# Keep every build in every release of every project.
print STDERR "*** looking for release members\n";
keepBuild $_ foreach $db->resultset('Builds')->search_literal(
"exists (select 1 from releasemembers where build = me.id)", { order_by => ["project", "jobset", "job", "id"] });
# Keep all builds that have been marked as "keep".
print STDERR "*** looking for kept builds\n";
my @buildsToKeep = $db->resultset('Builds')->search(
{ finished => 1, keep => 1 }, { order_by => ["project", "jobset", "job", "id"], columns => [ @columns ] });
keepBuild $_ foreach @buildsToKeep;
2009-01-13 14:02:07 +00:00
2012-03-07 14:02:31 +00:00
# Go over all projects.
foreach my $project ($db->resultset('Projects')->search({}, { order_by => ["name"] })) {
2009-01-13 14:02:07 +00:00
2010-11-19 11:01:31 +00:00
# Go over all jobsets in this project.
2012-03-07 14:02:31 +00:00
foreach my $jobset ($project->jobsets->search({}, { order_by => ["name" ]})) {
2010-11-19 11:01:31 +00:00
my $keepnr = $jobset->keepnr;
2012-05-11 07:11:07 +00:00
# If the jobset has been hidden and disabled for more than one week, than
2010-11-23 09:05:09 +00:00
# don't keep its builds anymore.
2012-05-11 07:11:07 +00:00
if ($jobset->enabled == 0 && ($project->hidden == 1 || $jobset->hidden == 1) && (time() - ($jobset->lastcheckedtime || 0) > (7 * 24 * 3600))) {
2010-11-23 09:05:09 +00:00
print STDERR "*** skipping disabled jobset ", $project->name, ":", $jobset->name, "\n";
next;
}
2011-04-01 07:40:06 +00:00
2010-11-23 09:05:09 +00:00
if ($keepnr <= 0 ) {
print STDERR "*** jobset ", $project->name, ":", $jobset->name, " set to keep 0 builds\n";
next;
}
2011-04-01 07:40:06 +00:00
2012-03-07 14:02:31 +00:00
print STDERR "*** looking for the $keepnr most recent successful builds of each job in jobset ",
$project->name, ":", $jobset->name, "\n";
keepBuild $_ foreach $jobset->builds->search(
2013-01-22 13:41:02 +00:00
{ 'me.id' => { 'in' => \
2012-03-07 14:02:31 +00:00
[ "select b2.id from Builds b2 join " .
" (select distinct job, system, coalesce( " .
" (select id from builds where project = b.project and jobset = b.jobset and job = b.job and system = b.system and finished = 1 and buildStatus = 0 order by id desc offset ? limit 1)" .
2012-04-22 06:30:48 +00:00
" , 0) as nth from builds b where project = ? and jobset = ? and isCurrent = 1) x " .
2012-03-07 14:02:31 +00:00
" on b2.project = ? and b2.jobset = ? and b2.job = x.job and b2.system = x.system and (id >= x.nth) where finished = 1 and buildStatus = 0"
, [ '', $keepnr - 1 ], [ '', $project->name ], [ '', $jobset->name ], [ '', $project->name ], [ '', $jobset->name ] ] }
},
{ order_by => ["job", "system", "id"], columns => [ @columns ] });
2009-02-06 15:02:49 +00:00
}
2009-10-20 12:35:01 +00:00
# Go over all views in this project.
foreach my $view ($project->views->all) {
print STDERR "*** looking for builds to keep in view ", $project->name, ":", $view->name, "\n";
2009-02-06 15:02:49 +00:00
2009-10-20 12:35:01 +00:00
(my $primaryJob) = $view->viewjobs->search({isprimary => 1});
my $jobs = [$view->viewjobs->all];
2009-02-06 15:02:49 +00:00
2009-10-20 12:35:01 +00:00
# Keep all builds belonging to the most recent successful view result.
2012-04-03 15:45:03 +00:00
my $latest = getLatestSuccessfulViewResult($project, $primaryJob, $jobs, 0);
2009-02-06 15:02:49 +00:00
if (defined $latest) {
2012-03-07 14:02:31 +00:00
print STDERR " keeping latest successful view result ", $latest->id, " (", $latest->get_column('releasename'), ")\n";
2009-10-20 12:35:01 +00:00
my $result = getViewResult($latest, $jobs);
keepBuild $_->{build} foreach @{$result->{jobs}};
2009-02-06 15:02:49 +00:00
}
2009-01-13 14:02:07 +00:00
}
}
2009-03-15 11:56:11 +00:00
# For scheduled builds, we register the derivation as a GC root.
2009-03-14 23:56:57 +00:00
print STDERR "*** looking for scheduled builds\n";
2012-03-07 14:02:31 +00:00
keepBuild $_ foreach $db->resultset('Builds')->search({ finished => 0 }, { columns => [ @columns ] });
2009-01-13 14:02:07 +00:00
2012-03-07 14:12:47 +00:00
# Remove existing roots that are no longer wanted.
2009-03-14 23:56:57 +00:00
print STDERR "*** removing unneeded GC roots\n";
2009-02-06 21:01:20 +00:00
2012-03-07 14:02:31 +00:00
my $rootsKept = 0;
my $rootsDeleted = 0;
2012-03-07 14:12:47 +00:00
foreach my $link (@roots) {
2012-03-07 14:02:31 +00:00
next if $link eq "." || $link eq "..";
my $path = "/nix/store/$link";
2009-01-13 14:02:07 +00:00
if (!defined $roots{$path}) {
print STDERR "removing root $path\n";
2012-03-07 14:02:31 +00:00
$rootsDeleted++;
2012-03-26 15:13:50 +00:00
unlink "$gcRootsDir/$link" or warn "cannot remove $gcRootsDir/$link";
2012-03-07 14:02:31 +00:00
} else {
$rootsKept++;
2009-01-13 14:02:07 +00:00
}
}
2012-03-07 14:02:31 +00:00
print STDERR "kept $rootsKept roots, deleted $rootsDeleted roots\n";