diff mbox series

[bug#54241,4/4] import: github: Reuse HTTP connection for the /tags URL fallback.

Message ID 20220303211444.19928-4-ludo@gnu.org
State Accepted
Headers show
Series 'github' importer gracefully handles rate limiting | expand

Checks

Context Check Description
cbaines/comparison success View comparision
cbaines/git branch success View Git branch
cbaines/applying patch success View Laminar job
cbaines/issue success View issue

Commit Message

Ludovic Courtès March 3, 2022, 9:14 p.m. UTC 
* guix/import/github.scm (fetch-releases-or-tags): Call
'open-connection-for-uri' and reuse the same connection for the two
'http-fetch' calls.
* .dir-locals.el (scheme-mode): Add 'call-with-port'.
---
 .dir-locals.el         |  1 +
 guix/import/github.scm | 30 ++++++++++++++++++------------
 2 files changed, 19 insertions(+), 12 deletions(-)
diff mbox series

Patch

diff --git a/.dir-locals.el b/.dir-locals.el
index 0edf2a8d23..bee745cc27 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -52,6 +52,7 @@ 
    (eval . (put 'test-equal 'scheme-indent-function 1))
    (eval . (put 'test-eq 'scheme-indent-function 1))
    (eval . (put 'call-with-input-string 'scheme-indent-function 1))
+   (eval . (put 'call-with-port 'scheme-indent-function 1))
    (eval . (put 'guard 'scheme-indent-function 1))
    (eval . (put 'lambda* 'scheme-indent-function 1))
    (eval . (put 'substitute* 'scheme-indent-function 1))
diff --git a/guix/import/github.scm b/guix/import/github.scm
index 5062bad80d..84f70eed0f 100644
--- a/guix/import/github.scm
+++ b/guix/import/github.scm
@@ -33,6 +33,7 @@  (define-module (guix import github)
   #:use-module ((guix ui) #:select (display-hint))
   #:use-module ((guix download) #:prefix download:)
   #:use-module ((guix git-download) #:prefix download:)
+  #:autoload   (guix build download) (open-connection-for-uri)
   #:use-module (guix import utils)
   #:use-module (json)
   #:use-module (guix packages)
@@ -226,18 +227,23 @@  (define headers
                     (_
                      (raise c)))))
 
-         (let* ((port   (http-fetch release-url #:headers headers))
-                (result (json->scm port)))
-           (close-port port)
-           (match result
-             (#()
-              ;; We got the empty list, presumably because the user didn't use GitHub's
-              ;; "release" mechanism, but hopefully they did use Git tags.
-              (let* ((port (http-fetch tag-url #:headers headers))
-                     (json (json->scm port)))
-                (close-port port)
-                json))
-             (x x))))))
+         (let ((release-uri (string->uri release-url)))
+           (call-with-port (open-connection-for-uri release-uri)
+             (lambda (connection)
+               (let* ((result (json->scm
+                               (http-fetch release-uri
+                                           #:port connection
+                                           #:keep-alive? #t
+                                           #:headers headers))))
+                 (match result
+                   (#()
+                    ;; We got the empty list, presumably because the user didn't use GitHub's
+                    ;; "release" mechanism, but hopefully they did use Git tags.
+                    (json->scm (http-fetch tag-url
+                                           #:port connection
+                                           #:keep-alive? #t
+                                           #:headers headers)))
+                   (x x)))))))))
 
 (define (latest-released-version url package-name)
   "Return the newest released version and its tag given a string URL like