summaryrefslogtreecommitdiff
path: root/gnu/build/vm.scm
diff options
context:
space:
mode:
authorMarius Bakke <mbakke@fastmail.com>2017-04-11 10:47:38 +0200
committerMarius Bakke <mbakke@fastmail.com>2017-05-19 12:59:25 +0200
commit01cc84dadee4571e5793658e912ee05d60fbf060 (patch)
treed7a407b6666d44d9d1e40e94276284d7d4006f5f /gnu/build/vm.scm
parente7fbd49132406bb9ec12141ac77ac401f58ee267 (diff)
downloadpatches-01cc84dadee4571e5793658e912ee05d60fbf060.tar
patches-01cc84dadee4571e5793658e912ee05d60fbf060.tar.gz
vm: Support arbitrary partition flags.
* gnu/build/vm.scm (<partition>): Change BOOTABLE? to FLAGS. (initialize-partition-table): Pass each flag to parted. (initialize-hard-disk): Locate boot partition. * gnu/system/vm.scm (qemu-image): Adjust partition flags.
Diffstat (limited to 'gnu/build/vm.scm')
-rw-r--r--gnu/build/vm.scm17
1 files changed, 12 insertions, 5 deletions
diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm
index 9a77bee72d..c7449cfbef 100644
--- a/gnu/build/vm.scm
+++ b/gnu/build/vm.scm
@@ -3,6 +3,7 @@
;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org>
;;; Copyright © 2016 Leo Famulari <leo@famulari.name>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -41,7 +42,7 @@
partition-size
partition-file-system
partition-label
- partition-bootable?
+ partition-flags
partition-initializer
root-partition-initializer
@@ -141,7 +142,7 @@ the #:references-graphs parameter of 'derivation'."
(size partition-size)
(file-system partition-file-system (default "ext4"))
(label partition-label (default #f))
- (bootable? partition-bootable? (default #f))
+ (flags partition-flags (default '()))
(initializer partition-initializer (default (const #t))))
(define (fold2 proc seed1 seed2 lst) ;TODO: factorize
@@ -168,9 +169,10 @@ actual /dev name based on DEVICE."
(cons* "mkpart" "primary" "ext2"
(format #f "~aB" offset)
(format #f "~aB" (+ offset (partition-size part)))
- (if (partition-bootable? part)
- `("set" ,(number->string index) "boot" "on")
- '())))
+ (append-map (lambda (flag)
+ (list "set" (number->string index)
+ (symbol->string flag) "on"))
+ (partition-flags part))))
(define (options partitions offset)
(let loop ((partitions partitions)
@@ -303,6 +305,11 @@ in PARTITIONS, and using BOOTCFG as its bootloader configuration file.
Each partition is initialized by calling its 'initializer' procedure,
passing it a directory name where it is mounted."
+
+ (define (partition-bootable? partition)
+ "Return the first partition found with the boot flag set."
+ (member 'boot (partition-flags partition)))
+
(let* ((partitions (initialize-partition-table device partitions))
(root (find partition-bootable? partitions))
(target "/fs"))