summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2023-06-08 22:43:05 +0200
committerLudovic Courtès <ludo@gnu.org>2023-06-08 22:54:58 +0200
commit885d524f79aa4bbfac5dfebf285e1e248184ee70 (patch)
treee48cdf6f498d2c95fad985d58436d4fb19f3e532
parent3f5e14182931f123c10513a3e1e2abaebfb52279 (diff)
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.
-rwxr-xr-xguix/scripts/substitute.scm11
-rw-r--r--tests/substitute.scm25
2 files changed, 34 insertions, 2 deletions
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index de7b77b0bf9..8b1f7d6fda9 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -38,7 +38,7 @@
38 #:use-module (guix cache) 38 #:use-module (guix cache)
39 #:use-module (gcrypt pk-crypto) 39 #:use-module (gcrypt pk-crypto)
40 #:use-module (guix pki) 40 #:use-module (guix pki)
41 #:use-module ((guix build utils) #:select (mkdir-p)) 41 #:autoload (guix build utils) (mkdir-p delete-file-recursively)
42 #:use-module ((guix build download) 42 #:use-module ((guix build download)
43 #:select (uri-abbreviation nar-uri-abbreviation 43 #:select (uri-abbreviation nar-uri-abbreviation
44 (open-connection-for-uri 44 (open-connection-for-uri
@@ -445,6 +445,11 @@ server certificates."
445 "Bind PORT with EXP... to a socket connected to URI." 445 "Bind PORT with EXP... to a socket connected to URI."
446 (call-with-cached-connection uri (lambda (port) exp ...))) 446 (call-with-cached-connection uri (lambda (port) exp ...)))
447 447
448(define-syntax-rule (catch-system-error exp)
449 (catch 'system-error
450 (lambda () exp)
451 (const #f)))
452
448(define* (download-nar narinfo destination 453(define* (download-nar narinfo destination
449 #:key status-port 454 #:key status-port
450 deduplicate? print-build-trace?) 455 deduplicate? print-build-trace?)
@@ -503,6 +508,10 @@ STATUS-PORT."
503 (narinfo-path narinfo) 508 (narinfo-path narinfo)
504 (narinfo-uri-base narinfo))))) 509 (narinfo-uri-base narinfo)))))
505 510
511 ;; Delete DESTINATION first--necessary when starting over after a failed
512 ;; download.
513 (catch-system-error (delete-file-recursively destination))
514
506 (let ((choices (narinfo-preferred-uris narinfo 515 (let ((choices (narinfo-preferred-uris narinfo
507 #:fast-decompression? 516 #:fast-decompression?
508 %prefer-fast-decompression?))) 517 %prefer-fast-decompression?)))
diff --git a/tests/substitute.scm b/tests/substitute.scm
index 8df3938b591..7246ed82d51 100644
--- a/tests/substitute.scm
+++ b/tests/substitute.scm
@@ -1,6 +1,6 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2014 Nikita Karetnikov <nikita@karetnikov.org> 2;;; Copyright © 2014 Nikita Karetnikov <nikita@karetnikov.org>
3;;; Copyright © 2014-2015, 2017-2019, 2021-2022 Ludovic Courtès <ludo@gnu.org> 3;;; Copyright © 2014-2015, 2017-2019, 2021-2023 Ludovic Courtès <ludo@gnu.org>
4;;; 4;;;
5;;; This file is part of GNU Guix. 5;;; This file is part of GNU Guix.
6;;; 6;;;
@@ -639,6 +639,29 @@ System: mips64el-linux\n")))
639 (lambda () 639 (lambda ()
640 (false-if-exception (delete-file "substitute-retrieved"))))))) 640 (false-if-exception (delete-file "substitute-retrieved")))))))
641 641
642(test-equal "substitute, previous partial download around"
643 "Substitutable data."
644 (with-narinfo* (string-append %narinfo "Signature: " (signature-field %narinfo))
645 %main-substitute-directory
646
647 (with-http-server `((200 ,(string-append %narinfo "Signature: "
648 (signature-field %narinfo)))
649 (200 ,(call-with-input-file
650 (string-append %main-substitute-directory
651 "/example.nar")
652 get-bytevector-all)))
653 (dynamic-wind
654 (const #t)
655 (lambda ()
656 (parameterize ((substitute-urls (list (%local-url))))
657 (mkdir-p "substitute-retrieved/a/b/c/d") ;add stale data
658 (request-substitution (string-append (%store-prefix)
659 "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
660 "substitute-retrieved"))
661 (call-with-input-file "substitute-retrieved" get-string-all))
662 (lambda ()
663 (false-if-exception (delete-file "substitute-retrieved")))))))
664
642(test-quit "substitute, narinfo is available but nar is missing" 665(test-quit "substitute, narinfo is available but nar is missing"
643 "failed to find alternative substitute" 666 "failed to find alternative substitute"
644 (with-narinfo* 667 (with-narinfo*