nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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.
This commit is contained in:
Ludovic Courtès 2019-08-28 11:10:55 +02:00
parent c6deb680e2
commit b8815c5ec4
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 15 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
guix/git-download.scm
View File

@ -139,8 +139,11 @@ HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if #f."
;; As a last resort, attempt to download from Software Heritage. ;; As a last resort, attempt to download from Software Heritage.
;; XXX: Currently recursive checkouts are not supported. ;; XXX: Currently recursive checkouts are not supported.
(and (not recursive?) (and (not recursive?)
(swh-download (getenv "git url") (getenv "git commit") (begin
#$output))))))) (format (current-error-port)
"Trying to download from Software Heritage...~%")
(swh-download (getenv "git url") (getenv "git commit")
#$output))))))))
(mlet %store-monad ((guile (package->derivation guile system))) (mlet %store-monad ((guile (package->derivation guile system)))
(gexp->derivation (or name "git-checkout") build (gexp->derivation (or name "git-checkout") build

12
guix/swh.scm
View File

@ -533,7 +533,8 @@ delete it when leaving the dynamic extent of this call."
(lambda () (lambda ()
(false-if-exception (delete-file-recursively tmp-dir)))))) (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 "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 REFERENCE originating from URL, and unpack it in OUTPUT. Return #t on success
and #f on failure. and #f on failure.
@ -545,10 +546,17 @@ wait until it becomes available, which could take several minutes."
(lookup-revision reference) (lookup-revision reference)
(lookup-origin-revision url reference)) (lookup-origin-revision url reference))
((? revision? revision) ((? 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 (call-with-temporary-directory
(lambda (directory) (lambda (directory)
(match (vault-fetch (revision-directory revision) 'directory) (match (vault-fetch (revision-directory revision) 'directory
#:log-port log-port)
(#f (#f
(format log-port
"SWH: directory ~a could not be fetched from the vault~%"
(revision-directory revision))
#f) #f)
((? port? input) ((? port? input)
(let ((tar (open-pipe* OPEN_WRITE "tar" "-C" directory "-xzvf" "-"))) (let ((tar (open-pipe* OPEN_WRITE "tar" "-C" directory "-xzvf" "-")))