Commit | Line | Data |
---|---|---|
9d449b94 MÁAV |
1 | ;;; GNU Guix --- Functional package management for GNU |
2 | ;;; Copyright © 2019, 2020 Miguel Ángel Arruga Vivas <rosen644835@gmail.com> | |
3294fa2b | 3 | ;;; Copyright © 2022 Josselin Poiret <dev@jpoiret.xyz> |
9d449b94 MÁAV |
4 | ;;; |
5 | ;;; This file is part of GNU Guix. | |
6 | ;;; | |
7 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | |
8 | ;;; under the terms of the GNU General Public License as published by | |
9 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
10 | ;;; your option) any later version. | |
11 | ;;; | |
12 | ;;; GNU Guix is distributed in the hope that it will be useful, but | |
13 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
14 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
15 | ;;; GNU General Public License for more details. | |
16 | ;;; | |
17 | ;;; You should have received a copy of the GNU General Public License | |
18 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |
19 | ||
20 | ;;; Commentary: | |
21 | ;;; | |
22 | ;;; Test boot parameters value storage and compatibility. | |
23 | ;;; | |
24 | ;;; Code: | |
25 | ||
26 | (define-module (test-boot-parameters) | |
27 | #:use-module (gnu bootloader) | |
28 | #:use-module (gnu bootloader grub) | |
29 | #:use-module (gnu system) | |
30 | #:use-module (gnu system file-systems) | |
31 | #:use-module (gnu system uuid) | |
47960b55 | 32 | #:use-module ((guix diagnostics) #:select (formatted-message?)) |
9d449b94 MÁAV |
33 | #:use-module (guix gexp) |
34 | #:use-module (guix store) | |
35 | #:use-module (guix tests) | |
47960b55 | 36 | #:use-module (srfi srfi-34) |
9d449b94 MÁAV |
37 | #:use-module (srfi srfi-64) |
38 | #:use-module (rnrs bytevectors)) | |
39 | ||
40 | (define %default-label "GNU with Linux-libre 99.1.2") | |
41 | (define %default-kernel-path | |
42 | (string-append (%store-prefix) | |
43 | "/zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz-linux-libre-99.1.2")) | |
44 | (define %default-kernel | |
45 | (string-append %default-kernel-path "/" (system-linux-image-file-name))) | |
46 | (define %default-kernel-arguments '()) | |
47 | (define %default-initrd-path | |
48 | (string-append (%store-prefix) "/wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww-initrd")) | |
49 | (define %default-initrd (string-append %default-initrd-path "/initrd.cpio.gz")) | |
50 | (define %default-root-device (uuid "abcdef12-3456-7890-abcd-ef1234567890")) | |
51 | (define %default-store-device (uuid "01234567-89ab-cdef-0123-456789abcdef")) | |
582cf925 MÁAV |
52 | (define %default-btrfs-subvolume "testfs") |
53 | (define %default-store-directory-prefix | |
54 | (string-append "/" %default-btrfs-subvolume)) | |
9d449b94 | 55 | (define %default-store-mount-point (%store-prefix)) |
f00e68ac MÁAV |
56 | (define %default-store-crypto-devices |
57 | (list (uuid "00000000-1111-2222-3333-444444444444") | |
58 | (uuid "55555555-6666-7777-8888-999999999999"))) | |
9d449b94 MÁAV |
59 | (define %default-multiboot-modules '()) |
60 | (define %default-locale "es_ES.utf8") | |
61 | (define %root-path "/") | |
62 | ||
63 | (define %grub-boot-parameters | |
64 | (boot-parameters | |
65 | (bootloader-name 'grub) | |
66 | (bootloader-menu-entries '()) | |
67 | (root-device %default-root-device) | |
68 | (label %default-label) | |
69 | (kernel %default-kernel) | |
70 | (kernel-arguments %default-kernel-arguments) | |
71 | (initrd %default-initrd) | |
72 | (multiboot-modules %default-multiboot-modules) | |
73 | (locale %default-locale) | |
74 | (store-device %default-store-device) | |
582cf925 | 75 | (store-directory-prefix %default-store-directory-prefix) |
f00e68ac | 76 | (store-crypto-devices %default-store-crypto-devices) |
9d449b94 MÁAV |
77 | (store-mount-point %default-store-mount-point))) |
78 | ||
79 | (define %default-operating-system | |
80 | (operating-system | |
81 | (host-name "host") | |
82 | (timezone "Europe/Berlin") | |
83 | (locale %default-locale) | |
84 | ||
85 | (bootloader (bootloader-configuration | |
86 | (bootloader grub-bootloader) | |
da4e4094 | 87 | (targets '("/dev/sda")))) |
9d449b94 MÁAV |
88 | (file-systems (cons* (file-system |
89 | (device %default-root-device) | |
90 | (mount-point %root-path) | |
91 | (type "ext4")) | |
92 | (file-system | |
93 | (device %default-store-device) | |
94 | (mount-point %default-store-mount-point) | |
582cf925 MÁAV |
95 | (type "btrfs") |
96 | (options | |
97 | (string-append "subvol=" | |
98 | %default-btrfs-subvolume))) | |
9d449b94 MÁAV |
99 | %base-file-systems)))) |
100 | ||
101 | (define (quote-uuid uuid) | |
102 | (list 'uuid (uuid-type uuid) (uuid-bytevector uuid))) | |
103 | ||
104 | ;; Call read-boot-parameters with the desired string as input. | |
105 | (define* (test-read-boot-parameters | |
106 | #:key | |
4a3b8f4d | 107 | (version %boot-parameters-version) |
9d449b94 MÁAV |
108 | (bootloader-name 'grub) |
109 | (bootloader-menu-entries '()) | |
110 | (label %default-label) | |
111 | (root-device (quote-uuid %default-root-device)) | |
112 | (kernel %default-kernel) | |
113 | (kernel-arguments %default-kernel-arguments) | |
114 | (initrd %default-initrd) | |
115 | (multiboot-modules %default-multiboot-modules) | |
116 | (locale %default-locale) | |
117 | (with-store #t) | |
118 | (store-device | |
119 | (quote-uuid %default-store-device)) | |
f00e68ac MÁAV |
120 | (store-crypto-devices |
121 | (map quote-uuid %default-store-crypto-devices)) | |
582cf925 | 122 | (store-directory-prefix %default-store-directory-prefix) |
9d449b94 MÁAV |
123 | (store-mount-point %default-store-mount-point)) |
124 | (define (generate-boot-parameters) | |
125 | (define (sexp-or-nothing fmt val) | |
126 | (cond ((eq? 'false val) (format #false fmt #false)) | |
127 | (val (format #false fmt val)) | |
128 | (else ""))) | |
129 | (format #false "(boot-parameters~a~a~a~a~a~a~a~a~a~a)" | |
130 | (sexp-or-nothing " (version ~S)" version) | |
131 | (sexp-or-nothing " (label ~S)" label) | |
132 | (sexp-or-nothing " (root-device ~S)" root-device) | |
133 | (sexp-or-nothing " (kernel ~S)" kernel) | |
134 | (sexp-or-nothing " (kernel-arguments ~S)" kernel-arguments) | |
135 | (sexp-or-nothing " (initrd ~S)" initrd) | |
136 | (if with-store | |
f00e68ac | 137 | (format #false " (store~a~a~a~a)" |
9d449b94 MÁAV |
138 | (sexp-or-nothing " (device ~S)" store-device) |
139 | (sexp-or-nothing " (mount-point ~S)" | |
582cf925 MÁAV |
140 | store-mount-point) |
141 | (sexp-or-nothing " (directory-prefix ~S)" | |
f00e68ac MÁAV |
142 | store-directory-prefix) |
143 | (sexp-or-nothing " (crypto-devices ~S)" | |
144 | store-crypto-devices)) | |
9d449b94 MÁAV |
145 | "") |
146 | (sexp-or-nothing " (locale ~S)" locale) | |
147 | (sexp-or-nothing " (bootloader-name ~a)" bootloader-name) | |
148 | (sexp-or-nothing " (bootloader-menu-entries ~S)" | |
149 | bootloader-menu-entries))) | |
150 | (let ((str (generate-boot-parameters))) | |
151 | (call-with-input-string str read-boot-parameters))) | |
152 | ||
153 | (test-begin "boot-parameters") | |
154 | ||
155 | ;; XXX: <warning: unrecognized boot parameters at '#f'> | |
156 | (test-assert "read, construction, mandatory fields" | |
47960b55 LC |
157 | (let-syntax ((test-read-boot-parameters |
158 | (syntax-rules () | |
159 | ((_ args ...) | |
160 | (guard (c ((formatted-message? c) #f)) | |
161 | (test-read-boot-parameters args ...)))))) | |
162 | (not (or (test-read-boot-parameters #:version #false) | |
163 | (test-read-boot-parameters #:version 'false) | |
164 | (test-read-boot-parameters #:version -1) | |
165 | (test-read-boot-parameters #:version "0") | |
166 | (test-read-boot-parameters #:root-device #false) | |
167 | (test-read-boot-parameters #:kernel #false) | |
168 | (test-read-boot-parameters #:label #false))))) | |
9d449b94 MÁAV |
169 | |
170 | (test-assert "read, construction, optional fields" | |
171 | (and (test-read-boot-parameters #:bootloader-name #false) | |
172 | (test-read-boot-parameters #:bootloader-menu-entries #false) | |
173 | (test-read-boot-parameters #:kernel-arguments #false) | |
174 | (test-read-boot-parameters #:with-store #false) | |
175 | (test-read-boot-parameters #:store-device #false) | |
176 | (test-read-boot-parameters #:store-device 'false) | |
f00e68ac | 177 | (test-read-boot-parameters #:store-crypto-devices #false) |
9d449b94 | 178 | (test-read-boot-parameters #:store-mount-point #false) |
582cf925 | 179 | (test-read-boot-parameters #:store-directory-prefix #false) |
9d449b94 MÁAV |
180 | (test-read-boot-parameters #:multiboot-modules #false) |
181 | (test-read-boot-parameters #:locale #false) | |
182 | (test-read-boot-parameters #:bootloader-name #false | |
183 | #:kernel-arguments #false | |
184 | #:with-store #false | |
185 | #:locale #false))) | |
186 | ||
187 | (test-equal "read, default equality" | |
188 | %grub-boot-parameters | |
189 | (test-read-boot-parameters)) | |
190 | ||
191 | (test-equal "read, root-device, label" | |
192 | (file-system-label "my-root") | |
193 | (boot-parameters-root-device | |
194 | (test-read-boot-parameters #:root-device '(file-system-label "my-root")))) | |
195 | ||
196 | (test-equal "read, root-device, /dev node" | |
197 | "/dev/sda2" | |
198 | (boot-parameters-root-device | |
199 | (test-read-boot-parameters #:root-device "/dev/sda2"))) | |
200 | ||
201 | (test-equal "read, kernel, only store path" | |
202 | %default-kernel | |
203 | (boot-parameters-kernel | |
204 | (test-read-boot-parameters #:kernel %default-kernel-path))) | |
205 | ||
206 | (test-equal "read, kernel, full-path" | |
207 | %default-kernel | |
208 | (boot-parameters-kernel | |
209 | (test-read-boot-parameters #:kernel %default-kernel))) | |
210 | ||
211 | (test-assert "read, construction, missing initrd" | |
212 | (not (boot-parameters-initrd (test-read-boot-parameters #:initrd #false)))) | |
213 | ||
214 | (test-equal "read, initrd, old format" | |
215 | "/a/b" | |
216 | (boot-parameters-initrd | |
217 | (test-read-boot-parameters #:initrd (list 'string-append "/a" "/b")))) | |
218 | ||
219 | ;; Compatibility reasons specified in gnu/system.scm. | |
220 | (test-eq "read, bootloader-name, default value" | |
221 | 'grub | |
222 | (boot-parameters-bootloader-name | |
223 | (test-read-boot-parameters #:bootloader-name #false))) | |
224 | ||
225 | (test-eq "read, bootloader-menu-entries, default value" | |
226 | '() | |
227 | (boot-parameters-bootloader-menu-entries | |
228 | (test-read-boot-parameters #:bootloader-menu-entries #false))) | |
229 | ||
230 | (test-eq "read, kernel-arguments, default value" | |
231 | '() | |
232 | (boot-parameters-kernel-arguments | |
233 | (test-read-boot-parameters #:kernel-arguments #false))) | |
234 | ||
235 | (test-assert "read, store-device, filter /dev" | |
236 | (not (boot-parameters-store-device | |
237 | (test-read-boot-parameters #:store-device "/dev/sda3")))) | |
238 | ||
239 | (test-assert "read, no-store, filter /dev from root" | |
240 | (not (boot-parameters-store-device | |
241 | (test-read-boot-parameters #:root-device "/dev/sda3" | |
242 | #:with-store #false)))) | |
243 | ||
244 | (test-assert "read, no store-device, filter /dev from root" | |
245 | (not (boot-parameters-store-device | |
246 | (test-read-boot-parameters #:root-device "/dev/sda3" | |
247 | #:store-device #false)))) | |
248 | ||
249 | (test-assert "read, store-device #false, filter /dev from root" | |
250 | (not (boot-parameters-store-device | |
251 | (test-read-boot-parameters #:root-device "/dev/sda3" | |
252 | #:store-device 'false)))) | |
253 | ||
254 | (test-equal "read, store-device, label (legacy)" | |
255 | (file-system-label "my-store") | |
256 | (boot-parameters-store-device | |
257 | (test-read-boot-parameters #:store-device "my-store"))) | |
258 | ||
259 | (test-equal "read, store-device, from root" | |
260 | %default-root-device | |
261 | (boot-parameters-store-device | |
262 | (test-read-boot-parameters #:with-store #false))) | |
263 | ||
264 | (test-equal "read, no store-mount-point, default" | |
265 | %root-path | |
266 | (boot-parameters-store-mount-point | |
267 | (test-read-boot-parameters #:store-mount-point #false))) | |
268 | ||
269 | (test-equal "read, no store, default store-mount-point" | |
270 | %root-path | |
271 | (boot-parameters-store-mount-point | |
272 | (test-read-boot-parameters #:with-store #false))) | |
273 | ||
f00e68ac MÁAV |
274 | (test-equal "read, store-crypto-devices, default" |
275 | '() | |
276 | (boot-parameters-store-crypto-devices | |
277 | (test-read-boot-parameters #:store-crypto-devices #false))) | |
278 | ||
279 | ;; XXX: <warning: unrecognized crypto-devices #f at '#f'> | |
280 | (test-equal "read, store-crypto-devices, false" | |
281 | '() | |
282 | (boot-parameters-store-crypto-devices | |
283 | (test-read-boot-parameters #:store-crypto-devices 'false))) | |
284 | ||
285 | ;; XXX: <warning: unrecognized crypto-device "bad" at '#f'> | |
286 | (test-equal "read, store-crypto-devices, string" | |
287 | '() | |
288 | (boot-parameters-store-crypto-devices | |
289 | (test-read-boot-parameters #:store-crypto-devices "bad"))) | |
290 | ||
9d449b94 MÁAV |
291 | ;; For whitebox testing |
292 | (define operating-system-boot-parameters | |
293 | (@@ (gnu system) operating-system-boot-parameters)) | |
294 | ||
295 | (test-equal "from os, locale" | |
296 | %default-locale | |
297 | (boot-parameters-locale | |
298 | (operating-system-boot-parameters %default-operating-system | |
299 | %default-root-device))) | |
300 | ||
582cf925 MÁAV |
301 | (test-equal "from os, store-directory-prefix" |
302 | %default-store-directory-prefix | |
303 | (boot-parameters-store-directory-prefix | |
304 | (operating-system-boot-parameters %default-operating-system | |
305 | %default-root-device))) | |
306 | ||
3294fa2b JP |
307 | (define %uuid-menu-entry |
308 | (menu-entry | |
309 | (label "test") | |
310 | (device (uuid "6d5b13d4-6092-46d0-8be4-073dc07413cc")) | |
311 | (linux "/boot/bzImage") | |
312 | (initrd "/boot/initrd.cpio.gz"))) | |
313 | ||
314 | (define %file-system-label-menu-entry | |
315 | (menu-entry | |
316 | (label "test") | |
317 | (device (file-system-label "test-label")) | |
318 | (linux "/boot/bzImage") | |
319 | (initrd "/boot/initrd.cpio.gz"))) | |
320 | ||
321 | (test-equal "menu-entry roundtrip, uuid" | |
322 | %uuid-menu-entry | |
323 | (sexp->menu-entry (menu-entry->sexp %uuid-menu-entry))) | |
324 | ||
325 | (test-equal "menu-entry roundtrip, file-system-label" | |
326 | %file-system-label-menu-entry | |
327 | (sexp->menu-entry (menu-entry->sexp %file-system-label-menu-entry))) | |
328 | ||
9d449b94 | 329 | (test-end "boot-parameters") |