ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05: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-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))

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 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 @@ (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