From a8d3033da61958c53c44dd5db90672bfc4533ef9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Thu, 3 Mar 2022 21:40:21 +0100 Subject: [PATCH] import: github: Reuse HTTP connection for the /tags URL fallback. * 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 --git a/.dir-locals.el b/.dir-locals.el index 6ebf61370e..09e19223d5 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 f3a1b1c5c4..51118d1d39 100644 --- a/guix/import/github.scm +++ b/guix/import/github.scm @@ -33,6 +33,7 @@ #: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) @@ -229,18 +230,23 @@ Alternatively, you can wait until your rate limit is reset, or use the (_ (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