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