hydra/src/script/hydra-update-gc-roots

#! /var/run/current-system/sw/bin/perl -w

use strict;
use File::Path;
use File::Basename;
use Nix::Store;
use Hydra::Schema;
use Hydra::Helper::Nix;
use Hydra::Model::DB;
use POSIX qw(strftime);

my $db = Hydra::Model::DB->new();


my %roots;

sub addRoot {
    my ($path) = @_;
    registerRoot($path);
    $roots{$path} = 1;
}


my @columns = ( "id", "project", "jobset", "job", "system", "finished", "outpath", "drvpath", "timestamp" );

sub keepBuild {
    my ($build) = @_;
    print STDERR "  keeping ", ($build->finished ? "" : "scheduled "), "build ", $build->id, " (",
        $build->get_column('project'), ":", $build->get_column('jobset'), ":", $build->get_column('job'), "; ",
	$build->system, "; ",
        strftime("%Y-%m-%d %H:%M:%S", localtime($build->timestamp)), ")\n";
    if (isValidPath($build->outpath)) {
	addRoot $build->outpath;
    } else {
        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";
	}
    }
}


# 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;


# 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;


# Go over all projects.
foreach my $project ($db->resultset('Projects')->search({}, { order_by => ["name"] })) {

    # Go over all jobsets in this project.
    foreach my $jobset ($project->jobsets->search({}, { order_by => ["name" ]})) {
        my $keepnr = $jobset->keepnr;

        # If the jobset has been hidden and disabled for more than one week, than
        # don't keep its builds anymore.
        if ($jobset->enabled == 0 && ($project->hidden == 1 || $jobset->hidden == 1) && (time() - ($jobset->lastcheckedtime || 0) > (7 * 24 * 3600))) {
            print STDERR "*** skipping disabled jobset ", $project->name, ":", $jobset->name, "\n";
            next;
        }

        if ($keepnr <= 0 ) {
            print STDERR "*** jobset ", $project->name, ":", $jobset->name, " set to keep 0 builds\n";
            next;
        }

	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(
	    { 'me.id' => { 'in' => \
	        [ "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)" .
                  "    , 0) as nth from builds b where project = ? and jobset = ? and isCurrent = 1) x " .
		  "  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 ] });
    }

    # 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, 0);
        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}};
        }
    }
}


# For scheduled builds, we register the derivation as a GC root.
print STDERR "*** looking for scheduled builds\n";
keepBuild $_ foreach $db->resultset('Builds')->search({ finished => 0 }, { columns => [ @columns ] });


# Remove existing roots that are no longer wanted.
print STDERR "*** removing unneeded GC roots\n";

my $rootsKept = 0;
my $rootsDeleted = 0;

foreach my $link (@roots) {
    next if $link eq "." || $link eq "..";
    my $path = "/nix/store/$link";
    if (!defined $roots{$path}) {
        print STDERR "removing root $path\n";
	$rootsDeleted++;
        unlink "$gcRootsDir/$link" or warn "cannot remove $gcRootsDir/$link";
    } else {
	$rootsKept++;
    }
}

print STDERR "kept $rootsKept roots, deleted $rootsDeleted roots\n";