projects/guix·blob mpd-fix-groups · refs

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