guix/scripts/nix-push.in

#! @perl@ -w -I@libexecdir@/nix

use strict;
use POSIX qw(tmpnam);
use readmanifest;

my $hashAlgo = "sha256";

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;

my $binDir = $ENV{"NIX_BIN_DIR"};
$binDir = "@bindir@" unless defined $binDir;

my $dataDir = $ENV{"NIX_DATA_DIR"};
$dataDir = "@datadir@" unless defined $dataDir;


# Parse the command line.
my $localCopy;
my $localArchivesDir;
my $localManifestFile;

my $archivesPutURL;
my $archivesGetURL;
my $manifestPutURL;

if ($ARGV[0] eq "--copy") {
    die "syntax: nix-push --copy ARCHIVES_DIR MANIFEST_FILE PATHS...\n" if scalar @ARGV < 3;
    $localCopy = 1;
    shift @ARGV;
    $localArchivesDir = shift @ARGV;
    $localManifestFile = shift @ARGV;
}
else {
    die "syntax: nix-push ARCHIVES_PUT_URL ARCHIVES_GET_URL " .
        "MANIFEST_PUT_URL PATHS...\n" if scalar @ARGV < 3;
    $localCopy = 0;
    $archivesPutURL = shift @ARGV;
    $archivesGetURL = shift @ARGV;
    $manifestPutURL = shift @ARGV;
}


# From the given store paths, determine the set of requisite store
# paths, i.e, the paths required to realise them.
my %storePaths;

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

    # Get all paths referenced by the normalisation of the given 
    # Nix expression.
    my $pid = open(READ,
        "$binDir/nix-store --query --requisites --force-realise " .
        "--include-outputs '$path'|") or die;
    
    while (<READ>) {
        chomp;
        die "bad: $_" unless /^\//;
        $storePaths{$_} = "";
    }

    close READ or die "nix-store failed: $?";
}

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.
    # !!! the string reference to `$storePath' is impure!  We could
    # also pass it as a normal input, but that would cause it to be
    # copied, and its name would be expanded (e.g.,
    # /nix/store/HASH1-HASH2-symname).  nix-instantiate should be
    # smart enough to add store paths as direct references of the Nix
    # expression.
    my $nixexpr = 
        "((import $dataDir/nix/corepkgs/nar/nar.nix) " .
        "{path = \"$storePath\"; system = \"@system@\"; hashAlgo = \"$hashAlgo\";}) ";
    
    print NIX $nixexpr;
}

print NIX "]";
close NIX;


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


# 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];

    # Note: we disable build hooks because of the impure path
    # reference (see above).  Even if that is fixed, using a hook
    # probably wouldn't make that much sense; pumping lots of data
    # around just to compress them won't gain that much.
    $ENV{"NIX_BUILD_HOOK"} = "";
    my $pid = open(READ, "$binDir/nix-store --realise @tmp2|")
        or die "cannot run nix-store";
    while (<READ>) {
        chomp;
        die unless (/^\//);
        push @narPaths, "$_";
    }
    close READ or die "nix-store failed: $?";
}


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

my %narFiles;
my %patches;

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;

    open HASH, "$narDir/narbz2-hash" or die "cannot open narbz2-hash";
    my $narbz2Hash = <HASH>;
    chomp $narbz2Hash;
    $narbz2Hash =~ /^[0-9a-z]+$/ or die "invalid hash";
    close HASH;

    open HASH, "$narDir/nar-hash" or die "cannot open nar-hash";
    my $narHash = <HASH>;
    chomp $narHash;
    $narHash =~ /^[0-9a-z]+$/ or die "invalid hash";
    close HASH;
    
    my $narName = "$narbz2Hash.nar.bz2";

    my $narFile = "$narDir/$narName";
    (-f $narFile) or die "narfile for $storePath not found";
    push @narArchives, $narFile;

    my $narbz2Size = (stat $narFile)[7];

    my $references = `$binDir/nix-store --query --references '$storePath'`;
    die "cannot query references for `$storePath'" if $? != 0;
    $references = join(" ", split(" ", $references));

    my $deriver = `$binDir/nix-store --query --deriver '$storePath'`;
    die "cannot query deriver for `$storePath'" if $? != 0;
    chomp $deriver;
    $deriver = "" if $deriver eq "unknown-deriver";

    my $url;
    if ($localCopy) {
        $url = "file://$localArchivesDir/$narName";
    } else {
        $url = "$archivesGetURL/$narName";
    }
    $narFiles{$storePath} = [
        { url => $url
        , hash => "$hashAlgo:$narbz2Hash"
        , size => $narbz2Size
        , narHash => "$hashAlgo:$narHash"
        , references => $references
        , deriver => $deriver
        }
    ];
}

writeManifest $manifest, \%narFiles, \%patches;


sub copyFile {
    my $src = shift;
    my $dst = shift;
    system("cp '$src' '$dst.tmp'") == 0 or die "cannot copy file";
    rename("$dst.tmp", "$dst") or die "cannot rename file";
}


# Upload the archives.
print STDERR "uploading archives...\n";

sub archiveExists {
    my $name = shift;
    print STDERR "  HEAD on $archivesGetURL/$name\n";
    return system("$curl --head $archivesGetURL/$name > /dev/null") == 0;
}

foreach my $narArchive (@narArchives) {

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

    if ($localCopy) {
        if (! -f "$localArchivesDir/$basename") {
            print STDERR "  $narArchive\n";
            copyFile $narArchive, "$localArchivesDir/$basename";
        }
    }
    else {
        if (!archiveExists("$basename")) {
            print STDERR "  $narArchive\n";
            system("$curl --show-error --upload-file " .
                   "'$narArchive' '$archivesPutURL/$basename' > /dev/null") == 0 or
                   die "curl failed on $narArchive: $?";
        }
    }
}


# Upload the manifest.
print STDERR "uploading manifest...\n";
if ($localCopy) {
    copyFile $manifest, $localManifestFile;
} else {
    system("$curl  --show-error --upload-file " .
           "'$manifest' '$manifestPutURL' > /dev/null") == 0 or
           die "curl failed on $manifest: $?";
}