vm: Modularize build-side code.

* guix/build/install.scm (install-grub): Call 'error' if 'system*'
  returns non-zero.
* guix/build/vm.scm (initialize-partition-table): Make 'partition-size'
  a positional parameter.  Call 'error' when 'system*' returns
  non-zero'.
  (format-partition, initialize-root-partition): New procedures.
  (initialize-hard-disk): Use them.

guix/build/install.scm

@@ -37,7 +37,7 @@
 
 (define* (install-grub grub.cfg device mount-point)
   "Install GRUB with GRUB.CFG on DEVICE, which is assumed to be mounted on
-MOUNT-POINT.  Return #t on success."
+MOUNT-POINT."
   (let* ((target (string-append mount-point "/boot/grub/grub.cfg"))
          (pivot  (string-append target ".new")))
     (mkdir-p (dirname target))
@@ -47,9 +47,11 @@ MOUNT-POINT.  Return #t on success."
     (copy-file grub.cfg pivot)
     (rename-file pivot target)
 
-    (zero? (system* "grub-install" "--no-floppy"
+    (unless (zero? (system* "grub-install" "--no-floppy"
-                    "--boot-directory" (string-append mount-point "/boot")
+                            "--boot-directory"
-                    device))))
+                            (string-append mount-point "/boot")
+                            device))
+      (error "failed to install GRUB"))))
 
 (define (evaluate-populate-directive directive target)
   "Evaluate DIRECTIVE, an sexp describing a file or directory to create under

guix/build/vm.scm

@@ -25,6 +25,9 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:export (load-in-linux-vm
+            format-partition
+            initialize-root-partition
+            initialize-partition-table
             initialize-hard-disk))
 
 ;;; Commentary:
@@ -113,16 +116,20 @@ The data at PORT is the format produced by #:references-graphs."
            (loop (read-line port)
                  result)))))
 
-(define* (initialize-partition-table device
+(define* (initialize-partition-table device partition-size
                                      #:key
                                      (label-type "msdos")
-                                     partition-size)
+                                     (offset (expt 2 20)))
   "Create on DEVICE a partition table of type LABEL-TYPE, with a single
-partition of PARTITION-SIZE MiB.  Return #t on success."
+partition of PARTITION-SIZE bytes starting at OFFSET bytes.  Return #t on
-  (display "creating partition table...\n")
+success."
-  (zero? (system* "parted" device "mklabel" label-type
+  (format #t "creating partition table with a ~a B partition...\n"
-                  "mkpart" "primary" "ext2" "1MiB"
+          partition-size)
-                  (format #f "~aB" partition-size))))
+  (unless (zero? (system* "parted" device "mklabel" label-type
+                          "mkpart" "primary" "ext2"
+                          (format #f "~aB" offset)
+                          (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
@@ -146,43 +153,19 @@ REFERENCE-GRAPHS, a list of reference-graph files."
 
 (define MS_BIND 4096)                             ; <sys/mounts.h> again!
 
-(define* (initialize-hard-disk device
+(define (format-partition partition type)
-                               #:key
+  "Create a file system TYPE on PARTITION."
-                               grub.cfg
+  (format #t "creating ~a partition...\n" type)
-                               disk-image-size
+  (unless (zero? (system* (string-append "mkfs." type) "-F" partition))
-                               (file-system-type "ext4")
+    (error "failed to create partition")))
-                               (closures '())
-                               copy-closures?
-                               (register-closures? #t)
-                               (directives '()))
-  "Initialize DEVICE, a disk of DISK-IMAGE-SIZE bytes, with a
-FILE-SYSTEM-TYPE partition, and with GRUB installed.  If REGISTER-CLOSURES? is
-true, register all of CLOSURES is the partition's store.  If COPY-CLOSURES? is
-true, copy all of CLOSURES to the partition.  Lastly, apply DIRECTIVES to
-further populate the partition."
-  (define target-directory
-    "/fs")
 
+(define* (initialize-root-partition target-directory
+                                    #:key copy-closures? register-closures?
+                                    closures)
+  "Initialize the root partition mounted at TARGET-DIRECTORY."
   (define target-store
     (string-append target-directory (%store-directory)))
 
-  (define partition
-    (string-append device "1"))
-
-  (unless (initialize-partition-table device
-                                      #:partition-size
-                                      (- disk-image-size (* 5 (expt 2 20))))
-    (error "failed to create partition table"))
-
-  (format #t "creating ~a partition...\n" file-system-type)
-  (unless (zero? (system* (string-append "mkfs." file-system-type)
-                          "-F" partition))
-    (error "failed to create partition"))
-
-  (display "mounting partition...\n")
-  (mkdir target-directory)
-  (mount partition target-directory file-system-type)
-
   (when copy-closures?
     ;; Populate the store.
     (populate-store (map (cut string-append "/xchg/" <>) closures)
@@ -207,12 +190,43 @@ further populate the partition."
     (unless copy-closures?
       (system* "umount" target-store)))
 
-  ;; Evaluate the POPULATE directives.
+  ;; Add the non-store directories and files.
   (display "populating...\n")
-  (populate-root-file-system target-directory)
+  (populate-root-file-system target-directory))
 
-  (unless (install-grub grub.cfg device target-directory)
+(define* (initialize-hard-disk device
-    (error "failed to install GRUB"))
+                               #:key
+                               grub.cfg
+                               disk-image-size
+                               (file-system-type "ext4")
+                               (closures '())
+                               copy-closures?
+                               (register-closures? #t))
+  "Initialize DEVICE, a disk of DISK-IMAGE-SIZE bytes, with a
+FILE-SYSTEM-TYPE partition, and with GRUB installed.  If REGISTER-CLOSURES? is
+true, register all of CLOSURES is the partition's store.  If COPY-CLOSURES? is
+true, copy all of CLOSURES to the partition."
+  (define target-directory
+    "/fs")
+
+  (define partition
+    (string-append device "1"))
+
+  (initialize-partition-table device
+                              (- disk-image-size (* 5 (expt 2 20))))
+
+  (format-partition partition file-system-type)
+
+  (display "mounting partition...\n")
+  (mkdir target-directory)
+  (mount partition target-directory file-system-type)
+
+  (initialize-root-partition target-directory
+                             #:copy-closures? copy-closures?
+                             #:register-closures? register-closures?
+                             #:closures closures)
+
+  (install-grub grub.cfg device target-directory)
 
   ;; 'guix-register' resets timestamps and everything, so no need to do it
   ;; once more in that case.