forked from lix-project/lix
1328aa3307
roots to a per-process temporary file in /nix/var/nix/temproots while holding a write lock on that file. The garbage collector acquires read locks on all those files, thus blocking further progress in other Nix processes, and reads the sets of temporary roots.
84 lines
1.9 KiB
Plaintext
84 lines
1.9 KiB
Plaintext
#! @perl@ -w
|
|
|
|
use strict;
|
|
use IPC::Open2;
|
|
|
|
my $rootsDir = "@localstatedir@/nix/gcroots";
|
|
my $storeDir = "@storedir@";
|
|
|
|
my %alive;
|
|
|
|
my $gcOper = "--delete";
|
|
my $extraArgs = "";
|
|
|
|
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 =~ /^-v+$/) {
|
|
$extraArgs = "$extraArgs $arg";
|
|
}
|
|
else { die "unknown argument `$arg'" };
|
|
}
|
|
|
|
|
|
# Recursively finds all symlinks to the store 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 "..";
|
|
my $path = $dir . "/" . $name;
|
|
|
|
if (-l $path) {
|
|
my $target = readlink $path
|
|
or die "cannot read symlink `$path': $!";
|
|
|
|
if (substr($target, 0, length $storeDir) eq $storeDir) {
|
|
# We're only interested in the store-level part.
|
|
$target = substr($target, length $storeDir);
|
|
$target = "$storeDir/$target";
|
|
push @roots, $target;
|
|
}
|
|
|
|
elsif ($followSymlinks && -d $path) {
|
|
findRoots 0, $path;
|
|
}
|
|
}
|
|
|
|
elsif (-d $path) {
|
|
findRoots $followSymlinks, $path;
|
|
}
|
|
}
|
|
|
|
}
|
|
|
|
|
|
# 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 $extraArgs")
|
|
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";
|