From 25b01f9a219338580b6f7a7449bba8ff90c2176c Mon Sep 17 00:00:00 2001
From: Marius Bakke
Date: Tue, 11 Apr 2017 10:47:38 +0200
Subject: [PATCH 1/4] vm: Add support for arbitrary partition flags.
* gnu/build/vm.scm (): Change BOOTABLE? to FLAGS.
(initialize-partition-table): Pass each flag to parted.
(initialize-hard-disk): Search for root partition by "boot" flag.
* gnu/system/vm.scm (qemu-image): Adjust partitions accordingly.
---
gnu/build/vm.scm | 22 ++++++++++++++++------
gnu/system/vm.scm | 2 +-
2 files changed, 17 insertions(+), 7 deletions(-)
diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm
index 1eb9a4c45..f6a028868 100644
--- a/gnu/build/vm.scm
+++ b/gnu/build/vm.scm
@@ -41,7 +41,7 @@
partition-size
partition-file-system
partition-label
- partition-bootable?
+ partition-flags
partition-initializer
root-partition-initializer
@@ -141,7 +141,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 +168,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")
- '())))
+ (apply append (map (lambda (flag)
+ (cons* "set" (number->string index) flag
+ "on" '()))
+ (partition-flags part)))))
(define (options partitions offset)
(let loop ((partitions partitions)
@@ -300,8 +301,17 @@ 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 (find-root-partition partitions)
+ "Return the first partition found with the boot flag set."
+ ;; FIXME: This probably does not work. What's the best way to do this?
+ (find (match-lambda
+ (($ _ _ _ _ flags)
+ (member "boot" flags)))
+ partitions))
+
(let* ((partitions (initialize-partition-table device partitions))
- (root (find partition-bootable? partitions))
+ (root (find-root-partition partitions))
(target "/fs"))
(unless root
(error "no bootable partition specified" partitions))
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 374d8b663..e8a8463d5 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
--
2.12.2
From 9db90ea41a94ecbe42bba88de1c2e3ac607d5ea4 Mon Sep 17 00:00:00 2001
From: Marius Bakke
Date: Tue, 11 Apr 2017 10:55:22 +0200
Subject: [PATCH 2/4] vm: Unconditionally add a small ESP partition.
* gnu/system/vm.scm (qemu-image): Append 20MB FAT32 partition.
---
gnu/system/vm.scm | 11 +++++++++--
1 file changed, 9 insertions(+), 2 deletions(-)
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index e8a8463d5..867802342 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -226,11 +226,18 @@ the image."
#:system-directory #$os-derivation))
(partitions (list (partition
(size #$(- disk-image-size
- (* 10 (expt 2 20))))
+ (* 30 (expt 2 20))))
(label #$file-system-label)
(file-system #$file-system-type)
(flags '("boot"))
- (initializer initialize)))))
+ (initializer initialize))
+ (partition
+ ;; Append a small FAT32 partition for
+ ;; use with UEFI bootloaders.
+ (size (* 20 (expt 2 20)))
+ (label "gnu-esp")
+ (file-system "vfat")
+ (flags '("esp"))))))
(initialize-hard-disk "/dev/vda"
#:partitions partitions
#:grub.cfg #$grub-configuration)
--
2.12.2
From 4306bae25d6110ec52b8bbe3ad8b55f2c4c18fca Mon Sep 17 00:00:00 2001
From: Marius Bakke
Date: Mon, 17 Apr 2017 22:21:28 +0200
Subject: [PATCH 3/4] gnu: dosfstools: Enable compatibility symlinks.
* gnu/packages/disk.scm (dosfstools)[arguments]<#:configure-flags>: New
parameter.
---
gnu/packages/disk.scm | 5 ++++-
1 file changed, 4 insertions(+), 1 deletion(-)
diff --git a/gnu/packages/disk.scm b/gnu/packages/disk.scm
index 93895278d..c31107fcf 100644
--- a/gnu/packages/disk.scm
+++ b/gnu/packages/disk.scm
@@ -196,7 +196,10 @@ to recover data more efficiently by only reading the necessary blocks.")
"0wy13i3i4x2bw1hf5m4fd0myh61f9bcrs035fdlf6gyc1jksrcp6"))))
(build-system gnu-build-system)
(arguments
- `(#:make-flags (list (string-append "PREFIX=" %output)
+ `(;; The "--enable-compat-symlinks" flag is needed so that "mkfs.vfat"
+ ;; is created. The guix build code expects this to exist.
+ #:configure-flags '("--enable-compat-symlinks")
+ #:make-flags (list (string-append "PREFIX=" %output)
"CC=gcc")))
(native-inputs
`(("xxd" ,vim))) ; for tests
--
2.12.2
From d3e733739edebfd42efd70e7cc6335f3862f1ed5 Mon Sep 17 00:00:00 2001
From: Marius Bakke
Date: Mon, 17 Apr 2017 22:25:43 +0200
Subject: [PATCH 4/4] gnu: vm: Add FAT32 utilities in base image.
* gnu/system/vm.scm (qemu-image): Add DOSFSTOOLS to the closure.
---
gnu/system/vm.scm | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 867802342..0f4e3ef7d 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -201,7 +201,7 @@ the image."
(guix build utils))
(let ((inputs
- '#$(append (list qemu parted grub e2fsprogs)
+ '#$(append (list qemu parted grub e2fsprogs dosfstools)
(map canonical-package
(list sed grep coreutils findutils gawk))
(if register-closures? (list guix) '())))
--
2.12.2