#! @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";