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>
8 ;;; This file is part of GNU Guix.
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.
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.
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/>.
23 (define-module (gnu bootloader)
24 #:use-module (guix discovery)
25 #:use-module (guix gexp)
26 #:use-module (guix profiles)
27 #:use-module (guix records)
28 #:use-module (guix ui)
29 #:use-module (srfi srfi-1)
30 #:use-module (ice-9 match)
36 menu-entry-linux-arguments
38 menu-entry-device-mount-point
39 menu-entry-multiboot-kernel
40 menu-entry-multiboot-arguments
41 menu-entry-multiboot-modules
51 bootloader-disk-image-installer
52 bootloader-configuration-file
53 bootloader-configuration-file-generator
55 bootloader-configuration
56 bootloader-configuration?
57 bootloader-configuration-bootloader
58 bootloader-configuration-target
59 bootloader-configuration-menu-entries
60 bootloader-configuration-default-entry
61 bootloader-configuration-timeout
62 bootloader-configuration-keyboard-layout
63 bootloader-configuration-theme
64 bootloader-configuration-terminal-outputs
65 bootloader-configuration-terminal-inputs
66 bootloader-configuration-serial-unit
67 bootloader-configuration-serial-speed
68 bootloader-configuration-additional-configuration
71 lookup-bootloader-by-name
73 efi-bootloader-chain))
77 ;;; Menu-entry record.
80 (define-record-type* <menu-entry>
81 menu-entry make-menu-entry
83 (label menu-entry-label)
84 (device menu-entry-device ; file system uuid, label, or #f
86 (device-mount-point menu-entry-device-mount-point
88 (linux menu-entry-linux
90 (linux-arguments menu-entry-linux-arguments
91 (default '())) ; list of string-valued gexps
92 (initrd menu-entry-initrd ; file name of the initrd as a gexp
94 (multiboot-kernel menu-entry-multiboot-kernel
96 (multiboot-arguments menu-entry-multiboot-arguments
97 (default '())) ; list of string-valued gexps
98 (multiboot-modules menu-entry-multiboot-modules
99 (default '()))) ; list of multiboot commands, where
100 ; a command is a list of <string>
102 (define (menu-entry->sexp entry)
103 "Return ENTRY serialized as an sexp."
105 (($ <menu-entry> label device mount-point linux linux-arguments initrd #f
107 `(menu-entry (version 0)
110 (device-mount-point ,mount-point)
112 (linux-arguments ,linux-arguments)
114 (($ <menu-entry> label device mount-point #f () #f
115 multiboot-kernel multiboot-arguments multiboot-modules)
116 `(menu-entry (version 0)
119 (device-mount-point ,mount-point)
120 (multiboot-kernel ,multiboot-kernel)
121 (multiboot-arguments ,multiboot-arguments)
122 (multiboot-modules ,multiboot-modules)))))
124 (define (sexp->menu-entry sexp)
125 "Turn SEXP, an sexp as returned by 'menu-entry->sexp', into a <menu-entry>
128 (('menu-entry ('version 0)
129 ('label label) ('device device)
130 ('device-mount-point mount-point)
131 ('linux linux) ('linux-arguments linux-arguments)
132 ('initrd initrd) _ ...)
136 (device-mount-point mount-point)
138 (linux-arguments linux-arguments)
140 (('menu-entry ('version 0)
141 ('label label) ('device device)
142 ('device-mount-point mount-point)
143 ('multiboot-kernel multiboot-kernel)
144 ('multiboot-arguments multiboot-arguments)
145 ('multiboot-modules multiboot-modules) _ ...)
149 (device-mount-point mount-point)
150 (multiboot-kernel multiboot-kernel)
151 (multiboot-arguments multiboot-arguments)
152 (multiboot-modules multiboot-modules)))))
156 ;;; Bootloader record.
159 ;; The <bootloader> record contains fields expressing how the bootloader
160 ;; should be installed. Every bootloader in gnu/bootloader/ directory
161 ;; has to be described by this record.
163 (define-record-type* <bootloader>
164 bootloader make-bootloader
166 (name bootloader-name)
167 (package bootloader-package)
168 (installer bootloader-installer)
169 (disk-image-installer bootloader-disk-image-installer
171 (configuration-file bootloader-configuration-file)
172 (configuration-file-generator bootloader-configuration-file-generator))
176 ;;; Bootloader configuration record.
179 ;; The <bootloader-configuration> record contains bootloader independant
180 ;; configuration used to fill bootloader configuration file.
182 (define-record-type* <bootloader-configuration>
183 bootloader-configuration make-bootloader-configuration
184 bootloader-configuration?
185 (bootloader bootloader-configuration-bootloader) ;<bootloader>
186 (target bootloader-configuration-target ;string
188 (menu-entries bootloader-configuration-menu-entries ;list of <menu-entry>
190 (default-entry bootloader-configuration-default-entry ;integer
192 (timeout bootloader-configuration-timeout ;seconds as integer
194 (keyboard-layout bootloader-configuration-keyboard-layout ;<keyboard-layout> | #f
196 (theme bootloader-configuration-theme ;bootloader-specific theme
198 (terminal-outputs bootloader-configuration-terminal-outputs ;list of symbols
199 (default '(gfxterm)))
200 (terminal-inputs bootloader-configuration-terminal-inputs ;list of symbols
202 (serial-unit bootloader-configuration-serial-unit ;integer | #f
204 (serial-speed bootloader-configuration-serial-speed ;integer | #f
212 (define (bootloader-modules)
213 "Return the list of bootloader modules."
214 (all-modules (map (lambda (entry)
215 `(,entry . "gnu/bootloader"))
217 #:warn warn-about-load-error))
220 ;; The list of publically-known bootloaders.
221 (delay (fold-module-public-variables (lambda (obj result)
222 (if (bootloader? obj)
226 (bootloader-modules))))
228 (define (lookup-bootloader-by-name name)
229 "Return the bootloader called NAME."
230 (or (find (lambda (bootloader)
231 (eq? name (bootloader-name bootloader)))
232 (force %bootloaders))
233 (leave (G_ "~a: no such bootloader~%") name)))
235 (define (efi-bootloader-profile files bootloader-package hooks)
236 "Creates a profile with BOOTLOADER-PACKAGE and a directory collection/ with
237 links to additional FILES from the store. This collection is meant to be used
238 by the bootloader installer.
240 FILES is a list of file or directory names from the store, which will be
241 symlinked into the collection/ directory. If a directory name ends with '/',
242 then the directory content instead of the directory itself will be symlinked
243 into the collection/ directory.
245 FILES may contain file like objects produced by functions like plain-file,
246 local-file, etc., or package contents produced with file-append.
248 HOOKS lists additional hook functions to modify the profile."
249 (define (bootloader-collection manifest)
251 (with-imported-modules '((guix build utils)
256 (use-modules ((guix build utils)
257 #:select (mkdir-p strip-store-file-name))
261 #:select (append-map every remove))
264 (define (symlink-to file directory transform)
265 "Creates a symlink to FILE named (TRANSFORM FILE) in DIRECTORY."
266 (symlink file (string-append directory "/" (transform file))))
267 (define (directory-content directory)
268 "Creates a list of absolute path names inside DIRECTORY."
270 (string-append directory name))
271 (or (scandir directory (lambda (name)
272 (not (member name '("." "..")))))
274 (define name-ends-with-/? (cut string-suffix? "/" <>))
275 (define (name-is-store-entry? name)
276 "Return #t if NAME is a direct store entry and nothing inside."
277 (not (string-index (strip-store-file-name name) #\/)))
278 (let* ((collection (string-append #$output "/collection"))
280 (directories (filter name-ends-with-/? files))
281 (names-from-directories
282 (append-map (lambda (directory)
283 (directory-content directory))
285 (names (append names-from-directories
286 (remove name-ends-with-/? files))))
288 (if (every file-exists? names)
290 (for-each (lambda (name)
291 (symlink-to name collection
292 (if (name-is-store-entry? name)
293 strip-store-file-name
299 (gexp->derivation "bootloader-collection"
304 `((type . profile-hook)
305 (hook . bootloader-collection))))
307 (profile (content (packages->manifest (list bootloader-package)))
308 (name "bootloader-profile")
309 (hooks (append (list bootloader-collection) hooks))
311 (allow-collisions? #f)
312 (relative-symlinks? #f)))
314 (define* (efi-bootloader-chain files
319 "Define a bootloader chain with FINAL-BOOTLOADER as the final bootloader and
320 certain directories and files from the store given in the list of FILES.
322 FILES may contain file like objects produced by functions like plain-file,
323 local-file, etc., or package contents produced with file-append. They will be
324 collected inside a directory collection/ inside a generated bootloader profile,
325 which will be passed to the INSTALLER.
327 If a directory name in FILES ends with '/', then the directory content instead
328 of the directory itself will be symlinked into the collection/ directory.
330 The procedures in the HOOKS list can be used to further modify the bootloader
331 profile. It is possible to pass a single function instead of a list.
333 If the INSTALLER argument is used, then this function will be called to install
334 the bootloader. Otherwise the installer of the FINAL-BOOTLOADER will be called."
335 (let* ((final-installer (or installer
336 (bootloader-installer final-bootloader)))
337 (profile (efi-bootloader-profile files
338 (bootloader-package final-bootloader)
343 (inherit final-bootloader)
346 #~(lambda (bootloader target mount-point)
347 (#$final-installer bootloader target mount-point)
349 (string-append bootloader "/collection")
350 (string-append mount-point target)
351 #:follow-symlinks? #t
352 #:log (%make-void-port "w")))))))