diff options
| author | Marius Bakke <mbakke@fastmail.com> | 2017-04-11 10:47:38 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2017-05-20 10:17:52 +0200 |
| commit | fd5a30ab7b999f9b1095426054b5fcdfdacddc6f (patch) | |
| tree | 578ebc0249d8984cf7d286d7d747cebd69a5ce09 | |
| parent | c383dc520f4b71bcb99115768bfafa00df85f9d1 (diff) | |
| download | guix-fd5a30ab7b999f9b1095426054b5fcdfdacddc6f.tar guix-fd5a30ab7b999f9b1095426054b5fcdfdacddc6f.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 1eb9a4c45e..00d625c946 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) @@ -300,6 +302,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 2c8b954c80..71bc55d7d8 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -229,7 +229,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 |