GNU bug report logs - #63646
[PATCH] substitute: If a server's nar URL is 404, try the next one(s).

Previous Next

To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 63646 in the body.
You can then email your comments to 63646 AT debbugs.gnu.org in the normal way.

Toggle the display of automated, internal messages from the tracker.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: guix-patches <at> gnu.org
Cc: Ludovic Courtès <ludo <at> gnu.org>
Subject: [PATCH] substitute: If a server's nar URL is 404, try the next one(s).
Date: Mon, 22 May 2023 17:30:50 +0200

If a substitute server advertises in its narinfo, for example, both a
/zstd and a /lzip URL but the /zstd URL is unreachable, try the /lzip
URL.

Fixes <https://issues.guix.gnu.org/63634>.

* guix/narinfo.scm (narinfo-preferred-uris): New procedure.
(narinfo-best-uri): Rebase on top of it.
* guix/scripts/substitute.scm (download-nar)[try-fetch]: New procedure.
Use 'narinfo-preferred-uris' and 'try-fetch' to attempt all the URLs of
NARINFO.
* tests/substitute.scm (request-substitution): Remove 'parameterize'.
Delete DESTINATION.
("substitute, preferred nar URL is 404, other is 200"): New test.
---
 guix/narinfo.scm            | 21 +++++++++++++++++----
 guix/scripts/substitute.scm | 33 ++++++++++++++++++++++-----------
 tests/substitute.scm        | 36 +++++++++++++++++++++++++++++++-----
 3 files changed, 70 insertions(+), 20 deletions(-)

