03/17: substitute: Gracefully retry after failed partial downloads.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 885d524f79aa4bbfac5dfebf285e1e248184ee70
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Thu Jun 8 22:43:05 2023 +0200

    substitute: Gracefully retry after failed partial downloads.
    
    Fixes <https://issues.guix.gnu.org/63443>.
    Reported by Attila Lendvai <attila@lendvai.name>.
    
    * guix/scripts/substitute.scm (catch-system-error): New macro.
    (download-nar): Add call to 'delete-file-recursively'.
    * tests/substitute.scm ("substitute, previous partial download around"):
    New test.
---
 guix/scripts/substitute.scm | 11 ++++++++++-
 tests/substitute.scm        | 25 ++++++++++++++++++++++++-
 2 files changed, 34 insertions(+), 2 deletions(-)

diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index de7b77b0bf..8b1f7d6fda 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -38,7 +38,7 @@
   #:use-module (guix cache)
   #:use-module (gcrypt pk-crypto)
   #:use-module (guix pki)
-  #:use-module ((guix build utils) #:select (mkdir-p))
+  #:autoload   (guix build utils) (mkdir-p delete-file-recursively)
   #:use-module ((guix build download)
                 #:select (uri-abbreviation nar-uri-abbreviation
                           (open-connection-for-uri
@@ -445,6 +445,11 @@ server certificates."
   "Bind PORT with EXP... to a socket connected to URI."
   (call-with-cached-connection uri (lambda (port) exp ...)))
 
+(define-syntax-rule (catch-system-error exp)
+  (catch 'system-error
+    (lambda () exp)
+    (const #f)))
+
 (define* (download-nar narinfo destination
                        #:key status-port
                        deduplicate? print-build-trace?)
@@ -503,6 +508,10 @@ STATUS-PORT."
               (narinfo-path narinfo)
               (narinfo-uri-base narinfo)))))
 
+  ;; Delete DESTINATION first--necessary when starting over after a failed
+  ;; download.
+  (catch-system-error (delete-file-recursively destination))
+
   (let ((choices (narinfo-preferred-uris narinfo
                                          #:fast-decompression?
                                          %prefer-fast-decompression?)))
diff --git a/tests/substitute.scm b/tests/substitute.scm
index 8df3938b59..7246ed82d5 100644
--- a/tests/substitute.scm
+++ b/tests/substitute.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014 Nikita Karetnikov <nikita@karetnikov.org>
-;;; Copyright © 2014-2015, 2017-2019, 2021-2022 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014-2015, 2017-2019, 2021-2023 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -639,6 +639,29 @@ System: mips64el-linux\n")))
         (lambda ()
           (false-if-exception (delete-file "substitute-retrieved")))))))
 
+(test-equal "substitute, previous partial download around"
+  "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)))
+                        (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))))
+            (mkdir-p "substitute-retrieved/a/b/c/d") ;add stale data
+            (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*