From fd5a30ab7b999f9b1095426054b5fcdfdacddc6f Mon Sep 17 00:00:00 2001 From: Marius Bakke Date: Tue, 11 Apr 2017 10:47:38 +0200 Subject: [PATCH] vm: Support arbitrary partition flags. * gnu/build/vm.scm (): 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. --- gnu/build/vm.scm | 17 ++++++++++++----- 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 ;;; Copyright © 2016 Leo Famulari ;;; Copyright © 2017 Mathieu Othacehe +;;; Copyright © 2017 Marius Bakke ;;; ;;; 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