From: "Ludovic Courtès" <ludo@gnu.org>
To: 44187@debbugs.gnu.org
Cc: "Ludovic Courtès" <ludovic.courtes@inria.fr>
Subject: bug#44187: [PATCH 2/3] git: 'update-cached-checkout' can fall back to SWH when cloning.
Date: Fri, 10 Sep 2021 16:34:14 +0200 [thread overview]
Message-ID: <20210910143415.14783-3-ludo@gnu.org> (raw)
In-Reply-To: <20210910143415.14783-1-ludo@gnu.org>
From: Ludovic Courtès <ludovic.courtes@inria.fr>
Fixes <https://issues.guix.gnu.org/44187>.
Reported by zimoun <zimon.toutoune@gmail.com>.
* guix/git.scm (GITERR_HTTP): New variable.
(clone-from-swh, clone/swh-fallback): New procedures.
(update-cached-checkout): Use 'clone/swh-fallback' instead of 'clone*'.
---
guix/git.scm | 42 +++++++++++++++++++++++++++++++++++++++++-
1 file changed, 41 insertions(+), 1 deletion(-)
diff --git a/guix/git.scm b/guix/git.scm
index acc48fd12f..377e09888a 100644
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -36,6 +36,7 @@
#:use-module (guix sets)
#:use-module ((guix diagnostics) #:select (leave))
#:use-module (guix progress)
+ #:autoload (guix swh) (swh-download)
#:use-module (rnrs bytevectors)
#:use-module (ice-9 format)
#:use-module (ice-9 match)
@@ -180,6 +181,13 @@ the 'SSL_CERT_FILE' and 'SSL_CERT_DIR' environment variables."
(lambda args
(make-fetch-options auth-method)))))
+(define GITERR_HTTP
+ ;; Guile-Git <= 0.5.2 lacks this constant.
+ (let ((errors (resolve-interface '(git errors))))
+ (if (module-defined? errors 'GITERR_HTTP)
+ (module-ref errors 'GITERR_HTTP)
+ 34)))
+
(define (clone* url directory)
"Clone git repository at URL into DIRECTORY. Upon failure,
make sure no empty directory is left behind."
@@ -342,6 +350,38 @@ definitely available in REPOSITORY, false otherwise."
(_
#f)))
+(define (clone-from-swh url tag-or-commit output)
+ "Attempt to clone TAG-OR-COMMIT (a string), which originates from URL, using
+a copy archived at Software Heritage."
+ (call-with-temporary-directory
+ (lambda (bare)
+ (and (swh-download url tag-or-commit bare
+ #:archive-type 'git-bare)
+ (let ((repository (clone* bare output)))
+ (remote-set-url! repository "origin" url)
+ repository)))))
+
+(define (clone/swh-fallback url ref cache-directory)
+ "Like 'clone', but fallback to Software Heritage if the repository cannot be
+found at URL."
+ (define (inaccessible-url-error? err)
+ (let ((class (git-error-class err))
+ (code (git-error-code err)))
+ (or (= class GITERR_HTTP) ;404 or similar
+ (= class GITERR_NET)))) ;unknown host, etc.
+
+ (catch 'git-error
+ (lambda ()
+ (clone* url cache-directory))
+ (lambda (key err)
+ (match ref
+ (((or 'commit 'tag-or-commit) . commit)
+ (if (inaccessible-url-error? err)
+ (or (clone-from-swh url commit cache-directory)
+ (throw key err))
+ (throw key err)))
+ (_ (throw key err))))))
+
(define cached-checkout-expiration
;; Return the expiration time procedure for a cached checkout.
;; TODO: Honor $GUIX_GIT_CACHE_EXPIRATION.
@@ -408,7 +448,7 @@ it unchanged."
(let* ((cache-exists? (openable-repository? cache-directory))
(repository (if cache-exists?
(repository-open cache-directory)
- (clone* url cache-directory))))
+ (clone/swh-fallback url ref cache-directory))))
;; Only fetch remote if it has not been cloned just before.
(when (and cache-exists?
(not (reference-available? repository ref)))
--
2.33.0
next prev parent reply other threads:[~2021-09-10 14:38 UTC|newest]
Thread overview: 15+ messages / expand[flat|nested] mbox.gz Atom feed top
2020-10-23 22:17 bug#44187: whishlist: time-machine --channel falls back to SWH zimoun
2021-03-05 14:51 ` Ludovic Courtès
2021-09-10 14:34 ` bug#44187: [PATCH 0/3] Fall back to Software Heritage (SWH) for Git clones Ludovic Courtès
2021-09-10 14:34 ` bug#44187: [PATCH 1/3] swh: Support downloads of bare Git repositories Ludovic Courtès
2021-09-17 17:31 ` bug#44187: Channel clones lack SWH fallback zimoun
2021-09-18 10:05 ` Ludovic Courtès
2021-09-18 10:27 ` zimoun
2021-09-10 14:34 ` Ludovic Courtès [this message]
2021-09-10 14:34 ` bug#44187: [PATCH 3/3] git: 'reference-available?' recognizes 'tag-or-commit' Ludovic Courtès
2021-09-13 16:07 ` bug#44187: [PATCH 0/3] Fall back to Software Heritage (SWH) for Git clones zimoun
2021-09-14 13:37 ` Ludovic Courtès
2021-09-17 8:02 ` bug#44187: Channel clones lack SWH fallback zimoun
2021-09-18 21:10 ` Ludovic Courtès
2021-09-20 9:27 ` zimoun
2021-09-22 10:03 ` Ludovic Courtès
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20210910143415.14783-3-ludo@gnu.org \
--to=ludo@gnu.org \
--cc=44187@debbugs.gnu.org \
--cc=ludovic.courtes@inria.fr \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/guix.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.