;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012-2021 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
(define (rm-rf dir)
(file-system-fold (const #t) ; enter?
(lambda (file stat result) ; leaf
+ (unless (eq? 'symlink (stat:type stat))
+ (chmod file #o644))
(delete-file file))
- (const #t) ; down
+ (lambda (dir stat result) ; down
+ (chmod dir #o755))
(lambda (dir stat result) ; up
(rmdir dir))
(const #t) ; skip
'(("R" directory #f)
("R/dir" directory #f)
("R/dir/exe" executable "1234")
+ ("R/dir" directory-complete #f)
("R/foo" regular "abcdefg")
- ("R/lnk" symlink "foo"))
+ ("R/lnk" symlink "foo")
+ ("R" directory-complete #f))
(let ()
(define-values (port get-bytevector)
(cut write-file input <>))
(call-with-input-file nar
(cut restore-file <> output))
- (file-tree-equal? input output))
+
+ (and (file-tree-equal? input output)
+ (every (lambda (file)
+ (canonical-file?
+ (string-append output "/" file)))
+ '("root" "root/reg" "root/exe"))))
(lambda ()
(false-if-exception (delete-file nar))
(false-if-exception (rm-rf output)))))))
(false-if-exception (rm-rf %test-dir))
(setlocale LC_ALL locale)))))
+;; XXX: Tell the 'deduplicate' procedure what store we're actually using.
+(setenv "NIX_STORE" (%store-prefix))
+
(test-assert "restore-file-set (signed, valid)"
(with-store store
(let* ((texts (unfold (cut >= <> 10)
;; their mtime and permissions were not reset. Ensure that this bug is
;; gone.
(with-store store
- (let* ((text1 (random-text))
- (text2 (random-text))
+ ;; Note: TEXT1 and TEXT2 must be longer than %DEDUPLICATION-MINIMUM-SIZE.
+ (let* ((text1 (string-concatenate (make-list 200 (random-text))))
+ (text2 (string-concatenate (make-list 200 (random-text))))
(tree `("tree" directory
("a" regular (data ,text1))
("b" directory