hydra/src/script/hydra_update_gc_roots.pl
Eelco Dolstra 77d4a8c027 * Keep the 3 most recent builds for every platform for every job.
Previously it just kept the 3 most recent builds for every job
  (contrary to what the comment said).
2010-02-15 10:21:11 +00:00

129 lines
4.1 KiB
Perl
Executable file

#! /var/run/current-system/sw/bin/perl -w
use strict;
use File::Path;
use File::Basename;
use Hydra::Schema;
use Hydra::Helper::Nix;
use POSIX qw(strftime);
my $db = openHydraDB;
my %roots;
sub registerRoot {
my ($path) = @_;
Hydra::Helper::Nix::registerRoot($path);
$roots{$path} = 1;
}
sub keepBuild {
my ($build) = @_;
print STDERR " keeping build ", $build->id, " (",
$build->system, "; ",
strftime("%Y-%m-%d %H:%M:%S", localtime($build->timestamp)), ")\n";
if (isValidPath($build->outpath)) {
registerRoot $build->outpath;
} else {
print STDERR "warning: output ", $build->outpath, " has disappeared\n";
}
}
# Go over all projects.
foreach my $project ($db->resultset('Projects')->all) {
# Go over all jobs in this project.
foreach my $job ($project->jobs->all) {
print STDERR "*** looking for builds to keep in job ",
$project->name, ":", $job->jobset->name, ":", $job->name, "\n";
# Keep the N most recent successful builds for each job and
# platform.
# !!! Take time into account? E.g. don't delete builds that
# are younger than N days.
my @systems = $job->builds->search({ }, { select => ["system"], distinct => 1 })->all;
foreach my $system (@systems) {
my @recentBuilds = $job->builds->search(
{ finished => 1
, buildStatus => 0 # == success
, system => $system->system
},
{ join => 'resultInfo'
, order_by => 'id DESC'
, rows => 3 # !!! should make this configurable
});
keepBuild $_ foreach @recentBuilds;
}
}
# 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";
(my $primaryJob) = $view->viewjobs->search({isprimary => 1});
my $jobs = [$view->viewjobs->all];
# Keep all builds belonging to the most recent successful view result.
my $latest = getLatestSuccessfulViewResult($project, $primaryJob, $jobs);
if (defined $latest) {
print STDERR "keeping latest successful view result ", $latest->id, " (", $latest->get_column('releasename'), ")\n";
my $result = getViewResult($latest, $jobs);
keepBuild $_->{build} foreach @{$result->{jobs}};
}
}
# Keep every build in every release in this project.
print STDERR "*** keeping releases in project ", $project->name, "\n"
if scalar $project->releases > 0;
foreach my $release ($project->releases->all) {
print STDERR "keeping release ", $release->name, "\n";
keepBuild $_->build foreach $release->releasemembers;
}
}
# 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}, {join => 'resultInfo'});
keepBuild $_ foreach @buildsToKeep;
# For scheduled builds, we register the derivation as a GC root.
print STDERR "*** looking for scheduled builds\n";
foreach my $build ($db->resultset('Builds')->search({finished => 0}, {join => 'schedulingInfo'})) {
if (isValidPath($build->drvpath)) {
print STDERR "keeping scheduled build ", $build->id, " (",
strftime("%Y-%m-%d %H:%M:%S", localtime($build->timestamp)), ")\n";
registerRoot $build->drvpath;
registerRoot $build->outpath if -e $build->outpath;
} else {
print STDERR "warning: derivation ", $build->drvpath, " has disappeared\n";
}
}
# Remove existing roots that are no longer wanted. !!! racy
print STDERR "*** removing unneeded GC roots\n";
my $gcRootsDir = getGCRootsDir;
opendir DIR, $gcRootsDir or die;
foreach my $link (readdir DIR) {
next if !-l "$gcRootsDir/$link";
my $path = readlink "$gcRootsDir/$link" or die;
if (!defined $roots{$path}) {
print STDERR "removing root $path\n";
unlink "$gcRootsDir/$link" or die "cannot remove $gcRootsDir/$link";
}
}
closedir DIR;