From 90c98b5a89038c41a0db0add9e2a3d4d1a1b6102 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 23 Aug 2019 18:16:13 +0200 Subject: swh: 'swh-download' checks return value of 'vault-fetch'. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Reported by Björn Höfling in . * 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 df2a138f04..1c416c8dd5 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))) -- cgit v1.2.3