bug#45174: ‘guix substitute’ doesn’t handle HTTP redirects

[Julien Lepiller <julien@lepiller.eu>]

[-- Attachment #1: Type: text/plain, Size: 3578 bytes --]

Le Fri, 11 Dec 2020 10:50:36 +0100,
Ludovic Courtès <ludovic.courtes@inria.fr> a écrit :

> Hi!
> 
> As reported by mange on #guix, it seems that ‘guix substitute’ does
> not follow redirects:
> 
> --8<---------------cut here---------------start------------->8---
> $ guix weather icecat emacs --substitute-urls=https://ci.guix.gnu.org
> computing 2 package derivations for x86_64-linux...
> looking for 2 store items on https://ci.guix.gnu.org...
> updating substitutes from 'https://ci.guix.gnu.org'... 100.0%
> https://ci.guix.gnu.org
>   100.0% substitutes available (2 out of 2)
>   at least 201.3 MiB of nars (compressed)
>   293.5 MiB on disk (uncompressed)
>   0.084 seconds per request (0.2 seconds in total)
>   11.9 requests per second
> 
>   at least 1,000 queued builds
>       x86_64-linux: 368 (36.8%)
>       i686-linux: 556 (55.6%)
>       armhf-linux: 6 (.6%)
>       aarch64-linux: 69 (6.9%)
>       i586-gnu: 1 (.1%)
>   build rate: 154.41 builds per hour
>       i686-linux: 40.77 builds per hour
>       x86_64-linux: 37.06 builds per hour
>       armhf-linux: 40.30 builds per hour
>       aarch64-linux: 35.83 builds per hour
>       i586-gnu: 0.55 builds per hour
> $ guix weather icecat emacs --substitute-urls=https://ci.guix.info
> computing 2 package derivations for x86_64-linux...
> looking for 2 store items on https://ci.guix.info...
> updating substitutes from 'https://ci.guix.info'... 100.0%
> https://ci.guix.info
>   0.0% substitutes available (0 out of 2)
>   unknown substitute sizes
>   0.0 MiB on disk (uncompressed)
>   0.069 seconds per request (0.1 seconds in total)
>   14.4 requests per second
> ni sekvas la redirektigon al 'https://ci.guix.gnu.org/api/queue'...
>   'https://ci.guix.gnu.org/api/queue' returned 500 ("Internal Server
> Error") --8<---------------cut
> here---------------end--------------->8---
> 
> This might explain things like <https://issues.guix.gnu.org/45051>.
> 
> (*.guix.info were turned into HTTP redirects a few days ago, see
> <https://git.savannah.gnu.org/cgit/guix/maintenance.git/commit/?id=c85e128e11d3ba060ae3a6e01da20f531b42d6ef>.)
> 
> Ludo’.
> 
> 
> 

Here is a patch to fix that issue. Since ci.guix.info now returns 200,
it's difficult to test the patch. I created a location block on my
website to redirect lepiller.eu/*.narinfo -> ci.guix.gnu.org/*.narinfo.
Here's the result:

$ guix weather icecat emacs --substitute-urls=https://lepiller.eu
calcul de 2 dérivations de paquets pour x86_64-linux…
recherche de 2 éléments du dépôt sur https://lepiller.eu...
mise à jour des substituts depuis « https://lepiller.eu »... 100.0 %
https://lepiller.eu
  0.0 % des substituts sont disponibles (0 sur 2)
  taille des substituts inconnue
  0,0 Mo sur le disque (décompressé)
  0,207 secondes par requête (0,4 secondes en tout)
  4,8 requêtes par seconde


$ ./pre-inst-env guix weather icecat emacs
--substitute-urls=https://lepiller.eu
computing 2 package derivations for x86_64-linux...
looking for 2 store items on https://lepiller.eu...
updating substitutes from 'https://lepiller.eu'... 100.0%
https://lepiller.eu
  100.0% substitutes available (2 out of 2)
  at least 201,3 MiB of nars (compressed)
  293,5 MiB on disk (uncompressed)
  0,525 seconds per request (1,1 seconds in total)
  1,9 requests per second


(note that I didn't redirect the ci API on my server, so the rest of the
weather command fails with a backtrace, but it's unrelated to this
patch and this issue).

[-- Attachment #2: 0001-substitute-Follow-narinfo-redirections.patch --]
[-- Type: text/x-patch, Size: 3117 bytes --]

From f20e01f2a8df538519660772a7431b53d650d64f Mon Sep 17 00:00:00 2001
From: Julien Lepiller <julien@lepiller.eu>
Date: Tue, 12 Jan 2021 18:07:25 +0100
Subject: [PATCH] substitute: Follow narinfo redirections.

* guix/scripts/substitute.scm (fetch-narinfos): Follow redirections.
---
 guix/scripts/substitute.scm | 38 +++++++++++++++++++++++++++----------
 1 file changed, 28 insertions(+), 10 deletions(-)

diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index e53de8c304..790168091e 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -663,18 +663,36 @@ port to it, or, if connection failed, print a warning and return #f.  Pass
            (len    (response-content-length response))
            (cache  (response-cache-control response))
            (ttl    (and cache (assoc-ref cache 'max-age))))
-      (update-progress!)
 
       ;; Make sure to read no more than LEN bytes since subsequent bytes may
       ;; belong to the next response.
-      (if (= code 200)                            ; hit
-          (let ((narinfo (read-narinfo port url #:size len)))
-            (if (string=? (dirname (narinfo-path narinfo))
-                          (%store-prefix))
-                (begin
-                  (cache-narinfo! url (narinfo-path narinfo) narinfo ttl)
-                  (cons narinfo result))
-                result))
+      (case code
+        ((200)                            ; hit
+         (update-progress!)
+         (let ((narinfo (read-narinfo port url #:size len)))
+           (if (string=? (dirname (narinfo-path narinfo))
+                         (%store-prefix))
+               (begin
+                 (cache-narinfo! url (narinfo-path narinfo) narinfo ttl)
+                 (cons narinfo result))
+               result)))
+        ((301 302 303 307 308)            ; redirect
+         (let* ((uri (response-location response))
+                (new-request (build-request
+                               uri #:headers '((User-Agent . "GNU Guile")))))
+           (if len
+               (get-bytevector-n port len)
+               (read-to-eof port))
+           (append
+             (http-multiple-get uri
+                                handle-narinfo-response '()
+                                (list new-request)
+                                #:open-connection
+                                open-connection-for-uri/cached
+                                #:verify-certificate? #f)
+             result)))
+        (else
+          (update-progress!)
           (let* ((path      (uri-path (request-uri request)))
                  (hash-part (basename
                              (string-drop-right path 8)))) ;drop ".narinfo"
@@ -685,7 +703,7 @@ port to it, or, if connection failed, print a warning and return #f.  Pass
                             (if (or (= 404 code) (= 202 code))
                                 ttl
                                 %narinfo-transient-error-ttl))
-            result))))
+            result)))))
 
   (define (do-fetch uri)
     (case (and=> uri uri-scheme)
-- 
2.29.2