diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2022-03-03 21:40:21 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2022-03-06 22:49:47 +0100 |
| commit | a8d3033da61958c53c44dd5db90672bfc4533ef9 (patch) | |
| tree | 62050d754601dd171ee44b5541bfaed31267230d | |
| parent | 8786c2e8d7585d4a55b1392093b9839f58bd4c3d (diff) | |
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'.
| -rw-r--r-- | .dir-locals.el | 1 | ||||
| -rw-r--r-- | guix/import/github.scm | 30 |
2 files changed, 19 insertions, 12 deletions
diff --git a/.dir-locals.el b/.dir-locals.el index 6ebf61370ee..09e19223d50 100644 --- a/.dir-locals.el +++ b/.dir-locals.el | |||
| @@ -52,6 +52,7 @@ | |||
| 52 | (eval . (put 'test-equal 'scheme-indent-function 1)) | 52 | (eval . (put 'test-equal 'scheme-indent-function 1)) |
| 53 | (eval . (put 'test-eq 'scheme-indent-function 1)) | 53 | (eval . (put 'test-eq 'scheme-indent-function 1)) |
| 54 | (eval . (put 'call-with-input-string 'scheme-indent-function 1)) | 54 | (eval . (put 'call-with-input-string 'scheme-indent-function 1)) |
| 55 | (eval . (put 'call-with-port 'scheme-indent-function 1)) | ||
| 55 | (eval . (put 'guard 'scheme-indent-function 1)) | 56 | (eval . (put 'guard 'scheme-indent-function 1)) |
| 56 | (eval . (put 'lambda* 'scheme-indent-function 1)) | 57 | (eval . (put 'lambda* 'scheme-indent-function 1)) |
| 57 | (eval . (put 'substitute* 'scheme-indent-function 1)) | 58 | (eval . (put 'substitute* 'scheme-indent-function 1)) |
diff --git a/guix/import/github.scm b/guix/import/github.scm index f3a1b1c5c4d..51118d1d394 100644 --- a/guix/import/github.scm +++ b/guix/import/github.scm | |||
| @@ -33,6 +33,7 @@ | |||
| 33 | #:use-module ((guix ui) #:select (display-hint)) | 33 | #:use-module ((guix ui) #:select (display-hint)) |
| 34 | #:use-module ((guix download) #:prefix download:) | 34 | #:use-module ((guix download) #:prefix download:) |
| 35 | #:use-module ((guix git-download) #:prefix download:) | 35 | #:use-module ((guix git-download) #:prefix download:) |
| 36 | #:autoload (guix build download) (open-connection-for-uri) | ||
| 36 | #:use-module (guix import utils) | 37 | #:use-module (guix import utils) |
| 37 | #:use-module (json) | 38 | #:use-module (json) |
| 38 | #:use-module (guix packages) | 39 | #:use-module (guix packages) |
| @@ -229,18 +230,23 @@ Alternatively, you can wait until your rate limit is reset, or use the | |||
| 229 | (_ | 230 | (_ |
| 230 | (raise c))))) | 231 | (raise c))))) |
| 231 | 232 | ||
| 232 | (let* ((port (http-fetch release-url #:headers headers)) | 233 | (let ((release-uri (string->uri release-url))) |
| 233 | (result (json->scm port))) | 234 | (call-with-port (open-connection-for-uri release-uri) |
| 234 | (close-port port) | 235 | (lambda (connection) |
| 235 | (match result | 236 | (let* ((result (json->scm |
| 236 | (#() | 237 | (http-fetch release-uri |
| 237 | ;; We got the empty list, presumably because the user didn't use GitHub's | 238 | #:port connection |
| 238 | ;; "release" mechanism, but hopefully they did use Git tags. | 239 | #:keep-alive? #t |
| 239 | (let* ((port (http-fetch tag-url #:headers headers)) | 240 | #:headers headers)))) |
| 240 | (json (json->scm port))) | 241 | (match result |
| 241 | (close-port port) | 242 | (#() |
| 242 | json)) | 243 | ;; We got the empty list, presumably because the user didn't use GitHub's |
| 243 | (x x)))))) | 244 | ;; "release" mechanism, but hopefully they did use Git tags. |
| 245 | (json->scm (http-fetch tag-url | ||
| 246 | #:port connection | ||
| 247 | #:keep-alive? #t | ||
| 248 | #:headers headers))) | ||
| 249 | (x x))))))))) | ||
| 244 | 250 | ||
| 245 | (define (latest-released-version url package-name) | 251 | (define (latest-released-version url package-name) |
| 246 | "Return the newest released version and its tag given a string URL like | 252 | "Return the newest released version and its tag given a string URL like |
