TakeV/guix
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

challenge: Actually delete nars that have been extracted.

Browse source 
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'.
This commit is contained in:
Ludovic Courtès 2022-06-13 09:51:56 +02:00
parent c318f4fcb1
commit 2a2856d5cc
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 27 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

30
guix/scripts/challenge.scm
View file

@ -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 @@ (define-module (guix scripts challenge)
#: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 @@ (define (report-differing-files 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 @@ (define local-hash
(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 @@ (define narinfo2
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)