eb233e728f
unreachable paths that haven't been used for N hours. For instance, `nix-collect-garbage --min-age 168' only deletes paths that haven't been accessed in the last week. This is useful for instance in the build farm where many derivations can be shared between consecutive builds, and we wouldn't want a garbage collect to throw them all away. We could of course register them as roots, but then we'd to unregister them at some point, which would be a pain to manage. The `--min-age' flag gives us a sort of MRU caching scheme. BUG: this really shouldn't be in gc.cc since that violates mechanism/policy separation.
91 lines
2 KiB
Plaintext
Executable file
91 lines
2 KiB
Plaintext
Executable file
#! @perl@ -w
|
|
|
|
use strict;
|
|
use IPC::Open2;
|
|
|
|
my $rootsDir = "@localstatedir@/nix/gcroots";
|
|
my $storeDir = "@storedir@";
|
|
|
|
my %alive;
|
|
|
|
my $gcOper = "--delete";
|
|
my $minAge = 0;
|
|
|
|
my @roots = ();
|
|
|
|
|
|
# Parse the command line.
|
|
for (my $i = 0; $i < scalar @ARGV; $i++) {
|
|
my $arg = $ARGV[$i];
|
|
if ($arg eq "--delete" || $arg eq "--print-live" || $arg eq "--print-dead") {
|
|
$gcOper = $arg;
|
|
}
|
|
elsif ($arg eq "--min-age") {
|
|
$i++;
|
|
$minAge = undef;
|
|
$minAge = $ARGV[$i];
|
|
die "invalid minimum age" unless defined $minAge && $minAge =~ /^\d*$/;
|
|
}
|
|
else { die "unknown argument `$arg'" };
|
|
}
|
|
|
|
|
|
# Read all GC roots from the given file.
|
|
sub readRoots {
|
|
my $fileName = shift;
|
|
open ROOT, "<$fileName" or die "cannot open `$fileName': $!";
|
|
while (<ROOT>) {
|
|
chomp;
|
|
foreach my $root (split ' ') {
|
|
die "bad root `$root' in file `$fileName'"
|
|
unless $root =~ /^\S+$/;
|
|
push @roots, $root;
|
|
}
|
|
}
|
|
close ROOT;
|
|
}
|
|
|
|
|
|
# Recursively finds all *.gcroot files in the given directory.
|
|
sub findRoots;
|
|
sub findRoots {
|
|
my $followSymlinks = shift;
|
|
my $dir = shift;
|
|
|
|
opendir(DIR, $dir) or die "cannot open directory `$dir': $!";
|
|
my @names = readdir DIR or die "cannot read directory `$dir': $!";
|
|
closedir DIR;
|
|
|
|
foreach my $name (@names) {
|
|
next if $name eq "." || $name eq "..";
|
|
$name = $dir . "/" . $name;
|
|
if ($name =~ /.gcroot$/ && -f $name) {
|
|
readRoots $name;
|
|
}
|
|
elsif (-d $name) {
|
|
if ($followSymlinks || !-l $name) {
|
|
findRoots 0, $name;
|
|
}
|
|
}
|
|
}
|
|
|
|
}
|
|
|
|
|
|
# Find GC roots, starting at $rootsDir.
|
|
findRoots 1, $rootsDir;
|
|
|
|
|
|
# Run the collector with the roots we found.
|
|
my $pid = open2(">&1", \*WRITE, "@bindir@/nix-store --gc $gcOper --min-age $minAge")
|
|
or die "cannot run `nix-store --gc'";
|
|
|
|
foreach my $root (@roots) {
|
|
print WRITE "$root\n";
|
|
}
|
|
|
|
close WRITE;
|
|
|
|
waitpid $pid, 0;
|
|
$? == 0 or die "`nix-store --gc' failed";
|