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

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
guix/nar.scm
View File

@ -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"))

14
guix/serialization.scm
View File

@ -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))

4
tests/guix-archive.sh
View File

@ -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"

12
tests/nar.scm
View File

@ -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)))))))