2010-11-29 16:14:43 +00:00
|
|
|
# This script mirrors a remote Nix channel in the local filesystem.
|
|
|
|
# It downloads the remote manifest, then any NAR files that are not
|
2012-04-04 14:45:24 +00:00
|
|
|
# already available in the target directory.
|
2010-11-29 16:14:43 +00:00
|
|
|
|
2009-04-16 09:25:42 +00:00
|
|
|
use strict;
|
2011-11-23 16:15:33 +00:00
|
|
|
use Nix::Manifest;
|
|
|
|
use Nix::GeneratePatches;
|
2012-12-09 22:43:26 +00:00
|
|
|
use Nix::Utils;
|
2013-03-25 13:19:27 +00:00
|
|
|
use Nix::Store;
|
2009-04-16 09:25:42 +00:00
|
|
|
use File::Basename;
|
|
|
|
use File::stat;
|
2013-06-17 00:33:29 +00:00
|
|
|
use Net::Amazon::S3;
|
2013-06-17 13:14:05 +00:00
|
|
|
use List::MoreUtils qw(part);
|
2013-06-17 19:28:59 +00:00
|
|
|
use Forks::Super 'bg_eval';
|
2010-11-29 16:14:43 +00:00
|
|
|
|
2009-04-16 09:25:42 +00:00
|
|
|
|
2012-04-04 14:45:24 +00:00
|
|
|
if (scalar @ARGV < 4 || scalar @ARGV > 6) {
|
2013-06-17 00:33:29 +00:00
|
|
|
print STDERR "Syntax: perl mirror-channel.pl <src-channel-url> <dst-channel-dir> <bucket-name> <nar-url> [<all-patches-manifest [<nix-exprs-url>]]\n";
|
2009-04-16 09:25:42 +00:00
|
|
|
exit 1;
|
|
|
|
}
|
|
|
|
|
2012-12-09 22:43:26 +00:00
|
|
|
my $curl = "curl --location --silent --show-error --fail";
|
2010-01-26 09:17:50 +00:00
|
|
|
|
2013-06-17 13:14:05 +00:00
|
|
|
my $nrProcesses = 8;
|
|
|
|
|
2009-04-16 09:25:42 +00:00
|
|
|
my $srcChannelURL = $ARGV[0];
|
2010-06-23 14:07:47 +00:00
|
|
|
my $dstChannelPath = $ARGV[1];
|
2013-06-17 00:33:29 +00:00
|
|
|
my $bucketName = $ARGV[2];
|
|
|
|
my $cacheURL = $ARGV[3]; die if $cacheURL =~ /\/$/;
|
2012-04-04 14:45:24 +00:00
|
|
|
my $allPatchesManifest = $ARGV[4] || "";
|
2013-03-25 13:19:27 +00:00
|
|
|
my $nixexprsURL = $ARGV[5];
|
2009-04-16 09:25:42 +00:00
|
|
|
|
|
|
|
die "$dstChannelPath doesn't exist\n" unless -d $dstChannelPath;
|
|
|
|
|
2010-11-30 13:05:32 +00:00
|
|
|
my $manifestPath = "$dstChannelPath/MANIFEST";
|
2013-06-17 00:33:29 +00:00
|
|
|
|
|
|
|
|
|
|
|
# S3 setup.
|
|
|
|
my $aws_access_key_id = $ENV{'AWS_ACCESS_KEY_ID'} or die;
|
|
|
|
my $aws_secret_access_key = $ENV{'AWS_SECRET_ACCESS_KEY'} or die;
|
|
|
|
|
|
|
|
my $s3 = Net::Amazon::S3->new(
|
|
|
|
{ aws_access_key_id => $aws_access_key_id,
|
|
|
|
aws_secret_access_key => $aws_secret_access_key,
|
|
|
|
retry => 1,
|
|
|
|
});
|
|
|
|
|
2013-06-17 19:28:59 +00:00
|
|
|
my $bucket = $s3->bucket($bucketName) or die;
|
2010-11-30 13:05:32 +00:00
|
|
|
|
2010-11-29 16:14:43 +00:00
|
|
|
|
2012-04-04 14:45:24 +00:00
|
|
|
# Fetch the manifest.
|
|
|
|
system("$curl '$srcChannelURL/MANIFEST' > $dstChannelPath/MANIFEST") == 0 or die;
|
2010-11-29 16:14:43 +00:00
|
|
|
|
2010-01-26 09:38:13 +00:00
|
|
|
|
2013-03-25 13:19:27 +00:00
|
|
|
if (defined $nixexprsURL) {
|
|
|
|
# Mirror nixexprs.tar.xz.
|
|
|
|
system("$curl '$nixexprsURL' > $dstChannelPath/nixexprs.tar.xz") == 0 or die "cannot download `$nixexprsURL'";
|
2013-02-05 14:55:24 +00:00
|
|
|
|
2013-03-25 13:19:27 +00:00
|
|
|
# Generate nixexprs.tar.bz2 for backwards compatibility.
|
|
|
|
system("xz -d < $dstChannelPath/nixexprs.tar.xz | bzip2 > $dstChannelPath/nixexprs.tar.bz2") == 0 or die "cannot recompress nixexprs.tar";
|
|
|
|
}
|
2009-04-16 09:25:42 +00:00
|
|
|
|
|
|
|
|
2012-10-29 11:10:33 +00:00
|
|
|
# Advertise a binary cache.
|
|
|
|
open FILE, ">$dstChannelPath/binary-cache-url" or die;
|
2013-06-17 00:33:29 +00:00
|
|
|
print FILE $cacheURL or die;
|
2012-10-29 11:10:33 +00:00
|
|
|
close FILE or die;
|
|
|
|
|
|
|
|
|
2010-11-29 16:14:43 +00:00
|
|
|
# Read the manifest.
|
2011-07-31 23:24:08 +00:00
|
|
|
my (%narFiles, %patches);
|
2012-04-04 14:45:24 +00:00
|
|
|
readManifest("$dstChannelPath/MANIFEST", \%narFiles, \%patches);
|
2009-04-16 09:25:42 +00:00
|
|
|
|
|
|
|
%patches = (); # not supported yet
|
|
|
|
|
|
|
|
my $size = scalar (keys %narFiles);
|
2012-12-09 22:43:26 +00:00
|
|
|
print STDERR "$size store paths in manifest\n";
|
2009-04-16 09:25:42 +00:00
|
|
|
|
2010-11-29 16:14:43 +00:00
|
|
|
|
2010-01-26 09:51:05 +00:00
|
|
|
# Protect against Hydra problems that leave the channel empty.
|
|
|
|
die "cowardly refusing to mirror an empty channel" if $size == 0;
|
|
|
|
|
2010-11-29 16:14:43 +00:00
|
|
|
|
2013-01-18 11:48:37 +00:00
|
|
|
sub permute {
|
|
|
|
my @list = @_;
|
|
|
|
for (my $n = scalar @list - 1; $n > 0; $n--) {
|
|
|
|
my $k = int(rand($n + 1)); # 0 <= $k <= $n
|
|
|
|
@list[$n, $k] = @list[$k, $n];
|
|
|
|
}
|
|
|
|
return @list;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2013-03-25 13:19:27 +00:00
|
|
|
sub queryPathHash16 {
|
|
|
|
my ($storePath) = @_;
|
|
|
|
my ($deriver, $narHash, $time, $narSize, $refs) = queryPathInfo($storePath, 0);
|
|
|
|
return $narHash;
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2009-04-16 09:25:42 +00:00
|
|
|
# Download every file that we don't already have, and update every URL
|
|
|
|
# to point to the mirror. Also fill in the size and hash fields in
|
|
|
|
# the manifest in order to be compatible with Nix < 0.13.
|
|
|
|
|
2013-06-17 13:14:05 +00:00
|
|
|
sub mirrorStorePath {
|
2013-06-17 19:28:59 +00:00
|
|
|
my ($storePath, $res) = @_;
|
2013-01-18 11:48:37 +00:00
|
|
|
my $nars = $narFiles{$storePath};
|
2013-06-17 00:33:29 +00:00
|
|
|
die if scalar @{$nars} != 1;
|
|
|
|
my $nar = $$nars[0];
|
2012-12-09 22:43:26 +00:00
|
|
|
my $pathHash = substr(basename($storePath), 0, 32);
|
2013-06-17 00:33:29 +00:00
|
|
|
my $narInfoFile = "$pathHash.narinfo";
|
2010-08-27 09:01:45 +00:00
|
|
|
|
2013-06-17 23:10:59 +00:00
|
|
|
#print STDERR "$$: checking $narInfoFile\n";
|
|
|
|
my $get = $bucket->get_key("$pathHash.narinfo", "GET");
|
2013-06-17 00:33:29 +00:00
|
|
|
my $narInfo;
|
|
|
|
|
|
|
|
if (defined $get) {
|
|
|
|
$narInfo = parseNARInfo($storePath, $get->{value});
|
2013-06-17 23:10:59 +00:00
|
|
|
|
|
|
|
#if (!defined $bucket->head_key("$narInfo->{url}", "GET")) {
|
|
|
|
# print STDERR "missing NAR $narInfo->{url}!\n";
|
|
|
|
# $bucket->delete_key("$pathHash.narinfo");
|
|
|
|
# goto recreate;
|
|
|
|
#}
|
|
|
|
|
2012-12-09 22:43:26 +00:00
|
|
|
$nar->{hash} = $narInfo->{fileHash};
|
|
|
|
$nar->{size} = $narInfo->{fileSize};
|
|
|
|
$nar->{narHash} = $narInfo->{narHash};
|
|
|
|
$nar->{narSize} = $narInfo->{narSize};
|
2013-06-17 23:10:59 +00:00
|
|
|
$nar->{compressionType} = $narInfo->{compression};
|
2012-12-09 22:43:26 +00:00
|
|
|
$nar->{url} = "$cacheURL/$narInfo->{url}";
|
2013-06-17 23:10:59 +00:00
|
|
|
|
2013-06-17 00:33:29 +00:00
|
|
|
} else {
|
2013-06-17 23:10:59 +00:00
|
|
|
recreate:
|
2013-06-17 13:14:05 +00:00
|
|
|
my $dstFileTmp = "/tmp/nar.$$";
|
2013-06-17 00:33:29 +00:00
|
|
|
my $ext;
|
|
|
|
|
|
|
|
if (isValidPath($storePath) && queryPathHash16($storePath) eq $nar->{narHash}) {
|
|
|
|
print STDERR "copying $storePath instead of downloading $nar->{url}\n";
|
|
|
|
|
|
|
|
# Verify that $storePath hasn't been corrupted and compress it at the same time.
|
|
|
|
$ext = "xz";
|
|
|
|
my $narHash = `bash -c 'exec 4>&1; nix-store --dump $storePath | tee >(nix-hash --type sha256 --flat /dev/stdin >&4) | xz -7 > $dstFileTmp'`;
|
|
|
|
chomp $narHash;
|
|
|
|
die "hash mismatch in `$storePath'" if "sha256:$narHash" ne $nar->{narHash};
|
|
|
|
} else {
|
|
|
|
print STDERR "downloading $nar->{url}\n";
|
|
|
|
system("$curl '$nar->{url}' > $dstFileTmp") == 0 or die "failed to download `$nar->{url}'";
|
|
|
|
|
|
|
|
# Verify whether the downloaded file is a bzipped NAR file
|
|
|
|
# that matches the NAR hash given in the manifest.
|
|
|
|
$ext = "bz2";
|
|
|
|
my $narHash = `bunzip2 < $dstFileTmp | nix-hash --type sha256 --flat /dev/stdin` or die;
|
|
|
|
chomp $narHash;
|
|
|
|
die "hash mismatch in downloaded file `$nar->{url}'" if "sha256:$narHash" ne $nar->{narHash};
|
|
|
|
}
|
|
|
|
|
|
|
|
# Compute the hash of the compressed NAR (Hydra doesn't provide one).
|
|
|
|
my $fileHash = hashFile("sha256", 1, $dstFileTmp);
|
|
|
|
my $dstFile = "nar/$fileHash.nar.$ext";
|
|
|
|
$nar->{url} = "$cacheURL/$dstFile";
|
|
|
|
$nar->{hash} = "sha256:$fileHash";
|
|
|
|
$nar->{size} = stat($dstFileTmp)->size;
|
|
|
|
|
|
|
|
if (!defined $bucket->head_key($dstFile)) {
|
|
|
|
print STDERR "uploading $dstFile ($nar->{size} bytes)\n";
|
|
|
|
$bucket->add_key_filename($dstFile, $dstFileTmp) or die "failed to upload $dstFile to S3\n";
|
|
|
|
}
|
2012-12-09 22:43:26 +00:00
|
|
|
|
2013-06-17 00:33:29 +00:00
|
|
|
unlink($dstFileTmp) or die;
|
|
|
|
|
|
|
|
# Write the .narinfo.
|
|
|
|
my $info;
|
|
|
|
$info .= "StorePath: $storePath\n";
|
|
|
|
$info .= "URL: nar/$fileHash.nar.$ext\n";
|
|
|
|
$info .= "Compression: " . ($ext eq "xz" ? "xz" : "bzip2") . "\n";
|
|
|
|
$info .= "FileHash: $nar->{hash}\n";
|
|
|
|
$info .= "FileSize: $nar->{size}\n";
|
|
|
|
$info .= "NarHash: $nar->{narHash}\n";
|
|
|
|
$info .= "NarSize: $nar->{narSize}\n";
|
|
|
|
$info .= "References: " . join(" ", map { basename $_ } (split " ", $nar->{references})) . "\n";
|
|
|
|
$info .= "Deriver: " . basename $nar->{deriver} . "\n" if $nar->{deriver} ne "";
|
|
|
|
$info .= "System: $nar->{system}\n" if defined $nar->{system};
|
|
|
|
|
|
|
|
$bucket->add_key($narInfoFile, $info) or die "failed to upload $narInfoFile to S3\n";
|
2009-04-16 09:25:42 +00:00
|
|
|
}
|
2013-06-17 19:28:59 +00:00
|
|
|
|
|
|
|
$res->{$storePath} = $nar;
|
2009-04-16 09:25:42 +00:00
|
|
|
}
|
|
|
|
|
2010-07-08 09:09:28 +00:00
|
|
|
|
2013-06-17 13:14:05 +00:00
|
|
|
# Spawn a bunch of children to mirror paths in parallel.
|
|
|
|
my $i = 0;
|
|
|
|
my @filesPerProcess = part { $i++ % $nrProcesses } permute(keys %narFiles);
|
2013-06-17 19:28:59 +00:00
|
|
|
my @results;
|
2013-06-17 13:14:05 +00:00
|
|
|
for (my $n = 0; $n < $nrProcesses; $n++) {
|
2013-06-17 19:28:59 +00:00
|
|
|
push @results, bg_eval { my $res = {}; mirrorStorePath($_, $res) foreach @{$filesPerProcess[$n]}; return $res; }
|
2013-06-17 13:14:05 +00:00
|
|
|
}
|
|
|
|
|
2013-06-17 19:28:59 +00:00
|
|
|
|
|
|
|
# Get the updated NAR info from the children so we can update the manifest.
|
|
|
|
foreach my $r (@results) {
|
|
|
|
while (my ($storePath, $nar) = each %$r) {
|
|
|
|
$narFiles{$storePath} = [$nar];
|
|
|
|
}
|
2013-06-17 13:14:05 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
|
2010-11-29 16:14:43 +00:00
|
|
|
# Read all the old patches and propagate the useful ones. We use the
|
|
|
|
# file "all-patches" to keep track of all patches that have been
|
|
|
|
# generated in the past, so that patches are not lost if (for
|
|
|
|
# instance) a package temporarily disappears from the source channel,
|
|
|
|
# or if multiple instances of this script are running concurrently.
|
2012-04-04 14:45:24 +00:00
|
|
|
my (%dummy, %allPatches);
|
|
|
|
readManifest($allPatchesManifest, \%dummy, \%allPatches)
|
|
|
|
if $allPatchesManifest ne "" && -f $allPatchesManifest;
|
2010-11-29 16:14:43 +00:00
|
|
|
propagatePatches \%allPatches, \%narFiles, \%patches;
|
|
|
|
|
|
|
|
|
|
|
|
# Make the temporary manifest available.
|
2012-04-04 14:45:24 +00:00
|
|
|
writeManifest("$dstChannelPath/MANIFEST", \%narFiles, \%patches);
|