bug#44760: [PATCH 02/15] serialization: 'restore-file' sets canonical timestamp and permissions.

[Ludovic Courtès]

* 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".
---
 guix/nar.scm           |  8 +++++---
 guix/serialization.scm | 14 +++++++++-----
 tests/guix-archive.sh  |  4 ++--
 tests/nar.scm          | 12 ++++++++++--
 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)))))))
-- 
2.29.2