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

Reported by Björn Höfling <bjoern.hoefling@bjoernhoefling.de>
in <https://bugs.gnu.org/36931>.

* guix/swh.scm (swh-download): Check whether 'vault-fetch' return false
before calling 'dump-port'.
master
Ludovic Courtès 2019-08-23 18:16:13 +02:00
parent b908fcd8c0
commit 90c98b5a89
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 16 additions and 13 deletions

View File

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