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.

diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index ddad5b7..dc338a1 100644 (file)
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -45,7 +45,6 @@
   #: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 @@ descriptions maintained upstream."
       (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)))