gnu/bootloader.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2017 David Craven <david@craven.ch>
   3 ;;; Copyright © 2017, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
   4 ;;; Copyright © 2017 Leo Famulari <leo@famulari.name>
   5 ;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
   6 ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
   7 ;;;
   8 ;;; This file is part of GNU Guix.
   9 ;;;
  10 ;;; GNU Guix is free software; you can redistribute it and/or modify it
  11 ;;; under the terms of the GNU General Public License as published by
  12 ;;; the Free Software Foundation; either version 3 of the License, or (at
  13 ;;; your option) any later version.
  14 ;;;
  15 ;;; GNU Guix is distributed in the hope that it will be useful, but
  16 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;;; GNU General Public License for more details.
  19 ;;;
  20 ;;; You should have received a copy of the GNU General Public License
  21 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 (define-module (gnu bootloader)
  24   #:use-module (guix discovery)
  25   #:use-module (guix records)
  26   #:use-module (guix ui)
  27   #:use-module (srfi srfi-1)
  28   #:use-module (ice-9 match)
  29   #:export (menu-entry
  30             menu-entry?
  31             menu-entry-label
  32             menu-entry-device
  33             menu-entry-linux
  34             menu-entry-linux-arguments
  35             menu-entry-initrd
  36             menu-entry-device-mount-point
  37             menu-entry-multiboot-kernel
  38             menu-entry-multiboot-arguments
  39             menu-entry-multiboot-modules
  40
  41             menu-entry->sexp
  42             sexp->menu-entry
  43
  44             bootloader
  45             bootloader?
  46             bootloader-name
  47             bootloader-package
  48             bootloader-installer
  49             bootloader-disk-image-installer
  50             bootloader-configuration-file
  51             bootloader-configuration-file-generator
  52
  53             bootloader-configuration
  54             bootloader-configuration?
  55             bootloader-configuration-bootloader
  56             bootloader-configuration-target
  57             bootloader-configuration-menu-entries
  58             bootloader-configuration-default-entry
  59             bootloader-configuration-timeout
  60             bootloader-configuration-keyboard-layout
  61             bootloader-configuration-theme
  62             bootloader-configuration-terminal-outputs
  63             bootloader-configuration-terminal-inputs
  64             bootloader-configuration-serial-unit
  65             bootloader-configuration-serial-speed
  66             bootloader-configuration-additional-configuration
  67
  68             %bootloaders
  69             lookup-bootloader-by-name))
  70
  71 \f
  72 ;;;
  73 ;;; Menu-entry record.
  74 ;;;
  75
  76 (define-record-type* <menu-entry>
  77   menu-entry make-menu-entry
  78   menu-entry?
  79   (label           menu-entry-label)
  80   (device          menu-entry-device       ; file system uuid, label, or #f
  81                    (default #f))
  82   (device-mount-point menu-entry-device-mount-point
  83                    (default #f))
  84   (linux           menu-entry-linux
  85                    (default #f))
  86   (linux-arguments menu-entry-linux-arguments
  87                    (default '()))          ; list of string-valued gexps
  88   (initrd          menu-entry-initrd       ; file name of the initrd as a gexp
  89                    (default #f))
  90   (multiboot-kernel menu-entry-multiboot-kernel
  91                     (default #f))
  92   (multiboot-arguments menu-entry-multiboot-arguments
  93                        (default '()))      ; list of string-valued gexps
  94   (multiboot-modules menu-entry-multiboot-modules
  95                      (default '())))       ; list of multiboot commands, where
  96                                            ; a command is a list of <string>
  97
  98 (define (menu-entry->sexp entry)
  99   "Return ENTRY serialized as an sexp."
 100   (match entry
 101     (($ <menu-entry> label device mount-point linux linux-arguments initrd #f
 102                      ())
 103      `(menu-entry (version 0)
 104                   (label ,label)
 105                   (device ,device)
 106                   (device-mount-point ,mount-point)
 107                   (linux ,linux)
 108                   (linux-arguments ,linux-arguments)
 109                   (initrd ,initrd)))
 110     (($ <menu-entry> label device mount-point #f () #f
 111                      multiboot-kernel multiboot-arguments multiboot-modules)
 112      `(menu-entry (version 0)
 113                   (label ,label)
 114                   (device ,device)
 115                   (device-mount-point ,mount-point)
 116                   (multiboot-kernel ,multiboot-kernel)
 117                   (multiboot-arguments ,multiboot-arguments)
 118                   (multiboot-modules ,multiboot-modules)))))
 119
 120 (define (sexp->menu-entry sexp)
 121   "Turn SEXP, an sexp as returned by 'menu-entry->sexp', into a <menu-entry>
 122 record."
 123   (match sexp
 124     (('menu-entry ('version 0)
 125                   ('label label) ('device device)
 126                   ('device-mount-point mount-point)
 127                   ('linux linux) ('linux-arguments linux-arguments)
 128                   ('initrd initrd) _ ...)
 129      (menu-entry
 130       (label label)
 131       (device device)
 132       (device-mount-point mount-point)
 133       (linux linux)
 134       (linux-arguments linux-arguments)
 135       (initrd initrd)))
 136     (('menu-entry ('version 0)
 137                   ('label label) ('device device)
 138                   ('device-mount-point mount-point)
 139                   ('multiboot-kernel multiboot-kernel)
 140                   ('multiboot-arguments multiboot-arguments)
 141                   ('multiboot-modules multiboot-modules) _ ...)
 142      (menu-entry
 143       (label label)
 144       (device device)
 145       (device-mount-point mount-point)
 146       (multiboot-kernel multiboot-kernel)
 147       (multiboot-arguments multiboot-arguments)
 148       (multiboot-modules multiboot-modules)))))
 149
 150 \f
 151 ;;;
 152 ;;; Bootloader record.
 153 ;;;
 154
 155 ;; The <bootloader> record contains fields expressing how the bootloader
 156 ;; should be installed. Every bootloader in gnu/bootloader/ directory
 157 ;; has to be described by this record.
 158
 159 (define-record-type* <bootloader>
 160   bootloader make-bootloader
 161   bootloader?
 162   (name                            bootloader-name)
 163   (package                         bootloader-package)
 164   (installer                       bootloader-installer)
 165   (disk-image-installer            bootloader-disk-image-installer
 166                                    (default #f))
 167   (configuration-file              bootloader-configuration-file)
 168   (configuration-file-generator    bootloader-configuration-file-generator))
 169
 170 \f
 171 ;;;
 172 ;;; Bootloader configuration record.
 173 ;;;
 174
 175 ;; The <bootloader-configuration> record contains bootloader independant
 176 ;; configuration used to fill bootloader configuration file.
 177
 178 (define-record-type* <bootloader-configuration>
 179   bootloader-configuration make-bootloader-configuration
 180   bootloader-configuration?
 181   (bootloader         bootloader-configuration-bootloader) ;<bootloader>
 182   (target             bootloader-configuration-target      ;string
 183                       (default #f))
 184   (menu-entries       bootloader-configuration-menu-entries ;list of <menu-entry>
 185                       (default '()))
 186   (default-entry      bootloader-configuration-default-entry ;integer
 187                       (default 0))
 188   (timeout            bootloader-configuration-timeout ;seconds as integer
 189                       (default 5))
 190   (keyboard-layout    bootloader-configuration-keyboard-layout ;<keyboard-layout> | #f
 191                       (default #f))
 192   (theme              bootloader-configuration-theme ;bootloader-specific theme
 193                       (default #f))
 194   (terminal-outputs   bootloader-configuration-terminal-outputs ;list of symbols
 195                       (default '(gfxterm)))
 196   (terminal-inputs    bootloader-configuration-terminal-inputs ;list of symbols
 197                       (default '()))
 198   (serial-unit        bootloader-configuration-serial-unit ;integer | #f
 199                       (default #f))
 200   (serial-speed       bootloader-configuration-serial-speed ;integer | #f
 201                       (default #f)))
 202
 203 \f
 204 ;;;
 205 ;;; Bootloaders.
 206 ;;;
 207
 208 (define (bootloader-modules)
 209   "Return the list of bootloader modules."
 210   (all-modules (map (lambda (entry)
 211                       `(,entry . "gnu/bootloader"))
 212                     %load-path)
 213                #:warn warn-about-load-error))
 214
 215 (define %bootloaders
 216   ;; The list of publically-known bootloaders.
 217   (delay (fold-module-public-variables (lambda (obj result)
 218                                          (if (bootloader? obj)
 219                                              (cons obj result)
 220                                              result))
 221                                        '()
 222                                        (bootloader-modules))))
 223
 224 (define (lookup-bootloader-by-name name)
 225   "Return the bootloader called NAME."
 226   (or (find (lambda (bootloader)
 227               (eq? name (bootloader-name bootloader)))
 228             (force %bootloaders))
 229       (leave (G_ "~a: no such bootloader~%") name)))