From 2a2856d5ccd9a9b7df8a94333a277b971a39b150 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 13 Jun 2022 09:51:56 +0200 Subject: challenge: Actually delete nars that have been extracted. Fixes . Reported by Vagrant Cascadian . * guix/scripts/challenge.scm (make-directory-writable): New procedure. (call-with-mismatches)[restore-file*]: New procedure. Use it instead of 'restore-file'. --- guix/scripts/challenge.scm | 30 +++++++++++++++++++++++++++--- 1 file changed, 27 insertions(+), 3 deletions(-) (limited to 'guix') 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 +;;; Copyright © 2015-2017, 2019-2022 Ludovic Courtès ;;; ;;; 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) -- cgit v1.2.3