me
/
guix
Archived
1
0
Fork 0
Code

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.
master
Marius Bakke 2017-04-11 10:47:38 +02:00
parent e7fbd49132
commit 01cc84dade
No known key found for this signature in database
GPG Key ID: A2A06DF2A33A54FA
2 changed files with 13 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
gnu/build/vm.scm
View File

@ -3,6 +3,7 @@
;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org> ;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org>
;;; Copyright © 2016 Leo Famulari <leo@famulari.name> ;;; Copyright © 2016 Leo Famulari <leo@famulari.name>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -41,7 +42,7 @@
partition-size partition-size
partition-file-system partition-file-system
partition-label partition-label
partition-bootable? partition-flags
partition-initializer partition-initializer
root-partition-initializer root-partition-initializer
@ -141,7 +142,7 @@ the #:references-graphs parameter of 'derivation'."
(size partition-size) (size partition-size)
(file-system partition-file-system (default "ext4")) (file-system partition-file-system (default "ext4"))
(label partition-label (default #f)) (label partition-label (default #f))
(bootable? partition-bootable? (default #f)) (flags partition-flags (default '()))
(initializer partition-initializer (default (const #t)))) (initializer partition-initializer (default (const #t))))
(define (fold2 proc seed1 seed2 lst) ;TODO: factorize (define (fold2 proc seed1 seed2 lst) ;TODO: factorize
@ -168,9 +169,10 @@ actual /dev name based on DEVICE."
(cons* "mkpart" "primary" "ext2" (cons* "mkpart" "primary" "ext2"
(format #f "~aB" offset) (format #f "~aB" offset)
(format #f "~aB" (+ offset (partition-size part))) (format #f "~aB" (+ offset (partition-size part)))
(if (partition-bootable? part) (append-map (lambda (flag)
`("set" ,(number->string index) "boot" "on") (list "set" (number->string index)
'()))) (symbol->string flag) "on"))
(partition-flags part))))
(define (options partitions offset) (define (options partitions offset)
(let loop ((partitions partitions) (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, Each partition is initialized by calling its 'initializer' procedure,
passing it a directory name where it is mounted." 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)) (let* ((partitions (initialize-partition-table device partitions))
(root (find partition-bootable? partitions)) (root (find partition-bootable? partitions))
(target "/fs")) (target "/fs"))

2
gnu/system/vm.scm
View File

@ -231,7 +231,7 @@ the image."
(* 10 (expt 2 20)))) (* 10 (expt 2 20))))
(label #$file-system-label) (label #$file-system-label)
(file-system #$file-system-type) (file-system #$file-system-type)
(bootable? #t) (flags '(boot))
(initializer initialize))))) (initializer initialize)))))
(initialize-hard-disk "/dev/vda" (initialize-hard-disk "/dev/vda"
#:partitions partitions #:partitions partitions