Merge branch 'core-updates'

5 files changed, 69 insertions, 32 deletions

diff --git a/guix/build-system/gnu.scm b/guix/build-system/gnu.scm
index 0c3f1ea4e3..4fa1d1683d 100644
--- a/guix/build-system/gnu.scm
+++ b/guix/build-system/gnu.scm
@@ -33,7 +33,8 @@
             package-with-extra-configure-variable
             static-libgcc-package
             static-package
-            dist-package))
+            dist-package
+            package-with-restricted-references))
 
 ;; Commentary:
 ;;
@@ -190,6 +191,15 @@ runs `make distcheck' and whose result is one or more source tarballs."
            ("gettext"  ,(ref '(gnu packages gettext) 'gnu-gettext))
            ("texinfo"  ,(ref '(gnu packages texinfo) 'texinfo))))))))
 
+(define (package-with-restricted-references p refs)
+  "Return a package whose outputs are guaranteed to only refer to the packages
+listed in REFS."
+  (if (eq? (package-build-system p) gnu-build-system) ; XXX: dirty
+      (package (inherit p)
+        (arguments `(#:allowed-references ,refs
+                     ,@(package-arguments p))))
+      p))
+
 
 (define %store
   ;; Store passed to STANDARD-INPUTS.
diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm
index da6b31c326..8636931ed9 100644
--- a/guix/build/gnu-build-system.scm
+++ b/guix/build/gnu-build-system.scm
@@ -97,7 +97,11 @@ working directory."
       (begin
         (mkdir "source")
         (chdir "source")
-        (copy-recursively source ".")
+
+        ;; Preserve timestamps (set to the Epoch) on the copied tree so that
+        ;; things work deterministically.
+        (copy-recursively source "."
+                          #:keep-mtime? #t)
         #t)
       (and (zero? (system* "tar" "xvf" source))
            (chdir (first-subdirectory ".")))))
diff --git a/guix/build/utils.scm b/guix/build/utils.scm
index 40af785b88..2f3dc9cad0 100644
--- a/guix/build/utils.scm
+++ b/guix/build/utils.scm
@@ -134,9 +134,12 @@ return values of applying PROC to the port."
 (define* (copy-recursively source destination
                            #:key
                            (log (current-output-port))
-                           (follow-symlinks? #f))
+                           (follow-symlinks? #f)
+                           keep-mtime?)
   "Copy SOURCE directory to DESTINATION.  Follow symlinks if FOLLOW-SYMLINKS?
-is true; otherwise, just preserve them.  Write verbose output to the LOG port."
+is true; otherwise, just preserve them.  When KEEP-MTIME? is true, keep the
+modification time of the files in SOURCE on those of DESTINATION.  Write
+verbose output to the LOG port."
   (define strip-source
     (let ((len (string-length source)))
       (lambda (file)
@@ -152,10 +155,15 @@ is true; otherwise, just preserve them.  Write verbose output to the LOG port."
                            (let ((target (readlink file)))
                              (symlink target dest)))
                           (else
-                           (copy-file file dest)))))
+                           (copy-file file dest)
+                           (when keep-mtime?
+                             (set-file-time dest stat))))))
                     (lambda (dir stat result)     ; down
-                      (mkdir-p (string-append destination
-                                              (strip-source dir))))
+                      (let ((target (string-append destination
+                                                   (strip-source dir))))
+                        (mkdir-p target)
+                        (when keep-mtime?
+                          (set-file-time target stat))))
                     (lambda (dir stat result)     ; up
                       result)
                     (const #t)                    ; skip
@@ -170,25 +178,30 @@ is true; otherwise, just preserve them.  Write verbose output to the LOG port."
                         stat
                         lstat)))
 
-(define (delete-file-recursively dir)
-  "Delete DIR recursively, like `rm -rf', without following symlinks.  Report
-but ignore errors."
-  (file-system-fold (const #t)                    ; enter?
-                    (lambda (file stat result)    ; leaf
-                      (delete-file file))
-                    (const #t)                    ; down
-                    (lambda (dir stat result)     ; up
-                      (rmdir dir))
-                    (const #t)                    ; skip
-                    (lambda (file stat errno result)
-                      (format (current-error-port)
-                              "warning: failed to delete ~a: ~a~%"
-                              file (strerror errno)))
-                    #t
-                    dir
-
-                    ;; Don't follow symlinks.
-                    lstat))
+(define* (delete-file-recursively dir
+                                  #:key follow-mounts?)
+  "Delete DIR recursively, like `rm -rf', without following symlinks.  Don't
+follow mount points either, unless FOLLOW-MOUNTS? is true.  Report but ignore
+errors."
+  (let ((dev (stat:dev (lstat dir))))
+    (file-system-fold (lambda (dir stat result)    ; enter?
+                        (or follow-mounts?
+                            (= dev (stat:dev stat))))
+                      (lambda (file stat result)   ; leaf
+                        (delete-file file))
+                      (const #t)                   ; down
+                      (lambda (dir stat result)    ; up
+                        (rmdir dir))
+                      (const #t)                   ; skip
+                      (lambda (file stat errno result)
+                        (format (current-error-port)
+                                "warning: failed to delete ~a: ~a~%"
+                                file (strerror errno)))
+                      #t
+                      dir
+
+                      ;; Don't follow symlinks.
+                      lstat)))
 
 (define (find-files dir regexp)
   "Return the lexicographically sorted list of files under DIR whose basename
diff --git a/guix/scripts/substitute-binary.scm b/guix/scripts/substitute-binary.scm
index 4bca8c2e88..ec7596efb6 100755
--- a/guix/scripts/substitute-binary.scm
+++ b/guix/scripts/substitute-binary.scm
@@ -592,9 +592,14 @@ Internal tool to substitute a pre-built binary to a local build.\n"))
          (let ((key (call-with-input-file %public-key-file
                       (compose string->canonical-sexp
                                get-string-all))))
-           (equal? (acl->public-keys acl) (list key)))))
-
-  (let ((acl (current-acl)))
+           (match acl
+             ((thing)
+              (equal? (canonical-sexp->string thing)
+                      (canonical-sexp->string key)))
+             (_
+              #f)))))
+
+  (let ((acl (acl->public-keys (current-acl))))
     (when (or (null? acl) (singleton? acl))
       (warning (_ "ACL for archive imports seems to be uninitialized, \
 substitutes may be unavailable\n")))))
@@ -603,6 +608,7 @@ substitutes may be unavailable\n")))))
   "Implement the build daemon's substituter protocol."
   (mkdir-p %narinfo-cache-directory)
   (maybe-remove-expired-cached-narinfo)
+  (check-acl-initialized)
 
   ;; Starting from commit 22144afa in Nix, we are allowed to bail out directly
   ;; when we know we cannot substitute, but we must emit a newline on stdout
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 345d8c3e5f..7a4a2a6a06 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -100,9 +100,13 @@ When GRUB? is true, install GRUB on DEVICE, using GRUB.CFG."
 
   (if (string=? target "/")
       (warning (_ "initializing the current root file system~%"))
-      ;; Copy items to the new store.
-      (for-each (cut copy-closure store <> target #:log-port log-port)
-                to-copy))
+      (begin
+        ;; Make sure the target store exists.
+        (mkdir-p (string-append target (%store-prefix)))
+
+        ;; Copy items to the new store.
+        (for-each (cut copy-closure store <> target #:log-port log-port)
+                  to-copy)))
 
   ;; Create a bunch of additional files.
   (format log-port "populating '~a'...~%" target)