61 lines
		
	
	
	
		
			1.8 KiB
		
	
	
	
		
			Perl
		
	
	
		
			Executable file
		
	
	
	
	
			
		
		
	
	
			61 lines
		
	
	
	
		
			1.8 KiB
		
	
	
	
		
			Perl
		
	
	
		
			Executable file
		
	
	
	
	
| #! /usr/bin/perl -w
 | |
| 
 | |
| use strict;
 | |
| 
 | |
| my $keep = 0;
 | |
| 
 | |
| if (scalar @ARGV > 0 && $ARGV[0] eq "--keep") {
 | |
|     shift @ARGV;
 | |
|     $keep = 1;
 | |
| }
 | |
| 
 | |
| my $hash = $ARGV[0];
 | |
| $hash || die "no package hash specified";
 | |
| 
 | |
| my $linkdir = "@localstatedir@/nix/links";
 | |
| 
 | |
| # Build the specified package, and all its dependencies.
 | |
| my $pkgdir = `nix -qph $hash`;
 | |
| if ($?) { die "`nix -qph' failed"; }
 | |
| chomp $pkgdir;
 | |
| 
 | |
| # Figure out a generation number.
 | |
| my $nr = 0;
 | |
| while (-e "$linkdir/$nr") { $nr++; }
 | |
| my $link = "$linkdir/$nr";
 | |
| 
 | |
| # Create a symlink from $link to $pkgdir.
 | |
| symlink($pkgdir, $link) or die "cannot create $link: $!";
 | |
| 
 | |
| # Also store the hash of $pkgdir.  This is useful for garbage
 | |
| # collection and the like.
 | |
| my $hashfile = "$linkdir/$nr.hash";
 | |
| open HASH, "> $hashfile" or die "cannot create $hashfile";
 | |
| print HASH "$hash\n";
 | |
| close HASH;
 | |
| 
 | |
| 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 || print "cannot delete $oldlink\n";
 | |
|     unlink("$oldlink.hash") == 1 || print "cannot delete $oldlink.hash\n";
 | |
| }
 |