lint: 'check-github-url' uses our own 'open-connection-for-uri'.
Fixes <https://bugs.gnu.org/35053>. Reported by Efraim Flashner <efraim@flashner.co.il>. Previously 'check-github-url' would let Guile 2.2's (web client) module take care of opening the connection. Consequently, it wouldn't use the TLS priority strings that we use in (guix build download), 'open-connection-for-uri'. In particular, it would not disable TLSv1.3, which would trigger <https://bugs.gnu.org/34102> for github.com. * guix/scripts/lint.scm (check-github-url): Add #:timeout parameter. [follow-redirect]: Change parameter name to 'url' and pass it to 'string->uri'. Call 'guix:open-connection-for-uri' to open the connection and pass it to 'http-head' via #:port.
This commit is contained in:
parent
bd5b6ce0d7
commit
702c3c7dab
1 changed files with 6 additions and 4 deletions
|
@ -45,7 +45,6 @@ (define-module (guix scripts lint)
|
|||
#:use-module (guix cve)
|
||||
#:use-module (gnu packages)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (ice-9 receive)
|
||||
#:use-module (ice-9 regex)
|
||||
#:use-module (ice-9 format)
|
||||
#:use-module (web client)
|
||||
|
@ -796,10 +795,13 @@ (define (check-mirror-uri uri) ;XXX: could be optimized
|
|||
(let ((uris (origin-uris origin)))
|
||||
(for-each check-mirror-uri uris)))))
|
||||
|
||||
(define (check-github-url package)
|
||||
(define* (check-github-url package #:key (timeout 3))
|
||||
"Check whether PACKAGE uses source URLs that redirect to GitHub."
|
||||
(define (follow-redirect uri)
|
||||
(receive (response body) (http-head uri)
|
||||
(define (follow-redirect url)
|
||||
(let* ((uri (string->uri url))
|
||||
(port (guix:open-connection-for-uri uri #:timeout timeout))
|
||||
(response (http-head uri #:port port)))
|
||||
(close-port port)
|
||||
(case (response-code response)
|
||||
((301 302)
|
||||
(uri->string (assoc-ref (response-headers response) 'location)))
|
||||
|
|
Loading…
Reference in a new issue