summary refs log tree commit diff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-09-08 22:45:30 +0200
committerLudovic Courtès <ludo@gnu.org>2013-09-08 23:30:12 +0200
commit8ab73e91d6550c192b750ec1457c69acbca9e711 (patch)
tree89dea03bf74abdb369983eda4b478ffd4bb2e885
parent6bf25b7b0554e8b569bc4938c4833491aedc742f (diff)
downloadguix-8ab73e91d6550c192b750ec1457c69acbca9e711.tar.gz
gnu: vm: Clear timestamps on the imported files, like in the store.
* gnu/system/vm.scm (qemu-image): Clear timestamps on the copied files.
-rw-r--r--gnu/system/vm.scm16
1 files changed, 16 insertions, 0 deletions
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 73543896ef..f0f40e54a3 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -75,6 +75,9 @@ DISK-IMAGE-SIZE bytes and return it.
 When REFERENCES-GRAPHS is true, it must be a list of file name/store path
 pairs, as for `derivation'.  The files containing the reference graphs are
 made available under the /xchg CIFS share."
+  ;; FIXME: Allow use of macros from other modules, as done in
+  ;; `build-expression->derivation'.
+
   (define input-alist
     (map (match-lambda
           ((input (? package? package))
@@ -294,6 +297,19 @@ It can be used to provide additional files, such as /etc files."
                                (primitive-load populate)
                                (chdir "/")))
 
+                      (display "clearing file timestamps...\n")
+                      (for-each (lambda (file)
+                                  (let ((s (lstat file)))
+                                    ;; XXX: Guile uses libc's 'utime' function
+                                    ;; (not 'futime'), so the timestamp of
+                                    ;; symlinks cannot be changed, and there
+                                    ;; are symlinks here pointing to
+                                    ;; /nix/store, which is the host,
+                                    ;; read-only store.
+                                    (unless (eq? (stat:type s) 'symlink)
+                                      (utime file 0 0 0 0))))
+                                (find-files "/fs" ".*"))
+
                       (and (zero?
                             (system* grub "--no-floppy"
                                      "--boot-directory" "/fs/boot"