[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
bug#26339: [PATCH 02/18] system: Add extlinux support.
|
From: |
Mathieu Othacehe |
|
Subject: |
bug#26339: [PATCH 02/18] system: Add extlinux support. |
|
Date: |
Sun, 2 Apr 2017 15:52:26 +0200 |
From: David Craven <address@hidden>
* 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 68f561e95..d3033f54f 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -437,6 +437,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 d528c4a6a..e0257bd4a 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)
@@ -131,8 +131,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
@@ -759,8 +759,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..6da19f6d3
--- /dev/null
+++ b/gnu/system/bootloader.scm
@@ -0,0 +1,158 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2017 David Craven <address@hidden>
+;;;
+;;; 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)))
+
+
+
+;;;
+;;; 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 address@hidden))))))
+
+ (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))
+
+
+
+
+;;;
+;;; 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 f2838d633..0b52e3e7e 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:
@@ -276,7 +269,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 '()))
@@ -284,6 +286,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)))
;;;
@@ -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 de6db0928..525480a11 100644
--- a/tests/guix-system.sh
+++ b/tests/guix-system.sh
@@ -91,7 +91,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"))
@@ -162,7 +161,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.12.2
bug#26339: [PATCH 12/18] system: Rename grub-device to fs->boot-device., Mathieu Othacehe, 2017/04/02
bug#26339: [PATCH 08/18] bootloader: Stop using grub module., Mathieu Othacehe, 2017/04/02