Commit | Line | Data |
---|---|---|
b09a8da4 MO |
1 | ;;; GNU Guix --- Functional package management for GNU |
2 | ;;; Copyright © 2017 David Craven <david@craven.ch> | |
7feefb3b | 3 | ;;; Copyright © 2017, 2020 Mathieu Othacehe <m.othacehe@gmail.com> |
b09a8da4 | 4 | ;;; Copyright © 2017 Leo Famulari <leo@famulari.name> |
a28cfee8 | 5 | ;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org> |
21acd8d6 | 6 | ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> |
b09a8da4 MO |
7 | ;;; |
8 | ;;; This file is part of GNU Guix. | |
9 | ;;; | |
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. | |
14 | ;;; | |
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. | |
19 | ;;; | |
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/>. | |
22 | ||
23 | (define-module (gnu bootloader) | |
24 | #:use-module (guix discovery) | |
25 | #:use-module (guix records) | |
26 | #:use-module (guix ui) | |
27 | #:use-module (srfi srfi-1) | |
a28cfee8 | 28 | #:use-module (ice-9 match) |
8b22107e MO |
29 | #:export (menu-entry |
30 | menu-entry? | |
31 | menu-entry-label | |
32 | menu-entry-device | |
33 | menu-entry-linux | |
34 | menu-entry-linux-arguments | |
35 | menu-entry-initrd | |
1975c754 | 36 | menu-entry-device-mount-point |
21acd8d6 JN |
37 | menu-entry-multiboot-kernel |
38 | menu-entry-multiboot-arguments | |
39 | menu-entry-multiboot-modules | |
8b22107e | 40 | |
a28cfee8 LC |
41 | menu-entry->sexp |
42 | sexp->menu-entry | |
43 | ||
8b22107e | 44 | bootloader |
b09a8da4 MO |
45 | bootloader? |
46 | bootloader-name | |
47 | bootloader-package | |
48 | bootloader-installer | |
7feefb3b | 49 | bootloader-disk-image-installer |
b09a8da4 MO |
50 | bootloader-configuration-file |
51 | bootloader-configuration-file-generator | |
52 | ||
53 | bootloader-configuration | |
54 | bootloader-configuration? | |
55 | bootloader-configuration-bootloader | |
045ebb3e | 56 | bootloader-configuration-target |
b09a8da4 MO |
57 | bootloader-configuration-menu-entries |
58 | bootloader-configuration-default-entry | |
59 | bootloader-configuration-timeout | |
8d058e7b | 60 | bootloader-configuration-keyboard-layout |
b09a8da4 MO |
61 | bootloader-configuration-theme |
62 | bootloader-configuration-terminal-outputs | |
63 | bootloader-configuration-terminal-inputs | |
64 | bootloader-configuration-serial-unit | |
65 | bootloader-configuration-serial-speed | |
66 | bootloader-configuration-additional-configuration | |
67 | ||
68 | %bootloaders | |
69 | lookup-bootloader-by-name)) | |
70 | ||
71 | \f | |
8b22107e MO |
72 | ;;; |
73 | ;;; Menu-entry record. | |
74 | ;;; | |
75 | ||
76 | (define-record-type* <menu-entry> | |
77 | menu-entry make-menu-entry | |
78 | menu-entry? | |
79 | (label menu-entry-label) | |
80 | (device menu-entry-device ; file system uuid, label, or #f | |
81 | (default #f)) | |
1975c754 DM |
82 | (device-mount-point menu-entry-device-mount-point |
83 | (default #f)) | |
21acd8d6 JN |
84 | (linux menu-entry-linux |
85 | (default #f)) | |
8b22107e MO |
86 | (linux-arguments menu-entry-linux-arguments |
87 | (default '())) ; list of string-valued gexps | |
21acd8d6 JN |
88 | (initrd menu-entry-initrd ; file name of the initrd as a gexp |
89 | (default #f)) | |
90 | (multiboot-kernel menu-entry-multiboot-kernel | |
91 | (default #f)) | |
92 | (multiboot-arguments menu-entry-multiboot-arguments | |
93 | (default '())) ; list of string-valued gexps | |
94 | (multiboot-modules menu-entry-multiboot-modules | |
95 | (default '()))) ; list of multiboot commands, where | |
96 | ; a command is a list of <string> | |
8b22107e | 97 | |
a28cfee8 LC |
98 | (define (menu-entry->sexp entry) |
99 | "Return ENTRY serialized as an sexp." | |
100 | (match entry | |
21acd8d6 JN |
101 | (($ <menu-entry> label device mount-point linux linux-arguments initrd #f |
102 | ()) | |
a28cfee8 LC |
103 | `(menu-entry (version 0) |
104 | (label ,label) | |
105 | (device ,device) | |
106 | (device-mount-point ,mount-point) | |
107 | (linux ,linux) | |
108 | (linux-arguments ,linux-arguments) | |
21acd8d6 JN |
109 | (initrd ,initrd))) |
110 | (($ <menu-entry> label device mount-point #f () #f | |
111 | multiboot-kernel multiboot-arguments multiboot-modules) | |
112 | `(menu-entry (version 0) | |
113 | (label ,label) | |
114 | (device ,device) | |
115 | (device-mount-point ,mount-point) | |
116 | (multiboot-kernel ,multiboot-kernel) | |
117 | (multiboot-arguments ,multiboot-arguments) | |
118 | (multiboot-modules ,multiboot-modules))))) | |
a28cfee8 LC |
119 | |
120 | (define (sexp->menu-entry sexp) | |
121 | "Turn SEXP, an sexp as returned by 'menu-entry->sexp', into a <menu-entry> | |
122 | record." | |
123 | (match sexp | |
124 | (('menu-entry ('version 0) | |
125 | ('label label) ('device device) | |
126 | ('device-mount-point mount-point) | |
127 | ('linux linux) ('linux-arguments linux-arguments) | |
128 | ('initrd initrd) _ ...) | |
129 | (menu-entry | |
130 | (label label) | |
131 | (device device) | |
132 | (device-mount-point mount-point) | |
133 | (linux linux) | |
134 | (linux-arguments linux-arguments) | |
21acd8d6 JN |
135 | (initrd initrd))) |
136 | (('menu-entry ('version 0) | |
137 | ('label label) ('device device) | |
138 | ('device-mount-point mount-point) | |
139 | ('multiboot-kernel multiboot-kernel) | |
140 | ('multiboot-arguments multiboot-arguments) | |
141 | ('multiboot-modules multiboot-modules) _ ...) | |
142 | (menu-entry | |
143 | (label label) | |
144 | (device device) | |
145 | (device-mount-point mount-point) | |
146 | (multiboot-kernel multiboot-kernel) | |
147 | (multiboot-arguments multiboot-arguments) | |
148 | (multiboot-modules multiboot-modules))))) | |
a28cfee8 | 149 | |
8b22107e | 150 | \f |
b09a8da4 MO |
151 | ;;; |
152 | ;;; Bootloader record. | |
153 | ;;; | |
154 | ||
155 | ;; The <bootloader> record contains fields expressing how the bootloader | |
156 | ;; should be installed. Every bootloader in gnu/bootloader/ directory | |
157 | ;; has to be described by this record. | |
158 | ||
159 | (define-record-type* <bootloader> | |
160 | bootloader make-bootloader | |
161 | bootloader? | |
162 | (name bootloader-name) | |
163 | (package bootloader-package) | |
164 | (installer bootloader-installer) | |
7feefb3b MO |
165 | (disk-image-installer bootloader-disk-image-installer |
166 | (default #f)) | |
b09a8da4 MO |
167 | (configuration-file bootloader-configuration-file) |
168 | (configuration-file-generator bootloader-configuration-file-generator)) | |
169 | ||
170 | \f | |
171 | ;;; | |
172 | ;;; Bootloader configuration record. | |
173 | ;;; | |
174 | ||
175 | ;; The <bootloader-configuration> record contains bootloader independant | |
176 | ;; configuration used to fill bootloader configuration file. | |
177 | ||
178 | (define-record-type* <bootloader-configuration> | |
179 | bootloader-configuration make-bootloader-configuration | |
180 | bootloader-configuration? | |
91b6873b LC |
181 | (bootloader bootloader-configuration-bootloader) ;<bootloader> |
182 | (target bootloader-configuration-target ;string | |
183 | (default #f)) | |
ac9cd78e | 184 | (menu-entries bootloader-configuration-menu-entries ;list of <menu-entry> |
91b6873b LC |
185 | (default '())) |
186 | (default-entry bootloader-configuration-default-entry ;integer | |
187 | (default 0)) | |
188 | (timeout bootloader-configuration-timeout ;seconds as integer | |
189 | (default 5)) | |
8d058e7b LC |
190 | (keyboard-layout bootloader-configuration-keyboard-layout ;<keyboard-layout> | #f |
191 | (default #f)) | |
91b6873b LC |
192 | (theme bootloader-configuration-theme ;bootloader-specific theme |
193 | (default #f)) | |
194 | (terminal-outputs bootloader-configuration-terminal-outputs ;list of symbols | |
195 | (default '(gfxterm))) | |
196 | (terminal-inputs bootloader-configuration-terminal-inputs ;list of symbols | |
197 | (default '())) | |
198 | (serial-unit bootloader-configuration-serial-unit ;integer | #f | |
199 | (default #f)) | |
200 | (serial-speed bootloader-configuration-serial-speed ;integer | #f | |
201 | (default #f))) | |
b09a8da4 MO |
202 | |
203 | \f | |
204 | ;;; | |
205 | ;;; Bootloaders. | |
206 | ;;; | |
207 | ||
208 | (define (bootloader-modules) | |
209 | "Return the list of bootloader modules." | |
210 | (all-modules (map (lambda (entry) | |
211 | `(,entry . "gnu/bootloader")) | |
3c0128b0 LC |
212 | %load-path) |
213 | #:warn warn-about-load-error)) | |
b09a8da4 MO |
214 | |
215 | (define %bootloaders | |
216 | ;; The list of publically-known bootloaders. | |
217 | (delay (fold-module-public-variables (lambda (obj result) | |
218 | (if (bootloader? obj) | |
219 | (cons obj result) | |
220 | result)) | |
221 | '() | |
222 | (bootloader-modules)))) | |
223 | ||
224 | (define (lookup-bootloader-by-name name) | |
225 | "Return the bootloader called NAME." | |
226 | (or (find (lambda (bootloader) | |
227 | (eq? name (bootloader-name bootloader))) | |
228 | (force %bootloaders)) | |
229 | (leave (G_ "~a: no such bootloader~%") name))) |