diff options
Diffstat (limited to 'scripts')
-rwxr-xr-x | scripts/build-remote.pl.in | 305 | ||||
-rw-r--r-- | scripts/copy-from-other-stores.pl.in | 65 | ||||
-rw-r--r-- | scripts/download-using-manifests.pl.in | 311 | ||||
-rw-r--r-- | scripts/nix-build.in | 7 | ||||
-rw-r--r-- | scripts/nix-push.in | 17 | ||||
-rw-r--r-- | scripts/readmanifest.pm.in | 29 | ||||
-rw-r--r-- | scripts/ssh.pm | 11 |
7 files changed, 399 insertions, 346 deletions
diff --git a/scripts/build-remote.pl.in b/scripts/build-remote.pl.in index c440b6a0f142..f9bff9c41d72 100755 --- a/scripts/build-remote.pl.in +++ b/scripts/build-remote.pl.in @@ -4,6 +4,7 @@ use Fcntl ':flock'; use English '-no_match_vars'; use IO::Handle; 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; +sub all { $_ || return 0 for @_; 1 } -my $conf = $ENV{"NIX_REMOTE_SYSTEMS"}; -decline if !defined $conf || ! -e $conf; - -my $canBuildLocally = $amWilling && ($localSystem eq $neededSystem); - - -# 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,134 +57,189 @@ 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; + } - # 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++; + # 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; + + + 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"; +# Perform the build. +my $buildFlags = "--max-silent-time $maxSilentTime --fallback --add-root $rootsDir/\$PPID.out --option verbosity 0"; -# `-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) { +# 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) { # 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 @@ -226,15 +247,23 @@ if (system("ssh $hostName @sshOpts -tt 'nix-store -r $drvPath $buildFlags > /dev # 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"; + 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..c50f540f3464 100644 --- a/scripts/download-using-manifests.pl.in +++ b/scripts/download-using-manifests.pl.in @@ -31,6 +31,148 @@ for my $manifest (glob "$manifestDir/*.nixmanifest") { } +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); + } +} + + +# Compute the most efficient sequence of downloads to produce the +# given path. +sub computeSmallestDownload { + my $targetPath = shift; + my $fast = 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 +188,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 +200,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, 1; + + 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}; + } + elsif ($edge->{type} eq "narfile") { + $downloadSize += $edge->{info}->{size}; + } + } + + print "$downloadSize\n"; + + my $narSize = $info->{narSize} || 0; + print "$narSize\n"; } else { die "unknown command `$cmd'"; } @@ -110,148 +272,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, 0; +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/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-push.in b/scripts/nix-push.in index 38097f740162..6760baa7e937 100644 --- a/scripts/nix-push.in +++ b/scripts/nix-push.in @@ -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 } diff --git a/scripts/readmanifest.pm.in b/scripts/readmanifest.pm.in index 7244984ead6a..c2c4be89b271 100644 --- a/scripts/readmanifest.pm.in +++ b/scripts/readmanifest.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); while (<MANIFEST>) { chomp; @@ -62,6 +52,7 @@ sub readManifest { undef $hash; undef $size; undef $narHash; + undef $narSize; undef $basePath; undef $baseHash; undef $patchType; @@ -89,7 +80,8 @@ 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 }; } @@ -100,8 +92,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,6 +124,7 @@ 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; } @@ -165,8 +158,9 @@ 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" @@ -182,8 +176,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"; diff --git a/scripts/ssh.pm b/scripts/ssh.pm index c6d667a65d90..44a0e6f31b1c 100644 --- a/scripts/ssh.pm +++ b/scripts/ssh.pm @@ -25,13 +25,16 @@ sub openSSHConnection { # 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>) { chomp; - last if /started/; + if ($_ eq "started") { + $sshStarted = 1; + return 1; + } } - - $sshStarted = 1; - return 1; + + return 0; } # Tell the master SSH client to exit. |