mirror/guix
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2025-01-18 21:46:35 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

import: github: Reuse HTTP connection for the /tags URL fallback.

Browse source 
* 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'.
This commit is contained in:
Ludovic Courtès 2022-03-03 21:40:21 +01:00
parent 8786c2e8d7
commit a8d3033da6
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 19 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
.dir-locals.el
View file

@ -52,6 +52,7 @@
(eval . (put 'test-equal 'scheme-indent-function 1)) (eval . (put 'test-equal 'scheme-indent-function 1))
(eval . (put 'test-eq '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-input-string 'scheme-indent-function 1))
(eval . (put 'call-with-port 'scheme-indent-function 1))
(eval . (put 'guard 'scheme-indent-function 1)) (eval . (put 'guard 'scheme-indent-function 1))
(eval . (put 'lambda* 'scheme-indent-function 1)) (eval . (put 'lambda* 'scheme-indent-function 1))
(eval . (put 'substitute* 'scheme-indent-function 1)) (eval . (put 'substitute* 'scheme-indent-function 1))

30
guix/import/github.scm
View file

@ -33,6 +33,7 @@ (define-module (guix import github)
#:use-module ((guix ui) #:select (display-hint)) #:use-module ((guix ui) #:select (display-hint))
#:use-module ((guix download) #:prefix download:) #:use-module ((guix download) #:prefix download:)
#:use-module ((guix git-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 (guix import utils)
#:use-module (json) #:use-module (json)
#:use-module (guix packages) #:use-module (guix packages)
@ -229,18 +230,23 @@ (define headers
(_ (_
(raise c))))) (raise c)))))
(let* ((port (http-fetch release-url #:headers headers)) (let ((release-uri (string->uri release-url)))
(result (json->scm port))) (call-with-port (open-connection-for-uri release-uri)
(close-port port) (lambda (connection)
(match result (let* ((result (json->scm
(#() (http-fetch release-uri
;; We got the empty list, presumably because the user didn't use GitHub's #:port connection
;; "release" mechanism, but hopefully they did use Git tags. #:keep-alive? #t
(let* ((port (http-fetch tag-url #:headers headers)) #:headers headers))))
(json (json->scm port))) (match result
(close-port port) (#()
json)) ;; We got the empty list, presumably because the user didn't use GitHub's
(x x)))))) ;; "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) (define (latest-released-version url package-name)
"Return the newest released version and its tag given a string URL like "Return the newest released version and its tag given a string URL like