From a5c6347ff06ba09530fdf0e01828aaec89f6ceb6 Mon Sep 17 00:00:00 2001
From: Eelco Dolstra <eelco.dolstra@logicblox.com>
Date: Fri, 11 Jul 2014 16:02:19 +0200
Subject: =?UTF-8?q?build-remote.pl:=20Use=20=E2=80=98nix-store=20--serve?=
 =?UTF-8?q?=E2=80=99=20on=20the=20remote=20side?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

This makes things more efficient (we don't need to use an SSH master
connection, and we only start a single remote process) and gets rid of
locking issues (the remote nix-store process will keep inputs and
outputs locked as long as they're needed).

It also makes it more or less secure to connect directly to the root
account on the build machine, using a forced command
(e.g. ‘command="nix-store --serve --write"’). This bypasses the Nix
daemon and is therefore more efficient.

Also, don't call nix-store to import the output paths.
---
 perl/lib/Nix/CopyClosure.pm | 96 +++++++++++++++++----------------------------
 perl/lib/Nix/SSH.pm         | 81 +++++++++++++++++++++++++++++++++++++-
 perl/lib/Nix/Store.pm       |  2 +-
 perl/lib/Nix/Store.xs       | 11 ++++++
 perl/local.mk               |  2 +-
 5 files changed, 128 insertions(+), 64 deletions(-)

(limited to 'perl')

diff --git a/perl/lib/Nix/CopyClosure.pm b/perl/lib/Nix/CopyClosure.pm
index 131f0b5a4..f701a7c8a 100644
--- a/perl/lib/Nix/CopyClosure.pm
+++ b/perl/lib/Nix/CopyClosure.pm
@@ -3,76 +3,27 @@ package Nix::CopyClosure;
 use strict;
 use Nix::Config;
 use Nix::Store;
+use Nix::SSH;
 use List::Util qw(sum);
 use IPC::Open2;
 
 
-sub readN {
-    my ($bytes, $from) = @_;
-    my $res = "";
-    while ($bytes > 0) {
-        my $s;
-        my $n = sysread($from, $s, $bytes);
-        die "I/O error reading from remote side\n" if !defined $n;
-        die "got EOF while expecting $bytes bytes from remote side\n" if !$n;
-        $bytes -= $n;
-        $res .= $s;
-    }
-    return $res;
-}
-
-
-sub readInt {
-    my ($from) = @_;
-    return unpack("L<x4", readN(8, $from));
-}
-
-
-sub writeString {
-    my ($s, $to) = @_;
-    my $len = length $s;
-    my $req .= pack("L<x4", $len);
-    $req .= $s;
-    $req .= "\000" x (8 - $len % 8) if $len % 8;
-    syswrite($to, $req) or die;
-}
-
-
-sub copyTo {
-    my ($sshHost, $sshOpts, $storePaths, $compressor, $decompressor,
+sub copyToOpen {
+    my ($from, $to, $sshHost, $storePaths, $compressor, $decompressor,
         $includeOutputs, $dryRun, $sign, $progressViewer, $useSubstitutes) = @_;
 
-    $useSubstitutes = 0 if $dryRun;
+    $useSubstitutes = 0 if $dryRun || !defined $useSubstitutes;
 
     # Get the closure of this path.
     my @closure = reverse(topoSortPaths(computeFSClosure(0, $includeOutputs,
         map { followLinksToStorePath $_ } @{$storePaths})));
 
-    # Start ‘nix-store --serve’ on the remote host.
-    my ($from, $to);
-    my $pid = open2($from, $to, "ssh $sshHost @{$sshOpts} nix-store --serve --write");
-
-    # Do the handshake.
-    eval {
-        my $SERVE_MAGIC_1 = 0x390c9deb; # FIXME
-        my $clientVersion = 0x200;
-        syswrite($to, pack("L<x4L<x4", $SERVE_MAGIC_1, $clientVersion)) or die;
-        die "did not get valid handshake from remote host\n" if readInt($from) != 0x5452eecb;
-        my $serverVersion = readInt($from);
-        die "unsupported server version\n" if $serverVersion < 0x200 || $serverVersion >= 0x300;
-    };
-    if ($@) {
-        chomp $@;
-        warn "$@; falling back to old closure copying method\n";
-        return oldCopyTo(\@closure, @_);
-    }
-
     # Send the "query valid paths" command with the "lock" option
     # enabled. This prevents a race where the remote host
     # garbage-collect paths that are already there. Optionally, ask
     # the remote host to substitute missing paths.
-    syswrite($to, pack("L<x4L<x4L<x4L<x4", 1, 1, $useSubstitutes, scalar @closure)) or die;
-    writeString($_, $to) foreach @closure;
+    syswrite($to, pack("L<x4L<x4L<x4", 1, 1, $useSubstitutes)) or die;
+    writeStrings(\@closure, $to);
 
     # Get back the set of paths that are already valid on the remote host.
     my %present;
@@ -115,22 +66,47 @@ sub copyTo {
 
     } else {
         exportPaths(fileno($to), $sign, @missing);
-        close $to;
     }
 
     readInt($from) == 1 or die "remote machine \`$sshHost' failed to import closure\n";
 }
 
 
+sub copyTo {
+    my ($sshHost, $sshOpts, $storePaths, $compressor, $decompressor,
+        $includeOutputs, $dryRun, $sign, $progressViewer, $useSubstitutes) = @_;
+
+    # Connect to the remote host.
+    my ($from, $to);
+    eval {
+        ($from, $to) = connectToRemoteNix($sshHost, $sshOpts);
+    };
+    if ($@) {
+        chomp $@;
+        warn "$@; falling back to old closure copying method\n";
+        return oldCopyTo(@_);
+    }
+
+    copyToOpen($from, $to, $sshHost, $storePaths, $compressor, $decompressor,
+               $includeOutputs, $dryRun, $sign, $progressViewer, $useSubstitutes);
+
+    close $to;
+}
+
+
 # For backwards compatibility with Nix <= 1.7. Will be removed
 # eventually.
 sub oldCopyTo {
-    my ($closure, $sshHost, $sshOpts, $storePaths, $compressor, $decompressor,
+    my ($sshHost, $sshOpts, $storePaths, $compressor, $decompressor,
         $includeOutputs, $dryRun, $sign, $progressViewer, $useSubstitutes) = @_;
 
+    # Get the closure of this path.
+    my @closure = reverse(topoSortPaths(computeFSClosure(0, $includeOutputs,
+        map { followLinksToStorePath $_ } @{$storePaths})));
+
     # Optionally use substitutes on the remote host.
     if (!$dryRun && $useSubstitutes) {
-        system "ssh $sshHost @{$sshOpts} nix-store -r --ignore-unknown @$closure";
+        system "ssh $sshHost @{$sshOpts} nix-store -r --ignore-unknown @closure";
         # Ignore exit status because this is just an optimisation.
     }
 
@@ -140,8 +116,8 @@ sub oldCopyTo {
     # target having this option yet.
     my @missing;
     my $missingSize = 0;
-    while (scalar(@$closure) > 0) {
-        my @ps = splice(@$closure, 0, 1500);
+    while (scalar(@closure) > 0) {
+        my @ps = splice(@closure, 0, 1500);
         open(READ, "set -f; ssh $sshHost @{$sshOpts} nix-store --check-validity --print-invalid @ps|");
         while (<READ>) {
             chomp;
diff --git a/perl/lib/Nix/SSH.pm b/perl/lib/Nix/SSH.pm
index 584c44500..c8792043c 100644
--- a/perl/lib/Nix/SSH.pm
+++ b/perl/lib/Nix/SSH.pm
@@ -1,5 +1,16 @@
+package Nix::SSH;
+
 use strict;
 use File::Temp qw(tempdir);
+use IPC::Open2;
+
+our @ISA = qw(Exporter);
+our @EXPORT = qw(
+  sshOpts openSSHConnection closeSSHConnection
+  readN readInt writeInt writeString writeStrings
+  connectToRemoteNix
+);
+
 
 our @sshOpts = split ' ', ($ENV{"NIX_SSHOPTS"} or "");
 
@@ -8,6 +19,7 @@ push @sshOpts, "-x";
 my $sshStarted = 0;
 my $sshHost;
 
+
 # Open a master SSH connection to `host', unless there already is a
 # running master connection (as determined by `-O check').
 sub openSSHConnection {
@@ -18,7 +30,7 @@ sub openSSHConnection {
 
     my $tmpDir = tempdir("nix-ssh.XXXXXX", CLEANUP => 1, TMPDIR => 1)
         or die "cannot create a temporary directory";
-    
+
     push @sshOpts, "-S", "$tmpDir/control";
 
     # Start the master.  We can't use the `-f' flag (fork into
@@ -39,6 +51,7 @@ sub openSSHConnection {
     return 0;
 }
 
+
 # Tell the master SSH client to exit.
 sub closeSSHConnection {
     if ($sshStarted) {
@@ -48,6 +61,70 @@ sub closeSSHConnection {
     }
 }
 
+
+sub readN {
+    my ($bytes, $from) = @_;
+    my $res = "";
+    while ($bytes > 0) {
+        my $s;
+        my $n = sysread($from, $s, $bytes);
+        die "I/O error reading from remote side\n" if !defined $n;
+        die "got EOF while expecting $bytes bytes from remote side\n" if !$n;
+        $bytes -= $n;
+        $res .= $s;
+    }
+    return $res;
+}
+
+
+sub readInt {
+    my ($from) = @_;
+    return unpack("L<x4", readN(8, $from));
+}
+
+
+sub writeInt {
+    my ($n, $to) = @_;
+    syswrite($to, pack("L<x4", $n)) or die;
+}
+
+
+sub writeString {
+    my ($s, $to) = @_;
+    my $len = length $s;
+    my $req .= pack("L<x4", $len);
+    $req .= $s;
+    $req .= "\000" x (8 - $len % 8) if $len % 8;
+    syswrite($to, $req) or die;
+}
+
+
+sub writeStrings {
+    my ($ss, $to) = @_;
+    writeInt(scalar(@{$ss}), $to);
+    writeString($_, $to) foreach @{$ss};
+}
+
+
+sub connectToRemoteNix {
+    my ($sshHost, $sshOpts) = @_;
+
+    # Start ‘nix-store --serve’ on the remote host.
+    my ($from, $to);
+    my $pid = open2($from, $to, "ssh $sshHost @{$sshOpts} nix-store --serve --write");
+
+    # Do the handshake.
+    my $SERVE_MAGIC_1 = 0x390c9deb; # FIXME
+    my $clientVersion = 0x200;
+    syswrite($to, pack("L<x4L<x4", $SERVE_MAGIC_1, $clientVersion)) or die;
+    die "did not get valid handshake from remote host\n" if readInt($from) != 0x5452eecb;
+    my $serverVersion = readInt($from);
+    die "unsupported server version\n" if $serverVersion < 0x200 || $serverVersion >= 0x300;
+
+    return ($from, $to, $pid);
+}
+
+
 END { my $saved = $?; closeSSHConnection; $? = $saved; }
 
-return 1;
+1;
diff --git a/perl/lib/Nix/Store.pm b/perl/lib/Nix/Store.pm
index 191116ee5..89cfaefa5 100644
--- a/perl/lib/Nix/Store.pm
+++ b/perl/lib/Nix/Store.pm
@@ -15,7 +15,7 @@ our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
 our @EXPORT = qw(
     isValidPath queryReferences queryPathInfo queryDeriver queryPathHash
     queryPathFromHashPart
-    topoSortPaths computeFSClosure followLinksToStorePath exportPaths
+    topoSortPaths computeFSClosure followLinksToStorePath exportPaths importPaths
     hashPath hashFile hashString
     addToStore makeFixedOutputPath
     derivationFromPath
diff --git a/perl/lib/Nix/Store.xs b/perl/lib/Nix/Store.xs
index 07ccebe62..ff90616d3 100644
--- a/perl/lib/Nix/Store.xs
+++ b/perl/lib/Nix/Store.xs
@@ -179,6 +179,17 @@ void exportPaths(int fd, int sign, ...)
         }
 
 
+void importPaths(int fd)
+    PPCODE:
+        try {
+            doInit();
+            FdSource source(fd);
+            store->importPaths(false, source);
+        } catch (Error & e) {
+            croak(e.what());
+        }
+
+
 SV * hashPath(char * algo, int base32, char * path)
     PPCODE:
         try {
diff --git a/perl/local.mk b/perl/local.mk
index 74c054e71..564683dff 100644
--- a/perl/local.mk
+++ b/perl/local.mk
@@ -27,7 +27,7 @@ ifeq ($(perlbindings), yes)
 
   Store_CXXFLAGS = \
     -I$(shell $(perl) -e 'use Config; print $$Config{archlibexp};')/CORE \
-    -D_FILE_OFFSET_BITS=64
+    -D_FILE_OFFSET_BITS=64 -Wno-unused-variable -Wno-literal-suffix
 
   Store_ALLOW_UNDEFINED = 1
 
-- 
cgit v1.2.3