lix/scripts/download-using-manifests.pl.in

396 lines
12 KiB
Perl
Raw Normal View History

#! @perl@ -w @perlFlags@
use strict;
use Nix::Config;
use Nix::Manifest;
2006-10-04 18:58:11 +00:00
use POSIX qw(strftime);
use File::Temp qw(tempdir);
STDOUT->autoflush(1);
my $logFile = "$Nix::Config::logDir/downloads";
2004-12-30 16:34:54 +00:00
# For queries, skip expensive calls to nix-hash etc. We're just
# estimating the expected download size.
my $fast = 1;
# Open the manifest cache and update it if necessary.
my $dbh = updateManifestDB();
sub isValidPath {
my $p = shift;
if ($fast) {
return -e $p;
} else {
return system("$Nix::Config::binDir/nix-store --check-validity '$p' 2> /dev/null") == 0;
}
}
sub parseHash {
my $hash = shift;
if ($hash =~ /^(.+):(.+)$/) {
return ($1, $2);
} else {
return ("md5", $hash);
}
}
# Compute the most efficient sequence of downloads to produce the
# given path.
sub computeSmallestDownload {
my $targetPath = shift;
# Build a graph of all store paths that might contribute to the
# construction of $targetPath, and the special node "start". The
# edges are either patch operations, or downloads of full NAR
# files. The latter edges only occur between "start" and a store
# path.
my %graph;
$graph{"start"} = {d => 0, pred => undef, edges => []};
my @queue = ();
my $queueFront = 0;
my %done;
sub addNode {
my $graph = shift;
my $u = shift;
$$graph{$u} = {d => 999999999999, pred => undef, edges => []}
unless defined $$graph{$u};
}
sub addEdge {
my $graph = shift;
my $u = shift;
my $v = shift;
my $w = shift;
my $type = shift;
my $info = shift;
addNode $graph, $u;
push @{$$graph{$u}->{edges}},
{weight => $w, start => $u, end => $v, type => $type, info => $info};
my $n = scalar @{$$graph{$u}->{edges}};
}
push @queue, $targetPath;
while ($queueFront < scalar @queue) {
my $u = $queue[$queueFront++];
2010-11-17 17:54:49 +00:00
next if defined $done{$u};
$done{$u} = 1;
addNode \%graph, $u;
# If the path already exists, it has distance 0 from the
# "start" node.
if (isValidPath($u)) {
addEdge \%graph, "start", $u, 0, "present", undef;
}
else {
# Add patch edges.
my $patchList = $dbh->selectall_arrayref(
"select * from Patches where storePath = ?",
{ Slice => {} }, $u);
foreach my $patch (@{$patchList}) {
if (isValidPath($patch->{basePath})) {
# !!! this should be cached
my ($baseHashAlgo, $baseHash) = parseHash $patch->{baseHash};
my $format = "--base32";
$format = "" if $baseHashAlgo eq "md5";
my $hash = $fast && $baseHashAlgo eq "sha256"
? `$Nix::Config::binDir/nix-store -q --hash "$patch->{basePath}"`
: `$Nix::Config::binDir/nix-hash --type '$baseHashAlgo' $format "$patch->{basePath}"`;
chomp $hash;
$hash =~ s/.*://;
next if $hash ne $baseHash;
}
push @queue, $patch->{basePath};
addEdge \%graph, $patch->{basePath}, $u, $patch->{size}, "patch", $patch;
}
# Add NAR file edges to the start node.
my $narFileList = $dbh->selectall_arrayref(
"select * from NARs where storePath = ?",
{ Slice => {} }, $u);
foreach my $narFile (@{$narFileList}) {
# !!! how to handle files whose size is not known in advance?
# For now, assume some arbitrary size (1 GB).
# This has the side-effect of preferring non-Hydra downloads.
addEdge \%graph, "start", $u, ($narFile->{size} || 1000000000), "narfile", $narFile;
}
}
}
# Run Dijkstra's shortest path algorithm to determine the shortest
# sequence of download and/or patch actions that will produce
# $targetPath.
my @todo = keys %graph;
while (scalar @todo > 0) {
# Remove the closest element from the todo list.
# !!! inefficient, use a priority queue
@todo = sort { -($graph{$a}->{d} <=> $graph{$b}->{d}) } @todo;
my $u = pop @todo;
my $u_ = $graph{$u};
foreach my $edge (@{$u_->{edges}}) {
my $v_ = $graph{$edge->{end}};
if ($v_->{d} > $u_->{d} + $edge->{weight}) {
$v_->{d} = $u_->{d} + $edge->{weight};
# Store the edge; to edge->start is actually the
# predecessor.
$v_->{pred} = $edge;
}
}
}
# Retrieve the shortest path from "start" to $targetPath.
my @path = ();
my $cur = $targetPath;
return () unless defined $graph{$targetPath}->{pred};
while ($cur ne "start") {
push @path, $graph{$cur}->{pred};
$cur = $graph{$cur}->{pred}->{start};
}
return @path;
}
# Parse the arguments.
if ($ARGV[0] eq "--query") {
while (<STDIN>) {
my $cmd = $_; chomp $cmd;
if ($cmd eq "have") {
my $storePath = <STDIN>; chomp $storePath;
print STDOUT (
scalar @{$dbh->selectcol_arrayref("select 1 from NARs where storePath = ?", {}, $storePath)} > 0
? "1\n" : "0\n");
}
elsif ($cmd eq "info") {
my $storePath = <STDIN>; chomp $storePath;
my $infos = $dbh->selectall_arrayref(
"select * from NARs where storePath = ?",
{ Slice => {} }, $storePath);
my $info;
if (scalar @{$infos} > 0) {
$info = @{$infos}[0];
}
else {
print "0\n";
next; # not an error
}
print "1\n";
print "$info->{deriver}\n";
my @references = split " ", $info->{refs};
print scalar @references, "\n";
print "$_\n" foreach @references;
my @path = computeSmallestDownload $storePath;
my $downloadSize = 0;
while (scalar @path > 0) {
my $edge = pop @path;
my $u = $edge->{start};
my $v = $edge->{end};
if ($edge->{type} eq "patch") {
$downloadSize += $edge->{info}->{size} || 0;
}
elsif ($edge->{type} eq "narfile") {
$downloadSize += $edge->{info}->{size} || 0;
}
}
print "$downloadSize\n";
my $narSize = $info->{narSize} || 0;
print "$narSize\n";
}
else { die "unknown command `$cmd'"; }
}
exit 0;
}
elsif ($ARGV[0] ne "--substitute") {
2010-02-04 09:38:09 +00:00
die;
}
die unless scalar @ARGV == 2;
my $targetPath = $ARGV[1];
$fast = 0;
# Create a temporary directory.
my $tmpDir = tempdir("nix-download.XXXXXX", CLEANUP => 1, TMPDIR => 1)
or die "cannot create a temporary directory";
my $tmpNar = "$tmpDir/nar";
my $tmpNar2 = "$tmpDir/nar2";
open LOGFILE, ">>$logFile" or die "cannot open log file $logFile";
my $date = strftime ("%F %H:%M:%S UTC", gmtime (time));
print LOGFILE "$$ get $targetPath $date\n";
print "\n*** Trying to download/patch `$targetPath'\n";
# Compute the shortest path.
my @path = computeSmallestDownload $targetPath;
die "don't know how to produce $targetPath\n" if scalar @path == 0;
# We don't need the manifest anymore, so close it as an optimisation:
# if we still have SQLite locks blocking other processes (we
# shouldn't), this gets rid of them.
$dbh->disconnect;
# Traverse the shortest path, perform the actions described by the
# edges.
my $curStep = 1;
my $maxStep = scalar @path;
sub downloadFile {
my $url = shift;
$ENV{"PRINT_PATH"} = 1;
$ENV{"QUIET"} = 1;
my ($hash, $path) = `$Nix::Config::binDir/nix-prefetch-url '$url'`;
2011-03-16 15:55:57 +00:00
die "download of `$url' failed" . ($! ? ": $!" : "") unless $? == 0;
chomp $path;
return $path;
}
my $finalNarHash;
while (scalar @path > 0) {
my $edge = pop @path;
my $u = $edge->{start};
my $v = $edge->{end};
print "\n*** Step $curStep/$maxStep: ";
if ($edge->{type} eq "present") {
print "using already present path `$v'\n";
2004-12-30 16:34:54 +00:00
print LOGFILE "$$ present $v\n";
if ($curStep < $maxStep) {
# Since this is not the last step, the path will be used
# as a base to one or more patches. So turn the base path
# into a NAR archive, to which we can apply the patch.
print " packing base path...\n";
system("$Nix::Config::binDir/nix-store --dump $v > $tmpNar") == 0
2006-09-25 10:44:27 +00:00
or die "cannot dump `$v'";
}
}
elsif ($edge->{type} eq "patch") {
my $patch = $edge->{info};
print "applying patch `$patch->{url}' to `$u' to create `$v'\n";
2004-12-30 16:34:54 +00:00
print LOGFILE "$$ patch $patch->{url} $patch->{size} $patch->{baseHash} $u $v\n";
# Download the patch.
print " downloading patch...\n";
my $patchPath = downloadFile "$patch->{url}";
# Apply the patch to the NAR archive produced in step 1 (for
# the already present path) or a later step (for patch sequences).
print " applying patch...\n";
system("$Nix::Config::libexecDir/bspatch $tmpNar $tmpNar2 $patchPath") == 0
2006-09-25 10:44:27 +00:00
or die "cannot apply patch `$patchPath' to $tmpNar";
if ($curStep < $maxStep) {
# The archive will be used as the base of the next patch.
2005-09-15 15:21:35 +00:00
rename "$tmpNar2", "$tmpNar" or die "cannot rename NAR archive: $!";
} else {
# This was the last patch. Unpack the final NAR archive
# into the target path.
print " unpacking patched archive...\n";
system("$Nix::Config::binDir/nix-store --restore $v < $tmpNar2") == 0
2006-09-25 10:44:27 +00:00
or die "cannot unpack $tmpNar2 into `$v'";
}
$finalNarHash = $patch->{narHash};
}
elsif ($edge->{type} eq "narfile") {
my $narFile = $edge->{info};
print "downloading `$narFile->{url}' into `$v'\n";
my $size = $narFile->{size} || -1;
print LOGFILE "$$ narfile $narFile->{url} $size $v\n";
2004-12-30 16:34:54 +00:00
# Download the archive.
print " downloading archive...\n";
my $narFilePath = downloadFile "$narFile->{url}";
if ($curStep < $maxStep) {
# The archive will be used a base to a patch.
system("$Nix::Config::bzip2 -d < '$narFilePath' > $tmpNar") == 0
2006-09-25 10:44:27 +00:00
or die "cannot unpack `$narFilePath' into `$v'";
} else {
# Unpack the archive into the target path.
print " unpacking archive...\n";
system("$Nix::Config::bzip2 -d < '$narFilePath' | $Nix::Config::binDir/nix-store --restore '$v'") == 0
2006-09-25 10:44:27 +00:00
or die "cannot unpack `$narFilePath' into `$v'";
}
$finalNarHash = $narFile->{narHash};
}
$curStep++;
}
2004-12-30 16:34:54 +00:00
2009-02-26 21:12:35 +00:00
# Make sure that the hash declared in the manifest matches what we
# downloaded and unpacked.
if (defined $finalNarHash) {
my ($hashAlgo, $hash) = parseHash $finalNarHash;
2009-02-26 21:12:35 +00:00
# The hash in the manifest can be either in base-16 or base-32.
# Handle both.
my $extraFlag =
($hashAlgo eq "sha256" && length($hash) != 64)
? "--base32" : "";
my $hash2 = `$Nix::Config::binDir/nix-hash --type $hashAlgo $extraFlag $targetPath`
or die "cannot compute hash of path `$targetPath'";
chomp $hash2;
2009-02-26 21:12:35 +00:00
die "hash mismatch in downloaded path $targetPath; expected $hash, got $hash2"
if $hash ne $hash2;
} else {
die "cannot check integrity of the downloaded path since its hash is not known";
}
2004-12-30 16:34:54 +00:00
print LOGFILE "$$ success\n";
close LOGFILE;