Merge branch 'master' into core-updates

This merge commit includes a fix for CVE-2017-6512 in Perl 5.26.0.

2 files changed, 60 insertions, 20 deletions

diff --git a/guix/import/cpan.scm b/guix/import/cpan.scm
index 32c5c310e1..a41f918049 100644
--- a/guix/import/cpan.scm
+++ b/guix/import/cpan.scm
@@ -88,7 +88,7 @@
   "Return the base distribution module for a given module.  E.g. the 'ok'
 module is distributed with 'Test::Simple', so (module->dist-name \"ok\") would
 return \"Test-Simple\""
-  (assoc-ref (json-fetch (string-append "https://api.metacpan.org/module/"
+  (assoc-ref (json-fetch (string-append "https://fastapi.metacpan.org/v1/module/"
                                         module
                                         "?fields=distribution"))
              "distribution"))
@@ -113,7 +113,7 @@ return \"Test-Simple\""
   "Return an alist representation of the CPAN metadata for the perl module MODULE,
 or #f on failure.  MODULE should be e.g. \"Test::Script\""
   ;; This API always returns the latest release of the module.
-  (json-fetch (string-append "https://api.metacpan.org/release/" name)))
+  (json-fetch (string-append "https://fastapi.metacpan.org/v1/release/" name)))
 
 (define (cpan-home name)
   (string-append "http://search.cpan.org/dist/" name))
diff --git a/guix/ssh.scm b/guix/ssh.scm
index 4fb145230d..32cf6e464b 100644
--- a/guix/ssh.scm
+++ b/guix/ssh.scm
@@ -150,23 +150,44 @@ can be written."
   ;; makes a round trip every time 32 KiB have been transferred.  This
   ;; procedure instead opens a separate channel to use the remote
   ;; 'import-paths' procedure, which consumes all the data in a single round
-  ;; trip.
+  ;; trip.  This optimizes the successful case at the expense of error
+  ;; conditions: errors can only be reported once all the input has been
+  ;; consumed.
   (define import
     `(begin
-       (use-modules (guix))
-
-       (with-store store
-         (setvbuf (current-input-port) _IONBF)
-
-         ;; FIXME: Exceptions are silently swallowed.  We should report them
-         ;; somehow.
-         (import-paths store (current-input-port)))))
-
-  (open-remote-output-pipe session
-                           (string-join
-                            `("guile" "-c"
-                              ,(object->string
-                                (object->string import))))))
+       (use-modules (guix) (srfi srfi-34)
+                    (rnrs io ports) (rnrs bytevectors))
+
+       (define (consume-input port)
+         (let ((bv (make-bytevector 32768)))
+           (let loop ()
+             (let ((n (get-bytevector-n! port bv 0
+                                         (bytevector-length bv))))
+               (unless (eof-object? n)
+                 (loop))))))
+
+       ;; Upon completion, write an sexp that denotes the status.
+       (write
+        (catch #t
+          (lambda ()
+            (guard (c ((nix-protocol-error? c)
+                       ;; Consume all the input since the only time we can
+                       ;; report the error is after everything has been
+                       ;; consumed.
+                       (consume-input (current-input-port))
+                       (list 'protocol-error (nix-protocol-error-message c))))
+              (with-store store
+                (setvbuf (current-input-port) _IONBF)
+                (import-paths store (current-input-port))
+                '(success))))
+          (lambda args
+            (cons 'error args))))))
+
+  (open-remote-pipe session
+                    (string-join
+                     `("guile" "-c"
+                       ,(object->string (object->string import))))
+                    OPEN_BOTH))
 
 (define* (store-export-channel session files
                                #:key recursive?)
@@ -224,10 +245,29 @@ Return the list of store items actually sent."
     ;; mark of 'export-paths' would be enough, but in practice it's not.)
     (channel-send-eof port)
 
-    ;; Wait for completion of the remote process.
-    (let ((result (zero? (channel-get-exit-status port))))
+    ;; Wait for completion of the remote process and read the status sexp from
+    ;; PORT.
+    (let* ((result (false-if-exception (read port)))
+           (status (zero? (channel-get-exit-status port))))
       (close-port port)
-      missing)))
+      (match result
+        (('success . _)
+         missing)
+        (('protocol-error message)
+         (raise (condition
+                 (&nix-protocol-error (message message) (status 42)))))
+        (('error key args ...)
+         (raise (condition
+                 (&nix-protocol-error
+                  (message (call-with-output-string
+                             (lambda (port)
+                               (print-exception port #f key args))))
+                  (status 43)))))
+        (_
+         (raise (condition
+                 (&nix-protocol-error
+                  (message "unknown error while sending files over SSH")
+                  (status 44)))))))))
 
 (define (remote-store-session remote)
   "Return the SSH channel beneath REMOTE, a remote store as returned by