#! @perl@ -w use strict; use IPC::Open2; my $rootsDir = "@localstatedir@/nix/gcroots"; my $storeDir = "@storedir@"; my %alive; my $gcOper = "--delete"; 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; } 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") 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";