From d06d54e338064d84a59c5811587b930799aab208 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Fri, 12 Jan 2018 22:20:30 +0100
Subject: offload: Fix regression in file retrieval.

This fixes a regression in 'retrieve-files*' introduced in
896fec476f728183b331cbb6e2afb891207b4205, whereby (guix scripts offload)
would not read the initial sexp now sent by the remote host via
'store-export-channel'.  This would effectively prevent file retrieval
entirely when offloading.

* guix/ssh.scm (retrieve-files*): New procedure, like former
'retrieve-files' but with an extra #:import parameter.
(retrieve-files): Rewrite in terms of 'retrieve-files*'.
(file-retrieval-port): Make private.
* guix/scripts/offload.scm (transfer-and-offload): Pass #:import to
'retrieve-files*'.
(retrieve-files*): Remove.
---
 guix/ssh.scm | 36 +++++++++++++++++++++++++-----------
 1 file changed, 25 insertions(+), 11 deletions(-)

(limited to 'guix/ssh.scm')

diff --git a/guix/ssh.scm b/guix/ssh.scm
index cb560c0e9c..21c452f28c 100644
--- a/guix/ssh.scm
+++ b/guix/ssh.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -29,6 +29,7 @@ (define-module (guix ssh)
   #:use-module (ssh dist)
   #:use-module (ssh dist node)
   #:use-module (srfi srfi-11)
+  #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
   #:use-module (ice-9 match)
@@ -38,9 +39,8 @@ (define-module (guix ssh)
             connect-to-remote-daemon
             send-files
             retrieve-files
-            remote-store-host
-
-            file-retrieval-port))
+            retrieve-files*
+            remote-store-host))
 
 ;;; Commentary:
 ;;;
@@ -339,10 +339,11 @@ (define-syntax raise-error
              (&message
               (message (format #f fmt args ...))))))))
 
-(define* (retrieve-files local files remote
-                         #:key recursive? (log-port (current-error-port)))
-  "Retrieve FILES from REMOTE and import them using the 'import-paths' RPC on
-LOCAL.  When RECURSIVE? is true, retrieve the closure of FILES."
+(define* (retrieve-files* files remote
+                          #:key recursive? (log-port (current-error-port))
+                          (import (const #f)))
+  "Pass IMPORT an input port from which to read the sequence of FILES coming
+from REMOTE.  When RECURSIVE? is true, retrieve the closure of FILES."
   (let-values (((port count)
                 (file-retrieval-port files remote
                                      #:recursive? recursive?)))
@@ -352,9 +353,12 @@ (define* (retrieve-files local files remote
                       "retrieving ~a store items from '~a'...~%" count)
                count (remote-store-host remote))
 
-       (let ((result (import-paths local port)))
-         (close-port port)
-         result))
+       (dynamic-wind
+         (const #t)
+         (lambda ()
+           (import port))
+         (lambda ()
+           (close-port port))))
       ((? eof-object?)
        (raise-error (G_ "failed to start Guile on remote host '~A': exit code ~A")
                     (remote-store-host remote)
@@ -386,4 +390,14 @@ (define* (retrieve-files local files remote
        (raise-error (G_ "failed to retrieve store items from '~a'")
                     (remote-store-host remote))))))
 
+(define* (retrieve-files local files remote
+                         #:key recursive? (log-port (current-error-port)))
+  "Retrieve FILES from REMOTE and import them using the 'import-paths' RPC on
+LOCAL.  When RECURSIVE? is true, retrieve the closure of FILES."
+  (retrieve-files* files remote
+                   #:recursive? recursive?
+                   #:log-port log-port
+                   #:import (lambda (port)
+                              (import-paths local port))))
+
 ;;; ssh.scm ends here
-- 
cgit v1.2.3