From 14960d6c531d3bead28138dff883e356d7f27f9a Mon Sep 17 00:00:00 2001
From: Eelco Dolstra <e.dolstra@tudelft.nl>
Date: Tue, 13 Jan 2009 14:02:07 +0000
Subject: [PATCH] * hydra_update_gc_roots.pl registers build outputs that
 should be kept   as GC roots and removes GC roots to build outputs that
 should no   longer be kept.

---
 src/Hydra/lib/Hydra/Controller/Root.pm    |  2 +
 src/Hydra/lib/Hydra/Helper/Nix.pm         |  8 ++-
 src/Hydra/root/build.tt                   |  4 ++
 src/Hydra/script/hydra_update_gc_roots.pl | 74 +++++++++++++++++++++++
 4 files changed, 86 insertions(+), 2 deletions(-)
 create mode 100755 src/Hydra/script/hydra_update_gc_roots.pl

diff --git a/src/Hydra/lib/Hydra/Controller/Root.pm b/src/Hydra/lib/Hydra/Controller/Root.pm
index 2e34752a..a68d4171 100644
--- a/src/Hydra/lib/Hydra/Controller/Root.pm
+++ b/src/Hydra/lib/Hydra/Controller/Root.pm
@@ -679,6 +679,8 @@ sub build :Local {
 
     $c->stash->{curTime} = time;
 
+    $c->stash->{available} = isValidPath $build->outpath;
+
     if (!$build->finished && $build->schedulingInfo->busy) {
         my $logfile = $build->schedulingInfo->logfile;
         $c->stash->{logtext} = `cat $logfile`;
diff --git a/src/Hydra/lib/Hydra/Helper/Nix.pm b/src/Hydra/lib/Hydra/Helper/Nix.pm
index a6dcaa65..c7fa8ea7 100644
--- a/src/Hydra/lib/Hydra/Helper/Nix.pm
+++ b/src/Hydra/lib/Hydra/Helper/Nix.pm
@@ -2,6 +2,7 @@ package Hydra::Helper::Nix;
 
 use strict;
 use Exporter;
+use File::Basename;
 
 our @ISA = qw(Exporter);
 our @EXPORT = qw(isValidPath getHydraPath getHydraDBPath openHydraDB);
@@ -9,8 +10,11 @@ our @EXPORT = qw(isValidPath getHydraPath getHydraDBPath openHydraDB);
 
 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;
+    #$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);
 }
 
 
diff --git a/src/Hydra/root/build.tt b/src/Hydra/root/build.tt
index 42e3414e..49b6c043 100644
--- a/src/Hydra/root/build.tt
+++ b/src/Hydra/root/build.tt
@@ -241,6 +241,10 @@
 
 <h2>Build products</h2>
 
+[% IF !available %]
+  <p class="error">Note: this build is no longer available.</p>
+[% END %]
+
 [% PROCESS renderProductList %]
 
 [% END %]
diff --git a/src/Hydra/script/hydra_update_gc_roots.pl b/src/Hydra/script/hydra_update_gc_roots.pl
new file mode 100755
index 00000000..b6c9cd83
--- /dev/null
+++ b/src/Hydra/script/hydra_update_gc_roots.pl
@@ -0,0 +1,74 @@
+#! /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;