forked from lix-project/lix
8846465934
Renamed `fstateRefs' to `fstateRequisites'. The semantics of this function is that it returns a list of all paths necessary to realise a given expression. For a derive expression, this is the union of requisites of the inputs; for a slice expression, it is the path of each element in the slice. Also included are the paths of the expressions themselves. Optionally, one can also include the requisites of successor expressions (to recycle intermediate results). * `nix-switch' now distinguishes between an expression and its normal form. Usually, only the normal form is registered as a root of the garbage collector. With the `--source-root' flag, it will also register the original expression as a root. * `nix-collect-garbage' now has a flag `--keep-successors' which causes successors not to be included in the list of garbage paths. * `nix-collect-garbage' now has a flag `--invert' which will print all paths that should *not* be garbage collected.
83 lines
2.3 KiB
Perl
Executable file
83 lines
2.3 KiB
Perl
Executable file
#! /usr/bin/perl -w
|
|
|
|
use strict;
|
|
|
|
my $keep = 0;
|
|
my $sourceroot = 0;
|
|
my $srcid;
|
|
|
|
foreach my $arg (@ARGV) {
|
|
if ($arg eq "--keep") { $keep = 1; }
|
|
elsif ($arg eq "--source-root") { $sourceroot = 1; }
|
|
elsif ($arg =~ /^([0-9a-z]{32})$/) { $srcid = $arg; }
|
|
else { die "unknown argument `$arg'" };
|
|
}
|
|
|
|
my $linkdir = "@localstatedir@/nix/links";
|
|
|
|
# Build the specified package, and all its dependencies.
|
|
my $nfid = `nix --install $srcid`;
|
|
if ($?) { die "`nix --install' failed"; }
|
|
chomp $nfid;
|
|
die unless $nfid =~ /^([0-9a-z]{32})$/;
|
|
|
|
my $pkgdir = `nix --query --list $nfid`;
|
|
if ($?) { die "`nix --query --list' failed"; }
|
|
chomp $pkgdir;
|
|
|
|
# Figure out a generation number.
|
|
opendir(DIR, $linkdir);
|
|
my $nr = 0;
|
|
foreach my $n (sort(readdir(DIR))) {
|
|
next if (!($n =~ /^\d+$/));
|
|
$nr = $n + 1 if ($n >= $nr);
|
|
}
|
|
closedir(DIR);
|
|
|
|
my $link = "$linkdir/$nr";
|
|
|
|
# Create a symlink from $link to $pkgdir.
|
|
symlink($pkgdir, $link) or die "cannot create $link: $!";
|
|
|
|
# Store the id of the normal form. This is useful for garbage
|
|
# collection and the like.
|
|
my $idfile = "$linkdir/$nr.id";
|
|
open ID, "> $idfile" or die "cannot create $idfile";
|
|
print ID "$nfid\n";
|
|
close ID;
|
|
|
|
# Optionally store the source id.
|
|
if ($sourceroot) {
|
|
$idfile = "$linkdir/$nr-src.id";
|
|
open ID, "> $idfile" or die "cannot create $idfile";
|
|
print ID "$srcid\n";
|
|
close ID;
|
|
}
|
|
|
|
my $current = "$linkdir/current";
|
|
|
|
# Read the current generation so that we can delete it (if --keep
|
|
# wasn't specified).
|
|
my $oldlink = readlink($current);
|
|
|
|
# Make $link the current generation by pointing $linkdir/current to
|
|
# it. The rename() system call is supposed to be essentially atomic
|
|
# on Unix. That is, if we have links `current -> X' and `new_current
|
|
# -> Y', and we rename new_current to current, a process accessing
|
|
# current will see X or Y, but never a file-not-found or other error
|
|
# condition. This is sufficient to atomically switch the current link
|
|
# tree.
|
|
|
|
print "switching $current to $link\n";
|
|
|
|
my $tmplink = "$linkdir/new_current";
|
|
symlink($link, $tmplink) or die "cannot create $tmplink";
|
|
rename($tmplink, $current) or die "cannot rename $tmplink";
|
|
|
|
if (!$keep && defined $oldlink) {
|
|
print "deleting old $oldlink\n";
|
|
unlink($oldlink) == 1 or print "cannot delete $oldlink\n";
|
|
unlink("$oldlink.id") == 1 or print "cannot delete $oldlink.id\n";
|
|
unlink("$oldlink-src.id");
|
|
}
|