02/03: swh: 'swh-download' checks return value of 'vault-fetch'.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 90c98b5a89038c41a0db0add9e2a3d4d1a1b6102
Author: Ludovic Courtès <address@hidden>
Date:   Fri Aug 23 18:16:13 2019 +0200

    swh: 'swh-download' checks return value of 'vault-fetch'.
    
    Reported by Björn Höfling <address@hidden>
    in <https://bugs.gnu.org/36931>.
    
    * guix/swh.scm (swh-download): Check whether 'vault-fetch' return false
    before calling 'dump-port'.
---
 guix/swh.scm | 31 +++++++++++++++++--------------
 1 file changed, 17 insertions(+), 14 deletions(-)

diff --git a/guix/swh.scm b/guix/swh.scm
index df2a138..1c416c8 100644
--- a/guix/swh.scm
+++ b/guix/swh.scm
@@ -547,19 +547,22 @@ wait until it becomes available, which could take several 
minutes."
     ((? revision? revision)
      (call-with-temporary-directory
       (lambda (directory)
-        (let ((input (vault-fetch (revision-directory revision) 'directory))
-              (tar   (open-pipe* OPEN_WRITE "tar" "-C" directory "-xzvf" "-")))
-          (dump-port input tar)
-          (close-port input)
-          (let ((status (close-pipe tar)))
-            (unless (zero? status)
-              (error "tar extraction failure" status)))
-
-          (match (scandir directory)
-            (("." ".." sub-directory)
-             (copy-recursively (string-append directory "/" sub-directory)
-                               output
-                               #:log (%make-void-port "w"))
-             #t))))))
+        (match (vault-fetch (revision-directory revision) 'directory)
+          (#f
+           #f)
+          ((? port? input)
+           (let ((tar (open-pipe* OPEN_WRITE "tar" "-C" directory "-xzvf" 
"-")))
+             (dump-port input tar)
+             (close-port input)
+             (let ((status (close-pipe tar)))
+               (unless (zero? status)
+                 (error "tar extraction failure" status)))
+
+             (match (scandir directory)
+               (("." ".." sub-directory)
+                (copy-recursively (string-append directory "/" sub-directory)
+                                  output
+                                  #:log (%make-void-port "w"))
+                #t))))))))
     (#f
      #f)))