projects/guix·blob hurd-team · refs

447 lines · 18.1 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2017 David Craven <[email protected]>
3;;; Copyright © 2017, 2020, 2022 Mathieu Othacehe <[email protected]>
4;;; Copyright © 2017 Leo Famulari <[email protected]>
5;;; Copyright © 2019, 2021, 2023, 2025 Ludovic Courtès <[email protected]>
6;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <[email protected]>
7;;; Copyright © 2022 Josselin Poiret <[email protected]>
8;;; Copyright © 2022 Reza Alizadeh Majd <[email protected]>
9;;; Copyright © 2024 Tomas Volf <[email protected]>
10;;;
11;;; This file is part of GNU Guix.
12;;;
13;;; GNU Guix is free software; you can redistribute it and/or modify it
14;;; under the terms of the GNU General Public License as published by
15;;; the Free Software Foundation; either version 3 of the License, or (at
16;;; your option) any later version.
17;;;
18;;; GNU Guix is distributed in the hope that it will be useful, but
19;;; WITHOUT ANY WARRANTY; without even the implied warranty of
20;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21;;; GNU General Public License for more details.
22;;;
23;;; You should have received a copy of the GNU General Public License
24;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
25
26(define-module (gnu bootloader)
27 #:use-module (gnu system file-systems)
28 #:use-module (gnu system uuid)
29 #:autoload (guix discovery) (fold-module-public-variables)
30 #:autoload (guix describe) (modules-from-current-profile)
31 #:use-module (guix gexp)
32 #:use-module (guix profiles)
33 #:use-module (guix records)
34 #:use-module (guix deprecation)
35 #:use-module ((guix ui) #:select (warn-about-load-error))
36 #:use-module (guix diagnostics)
37 #:use-module (guix i18n)
38 #:use-module (srfi srfi-1)
39 #:use-module (srfi srfi-34)
40 #:use-module (srfi srfi-35)
41 #:use-module (ice-9 match)
42 #:export (menu-entry
43 menu-entry?
44 menu-entry-label
45 menu-entry-device
46 menu-entry-linux
47 menu-entry-linux-arguments
48 menu-entry-initrd
49 menu-entry-device-mount-point
50 menu-entry-multiboot-kernel
51 menu-entry-multiboot-arguments
52 menu-entry-multiboot-modules
53 menu-entry-chain-loader
54
55 menu-entry->sexp
56 sexp->menu-entry
57
58 bootloader
59 bootloader?
60 bootloader-name
61 bootloader-package
62 bootloader-installer
63 bootloader-disk-image-installer
64 bootloader-configuration-file
65 bootloader-configuration-file-generator
66
67 bootloader-configuration
68 bootloader-configuration?
69 bootloader-configuration-bootloader
70 bootloader-configuration-target ;deprecated
71 bootloader-configuration-targets
72 bootloader-configuration-menu-entries
73 bootloader-configuration-default-entry
74 bootloader-configuration-timeout
75 bootloader-configuration-keyboard-layout
76 bootloader-configuration-theme
77 bootloader-configuration-terminal-outputs
78 bootloader-configuration-terminal-inputs
79 bootloader-configuration-serial-unit
80 bootloader-configuration-serial-speed
81 bootloader-configuration-device-tree-support?
82 bootloader-configuration-extra-initrd
83
84 %bootloaders
85 lookup-bootloader-by-name
86
87 efi-bootloader-chain))
88
89
90;;;
91;;; Menu-entry record.
92;;;
93
94(define-record-type* <menu-entry>
95 menu-entry make-menu-entry
96 menu-entry?
97 (label menu-entry-label)
98 (device menu-entry-device ; file system uuid, label, or #f
99 (default #f))
100 (device-mount-point menu-entry-device-mount-point
101 (default #f))
102 (linux menu-entry-linux
103 (default #f))
104 (linux-arguments menu-entry-linux-arguments
105 (default '())) ; list of string-valued gexps
106 (initrd menu-entry-initrd ; file name of the initrd as a gexp
107 (default #f))
108 (multiboot-kernel menu-entry-multiboot-kernel
109 (default #f))
110 (multiboot-arguments menu-entry-multiboot-arguments
111 (default '())) ; list of string-valued gexps
112 (multiboot-modules menu-entry-multiboot-modules
113 (default '())) ; list of multiboot commands, where
114 ; a command is a list of <string>
115 (chain-loader menu-entry-chain-loader
116 (default #f))) ; string, path of efi file
117
118(define (report-menu-entry-error menu-entry)
119 (raise
120 (condition
121 (&message
122 (message
123 (format #f (G_ "invalid menu-entry: ~a") menu-entry)))
124 (&fix-hint
125 (hint
126 (G_ "Please chose only one of:
127@enumerate
128@item direct boot by specifying fields @code{linux},
129@code{linux-arguments} and @code{linux-modules},
130@item multiboot by specifying fields @code{multiboot-kernel},
131@code{multiboot-arguments} and @code{multiboot-modules},
132@item chain-loader by specifying field @code{chain-loader}.
133@end enumerate"))))))
134
135(define (menu-entry->sexp entry)
136 "Return ENTRY serialized as an sexp."
137 (define (device->sexp device)
138 (match device
139 ((? uuid? uuid)
140 `(uuid ,(uuid-type uuid) ,(uuid->string uuid)))
141 ((? file-system-label? label)
142 `(label ,(file-system-label->string label)))
143 (_ device)))
144 (match entry
145 (($ <menu-entry> label device mount-point
146 (? identity linux) linux-arguments (? identity initrd)
147 #f () () #f)
148 `(menu-entry (version 0)
149 (label ,label)
150 (device ,(device->sexp device))
151 (device-mount-point ,mount-point)
152 (linux ,linux)
153 (linux-arguments ,linux-arguments)
154 (initrd ,initrd)))
155 (($ <menu-entry> label device mount-point #f () #f
156 (? identity multiboot-kernel) multiboot-arguments
157 multiboot-modules #f)
158 `(menu-entry (version 0)
159 (label ,label)
160 (device ,(device->sexp device))
161 (device-mount-point ,mount-point)
162 (multiboot-kernel ,multiboot-kernel)
163 (multiboot-arguments ,multiboot-arguments)
164 (multiboot-modules ,multiboot-modules)))
165 (($ <menu-entry> label device mount-point #f () #f #f () ()
166 (? identity chain-loader))
167 `(menu-entry (version 0)
168 (label ,label)
169 (device ,(device->sexp device))
170 (device-mount-point ,mount-point)
171 (chain-loader ,chain-loader)))
172 (_ (report-menu-entry-error entry))))
173
174(define (sexp->menu-entry sexp)
175 "Turn SEXP, an sexp as returned by 'menu-entry->sexp', into a <menu-entry>
176record."
177 (define (sexp->device device-sexp)
178 (match device-sexp
179 (('uuid type uuid-string)
180 (uuid uuid-string type))
181 (('label label)
182 (file-system-label label))
183 (_ device-sexp)))
184 (match sexp
185 (('menu-entry ('version 0)
186 ('label label) ('device device)
187 ('device-mount-point mount-point)
188 ('linux linux) ('linux-arguments linux-arguments)
189 ('initrd initrd) _ ...)
190 (menu-entry
191 (label label)
192 (device (sexp->device device))
193 (device-mount-point mount-point)
194 (linux linux)
195 (linux-arguments linux-arguments)
196 (initrd initrd)))
197 (('menu-entry ('version 0)
198 ('label label) ('device device)
199 ('device-mount-point mount-point)
200 ('multiboot-kernel multiboot-kernel)
201 ('multiboot-arguments multiboot-arguments)
202 ('multiboot-modules multiboot-modules) _ ...)
203 (menu-entry
204 (label label)
205 (device (sexp->device device))
206 (device-mount-point mount-point)
207 (multiboot-kernel multiboot-kernel)
208 (multiboot-arguments multiboot-arguments)
209 (multiboot-modules multiboot-modules)))
210 (('menu-entry ('version 0)
211 ('label label) ('device device)
212 ('device-mount-point mount-point)
213 ('chain-loader chain-loader) _ ...)
214 (menu-entry
215 (label label)
216 (device (sexp->device device))
217 (device-mount-point mount-point)
218 (chain-loader chain-loader)))))
219
220
221;;;
222;;; Bootloader record.
223;;;
224
225;; The <bootloader> record contains fields expressing how the bootloader
226;; should be installed. Every bootloader in gnu/bootloader/ directory
227;; has to be described by this record.
228
229(define-record-type* <bootloader>
230 bootloader make-bootloader
231 bootloader?
232 (name bootloader-name)
233 (package bootloader-package)
234 (installer bootloader-installer)
235 (disk-image-installer bootloader-disk-image-installer
236 (default #f))
237 (configuration-file bootloader-configuration-file)
238 (configuration-file-generator bootloader-configuration-file-generator))
239
240
241;;;
242;;; Bootloader configuration record.
243;;;
244
245;; The <bootloader-configuration> record contains bootloader independent
246;; configuration used to fill bootloader configuration file.
247
248(define-with-syntax-properties (warn-target-field-deprecation
249 (value properties))
250 (when value
251 (warning (source-properties->location properties)
252 (G_ "the 'target' field is deprecated, please use 'targets' \
253instead~%")))
254 value)
255
256(define-record-type* <bootloader-configuration>
257 bootloader-configuration make-bootloader-configuration
258 bootloader-configuration?
259 (bootloader
260 bootloader-configuration-bootloader) ;<bootloader>
261 (targets %bootloader-configuration-targets
262 (default #f)) ;list of strings
263 (target %bootloader-configuration-target ;deprecated
264 (default #f)
265 (sanitize warn-target-field-deprecation))
266 (menu-entries bootloader-configuration-menu-entries
267 (default '())) ;list of <menu-entry>
268 (default-entry bootloader-configuration-default-entry
269 (default 0)) ;integer
270 (timeout bootloader-configuration-timeout
271 (default 5)) ;seconds as integer
272 (keyboard-layout bootloader-configuration-keyboard-layout
273 (default #f)) ;<keyboard-layout> | #f
274 (theme bootloader-configuration-theme
275 (default #f)) ;bootloader-specific theme
276 (terminal-outputs bootloader-configuration-terminal-outputs
277 (default '(gfxterm))) ;list of symbols
278 (terminal-inputs bootloader-configuration-terminal-inputs
279 (default '())) ;list of symbols
280 (serial-unit bootloader-configuration-serial-unit
281 (default #f)) ;integer | #f
282 (serial-speed bootloader-configuration-serial-speed
283 (default #f)) ;integer | #f
284 (device-tree-support? bootloader-configuration-device-tree-support?
285 (default #t)) ;boolean
286 (extra-initrd bootloader-configuration-extra-initrd
287 (default #f))) ;string | #f
288
289(define-deprecated (bootloader-configuration-target config)
290 bootloader-configuration-targets
291 (%bootloader-configuration-target config))
292
293(define (bootloader-configuration-targets config)
294 (or (%bootloader-configuration-targets config)
295 ;; TODO: Remove after the deprecated 'target' field is removed.
296 (list (%bootloader-configuration-target config))
297 ;; XXX: At least the GRUB installer (see (gnu bootloader grub)) has this
298 ;; peculiar behavior of installing fonts and GRUB modules when DEVICE is #f,
299 ;; hence the default value of '(#f) rather than '().
300 (list #f)))
301
302
303;;;
304;;; Bootloaders.
305;;;
306
307(define (bootloader-modules)
308 "Return the list of bootloader modules."
309 (modules-from-current-profile "gnu/bootloader"
310 #:warn warn-about-load-error))
311
312(define %bootloaders
313 ;; The list of publically-known bootloaders.
314 (delay (fold-module-public-variables (lambda (obj result)
315 (if (bootloader? obj)
316 (cons obj result)
317 result))
318 '()
319 (bootloader-modules))))
320
321(define (lookup-bootloader-by-name name)
322 "Return the bootloader called NAME."
323 (or (find (lambda (bootloader)
324 (eq? name (bootloader-name bootloader)))
325 (force %bootloaders))
326 (leave (G_ "~a: no such bootloader~%") name)))
327
328(define (efi-bootloader-profile packages files hooks)
329 "Creates a profile from the lists of PACKAGES and FILES from the store.
330This profile is meant to be used by the bootloader-installer.
331
332FILES is a list of file or directory names from the store, which will be
333symlinked into the profile. If a directory name ends with '/', then the
334directory content instead of the directory itself will be symlinked into the
335profile.
336
337FILES may contain file like objects produced by procedures like plain-file,
338local-file, etc., or package contents produced with file-append.
339
340HOOKS lists additional hook functions to modify the profile."
341 (define* (efi-bootloader-profile-hook manifest #:optional system)
342 (define build
343 (with-imported-modules '((guix build utils))
344 #~(begin
345 (use-modules ((guix build utils)
346 #:select (mkdir-p strip-store-file-name))
347 ((ice-9 ftw)
348 #:select (scandir))
349 ((srfi srfi-1)
350 #:select (append-map every remove))
351 ((srfi srfi-26)
352 #:select (cut)))
353 (define (symlink-to file directory transform)
354 "Creates a symlink to FILE named (TRANSFORM FILE) in DIRECTORY."
355 (symlink file (string-append directory "/" (transform file))))
356 (define (directory-content directory)
357 "Creates a list of absolute path names inside DIRECTORY."
358 (map (lambda (name)
359 (string-append directory name))
360 (or (scandir directory (lambda (name)
361 (not (member name '("." "..")))))
362 '())))
363 (define name-ends-with-/? (cut string-suffix? "/" <>))
364 (define (name-is-store-entry? name)
365 "Return #t if NAME is a direct store entry and nothing inside."
366 (not (string-index (strip-store-file-name name) #\/)))
367 (let* ((files '#$files)
368 (directories (filter name-ends-with-/? files))
369 (names-from-directories
370 (append-map (lambda (directory)
371 (directory-content directory))
372 directories))
373 (names (append names-from-directories
374 (remove name-ends-with-/? files))))
375 (mkdir-p #$output)
376 (if (every file-exists? names)
377 (begin
378 (for-each (lambda (name)
379 (symlink-to name #$output
380 (if (name-is-store-entry? name)
381 strip-store-file-name
382 basename)))
383 names)
384 #t)
385 #f)))))
386
387 (gexp->derivation "efi-bootloader-profile"
388 build
389 #:system system
390 #:local-build? #t
391 #:substitutable? #f
392 #:properties
393 `((type . profile-hook)
394 (hook . efi-bootloader-profile-hook))))
395
396 (profile (content (packages->manifest packages))
397 (name "efi-bootloader-profile")
398 (hooks (cons efi-bootloader-profile-hook hooks))
399 (locales? #f)
400 (allow-collisions? #f)
401 (relative-symlinks? #f)))
402
403(define* (efi-bootloader-chain final-bootloader
404 #:key
405 (packages '())
406 (files '())
407 (hooks '())
408 installer
409 disk-image-installer)
410 "Define a chain of bootloaders with the FINAL-BOOTLOADER, optional PACKAGES,
411and optional directories and files from the store given in the list of FILES.
412
413The package of the FINAL-BOOTLOADER and all PACKAGES and FILES will be placed
414in an efi-bootloader-profile, which will be passed to the INSTALLER.
415
416FILES may contain file-like objects produced by procedures like plain-file,
417local-file, etc., or package contents produced with file-append.
418
419If a directory name in FILES ends with '/', then the directory content instead
420of the directory itself will be symlinked into the efi-bootloader-profile.
421
422The procedures in the HOOKS list can be used to further modify the bootloader
423profile. It is possible to pass a single function instead of a list.
424
425If the INSTALLER argument is used, then this gexp procedure will be called to
426install the efi-bootloader-profile. Otherwise the installer of the
427FINAL-BOOTLOADER will be called.
428
429If the DISK-IMAGE-INSTALLER is used, then this gexp procedure will be called
430to install the efi-bootloader-profile into a disk image. Otherwise the
431disk-image-installer of the FINAL-BOOTLOADER will be called."
432 (bootloader
433 (inherit final-bootloader)
434 (name 'efi-bootloader-chain)
435 (package
436 (efi-bootloader-profile (cons (bootloader-package final-bootloader)
437 packages)
438 files
439 (if (list? hooks)
440 hooks
441 (list hooks))))
442 (installer
443 (or installer
444 (bootloader-installer final-bootloader)))
445 (disk-image-installer
446 (or disk-image-installer
447 (bootloader-disk-image-installer final-bootloader)))))