* [PATCH 1/8] file-systems: Add FAT32 support.
2017-02-14 15:28 [PATCH 0/8] WIP: Better support for non-grub bootloaders David Craven
@ 2017-02-14 15:28 ` David Craven
2017-03-01 16:30 ` Danny Milosavljevic
2017-02-14 15:28 ` [PATCH 2/8] system: Pass <bootloader-parameter> to grub David Craven
` (8 subsequent siblings)
9 siblings, 1 reply; 19+ messages in thread
From: David Craven @ 2017-02-14 15:28 UTC (permalink / raw)
To: guix-devel
* gnu/build/file-systems.scm (%fat32-endianness, fat32-superblock?,
read-fat32-superblock, fat32-superblock-uuid, fat32-uuid->string,
fat32-superblock-volume-name, check-fat32-file-system): New variables.
(%partition-label-readers, %partition-uuid-readers, check-file-system): Add
fat support.
(latin1->string): New variable.
(null-terminated-latin1->string): Use latin1->string.
---
gnu/build/file-systems.scm | 66 +++++++++++++++++++++++++++++++++++++++++-----
1 file changed, 59 insertions(+), 7 deletions(-)
diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index f8ab95370..8c621d439 100644
--- a/gnu/build/file-systems.scm
+++ b/gnu/build/file-systems.scm
@@ -106,15 +106,17 @@ takes a bytevector and returns #t when it's a valid superblock."
(bytevector-copy! bv start result 0 size)
result))
-(define (null-terminated-latin1->string bv)
- "Return the volume name of SBLOCK as a string of at most 256 characters, or
-#f if SBLOCK has no volume name."
- ;; This is a Latin-1, nul-terminated string.
- (let ((bytes (take-while (negate zero?) (bytevector->u8-list bv))))
+(define (latin1->string bv terminator)
+ "Return a string of BV, a latin1 bytevector, or #f. TERMINATOR is a predicate
+that takes a number and returns #t when a termination character is found."
+ (let ((bytes (take-while (negate terminator) (bytevector->u8-list bv))))
(if (null? bytes)
#f
(list->string (map integer->char bytes)))))
+(define null-terminated-latin1->string
+ (cut latin1->string <> zero?))
+
\f
;;;
;;; Ext2 file systems.
@@ -194,6 +196,51 @@ if DEVICE does not contain a btrfs file system."
\f
;;;
+;;; FAT32 file systems.
+;;;
+
+;; <http://www.ecma-international.org/publications/files/ECMA-ST/Ecma-107.pdf>.
+
+(define-syntax %fat32-endianness
+ ;; Endianness of fat file systems.
+ (identifier-syntax (endianness little)))
+
+(define (fat32-superblock? sblock)
+ "Return #t when SBLOCK is a fat32 superblock."
+ (bytevector=? (sub-bytevector sblock 82 8)
+ (string->utf8 "FAT32 ")))
+
+(define (read-fat32-superblock device)
+ "Return the raw contents of DEVICE's btrfs superblock as a bytevector, or #f
+if DEVICE does not contain a fat file system."
+ (read-superblock device 0 90 fat32-superblock?))
+
+(define (fat32-superblock-uuid sblock)
+ "Return the Volume ID of a fat superblock SBLOCK as a 4-byte bytevector."
+ (sub-bytevector sblock 67 4))
+
+(define (fat32-uuid->string uuid)
+ "Convert fat32 UUID, a 4-byte bytevector, to its string representation."
+ (let ((high (bytevector-uint-ref uuid 0 %fat32-endianness 2))
+ (low (bytevector-uint-ref uuid 2 %fat32-endianness 2)))
+ (format #f "~:@(~x-~x~)" low high)))
+
+(define (fat32-superblock-volume-name sblock)
+ "Return the volume name of SBLOCK as a string of at most 11 characters, or
+#f if SBLOCK has no volume name. The volume name is a space terminated latin1
+string."
+ (latin1->string (sub-bytevector sblock 71 11) (cut eq? 32 <>)))
+
+(define (check-fat32-file-system device)
+ "Return the health of a fat file system on DEVICE."
+ (match (status:exit-val
+ (system* "dosfsck" "-v" "-a" device))
+ (0 'pass)
+ (1 'errors-corrected)
+ (_ 'fatal-error)))
+
+\f
+;;;
;;; LUKS encrypted devices.
;;;
@@ -307,13 +354,17 @@ partition field reader that returned a value."
(list (partition-field-reader read-ext2-superblock
ext2-superblock-volume-name)
(partition-field-reader read-btrfs-superblock
- btrfs-superblock-volume-name)))
+ btrfs-superblock-volume-name)
+ (partition-field-reader read-fat32-superblock
+ fat32-superblock-volume-name)))
(define %partition-uuid-readers
(list (partition-field-reader read-ext2-superblock
ext2-superblock-uuid)
(partition-field-reader read-btrfs-superblock
- btrfs-superblock-uuid)))
+ btrfs-superblock-uuid)
+ (partition-field-reader read-fat32-superblock
+ fat32-superblock-uuid)))
(define read-partition-label
(cut read-partition-field <> %partition-label-readers))
@@ -481,6 +532,7 @@ the following:
(cond
((string-prefix? "ext" type) check-ext2-file-system)
((string-prefix? "btrfs" type) check-btrfs-file-system)
+ ((string-prefix? "vfat" type) check-fat32-file-system)
(else #f)))
(if check-procedure
--
2.11.1
^ permalink raw reply related [flat|nested] 19+ messages in thread* [PATCH 2/8] system: Pass <bootloader-parameter> to grub.
2017-02-14 15:28 [PATCH 0/8] WIP: Better support for non-grub bootloaders David Craven
2017-02-14 15:28 ` [PATCH 1/8] file-systems: Add FAT32 support David Craven
@ 2017-02-14 15:28 ` David Craven
2017-02-14 15:28 ` [PATCH 2/8] system: Pass <boot-parameters> " David Craven
` (7 subsequent siblings)
9 siblings, 0 replies; 19+ messages in thread
From: David Craven @ 2017-02-14 15:28 UTC (permalink / raw)
To: guix-devel
* gnu/system.scm (operating-system-grub.cfg): Pass <bootloader-parameter>.
* gnu/system/grub.scm (boot-parameters->menu-entry): New variable.
(grub-configuration-file): Use boot-parameters->menu-entry.
---
gnu/system.scm | 12 +++++++-----
gnu/system/grub.scm | 19 +++++++++++++++----
2 files changed, 22 insertions(+), 9 deletions(-)
diff --git a/gnu/system.scm b/gnu/system.scm
index 1006c842c..adbbe37b5 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -97,6 +97,7 @@
operating-system-locale-directory
operating-system-boot-script
+ <boot-parameters>
boot-parameters
boot-parameters?
boot-parameters-label
@@ -738,16 +739,17 @@ listed in OS. The C library expects to find it under
(root-device -> (if (eq? 'uuid (file-system-title root-fs))
(uuid->string (file-system-device root-fs))
(file-system-device root-fs)))
- (entries -> (list (menu-entry
+ (entries -> (list (boot-parameters
(label label)
+ (root-device root-device)
;; The device where the kernel and initrd live.
- (device (grub-device store-fs))
- (device-mount-point
+ (store-device (grub-device store-fs))
+ (store-mount-point
(file-system-mount-point store-fs))
- (linux kernel)
- (linux-arguments
+ (kernel kernel)
+ (kernel-arguments
(cons* (string-append "--root=" root-device)
#~(string-append "--system=" #$system)
#~(string-append "--load=" #$system
diff --git a/gnu/system/grub.scm b/gnu/system/grub.scm
index b18b8be6d..6bb12b801 100644
--- a/gnu/system/grub.scm
+++ b/gnu/system/grub.scm
@@ -26,6 +26,7 @@
#:use-module (guix gexp)
#:use-module (guix download)
#:use-module (gnu artwork)
+ #:use-module (gnu system)
#:use-module (gnu system file-systems)
#:autoload (gnu packages bootloaders) (grub)
#:autoload (gnu packages compression) (gzip)
@@ -264,6 +265,15 @@ code."
(#f
#~(format #f "search --file --set ~a" #$file)))))
+(define (boot-parameters->menu-entry conf)
+ (menu-entry
+ (label (boot-parameters-label conf))
+ (device (boot-parameters-store-device conf))
+ (device-mount-point (boot-parameters-store-mount-point conf))
+ (linux (boot-parameters-kernel conf))
+ (linux-arguments (boot-parameters-kernel-arguments conf))
+ (initrd (boot-parameters-initrd conf))))
+
(define* (grub-configuration-file config entries
#:key
(system (%current-system))
@@ -273,7 +283,8 @@ code."
<file-system> object. OLD-ENTRIES is taken to be a list of menu entries
corresponding to old generations of the system."
(define all-entries
- (append entries (grub-configuration-menu-entries config)))
+ (append (map boot-parameters->menu-entry entries)
+ (grub-configuration-menu-entries config)))
(define entry->gexp
(match-lambda
@@ -296,9 +307,9 @@ corresponding to old generations of the system."
#$initrd)))))
(mlet %store-monad ((sugar (eye-candy config
- (menu-entry-device (first entries))
+ (menu-entry-device (first all-entries))
(menu-entry-device-mount-point
- (first entries))
+ (first all-entries))
#:system system
#:port #~port)))
(define builder
@@ -319,7 +330,7 @@ set timeout=~a~%"
#$@(if (pair? old-entries)
#~((format port "
submenu \"GNU system, old configurations...\" {~%")
- #$@(map entry->gexp old-entries)
+ #$@(map entry->gexp (map boot-parameters->menu-entry old-entries))
(format port "}~%"))
#~()))))
--
2.11.1
^ permalink raw reply related [flat|nested] 19+ messages in thread* [PATCH 2/8] system: Pass <boot-parameters> to grub.
2017-02-14 15:28 [PATCH 0/8] WIP: Better support for non-grub bootloaders David Craven
2017-02-14 15:28 ` [PATCH 1/8] file-systems: Add FAT32 support David Craven
2017-02-14 15:28 ` [PATCH 2/8] system: Pass <bootloader-parameter> to grub David Craven
@ 2017-02-14 15:28 ` David Craven
2017-02-14 15:28 ` [PATCH 3/8] system: Add extlinux support David Craven
` (6 subsequent siblings)
9 siblings, 0 replies; 19+ messages in thread
From: David Craven @ 2017-02-14 15:28 UTC (permalink / raw)
To: guix-devel
* gnu/system.scm (operating-system-grub.cfg): Pass <boot-parameters>.
* gnu/system/grub.scm (boot-parameters->menu-entry): New variable.
(grub-configuration-file): Use boot-parameters->menu-entry.
---
gnu/system.scm | 12 +++++++-----
gnu/system/grub.scm | 19 +++++++++++++++----
2 files changed, 22 insertions(+), 9 deletions(-)
diff --git a/gnu/system.scm b/gnu/system.scm
index 1006c842c..adbbe37b5 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -97,6 +97,7 @@
operating-system-locale-directory
operating-system-boot-script
+ <boot-parameters>
boot-parameters
boot-parameters?
boot-parameters-label
@@ -738,16 +739,17 @@ listed in OS. The C library expects to find it under
(root-device -> (if (eq? 'uuid (file-system-title root-fs))
(uuid->string (file-system-device root-fs))
(file-system-device root-fs)))
- (entries -> (list (menu-entry
+ (entries -> (list (boot-parameters
(label label)
+ (root-device root-device)
;; The device where the kernel and initrd live.
- (device (grub-device store-fs))
- (device-mount-point
+ (store-device (grub-device store-fs))
+ (store-mount-point
(file-system-mount-point store-fs))
- (linux kernel)
- (linux-arguments
+ (kernel kernel)
+ (kernel-arguments
(cons* (string-append "--root=" root-device)
#~(string-append "--system=" #$system)
#~(string-append "--load=" #$system
diff --git a/gnu/system/grub.scm b/gnu/system/grub.scm
index b18b8be6d..6bb12b801 100644
--- a/gnu/system/grub.scm
+++ b/gnu/system/grub.scm
@@ -26,6 +26,7 @@
#:use-module (guix gexp)
#:use-module (guix download)
#:use-module (gnu artwork)
+ #:use-module (gnu system)
#:use-module (gnu system file-systems)
#:autoload (gnu packages bootloaders) (grub)
#:autoload (gnu packages compression) (gzip)
@@ -264,6 +265,15 @@ code."
(#f
#~(format #f "search --file --set ~a" #$file)))))
+(define (boot-parameters->menu-entry conf)
+ (menu-entry
+ (label (boot-parameters-label conf))
+ (device (boot-parameters-store-device conf))
+ (device-mount-point (boot-parameters-store-mount-point conf))
+ (linux (boot-parameters-kernel conf))
+ (linux-arguments (boot-parameters-kernel-arguments conf))
+ (initrd (boot-parameters-initrd conf))))
+
(define* (grub-configuration-file config entries
#:key
(system (%current-system))
@@ -273,7 +283,8 @@ code."
<file-system> object. OLD-ENTRIES is taken to be a list of menu entries
corresponding to old generations of the system."
(define all-entries
- (append entries (grub-configuration-menu-entries config)))
+ (append (map boot-parameters->menu-entry entries)
+ (grub-configuration-menu-entries config)))
(define entry->gexp
(match-lambda
@@ -296,9 +307,9 @@ corresponding to old generations of the system."
#$initrd)))))
(mlet %store-monad ((sugar (eye-candy config
- (menu-entry-device (first entries))
+ (menu-entry-device (first all-entries))
(menu-entry-device-mount-point
- (first entries))
+ (first all-entries))
#:system system
#:port #~port)))
(define builder
@@ -319,7 +330,7 @@ set timeout=~a~%"
#$@(if (pair? old-entries)
#~((format port "
submenu \"GNU system, old configurations...\" {~%")
- #$@(map entry->gexp old-entries)
+ #$@(map entry->gexp (map boot-parameters->menu-entry old-entries))
(format port "}~%"))
#~()))))
--
2.11.1
^ permalink raw reply related [flat|nested] 19+ messages in thread* [PATCH 3/8] system: Add extlinux support.
2017-02-14 15:28 [PATCH 0/8] WIP: Better support for non-grub bootloaders David Craven
` (2 preceding siblings ...)
2017-02-14 15:28 ` [PATCH 2/8] system: Pass <boot-parameters> " David Craven
@ 2017-02-14 15:28 ` David Craven
2017-02-14 15:28 ` [PATCH 4/8] scripts: system: Rename --no-grub option to --no-bootloader David Craven
` (5 subsequent siblings)
9 siblings, 0 replies; 19+ messages in thread
From: David Craven @ 2017-02-14 15:28 UTC (permalink / raw)
To: guix-devel
* gnu/system.scm (operating-system): Add default bootloader.
(operating-system-grub.cfg): Use bootloader-configuration-file-procedure.
* gnu/system/grub.scm (bootloader-configuration->grub-configuration): New
variable.
(grub-configuration-file): Use bootloader-configuration->grub-configuration.
* guix/scripts/system.scm (profile-grub-entries): Rename system->grub-entry to
system->boot-parameters and adjust accordingly.
(perform-action): Make bootloader optional. Use
bootloader-configuration-device.
* gnu/system/bootloader.scm: New file.
* gnu/local.mk (GNU_SYSTEM_MODULES): Add it.
* tests/system.scm: Adjust operating-system to new API.
* tests/guix-system.sh: Adjust operating-system to new API.
---
gnu/local.mk | 1 +
gnu/system.scm | 10 +--
gnu/system/bootloader.scm | 158 ++++++++++++++++++++++++++++++++++++++++++++++
gnu/system/grub.scm | 22 ++++---
guix/scripts/system.scm | 44 ++++++-------
tests/guix-system.sh | 2 -
tests/system.scm | 2 -
7 files changed, 197 insertions(+), 42 deletions(-)
create mode 100644 gnu/system/bootloader.scm
diff --git a/gnu/local.mk b/gnu/local.mk
index 26f6bbf0d..0b1cbd9ac 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -431,6 +431,7 @@ GNU_SYSTEM_MODULES = \
\
%D%/system.scm \
%D%/system/file-systems.scm \
+ %D%/system/bootloader.scm \
%D%/system/grub.scm \
%D%/system/install.scm \
%D%/system/linux-container.scm \
diff --git a/gnu/system.scm b/gnu/system.scm
index adbbe37b5..b1402d3e9 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -47,7 +47,7 @@
#:use-module (gnu services)
#:use-module (gnu services shepherd)
#:use-module (gnu services base)
- #:use-module (gnu system grub)
+ #:use-module (gnu system bootloader)
#:use-module (gnu system shadow)
#:use-module (gnu system nss)
#:use-module (gnu system locale)
@@ -129,8 +129,8 @@
(default linux-libre))
(kernel-arguments operating-system-kernel-arguments
(default '())) ; list of gexps/strings
- (bootloader operating-system-bootloader) ; <grub-configuration>
-
+ (bootloader operating-system-bootloader ; <bootloader-configuration>
+ (default (extlinux-configuration)))
(initrd operating-system-initrd ; (list fs) -> M derivation
(default base-initrd))
(firmware operating-system-firmware ; list of packages
@@ -756,8 +756,8 @@ listed in OS. The C library expects to find it under
"/boot")
(operating-system-kernel-arguments os)))
(initrd initrd)))))
- (grub-configuration-file (operating-system-bootloader os) entries
- #:old-entries old-entries)))
+ ((bootloader-configuration-file-procedure (operating-system-bootloader os))
+ (operating-system-bootloader os) entries #:old-entries old-entries)))
(define (grub-device fs)
"Given FS, a <file-system> object, return a value suitable for use as the
diff --git a/gnu/system/bootloader.scm b/gnu/system/bootloader.scm
new file mode 100644
index 000000000..6366ba1cc
--- /dev/null
+++ b/gnu/system/bootloader.scm
@@ -0,0 +1,158 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2017 David Craven <david@craven.ch>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu system bootloader)
+ #:use-module (gnu system)
+ #:use-module (gnu system grub)
+ #:use-module (guix gexp)
+ #:use-module (guix packages)
+ #:use-module (guix records)
+ #:use-module (ice-9 match)
+ #:export (bootloader-configuration
+ bootloader-configuration?
+ bootloader-configuration-bootloader
+ bootloader-configuration-device
+ bootloader-configuration-menu-entries
+ bootloader-configuration-default-entry
+ bootloader-configuration-timeout
+ bootloader-configuration-file-location
+ bootloader-configuration-file-procedure
+ bootloader-configuration-install-procedure
+ bootloader-configuration-additional-configuration
+
+ extlinux-configuration
+ grub-configuration
+ grub-efi-configuration
+ syslinux-configuration))
+
+;;; Commentary:
+;;;
+;;; Generic configuration for bootloaders.
+;;;
+;;; Code:
+
+(define-record-type* <bootloader-configuration>
+ bootloader-configuration make-bootloader-configuration
+ bootloader-configuration?
+ (bootloader bootloader-configuration-bootloader ; package
+ (default #f))
+ (device bootloader-configuration-device ; string
+ (default #f))
+ (menu-entries bootloader-configuration-menu-entries ; list of <boot-parameters>
+ (default '()))
+ (default-entry bootloader-configuration-default-entry ; integer
+ (default 0))
+ (timeout bootloader-configuration-timeout ; integer
+ (default 5))
+ (configuration-file-location bootloader-configuration-file-location
+ (default #f))
+ (configuration-file-procedure bootloader-configuration-file-procedure ; procedure
+ (default #f))
+ (install-procedure bootloader-configuration-install-procedure ; procedure
+ (default #f))
+ (additional-configuration bootloader-configuration-additional-configuration ; record
+ (default #f)))
+
+\f
+
+;;;
+;;; Extlinux configuration file.
+;;;
+
+(define* (extlinux-configuration-file config entries
+ #:key
+ (system (%current-system))
+ (old-entries '()))
+ "Return the U-Boot configuration file corresponding to CONFIG, a
+<u-boot-configuration> object, and where the store is available at STORE-FS, a
+<file-system> object. OLD-ENTRIES is taken to be a list of menu entries
+corresponding to old generations of the system."
+
+ (define all-entries
+ (append entries (bootloader-configuration-menu-entries config)))
+
+ (define boot-parameters->gexp
+ (match-lambda
+ (($ <boot-parameters> label _ _ _ kernel kernel-arguments initrd)
+ #~(format port "LABEL ~a
+ MENU LABEL ~a
+ KERNEL ~a
+ FDTDIR ~a/lib/dtbs
+ INITRD ~a
+ APPEND ~a
+~%"
+ #$label #$label
+ #$kernel #$kernel #$initrd
+ (string-join (list #$@kernel-arguments))))))
+
+ (define builder
+ #~(call-with-output-file #$output
+ (lambda (port)
+ (let ((timeout #$(bootloader-configuration-timeout config)))
+ (format port "
+UI menu.c32
+PROMPT ~a
+TIMEOUT ~a~%"
+ (if (> timeout 0) 1 0)
+ (* 10 timeout))
+ #$@(map boot-parameters->gexp all-entries)
+
+ #$@(if (pair? old-entries)
+ #~((format port "~%")
+ #$@(map boot-parameters->gexp old-entries)
+ (format port "~%"))
+ #~())))))
+
+ (gexp->derivation "extlinux.conf" builder))
+
+
+\f
+
+;;;
+;;; Bootloader configurations.
+;;;
+
+(define* (extlinux-configuration #:optional (config (bootloader-configuration)))
+ (bootloader-configuration
+ (inherit config)
+ (configuration-file-location "/boot/extlinux/extlinux.conf")
+ (configuration-file-procedure extlinux-configuration-file)))
+
+(define* (grub-configuration #:optional (config (bootloader-configuration)))
+ (bootloader-configuration
+ (inherit config)
+ (bootloader (@ (gnu packages bootloaders) grub))
+ (configuration-file-location "/boot/grub/grub.cfg")
+ (configuration-file-procedure grub-configuration-file)
+ (install-procedure install-grub)
+ (additional-configuration
+ (let ((additional-config (bootloader-configuration-additional-configuration config)))
+ (if additional-config additional-config %default-theme)))))
+
+(define* (grub-efi-configuration #:optional (config (bootloader-configuration)))
+ (bootloader-configuration
+ (inherit (grub-configuration config))
+ (bootloader (@ (gnu packages bootloaders) grub-efi))))
+
+(define* (syslinux-configuration #:optional (config (bootloader-configuration)))
+ (bootloader-configuration
+ (inherit (extlinux-configuration config))
+ (bootloader (@ (gnu packages bootloaders) syslinux))
+ (install-procedure install-syslinux)))
+
+;;; bootloader.scm ends here
diff --git a/gnu/system/grub.scm b/gnu/system/grub.scm
index 6bb12b801..d0cc33f97 100644
--- a/gnu/system/grub.scm
+++ b/gnu/system/grub.scm
@@ -27,6 +27,7 @@
#:use-module (guix download)
#:use-module (gnu artwork)
#:use-module (gnu system)
+ #:use-module (gnu system bootloader)
#:use-module (gnu system file-systems)
#:autoload (gnu packages bootloaders) (grub)
#:autoload (gnu packages compression) (gzip)
@@ -49,14 +50,6 @@
%background-image
%default-theme
- grub-configuration
- grub-configuration?
- grub-configuration-device
- grub-configuration-grub
-
- menu-entry
- menu-entry?
-
grub-configuration-file))
;;; Commentary:
@@ -274,7 +267,16 @@ code."
(linux-arguments (boot-parameters-kernel-arguments conf))
(initrd (boot-parameters-initrd conf))))
-(define* (grub-configuration-file config entries
+(define (bootloader-configuration->grub-configuration config)
+ (grub-configuration
+ (grub (bootloader-configuration-bootloader config))
+ (device (bootloader-configuration-device config))
+ (menu-entries (bootloader-configuration-menu-entries config))
+ (default-entry (bootloader-configuration-default-entry config))
+ (timeout (bootloader-configuration-timeout config))
+ (theme (bootloader-configuration-additional-configuration config))))
+
+(define* (grub-configuration-file bootloader-config entries
#:key
(system (%current-system))
(old-entries '()))
@@ -282,6 +284,8 @@ code."
<grub-configuration> object, and where the store is available at STORE-FS, a
<file-system> object. OLD-ENTRIES is taken to be a list of menu entries
corresponding to old generations of the system."
+ (define config (bootloader-configuration->grub-configuration bootloader-config))
+
(define all-entries
(append (map boot-parameters->menu-entry entries)
(grub-configuration-menu-entries config)))
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 144a7fd37..fb32d08a5 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -37,10 +37,10 @@
#:use-module (guix build utils)
#:use-module (gnu build install)
#:use-module (gnu system)
+ #:use-module (gnu system bootloader)
#:use-module (gnu system file-systems)
#:use-module (gnu system linux-container)
#:use-module (gnu system vm)
- #:use-module (gnu system grub)
#:use-module (gnu services)
#:use-module (gnu services shepherd)
#:use-module (gnu services herd)
@@ -366,32 +366,25 @@ it atomically, and then run OS's activation script."
(numbers (generation-numbers profile)))
"Return a list of 'menu-entry' for the generations of PROFILE specified by
NUMBERS, which is a list of generation numbers."
- (define (system->grub-entry system number time)
+ (define (system->boot-parameters system number time)
(unless-file-not-found
(let* ((file (string-append system "/parameters"))
(params (call-with-input-file file
read-boot-parameters))
- (label (boot-parameters-label params))
(root (boot-parameters-root-device params))
(root-device (if (bytevector? root)
(uuid->string root)
- root))
- (kernel (boot-parameters-kernel params))
- (kernel-arguments (boot-parameters-kernel-arguments params))
- (initrd (boot-parameters-initrd params)))
- (menu-entry
- (label (string-append label " (#"
+ root)))
+ (boot-parameters
+ (inherit params)
+ (label (string-append (boot-parameters-label params) " (#"
(number->string number) ", "
(seconds->string time) ")"))
- (device (boot-parameters-store-device params))
- (device-mount-point (boot-parameters-store-mount-point params))
- (linux kernel)
- (linux-arguments
- (cons* (string-append "--root=" root-device)
+ (kernel-arguments
+ (cons* (string-append "--root=" (boot-parameters-root-device params))
(string-append "--system=" system)
(string-append "--load=" system "/boot")
- kernel-arguments))
- (initrd initrd)))))
+ (boot-parameters-kernel-arguments params)))))))
(let* ((systems (map (cut generation-file-name profile <>)
numbers))
@@ -399,7 +392,7 @@ NUMBERS, which is a list of generation numbers."
(unless-file-not-found
(stat:mtime (lstat system))))
systems)))
- (filter-map system->grub-entry systems numbers times)))
+ (filter-map system->boot-parameters systems numbers times)))
\f
;;;
@@ -613,8 +606,11 @@ building anything."
#:image-size image-size
#:full-boot? full-boot?
#:mappings mappings))
- (grub (package->derivation (grub-configuration-grub
- (operating-system-bootloader os))))
+ (bootloader (let ((bootloader (bootloader-configuration-bootloader
+ (operating-system-bootloader os))))
+ (if bootloader
+ (package->derivation bootloader)
+ (return #f))))
(grub.cfg (if (eq? 'container action)
(return #f)
(operating-system-grub.cfg os
@@ -626,8 +622,8 @@ building anything."
;; --no-grub is passed, because GRUB.CFG because we then use it as a GC
;; root. See <http://bugs.gnu.org/21068>.
(drvs -> (if (memq action '(init reconfigure))
- (if grub?
- (list sys grub.cfg grub)
+ (if (and grub? bootloader)
+ (list sys grub.cfg bootloader)
(list sys grub.cfg))
(list sys)))
(% (if derivations-only?
@@ -643,8 +639,8 @@ building anything."
drvs)
;; Make sure GRUB is accessible.
- (when grub?
- (let ((prefix (derivation->output-path grub)))
+ (when (and grub? bootloader)
+ (let ((prefix (derivation->output-path bootloader)))
(setenv "PATH"
(string-append prefix "/bin:" prefix "/sbin:"
(getenv "PATH")))))
@@ -835,7 +831,7 @@ resulting from command-line parsing."
((first second) second)
(_ #f)))
(device (and grub?
- (grub-configuration-device
+ (bootloader-configuration-device
(operating-system-bootloader os)))))
(with-store store
diff --git a/tests/guix-system.sh b/tests/guix-system.sh
index 77d4e2899..063e884be 100644
--- a/tests/guix-system.sh
+++ b/tests/guix-system.sh
@@ -84,7 +84,6 @@ OS_BASE='
(timezone "Europe/Paris")
(locale "en_US.UTF-8")
- (bootloader (grub-configuration (device "/dev/sdX")))
(file-systems (cons (file-system
(device "root")
(title (string->symbol "label"))
@@ -155,7 +154,6 @@ make_user_config ()
(timezone "Europe/Paris")
(locale "en_US.UTF-8")
- (bootloader (grub-configuration (device "/dev/sdX")))
(file-systems (cons (file-system
(device "root")
(title 'label)
diff --git a/tests/system.scm b/tests/system.scm
index ca34409be..bdda08e18 100644
--- a/tests/system.scm
+++ b/tests/system.scm
@@ -36,7 +36,6 @@
(host-name "komputilo")
(timezone "Europe/Berlin")
(locale "en_US.utf8")
- (bootloader (grub-configuration (device "/dev/sdX")))
(file-systems (cons %root-fs %base-file-systems))
(users %base-user-accounts)))
@@ -51,7 +50,6 @@
(host-name "komputilo")
(timezone "Europe/Berlin")
(locale "en_US.utf8")
- (bootloader (grub-configuration (device "/dev/sdX")))
(mapped-devices (list %luks-device))
(file-systems (cons (file-system
(inherit %root-fs)
--
2.11.1
^ permalink raw reply related [flat|nested] 19+ messages in thread* [PATCH 4/8] scripts: system: Rename --no-grub option to --no-bootloader.
2017-02-14 15:28 [PATCH 0/8] WIP: Better support for non-grub bootloaders David Craven
` (3 preceding siblings ...)
2017-02-14 15:28 ` [PATCH 3/8] system: Add extlinux support David Craven
@ 2017-02-14 15:28 ` David Craven
2017-02-14 15:28 ` [PATCH 5/8] vm: Remove hard coded kernel file name David Craven
` (4 subsequent siblings)
9 siblings, 0 replies; 19+ messages in thread
From: David Craven @ 2017-02-14 15:28 UTC (permalink / raw)
To: guix-devel
* guix/scripts/system.scm (%options, show-help): Adjust accordingly.
---
guix/scripts/system.scm | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index fb32d08a5..04274919e 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -733,7 +733,7 @@ Some ACTIONS support additional ARGS.\n"))
(display (_ "
--image-size=SIZE for 'vm-image', produce an image of SIZE"))
(display (_ "
- --no-grub for 'init', do not install GRUB"))
+ --no-bootloader for 'init', do not install a bootloader"))
(display (_ "
--share=SPEC for 'vm', share host file system according to SPEC"))
(display (_ "
@@ -768,7 +768,7 @@ Some ACTIONS support additional ARGS.\n"))
(lambda (opt name arg result)
(alist-cons 'image-size (size->number arg)
result)))
- (option '("no-grub") #f #f
+ (option '("no-bootloader") #f #f
(lambda (opt name arg result)
(alist-cons 'install-grub? #f result)))
(option '("full-boot") #f #f
--
2.11.1
^ permalink raw reply related [flat|nested] 19+ messages in thread* [PATCH 5/8] vm: Remove hard coded kernel file name.
2017-02-14 15:28 [PATCH 0/8] WIP: Better support for non-grub bootloaders David Craven
` (4 preceding siblings ...)
2017-02-14 15:28 ` [PATCH 4/8] scripts: system: Rename --no-grub option to --no-bootloader David Craven
@ 2017-02-14 15:28 ` David Craven
2017-02-28 22:48 ` Danny Milosavljevic
2017-02-14 15:28 ` [PATCH 6/8] vm: Improve readability of run-vm.sh generation David Craven
` (3 subsequent siblings)
9 siblings, 1 reply; 19+ messages in thread
From: David Craven @ 2017-02-14 15:28 UTC (permalink / raw)
To: guix-devel
* gnu/system/vm.scm (system-qemu-image/shared-store-script,
expression->derivation-in-linux-vm): Use operating-system-kernel-file and
system-linux-image-file-name.
* gnu/system.scm (system-linux-image-file-name): Add ARM.
---
gnu/system.scm | 9 ++++++---
gnu/system/vm.scm | 5 +++--
2 files changed, 9 insertions(+), 5 deletions(-)
diff --git a/gnu/system.scm b/gnu/system.scm
index b1402d3e9..f702e6ecc 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -97,6 +97,8 @@
operating-system-locale-directory
operating-system-boot-script
+ system-linux-image-file-name
+
<boot-parameters>
boot-parameters
boot-parameters?
@@ -256,9 +258,10 @@ from the initrd."
(define* (system-linux-image-file-name #:optional (system (%current-system)))
"Return the basename of the kernel image file for SYSTEM."
;; FIXME: Evaluate the conditional based on the actual current system.
- (if (string-prefix? "mips" (%current-system))
- "vmlinuz"
- "bzImage"))
+ (cond
+ ((string-prefix? "arm" (%current-system)) "zImage")
+ ((string-prefix? "mips" (%current-system)) "vmlinuz")
+ (else "bzImage")))
(define (operating-system-kernel-file os)
"Return an object representing the absolute file name of the kernel image of
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 8a35f7fbc..a7203d169 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -141,7 +141,8 @@ made available under the /xchg CIFS share."
(gnu build vm))
(let ((inputs '#$(list qemu coreutils))
- (linux (string-append #$linux "/bzImage"))
+ (linux (string-append #$linux "/"
+ #$(system-linux-image-file-name)))
(initrd (string-append #$initrd "/initrd"))
(loader #$loader)
(graphs '#$(match references-graphs
@@ -487,7 +488,7 @@ exec " #$qemu "/bin/" #$(qemu-command (%current-system))
#$@(if full-boot?
#~()
- #~(" -kernel " #$(operating-system-kernel os) "/bzImage \
+ #~(" -kernel " #$(operating-system-kernel-file os) " \
-initrd " #$os-drv "/initrd \
-append \"" #$(if graphic? "" "console=ttyS0 ")
"--system=" #$os-drv " --load=" #$os-drv "/boot --root=/dev/vda1 "
--
2.11.1
^ permalink raw reply related [flat|nested] 19+ messages in thread* [PATCH 6/8] vm: Improve readability of run-vm.sh generation.
2017-02-14 15:28 [PATCH 0/8] WIP: Better support for non-grub bootloaders David Craven
` (5 preceding siblings ...)
2017-02-14 15:28 ` [PATCH 5/8] vm: Remove hard coded kernel file name David Craven
@ 2017-02-14 15:28 ` David Craven
2017-02-28 23:44 ` Danny Milosavljevic
2017-02-14 15:28 ` [PATCH 7/8] vm: Fix full-boot? option David Craven
` (2 subsequent siblings)
9 siblings, 1 reply; 19+ messages in thread
From: David Craven @ 2017-02-14 15:28 UTC (permalink / raw)
To: guix-devel
* gnu/system/vm.scm (common-qemu-options,
system-qemu-image/shared-store-script): Improve readability.
---
gnu/system/vm.scm | 69 ++++++++++++++++++++++++++++++-------------------------
1 file changed, 38 insertions(+), 31 deletions(-)
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index a7203d169..103af37c9 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -434,25 +434,26 @@ bootloader refers to: OS kernel, initrd, bootloader data, etc."
(define* (common-qemu-options image shared-fs)
"Return the a string-value gexp with the common QEMU options to boot IMAGE,
with '-virtfs' options for the host file systems listed in SHARED-FS."
+
(define (virtfs-option fs)
- #~(string-append "-virtfs local,path=\"" #$fs
- "\",security_model=none,mount_tag=\""
- #$(file-system->mount-tag fs)
- "\" "))
+ #~(format #f "-virtfs local,path=~s,security_model=none,mount_tag=~s"
+ #$fs #$(file-system->mount-tag fs)))
- #~(string-append
- ;; Only enable kvm if we see /dev/kvm exists.
+ #~(;; Only enable kvm if we see /dev/kvm exists.
;; This allows users without hardware virtualization to still use these
;; commands.
- #$(if (file-exists? "/dev/kvm")
- " -enable-kvm "
- "")
- " -no-reboot -net nic,model=virtio \
- " #$@(map virtfs-option shared-fs) " \
- -vga std \
- -drive file=" #$image
- ",if=virtio,cache=writeback,werror=report,readonly \
- -m 256"))
+ #$@(if (file-exists? "/dev/kvm")
+ '("-enable-kvm")
+ '())
+
+ "-no-reboot"
+ "-net nic,model=virtio"
+
+ #$@(map virtfs-option shared-fs)
+ "-vga std"
+ (format #f "-drive file=~a,if=virtio,cache=writeback,werror=report,readonly"
+ #$image)
+ "-m 256"))
(define* (system-qemu-image/shared-store-script os
#:key
@@ -479,25 +480,31 @@ it is mostly useful when FULL-BOOT? is true."
os
#:full-boot? full-boot?
#:disk-image-size disk-image-size)))
+ (define kernel-arguments
+ #~(list "--root=/dev/vda1"
+ (string-append "--system=" #$os-drv)
+ (string-append "--load=" #$os-drv "/boot")
+ #$@(if graphic? #~() #~("console=ttyS0"))
+ #+@(operating-system-kernel-arguments os)))
+
+ (define qemu-exec
+ #~(list (string-append #$qemu "/bin/" #$(qemu-command (%current-system)))
+ #$@(if full-boot?
+ #~()
+ #~("-kernel" #$(operating-system-kernel-file os)
+ "-initrd" #$(file-append os-drv "/initrd")
+ (format #f "-append ~s"
+ (string-join #$kernel-arguments " "))))
+ #$@(common-qemu-options image
+ (map file-system-mapping-source
+ (cons %store-mapping mappings)))))
+
(define builder
#~(call-with-output-file #$output
(lambda (port)
- (display
- (string-append "#!" #$bash "/bin/sh
-exec " #$qemu "/bin/" #$(qemu-command (%current-system))
-
-#$@(if full-boot?
- #~()
- #~(" -kernel " #$(operating-system-kernel-file os) " \
- -initrd " #$os-drv "/initrd \
- -append \"" #$(if graphic? "" "console=ttyS0 ")
- "--system=" #$os-drv " --load=" #$os-drv "/boot --root=/dev/vda1 "
- (string-join (list #+@(operating-system-kernel-arguments os))) "\" "))
-#$(common-qemu-options image
- (map file-system-mapping-source
- (cons %store-mapping mappings)))
-" \"$@\"\n")
- port)
+ (format port "#!~a~% exec ~a \"$@\"~%"
+ #$(file-append bash "/bin/sh")
+ (string-join #$qemu-exec " "))
(chmod port #o555))))
(gexp->derivation "run-vm.sh" builder)))
--
2.11.1
^ permalink raw reply related [flat|nested] 19+ messages in thread* [PATCH 7/8] vm: Fix full-boot? option.
2017-02-14 15:28 [PATCH 0/8] WIP: Better support for non-grub bootloaders David Craven
` (6 preceding siblings ...)
2017-02-14 15:28 ` [PATCH 6/8] vm: Improve readability of run-vm.sh generation David Craven
@ 2017-02-14 15:28 ` David Craven
2017-03-06 22:44 ` Ludovic Courtès
2017-02-14 15:28 ` [PATCH 8/8] bootloader: Add install procedures and use them David Craven
2017-03-06 22:04 ` [PATCH 0/8] WIP: Better support for non-grub bootloaders Ludovic Courtès
9 siblings, 1 reply; 19+ messages in thread
From: David Craven @ 2017-02-14 15:28 UTC (permalink / raw)
To: guix-devel
* gnu/system/vm.scm (virtualized-operating-system): Add full-boot?
option. Don't add a %store-mapping when full-boot? is passed. This leads
the grub-configuration-file procedure to look for the kernel and initrd in
/ instead of /gnu/store.
---
gnu/system/vm.scm | 31 ++++++++++++++++++-------------
1 file changed, 18 insertions(+), 13 deletions(-)
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 103af37c9..9f914d03c 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -365,7 +365,7 @@ of the GNU system as described by OS."
(check? #f)
(create-mount-point? #t)))))
-(define (virtualized-operating-system os mappings)
+(define* (virtualized-operating-system os mappings #:optional (full-boot? #f))
"Return an operating system based on OS suitable for use in a virtualized
environment with the store shared with the host. MAPPINGS is a list of
<file-system-mapping> to realize in the virtualized OS."
@@ -381,6 +381,15 @@ environment with the store shared with the host. MAPPINGS is a list of
(string-prefix? "/dev/" source)))))
(operating-system-file-systems os)))
+ (define virtual-file-systems
+ (cons (file-system
+ (mount-point "/")
+ (device "/dev/vda1")
+ (type "ext4"))
+
+ (append (map mapping->file-system mappings)
+ user-file-systems)))
+
(operating-system (inherit os)
(initrd (lambda (file-systems . rest)
(apply base-initrd file-systems
@@ -391,17 +400,13 @@ environment with the store shared with the host. MAPPINGS is a list of
;; Disable swap.
(swap-devices '())
- (file-systems (cons* (file-system
- (mount-point "/")
- (device "/dev/vda1")
- (type "ext4"))
-
- (file-system (inherit
- (mapping->file-system %store-mapping))
- (needed-for-boot? #t))
-
- (append (map mapping->file-system mappings)
- user-file-systems)))))
+ (file-systems (if full-boot?
+ virtual-file-systems
+ (cons
+ (file-system
+ (inherit (mapping->file-system %store-mapping))
+ (needed-for-boot? #t))
+ virtual-file-systems)))))
(define* (system-qemu-image/shared-store
os
@@ -474,7 +479,7 @@ When FULL-BOOT? is true, the returned script runs everything starting from the
bootloader; otherwise it directly starts the operating system kernel. The
DISK-IMAGE-SIZE parameter specifies the size in bytes of the root disk image;
it is mostly useful when FULL-BOOT? is true."
- (mlet* %store-monad ((os -> (virtualized-operating-system os mappings))
+ (mlet* %store-monad ((os -> (virtualized-operating-system os mappings full-boot?))
(os-drv (operating-system-derivation os))
(image (system-qemu-image/shared-store
os
--
2.11.1
^ permalink raw reply related [flat|nested] 19+ messages in thread* [PATCH 8/8] bootloader: Add install procedures and use them.
2017-02-14 15:28 [PATCH 0/8] WIP: Better support for non-grub bootloaders David Craven
` (7 preceding siblings ...)
2017-02-14 15:28 ` [PATCH 7/8] vm: Fix full-boot? option David Craven
@ 2017-02-14 15:28 ` David Craven
2017-03-06 22:04 ` [PATCH 0/8] WIP: Better support for non-grub bootloaders Ludovic Courtès
9 siblings, 0 replies; 19+ messages in thread
From: David Craven @ 2017-02-14 15:28 UTC (permalink / raw)
To: guix-devel
* gnu/system/bootloader.scm (dd, install-grub, install-syslinux): New
procedures.
* gnu/build/install.scm (install-boot-config): New procedure.
(install-grub): Move to (gnu system bootloader).
* gnu/build/vm.scm (register-bootcfg-root): Rename register-grub.cfg-root and
adjust accordingly.
(initialize-hard-disk): Takes a bootloader, bootcfg, bootcfg-location and
install-bootloader procedure. Adjust accordingly.
* gnu/system/vm.scm (qemu-image): Adjust to initialize-hard-disk.
(system-disk-image, system-qemu-image, system-qemu-image/shared-store):
Adjust to qemu-image.
---
gnu/build/install.scm | 36 ++++++++--------------------------
gnu/build/vm.scm | 17 ++++++++++------
gnu/system/bootloader.scm | 49 ++++++++++++++++++++++++++++++++++++++++++++++-
gnu/system/vm.scm | 37 +++++++++++++++++++++++------------
4 files changed, 92 insertions(+), 47 deletions(-)
diff --git a/gnu/build/install.scm b/gnu/build/install.scm
index 5c2b35632..e970c79ec 100644
--- a/gnu/build/install.scm
+++ b/gnu/build/install.scm
@@ -22,8 +22,7 @@
#:use-module (guix build store-copy)
#:use-module (srfi srfi-26)
#:use-module (ice-9 match)
- #:export (install-grub
- install-grub-config
+ #:export (install-boot-config
populate-root-file-system
reset-timestamps
register-closure
@@ -38,36 +37,17 @@
;;;
;;; Code:
-(define (install-grub grub.cfg device mount-point)
- "Install GRUB with GRUB.CFG on DEVICE, which is assumed to be mounted on
-MOUNT-POINT.
-
-Note that the caller must make sure that GRUB.CFG is registered as a GC root
-so that the fonts, background images, etc. referred to by GRUB.CFG are not
-GC'd."
- (install-grub-config grub.cfg mount-point)
-
- ;; Tell 'grub-install' that there might be a LUKS-encrypted /boot or root
- ;; partition.
- (setenv "GRUB_ENABLE_CRYPTODISK" "y")
-
- (unless (zero? (system* "grub-install" "--no-floppy"
- "--boot-directory"
- (string-append mount-point "/boot")
- device))
- (error "failed to install GRUB")))
-
-(define (install-grub-config grub.cfg mount-point)
- "Atomically copy GRUB.CFG into boot/grub/grub.cfg on the MOUNT-POINT. Note
-that the caller must make sure that GRUB.CFG is registered as a GC root so
-that the fonts, background images, etc. referred to by GRUB.CFG are not GC'd."
- (let* ((target (string-append mount-point "/boot/grub/grub.cfg"))
+(define (install-boot-config bootcfg bootcfg-location mount-point)
+ "Atomically copy BOOTCFG into BOOTCFG-LOCATION on the MOUNT-POINT. Note
+that the caller must make sure that BOOTCFG is registered as a GC root so
+that the fonts, background images, etc. referred to by BOOTCFG are not GC'd."
+ (let* ((target (string-append mount-point bootcfg-location))
(pivot (string-append target ".new")))
(mkdir-p (dirname target))
- ;; Copy GRUB.CFG instead of just symlinking it, because symlinks won't
+ ;; Copy BOOTCFG instead of just symlinking it, because symlinks won't
;; work when /boot is on a separate partition. Do that atomically.
- (copy-file grub.cfg pivot)
+ (copy-file bootcfg pivot)
(rename-file pivot target)))
(define (evaluate-populate-directive directive target)
diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm
index 60ee18ebe..c536f4f44 100644
--- a/gnu/build/vm.scm
+++ b/gnu/build/vm.scm
@@ -283,15 +283,18 @@ SYSTEM-DIRECTORY is the name of the directory of the 'system' derivation."
(unless register-closures?
(reset-timestamps target))))
-(define (register-grub.cfg-root target grub.cfg)
+(define (register-bootcfg-root target bootcfg)
"On file system TARGET, register GRUB.CFG as a GC root."
(let ((directory (string-append target "/var/guix/gcroots")))
(mkdir-p directory)
- (symlink grub.cfg (string-append directory "/grub.cfg"))))
+ (symlink bootcfg (string-append directory "/bootcfg"))))
(define* (initialize-hard-disk device
#:key
- grub.cfg
+ bootloader
+ bootcfg
+ bootcfg-location
+ install-bootloader
(partitions '()))
"Initialize DEVICE as a disk containing all the <partition> objects listed
in PARTITIONS, and using GRUB.CFG as its bootloader configuration file.
@@ -309,10 +312,12 @@ passing it a directory name where it is mounted."
(display "mounting root partition...\n")
(mkdir-p target)
(mount (partition-device root) target (partition-file-system root))
- (install-grub grub.cfg device target)
+ (install-boot-config bootcfg bootcfg-location target)
+ (when install-bootloader
+ (install-bootloader bootloader device target))
- ;; Register GRUB.CFG as a GC root.
- (register-grub.cfg-root target grub.cfg)
+ ;; Register BOOTCFG as a GC root.
+ (register-bootcfg-root target bootcfg)
(umount target)))
diff --git a/gnu/system/bootloader.scm b/gnu/system/bootloader.scm
index 6366ba1cc..c072a42c4 100644
--- a/gnu/system/bootloader.scm
+++ b/gnu/system/bootloader.scm
@@ -38,7 +38,11 @@
extlinux-configuration
grub-configuration
grub-efi-configuration
- syslinux-configuration))
+ syslinux-configuration
+
+ dd
+ install-grub
+ install-syslinux))
;;; Commentary:
;;;
@@ -155,4 +159,47 @@ TIMEOUT ~a~%"
(bootloader (@ (gnu packages bootloaders) syslinux))
(install-procedure install-syslinux)))
+\f
+
+;;;
+;;; Bootloader install procedures.
+;;;
+
+(define dd
+ #~(lambda (bs count if of)
+ (zero? (system* "dd"
+ (string-append "bs=" (number->string bs))
+ (string-append "count=" (number->string count))
+ (string-append "if=" if)
+ (string-append "of=" of)))))
+
+(define install-grub
+ #~(lambda (bootloader device mount-point)
+ ;; Install GRUB on DEVICE which is mounted at MOUNT-POINT.
+ (let ((grub (string-append bootloader "/sbin/grub-install"))
+ (install-dir (string-append mount-point "/boot")))
+ ;; Tell 'grub-install' that there might be a LUKS-encrypted /boot or
+ ;; root partition.
+ (setenv "GRUB_ENABLE_CRYPTODISK" "y")
+
+ (unless (zero? (system* grub "--no-floppy"
+ "--boot-directory" install-dir
+ device))
+ (error "failed to install GRUB")))))
+
+(define install-syslinux
+ #~(lambda (bootloader device mount-point)
+ (let ((extlinux (string-append bootloader "/sbin/extlinux"))
+ (install-dir (string-append mount-point "/boot/extlinux"))
+ (syslinux-dir (string-append bootloader "/share/syslinux")))
+ (mkdir-p install-dir)
+ (for-each (lambda (file)
+ (copy-file file
+ (string-append install-dir "/" (basename file))))
+ (find-files syslinux-dir "\\.c32$"))
+
+ (unless (and (zero? (system* extlinux "--install" install-dir))
+ (#$dd 440 1 (string-append syslinux-dir "/mbr.bin") device))
+ (error "failed to install SYSLINUX")))))
+
;;; bootloader.scm ends here
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 9f914d03c..7808e3c79 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -45,10 +45,10 @@
#:select (%guile-static-stripped))
#:use-module (gnu packages admin)
+ #:use-module (gnu system bootloader)
#:use-module (gnu system shadow)
#:use-module (gnu system pam)
#:use-module (gnu system linux-initrd)
- #:use-module (gnu system grub)
#:use-module (gnu system file-systems)
#:use-module (gnu system)
#:use-module (gnu services)
@@ -175,8 +175,9 @@ made available under the /xchg CIFS share."
(disk-image-format "qcow2")
(file-system-type "ext4")
file-system-label
- os-derivation
- grub-configuration
+ os.drv
+ bootcfg.drv
+ bootloader-configuration
(register-closures? #t)
(inputs '())
copy-inputs?)
@@ -200,7 +201,7 @@ the image."
(guix build utils))
(let ((inputs
- '#$(append (list qemu parted grub e2fsprogs)
+ '#$(append (list qemu parted e2fsprogs)
(map canonical-package
(list sed grep coreutils findutils gawk))
(if register-closures? (list guix) '())))
@@ -222,7 +223,7 @@ the image."
#:closures graphs
#:copy-closures? #$copy-inputs?
#:register-closures? #$register-closures?
- #:system-directory #$os-derivation))
+ #:system-directory #$os.drv))
(partitions (list (partition
(size #$(- disk-image-size
(* 10 (expt 2 20))))
@@ -232,7 +233,16 @@ the image."
(initializer initialize)))))
(initialize-hard-disk "/dev/vda"
#:partitions partitions
- #:grub.cfg #$grub-configuration)
+ #:bootloader
+ #$(bootloader-configuration-bootloader
+ bootloader-configuration)
+ #:bootcfg #$bootcfg.drv
+ #:bootcfg-location
+ #$(bootloader-configuration-file-location
+ bootloader-configuration)
+ #:install-bootloader
+ #$(bootloader-configuration-install-procedure
+ bootloader-configuration))
(reboot)))))
#:system system
#:make-disk-image? #t
@@ -286,8 +296,9 @@ to USB sticks meant to be read-only."
(mlet* %store-monad ((os-drv (operating-system-derivation os))
(grub.cfg (operating-system-grub.cfg os)))
(qemu-image #:name name
- #:os-derivation os-drv
- #:grub-configuration grub.cfg
+ #:os.drv os-drv
+ #:bootcfg.drv grub.cfg
+ #:bootloader-configuration (operating-system-bootloader os)
#:disk-image-size disk-image-size
#:disk-image-format "raw"
#:file-system-type file-system-type
@@ -329,8 +340,9 @@ of the GNU system as described by OS."
(mlet* %store-monad
((os-drv (operating-system-derivation os))
(grub.cfg (operating-system-grub.cfg os)))
- (qemu-image #:os-derivation os-drv
- #:grub-configuration grub.cfg
+ (qemu-image #:os.drv os-drv
+ #:bootcfg.drv grub.cfg
+ #:bootloader-configuration (operating-system-bootloader os)
#:disk-image-size disk-image-size
#:file-system-type file-system-type
#:inputs `(("system" ,os-drv)
@@ -425,8 +437,9 @@ bootloader refers to: OS kernel, initrd, bootloader data, etc."
;; GRUB.CFG and all its dependencies, including the output of OS-DRV.
;; This is more than needed (we only need the kernel, initrd, GRUB for its
;; font, and the background image), but it's hard to filter that.
- (qemu-image #:os-derivation os-drv
- #:grub-configuration grub.cfg
+ (qemu-image #:os.drv os-drv
+ #:bootcfg.drv grub.cfg
+ #:bootloader-configuration (operating-system-bootloader os)
#:disk-image-size disk-image-size
#:inputs (if full-boot?
`(("grub.cfg" ,grub.cfg))
--
2.11.1
^ permalink raw reply related [flat|nested] 19+ messages in thread* Re: [PATCH 0/8] WIP: Better support for non-grub bootloaders.
2017-02-14 15:28 [PATCH 0/8] WIP: Better support for non-grub bootloaders David Craven
` (8 preceding siblings ...)
2017-02-14 15:28 ` [PATCH 8/8] bootloader: Add install procedures and use them David Craven
@ 2017-03-06 22:04 ` Ludovic Courtès
2017-03-17 12:43 ` Mathieu Othacehe
9 siblings, 1 reply; 19+ messages in thread
From: Ludovic Courtès @ 2017-03-06 22:04 UTC (permalink / raw)
To: David Craven; +Cc: guix-devel
Hi David,
Please let me know if you don’t want to be bothered about this. Problem
is there’s exciting stuff in this patch series and I’d probably have a
few questions for you if you want.
David Craven <david@craven.ch> skribis:
> These patches make changes to the bootloader API and will break operating-system's
> and some scripts (--no-grub is renamed to --no-bootloader).
>
> I would like some feedback on the API and also ideas on how to handle API changes
> with minimal discomfort to our users.
>
> The most interesting commit is 8a01985d7a936809102b10d494dc2286b3f8c6f2 which defines
> a <bootloader-configuration> record. extlinux-configuration, grub-configuration and
> syslinux-configuration are designed as transformation passes on a bootloader-configuration
> record. The idea is that someone that wants to add support for a new bootloader can
> use
>
> (bootloader (bootloader-configuration
> ...))
>
> and users that want to use a supported bootloader can configure it like this
>
> (bootloader (grub-configuration
> (bootloader-configuration
> (device "/dev/sda1"))))
Perhaps this could be:
(bootloader-configuration
(type grub-bootloader)
(device "/dev/sda1"))
That way, people would always write ‘bootloader-configuration’
regardless of the bootloader being used, which sounds simpler.
We could have this compatibility macro:
(define-syntax-rule (grub-configuration fields ...)
(bootloader-configuration
(type grub-bootloader)
fields ...))
> another important API change is that an operating-system does not need to set
> the bootloader when it is only intended to run through guix system vm or on
> an embedded system that has an extlinux compatible bootloader in ROM.
>
> Things that don't work yet:
> * system tests are broken due to API changes
> * grub-efi needs an installation procedure and the vm code needs
> support for alternative firmware like ovmf, gpt partition table
> and EFI boot partition.
> * The syslinux and grub bootloader configurations still require
> guix/scripts/system.scm to handle the new API on init and reconfigure
> and requires extensive testing on real hardware.
> * No automated system tests yet.
OK.
I’ll look more closely at the rest. I’m glad Danny already applied the
non-controversial patches!
Thanks,
Ludo’.
^ permalink raw reply [flat|nested] 19+ messages in thread* Re: [PATCH 0/8] WIP: Better support for non-grub bootloaders.
2017-03-06 22:04 ` [PATCH 0/8] WIP: Better support for non-grub bootloaders Ludovic Courtès
@ 2017-03-17 12:43 ` Mathieu Othacehe
2017-03-17 12:49 ` John Darrington
0 siblings, 1 reply; 19+ messages in thread
From: Mathieu Othacehe @ 2017-03-17 12:43 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: guix-devel, David Craven
Hi,
> Please let me know if you don’t want to be bothered about this. Problem
> is there’s exciting stuff in this patch series and I’d probably have a
> few questions for you if you want.
If we get no sign from David, I'd like to start working on this patch
serie, starting by rebasing it and applying Ludo proposals.
Is this ok for everybody ?
Thanks,
Mathieu
^ permalink raw reply [flat|nested] 19+ messages in thread
* Re: [PATCH 0/8] WIP: Better support for non-grub bootloaders.
2017-03-17 12:43 ` Mathieu Othacehe
@ 2017-03-17 12:49 ` John Darrington
2017-03-18 13:53 ` Ludovic Courtès
0 siblings, 1 reply; 19+ messages in thread
From: John Darrington @ 2017-03-17 12:49 UTC (permalink / raw)
To: Mathieu Othacehe; +Cc: guix-devel, David Craven
[-- Attachment #1: Type: text/plain, Size: 753 bytes --]
On Fri, Mar 17, 2017 at 01:43:19PM +0100, Mathieu Othacehe wrote:
Hi,
> Please let me know if you don???t want to be bothered about this. Problem
> is there???s exciting stuff in this patch series and I???d probably have a
> few questions for you if you want.
If we get no sign from David, I'd like to start working on this patch
serie, starting by rebasing it and applying Ludo proposals.
Is this ok for everybody ?
It's fine by me.
J'
--
Avoid eavesdropping. Send strong encrypted email.
PGP Public key ID: 1024D/2DE827B3
fingerprint = 8797 A26D 0854 2EAB 0285 A290 8A67 719C 2DE8 27B3
See http://sks-keyservers.net or any PGP keyserver for public key.
[-- Attachment #2: Digital signature --]
[-- Type: application/pgp-signature, Size: 181 bytes --]
^ permalink raw reply [flat|nested] 19+ messages in thread* Re: [PATCH 0/8] WIP: Better support for non-grub bootloaders.
2017-03-17 12:49 ` John Darrington
@ 2017-03-18 13:53 ` Ludovic Courtès
2017-03-18 17:25 ` David Craven
0 siblings, 1 reply; 19+ messages in thread
From: Ludovic Courtès @ 2017-03-18 13:53 UTC (permalink / raw)
To: John Darrington; +Cc: guix-devel, David Craven
John Darrington <john@darrington.wattle.id.au> skribis:
> On Fri, Mar 17, 2017 at 01:43:19PM +0100, Mathieu Othacehe wrote:
>
> Hi,
>
> > Please let me know if you don???t want to be bothered about this. Problem
> > is there???s exciting stuff in this patch series and I???d probably have a
> > few questions for you if you want.
>
> If we get no sign from David, I'd like to start working on this patch
> serie, starting by rebasing it and applying Ludo proposals.
>
> Is this ok for everybody ?
>
>
> It's fine by me.
Same here. Thanks, Mathieu!
Ludo’.
^ permalink raw reply [flat|nested] 19+ messages in thread