guix/scripts/nix-channel.in

#! @perl@ -w @perlFlags@

use strict;
use Nix::Config;

my $manifestDir = $Nix::Config::manifestDir;


# Turn on caching in nix-prefetch-url.
my $channelCache = "$Nix::Config::stateDir/channel-cache";
mkdir $channelCache, 0755 unless -e $channelCache;
$ENV{'NIX_DOWNLOAD_CACHE'} = $channelCache if -W $channelCache;


# Figure out the name of the `.nix-channels' file to use.
my $home = $ENV{"HOME"};
die '$HOME not set' unless defined $home;
my $channelsList = "$home/.nix-channels";

my $nixDefExpr = "$home/.nix-defexpr";
    

my @channels;


# Reads the list of channels from the file $channelsList;
sub readChannels {
    return if (!-f $channelsList);
    open CHANNELS, "<$channelsList" or die "cannot open `$channelsList': $!";
    while (<CHANNELS>) {
        chomp;
        next if /^\s*\#/;
        push @channels, $_;
    }
    close CHANNELS;
}


# Writes the list of channels to the file $channelsList;
sub writeChannels {
    open CHANNELS, ">$channelsList" or die "cannot open `$channelsList': $!";
    foreach my $url (@channels) {
        print CHANNELS "$url\n";
    }
    close CHANNELS;
}


# Adds a channel to the file $channelsList;
sub addChannel {
    my $url = shift;
    readChannels;
    foreach my $url2 (@channels) {
        return if $url eq $url2;
    }
    push @channels, $url;
    writeChannels;
}


# Remove a channel from the file $channelsList;
sub removeChannel {
    my $url = shift;
    my @left = ();
    readChannels;
    foreach my $url2 (@channels) {
        push @left, $url2 if $url ne $url2;
    }
    @channels = @left;
    writeChannels;
}


# Fetch Nix expressions and pull cache manifests from the subscribed
# channels.
sub update {
    readChannels;

    # Create the manifests directory if it doesn't exist.
    mkdir $manifestDir, 0755 unless -e $manifestDir;

    # Do we have write permission to the manifests directory?
    die "$0: you do not have write permission to `$manifestDir'!\n" unless -W $manifestDir;

    # Pull cache manifests.
    foreach my $url (@channels) {
        #print "pulling cache manifest from `$url'\n";
        system("$Nix::Config::binDir/nix-pull", "--skip-wrong-store", "$url/MANIFEST") == 0
            or die "cannot pull cache manifest from `$url'";
    }

    # Create a Nix expression that fetches and unpacks the channel Nix
    # expressions.

    my $inputs = "[";
    foreach my $url (@channels) {
        $url =~ /\/([^\/]+)\/?$/;
        my $channelName = $1;
        $channelName = "unnamed" unless defined $channelName;

        my $fullURL = "$url/nixexprs.tar.bz2";
        print "downloading Nix expressions from `$fullURL'...\n";
        $ENV{"PRINT_PATH"} = 1;
        $ENV{"QUIET"} = 1;
        my ($hash, $path) = `$Nix::Config::binDir/nix-prefetch-url '$fullURL'`;
        die "cannot fetch `$fullURL'" if $? != 0;
        chomp $path;
        $inputs .= '"' . $channelName . '"' . " " . $path . " ";
    }
    $inputs .= "]";

    # Figure out a name for the GC root.
    my $userName = getpwuid($<);
    die "who ARE you? go away" unless defined $userName;

    my $rootFile = "$Nix::Config::stateDir/gcroots/per-user/$userName/channels";
    
    # Build the Nix expression.
    print "unpacking channel Nix expressions...\n";
    my $outPath = `\\
        $Nix::Config::binDir/nix-build --out-link '$rootFile' --drv-link '$rootFile'.tmp \\
        '<nix/unpack-channel.nix>' \\
        --argstr system @system@ --arg inputs '$inputs'`
        or die "cannot unpack the channels";
    chomp $outPath;

    unlink "$rootFile.tmp";

    # Make the channels appear in nix-env.
    unlink $nixDefExpr if -l $nixDefExpr; # old-skool ~/.nix-defexpr
    mkdir $nixDefExpr or die "cannot create directory `$nixDefExpr'" if !-e $nixDefExpr;
    my $channelLink = "$nixDefExpr/channels";
    unlink $channelLink; # !!! not atomic
    symlink($outPath, $channelLink) or die "cannot symlink `$channelLink' to `$outPath'";
}


sub usageError {
    print STDERR <<EOF;
Usage:
  nix-channel --add URL
  nix-channel --remove URL
  nix-channel --list
  nix-channel --update
EOF
    exit 1;
}


usageError if scalar @ARGV == 0;


while (scalar @ARGV) {
    my $arg = shift @ARGV;

    if ($arg eq "--add") {
        usageError if scalar @ARGV != 1;
        addChannel (shift @ARGV);
        last;
    }

    if ($arg eq "--remove") {
        usageError if scalar @ARGV != 1;
        removeChannel (shift @ARGV);
        last;
    }

    if ($arg eq "--list") {
        usageError if scalar @ARGV != 0;
        readChannels;
        foreach my $url (@channels) {
            print "$url\n";
        }
        last;
    }

    elsif ($arg eq "--update") {
        usageError if scalar @ARGV != 0;
        update;
        last;
    }
    
    elsif ($arg eq "--help") {
        usageError;
    }

    else {
        die "unknown argument `$arg'; try `--help'";
    }
}