vm: Move store copy handling to (guix build store-copy).

* gnu/build/vm.scm (read-reference-graph, populate-store): Move to...
* guix/build/store-copy.scm: ... here.  New file.
* Makefile.am (MODULES): Add it.
* gnu/system/vm.scm (expression->derivation-in-linux-vm): Adjust default
  #:modules values accordingly.
* tests/gexp.scm ("gexp->derivation, store copy"): New test.

2 files changed, 3 insertions, 37 deletions

diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm
index ad63a2240d..27ccd047b7 100644
--- a/gnu/build/vm.scm
+++ b/gnu/build/vm.scm
@@ -18,12 +18,11 @@
 
 (define-module (gnu build vm)
   #:use-module (guix build utils)
+  #:use-module (guix build store-copy)
   #:use-module (gnu build linux-boot)
   #:use-module (gnu build install)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
-  #:use-module (ice-9 rdelim)
-  #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:export (qemu-command
             load-in-linux-vm
@@ -111,20 +110,6 @@ the #:references-graphs parameter of 'derivation'."
         (mkdir output)
         (copy-recursively "xchg" output))))
 
-(define (read-reference-graph port)
-  "Return a list of store paths from the reference graph at PORT.
-The data at PORT is the format produced by #:references-graphs."
-  (let loop ((line   (read-line port))
-             (result '()))
-    (cond ((eof-object? line)
-           (delete-duplicates result))
-          ((string-prefix? "/" line)
-           (loop (read-line port)
-                 (cons line result)))
-          (else
-           (loop (read-line port)
-                 result)))))
-
 (define* (initialize-partition-table device partition-size
                                      #:key
                                      (label-type "msdos")
@@ -140,26 +125,6 @@ success."
                           (format #f "~aB" partition-size)))
     (error "failed to create partition table")))
 
-(define* (populate-store reference-graphs target)
-  "Populate the store under directory TARGET with the items specified in
-REFERENCE-GRAPHS, a list of reference-graph files."
-  (define store
-    (string-append target (%store-directory)))
-
-  (define (things-to-copy)
-    ;; Return the list of store files to copy to the image.
-    (define (graph-from-file file)
-      (call-with-input-file file read-reference-graph))
-
-    (delete-duplicates (append-map graph-from-file reference-graphs)))
-
-  (mkdir-p store)
-  (chmod store #o1775)
-  (for-each (lambda (thing)
-              (copy-recursively thing
-                                (string-append target thing)))
-            (things-to-copy)))
-
 (define MS_BIND 4096)                             ; <sys/mounts.h> again!
 
 (define* (format-partition partition type
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index d263edb4f1..624f2a680a 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -116,7 +116,8 @@ input tuple.  The output file name is when building for SYSTEM."
                                                 (gnu build install)
                                                 (gnu build linux-boot)
                                                 (gnu build file-systems)
-                                                (guix build utils)))
+                                                (guix build utils)
+                                                (guix build store-copy)))
                                              (guile-for-build
                                               (%guile-for-build))