projects/guix·blob master · refs

329 lines · 12.6 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2019, 2020 Miguel Ángel Arruga Vivas <[email protected]>
3;;; Copyright © 2022 Josselin Poiret <[email protected]>
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)
32 #:use-module ((guix diagnostics) #:select (formatted-message?))
33 #:use-module (guix gexp)
34 #:use-module (guix store)
35 #:use-module (guix tests)
36 #:use-module (srfi srfi-34)
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"))
52(define %default-btrfs-subvolume "testfs")
53(define %default-store-directory-prefix
54 (string-append "/" %default-btrfs-subvolume))
55(define %default-store-mount-point (%store-prefix))
56(define %default-store-crypto-devices
57 (list (uuid "00000000-1111-2222-3333-444444444444")
58 (uuid "55555555-6666-7777-8888-999999999999")))
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)
75 (store-directory-prefix %default-store-directory-prefix)
76 (store-crypto-devices %default-store-crypto-devices)
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)
87 (targets '("/dev/sda"))))
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)
95 (type "btrfs")
96 (options
97 (string-append "subvol="
98 %default-btrfs-subvolume)))
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
107 (version %boot-parameters-version)
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))
120 (store-crypto-devices
121 (map quote-uuid %default-store-crypto-devices))
122 (store-directory-prefix %default-store-directory-prefix)
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
137 (format #false " (store~a~a~a~a)"
138 (sexp-or-nothing " (device ~S)" store-device)
139 (sexp-or-nothing " (mount-point ~S)"
140 store-mount-point)
141 (sexp-or-nothing " (directory-prefix ~S)"
142 store-directory-prefix)
143 (sexp-or-nothing " (crypto-devices ~S)"
144 store-crypto-devices))
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"
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)))))
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)
177 (test-read-boot-parameters #:store-crypto-devices #false)
178 (test-read-boot-parameters #:store-mount-point #false)
179 (test-read-boot-parameters #:store-directory-prefix #false)
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
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
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
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
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
329(test-end "boot-parameters")