ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

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

Browse source 
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
Show stats Download patch file Download diff file Expand all files Collapse all files

29
guix/swh.scm
View file

@ -547,19 +547,22 @@ (define (swh-download url reference output)
((? 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)))