#! /usr/bin/perl -w -I. use strict; use POSIX qw(tmpnam); use readmanifest; die unless scalar @ARGV == 5; my $cacheDir = $ARGV[0]; my $patchesDir = $ARGV[1]; my $patchesURL = $ARGV[2]; my $srcDir = $ARGV[3]; my $dstDir = $ARGV[4]; my $tmpdir; do { $tmpdir = tmpnam(); } until mkdir $tmpdir, 0777; print "TEMP = $tmpdir\n"; #END { rmdir $tmpdir; } my %srcNarFiles; my %srcPatches; my %srcSuccessors; my %dstNarFiles; my %dstPatches; my %dstSuccessors; readManifest "$srcDir/MANIFEST", \%srcNarFiles, \%srcPatches, \%srcSuccessors; readManifest "$dstDir/MANIFEST", \%dstNarFiles, \%dstPatches, \%dstSuccessors; sub findOutputPaths { my $narFiles = shift; my $successors = shift; my %outPaths; foreach my $p (keys %{$narFiles}) { # Ignore store expressions. next if ($p =~ /\.store$/); # Ignore builders (too much ambiguity -- they're all called # `builder.sh'). next if ($p =~ /\.sh$/); next if ($p =~ /\.patch$/); # Don't bother including tar files etc. next if ($p =~ /\.tar\.(gz|bz2)$/ || $p =~ /\.zip$/ || $p =~ /\.bin$/); $outPaths{$p} = 1; } return %outPaths; } print "finding src output paths...\n"; my %srcOutPaths = findOutputPaths \%srcNarFiles, \%srcSuccessors; print "finding dst output paths...\n"; my %dstOutPaths = findOutputPaths \%dstNarFiles, \%dstSuccessors; sub getNameVersion { my $p = shift; $p =~ /\/[0-9a-f]+((?:-[a-zA-Z][^\/-]*)+)([^\/]*)$/; my $name = $1; my $version = $2; $name =~ s/^-//; $version =~ s/^-//; return ($name, $version); } # A quick hack to get a measure of the `distance' between two # versions: it's just the position of the first character that differs # (or 999 if they are the same). sub versionDiff { my $s = shift; my $t = shift; my $i; return 999 if $s eq $t; for ($i = 0; $i < length $s; $i++) { return $i if $i >= length $t or substr($s, $i, 1) ne substr($t, $i, 1); } return $i; } sub getNarBz2 { my $narFiles = shift; my $storePath = shift; my $narFileList = $$narFiles{$storePath}; die "missing store expression $storePath" unless defined $narFileList; my $narFile = @{$narFileList}[0]; die unless defined $narFile; $narFile->{url} =~ /\/([^\/]+)$/; die unless defined $1; return "$cacheDir/$1"; } # For each output path in the destination, see if we need to / can # create a patch. print "creating patches...\n"; foreach my $p (keys %dstOutPaths) { # If exactly the same path already exists in the source, skip it. next if defined $srcOutPaths{$p}; # print " $p\n"; # If not, then we should find the path in the source that is # `most' likely to be present on a system that wants to install # this path. (my $name, my $version) = getNameVersion $p; my @closest = (); my $closestVersion; my $minDist = -1; # actually, larger means closer # Find all source paths with the same name. foreach my $q (keys %srcOutPaths) { (my $name2, my $version2) = getNameVersion $q; if ($name eq $name2) { my $dist = versionDiff $version, $version2; if ($dist > $minDist) { $minDist = $dist; @closest = ($q); $closestVersion = $version2; } elsif ($dist == $minDist) { push @closest, $q; } } } if (scalar(@closest) == 0) { print " NO BASE: $p\n"; next; } foreach my $closest (@closest) { # Generate a patch between $closest and $p. print " $p <- $closest\n"; # If the patch already exists, skip it. my $patchList = $dstPatches{$p}; if (defined $patchList) { my $found = 0; foreach my $patch (@{$patchList}) { if ($patch->{basePath} eq $closest) { # !!! baseHash might differ print " skipping, already exists\n"; $found = 1; last; } } next if $found; } my $srcNarBz2 = getNarBz2 \%srcNarFiles, $closest; my $dstNarBz2 = getNarBz2 \%dstNarFiles, $p; system("bunzip2 < $srcNarBz2 > $tmpdir/A") == 0 or die "cannot unpack $srcNarBz2"; system("bunzip2 < $dstNarBz2 > $tmpdir/B") == 0 or die "cannot unpack $dstNarBz2"; system("bsdiff $tmpdir/A $tmpdir/B $tmpdir/DIFF") == 0 or die "cannot compute binary diff"; my $baseHash = `nix-hash --flat $tmpdir/A` or die; chomp $baseHash; my $narHash = `nix-hash --flat $tmpdir/B` or die; chomp $narHash; my $narDiffHash = `nix-hash --flat $tmpdir/DIFF` or die; chomp $narDiffHash; my $narDiffSize = (stat "$tmpdir/DIFF")[7]; my $dstNarBz2Size = (stat $dstNarBz2)[7]; if ($narDiffSize >= $dstNarBz2Size) { print " rejecting; patch bigger than full archive\n"; next; } my $finalName = "$narDiffHash-$name-$closestVersion-to-$version.nar-diff"; if (-e "$patchesDir/$finalName") { print " not copying, already exists\n"; next; } system("cp '$tmpdir/DIFF' '$patchesDir/$finalName.tmp'") == 0 or die "cannot copy diff"; rename("$patchesDir/$finalName.tmp", "$patchesDir/$finalName") or die "cannot rename $patchesDir/$finalName.tmp"; # Add the patch to the manifest. addPatch \%dstPatches, $p, { url => "$patchesURL/$finalName", hash => $narDiffHash , size => $narDiffSize , basePath => $closest, baseHash => $baseHash , narHash => $narHash, patchType => "nar-bsdiff" }; } } writeManifest "$dstDir/MANIFEST", \%dstNarFiles, \%dstPatches, \%dstSuccessors;