diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2023-06-08 22:43:05 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2023-06-08 22:54:58 +0200 |
| commit | 885d524f79aa4bbfac5dfebf285e1e248184ee70 (patch) | |
| tree | e48cdf6f498d2c95fad985d58436d4fb19f3e532 | |
| parent | 3f5e14182931f123c10513a3e1e2abaebfb52279 (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-x | guix/scripts/substitute.scm | 11 | ||||
| -rw-r--r-- | tests/substitute.scm | 25 |
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* |
