From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from eggs.gnu.org ([2001:4830:134:3::10]:57189) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1d8XfX-0004hJ-99 for guix-patches@gnu.org; Wed, 10 May 2017 15:53:08 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1d8XfT-0002hO-8p for guix-patches@gnu.org; Wed, 10 May 2017 15:53:07 -0400 Received: from debbugs.gnu.org ([208.118.235.43]:34467) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1d8XfS-0002hI-Tr for guix-patches@gnu.org; Wed, 10 May 2017 15:53:03 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1d8XfS-0004Ki-I7 for guix-patches@gnu.org; Wed, 10 May 2017 15:53:02 -0400 Subject: bug#26815: [PATCH 1/3] vm: Support arbitrary partition flags. Resent-Message-ID: From: Marius Bakke Date: Wed, 10 May 2017 21:52:25 +0200 Message-Id: <20170510195227.13461-1-mbakke@fastmail.com> In-Reply-To: <87efvzl7w8.fsf@gnu.org> References: <87efvzl7w8.fsf@gnu.org> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+kyle=kyleam.com@gnu.org Sender: "Guix-patches" To: 26815@debbugs.gnu.org * 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 440596a40..588b2d58b 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) @@ -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 cc13abe2a..42c7690b1 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -230,7 +230,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 -- 2.12.2