bootloader: Add extlinux support.

* 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.
This commit is contained in:
Mathieu Othacehe 2017-05-15 22:24:18 +02:00
parent ce92d269fe
commit b09a8da4a2
No known key found for this signature in database
GPG Key ID: 8354763531769CA6
10 changed files with 369 additions and 68 deletions

View File

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Joshua S. Grant <jgrant@parenthetical.io> ;;; Copyright © 2015 Joshua S. Grant <jgrant@parenthetical.io>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -34,7 +35,8 @@
'((gnu system) '((gnu system)
(gnu system mapped-devices) (gnu system mapped-devices)
(gnu system file-systems) (gnu system file-systems)
(gnu system grub) ; 'grub-configuration' (gnu bootloader)
(gnu bootloader grub)
(gnu system pam) (gnu system pam)
(gnu system shadow) ; 'user-account' (gnu system shadow) ; 'user-account'
(gnu system linux-initrd) (gnu system linux-initrd)

127
gnu/bootloader.scm Normal file
View File

@ -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)))

123
gnu/bootloader/extlinux.scm Normal file
View File

@ -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)))

View File

@ -2,6 +2,7 @@
;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com> ;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
;;; Copyright © 2017 Leo Famulari <leo@famulari.name> ;;; Copyright © 2017 Leo Famulari <leo@famulari.name>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -18,7 +19,7 @@
;;; You should have received a copy of the GNU General Public License ;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. ;;; 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 store)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix derivations) #:use-module (guix derivations)
@ -28,6 +29,7 @@
#:use-module (guix download) #:use-module (guix download)
#:use-module (gnu artwork) #:use-module (gnu artwork)
#:use-module (gnu system) #:use-module (gnu system)
#:use-module (gnu bootloader)
#:use-module (gnu system file-systems) #:use-module (gnu system file-systems)
#:autoload (gnu packages bootloaders) (grub) #:autoload (gnu packages bootloaders) (grub)
#:autoload (gnu packages compression) (gzip) #:autoload (gnu packages compression) (gzip)
@ -50,15 +52,10 @@
%background-image %background-image
%default-theme %default-theme
grub-configuration grub-bootloader
grub-configuration? grub-efi-bootloader
grub-configuration-device
grub-configuration-grub
menu-entry grub-configuration))
menu-entry?
grub-configuration-file))
;;; Commentary: ;;; Commentary:
;;; ;;;
@ -106,29 +103,6 @@ denoting a file name."
(color-highlight '((fg . yellow) (bg . black))) (color-highlight '((fg . yellow) (bg . black)))
(color-normal '((fg . light-gray) (bg . black))))) ;XXX: #x303030 (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> (define-record-type* <menu-entry>
menu-entry make-menu-entry menu-entry make-menu-entry
menu-entry? menu-entry?
@ -147,6 +121,11 @@ denoting a file name."
;;; Background image & themes. ;;; 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) (define* (svg->png svg #:key width height)
"Build a PNG of HEIGHT x WIDTH from SVG." "Build a PNG of HEIGHT x WIDTH from SVG."
(gexp->derivation "grub-image.png" (gexp->derivation "grub-image.png"
@ -171,7 +150,8 @@ WIDTH/HEIGHT, or #f if none was found."
(let* ((ratio (/ width height)) (let* ((ratio (/ width height))
(image (find (lambda (image) (image (find (lambda (image)
(= (grub-image-aspect-ratio image) ratio)) (= (grub-image-aspect-ratio image) ratio))
(grub-theme-images (grub-configuration-theme config))))) (grub-theme-images
(bootloader-theme config)))))
(if image (if image
(svg->png (grub-image-file image) (svg->png (grub-image-file image)
#:width width #:height height) #:width width #:height height)
@ -212,14 +192,14 @@ system string---e.g., \"x86_64-linux\"."
"")) ""))
(define (setup-gfxterm config font-file) (define (setup-gfxterm config font-file)
(if (memq 'gfxterm (grub-configuration-terminal-outputs config)) (if (memq 'gfxterm (bootloader-configuration-terminal-outputs config))
#~(format #f "if loadfont ~a; then #~(format #f "if loadfont ~a; then
setup_gfxterm setup_gfxterm
fi~%" #$font-file) fi~%" #$font-file)
"")) ""))
(define (theme-colors type) (define (theme-colors type)
(let* ((theme (grub-configuration-theme config)) (let* ((theme (bootloader-theme config))
(colors (type theme))) (colors (type theme)))
(string-append (symbol->string (assoc-ref colors 'fg)) "/" (string-append (symbol->string (assoc-ref colors 'fg)) "/"
(symbol->string (assoc-ref colors 'bg))))) (symbol->string (assoc-ref colors 'bg)))))
@ -266,10 +246,10 @@ fi~%"
is a string that can be inserted in grub.cfg." is a string that can be inserted in grub.cfg."
(let* ((symbols->string (lambda (list) (let* ((symbols->string (lambda (list)
(string-join (map symbol->string list) " "))) (string-join (map symbol->string list) " ")))
(outputs (grub-configuration-terminal-outputs config)) (outputs (bootloader-configuration-terminal-outputs config))
(inputs (grub-configuration-terminal-inputs config)) (inputs (bootloader-configuration-terminal-inputs config))
(unit (grub-configuration-serial-unit config)) (unit (bootloader-configuration-serial-unit config))
(speed (grub-configuration-serial-speed config)) (speed (bootloader-configuration-serial-speed config))
;; Respectively, GRUB_TERMINAL_OUTPUT and GRUB_TERMINAL_INPUT, ;; Respectively, GRUB_TERMINAL_OUTPUT and GRUB_TERMINAL_INPUT,
;; as documented in GRUB manual section "Simple Configuration ;; as documented in GRUB manual section "Simple Configuration
@ -347,12 +327,13 @@ code."
(system (%current-system)) (system (%current-system))
(old-entries '())) (old-entries '()))
"Return the GRUB configuration file corresponding to CONFIG, a "Return the GRUB configuration file corresponding to CONFIG, a
<grub-configuration> object, and where the store is available at STORE-FS, a <bootloader-configuration> object, and where the store is available at
<file-system> object. OLD-ENTRIES is taken to be a list of menu entries STORE-FS, a <file-system> object. OLD-ENTRIES is taken to be a list of menu
corresponding to old generations of the system." entries corresponding to old generations of the system."
(define all-entries (define all-entries
(append (map boot-parameters->menu-entry entries) (map boot-parameters->menu-entry
(grub-configuration-menu-entries config))) (append entries
(bootloader-configuration-menu-entries config))))
(define entry->gexp (define entry->gexp
(match-lambda (match-lambda
@ -391,8 +372,8 @@ corresponding to old generations of the system."
(format port " (format port "
set default=~a set default=~a
set timeout=~a~%" set timeout=~a~%"
#$(grub-configuration-default-entry config) #$(bootloader-configuration-default-entry config)
#$(grub-configuration-timeout config)) #$(bootloader-configuration-timeout config))
#$@(map entry->gexp all-entries) #$@(map entry->gexp all-entries)
#$@(if (pair? old-entries) #$@(if (pair? old-entries)
@ -404,4 +385,64 @@ submenu \"GNU system, old configurations...\" {~%")
(gexp->derivation "grub.cfg" builder))) (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 ;;; grub.scm ends here

View File

@ -36,6 +36,9 @@
GNU_SYSTEM_MODULES = \ GNU_SYSTEM_MODULES = \
gnu.scm \ gnu.scm \
%D%/artwork.scm \ %D%/artwork.scm \
%D%/bootloader.scm \
%D%/bootloader/grub.scm \
%D%/bootloader/extlinux.scm \
%D%/packages.scm \ %D%/packages.scm \
%D%/packages/abduco.scm \ %D%/packages/abduco.scm \
%D%/packages/abiword.scm \ %D%/packages/abiword.scm \
@ -443,7 +446,6 @@ GNU_SYSTEM_MODULES = \
\ \
%D%/system.scm \ %D%/system.scm \
%D%/system/file-systems.scm \ %D%/system/file-systems.scm \
%D%/system/grub.scm \
%D%/system/install.scm \ %D%/system/install.scm \
%D%/system/linux-container.scm \ %D%/system/linux-container.scm \
%D%/system/linux-initrd.scm \ %D%/system/linux-initrd.scm \

View File

@ -48,6 +48,7 @@
#:use-module (gnu services) #:use-module (gnu services)
#:use-module (gnu services shepherd) #:use-module (gnu services shepherd)
#:use-module (gnu services base) #:use-module (gnu services base)
#:use-module (gnu bootloader)
#:use-module (gnu system shadow) #:use-module (gnu system shadow)
#:use-module (gnu system nss) #:use-module (gnu system nss)
#:use-module (gnu system locale) #:use-module (gnu system locale)
@ -139,7 +140,7 @@ booted from ROOT-DEVICE"
(default linux-libre)) (default linux-libre))
(kernel-arguments operating-system-user-kernel-arguments (kernel-arguments operating-system-user-kernel-arguments
(default '())) ; list of gexps/strings (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 (initrd operating-system-initrd ; (list fs) -> M derivation
(default base-initrd)) (default base-initrd))
@ -847,12 +848,11 @@ populate the \"old entries\" menu."
(root-device -> (if (eq? 'uuid (file-system-title root-fs)) (root-device -> (if (eq? 'uuid (file-system-title root-fs))
(uuid->string (file-system-device root-fs)) (uuid->string (file-system-device root-fs))
(file-system-device root-fs))) (file-system-device root-fs)))
(entry (operating-system-boot-parameters os system root-device))) (entry (operating-system-boot-parameters os system root-device))
((module-ref (resolve-interface '(gnu system grub)) (bootloader-conf -> (operating-system-bootloader os)))
'grub-configuration-file) ((bootloader-configuration-file-generator
(operating-system-bootloader os) (bootloader-configuration-bootloader bootloader-conf))
(list entry) bootloader-conf (list entry) #:old-entries old-entries)))
#:old-entries old-entries)))
(define (fs->boot-device fs) (define (fs->boot-device fs)
"Given FS, a <file-system> object, return a value suitable for use as the "Given FS, a <file-system> object, return a value suitable for use as the

View File

@ -49,7 +49,7 @@
#:use-module (gnu system shadow) #:use-module (gnu system shadow)
#:use-module (gnu system pam) #:use-module (gnu system pam)
#:use-module (gnu system linux-initrd) #: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 file-systems)
#:use-module (gnu system) #:use-module (gnu system)
#:use-module (gnu services) #:use-module (gnu services)

View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -20,8 +21,8 @@
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix records) #:use-module (guix records)
#:use-module (gnu bootloader grub)
#:use-module (gnu system) #:use-module (gnu system)
#:use-module (gnu system grub)
#:use-module (gnu system file-systems) #:use-module (gnu system file-systems)
#:use-module (gnu system shadow) #:use-module (gnu system shadow)
#:use-module (gnu services) #:use-module (gnu services)

View File

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 John Darrington <jmd@gnu.org> ;;; Copyright © 2016 John Darrington <jmd@gnu.org>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -19,8 +20,8 @@
(define-module (gnu tests nfs) (define-module (gnu tests nfs)
#:use-module (gnu tests) #:use-module (gnu tests)
#:use-module (gnu bootloader grub)
#:use-module (gnu system) #:use-module (gnu system)
#:use-module (gnu system grub)
#:use-module (gnu system file-systems) #:use-module (gnu system file-systems)
#:use-module (gnu system shadow) #:use-module (gnu system shadow)
#:use-module (gnu system vm) #:use-module (gnu system vm)

View File

@ -38,10 +38,10 @@
#:use-module (guix build utils) #:use-module (guix build utils)
#:use-module (gnu build install) #:use-module (gnu build install)
#:use-module (gnu system) #:use-module (gnu system)
#:use-module (gnu bootloader)
#:use-module (gnu system file-systems) #:use-module (gnu system file-systems)
#:use-module (gnu system linux-container) #:use-module (gnu system linux-container)
#:use-module (gnu system vm) #:use-module (gnu system vm)
#:use-module (gnu system grub)
#:use-module (gnu services) #:use-module (gnu services)
#:use-module (gnu services shepherd) #:use-module (gnu services shepherd)
#:use-module (gnu services herd) #:use-module (gnu services herd)
@ -598,8 +598,12 @@ output when building a system derivation, such as a disk image."
#:image-size image-size #:image-size image-size
#:full-boot? full-boot? #:full-boot? full-boot?
#:mappings mappings)) #:mappings mappings))
(grub (package->derivation (grub-configuration-grub (bootloader (let ((bootloader (bootloader-package
(operating-system-bootloader os)))) (bootloader-configuration-bootloader
(operating-system-bootloader os)))))
(if bootloader
(package->derivation bootloader)
(return #f))))
(grub.cfg (if (eq? 'container action) (grub.cfg (if (eq? 'container action)
(return #f) (return #f)
(operating-system-bootcfg os (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 ;; --no-grub is passed, because GRUB.CFG because we then use it as a GC
;; root. See <http://bugs.gnu.org/21068>. ;; root. See <http://bugs.gnu.org/21068>.
(drvs -> (if (memq action '(init reconfigure)) (drvs -> (if (memq action '(init reconfigure))
(if bootloader? (if (and bootloader? bootloader)
(list sys grub.cfg grub) (list sys grub.cfg bootloader)
(list sys grub.cfg)) (list sys grub.cfg))
(list sys))) (list sys)))
(% (if derivations-only? (% (if derivations-only?
@ -628,8 +632,8 @@ output when building a system derivation, such as a disk image."
drvs) drvs)
;; Make sure GRUB is accessible. ;; Make sure GRUB is accessible.
(when bootloader? (when (and bootloader? bootloader)
(let ((prefix (derivation->output-path grub))) (let ((prefix (derivation->output-path bootloader)))
(setenv "PATH" (setenv "PATH"
(string-append prefix "/bin:" prefix "/sbin:" (string-append prefix "/bin:" prefix "/sbin:"
(getenv "PATH"))))) (getenv "PATH")))))
@ -832,7 +836,7 @@ resulting from command-line parsing."
((first second) second) ((first second) second)
(_ #f))) (_ #f)))
(device (and bootloader? (device (and bootloader?
(grub-configuration-device (bootloader-configuration-device
(operating-system-bootloader os))))) (operating-system-bootloader os)))))
(with-store store (with-store store