gnu/bootloader.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2017 David Craven <david@craven.ch>
   3 ;;; Copyright © 2017 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-configuration-file
  46             bootloader-configuration-file-generator
  47
  48             bootloader-configuration
  49             bootloader-configuration?
  50             bootloader-configuration-bootloader
  51             bootloader-configuration-target
  52             bootloader-configuration-menu-entries
  53             bootloader-configuration-default-entry
  54             bootloader-configuration-timeout
  55             bootloader-configuration-keyboard-layout
  56             bootloader-configuration-theme
  57             bootloader-configuration-terminal-outputs
  58             bootloader-configuration-terminal-inputs
  59             bootloader-configuration-serial-unit
  60             bootloader-configuration-serial-speed
  61             bootloader-configuration-additional-configuration
  62
  63             %bootloaders
  64             lookup-bootloader-by-name))
  65
  66 \f
  67 ;;;
  68 ;;; Menu-entry record.
  69 ;;;
  70
  71 (define-record-type* <menu-entry>
  72   menu-entry make-menu-entry
  73   menu-entry?
  74   (label           menu-entry-label)
  75   (device          menu-entry-device       ; file system uuid, label, or #f
  76                    (default #f))
  77   (device-mount-point menu-entry-device-mount-point
  78                    (default #f))
  79   (linux           menu-entry-linux)
  80   (linux-arguments menu-entry-linux-arguments
  81                    (default '()))          ; list of string-valued gexps
  82   (initrd          menu-entry-initrd))     ; file name of the initrd as a gexp
  83
  84 (define (menu-entry->sexp entry)
  85   "Return ENTRY serialized as an sexp."
  86   (match entry
  87     (($ <menu-entry> label device mount-point linux linux-arguments initrd)
  88      `(menu-entry (version 0)
  89                   (label ,label)
  90                   (device ,device)
  91                   (device-mount-point ,mount-point)
  92                   (linux ,linux)
  93                   (linux-arguments ,linux-arguments)
  94                   (initrd ,initrd)))))
  95
  96 (define (sexp->menu-entry sexp)
  97   "Turn SEXP, an sexp as returned by 'menu-entry->sexp', into a <menu-entry>
  98 record."
  99   (match sexp
 100     (('menu-entry ('version 0)
 101                   ('label label) ('device device)
 102                   ('device-mount-point mount-point)
 103                   ('linux linux) ('linux-arguments linux-arguments)
 104                   ('initrd initrd) _ ...)
 105      (menu-entry
 106       (label label)
 107       (device device)
 108       (device-mount-point mount-point)
 109       (linux linux)
 110       (linux-arguments linux-arguments)
 111       (initrd initrd)))))
 112
 113 \f
 114 ;;;
 115 ;;; Bootloader record.
 116 ;;;
 117
 118 ;; The <bootloader> record contains fields expressing how the bootloader
 119 ;; should be installed. Every bootloader in gnu/bootloader/ directory
 120 ;; has to be described by this record.
 121
 122 (define-record-type* <bootloader>
 123   bootloader make-bootloader
 124   bootloader?
 125   (name                            bootloader-name)
 126   (package                         bootloader-package)
 127   (installer                       bootloader-installer)
 128   (configuration-file              bootloader-configuration-file)
 129   (configuration-file-generator    bootloader-configuration-file-generator))
 130
 131 \f
 132 ;;;
 133 ;;; Bootloader configuration record.
 134 ;;;
 135
 136 ;; The <bootloader-configuration> record contains bootloader independant
 137 ;; configuration used to fill bootloader configuration file.
 138
 139 (define-record-type* <bootloader-configuration>
 140   bootloader-configuration make-bootloader-configuration
 141   bootloader-configuration?
 142   (bootloader         bootloader-configuration-bootloader) ;<bootloader>
 143   (target             bootloader-configuration-target      ;string
 144                       (default #f))
 145   (menu-entries       bootloader-configuration-menu-entries ;list of <menu-entry>
 146                       (default '()))
 147   (default-entry      bootloader-configuration-default-entry ;integer
 148                       (default 0))
 149   (timeout            bootloader-configuration-timeout ;seconds as integer
 150                       (default 5))
 151   (keyboard-layout    bootloader-configuration-keyboard-layout ;<keyboard-layout> | #f
 152                       (default #f))
 153   (theme              bootloader-configuration-theme ;bootloader-specific theme
 154                       (default #f))
 155   (terminal-outputs   bootloader-configuration-terminal-outputs ;list of symbols
 156                       (default '(gfxterm)))
 157   (terminal-inputs    bootloader-configuration-terminal-inputs ;list of symbols
 158                       (default '()))
 159   (serial-unit        bootloader-configuration-serial-unit ;integer | #f
 160                       (default #f))
 161   (serial-speed       bootloader-configuration-serial-speed ;integer | #f
 162                       (default #f)))
 163
 164 \f
 165 ;;;
 166 ;;; Bootloaders.
 167 ;;;
 168
 169 (define (bootloader-modules)
 170   "Return the list of bootloader modules."
 171   (all-modules (map (lambda (entry)
 172                       `(,entry . "gnu/bootloader"))
 173                     %load-path)
 174                #:warn warn-about-load-error))
 175
 176 (define %bootloaders
 177   ;; The list of publically-known bootloaders.
 178   (delay (fold-module-public-variables (lambda (obj result)
 179                                          (if (bootloader? obj)
 180                                              (cons obj result)
 181                                              result))
 182                                        '()
 183                                        (bootloader-modules))))
 184
 185 (define (lookup-bootloader-by-name name)
 186   "Return the bootloader called NAME."
 187   (or (find (lambda (bootloader)
 188               (eq? name (bootloader-name bootloader)))
 189             (force %bootloaders))
 190       (leave (G_ "~a: no such bootloader~%") name)))