Only use GC protection when gnutls won't internally retry

2 files changed, 29 insertions, 4 deletions

diff --git a/guix-build-coordinator/agent-messaging/http.scm b/guix-build-coordinator/agent-messaging/http.scm
index 531df57..21b64d1 100644
--- a/guix-build-coordinator/agent-messaging/http.scm
+++ b/guix-build-coordinator/agent-messaging/http.scm
@@ -38,6 +38,9 @@
   #:use-module (web response)
   #:use-module (web uri)
   #:use-module (lzlib)
+  #:use-module ((gnutls) #:select (gnutls-version))
+  #:use-module ((guix config) #:select (%guix-version))
+  #:use-module ((guix utils) #:select (version>=?))
   #:use-module (prometheus)
   #:use-module (guix store)
   #:use-module (guix base64)
@@ -65,6 +68,22 @@
 (define (make-http-agent-interface coordinator-uri
                                    agent-uuid
                                    password)
+  (let* ((gnutls-ver (gnutls-version))
+         (guix-ver   %guix-version)
+         (gnutls-probably-retries-on-gc?
+          (or (version>=? gnutls-ver "3.7.3")
+              ;; guix patched gnutls to retry when interrupted by gc before
+              ;; gnutls released the change
+              (version>=? guix-ver "1.3.0-14"))))
+    (simple-format (current-error-port)
+                   "gc protection ~A (gnutls version: ~A, guix version: ~A)\n"
+                   (if gnutls-probably-retries-on-gc?
+                       "disabled"
+                       "enabled")
+                   gnutls-ver
+                   guix-ver)
+    (use-gc-protection? (not gnutls-probably-retries-on-gc?)))
+
   (make <http-agent-interface>
     #:coordinator-uri coordinator-uri
     #:agent-uuid agent-uuid
diff --git a/guix-build-coordinator/utils.scm b/guix-build-coordinator/utils.scm
index 4c6d507..4eacf37 100644
--- a/guix-build-coordinator/utils.scm
+++ b/guix-build-coordinator/utils.scm
@@ -36,6 +36,7 @@
 
             make-base64-output-port
 
+            use-gc-protection?
             with-gc-protection
 
             request-query-parameters
@@ -274,11 +275,16 @@ upcoming chunk."
              (parse-query-string query))
         '())))
 
+(define use-gc-protection?
+  (make-parameter #t))
+
 (define (with-gc-protection thunk)
-  (dynamic-wind
-    gc-disable
-    thunk
-    gc-enable))
+  (if (use-gc-protection?)
+      (dynamic-wind
+        gc-disable
+        thunk
+        gc-enable)
+      (thunk)))
 
 (define* (make-chunked-output-port* port #:key (keep-alive? #f)
                                     (buffering 1200)