* Move the patch generator into a module.

4 files changed, 345 insertions, 437 deletions

diff --git a/scripts/GeneratePatches.pm.in b/scripts/GeneratePatches.pm.in
new file mode 100755
index 000000000..bb7111f8e
--- /dev/null
+++ b/scripts/GeneratePatches.pm.in
@@ -0,0 +1,335 @@
+#! @perl@ -w -I@libexecdir@/nix
+
+use strict;
+use File::Temp qw(tempdir);
+use readmanifest;
+
+
+# Some patch generations options.
+
+# Max size of NAR archives to generate patches for.
+my $maxNarSize = $ENV{"NIX_MAX_NAR_SIZE"};
+$maxNarSize = 160 * 1024 * 1024 if !defined $maxNarSize;
+
+# If patch is bigger than this fraction of full archive, reject.
+my $maxPatchFraction = $ENV{"NIX_PATCH_FRACTION"};
+$maxPatchFraction = 0.60 if !defined $maxPatchFraction;
+
+my $timeLimit = $ENV{"NIX_BSDIFF_TIME_LIMIT"};
+$timeLimit = 180 if !defined $timeLimit;
+
+my $hashAlgo = "sha256";
+
+
+sub findOutputPaths {
+    my $narFiles = shift;
+
+    my %outPaths;
+    
+    foreach my $p (keys %{$narFiles}) {
+
+        # Ignore derivations.
+        next if ($p =~ /\.drv$/);
+        
+        # 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$/ || $p =~ /\.tar\.(gz|bz2|Z|lzma|xz)$/ || $p =~ /\.zip$/ || $p =~ /\.bin$/ || $p =~ /\.tgz$/ || $p =~ /\.rpm$/ || $p =~ /cvs-export$/ || $p =~ /fetchhg$/);
+
+        $outPaths{$p} = 1;
+    }
+
+    return %outPaths;
+}
+
+
+sub getNameVersion {
+    my $p = shift;
+    $p =~ /\/[0-9a-z]+((?:-[a-zA-Z][^\/-]*)+)([^\/]*)$/;
+    my $name = $1;
+    my $version = $2;
+    return undef unless defined $name && defined $version;
+    $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 $narPath = shift;
+    my $narFiles = shift;
+    my $storePath = shift;
+    
+    my $narFileList = $$narFiles{$storePath};
+    die "missing path $storePath" unless defined $narFileList;
+
+    my $narFile = @{$narFileList}[0];
+    die unless defined $narFile;
+
+    $narFile->{url} =~ /\/([^\/]+)$/;
+    die unless defined $1;
+    return "$narPath/$1";
+}
+
+
+sub containsPatch {
+    my $patches = shift;
+    my $storePath = shift;
+    my $basePath = shift;
+    my $patchList = $$patches{$storePath};
+    return 0 if !defined $patchList;
+    my $found = 0;
+    foreach my $patch (@{$patchList}) {
+        # !!! baseHash might differ
+        return 1 if $patch->{basePath} eq $basePath;
+    }
+    return 0;
+}
+
+
+sub generatePatches {
+    my ($srcNarFiles, $dstNarFiles, $srcPatches, $dstPatches, $narPath, $patchesPath, $patchesURL, $tmpDir) = @_;
+
+    my %srcOutPaths = findOutputPaths $srcNarFiles;
+    my %dstOutPaths = findOutputPaths $dstNarFiles;
+
+    # For each output path in the destination, see if we need to / can
+    # create a patch.
+
+    print STDERR "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 paths in the source that are
+        # `most' likely to be present on a system that wants to
+        # install this path.
+
+        (my $name, my $version) = getNameVersion $p;
+        next unless defined $name && defined $version;
+
+        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;
+            next unless defined $name2 && defined $version2;
+
+            if ($name eq $name2) {
+
+                my $srcSystem = @{$$dstNarFiles{$p}}[0]->{system};
+                my $dstSystem = @{$$srcNarFiles{$q}}[0]->{system};
+                if (defined $srcSystem && defined $dstSystem && $srcSystem ne $dstSystem) {
+                    print "    SKIPPING $q due to different systems ($srcSystem vs. $dstSystem)\n";
+                    next;
+                }
+
+                # If the sizes differ too much, then skip.  This
+                # disambiguates between, e.g., a real component and a
+                # wrapper component (cf. Firefox in Nixpkgs).
+                my $srcSize = @{$$srcNarFiles{$q}}[0]->{size};
+                my $dstSize = @{$$dstNarFiles{$p}}[0]->{size};
+                my $ratio = $srcSize / $dstSize;
+                $ratio = 1 / $ratio if $ratio < 1;
+                # print "  SIZE $srcSize $dstSize $ratio $q\n";
+
+                if ($ratio >= 3) {
+                    print "    SKIPPING $q due to size ratio $ratio ($srcSize vs. $dstSize)\n";
+                    next;
+                }
+
+                # If there are multiple matching names, include the
+                # ones with the closest version numbers.
+                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 STDERR "  $p <- $closest\n";
+
+            # If the patch already exists, skip it.
+            if (containsPatch($srcPatches, $p, $closest) ||
+                containsPatch($dstPatches, $p, $closest))
+            {
+                print "    skipping, already exists\n";
+                next;
+            }
+
+            my $srcNarBz2 = getNarBz2 $narPath, $srcNarFiles, $closest;
+            my $dstNarBz2 = getNarBz2 $narPath, $dstNarFiles, $p;
+
+            if (! -f $srcNarBz2) {
+                warn "patch source archive $srcNarBz2 is missing\n";
+                next;
+            }
+
+            system("@bunzip2@ < $srcNarBz2 > $tmpDir/A") == 0
+                or die "cannot unpack $srcNarBz2";
+
+            if ((stat "$tmpDir/A")[7] >= $maxNarSize) {
+                print "    skipping, source is too large\n";
+                next;
+            }
+        
+            system("@bunzip2@ < $dstNarBz2 > $tmpDir/B") == 0
+                or die "cannot unpack $dstNarBz2";
+
+            if ((stat "$tmpDir/B")[7] >= $maxNarSize) {
+                print "    skipping, destination is too large\n";
+                next;
+            }
+        
+            my $time1 = time();
+            my $res = system("ulimit -t $timeLimit; @libexecdir@/bsdiff $tmpDir/A $tmpDir/B $tmpDir/DIFF");
+            my $time2 = time();
+            if ($res) {
+                warn "binary diff computation aborted after ", $time2 - $time1, " seconds\n";
+                next;
+            }
+
+            my $baseHash = `@bindir@/nix-hash --flat --type $hashAlgo --base32 $tmpDir/A` or die;
+            chomp $baseHash;
+
+            my $narHash = `@bindir@/nix-hash --flat --type $hashAlgo --base32 $tmpDir/B` or die;
+            chomp $narHash;
+
+            my $narDiffHash = `@bindir@/nix-hash --flat --type $hashAlgo --base32 $tmpDir/DIFF` or die;
+            chomp $narDiffHash;
+
+            my $narDiffSize = (stat "$tmpDir/DIFF")[7];
+            my $dstNarBz2Size = (stat $dstNarBz2)[7];
+
+            print "    size $narDiffSize; full size $dstNarBz2Size; ", $time2 - $time1, " seconds\n";
+        
+            if ($narDiffSize >= $dstNarBz2Size) {
+                print "    rejecting; patch bigger than full archive\n";
+                next;
+            }
+    
+            if ($narDiffSize / $dstNarBz2Size >= $maxPatchFraction) {
+                print "    rejecting; patch too large relative to full archive\n";
+                next;
+            }
+    
+            my $finalName = "$narDiffHash.nar-bsdiff";
+
+            if (-e "$patchesPath/$finalName") {
+                print "    not copying, already exists\n";
+            }
+
+            else {
+                system("cp '$tmpDir/DIFF' '$patchesPath/$finalName.tmp'") == 0
+                    or die "cannot copy diff";
+                rename("$patchesPath/$finalName.tmp", "$patchesPath/$finalName")
+                    or die "cannot rename $patchesPath/$finalName.tmp";
+            }
+        
+            # Add the patch to the manifest.
+            addPatch $dstPatches, $p,
+                { url => "$patchesURL/$finalName", hash => "$hashAlgo:$narDiffHash"
+                , size => $narDiffSize, basePath => $closest, baseHash => "$hashAlgo:$baseHash"
+                , narHash => "$hashAlgo:$narHash", patchType => "nar-bsdiff"
+                };
+        }
+    }
+}
+
+
+# Propagate useful patches from $srcPatches to $dstPatches.  A patch
+# is useful if it produces either paths in the $dstNarFiles or paths
+# that can be used as the base for other useful patches.
+sub propagatePatches {
+    my ($srcPatches, $dstNarFiles, $dstPatches) = @_;
+
+    print STDERR "propagating patches...\n";
+
+    my $changed;
+    do {
+        # !!! we repeat this to reach the transitive closure; inefficient
+        $changed = 0;
+
+        print STDERR "loop\n";
+
+        my %dstBasePaths;
+        foreach my $q (keys %{$dstPatches}) {
+            foreach my $patch (@{$$dstPatches{$q}}) {
+                $dstBasePaths{$patch->{basePath}} = 1;
+            }
+        }
+
+        foreach my $p (keys %{$srcPatches}) {
+            my $patchList = $$srcPatches{$p};
+
+            my $include = 0;
+
+            # Is path $p included in the destination?  If so, include
+            # patches that produce it.
+            $include = 1 if defined $$dstNarFiles{$p};
+
+            # Is path $p a path that serves as a base for paths in the
+            # destination?  If so, include patches that produce it.
+            # !!! check baseHash
+            $include = 1 if defined $dstBasePaths{$p};
+
+            if ($include) {
+                foreach my $patch (@{$patchList}) {
+                    $changed = 1 if addPatch $dstPatches, $p, $patch;
+                }
+            }
+        
+        }
+    
+    } while $changed;
+}
+
+
+# Add all new patches in $srcPatches to $dstPatches.
+sub copyPatches {
+    my ($srcPatches, $dstPatches) = @_;
+    foreach my $p (keys %{$srcPatches}) {
+        addPatch $dstPatches, $p, $_ foreach @{$$srcPatches{$p}};
+    }
+}
+
+
+return 1;
diff --git a/scripts/Makefile.am b/scripts/Makefile.am
index aa5d6f78c..c55f92212 100644
--- a/scripts/Makefile.am
+++ b/scripts/Makefile.am
@@ -3,7 +3,7 @@ bin_SCRIPTS = nix-collect-garbage \
   nix-install-package nix-channel nix-build \
   nix-copy-closure 
 
