mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2025-01-11 21:59:08 -05:00
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:
parent
465d2cb286
commit
ed7d02f7c1
4 changed files with 26 additions and 12 deletions
|
@ -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"))
|
||||||
|
|
|
@ -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))
|
||||||
|
|
|
@ -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"
|
||||||
|
|
|
@ -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)))))))
|
||||||
|
|
Loading…
Reference in a new issue