bug#26339: [PATCH v4 1/7] bootloader: Add extlinux support.

[Mathieu Othacehe]

* 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.
---
 gnu.scm                             |   4 +-
 gnu/bootloader.scm                  | 114 ++++++++++++++++++++++++++++
 gnu/bootloader/extlinux.scm         | 147 ++++++++++++++++++++++++++++++++++++
 gnu/{system => bootloader}/grub.scm | 105 ++++++++++++++++++--------
 gnu/local.mk                        |   4 +-
 gnu/system.scm                      |  14 ++--
 gnu/system/vm.scm                   |   2 +-
 gnu/tests.scm                       |   3 +-
 gnu/tests/nfs.scm                   |   3 +-
 guix/scripts/system.scm             |  20 +++--
 10 files changed, 364 insertions(+), 52 deletions(-)
 create mode 100644 gnu/bootloader.scm
 create mode 100644 gnu/bootloader/extlinux.scm
 rename gnu/{system => bootloader}/grub.scm (83%)

diff --git a/gnu.scm b/gnu.scm
index 932e4cdd5..913ce6160 100644
--- a/gnu.scm
+++ b/gnu.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <address@hidden>
 ;;; Copyright © 2015 Joshua S. Grant <address@hidden>
+;;; Copyright © 2017 Mathieu Othacehe <address@hidden>
 ;;;
 ;;; 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)
diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm
new file mode 100644
index 000000000..77f81d33a
--- /dev/null
+++ b/gnu/bootloader.scm
@@ -0,0 +1,114 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2017 David Craven <address@hidden>
+;;; Copyright © 2017 Mathieu Othacehe <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 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-theme
+            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
+
+            %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)
+  (theme                           bootloader-theme
+                                   (default #f))
+  (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        ; 
integer
+                                   (default 5))
+  (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)
+              (format #t "~a\n" (eq? name (bootloader-name bootloader)))
+              (eq? name (bootloader-name bootloader)))
+            (force %bootloaders))
+      (leave (G_ "~a: no such bootloader~%") name)))
diff --git a/gnu/bootloader/extlinux.scm b/gnu/bootloader/extlinux.scm
new file mode 100644
index 000000000..002477c0c
--- /dev/null
+++ b/gnu/bootloader/extlinux.scm
@@ -0,0 +1,147 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2017 David Craven <address@hidden>
+;;; Copyright © 2017 Mathieu Othacehe <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 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 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)
+                    ;; 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-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 definitions.
+;;;
+
+(define extlinux-bootloader
+  (bootloader
+   (name 'extlinux)
+   (package #f)
+   (installer #f)
+   (configuration-file "/boot/extlinux/extlinux.conf")
+   (configuration-file-generator extlinux-configuration-file)))
+
+(define syslinux-bootloader
+  (bootloader
+   (inherit extlinux-bootloader)
+   (name 'syslinux)
+   (package syslinux)
+   (installer install-syslinux)))
+
+
+;;;
+;;; Compatibility macros.
+;;;
+
+(define-syntax-rule (extlinux-configuration fields ...)
+  (bootloader-configuration
+   (bootloader extlinux-bootloader)
+   fields ...))
+
+(define-syntax-rule (syslinux-configuration fields ...)
+  (bootloader-configuration
+   (bootloader syslinux-bootloader)
+   fields ...))
diff --git a/gnu/system/grub.scm b/gnu/bootloader/grub.scm
similarity index 83%
rename from gnu/system/grub.scm
rename to gnu/bootloader/grub.scm
index 58096429f..1dd50e391 100644
--- a/gnu/system/grub.scm
+++ b/gnu/bootloader/grub.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <address@hidden>
 ;;; Copyright © 2016 Chris Marusich <address@hidden>
+;;; Copyright © 2017 Mathieu Othacehe <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -17,7 +18,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)
@@ -27,6 +28,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)
@@ -49,15 +51,11 @@
             %background-image
             %default-theme
 
-            grub-configuration
-            grub-configuration?
-            grub-configuration-device
-            grub-configuration-grub
-
-            menu-entry
-            menu-entry?
+            grub-bootloader
+            grub-efi-bootloader
 
-            grub-configuration-file))
+            grub-configuration
+            grub-efi-configuration))
 
 ;;; Commentary:
 ;;;
@@ -105,21 +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)))
-
 (define-record-type* <menu-entry>
   menu-entry make-menu-entry
   menu-entry?
@@ -162,7 +145,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
+                                          (bootloader-configuration-bootloader 
config))))))
     (if image
         (svg->png (grub-image-file image)
                   #:width width #:height height)
@@ -205,7 +189,8 @@ system string---e.g., \"x86_64-linux\"."
         ""))
 
   (define (theme-colors type)
-    (let* ((theme  (grub-configuration-theme config))
+    (let* ((theme  (bootloader-theme
+                    (bootloader-configuration-bootloader config)))
            (colors (type theme)))
       (string-append (symbol->string (assoc-ref colors 'fg)) "/"
                      (symbol->string (assoc-ref colors 'bg)))))
@@ -282,12 +267,12 @@ 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)))
+            (bootloader-configuration-menu-entries config)))
 
   (define entry->gexp
     (match-lambda
@@ -326,8 +311,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)
@@ -339,4 +324,60 @@ 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)
+   (theme %default-theme)
+   (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-rule (grub-configuration fields ...)
+  (bootloader-configuration
+   (bootloader grub-bootloader)
+   fields ...))
+
+(define-syntax-rule (grub-efi-configuration fields ...)
+  (bootloader-configuration
+   (bootloader grub-efi-bootloader)
+   fields ...))
+
 ;;; grub.scm ends here
diff --git a/gnu/local.mk b/gnu/local.mk
index 28a283ab7..73650c673 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -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                     \
@@ -441,7 +444,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                  \
diff --git a/gnu/system.scm b/gnu/system.scm
index 9fc6cc5e7..8040e2b15 100644
--- a/gnu/system.scm
+++ b/gnu/system.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)
@@ -138,7 +139,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))
@@ -846,12 +847,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
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 2c8b954c8..080014cde 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -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)
diff --git a/gnu/tests.scm b/gnu/tests.scm
index 810711ab9..2886a982f 100644
--- a/gnu/tests.scm
+++ b/gnu/tests.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016, 2017 Ludovic Courtès <address@hidden>
+;;; Copyright © 2017 Mathieu Othacehe <address@hidden>
 ;;;
 ;;; 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)
diff --git a/gnu/tests/nfs.scm b/gnu/tests/nfs.scm
index 1f28f5a5b..9e1ac1d55 100644
--- a/gnu/tests/nfs.scm
+++ b/gnu/tests/nfs.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016 Ludovic Courtès <address@hidden>
 ;;; Copyright © 2016 John Darrington <address@hidden>
+;;; Copyright © 2017 Mathieu Othacehe <address@hidden>
 ;;;
 ;;; 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)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 9c0976750..5fd0d7600 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -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
-- 
2.13.0