-noinst_SCRIPTS = nix-profile.sh generate-patches.pl \
+noinst_SCRIPTS = nix-profile.sh GeneratePatches.pm \
   find-runtime-roots.pl build-remote.pl nix-reduce-build \
   copy-from-other-stores.pl nix-http-export.cgi
 
@@ -17,7 +17,7 @@ install-exec-local: readmanifest.pm download-using-manifests.pl copy-from-other-
 	$(INSTALL_DATA) readconfig.pm $(DESTDIR)$(libexecdir)/nix 
 	$(INSTALL_DATA) ssh.pm $(DESTDIR)$(libexecdir)/nix 
 	$(INSTALL_PROGRAM) find-runtime-roots.pl $(DESTDIR)$(libexecdir)/nix 
-	$(INSTALL_PROGRAM) generate-patches.pl $(DESTDIR)$(libexecdir)/nix 
+	$(INSTALL_PROGRAM) GeneratePatches.pm $(DESTDIR)$(libexecdir)/nix 
 	$(INSTALL_PROGRAM) build-remote.pl $(DESTDIR)$(libexecdir)/nix 
 	$(INSTALL) -d $(DESTDIR)$(libexecdir)/nix/substituters
 	$(INSTALL_PROGRAM) download-using-manifests.pl $(DESTDIR)$(libexecdir)/nix/substituters
