(address . guix-patches@gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
ee9f2c11ccbaf92d8d63442f3bff6e447bb8ba61.1729255954.git.ludo@gnu.org
* guix/git.scm (set-git-timeouts): New procedure.
(update-cached-checkout): Add #:connection-timeout and #:read-timeout.
Call ‘set-git-timeouts’.
Change-Id: Ibbd4fc6104ce66afed880b3975c129abbc2ab755
---
guix/git.scm | 23 ++++++++++++++++++++++-
1 file changed, 22 insertions(+), 1 deletion(-)
Toggle diff (59 lines)
diff --git a/guix/git.scm b/guix/git.scm
index 48a962089d..410cd4c153 100644
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -206,6 +206,19 @@ (define GITERR_HTTP
(module-ref errors 'GITERR_HTTP)
34)))
+(define (set-git-timeouts connection-timeout read-timeout)
+ "Instruct Guile-Git to honor the given CONNECTION-TIMEOUT and READ-TIMEOUT
+when talking to remote Git servers.
+
+If one of them is #f, the corresponding default setting is kept unchanged."
+ ;; 'set-server-timeout!' & co. were added in Guile-Git 0.9.0.
+ (when (and (defined? 'set-server-connection-timeout!)
+ connection-timeout)
+ (set-server-connection-timeout! connection-timeout))
+ (when (and (defined? 'set-server-timeout!)
+ read-timeout)
+ (set-server-timeout! read-timeout)))
+
(define (clone* url directory)
"Clone git repository at URL into DIRECTORY. Upon failure,
make sure no empty directory is left behind."
@@ -512,6 +525,8 @@ (define (maybe-run-git-gc directory)
(define* (update-cached-checkout url
#:key
+ (connection-timeout 30000)
+ (read-timeout 45000)
(ref '())
recursive?
(check-out? #t)
@@ -533,7 +548,12 @@ (define* (update-cached-checkout url
When RECURSIVE? is true, check out submodules as well, if any.
When CHECK-OUT? is true, reset the cached working tree to REF; otherwise leave
-it unchanged."
+it unchanged.
+
+Wait for up to CONNECTION-TIMEOUT milliseconds when establishing connection to
+the remote server, and for up to READ-TIMEOUT milliseconds when reading from
+it. When zero, use the system defaults for these timeouts; when false, leave
+current settings unchanged."
(define (cache-entries directory)
(filter-map (match-lambda
((or "." "..")
@@ -555,6 +575,7 @@ (define* (update-cached-checkout url
(_ ref)))
(with-libgit2
+ (set-git-timeouts connection-timeout read-timeout)
(let* ((cache-exists? (openable-repository? cache-directory))
(repository (if cache-exists?
(repository-open cache-directory)
base-commit: d95588242c605fbb72e25fe36a0903a1538e9018
--
2.46.0