summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix/nar.scm8
-rw-r--r--guix/serialization.scm14
-rw-r--r--tests/guix-archive.sh4
-rw-r--r--tests/nar.scm12
4 files changed, 26 insertions, 12 deletions
diff --git a/guix/nar.scm b/guix/nar.scm
index a23af2e5de..edfcc9aab5 100644
--- a/guix/nar.scm
+++ b/guix/nar.scm
@@ -114,10 +114,12 @@ held."
;; Install the new TARGET.
(rename-file source target)
- ;; Register TARGET. As a side effect, it resets the timestamps of all
- ;; its files, recursively, and runs a deduplication pass.
+ ;; Register TARGET. As a side effect, run a deduplication pass.
+ ;; Timestamps and permissions are already correct thanks to
+ ;; 'restore-file'.
(register-items db
- (list (store-info target deriver references))))
+ (list (store-info target deriver references))
+ #:reset-timestamps? #f))
(when lock?
(delete-file (string-append target ".lock"))
diff --git a/guix/serialization.scm b/guix/serialization.scm
index cc56134ef4..677ca60b66 100644
--- a/guix/serialization.scm
+++ b/guix/serialization.scm
@@ -459,23 +459,27 @@ depends on TYPE."
(define (restore-file port file)
"Read a file (possibly a directory structure) in Nar format from PORT.
-Restore it as FILE."
+Restore it as FILE with canonical permissions and timestamps."
(fold-archive (lambda (file type content result)
(match type
('directory
(mkdir file))
('directory-complete
- #t)
+ (chmod file #o555)
+ (utime file 1 1 0 0))
('symlink
- (symlink content file))
+ (symlink content file)
+ (utime file 1 1 0 0 AT_SYMLINK_NOFOLLOW))
((or 'regular 'executable)
(match content
((input . size)
(call-with-output-file file
(lambda (output)
(dump input output size)
- (when (eq? type 'executable)
- (chmod output #o755)))))))))
+ (chmod output (if (eq? type 'executable)
+ #o555
+ #o444))))
+ (utime file 1 1 0 0))))))
#t
port
file))
diff --git a/tests/guix-archive.sh b/tests/guix-archive.sh
index e796c62f9a..00b87ff0ac 100644
--- a/tests/guix-archive.sh
+++ b/tests/guix-archive.sh
@@ -1,5 +1,5 @@
# GNU Guix --- Functional package management for GNU
-# Copyright © 2013, 2014, 2015, 2019 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2013, 2014, 2015, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
#
# This file is part of GNU Guix.
#
@@ -28,7 +28,7 @@ tmpdir="t-archive-dir-$$"
rm -f "$archive" "$archive_alt"
rm -rf "$tmpdir"
-trap 'rm -f "$archive" "$archive_alt"; rm -rf "$tmpdir"' EXIT
+trap 'rm -f "$archive" "$archive_alt"; chmod -R +w "$tmpdir"; rm -rf "$tmpdir"' EXIT
guix archive --export guile-bootstrap > "$archive"
guix archive --export guile-bootstrap:out > "$archive_alt"
diff --git a/tests/nar.scm b/tests/nar.scm
index b542ebd47c..59616659c8 100644
--- a/tests/nar.scm
+++ b/tests/nar.scm
@@ -136,8 +136,11 @@
(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
@@ -363,7 +366,12 @@
(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)))))))