aboutsummaryrefslogtreecommitdiff
path: root/guix/swh.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2019-08-28 11:10:55 +0200
committerLudovic Courtès <ludo@gnu.org>2019-08-28 18:52:51 +0200
commitb8815c5ec4ee70c535693031072447671c1b781f (patch)
tree97eff13a5bfde5c4e47dfe6d5e11c73dfa5cdf44 /guix/swh.scm
parentc6deb680e263b637a27fc6cc7782fdbf5485623e (diff)
downloadguix-b8815c5ec4ee70c535693031072447671c1b781f.tar
guix-b8815c5ec4ee70c535693031072447671c1b781f.tar.gz
swh: 'swh-download' prints debugging info.
* guix/git-download.scm (git-fetch): Print a message before calling 'swh-download'. * guix/swh.scm (swh-download): Add #:log-port. Write debugging messages to LOG-PORT.
Diffstat (limited to 'guix/swh.scm')
-rw-r--r--guix/swh.scm12
1 files changed, 10 insertions, 2 deletions
diff --git a/guix/swh.scm b/guix/swh.scm
index 1c416c8dd5..b72d1c311e 100644
--- a/guix/swh.scm
+++ b/guix/swh.scm
@@ -533,7 +533,8 @@ delete it when leaving the dynamic extent of this call."
(lambda ()
(false-if-exception (delete-file-recursively tmp-dir))))))
-(define (swh-download url reference output)
+(define* (swh-download url reference output
+ #:key (log-port (current-error-port)))
"Download from Software Heritage a checkout of the Git tag or commit
REFERENCE originating from URL, and unpack it in OUTPUT. Return #t on success
and #f on failure.
@@ -545,10 +546,17 @@ wait until it becomes available, which could take several minutes."
(lookup-revision reference)
(lookup-origin-revision url reference))
((? revision? revision)
+ (format log-port "SWH: found revision ~a with directory at '~a'~%"
+ (revision-id revision)
+ (swh-url (revision-directory-url revision)))
(call-with-temporary-directory
(lambda (directory)
- (match (vault-fetch (revision-directory revision) 'directory)
+ (match (vault-fetch (revision-directory revision) 'directory
+ #:log-port log-port)
(#f
+ (format log-port
+ "SWH: directory ~a could not be fetched from the vault~%"
+ (revision-directory revision))
#f)
((? port? input)
(let ((tar (open-pipe* OPEN_WRITE "tar" "-C" directory "-xzvf" "-")))