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'.
This commit is contained in:
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)
(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 (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))))))
(match (scandir directory)
(("." ".." sub-directory)
(copy-recursively (string-append directory "/" sub-directory)
output
#:log (%make-void-port "w"))
#t))))))))
(#f
#f)))