293 lines
		
	
	
	
		
			8.4 KiB
		
	
	
	
		
			Perl
		
	
	
	
	
	
			
		
		
	
	
			293 lines
		
	
	
	
		
			8.4 KiB
		
	
	
	
		
			Perl
		
	
	
	
	
	
| #! @perl@ -w -I@libexecdir@/nix
 | |
| 
 | |
| use strict;
 | |
| use readmanifest;
 | |
| use POSIX qw(strftime);
 | |
| use File::Temp qw(tempdir);
 | |
| 
 | |
| my $manifestDir = "@localstatedir@/nix/manifests";
 | |
| my $logFile = "@localstatedir@/log/nix/downloads";
 | |
| 
 | |
| open LOGFILE, ">>$logFile" or die "cannot open log file $logFile";
 | |
| 
 | |
| delete $ENV{"NIX_ROOT"};
 | |
| 
 | |
| # Create a temporary directory.
 | |
| my $tmpDir = tempdir("nix-download.XXXXXX", CLEANUP => 1, TMPDIR => 1)
 | |
|     or die "cannot create a temporary directory";
 | |
| 
 | |
| chdir $tmpDir or die "cannot change to `$tmpDir': $!";
 | |
| 
 | |
| my $tmpNar = "$tmpDir/nar";
 | |
| my $tmpNar2 = "$tmpDir/nar2";
 | |
| 
 | |
| END { unlink $tmpNar; unlink $tmpNar2; rmdir $tmpDir; }
 | |
| 
 | |
| 
 | |
| # Check the arguments.
 | |
| die unless scalar @ARGV == 1;
 | |
| my $targetPath = $ARGV[0];
 | |
| 
 | |
| my $date = strftime ("%F %H:%M:%S UTC", gmtime (time));
 | |
| print LOGFILE "$$ get $targetPath $date\n";
 | |
| 
 | |
| print "\n*** Trying to download/patch `$targetPath'\n";
 | |
| 
 | |
| 
 | |
| # Load all manifests.
 | |
| my %narFiles;
 | |
| my %patches;
 | |
| my %successors;
 | |
| 
 | |
| for my $manifest (glob "$manifestDir/*.nixmanifest") {
 | |
| #    print STDERR "reading $manifest\n";
 | |
|     if (readManifest($manifest, \%narFiles, \%patches, \%successors) < 3) {
 | |
|         print STDERR "you have an old-style manifest `$manifest'; please delete it\n";
 | |
|         exit 1;
 | |
|     }
 | |
| }
 | |
| 
 | |
| 
 | |
| # 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 addToQueue {
 | |
|     my $v = shift;
 | |
|     return if defined $done{$v};
 | |
|     $done{$v} = 1;
 | |
|     push @queue, $v;
 | |
| }
 | |
| 
 | |
| sub addNode {
 | |
|     my $u = shift;
 | |
|     $graph{$u} = {d => 999999999999, pred => undef, edges => []}
 | |
|         unless defined $graph{$u};
 | |
| }
 | |
| 
 | |
| sub addEdge {
 | |
|     my $u = shift;
 | |
|     my $v = shift;
 | |
|     my $w = shift;
 | |
|     my $type = shift;
 | |
|     my $info = shift;
 | |
|     addNode $u;
 | |
|     push @{$graph{$u}->{edges}},
 | |
|         {weight => $w, start => $u, end => $v, type => $type, info => $info};
 | |
|     my $n = scalar @{$graph{$u}->{edges}};
 | |
| }
 | |
| 
 | |
| addToQueue $targetPath;
 | |
| 
 | |
| sub isValidPath {
 | |
|     my $p = shift;
 | |
|     return system("@bindir@/nix-store --check-validity '$p' 2> /dev/null") == 0;
 | |
| }
 | |
| 
 | |
| sub parseHash {
 | |
|     my $hash = shift;
 | |
|     if ($hash =~ /^(.+):(.+)$/) {
 | |
|         return ($1, $2);
 | |
|     } else {
 | |
|         return ("md5", $hash);
 | |
|     }
 | |
| }
 | |
| 
 | |
| while ($queueFront < scalar @queue) {
 | |
|     my $u = $queue[$queueFront++];
 | |
| #    print "$u\n";
 | |
| 
 | |
|     addNode $u;
 | |
| 
 | |
|     # If the path already exists, it has distance 0 from the "start"
 | |
|     # node.
 | |
|     if (isValidPath($u)) {
 | |
|         addEdge "start", $u, 0, "present", undef;
 | |
|     }
 | |
| 
 | |
|     else {
 | |
| 
 | |
|         # Add patch edges.
 | |
|         my $patchList = $patches{$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 = `@bindir@/nix-hash --type '$baseHashAlgo' $format "$patch->{basePath}"`;
 | |
|                 chomp $hash;
 | |
| #                print "  MY HASH is $hash\n";
 | |
|                 if ($hash ne $baseHash) {
 | |
|                     print LOGFILE "$$ rejecting $patch->{basePath}\n";
 | |
|                     next;
 | |
|                 }
 | |
|             }
 | |
| #            print "  PATCH from $patch->{basePath}\n";
 | |
|             addToQueue $patch->{basePath};
 | |
|             addEdge $patch->{basePath}, $u, $patch->{size}, "patch", $patch;
 | |
|         }
 | |
| 
 | |
|         # Add NAR file edges to the start node.
 | |
|         my $narFileList = $narFiles{$u};
 | |
|         foreach my $narFile (@{$narFileList}) {
 | |
| #            print "  NAR from $narFile->{url}\n";
 | |
|             addEdge "start", $u, $narFile->{size}, "narfile", $narFile;
 | |
|             if ($u eq $targetPath) {
 | |
|                 print LOGFILE "$$ full-download-would-be $narFile->{size}\n";
 | |
|             }
 | |
|         }
 | |
| 
 | |
|     }
 | |
