* gnu/bootloader.scm: New file. * gnu/bootloader/extlinux.scm: New file. * gnu/bootloader/grub.scm: New file. * gnu/local.mk: Build new files. * gnu/system.scm: Adapt to new bootloader api. * gnu/scripts/system.scm: Adapt to new bootloader api. * gnu.scm: Remove (gnu system grub) and replace by (gnu bootloader) and (gnu bootloader grub) modules. * gnu/system/grub.scm: Moved content to gnu/bootloader/grub.scm. * gnu/system/vm: Replace (gnu system grub) module by (gnu bootloader). * gnu/tests.scm: Ditto. * gnu/tests/nfs.scm: Ditto.gn-latest-20200428
@@ -1,6 +1,7 @@ | |||
;;; GNU Guix --- Functional package management for GNU | |||
;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> | |||
;;; Copyright © 2015 Joshua S. Grant <jgrant@parenthetical.io> | |||
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> | |||
;;; | |||
;;; This file is part of GNU Guix. | |||
;;; | |||
@@ -34,7 +35,8 @@ | |||
'((gnu system) | |||
(gnu system mapped-devices) | |||
(gnu system file-systems) | |||
(gnu system grub) ; 'grub-configuration' | |||
(gnu bootloader) | |||
(gnu bootloader grub) | |||
(gnu system pam) | |||
(gnu system shadow) ; 'user-account' | |||
(gnu system linux-initrd) | |||
@@ -0,0 +1,127 @@ | |||
;;; GNU Guix --- Functional package management for GNU | |||
;;; Copyright © 2017 David Craven <david@craven.ch> | |||
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> | |||
;;; Copyright © 2017 Leo Famulari <leo@famulari.name> | |||
;;; | |||
;;; 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 bootloader) | |||
#:use-module (guix discovery) | |||
#:use-module (guix records) | |||
#:use-module (guix ui) | |||
#:use-module (srfi srfi-1) | |||
#:export (bootloader | |||
bootloader? | |||
bootloader-name | |||
bootloader-package | |||
bootloader-installer | |||
bootloader-configuration-file | |||
bootloader-configuration-file-generator | |||
bootloader-configuration | |||
bootloader-configuration? | |||
bootloader-configuration-bootloader | |||
bootloader-configuration-device | |||
bootloader-configuration-menu-entries | |||
bootloader-configuration-default-entry | |||
bootloader-configuration-timeout | |||
bootloader-configuration-theme | |||
bootloader-configuration-terminal-outputs | |||
bootloader-configuration-terminal-inputs | |||
bootloader-configuration-serial-unit | |||
bootloader-configuration-serial-speed | |||
bootloader-configuration-additional-configuration | |||
%bootloaders | |||
lookup-bootloader-by-name)) | |||
;;; | |||
;;; Bootloader record. | |||
;;; | |||
;; The <bootloader> record contains fields expressing how the bootloader | |||
;; should be installed. Every bootloader in gnu/bootloader/ directory | |||
;; has to be described by this record. | |||
(define-record-type* <bootloader> | |||
bootloader make-bootloader | |||
bootloader? | |||
(name bootloader-name) | |||
(package bootloader-package) | |||
(installer bootloader-installer) | |||
(configuration-file bootloader-configuration-file) | |||
(configuration-file-generator bootloader-configuration-file-generator)) | |||
;;; | |||
;;; Bootloader configuration record. | |||
;;; | |||
;; The <bootloader-configuration> record contains bootloader independant | |||
;; configuration used to fill bootloader configuration file. | |||
(define-record-type* <bootloader-configuration> | |||
bootloader-configuration make-bootloader-configuration | |||
bootloader-configuration? | |||
(bootloader bootloader-configuration-bootloader) ; <bootloader> | |||
(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 ; seconds as integer | |||
(default 5)) | |||
(theme bootloader-configuration-theme ; bootloader-specific theme | |||
(default #f)) | |||
(terminal-outputs bootloader-configuration-terminal-outputs ; list of symbols | |||
(default '(gfxterm))) | |||
(terminal-inputs bootloader-configuration-terminal-inputs ; list of symbols | |||
(default '())) | |||
(serial-unit bootloader-configuration-serial-unit ; integer | #f | |||
(default #f)) | |||
(serial-speed bootloader-configuration-serial-speed ; integer | #f | |||
(default #f)) | |||
(additional-configuration bootloader-configuration-additional-configuration ; record | |||
(default #f))) | |||
;;; | |||
;;; Bootloaders. | |||
;;; | |||
(define (bootloader-modules) | |||
"Return the list of bootloader modules." | |||
(all-modules (map (lambda (entry) | |||
`(,entry . "gnu/bootloader")) | |||
%load-path))) | |||
(define %bootloaders | |||
;; The list of publically-known bootloaders. | |||
(delay (fold-module-public-variables (lambda (obj result) | |||
(if (bootloader? obj) | |||
(cons obj result) | |||
result)) | |||
'() | |||
(bootloader-modules)))) | |||
(define (lookup-bootloader-by-name name) | |||
"Return the bootloader called NAME." | |||
(or (find (lambda (bootloader) | |||
(eq? name (bootloader-name bootloader))) | |||
(force %bootloaders)) | |||
(leave (G_ "~a: no such bootloader~%") name))) |
@@ -0,0 +1,123 @@ | |||
;;; GNU Guix --- Functional package management for GNU | |||
;;; Copyright © 2017 David Craven <david@craven.ch> | |||
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> | |||
;;; | |||
;;; 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 bootloader extlinux) | |||
#:use-module (gnu bootloader) | |||
#:use-module (gnu system) | |||
#:use-module (gnu packages bootloaders) | |||
#:use-module (guix gexp) | |||
#:use-module (guix monads) | |||
#:use-module (guix records) | |||
#:use-module (guix utils) | |||
#:export (extlinux-bootloader | |||
syslinux-bootloader | |||
extlinux-configuration | |||
syslinux-configuration)) | |||
(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 params) | |||
(let ((label (boot-parameters-label params)) | |||
(kernel (boot-parameters-kernel params)) | |||
(kernel-arguments (boot-parameters-kernel-arguments params)) | |||
(initrd (boot-parameters-initrd params))) | |||
#~(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) | |||
;; timeout is expressed in 1/10s of seconds. | |||
(* 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)) | |||
;;; | |||
;;; 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-extlinux | |||
#~(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"))) | |||
(for-each (lambda (file) | |||
(install-file file install-dir)) | |||
(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 definitions. | |||
;;; | |||
(define extlinux-bootloader | |||
(bootloader | |||
(name 'extlinux) | |||
(package syslinux) | |||
(installer install-extlinux) | |||
(configuration-file "/boot/extlinux/extlinux.conf") | |||
(configuration-file-generator extlinux-configuration-file))) |
@@ -2,6 +2,7 @@ | |||
;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> | |||
;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com> | |||
;;; Copyright © 2017 Leo Famulari <leo@famulari.name> | |||
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> | |||
;;; | |||
;;; This file is part of GNU Guix. | |||
;;; | |||
@@ -18,7 +19,7 @@ | |||
;;; 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 grub) | |||
(define-module (gnu bootloader grub) | |||
#:use-module (guix store) | |||
#:use-module (guix packages) | |||
#:use-module (guix derivations) | |||
@@ -28,6 +29,7 @@ | |||
#:use-module (guix download) | |||
#:use-module (gnu artwork) | |||
#:use-module (gnu system) | |||
#:use-module (gnu bootloader) | |||
#:use-module (gnu system file-systems) | |||
#:autoload (gnu packages bootloaders) (grub) | |||
#:autoload (gnu packages compression) (gzip) | |||
@@ -50,15 +52,10 @@ | |||
%background-image | |||
%default-theme | |||
grub-configuration | |||
grub-configuration? | |||
grub-configuration-device | |||
grub-configuration-grub | |||
grub-bootloader | |||
grub-efi-bootloader | |||
menu-entry | |||
menu-entry? | |||
grub-configuration-file)) | |||
grub-configuration)) | |||
;;; Commentary: | |||
;;; | |||
@@ -106,29 +103,6 @@ denoting a file name." | |||
(color-highlight '((fg . yellow) (bg . black))) | |||
(color-normal '((fg . light-gray) (bg . black))))) ;XXX: #x303030 | |||
(define-record-type* <grub-configuration> | |||
grub-configuration make-grub-configuration | |||
grub-configuration? | |||
(grub grub-configuration-grub ; package | |||
(default (@ (gnu packages bootloaders) grub))) | |||
(device grub-configuration-device) ; string | |||
(menu-entries grub-configuration-menu-entries ; list | |||
(default '())) | |||
(default-entry grub-configuration-default-entry ; integer | |||
(default 0)) | |||
(timeout grub-configuration-timeout ; integer | |||
(default 5)) | |||
(theme grub-configuration-theme ; <grub-theme> | |||
(default %default-theme)) | |||
(terminal-outputs grub-configuration-terminal-outputs ; list of symbols | |||
(default '(gfxterm))) | |||
(terminal-inputs grub-configuration-terminal-inputs ; list of symbols | |||
(default '())) | |||
(serial-unit grub-configuration-serial-unit ; integer | #f | |||
(default #f)) | |||
(serial-speed grub-configuration-serial-speed ; integer | #f | |||
(default #f))) | |||
(define-record-type* <menu-entry> | |||
menu-entry make-menu-entry | |||
menu-entry? | |||
@@ -147,6 +121,11 @@ denoting a file name." | |||
;;; Background image & themes. | |||
;;; | |||
(define (bootloader-theme config) | |||
"Return user defined theme in CONFIG if defined or %default-theme | |||
otherwise." | |||
(or (bootloader-configuration-theme config) %default-theme)) | |||
(define* (svg->png svg #:key width height) | |||
"Build a PNG of HEIGHT x WIDTH from SVG." | |||
(gexp->derivation "grub-image.png" | |||
@@ -171,7 +150,8 @@ WIDTH/HEIGHT, or #f if none was found." | |||
(let* ((ratio (/ width height)) | |||
(image (find (lambda (image) | |||
(= (grub-image-aspect-ratio image) ratio)) | |||
(grub-theme-images (grub-configuration-theme config))))) | |||
(grub-theme-images | |||
(bootloader-theme config))))) | |||
(if image | |||
(svg->png (grub-image-file image) | |||
#:width width #:height height) | |||
@@ -212,14 +192,14 @@ system string---e.g., \"x86_64-linux\"." | |||
"")) | |||
(define (setup-gfxterm config font-file) | |||
(if (memq 'gfxterm (grub-configuration-terminal-outputs config)) | |||
#~(format #f "if loadfont ~a; then | |||
(if (memq 'gfxterm (bootloader-configuration-terminal-outputs config)) | |||
#~(format #f "if loadfont ~a; then | |||
setup_gfxterm | |||
fi~%" #$font-file) | |||
"")) | |||
"")) | |||
(define (theme-colors type) | |||
(let* ((theme (grub-configuration-theme config)) | |||
(let* ((theme (bootloader-theme config)) | |||
(colors (type theme))) | |||
(string-append (symbol->string (assoc-ref colors 'fg)) "/" | |||
(symbol->string (assoc-ref colors 'bg))))) | |||
@@ -266,10 +246,10 @@ fi~%" | |||
is a string that can be inserted in grub.cfg." | |||
(let* ((symbols->string (lambda (list) | |||
(string-join (map symbol->string list) " "))) | |||
(outputs (grub-configuration-terminal-outputs config)) | |||
(inputs (grub-configuration-terminal-inputs config)) | |||
(unit (grub-configuration-serial-unit config)) | |||
(speed (grub-configuration-serial-speed config)) | |||
(outputs (bootloader-configuration-terminal-outputs config)) | |||
(inputs (bootloader-configuration-terminal-inputs config)) | |||
(unit (bootloader-configuration-serial-unit config)) | |||
(speed (bootloader-configuration-serial-speed config)) | |||
;; Respectively, GRUB_TERMINAL_OUTPUT and GRUB_TERMINAL_INPUT, | |||
;; as documented in GRUB manual section "Simple Configuration | |||
@@ -347,12 +327,13 @@ code." | |||
(system (%current-system)) | |||
(old-entries '())) | |||
"Return the GRUB configuration file corresponding to CONFIG, a | |||
<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." | |||
<bootloader-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 (map boot-parameters->menu-entry entries) | |||
(grub-configuration-menu-entries config))) | |||
(map boot-parameters->menu-entry | |||
(append entries | |||
(bootloader-configuration-menu-entries config)))) | |||
(define entry->gexp | |||
(match-lambda | |||
@@ -391,8 +372,8 @@ corresponding to old generations of the system." | |||
(format port " | |||
set default=~a | |||
set timeout=~a~%" | |||
#$(grub-configuration-default-entry config) | |||
#$(grub-configuration-timeout config)) | |||
#$(bootloader-configuration-default-entry config) | |||
#$(bootloader-configuration-timeout config)) | |||
#$@(map entry->gexp all-entries) | |||
#$@(if (pair? old-entries) | |||
@@ -404,4 +385,64 @@ submenu \"GNU system, old configurations...\" {~%") | |||
(gexp->derivation "grub.cfg" builder))) | |||
;;; | |||
;;; Install procedures. | |||
;;; | |||
(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"))))) | |||
;;; | |||
;;; Bootloader definitions. | |||
;;; | |||
(define grub-bootloader | |||
(bootloader | |||
(name 'grub) | |||
(package grub) | |||
(installer install-grub) | |||
(configuration-file "/boot/grub/grub.cfg") | |||
(configuration-file-generator grub-configuration-file))) | |||
(define* grub-efi-bootloader | |||
(bootloader | |||
(inherit grub-bootloader) | |||
(name 'grub-efi) | |||
(package grub-efi))) | |||
;;; | |||
;;; Compatibility macros. | |||
;;; | |||
(define-syntax grub-configuration | |||
(syntax-rules (grub) | |||
((_ (grub package) fields ...) | |||
(if (eq? package grub) | |||
(bootloader-configuration | |||
(bootloader grub-bootloader) | |||
fields ...) | |||
(bootloader-configuration | |||
(bootloader grub-efi-bootloader) | |||
fields ...))) | |||
((_ fields ...) | |||
(bootloader-configuration | |||
(bootloader grub-bootloader) | |||
fields ...)))) | |||
;;; grub.scm ends here |
@@ -36,6 +36,9 @@ | |||
GNU_SYSTEM_MODULES = \ | |||
gnu.scm \ | |||
%D%/artwork.scm \ | |||
%D%/bootloader.scm \ | |||
%D%/bootloader/grub.scm \ | |||
%D%/bootloader/extlinux.scm \ | |||
%D%/packages.scm \ | |||
%D%/packages/abduco.scm \ | |||
%D%/packages/abiword.scm \ | |||
@@ -443,7 +446,6 @@ GNU_SYSTEM_MODULES = \ | |||
\ | |||
%D%/system.scm \ | |||
%D%/system/file-systems.scm \ | |||
%D%/system/grub.scm \ | |||
%D%/system/install.scm \ | |||
%D%/system/linux-container.scm \ | |||
%D%/system/linux-initrd.scm \ | |||
@@ -48,6 +48,7 @@ | |||
#:use-module (gnu services) | |||
#:use-module (gnu services shepherd) | |||
#:use-module (gnu services base) | |||
#:use-module (gnu bootloader) | |||
#:use-module (gnu system shadow) | |||
#:use-module (gnu system nss) | |||
#:use-module (gnu system locale) | |||
@@ -139,7 +140,7 @@ booted from ROOT-DEVICE" | |||
(default linux-libre)) | |||
(kernel-arguments operating-system-user-kernel-arguments | |||
(default '())) ; list of gexps/strings | |||
(bootloader operating-system-bootloader) ; <grub-configuration> | |||
(bootloader operating-system-bootloader) ; <bootloader-configuration> | |||
(initrd operating-system-initrd ; (list fs) -> M derivation | |||
(default base-initrd)) | |||
@@ -847,12 +848,11 @@ populate the \"old entries\" menu." | |||
(root-device -> (if (eq? 'uuid (file-system-title root-fs)) | |||
(uuid->string (file-system-device root-fs)) | |||
(file-system-device root-fs))) | |||
(entry (operating-system-boot-parameters os system root-device))) | |||
((module-ref (resolve-interface '(gnu system grub)) | |||
'grub-configuration-file) | |||
(operating-system-bootloader os) | |||
(list entry) | |||
#:old-entries old-entries))) | |||
(entry (operating-system-boot-parameters os system root-device)) | |||
(bootloader-conf -> (operating-system-bootloader os))) | |||
((bootloader-configuration-file-generator | |||
(bootloader-configuration-bootloader bootloader-conf)) | |||
bootloader-conf (list entry) #:old-entries old-entries))) | |||
(define (fs->boot-device fs) | |||
"Given FS, a <file-system> object, return a value suitable for use as the | |||
@@ -49,7 +49,7 @@ | |||
#:use-module (gnu system shadow) | |||
#:use-module (gnu system pam) | |||
#:use-module (gnu system linux-initrd) | |||
#:use-module (gnu system grub) | |||
#:use-module (gnu bootloader) | |||
#:use-module (gnu system file-systems) | |||
#:use-module (gnu system) | |||
#:use-module (gnu services) | |||
@@ -1,5 +1,6 @@ | |||
;;; GNU Guix --- Functional package management for GNU | |||
;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org> | |||
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> | |||
;;; | |||
;;; This file is part of GNU Guix. | |||
;;; | |||
@@ -20,8 +21,8 @@ | |||
#:use-module (guix gexp) | |||
#:use-module (guix utils) | |||
#:use-module (guix records) | |||
#:use-module (gnu bootloader grub) | |||
#:use-module (gnu system) | |||
#:use-module (gnu system grub) | |||
#:use-module (gnu system file-systems) | |||
#:use-module (gnu system shadow) | |||
#:use-module (gnu services) | |||
@@ -1,6 +1,7 @@ | |||
;;; GNU Guix --- Functional package management for GNU | |||
;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org> | |||
;;; Copyright © 2016 John Darrington <jmd@gnu.org> | |||
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> | |||
;;; | |||
;;; This file is part of GNU Guix. | |||
;;; | |||
@@ -19,8 +20,8 @@ | |||
(define-module (gnu tests nfs) | |||
#:use-module (gnu tests) | |||
#:use-module (gnu bootloader grub) | |||
#:use-module (gnu system) | |||
#:use-module (gnu system grub) | |||
#:use-module (gnu system file-systems) | |||
#:use-module (gnu system shadow) | |||
#:use-module (gnu system vm) | |||
@@ -38,10 +38,10 @@ | |||
#:use-module (guix build utils) | |||
#:use-module (gnu build install) | |||
#:use-module (gnu system) | |||
#:use-module (gnu 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) | |||
@@ -598,8 +598,12 @@ output when building a system derivation, such as a disk image." | |||
#:image-size image-size | |||
#:full-boot? full-boot? | |||
#:mappings mappings)) | |||
(grub (package->derivation (grub-configuration-grub | |||
(operating-system-bootloader os)))) | |||
(bootloader (let ((bootloader (bootloader-package | |||
(bootloader-configuration-bootloader | |||
(operating-system-bootloader os))))) | |||
(if bootloader | |||
(package->derivation bootloader) | |||
(return #f)))) | |||
(grub.cfg (if (eq? 'container action) | |||
(return #f) | |||
(operating-system-bootcfg os | |||
@@ -611,8 +615,8 @@ output when building a system derivation, such as a disk image." | |||
;; --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 bootloader? | |||
(list sys grub.cfg grub) | |||
(if (and bootloader? bootloader) | |||
(list sys grub.cfg bootloader) | |||
(list sys grub.cfg)) | |||
(list sys))) | |||
(% (if derivations-only? | |||
@@ -628,8 +632,8 @@ output when building a system derivation, such as a disk image." | |||
drvs) | |||
;; Make sure GRUB is accessible. | |||
(when bootloader? | |||
(let ((prefix (derivation->output-path grub))) | |||
(when (and bootloader? bootloader) | |||
(let ((prefix (derivation->output-path bootloader))) | |||
(setenv "PATH" | |||
(string-append prefix "/bin:" prefix "/sbin:" | |||
(getenv "PATH"))))) | |||
@@ -832,7 +836,7 @@ resulting from command-line parsing." | |||
((first second) second) | |||
(_ #f))) | |||
(device (and bootloader? | |||
(grub-configuration-device | |||
(bootloader-configuration-device | |||
(operating-system-bootloader os))))) | |||
(with-store store | |||