diff options
| author | Marius Bakke <mbakke@fastmail.com> | 2017-04-11 10:47:38 +0200 |
|---|---|---|
| committer | Marius Bakke <mbakke@fastmail.com> | 2017-05-19 12:59:25 +0200 |
| commit | 01cc84dadee4571e5793658e912ee05d60fbf060 (patch) | |
| tree | d7a407b6666d44d9d1e40e94276284d7d4006f5f | |
| parent | e7fbd49132406bb9ec12141ac77ac401f58ee267 (diff) | |
| download | guix-01cc84dadee4571e5793658e912ee05d60fbf060.tar guix-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.
| -rw-r--r-- | gnu/build/vm.scm | 17 | ||||
| -rw-r--r-- | gnu/system/vm.scm | 2 |
2 files changed, 13 insertions, 6 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")) diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 2ee5c2b1e7..e0e4d33d45 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -231,7 +231,7 @@ the image." (* 10 (expt 2 20)))) (label #$file-system-label) (file-system #$file-system-type) - (bootable? #t) + (flags '(boot)) (initializer initialize))))) (initialize-hard-disk "/dev/vda" #:partitions partitions |