| }
 | |
| 
 | |
| 
 | |
| # Run Dijkstra's shortest path algorithm to determine the shortest
 | |
| # sequence of download and/or patch actions that will produce
 | |
| # $targetPath.
 | |
| 
 | |
| sub byDistance { # sort by distance, reversed
 | |
|     return -($graph{$a}->{d} <=> $graph{$b}->{d});
 | |
| }
 | |
| 
 | |
| my @todo = keys %graph;
 | |
| 
 | |
| while (scalar @todo > 0) {
 | |
| 
 | |
|     # Remove the closest element from the todo list.
 | |
|     @todo = sort byDistance @todo;
 | |
|     my $u = pop @todo;
 | |
| 
 | |
|     my $u_ = $graph{$u};
 | |
| 
 | |
| #    print "IN $u $u_->{d}\n";
 | |
| 
 | |
|     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; 
 | |
| #            print "  RELAX $edge->{end} $v_->{d}\n";
 | |
|         }
 | |
|     }
 | |
| }
 | |
| 
 | |
| 
 | |
| # Retrieve the shortest path from "start" to $targetPath.
 | |
| my @path = ();
 | |
| my $cur = $targetPath;
 | |
| die "don't know how to produce $targetPath\n"
 | |
|     unless defined $graph{$targetPath}->{pred};
 | |
| while ($cur ne "start") {
 | |
|     push @path, $graph{$cur}->{pred};
 | |
|     $cur = $graph{$cur}->{pred}->{start};
 | |
| }
 | |
| 
 | |
| 
 | |
| # Traverse the shortest path, perform the actions described by the
 | |
| # edges.
 | |
| my $curStep = 1;
 | |
| my $maxStep = scalar @path;
 | |
| 
 | |
| sub downloadFile {
 | |
|     my $url = shift;
 | |
|     my ($hashAlgo, $hash) = parseHash(shift);
 | |
|     $ENV{"PRINT_PATH"} = 1;
 | |
|     $ENV{"QUIET"} = 1;
 | |
|     $ENV{"NIX_HASH_ALGO"} = $hashAlgo;
 | |
|     my ($hash2, $path) = `@bindir@/nix-prefetch-url '$url' '$hash'`;
 | |
|     die "download of `$url' failed" unless $? == 0;
 | |
|     chomp $hash2;
 | |
|     chomp $path;
 | |
|     die "hash mismatch, expected $hash, got $hash2" if $hash ne $hash2;
 | |
|     return $path;
 | |
| }
 | |
| 
 | |
| 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";
 | |
|         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("@bindir@/nix-store --dump $v > $tmpNar") == 0
 | |
|                 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";
 | |
| 
 | |
|         print LOGFILE "$$ patch $patch->{url} $patch->{size} $patch->{baseHash} $u $v\n";
 | |
| 
 | |
|         # Download the patch.
 | |
|         print "  downloading patch...\n";
 | |
|         my $patchPath = downloadFile "$patch->{url}", "$patch->{hash}";
 | |
| 
 | |
|         # 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("@libexecdir@/bspatch $tmpNar $tmpNar2 $patchPath") == 0
 | |
|             or die "cannot apply patch `$patchPath' to $tmpNar";
 | |
| 
 | |
|         if ($curStep < $maxStep) {
 | |
|             # The archive will be used as the base of the next patch.
 | |
|             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("@bindir@/nix-store --restore $v < $tmpNar2") == 0
 | |
|                 or die "cannot unpack $tmpNar2 into `$v'";
 | |
|         }
 | |
|     }
 | |
| 
 | |
|     elsif ($edge->{type} eq "narfile") {
 | |
|         my $narFile = $edge->{info};
 | |
|         print "downloading `$narFile->{url}' into `$v'\n";
 | |
| 
 | |
|         print LOGFILE "$$ narfile $narFile->{url} $narFile->{size} $v\n";
 | |
|         
 | |
|         # Download the archive.
 | |
|         print "  downloading archive...\n";
 | |
|         my $narFilePath = downloadFile "$narFile->{url}", "$narFile->{hash}";
 | |
| 
 | |
|         if ($curStep < $maxStep) {
 | |
|             # The archive will be used a base to a patch.
 | |
|             system("@bunzip2@ < '$narFilePath' > $tmpNar") == 0
 | |
|                 or die "cannot unpack `$narFilePath' into `$v'";
 | |
|         } else {
 | |
|             # Unpack the archive into the target path.
 | |
|             print "  unpacking archive...\n";
 | |
|             system("@bunzip2@ < '$narFilePath' | @bindir@/nix-store --restore '$v'") == 0
 | |
|                 or die "cannot unpack `$narFilePath' into `$v'";
 | |
|         }
 | |
|     }
 | |
| 
 | |
|     $curStep++;
 | |
| }
 | |
| 
 | |
| 
 | |
| print LOGFILE "$$ success\n";
 | |
| close LOGFILE;
 |