diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2022-06-13 09:51:56 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2022-06-13 12:27:34 +0200 |
| commit | 2a2856d5ccd9a9b7df8a94333a277b971a39b150 (patch) | |
| tree | 7b78a866ea42e70cafd4cee6353a2a7c2b5989cc /guix | |
| parent | c318f4fcb190adaab4de491014f59eb79a28efc5 (diff) | |
| download | guix-2a2856d5ccd9a9b7df8a94333a277b971a39b150.tar.gz guix-2a2856d5ccd9a9b7df8a94333a277b971a39b150.tar.xz | |
challenge: Actually delete nars that have been extracted.
Fixes <https://issues.guix.gnu.org/55809>.
Reported by Vagrant Cascadian <vagrant@reproducible-builds.org>.
* guix/scripts/challenge.scm (make-directory-writable): New procedure.
(call-with-mismatches)[restore-file*]: New procedure.
Use it instead of 'restore-file'.
Diffstat (limited to 'guix')
| -rw-r--r-- | guix/scripts/challenge.scm | 30 |
1 files changed, 27 insertions, 3 deletions
diff --git a/guix/scripts/challenge.scm b/guix/scripts/challenge.scm index c29d5105ae..72d3e850f2 100644 --- a/guix/scripts/challenge.scm +++ b/guix/scripts/challenge.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2015, 2016, 2017, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2015-2017, 2019-2022 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -32,6 +32,7 @@ #:use-module (rnrs bytevectors) #:autoload (guix http-client) (http-fetch) #:use-module ((guix build syscalls) #:select (terminal-columns)) + #:autoload (guix build utils) (make-file-writable) #:use-module (gcrypt hash) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) @@ -310,6 +311,22 @@ specified in COMPARISON-REPORT." (length files))) (format #t "~{ ~a~%~}" files)))) +(define (make-directory-writable directory) + "Recurse into DIRECTORY and make each entry writable, similar to +'chmod -R +w DIRECTORY'." + (file-system-fold (const #t) + (lambda (file stat _) ;leaf + (make-file-writable file)) + (lambda (directory stat _) ;down + (make-file-writable directory)) + (const #t) ;up + (const #f) ;skip + (lambda (file stat errno _) ;error + (leave (G_ "failed to delete '~a': ~a~%") + file (strerror errno))) + #t + directory)) + (define (call-with-mismatches comparison-report proc) "Call PROC with two directories containing the mismatching store items." (define local-hash @@ -318,6 +335,13 @@ specified in COMPARISON-REPORT." (define narinfos (comparison-report-narinfos comparison-report)) + (define (restore-file* port directory) + ;; Since 'restore-file' sets "canonical" file permissions (read-only), + ;; make an extra traversal to make DIRECTORY writable so it can be deleted + ;; when the dynamic extent of 'call-with-temporary-directory' is left. + (restore-file port directory) + (make-directory-writable directory)) + (call-with-temporary-directory (lambda (directory1) (call-with-temporary-directory @@ -338,10 +362,10 @@ specified in COMPARISON-REPORT." narinfos))) (rmdir directory1) - (call-with-nar narinfo1 (cut restore-file <> directory1)) + (call-with-nar narinfo1 (cut restore-file* <> directory1)) (when narinfo2 (rmdir directory2) - (call-with-nar narinfo2 (cut restore-file <> directory2))) + (call-with-nar narinfo2 (cut restore-file* <> directory2))) (proc directory1 (if local-hash (comparison-report-item comparison-report) |