[PATCH 0/3] Git progress report and proxy support

  • Done
  • quality assurance status badge
Details
One participant
  • Ludovic Courtès
Owner
unassigned
Submitted by
Ludovic Courtès
Severity
normal
L
L
Ludovic Courtès wrote on 12 Oct 2020 22:49
(address . guix-patches@gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
20201012204957.8320-1-ludo@gnu.org
Hello Guix!

This patch series closes two gaps:

1. Lack of HTTP/HTTPS proxy support for Git clones/fetches as
made by ‘guix pull’, ‘--with-branch’, etc.

2. Lack of progress report for clones/fetches, which is a serious
issue for big repos like that of Guix, which can take a couple
of minutes to fetch: https://issues.guix.gnu.org/39260.
This is also the first experience of ‘guix pull’ that people
have: seemingly nothing happens during a couple of minutes.

I tested it with Guile-Git commit d418a854a3785b9ae96741f4c755517e29224197,
which should become 0.4.0 soonish.

Ludo’.

Ludovic Courtès (3):
git: Require Guile-Git 0.3.0 or later.
git: Display a progress bar while fetching a repo.
git: Support HTTP and HTTPS proxies.

configure.ac | 5 ++
doc/guix.texi | 4 +-
guix/git.scm | 140 ++++++++++++++++++++++++++++----------------------
m4/guix.m4 | 22 ++++++++
4 files changed, 109 insertions(+), 62 deletions(-)

--
2.28.0
L
L
Ludovic Courtès wrote on 12 Oct 2020 23:09
[PATCH 1/3] git: Require Guile-Git 0.3.0 or later.
(address . 43968@debbugs.gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
20201012210955.8753-1-ludo@gnu.org
* guix/git.scm (auth-supported?): Remove.
(clone*): Inline code that was dependent on AUTH-SUPPORTED?.
(update-cached-checkout): Likewise.
(resolve-reference): Remove check for 'object-lookup-prefix' and use it
unconditionally.
(load-git-submodules): Remove.
(update-submodules): Use 'repository-submodules', 'submodule-lookup',
etc. unconditionally.
(update-cached-checkout): Use 'repository-close!' unconditionally.
* m4/guix.m4 (GUIX_CHECK_GUILE_GIT): New macro.
* configure.ac: Use it and error out when it fails.
* doc/guix.texi (Requirements): Bump to Guile-Git 0.3.0.
---
configure.ac | 5 +++
doc/guix.texi | 4 +--
guix/git.scm | 84 ++++++++++++++-------------------------------------
m4/guix.m4 | 22 ++++++++++++++
4 files changed, 52 insertions(+), 63 deletions(-)

Toggle diff (207 lines)
diff --git a/configure.ac b/configure.ac
index 6861112eaf..6e718afdd1 100644
--- a/configure.ac
+++ b/configure.ac
@@ -144,6 +144,11 @@ if test "x$guix_cv_have_recent_guile_gcrypt" != "xyes"; then
AC_MSG_ERROR([A recent Guile-Gcrypt could not be found; please install it.])
fi
+GUIX_CHECK_GUILE_GIT
+if test "x$guix_cv_have_recent_guile_git" != "xyes"; then
+ AC_MSG_ERROR([A recent Guile-Git could not be found; please install it.])
+fi
+
dnl Check for Guile-zlib.
GUILE_MODULE_AVAILABLE([have_guile_zlib], [(zlib)])
if test "x$have_guile_zlib" != "xyes"; then
diff --git a/doc/guix.texi b/doc/guix.texi
index 7150adeaa8..73156e9492 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -809,8 +809,8 @@ or later;
@item @uref{https://notabug.org/guile-lzlib/guile-lzlib, Guile-lzlib};
@item
@c FIXME: Specify a version number once a release has been made.
-@uref{https://gitlab.com/guile-git/guile-git, Guile-Git}, from August
-2017 or later;
+@uref{https://gitlab.com/guile-git/guile-git, Guile-Git}, version 0.3.0
+or later;
@item @uref{https://savannah.nongnu.org/projects/guile-json/, Guile-JSON}
4.3.0 or later;
@item @url{https://www.gnu.org/software/make/, GNU Make}.
diff --git a/guix/git.scm b/guix/git.scm
index 637936c16a..cfb8d626f5 100644
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -20,6 +20,7 @@
(define-module (guix git)
#:use-module (git)
#:use-module (git object)
+ #:use-module (git submodule)
#:use-module (guix i18n)
#:use-module (guix base32)
#:use-module (gcrypt hash)
@@ -116,10 +117,6 @@ the 'SSL_CERT_FILE' and 'SSL_CERT_DIR' environment variables."
(string-append "R:" url)
url))))))
-;; Authentication appeared in Guile-Git 0.3.0, check if it is available.
-(define auth-supported?
- (false-if-exception (resolve-interface '(git auth))))
-
(define (clone* url directory)
"Clone git repository at URL into DIRECTORY. Upon failure,
make sure no empty directory is left behind."
@@ -127,18 +124,10 @@ make sure no empty directory is left behind."
(lambda ()
(mkdir-p directory)
- ;; Note: Explicitly pass options to work around the invalid default
- ;; value in Guile-Git: <https://bugs.gnu.org/29238>.
- (if (module-defined? (resolve-interface '(git))
- 'clone-init-options)
- (let ((auth-method (and auth-supported?
- (%make-auth-ssh-agent))))
- (clone url directory
- (if auth-supported?
- (make-clone-options
- #:fetch-options (make-fetch-options auth-method))
- (clone-init-options))))
- (clone url directory)))
+ (let ((auth-method (%make-auth-ssh-agent)))
+ (clone url directory
+ (make-clone-options
+ #:fetch-options (make-fetch-options auth-method)))))
(lambda _
(false-if-exception (rmdir directory)))))
@@ -167,12 +156,7 @@ corresponding Git object."
;; read out-of-bounds when passed a string shorter than 40 chars,
;; which is why we delay calls to it below.
(if (< len 40)
- (if (module-defined? (resolve-interface '(git object))
- 'object-lookup-prefix)
- (object-lookup-prefix repository (string->oid commit) len)
- (raise (condition
- (&message
- (message "long Git object ID is required")))))
+ (object-lookup-prefix repository (string->oid commit) len)
(object-lookup repository (string->oid commit)))))
(('tag-or-commit . str)
(if (or (> (string-length str) 40)
@@ -234,40 +218,23 @@ dynamic extent of EXP."
(lambda (key err)
(report-git-error err))))
-(define (load-git-submodules)
- "Attempt to load (git submodules), which was missing until Guile-Git 0.2.0.
-Return true on success, false on failure."
- (match (false-if-exception (resolve-interface '(git submodule)))
- (#f
- (set! load-git-submodules (const #f))
- #f)
- (iface
- (module-use! (resolve-module '(guix git)) iface)
- (set! load-git-submodules (const #t))
- #t)))
-
(define* (update-submodules repository
#:key (log-port (current-error-port)))
"Update the submodules of REPOSITORY, a Git repository object."
- ;; Guile-Git < 0.2.0 did not have (git submodule).
- (if (load-git-submodules)
- (for-each (lambda (name)
- (let ((submodule (submodule-lookup repository name)))
- (format log-port (G_ "updating submodule '~a'...~%")
- name)
- (submodule-update submodule)
+ (for-each (lambda (name)
+ (let ((submodule (submodule-lookup repository name)))
+ (format log-port (G_ "updating submodule '~a'...~%")
+ name)
+ (submodule-update submodule)
- ;; Recurse in SUBMODULE.
- (let ((directory (string-append
- (repository-working-directory repository)
- "/" (submodule-path submodule))))
- (with-repository directory repository
- (update-submodules repository
- #:log-port log-port)))))
- (repository-submodules repository))
- (format (current-error-port)
- (G_ "Support for submodules is missing; \
-please upgrade Guile-Git.~%"))))
+ ;; Recurse in SUBMODULE.
+ (let ((directory (string-append
+ (repository-working-directory repository)
+ "/" (submodule-path submodule))))
+ (with-repository directory repository
+ (update-submodules repository
+ #:log-port log-port)))))
+ (repository-submodules repository)))
(define-syntax-rule (false-if-git-not-found exp)
"Evaluate EXP, returning #false if a GIT_ENOTFOUND error is raised."
@@ -331,12 +298,9 @@ it unchanged."
;; Only fetch remote if it has not been cloned just before.
(when (and cache-exists?
(not (reference-available? repository ref)))
- (if auth-supported?
- (let ((auth-method (and auth-supported?
- (%make-auth-ssh-agent))))
- (remote-fetch (remote-lookup repository "origin")
- #:fetch-options (make-fetch-options auth-method)))
- (remote-fetch (remote-lookup repository "origin"))))
+ (let ((auth-method (%make-auth-ssh-agent)))
+ (remote-fetch (remote-lookup repository "origin")
+ #:fetch-options (make-fetch-options auth-method))))
(when recursive?
(update-submodules repository #:log-port log-port))
@@ -359,9 +323,7 @@ it unchanged."
;; Reclaim file descriptors and memory mappings associated with
;; REPOSITORY as soon as possible.
- (when (module-defined? (resolve-interface '(git repository))
- 'repository-close!)
- (repository-close! repository))
+ (repository-close! repository)
(values cache-directory (oid->string oid) relation)))))
diff --git a/m4/guix.m4 b/m4/guix.m4
index 2fcc65e039..4fa7cdf737 100644
--- a/m4/guix.m4
+++ b/m4/guix.m4
@@ -204,6 +204,28 @@ AC_DEFUN([GUIX_CHECK_GUILE_GCRYPT], [
fi])
])
+dnl GUIX_CHECK_GUILE_GIT
+dnl
+dnl Check whether a recent-enough Guile-Git is available.
+AC_DEFUN([GUIX_CHECK_GUILE_GIT], [
+ dnl Check whether we're using Guile-Git 0.3.0 or later. 0.3.0
+ dnl introduced SSH authentication support and more.
+ AC_CACHE_CHECK([whether Guile-Git is available and recent enough],
+ [guix_cv_have_recent_guile_git],
+ [GUILE_CHECK([retval],
+ [(use-modules (git) (git auth) (git submodule))
+ (let ((auth (%make-auth-ssh-agent)))
+ repository-close!
+ object-lookup-prefix
+ (make-clone-options
+ #:fetch-options (make-fetch-options auth)))])
+ if test "$retval" = 0; then
+ guix_cv_have_recent_guile_git="yes"
+ else
+ guix_cv_have_recent_guile_git="no"
+ fi])
+])
+
dnl GUIX_TEST_ROOT_DIRECTORY
AC_DEFUN([GUIX_TEST_ROOT_DIRECTORY], [
AC_CACHE_CHECK([for unit test root directory],
--
2.28.0
L
L
Ludovic Courtès wrote on 12 Oct 2020 23:09
[PATCH 3/3] git: Support HTTP and HTTPS proxies.
(address . 43968@debbugs.gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
20201012210955.8753-3-ludo@gnu.org
This allows 'guix pull' and similar to fetch code over a proxy.

* guix/git.scm (make-default-fetch-options): Pass #:proxy-url.
---
guix/git.scm | 7 +++++--
1 file changed, 5 insertions(+), 2 deletions(-)

Toggle diff (23 lines)
diff --git a/guix/git.scm b/guix/git.scm
index b81a011443..364b4997ae 100644
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -161,11 +161,14 @@ the 'SSL_CERT_FILE' and 'SSL_CERT_DIR' environment variables."
(define (make-default-fetch-options)
"Return the default fetch options."
(let ((auth-method (%make-auth-ssh-agent)))
- ;; The #:transfer-progress option appeared in Guile-Git 0.4.0. Omit it
- ;; when using an older version.
+ ;; The #:transfer-progress and #:proxy-url options appeared in Guile-Git
+ ;; 0.4.0. Omit them when using an older version.
(catch 'wrong-number-of-args
(lambda ()
(make-fetch-options auth-method
+ ;; Guile-Git doesn't distinguish between these.
+ #:proxy-url (or (getenv "http_proxy")
+ (getenv "https_proxy"))
#:transfer-progress
(and (isatty? (current-error-port))
show-progress)))
--
2.28.0
L
L
Ludovic Courtès wrote on 12 Oct 2020 23:09
[PATCH 2/3] git: Display a progress bar while fetching a repo.
(address . 43968@debbugs.gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
20201012210955.8753-2-ludo@gnu.org

This uses the API of the yet-to-be-released Guile-Git 0.4.0. Using an
older version is still possible, but progress report is disabled.

* guix/git.scm (show-progress, make-default-fetch-options): New
procedures.
(clone*, update-cached-checkout): Use it instead of
'make-fetch-options'.
---
guix/git.scm | 59 ++++++++++++++++++++++++++++++++++++++++++++++++++--
1 file changed, 57 insertions(+), 2 deletions(-)

Toggle diff (94 lines)
diff --git a/guix/git.scm b/guix/git.scm
index cfb8d626f5..b81a011443 100644
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -31,7 +31,9 @@
#:use-module (guix gexp)
#:use-module (guix sets)
#:use-module ((guix diagnostics) #:select (leave))
+ #:use-module (guix progress)
#:use-module (rnrs bytevectors)
+ #:use-module (ice-9 format)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
@@ -117,6 +119,59 @@ the 'SSL_CERT_FILE' and 'SSL_CERT_DIR' environment variables."
(string-append "R:" url)
url))))))
+(define (show-progress progress)
+ "Display a progress bar as we fetch Git code. PROGRESS is an
+<indexer-progress> record from (git)."
+ (define total
+ (indexer-progress-total-objects progress))
+
+ (define hundredth
+ (match (quotient (indexer-progress-total-objects progress) 100)
+ (0 1)
+ (x x)))
+
+ (define-values (done label)
+ (if (< (indexer-progress-received-objects progress) total)
+ (values (indexer-progress-received-objects progress)
+ (G_ "receiving objects"))
+ (values (indexer-progress-indexed-objects progress)
+ (G_ "indexing objects"))))
+
+ (define %
+ (* 100. (/ done total)))
+
+ (when (and (< % 100) (zero? (modulo done hundredth)))
+ (erase-current-line (current-error-port))
+ (let ((width (max (- (current-terminal-columns)
+ (string-length label) 7)
+ 3)))
+ (format (current-error-port) "~a ~3,d% ~a"
+ label (inexact->exact (round %))
+ (progress-bar % width)))
+ (force-output (current-error-port)))
+
+ (when (= % 100.)
+ ;; We're done, erase the line.
+ (erase-current-line (current-error-port))
+ (force-output (current-error-port)))
+
+ ;; Return true to indicate that we should go on.
+ #t)
+
+(define (make-default-fetch-options)
+ "Return the default fetch options."
+ (let ((auth-method (%make-auth-ssh-agent)))
+ ;; The #:transfer-progress option appeared in Guile-Git 0.4.0. Omit it
+ ;; when using an older version.
+ (catch 'wrong-number-of-args
+ (lambda ()
+ (make-fetch-options auth-method
+ #:transfer-progress
+ (and (isatty? (current-error-port))
+ show-progress)))
+ (lambda args
+ (make-fetch-options auth-method)))))
+
(define (clone* url directory)
"Clone git repository at URL into DIRECTORY. Upon failure,
make sure no empty directory is left behind."
@@ -127,7 +182,7 @@ make sure no empty directory is left behind."
(let ((auth-method (%make-auth-ssh-agent)))
(clone url directory
(make-clone-options
- #:fetch-options (make-fetch-options auth-method)))))
+ #:fetch-options (make-default-fetch-options)))))
(lambda _
(false-if-exception (rmdir directory)))))
@@ -300,7 +355,7 @@ it unchanged."
(not (reference-available? repository ref)))
(let ((auth-method (%make-auth-ssh-agent)))
(remote-fetch (remote-lookup repository "origin")
- #:fetch-options (make-fetch-options auth-method))))
+ #:fetch-options (make-default-fetch-options))))
(when recursive?
(update-submodules repository #:log-port log-port))
--
2.28.0
L
L
Ludovic Courtès wrote on 22 Oct 2020 17:12
Re: [bug#43968] [PATCH 0/3] Git progress report and proxy support
(address . 43968-done@debbugs.gnu.org)
87lffys3ab.fsf@gnu.org
Ludovic Courtès <ludo@gnu.org> skribis:

Toggle quote (4 lines)
> git: Require Guile-Git 0.3.0 or later.
> git: Display a progress bar while fetching a repo.
> git: Support HTTP and HTTPS proxies.

Pushed as 8425a9b60a75d95000634bee518d9fd1cf1b4d8b.

Ludo'.
Closed
?
Your comment

This issue is archived.

To comment on this conversation send an email to 43968@debbugs.gnu.org

To respond to this issue using the mumi CLI, first switch to it
mumi current 43968
Then, you may apply the latest patchset in this issue (with sign off)
mumi am -- -s
Or, compose a reply to this issue
mumi compose
Or, send patches to this issue
mumi send-email *.patch