From 72b891e50e1d0106a4b7a0fd88a44e34baae93e9 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sat, 25 Jul 2015 23:57:52 +0200
Subject: vm: Make the list of partitions to build a parameter.

* gnu/build/vm.scm (<partition>): New record type.
  (fold2): New procedure.
  (initialize-partition-table): Remove #:bootable? and
  'partition-size' parameters.  Add 'partitions' parameter.  Invoke 'parted'
  with '--script'.
  (initialize-root-partition): Remove.
  (initialize-partition, root-partition-initializer): New procedures.
  (initialize-hard-disk): Remove #:system-directory, #:disk-image-size,
  #:file-system-type, #:file-system-label, #:closures, #:copy-closures?,
  #:bootable?, and #:register-closures? parameters.  Add #:partitions.
  Rewrite to use 'initialize-partition' for each item of PARTITIONS.
* gnu/system/vm.scm (expression->derivation-in-linux-vm): Add (guix records)
  to #:modules default value.
  (qemu-image): Adjust accordingly.
---
 gnu/system/vm.scm | 29 ++++++++++++++++++-----------
 1 file changed, 18 insertions(+), 11 deletions(-)

(limited to 'gnu/system')

diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index eb27ebce3b..dfb6996067 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -101,6 +101,7 @@
                                                 (gnu build linux-modules)
                                                 (gnu build file-systems)
                                                 (guix elf)
+                                                (guix records)
                                                 (guix build utils)
                                                 (guix build syscalls)
                                                 (guix build store-copy)))
@@ -227,18 +228,24 @@ the image."
 
          (set-path-environment-variable "PATH" '("bin" "sbin") inputs)
 
-         (let ((graphs '#$(match inputs
-                            (((names . _) ...)
-                             names))))
+         (let* ((graphs     '#$(match inputs
+                                 (((names . _) ...)
+                                  names)))
+                (initialize (root-partition-initializer
+                             #:closures graphs
+                             #:copy-closures? #$copy-inputs?
+                             #:register-closures? #$register-closures?
+                             #:system-directory #$os-derivation))
+                (partitions (list (partition
+                                   (size #$(- disk-image-size
+                                              (* 10 (expt 2 20))))
+                                   (label #$file-system-label)
+                                   (file-system #$file-system-type)
+                                   (bootable? #t)
+                                   (initializer initialize)))))
            (initialize-hard-disk "/dev/vda"
-                                 #:system-directory #$os-derivation
-                                 #:grub.cfg #$grub-configuration
-                                 #:closures graphs
-                                 #:copy-closures? #$copy-inputs?
-                                 #:register-closures? #$register-closures?
-                                 #:disk-image-size #$disk-image-size
-                                 #:file-system-type #$file-system-type
-                                 #:file-system-label #$file-system-label)
+                                 #:partitions partitions
+                                 #:grub.cfg #$grub-configuration)
            (reboot))))
    #:system system
    #:make-disk-image? #t
-- 
cgit v1.2.3