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'.master
parent
8786c2e8d7
commit
a8d3033da6
|
@ -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))
|
||||
|
|
|
@ -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
|
||||
|
|
Reference in New Issue