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