01/05: offload: Fix regression in file retrieval.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit d06d54e338064d84a59c5811587b930799aab208
Author: Ludovic Courtès <address@hidden>
Date:   Fri Jan 12 22:20:30 2018 +0100

    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/scripts/offload.scm | 27 ++++++++++-----------------
 guix/ssh.scm             | 36 +++++++++++++++++++++++++-----------
 2 files changed, 35 insertions(+), 28 deletions(-)

diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm
index 7e114fa..25efe90 100644
--- a/guix/scripts/offload.scm
+++ b/guix/scripts/offload.scm
@@ -358,26 +358,19 @@ MACHINE."
     (parameterize ((current-build-output-port (build-log-port)))
       (build-derivations store (list drv))))
 
-  (retrieve-files* outputs store)
+  (retrieve-files* outputs store
+
+                   ;; We cannot use the 'import-paths' RPC here because we
+                   ;; already hold the locks for FILES.
+                   #:import
+                   (lambda (port)
+                     (restore-file-set port
+                                       #:log-port (current-error-port)
+                                       #:lock? #f)))
+
   (format (current-error-port) "done with offloaded '~a'~%"
           (derivation-file-name drv)))
 
-(define (retrieve-files* files remote)
-  "Retrieve FILES from REMOTE and import them using 'restore-file-set'."
-  (let-values (((port count)
-                (file-retrieval-port files remote)))
-    (format #t (N_ "retrieving ~a store item from '~a'...~%"
-                   "retrieving ~a store items from '~a'...~%" count)
-            count (remote-store-host remote))
-
-    ;; We cannot use the 'import-paths' RPC here because we already
-    ;; hold the locks for FILES.
-    (let ((result (restore-file-set port
-                                    #:log-port (current-error-port)
-                                    #:lock? #f)))
-      (close-port port)
-      result)))
-
 
 ;;;
 ;;; Scheduling.
diff --git a/guix/ssh.scm b/guix/ssh.scm
index cb560c0..21c452f 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 <address@hidden>
+;;; Copyright © 2016, 2017, 2018 Ludovic Courtès <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -29,6 +29,7 @@
   #: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 @@
             connect-to-remote-daemon
             send-files
             retrieve-files
-            remote-store-host
-
-            file-retrieval-port))
+            retrieve-files*
+            remote-store-host))
 
 ;;; Commentary:
 ;;;
@@ -339,10 +339,11 @@ to the length of FILES.)"
              (&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 @@ LOCAL.  When RECURSIVE? is true, retrieve the closure of 
FILES."
                       "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 @@ check.")
        (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