guix/scripts/nix-push.in

#! @perl@ -w

use strict;
use POSIX qw(tmpnam);

my $tmpdir;
do { $tmpdir = tmpnam(); }
until mkdir $tmpdir, 0777;

my $nixfile = "$tmpdir/create-nars.nix";
my $manifest = "$tmpdir/MANIFEST";

END { unlink $manifest; unlink $nixfile; rmdir $tmpdir; }

my $curl = "@curl@ --fail --silent";
my $extraCurlFlags = ${ENV{'CURL_FLAGS'}};
$curl = "$curl $extraCurlFlags" if defined $extraCurlFlags;


# Parse the command line.
my $archives_put_url = shift @ARGV;
my $archives_get_url = shift @ARGV;
my $manifest_put_url = shift @ARGV;


# From the given store expressions, determine the requisite store
# paths.
my %storepaths;

foreach my $storeexpr (@ARGV) {
    die unless $storeexpr =~ /^\//;

    # Get all paths referenced by the normalisation of the given 
    # Nix expression.
    system "@bindir@/nix-store --realise $storeexpr > /dev/null";
    die if ($?);

    open PATHS, "@bindir@/nix-store --query --requisites --include-successors $storeexpr 2> /dev/null |" or die;
    while (<PATHS>) {
        chomp;
        die "bad: $_" unless /^\//;
        $storepaths{$_} = "";
    }
    close PATHS;
}

my @storepaths = keys %storepaths;


# For each path, create a Nix expression that turns the path into
# a Nix archive.
open NIX, ">$nixfile";
print NIX "[";

foreach my $storepath (@storepaths) {
    die unless ($storepath =~ /\/[0-9a-z]{32}.*$/);

    # Construct a Nix expression that creates a Nix archive.
    my $nixexpr = 
        "((import @datadir@/nix/corepkgs/nar/nar.nix) " .
        # !!! $storepath should be represented as a closure
        "{path = \"$storepath\"; system = \"@system@\";}) ";
    
    print NIX $nixexpr;
}

print NIX "]";
close NIX;


# Instantiate store expressions from the Nix expression.
my @storeexprs;
print STDERR "instantiating store expressions...\n";
open STOREEXPRS, "@bindir@/nix-instantiate $nixfile |" or die "cannot run nix-instantiate";
while (<STOREEXPRS>) {
    chomp;
    die unless /^\//;
    push @storeexprs, $_;
}
close STOREEXPRS;


# Realise the store expressions.
print STDERR "creating archives...\n";

my @narpaths;

my @tmp = @storeexprs;
while (scalar @tmp > 0) {
    my $n = scalar @tmp;
    if ($n > 256) { $n = 256 };
    my @tmp2 = @tmp[0..$n - 1];
    @tmp = @tmp[$n..scalar @tmp - 1];

    system "@bindir@/nix-store --realise @tmp2 > /dev/null";
    if ($?) { die "`nix-store --realise' failed"; }

    open NARPATHS, "@bindir@/nix-store --query --list @tmp2 |" or die "cannot run nix";
    while (<NARPATHS>) {
        chomp;
        die unless (/^\//);
        push @narpaths, "$_";
    }
    close NARPATHS;
}


# Create the manifest.
print STDERR "creating manifest...\n";

open MANIFEST, ">$manifest";

my @nararchives;
for (my $n = 0; $n < scalar @storepaths; $n++) {
    my $storepath = $storepaths[$n];
    my $nardir = $narpaths[$n];
    
    $storepath =~ /\/([^\/]*)$/;
    my $basename = $1;
    defined $basename or die;

    my $narname = "$basename.nar.bz2";

    my $narfile = "$nardir/$narname";
    (-f $narfile) or die "narfile for $storepath not found";
    push @nararchives, $narfile;

    open MD5, "$nardir/narbz2-hash" or die "cannot open narbz2-hash";
    my $narbz2Hash = <MD5>;
    chomp $narbz2Hash;
    $narbz2Hash =~ /^[0-9a-z]{32}$/ or die "invalid hash";
    close MD5;

    open MD5, "$nardir/nar-hash" or die "cannot open nar-hash";
    my $narHash = <MD5>;
    chomp $narHash;
    $narHash =~ /^[0-9a-z]{32}$/ or die "invalid hash";
    close MD5;
    
    my $size = (stat $narfile)[7];

    print MANIFEST "{\n";
    print MANIFEST "  StorePath: $storepath\n";
    print MANIFEST "  NarURL: $archives_get_url/$narname\n";
    print MANIFEST "  MD5: $narbz2Hash\n";
    print MANIFEST "  NarHash: $narHash\n";
    print MANIFEST "  Size: $size\n";

    if ($storepath =~ /\.store$/) {
        open PREDS, "@bindir@/nix-store --query --predecessors $storepath |" or die "cannot run nix";
        while (<PREDS>) {
            chomp;
            die unless (/^\//);
            my $pred = $_;
            # Only include predecessors that are themselves being
            # pushed.
            if (defined $storepaths{$pred}) {
                print MANIFEST "  SuccOf: $pred\n";
            }
        }
        close PREDS;
    }

    print MANIFEST "}\n";
}

close MANIFEST;


# Upload the archives.
print STDERR "uploading archives...\n";
foreach my $nararchive (@nararchives) {

    $nararchive =~ /\/([^\/]*)$/;
    my $basename = $1;

    if (system("$curl --head $archives_get_url/$basename > /dev/null") != 0) {
        print STDERR "  $nararchive\n";
        system("$curl --show-error --upload-file " .
               "'$nararchive' '$archives_put_url/$basename' > /dev/null") == 0 or
            die "curl failed on $nararchive: $?";
    }
}


# Upload the manifest.
print STDERR "uploading manifest...\n";
system("$curl  --show-error --upload-file " .
       "'$manifest' '$manifest_put_url' > /dev/null") == 0 or
    die "curl failed on $manifest: $?";