diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2019-08-28 11:10:55 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2019-08-28 18:52:51 +0200 |
| commit | b8815c5ec4ee70c535693031072447671c1b781f (patch) | |
| tree | 97eff13a5bfde5c4e47dfe6d5e11c73dfa5cdf44 | |
| parent | c6deb680e263b637a27fc6cc7782fdbf5485623e (diff) | |
| download | 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.
| -rw-r--r-- | guix/git-download.scm | 7 | ||||
| -rw-r--r-- | guix/swh.scm | 12 |
2 files changed, 15 insertions, 4 deletions
diff --git a/guix/git-download.scm b/guix/git-download.scm index 8f84681d46..c62bb8ad0f 100644 --- a/guix/git-download.scm +++ b/guix/git-download.scm @@ -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. ;; 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 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" "-"))) |