#! /usr/bin/perl -w use strict; my $pkglist = $ENV{"NIX_ACTIVATIONS"}; $pkglist or die "NIX_ACTIVATIONS not set"; my $linkdir = $ENV{"NIX_LINKS"}; $linkdir or die "NIX_LINKS not set"; my @dirs = ("bin", "sbin", "lib"); # Figure out a generation number. my $nr = 1; while (-e "$linkdir/$nr") { $nr++; } my $gendir = "$linkdir/$nr"; print "populating $gendir\n"; # Create the subdirectories. mkdir $gendir; foreach my $dir (@dirs) { mkdir "$gendir/$dir"; } # For each activated package, create symlinks. sub createLinks { my $srcdir = shift; my $dstdir = shift; my @srcfiles = glob("$srcdir/*"); foreach my $srcfile (@srcfiles) { my $basename = $srcfile; $basename =~ s/^.*\///g; # strip directory my $dstfile = "$dstdir/$basename"; if (-d $srcfile) { # !!! hack for resolving name clashes if (!-e $dstfile) { mkdir($dstfile) or die "error creating directory $dstfile"; } -d $dstfile or die "$dstfile is not a directory"; createLinks($srcfile, $dstfile); } elsif (-l $dstfile) { my $target = readlink($dstfile); die "collission between $srcfile and $target"; } else { print "linking $dstfile to $srcfile\n"; symlink($srcfile, $dstfile) or die "error creating link $dstfile"; } } } open PKGS, "< $pkglist"; while () { chomp; my $hash = $_; my $pkgdir = `nix getpkg $hash`; if ($?) { die "`nix getpkg' failed"; } chomp $pkgdir; print "merging $pkgdir\n"; foreach my $dir (@dirs) { createLinks("$pkgdir/$dir", "$gendir/$dir"); } } close PKGS; # Make $gendir 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. my $current = "$linkdir/current"; print "switching $current to $gendir\n"; my $tmplink = "$linkdir/new_current"; symlink($gendir, $tmplink) or die "cannot create $tmplink"; rename($tmplink, $current) or die "cannot rename $tmplink";