GNU bug report logs - #43968
[PATCH 0/3] Git progress report and proxy support

Previous Next

To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 43968 in the body.
You can then email your comments to 43968 AT debbugs.gnu.org in the normal way.

Toggle the display of automated, internal messages from the tracker.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: guix-patches <at> gnu.org
Cc: Ludovic Courtès <ludo <at> gnu.org>
Subject: [PATCH 0/3] Git progress report and proxy support
Date: Mon, 12 Oct 2020 22:49:57 +0200

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

Message #8 received at 43968 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 43968 <at> debbugs.gnu.org
Cc: Ludovic Courtès <ludo <at> gnu.org>
Subject: [PATCH 1/3] git: Require Guile-Git 0.3.0 or later.
Date: Mon, 12 Oct 2020 23:09:53 +0200

* 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(-)

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

Message #11 received at 43968 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 43968 <at> debbugs.gnu.org
Cc: Ludovic Courtès <ludo <at> gnu.org>
Subject: [PATCH 3/3] git: Support HTTP and HTTPS proxies.
Date: Mon, 12 Oct 2020 23:09:55 +0200

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(-)

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

Message #14 received at 43968 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 43968 <at> debbugs.gnu.org
Cc: Ludovic Courtès <ludo <at> gnu.org>
Subject: [PATCH 2/3] git: Display a progress bar while fetching a repo.
Date: Mon, 12 Oct 2020 23:09:54 +0200

Fixes <https://bugs.gnu.org/39260>.

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(-)

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

Message #19 received at 43968-done <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 43968-done <at> debbugs.gnu.org
Subject: Re: [bug#43968] [PATCH 0/3] Git progress report and proxy support
Date: Thu, 22 Oct 2020 17:12:28 +0200

Ludovic Courtès <ludo <at> gnu.org> skribis:

>   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'.

Previous Next

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