serialization: 'restore-file' sets canonical timestamp and permissions.

* guix/serialization.scm (restore-file): Set the permissions and mtime
of FILE.
* guix/nar.scm (finalize-store-file): Pass #:reset-timestamps? #f to
'register-items'.
* tests/nar.scm (rm-rf): Add 'chmod' calls to ensure files are writable.
("write-file + restore-file with symlinks"): Ensure every file in OUTPUT
passes 'canonical-file?'.
* tests/guix-archive.sh: Run "chmod -R +w" before "rm -rf".
This commit is contained in:
Ludovic Courtès 2020-12-09 22:16:35 +01:00
parent 465d2cb286
commit ed7d02f7c1
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
4 changed files with 26 additions and 12 deletions

View file

@ -114,10 +114,12 @@ (define (acquire-lock file)
;; Install the new TARGET. ;; Install the new TARGET.
(rename-file source target) (rename-file source target)
;; Register TARGET. As a side effect, it resets the timestamps of all ;; Register TARGET. As a side effect, run a deduplication pass.
;; its files, recursively, and runs a deduplication pass. ;; Timestamps and permissions are already correct thanks to
;; 'restore-file'.
(register-items db (register-items db
(list (store-info target deriver references)))) (list (store-info target deriver references))
#:reset-timestamps? #f))
(when lock? (when lock?
(delete-file (string-append target ".lock")) (delete-file (string-append target ".lock"))

View file

@ -459,23 +459,27 @@ (define (read-eof-marker)
(define (restore-file port file) (define (restore-file port file)
"Read a file (possibly a directory structure) in Nar format from PORT. "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) (fold-archive (lambda (file type content result)
(match type (match type
('directory ('directory
(mkdir file)) (mkdir file))
('directory-complete ('directory-complete
#t) (chmod file #o555)
(utime file 1 1 0 0))
('symlink ('symlink
(symlink content file)) (symlink content file)
(utime file 1 1 0 0 AT_SYMLINK_NOFOLLOW))
((or 'regular 'executable) ((or 'regular 'executable)
(match content (match content
((input . size) ((input . size)
(call-with-output-file file (call-with-output-file file
(lambda (output) (lambda (output)
(dump input output size) (dump input output size)
(when (eq? type 'executable) (chmod output (if (eq? type 'executable)
(chmod output #o755))))))))) #o555
#o444))))
(utime file 1 1 0 0))))))
#t #t
port port
file)) file))

View file

@ -1,5 +1,5 @@
# GNU Guix --- Functional package management for GNU # 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. # This file is part of GNU Guix.
# #
@ -28,7 +28,7 @@ tmpdir="t-archive-dir-$$"
rm -f "$archive" "$archive_alt" rm -f "$archive" "$archive_alt"
rm -rf "$tmpdir" 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 > "$archive"
guix archive --export guile-bootstrap:out > "$archive_alt" guix archive --export guile-bootstrap:out > "$archive_alt"

View file

@ -136,8 +136,11 @@ (define (populate-file file size)
(define (rm-rf dir) (define (rm-rf dir)
(file-system-fold (const #t) ; enter? (file-system-fold (const #t) ; enter?
(lambda (file stat result) ; leaf (lambda (file stat result) ; leaf
(unless (eq? 'symlink (stat:type stat))
(chmod file #o644))
(delete-file file)) (delete-file file))
(const #t) ; down (lambda (dir stat result) ; down
(chmod dir #o755))
(lambda (dir stat result) ; up (lambda (dir stat result) ; up
(rmdir dir)) (rmdir dir))
(const #t) ; skip (const #t) ; skip
@ -363,7 +366,12 @@ (define (touch file)
(cut write-file input <>)) (cut write-file input <>))
(call-with-input-file nar (call-with-input-file nar
(cut restore-file <> output)) (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 () (lambda ()
(false-if-exception (delete-file nar)) (false-if-exception (delete-file nar))
(false-if-exception (rm-rf output))))))) (false-if-exception (rm-rf output)))))))