diff --git a/guix/narinfo.scm b/guix/narinfo.scm
index 741c7ad406..a149d9a901 100644
--- a/guix/narinfo.scm
+++ b/guix/narinfo.scm
@@ -54,6 +54,7 @@ (define-module (guix narinfo)
             narinfo-hash-algorithm+value
 
             narinfo-hash->sha256
+            narinfo-preferred-uris
             narinfo-best-uri
 
             valid-narinfo?
@@ -309,9 +310,11 @@ (define (decompresses-faster? compression1 compression2)
     ("gzip" (string=? compression2 "lzip"))
     (_      #f)))
 
-(define* (narinfo-best-uri narinfo #:key fast-decompression?)
-  "Select the \"best\" URI to download NARINFO's nar, and return three values:
-the URI, its compression method (a string), and the compressed file size.
+(define* (narinfo-preferred-uris narinfo #:key fast-decompression?)
+  "Return the sorted list of \"preferred\" nar URIs from NARINFO (preferred
+comes first) where each entry is a tuple containing: the URI, its compression
+method (a string), and the compressed file size.
+
 When FAST-DECOMPRESSION? is true, prefer substitutes with faster
 decompression (typically zstd) rather than substitutes with a higher
 compression ratio (typically lzip)."
@@ -343,6 +346,16 @@ (define* (narinfo-best-uri narinfo #:key fast-decompression?)
          ((uri2 compression2 . _)
           (decompresses-faster? compression2 compression1))))))
 
-  (match (sort choices (if fast-decompression? (negate speed<?) file-size<?))
+  (sort choices (if fast-decompression? (negate speed<?) file-size<?)))
+
+(define* (narinfo-best-uri narinfo #:key fast-decompression?)
+  "Select the \"best\" URI to download NARINFO's nar, and return three values:
+the URI, its compression method (a string), and the compressed file size.
+
+When FAST-DECOMPRESSION? is true, prefer substitutes with faster
+decompression (typically zstd) rather than substitutes with a higher
+compression ratio (typically lzip)."
+  (match (narinfo-preferred-uris narinfo
+                                 #:fast-decompression? fast-decompression?)
     (((uri compression file-size) _ ...)
      (values uri compression file-size))))
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 0b27ebb0fc..7a612c971c 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -481,18 +481,29 @@ (define* (download-nar narinfo destination
        (leave (G_ "unsupported substitute URI scheme: ~a~%")
               (uri->string uri)))))
 
-  (let ((uri compression file-size
-             (narinfo-best-uri narinfo
-                               #:fast-decompression?
-                               %prefer-fast-decompression?)))
-    (unless print-build-trace?
-      (format (current-error-port)
-              (G_ "Downloading ~a...~%") (uri->string uri)))
+  (define (try-fetch choices)
+    (match choices
+      (((uri compression file-size) rest ...)
+       (guard (c ((and (pair? rest) (network-error? c))
+                  (warning (G_ "download from '~a' failed, trying next URL~%")
+                           (uri->string uri))
+                  (try-fetch rest)))
+         (let ((port download-size (fetch uri)))
+           (unless print-build-trace?
+             (format (current-error-port)
+                     (G_ "Downloading ~a...~%") (uri->string uri)))
+           (values port uri compression download-size))))
+      (()
+       (leave (G_ "no valid nar URLs for ~a at ~a~%")
+              (narinfo-path narinfo)
+              (narinfo-uri-base narinfo)))))
 
-    (let* ((raw download-size
-                ;; 'guix publish' without '--cache' doesn't specify a
-                ;; Content-Length, so DOWNLOAD-SIZE is #f in this case.
-                (fetch uri))
+  (let ((choices (narinfo-preferred-uris narinfo
+                                         #:fast-decompression?
+                                         %prefer-fast-decompression?)))
+    ;; 'guix publish' without '--cache' doesn't specify a Content-Length, so
+    ;; DOWNLOAD-SIZE is #f in this case.
+    (let* ((raw uri compression download-size (try-fetch choices))
            (progress
             (let* ((dl-size  (or download-size
                                  (and (equal? compression "none")
diff --git a/tests/substitute.scm b/tests/substitute.scm
index 9032a50268..8df3938b59 100644
--- a/tests/substitute.scm
+++ b/tests/substitute.scm
@@ -64,11 +64,11 @@ (define-syntax-rule (test-quit name error-rx exp)
 
 (define (request-substitution item destination)
   "Run 'guix substitute --substitute' to fetch ITEM to DESTINATION."
-  (parameterize ((guix-warning-port (current-error-port)))
-    (with-input-from-string (string-append "substitute " item " "
-                                           destination "\n")
-      (lambda ()
-        (guix-substitute "--substitute")))))
+  (false-if-exception (delete-file destination))
+  (with-input-from-string (string-append "substitute " item " "
+                                         destination "\n")
+    (lambda ()
+      (guix-substitute "--substitute"))))
 
 (define %public-key
   ;; This key is known to be in the ACL by default.
@@ -613,6 +613,32 @@ (define-syntax-rule (with-narinfo* narinfo directory body ...)
                 (lambda ()
                   (false-if-exception (delete-file "substitute-retrieved")))))))))))
 
+(test-equal "substitute, preferred nar URL is 404, other is 200"
+  "Substitutable data."
+  (with-narinfo* (string-append %narinfo "Signature: " (signature-field %narinfo))
+      %main-substitute-directory
+
+    (with-http-server `((200 ,(string-append %narinfo "Signature: "
+                                             (signature-field %narinfo)
+                                             "\n"
+                                             "URL: example.nar.lz\n"
+                                             "Compression: lzip\n"))
+                        (404 "Sorry, nar.lz is missing!")
+                        (200 ,(call-with-input-file
+                                  (string-append %main-substitute-directory
+                                                 "/example.nar")
+                                get-bytevector-all)))
+      (dynamic-wind
+        (const #t)
+        (lambda ()
+          (parameterize ((substitute-urls (list (%local-url))))
+            (request-substitution (string-append (%store-prefix)
+                                                 "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
+                                  "substitute-retrieved"))
+          (call-with-input-file "substitute-retrieved" get-string-all))
+        (lambda ()
+          (false-if-exception (delete-file "substitute-retrieved")))))))
+
 (test-quit "substitute, narinfo is available but nar is missing"
     "failed to find alternative substitute"
   (with-narinfo*

base-commit: dff1689bb37e5303868584d3f1d7a33cbcb7f51e
-- 
2.40.1

Message #8 received at 63646 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 63646 <at> debbugs.gnu.org
Cc: Josselin Poiret <dev <at> jpoiret.xyz>, Tobias Geerinckx-Rice <me <at> tobias.gr>,
 Simon Tournier <zimon.toutoune <at> gmail.com>, Mathieu Othacehe <othacehe <at> gnu.org>,
 Christopher Baines <mail <at> cbaines.net>, Ricardo Wurmus <rekado <at> elephly.net>
Subject: Re: bug#63646: [PATCH] substitute: If a server's nar URL is 404,
 try the next one(s).
Date: Mon, 22 May 2023 17:45:27 +0200

Ludovic Courtès <ludo <at> gnu.org> skribis:

> +  (define (try-fetch choices)
> +    (match choices
> +      (((uri compression file-size) rest ...)
> +       (guard (c ((and (pair? rest) (network-error? c))
> +                  (warning (G_ "download from '~a' failed, trying next URL~%")
> +                           (uri->string uri))

I realized we can change ‘network-error?’ to ‘http-get-error?’ above.
Otherwise, we could find ourselves trying several nar URLs on the same
server when the error is ETIMEDOUT or ECONNREFUSED, which would be a
waste of time.

Ludo’.

Message #15 received at 63646-done <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 63646-done <at> debbugs.gnu.org, 63634-done <at> debbugs.gnu.org
Cc: Josselin Poiret <dev <at> jpoiret.xyz>, Christopher Baines <mail <at> cbaines.net>,
 Simon Tournier <zimon.toutoune <at> gmail.com>, Mathieu Othacehe <othacehe <at> gnu.org>,
 Tobias Geerinckx-Rice <me <at> tobias.gr>, Ricardo Wurmus <rekado <at> elephly.net>
Subject: Re: bug#63646: [PATCH] substitute: If a server's nar URL is 404,
 try the next one(s).
Date: Tue, 30 May 2023 00:19:07 +0200

Hi,

Ludovic Courtès <ludo <at> gnu.org> skribis:

> Ludovic Courtès <ludo <at> gnu.org> skribis:
>
>> +  (define (try-fetch choices)
>> +    (match choices
>> +      (((uri compression file-size) rest ...)
>> +       (guard (c ((and (pair? rest) (network-error? c))
>> +                  (warning (G_ "download from '~a' failed, trying next URL~%")
>> +                           (uri->string uri))
>
> I realized we can change ‘network-error?’ to ‘http-get-error?’ above.
> Otherwise, we could find ourselves trying several nar URLs on the same
> server when the error is ETIMEDOUT or ECONNREFUSED, which would be a
> waste of time.

Pushed as 8af9a2aa5fa2fa5b00234c1cbe12e9aff60888a0.

Ludo’.

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.