diff options
author | Eelco Dolstra <e.dolstra@tudelft.nl> | 2011-02-09T12·41+0000 |
---|---|---|
committer | Eelco Dolstra <e.dolstra@tudelft.nl> | 2011-02-09T12·41+0000 |
commit | d0eda1f3e9b2030e373038fd8997f033f2d7aedd (patch) | |
tree | 9db733f87fceaba36ddcba54b794b8be06c1d136 /scripts | |
parent | 3854fc9b42d16b810f62b64194b699033b03aaf1 (diff) | |
parent | 543988572e2abc85767da315b2acc1f971c5d07f (diff) |
* Merged the SQLite branch.
Diffstat (limited to 'scripts')
-rwxr-xr-x | scripts/GeneratePatches.pm.in | 334 | ||||
-rw-r--r-- | scripts/Makefile.am | 27 | ||||
-rw-r--r-- | scripts/NixConfig.pm.in (renamed from scripts/readconfig.pm.in) | 0 | ||||
-rw-r--r-- | scripts/NixManifest.pm.in (renamed from scripts/readmanifest.pm.in) | 45 | ||||
-rw-r--r-- | scripts/SSH.pm (renamed from scripts/ssh.pm) | 17 | ||||
-rwxr-xr-x | scripts/build-remote.pl.in | 325 | ||||
-rw-r--r-- | scripts/copy-from-other-stores.pl.in | 65 | ||||
-rw-r--r-- | scripts/download-using-manifests.pl.in | 321 | ||||
-rwxr-xr-x | scripts/generate-patches.pl.in | 416 | ||||
-rw-r--r-- | scripts/nix-build.in | 7 | ||||
-rw-r--r-- | scripts/nix-copy-closure.in | 14 | ||||
-rw-r--r-- | scripts/nix-generate-patches.in | 42 | ||||
-rw-r--r-- | scripts/nix-pull.in | 2 | ||||
-rw-r--r-- | scripts/nix-push.in | 19 |
14 files changed, 832 insertions, 802 deletions
diff --git a/scripts/GeneratePatches.pm.in b/scripts/GeneratePatches.pm.in new file mode 100755 index 000000000000..2d2653255e54 --- /dev/null +++ b/scripts/GeneratePatches.pm.in @@ -0,0 +1,334 @@ +#! @perl@ -w -I@libexecdir@/nix + +use strict; +use File::Temp qw(tempdir); + + +# 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 aa5d6f78c18a..60bb0a9b8105 100644 --- a/scripts/Makefile.am +++ b/scripts/Makefile.am @@ -1,23 +1,23 @@ bin_SCRIPTS = nix-collect-garbage \ nix-pull nix-push nix-prefetch-url \ nix-install-package nix-channel nix-build \ - nix-copy-closure + nix-copy-closure nix-generate-patches -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 -nix-pull nix-push: readmanifest.pm readconfig.pm download-using-manifests.pl +nix-pull nix-push: NixManifest.pm NixConfig.pm download-using-manifests.pl -install-exec-local: readmanifest.pm download-using-manifests.pl copy-from-other-stores.pl find-runtime-roots.pl +install-exec-local: NixManifest.pm GeneratePatches.pm download-using-manifests.pl copy-from-other-stores.pl find-runtime-roots.pl $(INSTALL) -d $(DESTDIR)$(sysconfdir)/profile.d $(INSTALL_PROGRAM) nix-profile.sh $(DESTDIR)$(sysconfdir)/profile.d/nix.sh $(INSTALL) -d $(DESTDIR)$(libexecdir)/nix - $(INSTALL_DATA) readmanifest.pm $(DESTDIR)$(libexecdir)/nix - $(INSTALL_DATA) readconfig.pm $(DESTDIR)$(libexecdir)/nix - $(INSTALL_DATA) ssh.pm $(DESTDIR)$(libexecdir)/nix + $(INSTALL_DATA) NixManifest.pm $(DESTDIR)$(libexecdir)/nix + $(INSTALL_DATA) NixConfig.pm $(DESTDIR)$(libexecdir)/nix + $(INSTALL_DATA) SSH.pm $(DESTDIR)$(libexecdir)/nix + $(INSTALL_DATA) GeneratePatches.pm $(DESTDIR)$(libexecdir)/nix $(INSTALL_PROGRAM) find-runtime-roots.pl $(DESTDIR)$(libexecdir)/nix - $(INSTALL_PROGRAM) generate-patches.pl $(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 @@ -30,15 +30,16 @@ EXTRA_DIST = nix-collect-garbage.in \ nix-pull.in nix-push.in nix-profile.sh.in \ nix-prefetch-url.in nix-install-package.in \ nix-channel.in \ - readmanifest.pm.in \ - readconfig.pm.in \ - ssh.pm \ + NixManifest.pm.in \ + NixConfig.pm.in \ + SSH.pm \ + GeneratePatches.pm.in \ nix-build.in \ download-using-manifests.pl.in \ copy-from-other-stores.pl.in \ - generate-patches.pl.in \ nix-copy-closure.in \ find-runtime-roots.pl.in \ build-remote.pl.in \ nix-reduce-build.in \ - nix-http-export.cgi.in + nix-http-export.cgi.in \ + nix-generate-patches.in diff --git a/scripts/readconfig.pm.in b/scripts/NixConfig.pm.in index aeb443aeed3a..aeb443aeed3a 100644 --- a/scripts/readconfig.pm.in +++ b/scripts/NixConfig.pm.in diff --git a/scripts/readmanifest.pm.in b/scripts/NixManifest.pm.in index 7244984ead6a..be0dda616922 100644 --- a/scripts/readmanifest.pm.in +++ b/scripts/NixManifest.pm.in @@ -33,18 +33,8 @@ sub readManifest { my $manifestVersion = 2; - my $storePath; - my $url; - my $hash; - my $size; - my $basePath; - my $baseHash; - my $patchType; - my $narHash; - my $references; - my $deriver; - my $hashAlgo; - my $copyFrom; + my ($storePath, $url, $hash, $size, $basePath, $baseHash, $patchType); + my ($narHash, $narSize, $references, $deriver, $hashAlgo, $copyFrom, $system); while (<MANIFEST>) { chomp; @@ -62,9 +52,11 @@ sub readManifest { undef $hash; undef $size; undef $narHash; + undef $narSize; undef $basePath; undef $baseHash; undef $patchType; + undef $system; $references = ""; $deriver = ""; $hashAlgo = "md5"; @@ -89,8 +81,10 @@ sub readManifest { if (!$found) { push @{$narFileList}, { url => $url, hash => $hash, size => $size - , narHash => $narHash, references => $references + , narHash => $narHash, narSize => $narSize + , references => $references , deriver => $deriver, hashAlgo => $hashAlgo + , system => $system }; } @@ -100,8 +94,8 @@ sub readManifest { addPatch $patches, $storePath, { url => $url, hash => $hash, size => $size , basePath => $basePath, baseHash => $baseHash - , narHash => $narHash, patchType => $patchType - , hashAlgo => $hashAlgo + , narHash => $narHash, narSize => $narSize + , patchType => $patchType, hashAlgo => $hashAlgo }; } @@ -132,9 +126,11 @@ sub readManifest { elsif (/^\s*BaseHash:\s*(\S+)\s*$/) { $baseHash = $1; } elsif (/^\s*Type:\s*(\S+)\s*$/) { $patchType = $1; } elsif (/^\s*NarHash:\s*(\S+)\s*$/) { $narHash = $1; } + elsif (/^\s*NarSize:\s*(\d+)\s*$/) { $narSize = $1; } elsif (/^\s*References:\s*(.*)\s*$/) { $references = $1; } elsif (/^\s*Deriver:\s*(\S+)\s*$/) { $deriver = $1; } elsif (/^\s*ManifestVersion:\s*(\d+)\s*$/) { $manifestVersion = $1; } + elsif (/^\s*System:\s*(\S+)\s*$/) { $system = $1; } # Compatibility; elsif (/^\s*NarURL:\s*(\S+)\s*$/) { $url = $1; } @@ -150,7 +146,7 @@ sub readManifest { sub writeManifest { - my ($manifest, $narFiles, $patches) = @_; + my ($manifest, $narFiles, $patches, $noCompress) = @_; open MANIFEST, ">$manifest.tmp"; # !!! check exclusive @@ -165,12 +161,14 @@ sub writeManifest { print MANIFEST " StorePath: $storePath\n"; print MANIFEST " NarURL: $narFile->{url}\n"; print MANIFEST " Hash: $narFile->{hash}\n" if defined $narFile->{hash}; - print MANIFEST " NarHash: $narFile->{narHash}\n"; print MANIFEST " Size: $narFile->{size}\n" if defined $narFile->{size}; + print MANIFEST " NarHash: $narFile->{narHash}\n"; + print MANIFEST " NarSize: $narFile->{narSize}\n" if $narFile->{narSize}; print MANIFEST " References: $narFile->{references}\n" if defined $narFile->{references} && $narFile->{references} ne ""; print MANIFEST " Deriver: $narFile->{deriver}\n" if defined $narFile->{deriver} && $narFile->{deriver} ne ""; + print MANIFEST " System: $narFile->{system}\n" if defined $narFile->{system}; print MANIFEST "}\n"; } } @@ -182,8 +180,9 @@ sub writeManifest { print MANIFEST " StorePath: $storePath\n"; print MANIFEST " NarURL: $patch->{url}\n"; print MANIFEST " Hash: $patch->{hash}\n"; - print MANIFEST " NarHash: $patch->{narHash}\n"; print MANIFEST " Size: $patch->{size}\n"; + print MANIFEST " NarHash: $patch->{narHash}\n"; + print MANIFEST " NarSize: $patch->{narSize}\n" if $patch->{narSize}; print MANIFEST " BasePath: $patch->{basePath}\n"; print MANIFEST " BaseHash: $patch->{baseHash}\n"; print MANIFEST " Type: $patch->{patchType}\n"; @@ -199,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: $!"; + } } diff --git a/scripts/ssh.pm b/scripts/SSH.pm index c6d667a65d90..68f4a628b072 100644 --- a/scripts/ssh.pm +++ b/scripts/SSH.pm @@ -3,6 +3,8 @@ use File::Temp qw(tempdir); our @sshOpts = split ' ', ($ENV{"NIX_SSHOPTS"} or ""); +push @sshOpts, "-x"; + my $sshStarted = 0; my $sshHost; @@ -24,14 +26,17 @@ sub openSSHConnection { # child continues to run if we are killed. So instead make SSH # print "started" when it has established the connection, and wait # until we see that. - open SSH, "ssh $sshHost @sshOpts -M -N -o LocalCommand='echo started' -o PermitLocalCommand=yes |" or die; - while (<SSH>) { + open SSHPIPE, "ssh $sshHost @sshOpts -M -N -o LocalCommand='echo started' -o PermitLocalCommand=yes |" or die; + + while (<SSHPIPE>) { chomp; - last if /started/; + if ($_ eq "started") { + $sshStarted = 1; + return 1; + } } - - $sshStarted = 1; - return 1; + + return 0; } # Tell the master SSH client to exit. diff --git a/scripts/build-remote.pl.in b/scripts/build-remote.pl.in index c440b6a0f142..e943b0d9e304 100755 --- a/scripts/build-remote.pl.in +++ b/scripts/build-remote.pl.in @@ -3,7 +3,8 @@ use Fcntl ':flock'; use English '-no_match_vars'; use IO::Handle; -use ssh qw/sshOpts openSSHConnection/; +use SSH qw/sshOpts openSSHConnection/; +no warnings('once'); # General operation: @@ -31,57 +32,22 @@ $ENV{"DISPLAY"} = ""; $ENV{"SSH_ASKPASS"} = ""; -my $loadIncreased = 0; - -my ($amWilling, $localSystem, $neededSystem, $drvPath, $maxSilentTime) = @ARGV; -$maxSilentTime = 0 unless defined $maxSilentTime; - sub sendReply { my $reply = shift; print STDERR "# $reply\n"; } -sub decline { - sendReply "decline"; - exit 0; -} - -my $currentLoad = $ENV{"NIX_CURRENT_LOAD"}; -decline unless defined $currentLoad; -mkdir $currentLoad, 0777 or die unless -d $currentLoad; - -my $conf = $ENV{"NIX_REMOTE_SYSTEMS"}; -decline if !defined $conf || ! -e $conf; - -my $canBuildLocally = $amWilling && ($localSystem eq $neededSystem); - +sub all { $_ || return 0 for @_; 1 } -# Read the list of machines. -my @machines; -open CONF, "< $conf" or die; - -while (<CONF>) { - chomp; - s/\#.*$//g; - next if /^\s*$/; - /^\s*(\S+)\s+(\S+)\s+(\S+)\s+(\d+)(\s+([0-9\.]+))?\s*$/ or die; - push @machines, - { hostName => $1 - , systemTypes => [split(/,/, $2)] - , sshKeys => $3 - , maxJobs => $4 - , speedFactor => 1.0 * ($6 || 1) - , enabled => 1 - }; -} -close CONF; +# Initialisation. +my $loadIncreased = 0; +my ($localSystem, $maxSilentTime, $printBuildTrace) = @ARGV; +$maxSilentTime = 0 unless defined $maxSilentTime; -# Acquire the exclusive lock on $currentLoad/main-lock. -my $mainLock = "$currentLoad/main-lock"; -open MAINLOCK, ">>$mainLock" or die; -flock(MAINLOCK, LOCK_EX) or die; +my $currentLoad = $ENV{"NIX_CURRENT_LOAD"}; +my $conf = $ENV{"NIX_REMOTE_SYSTEMS"}; sub openSlotLock { @@ -91,150 +57,213 @@ sub openSlotLock { open $slotLock, ">>$slotLockFn" or die; return $slotLock; } - -my $hostName; -my $slotLock; -while (1) { +# Read the list of machines. +my @machines; +if (defined $conf && -e $conf) { + open CONF, "< $conf" or die; + while (<CONF>) { + chomp; + s/\#.*$//g; + next if /^\s*$/; + my @tokens = split /\s/, $_; + push @machines, + { hostName => $tokens[0] + , systemTypes => [ split(/,/, $tokens[1]) ] + , sshKeys => $tokens[2] + , maxJobs => int($tokens[3]) + , speedFactor => 1.0 * (defined $tokens[4] ? int($tokens[4]) : 1) + , features => [ split(/,/, $tokens[5] || "") ] + , enabled => 1 + }; + } + close CONF; +} + + + +# Wait for the calling process to ask us whether we can build some derivation. +my ($drvPath, $hostName, $slotLock); + +REQ: while (1) { + $_ = <STDIN> || exit 0; + my ($amWilling, $neededSystem); + ($amWilling, $neededSystem, $drvPath, $requiredFeatures) = split; + my @requiredFeatures = split /,/, $requiredFeatures; + + my $canBuildLocally = $amWilling && ($localSystem eq $neededSystem); + + if (!defined $currentLoad) { + sendReply "decline"; + next; + } + + # Acquire the exclusive lock on $currentLoad/main-lock. + mkdir $currentLoad, 0777 or die unless -d $currentLoad; + my $mainLock = "$currentLoad/main-lock"; + open MAINLOCK, ">>$mainLock" or die; + flock(MAINLOCK, LOCK_EX) or die; - # Find all machine that can execute this build, i.e., that support - # builds for the given platform and are not at their job limit. - my $rightType = 0; - my @available = (); - LOOP: foreach my $cur (@machines) { - if ($cur->{enabled} && grep { $neededSystem eq $_ } @{$cur->{systemTypes}}) { - $rightType = 1; - - # We have a machine of the right type. Determine the load on - # the machine. - my $slot = 0; - my $load = 0; - my $free; - while ($slot < $cur->{maxJobs}) { - my $slotLock = openSlotLock($cur, $slot); - if (flock($slotLock, LOCK_EX | LOCK_NB)) { - $free = $slot unless defined $free; - flock($slotLock, LOCK_UN) or die; - } else { - $load++; + + while (1) { + # Find all machine that can execute this build, i.e., that + # support builds for the given platform and features, and are + # not at their job limit. + my $rightType = 0; + my @available = (); + LOOP: foreach my $cur (@machines) { + if ($cur->{enabled} + && (grep { $neededSystem eq $_ } @{$cur->{systemTypes}}) + && all(map { my $f = $_; 0 != grep { $f eq $_ } @{$cur->{features}} } @requiredFeatures)) + { + $rightType = 1; + + # We have a machine of the right type. Determine the load on + # the machine. + my $slot = 0; + my $load = 0; + my $free; + while ($slot < $cur->{maxJobs}) { + my $slotLock = openSlotLock($cur, $slot); + if (flock($slotLock, LOCK_EX | LOCK_NB)) { + $free = $slot unless defined $free; + flock($slotLock, LOCK_UN) or die; + } else { + $load++; + } + close $slotLock; + $slot++; } - close $slotLock; - $slot++; + + push @available, { machine => $cur, load => $load, free => $free } + if $load < $cur->{maxJobs}; } - - push @available, { machine => $cur, load => $load, free => $free } - if $load < $cur->{maxJobs}; } - } - if (defined $ENV{NIX_DEBUG_HOOK}) { - print STDERR "load on " . $_->{machine}->{hostName} . " = " . $_->{load} . "\n" - foreach @available; - } + if (defined $ENV{NIX_DEBUG_HOOK}) { + print STDERR "load on " . $_->{machine}->{hostName} . " = " . $_->{load} . "\n" + foreach @available; + } - # Didn't find any available machine? Then decline or postpone. - if (scalar @available == 0) { - # Postpone if we have a machine of the right type, except if the - # local system can and wants to do the build. - if ($rightType && !$canBuildLocally) { - sendReply "postpone"; - exit 0; - } else { - decline; + # Didn't find any available machine? Then decline or postpone. + if (scalar @available == 0) { + # Postpone if we have a machine of the right type, except + # if the local system can and wants to do the build. + if ($rightType && !$canBuildLocally) { + sendReply "postpone"; + } else { + sendReply "decline"; + } + close MAINLOCK; + next REQ; } - } - - # Prioritise the available machines as follows: - # - First by load divided by speed factor, rounded to the nearest - # integer. This causes fast machines to be preferred over slow - # machines with similar loads. - # - Then by speed factor. - # - Finally by load. - sub lf { my $x = shift; return int($x->{load} / $x->{machine}->{speedFactor} + 0.4999); } - @available = sort - { lf($a) <=> lf($b) - || $b->{machine}->{speedFactor} <=> $a->{machine}->{speedFactor} - || $a->{load} <=> $b->{load} - } @available; + # Prioritise the available machines as follows: + # - First by load divided by speed factor, rounded to the nearest + # integer. This causes fast machines to be preferred over slow + # machines with similar loads. + # - Then by speed factor. + # - Finally by load. + sub lf { my $x = shift; return int($x->{load} / $x->{machine}->{speedFactor} + 0.4999); } + @available = sort + { lf($a) <=> lf($b) + || $b->{machine}->{speedFactor} <=> $a->{machine}->{speedFactor} + || $a->{load} <=> $b->{load} + } @available; - # Select the best available machine and lock a free slot. - my $selected = $available[0]; - my $machine = $selected->{machine}; - $slotLock = openSlotLock($machine, $selected->{free}); - flock($slotLock, LOCK_EX | LOCK_NB) or die; - utime undef, undef, $slotLock; + # Select the best available machine and lock a free slot. + my $selected = $available[0]; + my $machine = $selected->{machine}; + + $slotLock = openSlotLock($machine, $selected->{free}); + flock($slotLock, LOCK_EX | LOCK_NB) or die; + utime undef, undef, $slotLock; - close MAINLOCK; + close MAINLOCK; - # Connect to the selected machine. - @sshOpts = ("-i", $machine->{sshKeys}, "-x"); - $hostName = $machine->{hostName}; - last if openSSHConnection $hostName; + # Connect to the selected machine. + @sshOpts = ("-i", $machine->{sshKeys}, "-x"); + $hostName = $machine->{hostName}; + last REQ if openSSHConnection $hostName; - warn "unable to open SSH connection to $hostName, trying other available machines...\n"; - $machine->{enabled} = 0; + warn "unable to open SSH connection to $hostName, trying other available machines...\n"; + $machine->{enabled} = 0; + } } # Tell Nix we've accepted the build. sendReply "accept"; -my $x = <STDIN>; -chomp $x; - -if ($x ne "okay") { - exit 0; -} +my @inputs = split /\s/, readline(STDIN); +my @outputs = split /\s/, readline(STDIN); -# Do the actual build. print STDERR "building `$drvPath' on `$hostName'\n"; +print STDERR "@ build-remote $drvPath $hostName\n" if $printBuildTrace; -my $inputs = `cat inputs`; die if ($? != 0); -$inputs =~ s/\n/ /g; - -my $outputs = `cat outputs`; die if ($? != 0); -$outputs =~ s/\n/ /g; - -print "copying inputs...\n"; my $maybeSign = ""; $maybeSign = "--sign" if -e "/nix/etc/nix/signing-key.sec"; -system("NIX_SSHOPTS=\"@sshOpts\" @bindir@/nix-copy-closure $hostName $maybeSign $drvPath $inputs") == 0 + +# Register the derivation as a temporary GC root. Note that $PPID is +# the PID of the remote SSH process, which, due to the use of a +# persistant SSH connection, should be the same across all remote +# command invocations for this session. +my $rootsDir = "@localstatedir@/nix/gcroots/tmp"; +system("ssh $hostName @sshOpts 'mkdir -m 1777 -p $rootsDir; ln -sfn $drvPath $rootsDir/\$PPID.drv'"); + +sub removeRoots { + system("ssh $hostName @sshOpts 'rm -f $rootsDir/\$PPID.drv $rootsDir/\$PPID.out'"); +} + + +# Copy the derivation and its dependencies to the build machine. +system("NIX_SSHOPTS=\"@sshOpts\" @bindir@/nix-copy-closure $hostName $maybeSign $drvPath @inputs") == 0 or die "cannot copy inputs to $hostName: $?"; -print "building...\n"; - -my $buildFlags = "--max-silent-time $maxSilentTime --fallback"; - -# `-tt' forces allocation of a pseudo-terminal. This is required to -# make the remote nix-store process receive a signal when the -# connection dies. Without it, the remote process might continue to -# run indefinitely (that is, until it next tries to write to -# stdout/stderr). -if (system("ssh $hostName @sshOpts -tt 'nix-store -r $drvPath $buildFlags > /dev/null'") != 0) { - # If we couldn't run ssh or there was an ssh problem (indicated by - # exit code 255), then we return exit code 1; otherwise we assume - # that the builder failed, which we indicate to Nix using exit - # code 100. It's important to distinguish between the two because - # the first is a transient failure and the latter is permanent. - my $res = $? == -1 || ($? >> 8) == 255 ? 1 : 100; - print STDERR "build of `$drvPath' on `$hostName' failed with exit code $?\n"; + +# Perform the build. +my $buildFlags = "--max-silent-time $maxSilentTime --fallback --add-root $rootsDir/\$PPID.out --option verbosity 0"; + +# We let the remote side kill its process group when the connection is +# closed unexpectedly. This is necessary to ensure that no processes +# are left running on the remote system if the local Nix process is +# killed. (SSH itself doesn't kill child processes if the connection +# is interrupted unless the `-tt' flag is used to force a pseudo-tty, +# in which case every child receives SIGHUP; however, `-tt' doesn't +# work on some platforms when connection sharing is used.) +pipe STDIN, DUMMY; # make sure we have a readable STDIN +if (system("ssh $hostName @sshOpts '(read; kill -INT -\$\$) <&0 & nix-store -r $drvPath $buildFlags > /dev/null' 2>&4") != 0) { + # Note that if we get exit code 100 from `nix-store -r', it + # denotes a permanent build failure (as opposed to an SSH problem + # or a temporary Nix problem). We propagate this to the caller to + # allow it to distinguish between transient and permanent + # failures. + my $res = $? >> 8; + print STDERR "build of `$drvPath' on `$hostName' failed with exit code $res\n"; + removeRoots; exit $res; } -print "build of `$drvPath' on `$hostName' succeeded\n"; +#print "build of `$drvPath' on `$hostName' succeeded\n"; -foreach my $output (split '\n', $outputs) { + +# Copy the output from the build machine. +foreach my $output (@outputs) { my $maybeSignRemote = ""; $maybeSignRemote = "--sign" if $UID != 0; - system("ssh $hostName @sshOpts 'nix-store --export $maybeSignRemote $output' | @bindir@/nix-store --import > /dev/null") == 0 + system("ssh $hostName @sshOpts 'nix-store --export $maybeSignRemote $output'" . + "| NIX_HELD_LOCKS=$output @bindir@/nix-store --import > /dev/null") == 0 or die "cannot copy $output from $hostName: $?"; } + + +# Get rid of the temporary GC roots. +removeRoots; diff --git a/scripts/copy-from-other-stores.pl.in b/scripts/copy-from-other-stores.pl.in index 8f0ff4ca8df8..10130c0893ea 100644 --- a/scripts/copy-from-other-stores.pl.in +++ b/scripts/copy-from-other-stores.pl.in @@ -17,25 +17,19 @@ foreach my $dir (@remoteStoresAll) { } +$ENV{"NIX_REMOTE"} = ""; + + sub findStorePath { my $storePath = shift; - - my $storePathName = basename $storePath; - foreach my $store (@remoteStores) { - # Determine whether $storePath exists by looking for the - # existence of the info file, and if so, get store path info - # from that file. This rather breaks abstraction: we should - # be using `nix-store' for that. But right now there is no - # good way to tell nix-store to access a store mounted under a - # different location (there's $NIX_STORE, but that only works - # if the remote store is mounted under its "real" location). - my $infoFile = "$store/var/nix/db/info/$storePathName"; - my $storePath2 = "$store/store/$storePathName"; - if (-f $infoFile && -e $storePath2) { - return ($infoFile, $storePath2); - } + my $sourcePath = "$store/store/" . basename $storePath; + next unless -e $sourcePath || -l $sourcePath; + $ENV{"NIX_DB_DIR"} = "$store/var/nix/db"; + return ($store, $sourcePath) if + system("@bindir@/nix-store --check-validity $storePath") == 0; } + return undef; } @@ -46,37 +40,38 @@ if ($ARGV[0] eq "--query") { if ($cmd eq "have") { my $storePath = <STDIN>; chomp $storePath; - (my $infoFile) = findStorePath $storePath; - print STDOUT ($infoFile ? "1\n" : "0\n"); + print STDOUT (defined findStorePath($storePath) ? "1\n" : "0\n"); } elsif ($cmd eq "info") { my $storePath = <STDIN>; chomp $storePath; - (my $infoFile) = findStorePath $storePath; - if (!$infoFile) { + my ($store, $sourcePath) = findStorePath($storePath); + if (!defined $store) { print "0\n"; next; # not an error } print "1\n"; - my $deriver = ""; - my @references = (); - - open INFO, "<$infoFile" or die "cannot read info file $infoFile\n"; - while (<INFO>) { - chomp; - /^([\w-]+): (.*)$/ or die "bad info file"; - my $key = $1; - my $value = $2; - if ($key eq "Deriver") { $deriver = $value; } - elsif ($key eq "References") { @references = split ' ', $value; } - } - close INFO; + $ENV{"NIX_DB_DIR"} = "$store/var/nix/db"; + + my $deriver = `@bindir@/nix-store --query --deriver $storePath`; + die "cannot query deriver of `$storePath'" if $? != 0; + chomp $deriver; + $deriver = "" if $deriver eq "unknown-deriver"; + + my @references = split "\n", + `@bindir@/nix-store --query --references $storePath`; + die "cannot query references of `$storePath'" if $? != 0; + + my $narSize = `@bindir@/nix-store --query --size $storePath`; + die "cannot query size of `$storePath'" if $? != 0; + chomp $narSize; print "$deriver\n"; print scalar @references, "\n"; print "$_\n" foreach @references; - print "0\n"; # !!! showing size not supported (yet) + print "$narSize\n"; + print "$narSize\n"; } else { die "unknown command `$cmd'"; } @@ -87,8 +82,8 @@ if ($ARGV[0] eq "--query") { elsif ($ARGV[0] eq "--substitute") { die unless scalar @ARGV == 2; my $storePath = $ARGV[1]; - (my $infoFile, my $sourcePath) = findStorePath $storePath; - die unless $infoFile; + my ($store, $sourcePath) = findStorePath $storePath; + die unless $store; print "\n*** Copying `$storePath' from `$sourcePath'\n\n"; system("$binDir/nix-store --dump $sourcePath | $binDir/nix-store --restore $storePath") == 0 or die "cannot copy `$sourcePath' to `$storePath'"; diff --git a/scripts/download-using-manifests.pl.in b/scripts/download-using-manifests.pl.in index d48c7dd4bc3f..fe80bc11f3a7 100644 --- a/scripts/download-using-manifests.pl.in +++ b/scripts/download-using-manifests.pl.in @@ -1,7 +1,7 @@ #! @perl@ -w -I@libexecdir@/nix use strict; -use readmanifest; +use NixManifest; use POSIX qw(strftime); use File::Temp qw(tempdir); @@ -12,6 +12,10 @@ STDOUT->autoflush(1); my $manifestDir = ($ENV{"NIX_MANIFESTS_DIR"} or "@localstatedir@/nix/manifests"); my $logFile = "@localstatedir@/log/nix/downloads"; +# For queries, skip expensive calls to nix-hash etc. We're just +# estimating the expected download size. +my $fast = 1; + # Load all manifests. my %narFiles; @@ -31,6 +35,151 @@ for my $manifest (glob "$manifestDir/*.nixmanifest") { } +sub isValidPath { + my $p = shift; + if ($fast) { + return -e $p; + } else { + 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); + } +} + + +# 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++]; + 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 = $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 = $fast && $baseHashAlgo eq "sha256" + ? `$binDir/nix-store -q --hash "$patch->{basePath}"` + : `$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 = $narFiles{$u}; + foreach my $narFile (@{$narFileList}) { + # !!! how to handle files whose size is not known in advance? + # For now, assume some arbitrary size (1 MB). + addEdge \%graph, "start", $u, ($narFile->{size} || 1000000), "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") { @@ -46,6 +195,7 @@ if ($ARGV[0] eq "--query") { elsif ($cmd eq "info") { my $storePath = <STDIN>; chomp $storePath; + my $info; if (defined $narFiles{$storePath}) { $info = @{$narFiles{$storePath}}[0]; @@ -57,13 +207,32 @@ if ($ARGV[0] eq "--query") { print "0\n"; next; # not an error } + print "1\n"; print "$info->{deriver}\n"; my @references = split " ", $info->{references}; print scalar @references, "\n"; print "$_\n" foreach @references; - my $size = $info->{size} || 0; - print "$size\n"; + + 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'"; } @@ -79,6 +248,7 @@ elsif ($ARGV[0] ne "--substitute") { die unless scalar @ARGV == 2; my $targetPath = $ARGV[1]; +$fast = 0; # Create a temporary directory. @@ -110,148 +280,9 @@ foreach my $localPath (@{$localPathList}) { } -# 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; - if ($hash ne $baseHash) { - print LOGFILE "$$ rejecting $patch->{basePath}\n"; - next; - } - } - 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}) { - # !!! how to handle files whose size is not known in advance? - # For now, assume some arbitrary size (1 MB). - addEdge "start", $u, ($narFile->{size} || 1000000), "narfile", $narFile; - if ($u eq $targetPath) { - my $size = $narFile->{size} || -1; - print LOGFILE "$$ full-download-would-be $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}; - - 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; -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}; -} +# Compute the shortest path. +my @path = computeSmallestDownload $targetPath; +die "don't know how to produce $targetPath\n" if scalar @path == 0; # Traverse the shortest path, perform the actions described by the diff --git a/scripts/generate-patches.pl.in b/scripts/generate-patches.pl.in deleted file mode 100755 index dba6473508d3..000000000000 --- a/scripts/generate-patches.pl.in +++ /dev/null @@ -1,416 +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; - - -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"; - -print "TEMP = $tmpDir\n"; - -#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) { - - # 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 $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; - } - - system("@libexecdir@/bsdiff $tmpDir/A $tmpDir/B $tmpDir/DIFF") == 0 - or die "cannot compute binary diff"; - - 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\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/nix-build.in b/scripts/nix-build.in index ed85d5712128..f9d81b36c7a0 100644 --- a/scripts/nix-build.in +++ b/scripts/nix-build.in @@ -123,6 +123,11 @@ EOF $verbose = 1; } + elsif ($arg eq "--quiet") { + push @buildArgs, $arg; + push @instArgs, $arg; + } + elsif (substr($arg, 0, 1) eq "-") { push @buildArgs, $arg; } @@ -165,7 +170,7 @@ foreach my $expr (@exprs) { # Build. my @outPaths; - $pid = open(OUTPATHS, "-|") || exec "$binDir/nix-store", "--add-root", $outLink, "--indirect", "-rv", + $pid = open(OUTPATHS, "-|") || exec "$binDir/nix-store", "--add-root", $outLink, "--indirect", "-r", @buildArgs, @drvPaths; while (<OUTPATHS>) {chomp; push @outPaths, $_;} if (!close OUTPATHS) { diff --git a/scripts/nix-copy-closure.in b/scripts/nix-copy-closure.in index a477cc01a4cf..c037f003f0d0 100644 --- a/scripts/nix-copy-closure.in +++ b/scripts/nix-copy-closure.in @@ -1,6 +1,6 @@ #! @perl@ -w -I@libexecdir@/nix -use ssh; +use SSH; my $binDir = $ENV{"NIX_BIN_DIR"} || "@bindir@"; @@ -61,7 +61,7 @@ if ($toMode) { # Copy TO the remote machine. my @allStorePaths; # Get the closure of this path. - my $pid = open(READ, "$binDir/nix-store --query --requisites @storePaths|") or die; + my $pid = open(READ, "set -f; $binDir/nix-store --query --requisites @storePaths|") or die; while (<READ>) { chomp; @@ -73,7 +73,7 @@ if ($toMode) { # Copy TO the remote machine. # Ask the remote host which paths are invalid. - open(READ, "ssh $sshHost @sshOpts nix-store --check-validity --print-invalid @allStorePaths|"); + open(READ, "set -f; ssh $sshHost @sshOpts nix-store --check-validity --print-invalid @allStorePaths|"); my @missing = (); while (<READ>) { chomp; @@ -88,7 +88,7 @@ if ($toMode) { # Copy TO the remote machine. print STDERR " $_\n" foreach @missing; my $extraOpts = ""; $extraOpts .= "--sign" if $sign == 1; - system("nix-store --export $extraOpts @missing $compressor | ssh $sshHost @sshOpts '$decompressor nix-store --import'") == 0 + system("set -f; nix-store --export $extraOpts @missing $compressor | ssh $sshHost @sshOpts '$decompressor nix-store --import'") == 0 or die "copying store paths to remote machine `$sshHost' failed: $?"; } @@ -101,7 +101,7 @@ else { # Copy FROM the remote machine. # machine. Paths are assumed to be store paths; there is no # resolution (following of symlinks). my $pid = open(READ, - "ssh @sshOpts $sshHost nix-store --query --requisites @storePaths|") or die; + "set -f; ssh @sshOpts $sshHost nix-store --query --requisites @storePaths|") or die; my @allStorePaths; @@ -115,7 +115,7 @@ else { # Copy FROM the remote machine. # What paths are already valid locally? - open(READ, "@bindir@/nix-store --check-validity --print-invalid @allStorePaths|"); + open(READ, "set -f; @bindir@/nix-store --check-validity --print-invalid @allStorePaths|"); my @missing = (); while (<READ>) { chomp; @@ -130,7 +130,7 @@ else { # Copy FROM the remote machine. print STDERR " $_\n" foreach @missing; my $extraOpts = ""; $extraOpts .= "--sign" if $sign == 1; - system("ssh $sshHost @sshOpts 'nix-store --export $extraOpts @missing $compressor' | $decompressor @bindir@/nix-store --import") == 0 + system("set -f; ssh $sshHost @sshOpts 'nix-store --export $extraOpts @missing $compressor' | $decompressor @bindir@/nix-store --import") == 0 or die "copying store paths from remote machine `$sshHost' failed: $?"; } diff --git a/scripts/nix-generate-patches.in b/scripts/nix-generate-patches.in new file mode 100644 index 000000000000..c96cc704a1e8 --- /dev/null +++ b/scripts/nix-generate-patches.in @@ -0,0 +1,42 @@ +#! @perl@ -w -I@libexecdir@/nix + +use strict; +use File::Temp qw(tempdir); +use NixManifest; +use GeneratePatches; + +if (scalar @ARGV != 5) { + print STDERR <<EOF; +Usage: nix-generate-patches NAR-DIR PATCH-DIR PATCH-URI OLD-MANIFEST NEW-MANIFEST + +This command generates binary patches between NAR files listed in +OLD-MANIFEST and NEW-MANIFEST. The patches are written to the +directory PATCH-DIR, and the prefix PATCH-URI is used to generate URIs +for the patches. The patches are added to NEW-MANIFEST. All NARs are +required to exist in NAR-DIR. Patches are generated between +succeeding versions of packages with the same name. +EOF + exit 1; +} + +my $narPath = $ARGV[0]; +my $patchesPath = $ARGV[1]; +my $patchesURL = $ARGV[2]; +my $srcManifest = $ARGV[3]; +my $dstManifest = $ARGV[4]; + +my (%srcNarFiles, %srcLocalPaths, %srcPatches); +readManifest $srcManifest, \%srcNarFiles, \%srcLocalPaths, \%srcPatches; + +my (%dstNarFiles, %dstLocalPaths, %dstPatches); +readManifest $dstManifest, \%dstNarFiles, \%dstLocalPaths, \%dstPatches; + +my $tmpDir = tempdir("nix-generate-patches.XXXXXX", CLEANUP => 1, TMPDIR => 1) + or die "cannot create a temporary directory"; + +generatePatches \%srcNarFiles, \%dstNarFiles, \%srcPatches, \%dstPatches, + $narPath, $patchesPath, $patchesURL, $tmpDir; + +propagatePatches \%srcPatches, \%dstNarFiles, \%dstPatches; + +writeManifest $dstManifest, \%dstNarFiles, \%dstPatches; diff --git a/scripts/nix-pull.in b/scripts/nix-pull.in index e2a0cc1fafdf..f3b533ff7a4c 100644 --- a/scripts/nix-pull.in +++ b/scripts/nix-pull.in @@ -2,7 +2,7 @@ use strict; use File::Temp qw(tempdir); -use readmanifest; +use NixManifest; my $tmpDir = tempdir("nix-pull.XXXXXX", CLEANUP => 1, TMPDIR => 1) or die "cannot create a temporary directory"; diff --git a/scripts/nix-push.in b/scripts/nix-push.in index 38097f740162..1d8ba86a8d0c 100644 --- a/scripts/nix-push.in +++ b/scripts/nix-push.in @@ -2,7 +2,7 @@ use strict; use File::Temp qw(tempdir); -use readmanifest; +use NixManifest; my $hashAlgo = "sha256"; @@ -172,12 +172,6 @@ for (my $n = 0; $n < scalar @storePaths; $n++) { $narbz2Hash =~ /^[0-9a-z]+$/ or die "invalid hash"; close HASH; - open HASH, "$narDir/nar-hash" or die "cannot open nar-hash"; - my $narHash = <HASH>; - chomp $narHash; - $narHash =~ /^[0-9a-z]+$/ or die "invalid hash"; - close HASH; - my $narName = "$narbz2Hash.nar.bz2"; my $narFile = "$narDir/$narName"; @@ -195,6 +189,14 @@ for (my $n = 0; $n < scalar @storePaths; $n++) { chomp $deriver; $deriver = "" if $deriver eq "unknown-deriver"; + my $narHash = `$binDir/nix-store --query --hash '$storePath'`; + die "cannot query hash for `$storePath'" if $? != 0; + chomp $narHash; + + my $narSize = `$binDir/nix-store --query --size '$storePath'`; + die "cannot query size for `$storePath'" if $? != 0; + chomp $narSize; + my $url; if ($localCopy) { $url = "$targetArchivesUrl/$narName"; @@ -205,7 +207,8 @@ for (my $n = 0; $n < scalar @storePaths; $n++) { { url => $url , hash => "$hashAlgo:$narbz2Hash" , size => $narbz2Size - , narHash => "$hashAlgo:$narHash" + , narHash => "$narHash" + , narSize => $narSize , references => $references , deriver => $deriver } |