pack: Import (guix store database) only when '--localstatedir' is passed.

[jackhill/guix/guix.git] / gnu / build / vm.scm

diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm
index abecc8c..7468085 100644 (file)
--- a/gnu/build/vm.scm
+++ b/gnu/build/vm.scm
@@ -25,7 +25,7 @@
   #:use-module (guix build utils)
   #:use-module (guix build store-copy)
   #:use-module (guix build syscalls)
-  #:use-module ((guix store database) #:select (reset-timestamps))
+  #:use-module (guix store database)
   #:use-module (gnu build linux-boot)
   #:use-module (gnu build install)
   #:use-module (gnu system uuid)
@@ -105,7 +105,13 @@ the #:references-graphs parameter of 'derivation'."
       ;; hardware virtualization to still use these commands.  KVM support is
       ;; still buggy on some ARM32 boards. Do not use it even if available.
       ,@(if (and (file-exists? "/dev/kvm")
-                 (not target-arm32?))
+                 (not target-arm32?)
+
+                 ;; XXX: 32-bit 'qemu-system-i386 -enable-kvm' segfaults on
+                 ;; x86_64 hosts running Linux-libre 4.17:
+                 ;; <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=31380#18> and
+                 ;; <https://lists.gnu.org/archive/html/qemu-devel/2018-07/msg01166.html>.
+                 (not (string-suffix? "-i386" qemu)))
             '("-enable-kvm")
             '())
 
@@ -185,6 +191,23 @@ the #:references-graphs parameter of 'derivation'."
           (mkdir output)
           (copy-recursively "xchg" output)))))
 
+(define* (register-closure prefix closure
+                           #:key
+                           (deduplicate? #t) (reset-timestamps? #t)
+                           (schema (sql-schema)))
+  "Register CLOSURE in PREFIX, where PREFIX is the directory name of the
+target store and CLOSURE is the name of a file containing a reference graph as
+produced by #:references-graphs..  As a side effect, if RESET-TIMESTAMPS? is
+true, reset timestamps on store files and, if DEDUPLICATE? is true,
+deduplicates files common to CLOSURE and the rest of PREFIX."
+  (let ((items (call-with-input-file closure read-reference-graph)))
+    (register-items items
+                    #:prefix prefix
+                    #:deduplicate? deduplicate?
+                    #:reset-timestamps? reset-timestamps?
+                    #:registration-time %epoch
+                    #:schema schema)))
+
 \f
 ;;;
 ;;; Partitions.