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

swh: 'swh-download' prints debugging info.

Browse source 
* 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 @@ (define recursive?
;; As a last resort, attempt to download from Software Heritage.
;; XXX: Currently recursive checkouts are not supported.
(and (not recursive?)
(swh-download (getenv "git url") (getenv "git commit")
#$output)))))))
(begin
(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)))
(gexp->derivation (or name "git-checkout") build

12
guix/swh.scm
View file

@ -533,7 +533,8 @@ (define (call-with-temporary-directory proc) ;FIXME: factorize
(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 @@ (define (swh-download url reference output)
(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" "-")))