01/09: swh: 'swh-download' prints debugging info.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit b8815c5ec4ee70c535693031072447671c1b781f
Author: Ludovic Courtès <address@hidden>
Date:   Wed Aug 28 11:10:55 2019 +0200

    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.
---
 guix/git-download.scm |  7 +++++--
 guix/swh.scm          | 12 ++++++++++--
 2 files changed, 15 insertions(+), 4 deletions(-)

diff --git a/guix/git-download.scm b/guix/git-download.scm
index 8f84681..c62bb8a 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 1c416c8..b72d1c3 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" 
"-")))