about summary refs log tree commit diff
path: root/perl
diff options
context:
space:
mode:
Diffstat (limited to 'perl')
-rw-r--r--perl/lib/Nix/CopyClosure.pm96
-rw-r--r--perl/lib/Nix/SSH.pm81
-rw-r--r--perl/lib/Nix/Store.pm2
-rw-r--r--perl/lib/Nix/Store.xs11
-rw-r--r--perl/local.mk2
5 files changed, 128 insertions, 64 deletions
diff --git a/perl/lib/Nix/CopyClosure.pm b/perl/lib/Nix/CopyClosure.pm
index 131f0b5a4557..f701a7c8a0d5 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 584c44500981..c8792043c20c 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 191116ee5637..89cfaefa5fd4 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 07ccebe62f51..ff90616d3766 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 74c054e7133f..564683dffee2 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
generated by cgit-pink 1.4.1 (git 2.44.2) at 2024-09-09T14·19+0000