GNU bug report logs - #44187
Channel clones lack SWH fallback

Previous Next

Full log

View this message in rfc822 format

From: Ludovic Courtès <ludo <at> gnu.org>
To: zimoun <zimon.toutoune <at> gmail.com>
Cc: 44187 <at> debbugs.gnu.org
Subject: bug#44187: whishlist: time-machine --channel falls back to SWH
Date: Fri, 05 Mar 2021 15:51:08 +0100

[Message part 1 (text/plain, inline)]

Hi,

zimoun <zimon.toutoune <at> gmail.com> skribis:

> Let’s describe the use case.  Consider that:
>
>   guix time-machine -C channels -- install foo
>
> is provided in some documentation, say scientific paper.  Where the
> channels.scm file is completly described:
>
> (list (channel
>         (name 'kikoo)
>         (url "https://example.org/that-great.git")
>         (commit
>           "353bdae32f72b720c7ddd706576ccc40e2b43f95")))
>
> In the future, if https://example.org/that-great.git disappears, then
> build/install the package ’foo’ is becoming difficult, nor impossible.
>
> However, let’s consider that the repo ’that-great’ had been saved in SWH
> (say manually); since it is a regular Git repo.  Guix should be able to
> fallback to it transparently.

I went head-down to add SWH fallback to ‘latest-repository-commit’… but
that’s of no use because (guix channels) wants a complete clone so that
it can determine commit relations (to detect downgrades).

The SWH vault gives access to checkouts primarily, but it’s also
possible to get a full repo in ‘git fast-import’ format, which is what
we need:

  https://archive.softwareheritage.org/api/1/vault/revision/gitfast/doc/

However, this API will be eventually replaced by some other solution say
SWH developers, possibly a bare Git repo export, so it may not be a good
idea to build upon it.

If we were able, using the SWH API, to map “revisions” to “origins”, we
could find potential mirrors hosting a given commit, but apparently
that’s not possible.

To be continued…

Ludo’.

[Message part 2 (text/x-patch, inline)]

diff --git a/guix/git.scm b/guix/git.scm
index a5103547d3..449011c51a 100644
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -32,6 +32,7 @@
   #:use-module (guix records)
   #:use-module (guix gexp)
   #:use-module (guix sets)
+  #:autoload   (guix swh) (swh-download)
   #:use-module ((guix diagnostics) #:select (leave))
   #:use-module (guix progress)
   #:use-module (rnrs bytevectors)
@@ -459,22 +460,43 @@ Log progress and checkout info to LOG-PORT."
                   (eq? 'regular (stat:type stat))))))
 
   (format log-port "updating checkout of '~a'...~%" url)
-  (let*-values
-      (((checkout commit _)
-        (update-cached-checkout url
-                                #:recursive? recursive?
-                                #:ref ref
-                                #:cache-directory
-                                (url-cache-directory url cache-directory
-                                                     #:recursive?
-                                                     recursive?)
-                                #:log-port log-port))
-       ((name)
-        (url+commit->name url commit)))
-    (format log-port "retrieved commit ~a~%" commit)
-    (values (add-to-store store name #t "sha256" checkout
-                          #:select? (negate dot-git?))
-            commit)))
+
+  (catch 'git-error
+    (lambda ()
+      (let*-values
+          (((checkout commit _)
+            (update-cached-checkout (pk 'l-r-c url)
+                                    #:recursive? recursive?
+                                    #:ref ref
+                                    #:cache-directory
+                                    (url-cache-directory url cache-directory
+                                                         #:recursive?
+                                                         recursive?)
+                                    #:log-port log-port))
+           ((name)
+            (url+commit->name url commit)))
+        (format log-port "retrieved commit ~a~%" commit)
+        (values (add-to-store store name #t "sha256" checkout
+                              #:select? (negate dot-git?))
+                commit)))
+    (lambda (key err . rest)
+      ;; XXX: 'swh-download' currently doesn't support submodules.
+      (when recursive?
+        (apply throw key err rest))
+
+      (pk 'err key err rest)
+      (match ref
+        (('commit . commit)
+         ;; Attempt to fetch COMMIT from SWH.
+         (call-with-temporary-directory
+          (lambda (directory)
+            (unless (swh-download url commit directory)
+              (apply throw key err rest))
+            (values (add-to-store store (url+commit->name url commit)
+                                  #t "sha256" directory)
+                    commit))))
+        (_
+         (apply throw key err rest))))))
 
 (define (print-git-error port key args default-printer)
   (match args

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.