hydra/src/Hydra/script/hydra_update_gc_roots.pl

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

use strict;
use File::Path;
use File::Basename;
use Hydra::Schema;
use Hydra::Helper::Nix;

my $db = openHydraDB;

die unless defined $ENV{LOGNAME};
my $gcRootsDir = "/nix/var/nix/gcroots/per-user/$ENV{LOGNAME}/hydra-roots";


my %roots;

sub registerRoot {
    my ($path) = @_;
    print "$path\n";

    mkpath($gcRootsDir) if !-e $gcRootsDir;

    my $link = "$gcRootsDir/" . basename $path;
        
    if (!-e $link) {
        symlink($path, $link)
            or die "cannot creating symlink in $gcRootsDir to $path";
    }

    $roots{$path} = 1;
}


# Determine which builds to keep automatically.
my %pathsToKeep;

# TODO


# For finished builds, we only keep the output path, not the derivation.
foreach my $build ($db->resultset('Builds')->search({finished => 1, buildStatus => 0}, {join => 'resultInfo'})) {
    if ($build->resultInfo->keep || defined $pathsToKeep{$build->outpath}) {
        if (isValidPath($build->outpath)) {
            registerRoot $build->outpath;
        } else {
            print STDERR "warning: output ", $build->outpath, " has disappeared\n";
        }
    }
}


# For scheduled builds, we register the derivation as a GC root.
foreach my $build ($db->resultset('Builds')->search({finished => 0}, {join => 'schedulingInfo'})) {
    if (isValidPath($build->drvpath)) {
        registerRoot $build->drvpath;
    } else {
        print STDERR "warning: derivation ", $build->drvpath, " has disappeared\n";
    }
}


# Remove existing roots that are no longer wanted.  !!! racy
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;