@@ -36,7 +36,7 @@ EXTRA_DIST = nix-collect-garbage.in \
   nix-build.in \
   download-using-manifests.pl.in \
   copy-from-other-stores.pl.in \
-  generate-patches.pl.in \
+  GeneratePatches.pm.in \
   nix-copy-closure.in \
   find-runtime-roots.pl.in \
   build-remote.pl.in \
diff --git a/scripts/generate-patches.pl.in b/scripts/generate-patches.pl.in
deleted file mode 100755
index 05bf65093..000000000
--- a/scripts/generate-patches.pl.in
+++ /dev/null
@@ -1,429 +0,0 @@
-#! @perl@ -w -I@libexecdir@/nix
-
-use strict;
-use File::Temp qw(tempdir);
-use readmanifest;
-
-
-# Some patch generations options.
-
-# Max size of NAR archives to generate patches for.
-my $maxNarSize = $ENV{"NIX_MAX_NAR_SIZE"};
-$maxNarSize = 100 * 1024 * 1024 if !defined $maxNarSize;
-
-# If patch is bigger than this fraction of full archive, reject.
-my $maxPatchFraction = $ENV{"NIX_PATCH_FRACTION"};
-$maxPatchFraction = 0.60 if !defined $maxPatchFraction;
-
-my $timeLimit = $ENV{"NIX_BSDIFF_TIME_LIMIT"};
-$timeLimit = 180 if !defined $timeLimit;
-
-
-die unless scalar @ARGV == 5;
-
-my $hashAlgo = "sha256";
-
-my $narDir = $ARGV[0];
-my $patchesDir = $ARGV[1];
-my $patchesURL = $ARGV[2];
-my $srcManifest = $ARGV[3];
-my $dstManifest = $ARGV[4];
-
-my $tmpDir = tempdir("nix-generate-patches.XXXXXX", CLEANUP => 1, TMPDIR => 1)
-    or die "cannot create a temporary directory";
-
-#END { rmdir $tmpDir; }
-
-my %srcNarFiles;
-my %srcLocalPaths;
-my %srcPatches;
-
-my %dstNarFiles;
-my %dstLocalPaths;
-my %dstPatches;
-
-readManifest "$srcManifest",
-    \%srcNarFiles, \%srcLocalPaths, \%srcPatches;
-
-readManifest "$dstManifest",
-    \%dstNarFiles, \%dstLocalPaths, \%dstPatches;
-
-
-sub findOutputPaths {
-    my $narFiles = shift;
-
-    my %outPaths;
-    
-    foreach my $p (keys %{$narFiles}) {
-
-        # Ignore derivations.
-        next if ($p =~ /\.drv$/);
-        
-        # 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$/ || $p =~ /\.tar\.(gz|bz2|Z|lzma|xz)$/ || $p =~ /\.zip$/ || $p =~ /\.bin$/ || $p =~ /\.tgz$/ || $p =~ /\.rpm$/ || $p =~ /cvs-export$/ || $p =~ /fetchhg$/);
-
-        $outPaths{$p} = 1;
-    }
-
-    return %outPaths;
-}
-
-print "finding src output paths...\n";
-my %srcOutPaths = findOutputPaths \%srcNarFiles;
-
-print "finding dst output paths...\n";
-my %dstOutPaths = findOutputPaths \%dstNarFiles;
-
-
-sub getNameVersion {
-    my $p = shift;
-    $p =~ /\/[0-9a-z]+((?:-[a-zA-Z][^\/-]*)+)([^\/]*)$/;
-    my $name = $1;
-    my $version = $2;
-    return undef unless defined $name && defined $version;
-    $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 path $storePath" unless defined $narFileList;
-
-    my $narFile = @{$narFileList}[0];
-    die unless defined $narFile;
-
-    $narFile->{url} =~ /\/([^\/]+)$/;
-    die unless defined $1;
-    return "$narDir/$1";
-}
-
-
-sub containsPatch {
-    my $patches = shift;
-    my $storePath = shift;
-    my $basePath = shift;
-    my $patchList = $$patches{$storePath};
-    return 0 if !defined $patchList;
-    my $found = 0;
-    foreach my $patch (@{$patchList}) {
-        # !!! baseHash might differ
-        return 1 if $patch->{basePath} eq $basePath;
-    }
-    return 0;
-}
-
-
-# Compute the "weighted" number of uses of a path in the build graph.
-sub computeUses {
-    my $narFiles = shift;
-    my $path = shift;
-
-    # Find the deriver of $path.
-    return 1 unless defined $$narFiles{$path};
-    my $deriver = @{$$narFiles{$path}}[0]->{deriver};
-    return 1 unless defined $deriver && $deriver ne "";
-
-#    print "  DERIVER $deriver\n";
-
-    # Optimisation: build the referrers graph from the references
-    # graph.
-    my %referrers;
-    foreach my $q (keys %{$narFiles}) {
-        my @refs = split " ", @{$$narFiles{$q}}[0]->{references};
-        foreach my $r (@refs) {
-            $referrers{$r} = [] unless defined $referrers{$r};
-            push @{$referrers{$r}}, $q;
-        }
-    }
-
-    # Determine the shortest path from $deriver to all other reachable
-    # paths in the `referrers' graph.
-
-    my %dist;
-    $dist{$deriver} = 0;
-
-    my @queue = ($deriver);
-    my $pos = 0;
-    
-    while ($pos < scalar @queue) {
-        my $p = $queue[$pos];
-        $pos++;
-
-        foreach my $q (@{$referrers{$p}}) {
-            if (!defined $dist{$q}) {
-                $dist{$q} = $dist{$p} + 1;
-#                print "    $q $dist{$q}\n";
-                push @queue, $q;
-            }
-        }
-    }
-
-    my $wuse = 1.0;
-    foreach my $user (keys %dist) {
-        next if $user eq $deriver;
-#        print "    $user $dist{$user}\n";
-        $wuse += 1.0 / 2.0**$dist{$user};
-    }
-
-#    print "    XXX $path $wuse\n";
-    
-    return $wuse;
-}
-
-
-# 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 paths in the source that are
-    # `most' likely to be present on a system that wants to install
-    # this path.
-
-    (my $name, my $version) = getNameVersion $p;
-    next unless defined $name && defined $version;
-
-    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;
-        next unless defined $name2 && defined $version2;
-
-        if ($name eq $name2) {
-
-            my $srcSystem = @{$dstNarFiles{$p}}[0]->{system};
-            my $dstSystem = @{$srcNarFiles{$q}}[0]->{system};
-            if (defined $srcSystem && defined $dstSystem && $srcSystem ne $dstSystem) {
-                print "  SKIPPING $q due to different systems ($srcSystem vs. $dstSystem)\n";
-                next;
-            }
-
-            # If the sizes differ too much, then skip.  This
-            # disambiguates between, e.g., a real component and a
-            # wrapper component (cf. Firefox in Nixpkgs).
-            my $srcSize = @{$srcNarFiles{$q}}[0]->{size};
-            my $dstSize = @{$dstNarFiles{$p}}[0]->{size};
-            my $ratio = $srcSize / $dstSize;
-            $ratio = 1 / $ratio if $ratio < 1;
-#            print "  SIZE $srcSize $dstSize $ratio $q\n";
-
-            if ($ratio >= 3) {
-                print "  SKIPPING $q due to size ratio $ratio ($srcSize vs. $dstSize)\n";
-                next;
-            }
-
-            # If the numbers of weighted uses differ too much, then
-            # skip.  This disambiguates between, e.g., the bootstrap
-            # GCC and the final GCC in Nixpkgs.
-#            my $srcUses = computeUses \%srcNarFiles, $q;
-#            my $dstUses = computeUses \%dstNarFiles, $p;
-#            $ratio = $srcUses / $dstUses;
-#            $ratio = 1 / $ratio if $ratio < 1;
-#            print "  USE $srcUses $dstUses $ratio $q\n";
-            
-#            if ($ratio >= 2) {
-#                print "  SKIPPING $q due to use ratio $ratio ($srcUses $dstUses)\n";
-#                next;
-#            }
-
-            # If there are multiple matching names, include the ones
-            # with the closest version numbers.
-            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.
-        if (containsPatch(\%srcPatches, $p, $closest) ||
-            containsPatch(\%dstPatches, $p, $closest))
-        {
-            print "    skipping, already exists\n";
-            next;
-        }
-
-#        next;
-        
-        my $srcNarBz2 = getNarBz2 \%srcNarFiles, $closest;
-        my $dstNarBz2 = getNarBz2 \%dstNarFiles, $p;
-
-        if (! -f $srcNarBz2) {
-            warn "patch source archive $srcNarBz2 is missing\n";
-            next;
-        }
-
-        system("@bunzip2@ < $srcNarBz2 > $tmpDir/A") == 0
-            or die "cannot unpack $srcNarBz2";
-
-        if ((stat "$tmpDir/A")[7] >= $maxNarSize) {
-            print "    skipping, source is too large\n";
-            next;
-        }
-        
-        system("@bunzip2@ < $dstNarBz2 > $tmpDir/B") == 0
-            or die "cannot unpack $dstNarBz2";
-
-        if ((stat "$tmpDir/B")[7] >= $maxNarSize) {
-            print "    skipping, destination is too large\n";
-            next;
-        }
-        
-        my $time1 = time();
-        my $res = system("ulimit -t $timeLimit; @libexecdir@/bsdiff $tmpDir/A $tmpDir/B $tmpDir/DIFF");
-        my $time2 = time();
-        if ($res) {
-            warn "binary diff computation aborted after ", $time2 - $time1, " seconds\n";
-            next;
-        }
-
-        my $baseHash = `@bindir@/nix-hash --flat --type $hashAlgo --base32 $tmpDir/A` or die;
-        chomp $baseHash;
-
-        my $narHash = `@bindir@/nix-hash --flat --type $hashAlgo --base32 $tmpDir/B` or die;
-        chomp $narHash;
-
-        my $narDiffHash = `@bindir@/nix-hash --flat --type $hashAlgo --base32 $tmpDir/DIFF` or die;
-        chomp $narDiffHash;
-
-        my $narDiffSize = (stat "$tmpDir/DIFF")[7];
-        my $dstNarBz2Size = (stat $dstNarBz2)[7];
-
-        print "    size $narDiffSize; full size $dstNarBz2Size; ", $time2 - $time1, " seconds\n";
-        
-        if ($narDiffSize >= $dstNarBz2Size) {
-            print "    rejecting; patch bigger than full archive\n";
-            next;
-        }
-    
-        if ($narDiffSize / $dstNarBz2Size >= $maxPatchFraction) {
-            print "    rejecting; patch too large relative to full archive\n";
-            next;
-        }
-    
-        my $finalName =
-            "$narDiffHash.nar-bsdiff";
-
-        if (-e "$patchesDir/$finalName") {
-            print "    not copying, already exists\n";
-        }
-
-        else {
-
-            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 => "$hashAlgo:$narDiffHash"
-            , size => $narDiffSize, basePath => $closest, baseHash => "$hashAlgo:$baseHash"
-            , narHash => "$hashAlgo:$narHash", patchType => "nar-bsdiff"
-            }, 0;
-    }
-}
-
-
-# Add in any potentially useful patches in the source (namely, those
-# patches that produce either paths in the destination or paths that
-# can be used as the base for other useful patches).
-
-print "propagating patches...\n";
-
-my $changed;
-do {
-    # !!! we repeat this to reach the transitive closure; inefficient
-    $changed = 0;
-
-    print "loop\n";
-
-    my %dstBasePaths;
-    foreach my $q (keys %dstPatches) {
-	foreach my $patch (@{$dstPatches{$q}}) {
-	    $dstBasePaths{$patch->{basePath}} = 1;
-	}
-    }
-
-    foreach my $p (keys %srcPatches) {
-        my $patchList = $srcPatches{$p};
-
-        my $include = 0;
-
-        # Is path $p included in the destination?  If so, include
-        # patches that produce it.
-        $include = 1 if defined $dstNarFiles{$p};
-
-        # Is path $p a path that serves as a base for paths in the
-        # destination?  If so, include patches that produce it.
-	# !!! check baseHash
-        $include = 1 if defined $dstBasePaths{$p};
-
-        if ($include) {
-            foreach my $patch (@{$patchList}) {
-                $changed = 1 if addPatch \%dstPatches, $p, $patch;
-            }
-        }
-        
-    }
-    
-} while $changed;
-
-
-# Rewrite the manifest of the destination (with the new patches).
-writeManifest "${dstManifest}",
-    \%dstNarFiles, \%dstPatches;
diff --git a/scripts/readmanifest.pm.in b/scripts/readmanifest.pm.in
index 82a01e5ab..be0dda616 100644
--- a/scripts/readmanifest.pm.in
+++ b/scripts/readmanifest.pm.in
@@ -146,7 +146,7 @@ sub readManifest {
 
 
 sub writeManifest {
-    my ($manifest, $narFiles, $patches) = @_;
+    my ($manifest, $narFiles, $patches, $noCompress) = @_;
 
     open MANIFEST, ">$manifest.tmp"; # !!! check exclusive
 
@@ -198,11 +198,13 @@ sub writeManifest {
 
 
     # Create a bzipped manifest.
-    system("@bzip2@ < $manifest > $manifest.bz2.tmp") == 0
-        or die "cannot compress manifest";
+    unless (defined $noCompress) {
+	system("@bzip2@ < $manifest > $manifest.bz2.tmp") == 0
+	    or die "cannot compress manifest";
 
-    rename("$manifest.bz2.tmp", "$manifest.bz2")
-        or die "cannot rename $manifest.bz2.tmp: $!";
+	rename("$manifest.bz2.tmp", "$manifest.bz2")
+	    or die "cannot rename $manifest.bz2.tmp: $!";
+    }
 }